annotate tests/gtk/statusbar-test.el @ 1410:44de306310b8

[xemacs-hg @ 2003-04-14 03:40:26 by youngs] 2003-04-14 Steve Youngs <youngs@xemacs.org> * package-admin.el (package-admin-find-top-directory): Use 'directory-sep-char'. (package-admin-get-install-dir): Ditto. This is so PUI won't break on platforms that don't use '/' as the directory separator. * package-get.el (package-get-pgp-available-p): New. (package-get-require-signed-base-updates): Use it. (package-get-update-base-from-buffer): Move the code that finds the gpg stuff into `package-get-pgp-available-p'. Now if you have Mailcrypt and a PGP binary installed and set up on your system, PUI will automatically default to doing PGP verification, otherwise it'll default to off. (package-get-require-base): Use the DATUM arg to `error'. (package-get-locate-index-file): Ditto. (package-get-update-base): Ditto. (package-get-update-base-entries): Ditto. (package-get-all): Ditto. (package-get-dependencies): Ditto. (package-get-info): Ditto. (package-get): Ditto. * package-info.el (batch-update-package-info): Use the DATUM arg to `error'. * package-net.el (package-net-batch-generate-bin-ini): Use the DATUM arg to `error'. * package-ui.el (pui-toggle-package-key): Use the DATUM arg to `error'. (pui-toggle-package-delete-key): Ditto. (pui-install-selected-packages): Ditto. (pui-add-required-packages): Ditto. (pui-display-info): Ditto. (list-packages-mode): Ditto. * packages.el (package-require): Use the DATUM arg to `error'.
author youngs
date Mon, 14 Apr 2003 03:40:27 +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))))