annotate tests/glyph-test.el @ 5169:6c6d78781d59

cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-24 Ben Wing <ben@xemacs.org> * array.h: * array.h (XD_LISP_DYNARR_DESC): * dumper.c (pdump_register_sub): * dumper.c (pdump_store_new_pointer_offsets): * dumper.c (pdump_reloc_one_mc): * elhash.c: * gc.c (lispdesc_one_description_line_size): * gc.c (kkcc_marking): * lrecord.h: * lrecord.h (IF_NEW_GC): * lrecord.h (enum memory_description_type): * lrecord.h (enum data_description_entry_flags): * lrecord.h (struct opaque_convert_functions): Rename XD_LISP_OBJECT_BLOCK_PTR to XD_INLINE_LISP_OBJECT_BLOCK_PTR and document it in lrecord.h. * data.c: * data.c (finish_marking_weak_lists): * data.c (continue_marking_ephemerons): * data.c (finish_marking_ephemerons): * elhash.c (MARK_OBJ): * gc.c: * gc.c (lispdesc_indirect_count_1): * gc.c (struct): * gc.c (kkcc_bt_push): * gc.c (kkcc_gc_stack_push): * gc.c (kkcc_gc_stack_push_lisp_object): * gc.c (kkcc_gc_stack_repush_dirty_object): * gc.c (KKCC_DO_CHECK_FREE): * gc.c (mark_object_maybe_checking_free): * gc.c (mark_struct_contents): * gc.c (mark_lisp_object_block_contents): * gc.c (register_for_finalization): * gc.c (mark_object): * gc.h: * lisp.h: * profile.c: * profile.c (mark_profiling_info_maphash): Clean up KKCC code related to DEBUG_XEMACS. Rename kkcc_backtrace() to kkcc_backtrace_1() and add two params: a `size' arg to control how many stack elements to print and a `detailed' arg to control whether Lisp objects are printed using `debug_print()'. Create front-ends to kkcc_backtrace_1() -- kkcc_detailed_backtrace(), kkcc_short_backtrace(), kkcc_detailed_backtrace_full(), kkcc_short_backtrace_full(), as well as shortened versions kbt(), kbts(), kbtf(), kbtsf() -- to call it with various parameter values. Add an `is_lisp' field to the stack and backtrace structures and use it to keep track of whether an object pushed onto the stack is a Lisp object or a non-Lisp structure; in kkcc_backtrace_1(), don't try to print a non-Lisp structure as a Lisp object. * elhash.c: * extents.c: * file-coding.c: * lrecord.h: * lrecord.h (IF_NEW_GC): * marker.c: * marker.c (Fmarker_buffer): * mule-coding.c: * number.c: * rangetab.c: * specifier.c: New macros IF_OLD_GC(), IF_NEW_GC() to simplify declaration of Lisp objects when a finalizer may exist in one but not the other. Use them appropriately. * extents.c (finalize_extent_info): Don't zero out data->soe and data->extents before trying to free, else we get memory leaks. * lrecord.h (enum lrecord_type): Make the first lrecord type have value 1 not 0 so that 0 remains without implementation and attempts to interpret zeroed memory as a Lisp object will be more obvious. * array.c (Dynarr_free): * device-msw.c (msprinter_delete_device): * device-tty.c (free_tty_device_struct): * device-tty.c (tty_delete_device): * dialog-msw.c (handle_directory_dialog_box): * dialog-x.c: * emacs.c (free_argc_argv): * emodules.c (attempt_module_delete): * file-coding.c (chain_finalize_coding_stream_1): * file-coding.c (chain_finalize_coding_stream): * glyphs-eimage.c: * glyphs-eimage.c (jpeg_instantiate_unwind): * glyphs-eimage.c (gif_instantiate_unwind): * glyphs-eimage.c (png_instantiate_unwind): * glyphs-eimage.c (tiff_instantiate_unwind): * imgproc.c: * imgproc.c (build_EImage_quantable): * insdel.c (uninit_buffer_text): * mule-coding.c (iso2022_finalize_detection_state): * objects-tty.c (tty_finalize_color_instance): * objects-tty.c (tty_finalize_font_instance): * objects-tty.c (tty_font_list): * process.c: * process.c (finalize_process): * redisplay.c (add_propagation_runes): * scrollbar-gtk.c: * scrollbar-gtk.c (gtk_free_scrollbar_instance): * scrollbar-gtk.c (gtk_release_scrollbar_instance): * scrollbar-msw.c: * scrollbar-msw.c (mswindows_free_scrollbar_instance): * scrollbar-msw.c (unshow_that_mofo): * scrollbar-x.c (x_free_scrollbar_instance): * scrollbar-x.c (x_release_scrollbar_instance): * select-x.c: * select-x.c (x_handle_selection_request): * syntax.c: * syntax.c (uninit_buffer_syntax_cache): * text.h (eifree): If possible, whenever we call xfree() on a field in a structure, set the field to 0 afterwards. A lot of code is written so that it checks the value being freed to see if it is non-zero before freeing it -- doing this and setting the value to 0 afterwards ensures (a) we won't try to free twice if the cleanup code is called twice; (b) if the object itself stays around, KKCC won't crash when attempting to mark the freed field. * rangetab.c: Add a finalization method when not NEW_GC to avoid memory leaks. (#### We still get memory leaks when NEW_GC; need to convert gap array to Lisp object).
author Ben Wing <ben@xemacs.org>
date Wed, 24 Mar 2010 01:22:51 -0500
parents 8a653fbe5c27
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
4781
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
1 ;;; Copyright (C) 1998 Andy Piper
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
2
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
3 ;;; This file is part of XEmacs.
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
4
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
5 ;;; XEmacs is free software; you can redistribute it and/or modify it
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
6 ;;; under the terms of the GNU General Public License as published by
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
7 ;;; the Free Software Foundation; either version 2, or (at your
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
8 ;;; option) any later version.
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
9
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
10 ;;; XEmacs is distributed in the hope that it will be useful, but
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
11 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
13 ;;; General Public License for more details.
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
14
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
15 ;;; You should have received a copy of the GNU General Public License
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
16 ;;; along with XEmacs; see the file COPYING. If not, write to the Free
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
17 ;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
18 ;;; Boston, MA 02110-1301, USA.
8a653fbe5c27 Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents: 462
diff changeset
19
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
22 (setq im (make-glyph [xbm :file "xemacsicon.xbm"])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
24 (set-extent-begin-glyph
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
25 (make-extent (point) (point))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
26 (make-glyph [string :data "xemacs"]))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
27
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 (defun foo ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 (setq ok-select (not ok-select)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 (defun fee () (interactive) (message "hello"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; button in a group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 (setq ok-select nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
38 (make-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
39 (setq radio-button1
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
40 [button :face widget
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
41 :descriptor ["ok1" (setq ok-select t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 :style radio :selected ok-select]])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; button in a group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
46 (make-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
47 (setq radio-button2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
48 [button :descriptor ["ok2" (setq ok-select nil) :style radio
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 :selected (not ok-select)]])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; toggle button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (setq tbutton
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
54 (make-glyph [button :descriptor ["ok3" (setq ok-select nil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 :style toggle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 :selected (not ok-select)]])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
59 (make-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
60 (setq toggle-button
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
61 [button :descriptor ["ok4" :style toggle
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
62 :callback
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
63 (setq ok-select (not ok-select))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
64 :selected ok-select]])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; normal pushbutton
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (setq push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (make-glyph [button :width 10 :height 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 :face modeline-mousable
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
72 :descriptor "ok" :callback foo
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 :selected t])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; tree view
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (setq tree (make-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 [tree-view :width 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 :descriptor "My Tree"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
80 :items (["One" foo]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
81 (["Two" foo]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
82 ["Four" foo]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
83 "Six")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
84 "Three")])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;; tab control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (setq tab (make-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 [tab-control :descriptor "My Tab"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 :face highlight
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
92 :orientation right
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
93 :items (["One" foo :selected t]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
94 ["Two" fee :selected nil]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
95 ["Three" foo :selected nil])])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ;; progress gauge
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (setq pgauge (make-glyph
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
101 [progress-gauge :width 10 :height 2 :value 0
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 :descriptor "ok"])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 ;; progress the progress ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (let ((x 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (while (<= x 100)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
106 (set-glyph-image pgauge `[progress-gauge :width 10 :height 2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
107 :descriptor "ok" :value ,x])
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (setq x (+ x 5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (sit-for 0.1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 ;; progress gauge in the modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (setq global-mode-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (cons (make-extent nil nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (setq pg (make-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 [progress-gauge :width 5 :pixel-height 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 :descriptor "ok"]))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 ;; progress the progress ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (let ((x 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (while (<= x 100)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
120 (set-glyph-image pg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
121 `[progress-gauge :width 5 :pixel-height 16
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
122 :descriptor "ok" :value ,x])
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (setq x (+ x 5))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
124 (redisplay-frame)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (sit-for 0.1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (make-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 [button :face modeline-mousable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 :descriptor "ok" :callback foo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 :image [xpm :file "../etc/xemacs-icon.xpm"]]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 ;; normal pushbutton
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (make-extent (point) (point))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
137 (setq pbutton
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
138 (make-glyph [button :descriptor ["A Big Button" foo ]])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 ;; edit box
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
143 (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 :face bold-italic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 :descriptor ["Hello"]])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 ;; combo box
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
149 (make-glyph (setq combo-box
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
150 [combo-box :width 10 :descriptor ["Hello"]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
151 :items ("One" "Two" "Three")])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 ;; label
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
156 (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 ;; string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (make-extent (point) (point))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
161 (make-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
162 (setq str
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
163 [string :data "Hello There"])))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 ;; scrollbar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 ;(set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 ; (make-extent (point) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 ;; generic subwindow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (set-extent-begin-glyph (make-extent (point) (point)) sw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 ;; layout
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (setq layout
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (make-glyph
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
177 `[layout :descriptor "The Layout"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
178 :orientation vertical
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
179 :justify left
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
180 :border [string :data "Hello There Mrs"]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
181 :items ([layout :orientation horizontal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
182 :items (,radio-button1 ,radio-button2)]
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
183 ,edit-field ,toggle-button ,label ,str)]))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
184 ;(set-glyph-face layout 'gui-element)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (set-extent-begin-glyph
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (make-extent (point) (point)) layout)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
187
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
188 ;; another test layout
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
189 (set-extent-begin-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
190 (make-extent (point) (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
191 (setq layout-2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
192 (make-glyph `[layout :descriptor "The Layout"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
193 :orientation vertical
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
194 :items ([progress-gauge :value 0 :width 10 :height 2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
195 :descriptor "ok"])])))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
196
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
197 (set-glyph-image layout-2 `[layout :descriptor "The Layout"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
198 :orientation vertical
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
199 :items ([progress-gauge :value 4 :width 10 :height 2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 438
diff changeset
200 :descriptor "ok"])])
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
201 (setq test-toggle-widget nil)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
202
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
203 (defun test-toggle (widget)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
204 (set-extent-begin-glyph
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
205 (make-extent (point) (point))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
206 (make-glyph (vector 'button
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
207 :descriptor "ok"
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
208 :style 'toggle
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
209 :selected `(funcall test-toggle-value
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
210 ,widget)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
211 :callback `(funcall test-toggle-action
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
212 ,widget)))))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
213
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
214 (defun test-toggle-action (widget &optional event)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
215 (if widget
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
216 (message "Widget is t")
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
217 (message "Widget is nil")))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
218
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
219 (defun test-toggle-value (widget)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
220 (setq widget (not widget))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
221 (not widget))