Mercurial > hg > xemacs-beta
annotate tests/gtk/statusbar-test.el @ 5407:7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Tue, 19 Oct 2010 22:33:36 +0200 |
| parents | ba07c880114a |
| children | b9167d522a9a |
| rev | line source |
|---|---|
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
1 ;; This file is part of XEmacs. |
|
5407
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
2 |
|
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
3 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
4 ;; under the terms of the GNU General Public License as published by the |
|
5407
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
5 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
6 ;; option) any later version. |
|
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
7 |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
8 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
9 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
10 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
11 ;; for more details. |
|
5407
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
12 |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
13 ;; You should have received a copy of the GNU General Public License |
|
5407
7ba892d101ce
Convert remainder in "tests" with plain text GPLv2 to GPLv3
Mats Lidell <matsl@xemacs.org>
parents:
5231
diff
changeset
|
14 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
15 |
| 462 | 16 (defvar statusbar-hashtable (make-hashtable 29)) |
| 17 (defvar statusbar-gnome-p nil) | |
| 18 | |
| 19 (defmacro get-frame-statusbar (frame) | |
| 20 `(gethash (or ,frame (selected-frame)) statusbar-hashtable)) | |
| 21 | |
| 22 (defun add-frame-statusbar (frame) | |
| 23 "Stick a GTK (or GNOME) statusbar at the bottom of the frame." | |
| 24 (if (windowp (frame-property frame 'minibuffer)) | |
| 25 (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer))) | |
| 26 statusbar-hashtable) | |
| 27 (let ((sbar nil) | |
| 28 (shell (frame-property frame 'shell-widget))) | |
| 29 (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell))) | |
| 30 (progn | |
| 31 (require 'gnome-widgets) | |
| 32 (setq sbar (gnome-appbar-new t t 0) | |
| 33 statusbar-gnome-p t) | |
| 34 (gtk-progress-set-format-string sbar "%p%%") | |
| 35 (gnome-app-set-statusbar shell sbar)) | |
| 36 (setq sbar (gtk-statusbar-new)) | |
| 37 (gtk-box-pack-end (frame-property frame 'container-widget) | |
| 38 sbar nil nil 0)) | |
| 39 (puthash frame sbar statusbar-hashtable)))) | |
| 40 | |
| 41 (add-hook 'create-frame-hook 'add-frame-statusbar) | |
| 42 (add-hook 'delete-frame-hook (lambda (f) | |
| 43 (remhash f statusbar-hashtable))) | |
| 44 | |
| 45 | |
| 46 (defun clear-message (&optional label frame stdout-p no-restore) | |
| 47 (let ((sbar (get-frame-statusbar frame))) | |
| 48 (if sbar | |
| 49 (if statusbar-gnome-p | |
| 50 (gnome-appbar-pop sbar) | |
| 51 (gtk-statusbar-pop sbar 1))))) | |
| 52 | |
| 53 (defun append-message (label message &optional frame stdout-p) | |
| 54 (let ((sbar (get-frame-statusbar frame))) | |
| 55 (if sbar | |
| 56 (if statusbar-gnome-p | |
| 57 (gnome-appbar-push sbar message) | |
| 58 (gtk-statusbar-push sbar 1 message))))) | |
| 59 | |
| 60 (defun progress-display (fmt &optional value &rest args) | |
| 61 "Print a progress gauge and message in the bottom gutter area of the frame. | |
| 62 The arguments are the same as to `format'. | |
| 63 | |
| 64 If the only argument is nil, clear any existing progress gauge." | |
| 65 (let ((sbar (get-frame-statusbar nil))) | |
| 66 (apply 'message fmt args) | |
| 67 (if statusbar-gnome-p | |
| 68 (progn | |
| 69 (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t) | |
| 70 (gnome-appbar-set-progress sbar (/ value 100.0)) | |
| 71 (gdk-flush))))) | |
| 72 | |
| 73 (defun lprogress-display (label fmt &optional value &rest args) | |
| 74 "Print a progress gauge and message in the bottom gutter area of the frame. | |
| 75 First argument LABEL is an identifier for this progress gauge. The rest of the | |
| 76 arguments are the same as to `format'." | |
| 77 (if (and (null fmt) (null args)) | |
| 78 (prog1 nil | |
| 79 (clear-progress-display label nil)) | |
| 80 (let ((str (apply 'format fmt args))) | |
| 81 (progress-display str value) | |
| 82 str))) | |
| 83 | |
| 84 (defun clear-progress-display (&rest ignored) | |
| 85 (if statusbar-gnome-p | |
| 86 (let* ((sbar (get-frame-statusbar nil)) | |
| 87 (progress (gnome-appbar-get-progress sbar))) | |
| 88 (gnome-appbar-set-progress sbar 0) | |
| 89 (gtk-progress-set-show-text progress nil)))) |