Mercurial > hg > xemacs-beta
annotate tests/gtk/statusbar-test.el @ 5136:0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-03-12 Ben Wing <ben@xemacs.org>
* test-harness.el (test-harness-from-buffer):
Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...).
Get rid of `Assert-equalp' and friends, `Assert-test', and
`Assert-test-not'. Instead, make `Assert' smart enough to do the
equivalent functionality when an expression like (Assert (equalp ...))
is seen.
tests/ChangeLog addition:
2010-03-12 Ben Wing <ben@xemacs.org>
* automated/base64-tests.el (bt-base64-encode-string):
* automated/base64-tests.el (bt-base64-decode-string):
* automated/base64-tests.el (for):
* automated/byte-compiler-tests.el:
* automated/byte-compiler-tests.el (before-and-after-compile-equal):
* automated/case-tests.el (downcase-string):
* automated/case-tests.el (uni-mappings):
* automated/ccl-tests.el (ccl-test-normal-expr):
* automated/ccl-tests.el (ccl-test-map-instructions):
* automated/ccl-tests.el (ccl-test-suites):
* automated/database-tests.el (delete-database-files):
* automated/extent-tests.el (let):
* automated/extent-tests.el (insert):
* automated/extent-tests.el (props):
* automated/file-tests.el:
* automated/file-tests.el (for):
* automated/hash-table-tests.el (test):
* automated/hash-table-tests.el (for):
* automated/hash-table-tests.el (ht):
* automated/hash-table-tests.el (iterations):
* automated/hash-table-tests.el (h1):
* automated/hash-table-tests.el (equal):
* automated/hash-table-tests.el (=):
* automated/lisp-tests.el:
* automated/lisp-tests.el (eq):
* automated/lisp-tests.el (test-setq):
* automated/lisp-tests.el (my-vector):
* automated/lisp-tests.el (x):
* automated/lisp-tests.el (equal):
* automated/lisp-tests.el (y):
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (=):
* automated/lisp-tests.el (six):
* automated/lisp-tests.el (three):
* automated/lisp-tests.el (one):
* automated/lisp-tests.el (two):
* automated/lisp-tests.el (five):
* automated/lisp-tests.el (test1):
* automated/lisp-tests.el (division-test):
* automated/lisp-tests.el (for):
* automated/lisp-tests.el (check-function-argcounts):
* automated/lisp-tests.el (z):
* automated/lisp-tests.el (eql):
* automated/lisp-tests.el (test-harness-risk-infloops):
* automated/lisp-tests.el (erase-buffer):
* automated/lisp-tests.el (sym):
* automated/lisp-tests.el (new-char):
* automated/lisp-tests.el (new-load-file-name):
* automated/lisp-tests.el (cl-floor):
* automated/lisp-tests.el (foo):
* automated/md5-tests.el (lambda):
* automated/md5-tests.el (large-string):
* automated/md5-tests.el (mapcar):
* automated/md5-tests.el (insert):
* automated/mule-tests.el:
* automated/mule-tests.el (test-chars):
* automated/mule-tests.el (existing-file-name):
* automated/mule-tests.el (featurep):
* automated/query-coding-tests.el (featurep):
* automated/regexp-tests.el:
* automated/regexp-tests.el (insert):
* automated/regexp-tests.el (Assert):
* automated/regexp-tests.el (=):
* automated/regexp-tests.el (featurep):
* automated/regexp-tests.el (text):
* automated/regexp-tests.el (text1):
* automated/regexp-tests.el ("aáa"):
* automated/regexp-tests.el (eql):
* automated/search-tests.el (insert):
* automated/search-tests.el (featurep):
* automated/search-tests.el (let):
* automated/search-tests.el (boundp):
* automated/symbol-tests.el:
* automated/symbol-tests.el (name):
* automated/symbol-tests.el (check-weak-list-unique):
* automated/symbol-tests.el (string):
* automated/symbol-tests.el (list):
* automated/symbol-tests.el (foo):
* automated/symbol-tests.el (eq):
* automated/symbol-tests.el (fresh-keyword-name):
* automated/symbol-tests.el (print-gensym):
* automated/symbol-tests.el (mysym):
* automated/syntax-tests.el (test-forward-word):
* automated/syntax-tests.el (test-backward-word):
* automated/syntax-tests.el (test-syntax-table):
* automated/syntax-tests.el (with-syntax-table):
* automated/syntax-tests.el (Skip-Test-Unless):
* automated/syntax-tests.el (with):
* automated/tag-tests.el (testfile):
* automated/weak-tests.el (w):
* automated/weak-tests.el (p):
* automated/weak-tests.el (a):
Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...).
Get rid of `Assert-equalp' and friends, `Assert-test', and
`Assert-test-not'. Instead, make `Assert' smart enough to do the
equivalent functionality when an expression like (Assert (equalp ...))
is seen.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 12 Mar 2010 18:27:51 -0600 |
| parents | db7068430402 |
| children | ba07c880114a |
| 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. |
|
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
|
2 ;; |
|
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
|
3 ;; XEmacs is free software; you can redistribute it and/or modify it |
|
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 |
|
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
|
5 ;; Free Software Foundation; either version 2, or (at your option) any |
|
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
|
6 ;; later version. |
|
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
|
7 ;; |
|
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. |
|
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
|
12 ;; |
|
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 |
|
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
|
14 ;; along with XEmacs; see the file COPYING. If not, write to |
|
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 ;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
|
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
|
16 ;; Boston, MA 02111-1301, USA. */ |
|
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
|
17 |
| 462 | 18 (defvar statusbar-hashtable (make-hashtable 29)) |
| 19 (defvar statusbar-gnome-p nil) | |
| 20 | |
| 21 (defmacro get-frame-statusbar (frame) | |
| 22 `(gethash (or ,frame (selected-frame)) statusbar-hashtable)) | |
| 23 | |
| 24 (defun add-frame-statusbar (frame) | |
| 25 "Stick a GTK (or GNOME) statusbar at the bottom of the frame." | |
| 26 (if (windowp (frame-property frame 'minibuffer)) | |
| 27 (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer))) | |
| 28 statusbar-hashtable) | |
| 29 (let ((sbar nil) | |
| 30 (shell (frame-property frame 'shell-widget))) | |
| 31 (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell))) | |
| 32 (progn | |
| 33 (require 'gnome-widgets) | |
| 34 (setq sbar (gnome-appbar-new t t 0) | |
| 35 statusbar-gnome-p t) | |
| 36 (gtk-progress-set-format-string sbar "%p%%") | |
| 37 (gnome-app-set-statusbar shell sbar)) | |
| 38 (setq sbar (gtk-statusbar-new)) | |
| 39 (gtk-box-pack-end (frame-property frame 'container-widget) | |
| 40 sbar nil nil 0)) | |
| 41 (puthash frame sbar statusbar-hashtable)))) | |
| 42 | |
| 43 (add-hook 'create-frame-hook 'add-frame-statusbar) | |
| 44 (add-hook 'delete-frame-hook (lambda (f) | |
| 45 (remhash f statusbar-hashtable))) | |
| 46 | |
| 47 | |
| 48 (defun clear-message (&optional label frame stdout-p no-restore) | |
| 49 (let ((sbar (get-frame-statusbar frame))) | |
| 50 (if sbar | |
| 51 (if statusbar-gnome-p | |
| 52 (gnome-appbar-pop sbar) | |
| 53 (gtk-statusbar-pop sbar 1))))) | |
| 54 | |
| 55 (defun append-message (label message &optional frame stdout-p) | |
| 56 (let ((sbar (get-frame-statusbar frame))) | |
| 57 (if sbar | |
| 58 (if statusbar-gnome-p | |
| 59 (gnome-appbar-push sbar message) | |
| 60 (gtk-statusbar-push sbar 1 message))))) | |
| 61 | |
| 62 (defun progress-display (fmt &optional value &rest args) | |
| 63 "Print a progress gauge and message in the bottom gutter area of the frame. | |
| 64 The arguments are the same as to `format'. | |
| 65 | |
| 66 If the only argument is nil, clear any existing progress gauge." | |
| 67 (let ((sbar (get-frame-statusbar nil))) | |
| 68 (apply 'message fmt args) | |
| 69 (if statusbar-gnome-p | |
| 70 (progn | |
| 71 (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t) | |
| 72 (gnome-appbar-set-progress sbar (/ value 100.0)) | |
| 73 (gdk-flush))))) | |
| 74 | |
| 75 (defun lprogress-display (label fmt &optional value &rest args) | |
| 76 "Print a progress gauge and message in the bottom gutter area of the frame. | |
| 77 First argument LABEL is an identifier for this progress gauge. The rest of the | |
| 78 arguments are the same as to `format'." | |
| 79 (if (and (null fmt) (null args)) | |
| 80 (prog1 nil | |
| 81 (clear-progress-display label nil)) | |
| 82 (let ((str (apply 'format fmt args))) | |
| 83 (progress-display str value) | |
| 84 str))) | |
| 85 | |
| 86 (defun clear-progress-display (&rest ignored) | |
| 87 (if statusbar-gnome-p | |
| 88 (let* ((sbar (get-frame-statusbar nil)) | |
| 89 (progress (gnome-appbar-get-progress sbar))) | |
| 90 (gnome-appbar-set-progress sbar 0) | |
| 91 (gtk-progress-set-show-text progress nil)))) |