This patch adds basic disk usage formatters for the modeline.
Only tested on linux with clisp. It rely on 'df' command to get usage
informations.
--
Morgan Veyret ([EMAIL PROTECTED])
http://appart.kicks-ass.net/patzy
>From e2da0247049565abf21e1d076f9ad3b97745604a Mon Sep 17 00:00:00 2001
From: Morgan Veyret <[EMAIL PROTECTED]>
Date: Fri, 24 Oct 2008 14:57:04 +0200
Subject: [PATCH] Added simple disk usage formatters for the modeline.
---
contrib/disk.lisp | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 113 insertions(+), 0 deletions(-)
create mode 100644 contrib/disk.lisp
diff --git a/contrib/disk.lisp b/contrib/disk.lisp
new file mode 100644
index 0000000..b230545
--- /dev/null
+++ b/contrib/disk.lisp
@@ -0,0 +1,113 @@
+;;; Disk usage monitoring for stumpwm's modeline
+;;;
+;;; Copyright 2007 Morgan Veyret.
+;;;
+;;; Maintainer: Morgan Veyret
+;;;
+;;; This module is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This module is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this software; see the file COPYING. If not, write to
+;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;; Boston, MA 02111-1307 USA
+;;;
+
+;;; USAGE:
+;;;
+;;; Put:
+;;;
+;;; (load-module "disk")
+;;;
+;;; ...into your ~/.stumpwmrc
+;;;
+;;; Then you can use "%D" in your mode line format.
+;;; You can customize the modeline format (*disk-modeline-fmt*). See the
+;;; documentation for *disk-modeline-fmt* for more information.
+
+;;; CODE:
+(in-package :stumpwm)
+
+(dolist (a '((#\D disk-modeline)))
+ (pushnew a *screen-mode-line-formatters* :test 'equal))
+
+(defvar *disk-usage* nil)
+
+(defun disk-usage-tokenize (usage-line-str)
+ (ppcre:split "(\\s+)" usage-line-str))
+
+(defun disk-update-usage (paths)
+ (setf *disk-usage*
+ (with-input-from-string
+ (usage-str (run-shell-command
+ (format nil "df -h ~{~a ~} | grep -v 'Filesystem'"
paths) t))
+ (loop for i = (read-line usage-str nil nil)
+ while i
+ collect (disk-usage-tokenize i)))))
+
+(defvar *disk-usage-paths* '("/"))
+
+
+(defun disk-usage-get-field (path field-number)
+ (let ((usage-infos (find-if (lambda (item)
+ (string= (car (last item)) path))
+ *disk-usage*)))
+ (nth field-number usage-infos)))
+(defun disk-get-device (path)
+ (disk-usage-get-field path 0))
+(defun disk-get-size (path)
+ (disk-usage-get-field path 1))
+(defun disk-get-used (path)
+ (disk-usage-get-field path 2))
+(defun disk-get-available (path)
+ (disk-usage-get-field path 3))
+(defun disk-get-use-percent (path)
+ (disk-usage-get-field path 4))
+(defun disk-get-mount-point (path)
+ (disk-usage-get-field path 5))
+
+(defun disk-modeline (ml)
+ (declare (ignore ml))
+ (disk-update-usage *disk-usage-paths*)
+ (let ((fmts (loop for p in *disk-usage-paths*
+ collect (format-expand *disk-formatters-alist*
+ *disk-modeline-fmt*
+ p))))
+ (format nil "~{~a ~}" fmts)))
+
+(defvar *disk-formatters-alist*
+ '((#\d disk-get-device)
+ (#\s disk-get-size)
+ (#\u disk-get-used)
+ (#\a disk-get-available)
+ (#\p disk-get-use-percent)
+ (#\m disk-get-mount-point)))
+
+(defvar *disk-modeline-fmt* "%m: %u/%s"
+ "The default value for displaying disk usage information on the modeline.
+
[EMAIL PROTECTED] @asis
[EMAIL PROTECTED] %%
+A literal '%'
[EMAIL PROTECTED] %d
+Filesystem device
[EMAIL PROTECTED] %s
+Filesystem size
[EMAIL PROTECTED] %u
+Filesystem used space
[EMAIL PROTECTED] %a
+Filesystem available space
[EMAIL PROTECTED] %p
+Filesystem used space in percent
[EMAIL PROTECTED] %m
+Filesystem mount point
[EMAIL PROTECTED] table
+")
+
--
1.5.5.1
_______________________________________________
Stumpwm-devel mailing list
Stumpwm-devel@nongnu.org
http://lists.nongnu.org/mailman/listinfo/stumpwm-devel
