annotate tests/gtk/statusbar-test.el @ 5146:88bd4f3ef8e4

make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-15 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (c_readonly): * alloc.c (deadbeef_memory): * alloc.c (make_compiled_function): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (noseeum_make_marker): * alloc.c (ADDITIONAL_FREE_string): * alloc.c (common_init_alloc_early): * alloc.c (init_alloc_once_early): * bytecode.c (print_compiled_function): * bytecode.c (mark_compiled_function): * casetab.c: * casetab.c (print_case_table): * console.c: * console.c (print_console): * database.c (print_database): * database.c (finalize_database): * device-msw.c (sync_printer_with_devmode): * device-msw.c (print_devmode): * device-msw.c (finalize_devmode): * device.c: * device.c (print_device): * elhash.c: * elhash.c (print_hash_table): * eval.c (print_multiple_value): * eval.c (mark_multiple_value): * events.c (deinitialize_event): * events.c (print_event): * events.c (event_equal): * extents.c: * extents.c (soe_dump): * extents.c (soe_insert): * extents.c (soe_delete): * extents.c (soe_move): * extents.c (extent_fragment_update): * extents.c (print_extent_1): * extents.c (print_extent): * extents.c (vars_of_extents): * frame.c: * frame.c (print_frame): * free-hook.c: * free-hook.c (check_free): * glyphs.c: * glyphs.c (print_image_instance): * glyphs.c (print_glyph): * gui.c: * gui.c (copy_gui_item): * hash.c: * hash.c (NULL_ENTRY): * hash.c (KEYS_DIFFER_P): * keymap.c (print_keymap): * keymap.c (MARKED_SLOT): * lisp.h: * lrecord.h: * lrecord.h (LISP_OBJECT_UID): * lrecord.h (set_lheader_implementation): * lrecord.h (struct old_lcrecord_header): * lstream.c (print_lstream): * lstream.c (finalize_lstream): * marker.c (print_marker): * marker.c (marker_equal): * mc-alloc.c (visit_all_used_page_headers): * mule-charset.c: * mule-charset.c (print_charset): * objects.c (print_color_instance): * objects.c (print_font_instance): * objects.c (finalize_font_instance): * opaque.c (print_opaque): * opaque.c (print_opaque_ptr): * opaque.c (equal_opaque_ptr): * print.c (internal_object_printer): * print.c (enum printing_badness): * rangetab.c (print_range_table): * rangetab.c (range_table_equal): * specifier.c (print_specifier): * specifier.c (finalize_specifier): * symbols.c: * symbols.c (print_symbol_value_magic): * tooltalk.c: * tooltalk.c (print_tooltalk_message): * tooltalk.c (print_tooltalk_pattern): * window.c (print_window): * window.c (debug_print_window): (1) Make lrecord UID's have a separate UID space for each object. Otherwise, with 20-bit UID's, we rapidly wrap around, especially when common objects like conses and strings increment the UID value for every object created. (Originally I tried making two UID spaces, one for objects that always print readably and hence don't display the UID, and one for other objects. But certain objects like markers for which a UID is displayed are still generated rapidly enough that UID overflow is a serious issue.) This also has the advantage of making UID values smaller, hence easier to remember -- their main purpose is to make it easier to keep track of different objects of the same type when debugging code. Make sure we dump lrecord UID's so that we don't have problems with pdumped and non-dumped objects having the same UID. (2) Display UID's consistently whenever an object (a) doesn't consistently print readably (objects like cons and string, which always print readably, can't display a UID), and (b) doesn't otherwise have a unique property that makes objects of a particular type distinguishable. (E.g. buffers didn't and still don't print an ID, but the buffer name uniquely identifies the buffer.) Some types, such as event, extent, compiled-function, didn't always (or didn't ever) display an ID; others (such as marker, extent, lstream, opaque, opaque-ptr, any object using internal_object_printer()) used to display the actual machine pointer instead. (3) Rename NORMAL_LISP_OBJECT_UID to LISP_OBJECT_UID; make it work over all Lisp objects and take a Lisp object, not a struct pointer. (4) Some misc cleanups in alloc.c, elhash.c. (5) Change code in events.c that "deinitializes" an event so that it doesn't increment the event UID counter in the process. Also use deadbeef_memory() to overwrite memory instead of doing the same with custom code. In the process, make deadbeef_memory() in alloc.c always available, and delete extraneous copy in mc-alloc.c. Also capitalize all uses of 0xDEADBEEF. Similarly in elhash.c call deadbeef_memory(). (6) Resurrect "debug SOE" code in extents.c. Make it conditional on DEBUG_XEMACS and on a `debug-soe' variable, rather than on SOE_DEBUG. Make it output to stderr, not stdout. (7) Delete some custom print methods that were identical to external_object_printer().
author Ben Wing <ben@xemacs.org>
date Mon, 15 Mar 2010 16:35:38 -0500
parents db7068430402
children ba07c880114a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 (defvar statusbar-hashtable (make-hashtable 29))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 (defvar statusbar-gnome-p nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 (defmacro get-frame-statusbar (frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 `(gethash (or ,frame (selected-frame)) statusbar-hashtable))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 (defun add-frame-statusbar (frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 "Stick a GTK (or GNOME) statusbar at the bottom of the frame."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 (if (windowp (frame-property frame 'minibuffer))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 (puthash frame (get-frame-statusbar (window-frame (frame-property frame 'minibuffer)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 statusbar-hashtable)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29 (let ((sbar nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30 (shell (frame-property frame 'shell-widget)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 (if (string-match "Gnome" (gtk-type-name (gtk-object-type shell)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 (require 'gnome-widgets)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 (setq sbar (gnome-appbar-new t t 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 statusbar-gnome-p t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 (gtk-progress-set-format-string sbar "%p%%")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37 (gnome-app-set-statusbar shell sbar))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 (setq sbar (gtk-statusbar-new))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 (gtk-box-pack-end (frame-property frame 'container-widget)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40 sbar nil nil 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 (puthash frame sbar statusbar-hashtable))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 (add-hook 'create-frame-hook 'add-frame-statusbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44 (add-hook 'delete-frame-hook (lambda (f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 (remhash f statusbar-hashtable)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 (defun clear-message (&optional label frame stdout-p no-restore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 (let ((sbar (get-frame-statusbar frame)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 (if sbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 (gnome-appbar-pop sbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (gtk-statusbar-pop sbar 1)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 (defun append-message (label message &optional frame stdout-p)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 (let ((sbar (get-frame-statusbar frame)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 (if sbar
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 (gnome-appbar-push sbar message)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 (gtk-statusbar-push sbar 1 message)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (defun progress-display (fmt &optional value &rest args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 "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
64 The arguments are the same as to `format'.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 If the only argument is nil, clear any existing progress gauge."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 (let ((sbar (get-frame-statusbar nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68 (apply 'message fmt args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 (progn
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 (gtk-progress-set-show-text (gnome-appbar-get-progress sbar) t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 (gnome-appbar-set-progress sbar (/ value 100.0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 (gdk-flush)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 (defun lprogress-display (label fmt &optional value &rest args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 "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
77 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
78 arguments are the same as to `format'."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 (if (and (null fmt) (null args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 (prog1 nil
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 (clear-progress-display label nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 (let ((str (apply 'format fmt args)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 (progress-display str value)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 str)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 (defun clear-progress-display (&rest ignored)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 (if statusbar-gnome-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 (let* ((sbar (get-frame-statusbar nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 (progress (gnome-appbar-get-progress sbar)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 (gnome-appbar-set-progress sbar 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 (gtk-progress-set-show-text progress nil))))