annotate tests/gtk/statusbar-test.el @ 1559:9bf5135fc04f

[xemacs-hg @ 2003-07-04 07:16:25 by michaels] 2003-07-02 Mike Sperber <mike@xemacs.org> * toolbar.c (update_frame_toolbars_geometry): Update the frame size when correct information to compute it is actually available. Moreover, do it right via the frame method if it's available.
author michaels
date Fri, 04 Jul 2003 07:16:26 +0000
parents 0784d089fdc9
children db7068430402
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 (defvar statusbar-hashtable (make-hashtable 29))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2 (defvar statusbar-gnome-p nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
3
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
4 (defmacro get-frame-statusbar (frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
5 `(gethash (or ,frame (selected-frame)) statusbar-hashtable))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7 (defun add-frame-statusbar (frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 "Stick a GTK (or GNOME) statusbar at the bottom of the frame."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9 (if (windowp (frame-property frame 'minibuffer))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10 (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 statusbar-hashtable)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12 (let ((sbar nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 (shell (frame-property frame 'shell-widget)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14 (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 (require 'gnome-widgets)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17 (setq sbar (gnome-appbar-new t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 statusbar-gnome-p t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 (gtk-progress-set-format-string sbar "%p%%")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 (gnome-app-set-statusbar shell sbar))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 (setq sbar (gtk-statusbar-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 (gtk-box-pack-end (frame-property frame 'container-widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 sbar nil nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 (puthash frame sbar statusbar-hashtable))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 (add-hook 'create-frame-hook 'add-frame-statusbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 (add-hook 'delete-frame-hook (lambda (f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 (remhash f statusbar-hashtable)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 (defun clear-message (&optional label frame stdout-p no-restore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 (let ((sbar (get-frame-statusbar frame)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 (if sbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 (gnome-appbar-pop sbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 (gtk-statusbar-pop sbar 1)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 (defun append-message (label message &optional frame stdout-p)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 (let ((sbar (get-frame-statusbar frame)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40 (if sbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42 (gnome-appbar-push sbar message)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 (gtk-statusbar-push sbar 1 message)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 (defun progress-display (fmt &optional value &rest args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 "Print a progress gauge and message in the bottom gutter area of the frame.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47 The arguments are the same as to `format'.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 If the only argument is nil, clear any existing progress gauge."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 (let ((sbar (get-frame-statusbar nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 (apply 'message fmt args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 (gnome-appbar-set-progress sbar (/ value 100.0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 (gdk-flush)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 (defun lprogress-display (label fmt &optional value &rest args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 "Print a progress gauge and message in the bottom gutter area of the frame.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 First argument LABEL is an identifier for this progress gauge. The rest of the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 arguments are the same as to `format'."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (if (and (null fmt) (null args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 (prog1 nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 (clear-progress-display label nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 (let ((str (apply 'format fmt args)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 (progress-display str value)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 str)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 (defun clear-progress-display (&rest ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 (let* ((sbar (get-frame-statusbar nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 (progress (gnome-appbar-get-progress sbar)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 (gnome-appbar-set-progress sbar 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 (gtk-progress-set-show-text progress nil))))