annotate tests/gtk/statusbar-test.el @ 1123:37bdd24225ef

[xemacs-hg @ 2002-11-27 07:15:02 by ben] bug fixes, profiling debugging improvements configure.in: Check for GCC version and only use -Wpacked in v3. .cvsignore: Add .idb, .ilk for MS Windows VC++. cl-macs.el: Document better. cmdloop.el: Removed. Remove nonworking breakpoint-on-error now that debug-on-error works as documented. help.el: Extract out with-displaying-help-buffer into a more general mechanism. lib-complete.el: Support thunks in find-library-source-path. startup.el: Don't catch errors when noninteractive, because that makes stack traces from stack-trace-on-error useless. .cvsignore: Windows shit. alloc.c: Better redisplay-related assert. elhash.c: Comment change. eval.c: Don't generate large warning strings (e.g. backtraces) when they will be discarded. Implement debug-on-error as documented -- it will enter the debugger and crash when an uncaught signal happens noninteractively and we are --debug. Better redisplay-related asserts. frame-msw.c, frame.c, lisp.h, redisplay.c, scrollbar-gtk.c, scrollbar-x.c, signal.c, sysdep.c: Fix up documentation related to QUIT (which CANNOT garbage-collect under any circumstances), and to redisplay critical sections. lread.c: Add load-ignore-out-of-date-elc-files, load-always-display-messages, load-show-full-path-in-messages for more robust package compilation and debugging. profile.c: Overhaul profile code. Change format to include call count and be extensible for further info. Remove call-count-profile-table. Add set-profiling-info. See related profile.el changes (which SHOULD ABSOLUTELY be in the core! Get rid of xemacs-devel and xemacs-base packages *yesterday*!).
author ben
date Wed, 27 Nov 2002 07:15:36 +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))))