Mercurial > hg > xemacs-beta
diff tests/gtk/statusbar-test.el @ 462:0784d089fdc9 r21-2-46
Import from CVS: tag r21-2-46
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:44:37 +0200 |
parents | |
children | db7068430402 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/gtk/statusbar-test.el Mon Aug 13 11:44:37 2007 +0200 @@ -0,0 +1,74 @@ +(defvar statusbar-hashtable (make-hashtable 29)) +(defvar statusbar-gnome-p nil) + +(defmacro get-frame-statusbar (frame) + `(gethash (or ,frame (selected-frame)) statusbar-hashtable)) + +(defun add-frame-statusbar (frame) + "Stick a GTK (or GNOME) statusbar at the bottom of the frame." + (if (windowp (frame-property frame 'minibuffer)) + (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer))) + statusbar-hashtable) + (let ((sbar nil) + (shell (frame-property frame 'shell-widget))) + (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell))) + (progn + (require 'gnome-widgets) + (setq sbar (gnome-appbar-new t t 0) + statusbar-gnome-p t) + (gtk-progress-set-format-string sbar "%p%%") + (gnome-app-set-statusbar shell sbar)) + (setq sbar (gtk-statusbar-new)) + (gtk-box-pack-end (frame-property frame 'container-widget) + sbar nil nil 0)) + (puthash frame sbar statusbar-hashtable)))) + +(add-hook 'create-frame-hook 'add-frame-statusbar) +(add-hook 'delete-frame-hook (lambda (f) + (remhash f statusbar-hashtable))) + + +(defun clear-message (&optional label frame stdout-p no-restore) + (let ((sbar (get-frame-statusbar frame))) + (if sbar + (if statusbar-gnome-p + (gnome-appbar-pop sbar) + (gtk-statusbar-pop sbar 1))))) + +(defun append-message (label message &optional frame stdout-p) + (let ((sbar (get-frame-statusbar frame))) + (if sbar + (if statusbar-gnome-p + (gnome-appbar-push sbar message) + (gtk-statusbar-push sbar 1 message))))) + +(defun progress-display (fmt &optional value &rest args) + "Print a progress gauge and message in the bottom gutter area of the frame. +The arguments are the same as to `format'. + +If the only argument is nil, clear any existing progress gauge." + (let ((sbar (get-frame-statusbar nil))) + (apply 'message fmt args) + (if statusbar-gnome-p + (progn + (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t) + (gnome-appbar-set-progress sbar (/ value 100.0)) + (gdk-flush))))) + +(defun lprogress-display (label fmt &optional value &rest args) + "Print a progress gauge and message in the bottom gutter area of the frame. +First argument LABEL is an identifier for this progress gauge. The rest of the +arguments are the same as to `format'." + (if (and (null fmt) (null args)) + (prog1 nil + (clear-progress-display label nil)) + (let ((str (apply 'format fmt args))) + (progress-display str value) + str))) + +(defun clear-progress-display (&rest ignored) + (if statusbar-gnome-p + (let* ((sbar (get-frame-statusbar nil)) + (progress (gnome-appbar-get-progress sbar))) + (gnome-appbar-set-progress sbar 0) + (gtk-progress-set-show-text progress nil))))