annotate src/gui.c @ 418:e804706bfb8c r21-2-17

Import from CVS: tag r21-2-17
author cvs
date Mon, 13 Aug 2007 11:23:13 +0200
parents 697ef44129c6
children 41dbb7a9d5f2
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 Copyright (C) 1995 Board of Trustees, University of Illinois.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 Copyright (C) 1995, 1996 Ben Wing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
5 Copyright (C) 1998 Free Software Foundation, Inc.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 This file is part of XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 under the terms of the GNU General Public License as published by the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 Free Software Foundation; either version 2, or (at your option) any
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 /* Synched up with: Not in FSF. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 #include <config.h>
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
27 #include "lisp.h"
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
28 #include "gui.h"
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
29 #include "elhash.h"
380
8626e4521993 Import from CVS: tag r21-2-5
cvs
parents: 377
diff changeset
30 #include "bytecode.h"
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
377
d883f39b8495 Import from CVS: tag r21-2b4
cvs
parents: 371
diff changeset
33 Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence;
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
34 Lisp_Object Q_accelerator, Q_label, Q_callback;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 Lisp_Object Qtoggle, Qradio;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
37 #ifdef HAVE_POPUPS
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
38
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
39 /* count of menus/dboxes currently up */
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
40 int popup_up_p;
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
41
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
42 DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /*
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
43 Return t if a popup menu or dialog box is up, nil otherwise.
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
44 See `popup-menu' and `popup-dialog-box'.
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
45 */
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
46 ())
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
47 {
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
48 return popup_up_p ? Qt : Qnil;
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
49 }
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
50 #endif /* HAVE_POPUPS */
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
51
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
52 int
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
53 separator_string_p (CONST char *s)
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
54 {
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
55 CONST char *p;
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
56 char first;
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
57
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
58 if (!s || s[0] == '\0')
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
59 return 0;
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
60 first = s[0];
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
61 if (first != '-' && first != '=')
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
62 return 0;
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
63 for (p = s; *p == first; p++)
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
64 ;
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
65
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
66 return (*p == '!' || *p == ':' || *p == '\0');
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
67 }
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
68
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
69 /* Massage DATA to find the correct function and argument. Used by
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
70 popup_selection_callback() and the msw code. */
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
71 void
288
e11d67e05968 Import from CVS: tag r21-0b42
cvs
parents: 286
diff changeset
72 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
73 {
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
74 if (SYMBOLP (data)
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
75 || (COMPILED_FUNCTIONP (data)
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
76 && XCOMPILED_FUNCTION (data)->flags.interactivep)
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
77 || (EQ (XCAR (data), Qlambda)
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
78 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
286
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
79 {
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
80 *fn = Qcall_interactively;
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
81 *arg = data;
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
82 }
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
83 else if (CONSP (data))
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
84 {
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
85 *fn = Qeval;
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
86 *arg = data;
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
87 }
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
88 else
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
89 {
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
90 *fn = Qeval;
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
91 *arg = list3 (Qsignal,
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
92 list2 (Qquote, Qerror),
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
93 list2 (Qquote, list2 (build_translated_string
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
94 ("illegal callback"),
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
95 data)));
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
96 }
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
97 }
57709be46d1b Import from CVS: tag r21-0b41
cvs
parents: 272
diff changeset
98
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
99 /*
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
100 * Add a value VAL associated with keyword KEY into PGUI_ITEM
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
101 * structure. If KEY is not a keyword, or is an unknown keyword, then
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
102 * error is signaled.
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
103 */
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
104 void
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
105 gui_item_add_keyval_pair (Lisp_Object gui_item,
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
106 Lisp_Object key, Lisp_Object val,
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
107 Error_behavior errb)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
108 {
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
109 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
110
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
111 if (!KEYWORDP (key))
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
112 signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
113
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
114 if (EQ (key, Q_suffix)) pgui_item->suffix = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
115 else if (EQ (key, Q_active)) pgui_item->active = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
116 else if (EQ (key, Q_included)) pgui_item->included = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
117 else if (EQ (key, Q_config)) pgui_item->config = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
118 else if (EQ (key, Q_filter)) pgui_item->filter = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
119 else if (EQ (key, Q_style)) pgui_item->style = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
120 else if (EQ (key, Q_selected)) pgui_item->selected = val;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
121 else if (EQ (key, Q_keys)) pgui_item->keys = val;
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
122 else if (EQ (key, Q_callback)) pgui_item->callback = val;
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
123 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */
377
d883f39b8495 Import from CVS: tag r21-2b4
cvs
parents: 371
diff changeset
124 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
125 else if (ERRB_EQ (errb, ERROR_ME))
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
126 signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name);
398
74fd4e045ea6 Import from CVS: tag r21-2-29
cvs
parents: 388
diff changeset
127 }
74fd4e045ea6 Import from CVS: tag r21-2-29
cvs
parents: 388
diff changeset
128
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
129 void
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
130 gui_item_init (Lisp_Object gui_item)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
131 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
132 struct Lisp_Gui_Item *lp = XGUI_ITEM (gui_item);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
133
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
134 lp->name = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
135 lp->callback = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
136 lp->suffix = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
137 lp->active = Qt;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
138 lp->included = Qt;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
139 lp->config = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
140 lp->filter = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
141 lp->style = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
142 lp->selected = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
143 lp->keys = Qnil;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
144 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
145
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
146 Lisp_Object
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
147 allocate_gui_item ()
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
148 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
149 struct Lisp_Gui_Item *lp =
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
150 alloc_lcrecord_type (struct Lisp_Gui_Item, &lrecord_gui_item);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
151 Lisp_Object val;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
152
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
153 zero_lcrecord (lp);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
154 XSETGUI_ITEM (val, lp);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
155
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
156 gui_item_init (val);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
157
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
158 return val;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
159 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
160
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
161 /*
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
162 * ITEM is a lisp vector, describing a menu item or a button. The
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
163 * function extracts the description of the item into the PGUI_ITEM
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
164 * structure.
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
165 */
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
166 static Lisp_Object
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
167 make_gui_item_from_keywords_internal (Lisp_Object item,
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
168 Error_behavior errb)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
169 {
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
170 int length, plist_p, start;
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
171 Lisp_Object *contents;
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
172 Lisp_Object gui_item = allocate_gui_item ();
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
173 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
174
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
175 CHECK_VECTOR (item);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
176 length = XVECTOR_LENGTH (item);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
177 contents = XVECTOR_DATA (item);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
178
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
179 if (length < 1)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
180 signal_simple_error ("GUI item descriptors must be at least 1 elts long", item);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
181
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
182 /* length 1: [ "name" ]
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
183 length 2: [ "name" callback ]
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
184 length 3: [ "name" callback active-p ]
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
185 or [ "name" keyword value ]
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
186 length 4: [ "name" callback active-p suffix ]
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
187 or [ "name" callback keyword value ]
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
188 length 5+: [ "name" callback [ keyword value ]+ ]
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
189 or [ "name" [ keyword value ]+ ]
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
190 */
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
191 plist_p = (length > 2 && (KEYWORDP (contents [1])
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
192 || KEYWORDP (contents [2])));
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
193
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
194 pgui_item->name = contents [0];
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
195 if (length > 1 && !KEYWORDP (contents [1]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
196 {
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
197 pgui_item->callback = contents [1];
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
198 start = 2;
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
199 }
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
200 else
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
201 start =1;
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
202
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
203 if (!plist_p && length > 2)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
204 /* the old way */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
205 {
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
206 pgui_item->active = contents [2];
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
207 if (length == 4)
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
208 pgui_item->suffix = contents [3];
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
209 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
210 else
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
211 /* the new way */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
212 {
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
213 int i;
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
214 if ((length - start) & 1)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
215 signal_simple_error (
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
216 "GUI item descriptor has an odd number of keywords and values",
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
217 item);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
218
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
219 for (i = start; i < length;)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
220 {
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
221 Lisp_Object key = contents [i++];
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
222 Lisp_Object val = contents [i++];
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
223 gui_item_add_keyval_pair (gui_item, key, val, errb);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
224 }
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
225 }
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
226 return gui_item;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
227 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
228
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
229 Lisp_Object
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
230 gui_parse_item_keywords (Lisp_Object item)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
231 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
232 return make_gui_item_from_keywords_internal (item, ERROR_ME);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
233 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
234
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
235 Lisp_Object
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
236 gui_parse_item_keywords_no_errors (Lisp_Object item)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
237 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
238 return make_gui_item_from_keywords_internal (item, ERROR_ME_NOT);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
239 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
240
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
241 /* convert a gui item into plist properties */
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
242 void
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
243 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item)
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
244 {
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
245 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
246
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
247 if (!NILP (pgui_item->callback))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
248 Fplist_put (plist, Q_callback, pgui_item->callback);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
249 if (!NILP (pgui_item->suffix))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
250 Fplist_put (plist, Q_suffix, pgui_item->suffix);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
251 if (!NILP (pgui_item->active))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
252 Fplist_put (plist, Q_active, pgui_item->active);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
253 if (!NILP (pgui_item->included))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
254 Fplist_put (plist, Q_included, pgui_item->included);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
255 if (!NILP (pgui_item->config))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
256 Fplist_put (plist, Q_config, pgui_item->config);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
257 if (!NILP (pgui_item->filter))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
258 Fplist_put (plist, Q_filter, pgui_item->filter);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
259 if (!NILP (pgui_item->style))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
260 Fplist_put (plist, Q_style, pgui_item->style);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
261 if (!NILP (pgui_item->selected))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
262 Fplist_put (plist, Q_selected, pgui_item->selected);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
263 if (!NILP (pgui_item->keys))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
264 Fplist_put (plist, Q_keys, pgui_item->keys);
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
265 }
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
266
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
267 /*
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
268 * Decide whether a GUI item is active by evaluating its :active form
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
269 * if any
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
270 */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
271 int
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
272 gui_item_active_p (Lisp_Object gui_item)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
273 {
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
274 /* This function can call lisp */
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
275
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
276 /* Shortcut to avoid evaluating Qt each time */
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
277 return (EQ (XGUI_ITEM (gui_item)->active, Qt)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
278 || !NILP (Feval (XGUI_ITEM (gui_item)->active)));
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
279 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
280
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
281 /*
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
282 * Decide whether a GUI item is selected by evaluating its :selected form
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
283 * if any
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
284 */
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
285 int
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
286 gui_item_selected_p (Lisp_Object gui_item)
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
287 {
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
288 /* This function can call lisp */
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
289
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
290 /* Shortcut to avoid evaluating Qt each time */
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
291 return (EQ (XGUI_ITEM (gui_item)->selected, Qt)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
292 || !NILP (Feval (XGUI_ITEM (gui_item)->selected)));
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
293 }
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
294
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
295 /*
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
296 * Decide whether a GUI item is included by evaluating its :included
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
297 * form if given, and testing its :config form against supplied CONFLIST
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
298 * configuration variable
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
299 */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
300 int
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
301 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
302 {
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
303 /* This function can call lisp */
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
304 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
305
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
306 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
307 if (!EQ (pgui_item->included, Qt)
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
308 && NILP (Feval (pgui_item->included)))
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
309 return 0;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
310
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
311 /* Do :config if conflist is given */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
312 if (!NILP (conflist) && !NILP (pgui_item->config)
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
313 && NILP (Fmemq (pgui_item->config, conflist)))
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
314 return 0;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
315
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
316 return 1;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
317 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
318
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
319 static DOESNT_RETURN
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
320 signal_too_long_error (Lisp_Object name)
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
321 {
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
322 signal_simple_error ("GUI item produces too long displayable string", name);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
323 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
324
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
325 #ifdef HAVE_WINDOW_SYSTEM
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
326 /*
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
327 * Format "left flush" display portion of an item into BUF, guarded by
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
328 * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
329 * null character, so actual maximum size of buffer consumed is
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
330 * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
331 * signaled.
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
332 * Return value is the offset to the terminating null character into the
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
333 * buffer.
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
334 */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
335 unsigned int
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
336 gui_item_display_flush_left (Lisp_Object gui_item,
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
337 char* buf, Bytecount buf_len)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
338 {
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
339 char *p = buf;
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
340 Bytecount len;
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
341 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
342
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
343 /* Copy item name first */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
344 CHECK_STRING (pgui_item->name);
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
345 len = XSTRING_LENGTH (pgui_item->name);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
346 if (len > buf_len)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
347 signal_too_long_error (pgui_item->name);
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
348 memcpy (p, XSTRING_DATA (pgui_item->name), len);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
349 p += len;
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
350
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
351 /* Add space and suffix, if there is a suffix.
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
352 * If suffix is not string evaluate it */
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
353 if (!NILP (pgui_item->suffix))
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
354 {
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
355 Lisp_Object suffix = pgui_item->suffix;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
356 /* Shortcut to avoid evaluating suffix each time */
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
357 if (!STRINGP (suffix))
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
358 {
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
359 suffix = Feval (suffix);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
360 CHECK_STRING (suffix);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents: 251
diff changeset
361 }
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
362
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
363 len = XSTRING_LENGTH (suffix);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
364 if (p + len + 1 > buf + buf_len)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
365 signal_too_long_error (pgui_item->name);
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
366 *(p++) = ' ';
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
367 memcpy (p, XSTRING_DATA (suffix), len);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
368 p += len;
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
369 }
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
370 *p = '\0';
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
371 return p - buf;
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
372 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
373
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
374 /*
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
375 * Format "right flush" display portion of an item into BUF, guarded by
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
376 * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
377 * null character, so actual maximum size of buffer consumed is
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
378 * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
379 * signaled.
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
380 * Return value is the offset to the terminating null character into the
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
381 * buffer.
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
382 */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
383 unsigned int
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
384 gui_item_display_flush_right (Lisp_Object gui_item,
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
385 char* buf, Bytecount buf_len)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
386 {
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
387 struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
388 *buf = 0;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
389
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
390 /* Have keys? */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
391 if (!menubar_show_keybindings)
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
392 return 0;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
393
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
394 /* Try :keys first */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
395 if (!NILP (pgui_item->keys))
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
396 {
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
397 CHECK_STRING (pgui_item->keys);
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
398 if (XSTRING_LENGTH (pgui_item->keys) > buf_len)
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
399 signal_too_long_error (pgui_item->name);
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
400 strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys));
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
401 return XSTRING_LENGTH (pgui_item->keys);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
402 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
403
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
404 /* See if we can derive keys out of callback symbol */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
405 if (SYMBOLP (pgui_item->callback))
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
406 {
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
407 char buf2 [1024];
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 259
diff changeset
408 Bytecount len;
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
409
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
410 where_is_to_char (pgui_item->callback, buf2);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
411 len = strlen (buf2);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
412 if (len > buf_len)
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
413 signal_too_long_error (pgui_item->name);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
414 strcpy (buf, buf2);
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
415 return len;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
416 }
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
417
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
418 /* No keys - no right flush display */
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
419 return 0;
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
420 }
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
421 #endif /* HAVE_WINDOW_SYSTEM */
251
677f6a0ee643 Import from CVS: tag r20-5b24
cvs
parents: 231
diff changeset
422
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
423 static Lisp_Object
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
424 mark_gui_item (Lisp_Object obj, void (*markobj) (Lisp_Object))
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
425 {
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
426 struct Lisp_Gui_Item *p = XGUI_ITEM (obj);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
427
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
428 markobj (p->name);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
429 markobj (p->callback);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
430 markobj (p->suffix);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
431 markobj (p->active);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
432 markobj (p->included);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
433 markobj (p->config);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
434 markobj (p->filter);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
435 markobj (p->style);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
436 markobj (p->selected);
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
437 markobj (p->keys);
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
438
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
439 return Qnil;
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
440 }
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
441
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
442 static unsigned long
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
443 gui_item_hash (Lisp_Object obj, int depth)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
444 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
445 struct Lisp_Gui_Item *p = XGUI_ITEM (obj);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
446
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
447 return HASH2 (HASH5 (internal_hash (p->name, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
448 internal_hash (p->callback, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
449 internal_hash (p->suffix, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
450 internal_hash (p->active, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
451 internal_hash (p->included, depth + 1)),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
452 HASH5 (internal_hash (p->config, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
453 internal_hash (p->filter, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
454 internal_hash (p->style, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
455 internal_hash (p->selected, depth + 1),
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
456 internal_hash (p->keys, depth + 1)));
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
457 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
458
412
697ef44129c6 Import from CVS: tag r21-2-14
cvs
parents: 408
diff changeset
459 int
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
460 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot)
404
2f8bb876ab1d Import from CVS: tag r21-2-32
cvs
parents: 400
diff changeset
461 {
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
462 int hashid = gui_item_hash (gitem, 0);
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
463 int id = GUI_ITEM_ID_BITS (hashid, slot);
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
464 while (!NILP (Fgethash (make_int (id),
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
465 hashtable, Qnil)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
466 {
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
467 id = GUI_ITEM_ID_BITS (id + 1, slot);
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
468 }
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
469 return id;
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents: 380
diff changeset
470 }
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
471
418
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
472 static int
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
473 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
474 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
475 struct Lisp_Gui_Item *p1 = XGUI_ITEM (obj1);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
476 struct Lisp_Gui_Item *p2 = XGUI_ITEM (obj2);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
477
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
478 if (!(internal_equal (p1->name, p2->name, depth + 1)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
479 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
480 internal_equal (p1->callback, p2->callback, depth + 1)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
481 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
482 EQ (p1->suffix, p2->suffix)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
483 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
484 EQ (p1->active, p2->active)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
485 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
486 EQ (p1->included, p2->included)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
487 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
488 EQ (p1->config, p2->config)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
489 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
490 EQ (p1->filter, p2->filter)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
491 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
492 EQ (p1->style, p2->style)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
493 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
494 EQ (p1->selected, p2->selected)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
495 &&
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
496 EQ (p1->keys, p2->keys)))
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
497 return 0;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
498 return 1;
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
499 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
500
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
501 static void
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
502 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
503 {
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
504 struct Lisp_Gui_Item *g = XGUI_ITEM (obj);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
505 char buf[20];
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
506
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
507 if (print_readably)
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
508 error ("printing unreadable object #<gui-item 0x%x>", g->header.uid);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
509
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
510 write_c_string ("#<gui-item ", printcharfun);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
511 sprintf (buf, "0x%x>", g->header.uid);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
512 write_c_string (buf, printcharfun);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
513 }
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
514
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
515 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item,
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
516 mark_gui_item, print_gui_item,
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
517 0, gui_item_equal,
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
518 gui_item_hash,
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
519 struct Lisp_Gui_Item);
e804706bfb8c Import from CVS: tag r21-2-17
cvs
parents: 412
diff changeset
520
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
521 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
522 syms_of_gui (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
523 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
524 defkeyword (&Q_active, ":active");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
525 defkeyword (&Q_suffix, ":suffix");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
526 defkeyword (&Q_keys, ":keys");
377
d883f39b8495 Import from CVS: tag r21-2b4
cvs
parents: 371
diff changeset
527 defkeyword (&Q_key_sequence,":key-sequence");
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
528 defkeyword (&Q_style, ":style");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
529 defkeyword (&Q_selected, ":selected");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
530 defkeyword (&Q_filter, ":filter");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
531 defkeyword (&Q_config, ":config");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
532 defkeyword (&Q_included, ":included");
175
2d532a89d707 Import from CVS: tag r20-3b14
cvs
parents: 0
diff changeset
533 defkeyword (&Q_accelerator, ":accelerator");
377
d883f39b8495 Import from CVS: tag r21-2b4
cvs
parents: 371
diff changeset
534 defkeyword (&Q_label, ":label");
388
aabb7f5b1c81 Import from CVS: tag r21-2-9
cvs
parents: 384
diff changeset
535 defkeyword (&Q_callback, ":callback");
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
536
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
537 defsymbol (&Qtoggle, "toggle");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
538 defsymbol (&Qradio, "radio");
231
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
539
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
540 #ifdef HAVE_POPUPS
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
541 DEFSUBR (Fpopup_up_p);
557eaa0339bf Import from CVS: tag r20-5b14
cvs
parents: 175
diff changeset
542 #endif
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
543 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
544
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
545 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
546 vars_of_gui (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
547 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
548 }