Mercurial > hg > xemacs-beta
annotate tests/gtk/statusbar-test.el @ 776:79940b592197
[xemacs-hg @ 2002-03-15 07:43:14 by ben]
.cvsignore: ignore .tmp files that are getting auto-created by VC.
Makefile.in.in: Use -no-packages to avoid problems with package files shadowing
core files (e.g. unicode.el in mule-ucs).
alloc.c, emacs.c, lisp.h: add new -no-packages. make sure list of args for sorting is
actually correct. clean up arg parsing code.
xemacs.mak: Use -no-packages to avoid problems with package files shadowing
core files (e.g. unicode.el in mule-ucs).
Makefile: Use -no-packages to avoid problems with package files shadowing
core files (e.g. unicode.el in mule-ucs).
mule\chinese.el, mule\japan-util.el: fix warnings.
behavior-defs.el: fix errors with require.
bytecomp-runtime.el: add new funs {when,and}-{f}boundp, clean up docs.
cus-edit.el: pretty-print values.
dump-paths.el, find-paths.el, startup.el, setup-paths.el: fix problems/inconsistencies parsing options. support new
-no-packages option. merge code duplication in dump-paths and
startup.
lisp-mode.el: indent macrolet and labels correctly. update comments about
lisp-indent-function. flet already handled in cl.
apropos.el, auto-save.el, buff-menu.el, cl-extra.el, dragdrop.el, faces.el, files.el, fill.el, font-lock.el, font.el, gtk-faces.el, gui.el, help.el, hyper-apropos.el, info.el, isearch-mode.el, keymap.el, lisp-mnt.el, mouse.el, package-admin.el, package-get.el, printer.el, process.el, resize-minibuffer.el, simple.el, toolbar-items.el, wid-edit.el, win32-native.el: fix warnings.
very-early-lisp.el: update docs.
mule\chinese.el, mule\japan-util.el: fix warnings.
mule\chinese.el, mule\japan-util.el: fix warnings.
behavior-defs.el: fix errors with require.
bytecomp-runtime.el: add new funs {when,and}-{f}boundp, clean up docs.
cus-edit.el: pretty-print values.
dump-paths.el, find-paths.el, startup.el, setup-paths.el: fix problems/inconsistencies parsing options. support new
-no-packages option. merge code duplication in dump-paths and
startup.
lisp-mode.el: indent macrolet and labels correctly. update comments about
lisp-indent-function. flet already handled in cl.
apropos.el, auto-save.el, buff-menu.el, cl-extra.el, dragdrop.el, faces.el, files.el, fill.el, font-lock.el, font.el, gtk-faces.el, gui.el, help.el, hyper-apropos.el, info.el, isearch-mode.el, keymap.el, lisp-mnt.el, mouse.el, package-admin.el, package-get.el, printer.el, process.el, resize-minibuffer.el, simple.el, toolbar-items.el, wid-edit.el, win32-native.el: fix warnings.
very-early-lisp.el: update docs.
mule\chinese.el, mule\japan-util.el: fix warnings.
Makefile.in.in: Use -no-packages to avoid problems with package files shadowing
core files (e.g. unicode.el in mule-ucs).
Makefile.in.in: Use -no-packages to avoid problems with package files shadowing
core files (e.g. unicode.el in mule-ucs).
author | ben |
---|---|
date | Fri, 15 Mar 2002 07:43:43 +0000 |
parents | 0784d089fdc9 |
children | db7068430402 |
rev | line source |
---|---|
462 | 1 (defvar statusbar-hashtable (make-hashtable 29)) |
2 (defvar statusbar-gnome-p nil) | |
3 | |
4 (defmacro get-frame-statusbar (frame) | |
5 `(gethash (or ,frame (selected-frame)) statusbar-hashtable)) | |
6 | |
7 (defun add-frame-statusbar (frame) | |
8 "Stick a GTK (or GNOME) statusbar at the bottom of the frame." | |
9 (if (windowp (frame-property frame 'minibuffer)) | |
10 (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer))) | |
11 statusbar-hashtable) | |
12 (let ((sbar nil) | |
13 (shell (frame-property frame 'shell-widget))) | |
14 (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell))) | |
15 (progn | |
16 (require 'gnome-widgets) | |
17 (setq sbar (gnome-appbar-new t t 0) | |
18 statusbar-gnome-p t) | |
19 (gtk-progress-set-format-string sbar "%p%%") | |
20 (gnome-app-set-statusbar shell sbar)) | |
21 (setq sbar (gtk-statusbar-new)) | |
22 (gtk-box-pack-end (frame-property frame 'container-widget) | |
23 sbar nil nil 0)) | |
24 (puthash frame sbar statusbar-hashtable)))) | |
25 | |
26 (add-hook 'create-frame-hook 'add-frame-statusbar) | |
27 (add-hook 'delete-frame-hook (lambda (f) | |
28 (remhash f statusbar-hashtable))) | |
29 | |
30 | |
31 (defun clear-message (&optional label frame stdout-p no-restore) | |
32 (let ((sbar (get-frame-statusbar frame))) | |
33 (if sbar | |
34 (if statusbar-gnome-p | |
35 (gnome-appbar-pop sbar) | |
36 (gtk-statusbar-pop sbar 1))))) | |
37 | |
38 (defun append-message (label message &optional frame stdout-p) | |
39 (let ((sbar (get-frame-statusbar frame))) | |
40 (if sbar | |
41 (if statusbar-gnome-p | |
42 (gnome-appbar-push sbar message) | |
43 (gtk-statusbar-push sbar 1 message))))) | |
44 | |
45 (defun progress-display (fmt &optional value &rest args) | |
46 "Print a progress gauge and message in the bottom gutter area of the frame. | |
47 The arguments are the same as to `format'. | |
48 | |
49 If the only argument is nil, clear any existing progress gauge." | |
50 (let ((sbar (get-frame-statusbar nil))) | |
51 (apply 'message fmt args) | |
52 (if statusbar-gnome-p | |
53 (progn | |
54 (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t) | |
55 (gnome-appbar-set-progress sbar (/ value 100.0)) | |
56 (gdk-flush))))) | |
57 | |
58 (defun lprogress-display (label fmt &optional value &rest args) | |
59 "Print a progress gauge and message in the bottom gutter area of the frame. | |
60 First argument LABEL is an identifier for this progress gauge. The rest of the | |
61 arguments are the same as to `format'." | |
62 (if (and (null fmt) (null args)) | |
63 (prog1 nil | |
64 (clear-progress-display label nil)) | |
65 (let ((str (apply 'format fmt args))) | |
66 (progress-display str value) | |
67 str))) | |
68 | |
69 (defun clear-progress-display (&rest ignored) | |
70 (if statusbar-gnome-p | |
71 (let* ((sbar (get-frame-statusbar nil)) | |
72 (progress (gnome-appbar-get-progress sbar))) | |
73 (gnome-appbar-set-progress sbar 0) | |
74 (gtk-progress-set-show-text progress nil)))) |