Mercurial > hg > xemacs-beta

comparison src/gui.c @ 251:677f6a0ee643 r20-5b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b24
author cvs
date Mon, 13 Aug 2007 10:19:59 +0200
parents 557eaa0339bf
children 11cf20601dec
comparison
equal deleted inserted replaced
250:f385a461c9aa 251:677f6a0ee643
21 Boston, MA 02111-1307, USA. */ 21 Boston, MA 02111-1307, USA. */
22 22
23 /* Synched up with: Not in FSF. */ 23 /* Synched up with: Not in FSF. */
24 24
25 #include <config.h> 25 #include <config.h>
26 #include "lisp.h"
26 #include "gui.h" 27 #include "gui.h"
27 #include "lisp.h"
28 28
29 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; 29 Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected;
30 Lisp_Object Q_filter, Q_config, Q_included; 30 Lisp_Object Q_filter, Q_config, Q_included;
31 Lisp_Object Q_accelerator; 31 Lisp_Object Q_accelerator;
32 Lisp_Object Qtoggle, Qradio; 32 Lisp_Object Qtoggle, Qradio;
58 return 0; 58 return 0;
59 for (p = s; *p == first; p++); 59 for (p = s; *p == first; p++);
60 60
61 if (*p == '!' || *p == ':' || *p == '\0') 61 if (*p == '!' || *p == ':' || *p == '\0')
62 return 1; 62 return 1;
63 return 0;
64 }
65
66 /*
67 * Initialize the gui_item structure by setting all (GC-protected)
68 * fields to their default values. The defaults are t for :active and
69 * :included values, and nil for others.
70 */
71 void
72 gui_item_init (struct gui_item *pgui_item)
73 {
74 pgui_item->name = Qnil;
75 pgui_item->callback = Qnil;
76 pgui_item->suffix = Qnil;
77 pgui_item->active = Qt;
78 pgui_item->included = Qt;
79 pgui_item->config = Qunbound;
80 pgui_item->filter = Qnil;
81 pgui_item->style = Qnil;
82 pgui_item->selected = Qnil;
83 pgui_item->keys = Qnil;
84 }
85
86 /*
87 * Add a value VAL associated with keyword KEY into PGUI_ITEM
88 * structure. If KEY is not a keyword, or is an unknown keyword, then
89 * error is signaled.
90 */
91 void
92 gui_item_add_keyval_pair (struct gui_item *pgui_item,
93 Lisp_Object key, Lisp_Object val)
94 {
95 if (!KEYWORDP (key))
96 error ("Not a keyword %S in gui item %S", key, pgui_item->name);
97
98 if (EQ (key, Q_suffix))
99 pgui_item->suffix = val;
100 else if (EQ (key, Q_active))
101 pgui_item->active = val;
102 else if (EQ (key, Q_included))
103 pgui_item->included = val;
104 else if (EQ (key, Q_config))
105 pgui_item->config = val;
106 else if (EQ (key, Q_filter))
107 pgui_item->filter = val;
108 else if (EQ (key, Q_style))
109 pgui_item->style = val;
110 else if (EQ (key, Q_selected))
111 pgui_item->selected = val;
112 else if (EQ (key, Q_keys))
113 pgui_item->keys = val;
114 else
115 error ("Unknown keyword %S in gui item %S", key, pgui_item->name);
116 }
117
118 /*
119 * ITEM is a lisp vector, describing a menu item or a button. The
120 * function extracts the description of the item into the PGUI_ITEM
121 * structure.
122 */
123 void
124 gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item)
125 {
126 int length, plist_p;
127 Lisp_Object *contents;
128
129 CHECK_VECTOR (item);
130 length = XVECTOR_LENGTH (item);
131 contents = XVECTOR_DATA (item);
132
133 if (length < 3)
134 signal_simple_error ("GUI item descriptors must be at least 3 elts long", item);
135
136 /* length 3: [ "name" callback active-p ]
137 length 4: [ "name" callback active-p suffix ]
138 or [ "name" callback keyword value ]
139 length 5+: [ "name" callback [ keyword value ]+ ]
140 */
141 plist_p = (length >= 5 || KEYWORDP (contents [2]));
142
143 pgui_item->name = contents [0];
144 pgui_item->callback = contents [1];
145
146 if (!plist_p)
147 /* the old way */
148 {
149 pgui_item->active = contents [2];
150 if (length == 4)
151 pgui_item->suffix = contents [3];
152 }
153 else
154 /* the new way */
155 {
156 int i;
157 if (length & 1)
158 signal_simple_error (
159 "GUI item descriptor has an odd number of keywords and values",
160 item);
161
162 for (i = 2; i < length;)
163 {
164 Lisp_Object key = contents [i++];
165 Lisp_Object val = contents [i++];
166 gui_item_add_keyval_pair (pgui_item, key, val);
167 }
168 }
169 }
170
171 /*
172 * Decide whether a GUI item is active by evaluating its :active form
173 * if any
174 */
175 int
176 gui_item_active_p (CONST struct gui_item *pgui_item)
177 {
178 /* This function can call lisp */
179
180 /* Shortcut to avoid evaluating Qt each time */
181 return (EQ (pgui_item->active, Qt)
182 || !NILP (Feval (pgui_item->active)));
183 }
184
185 /*
186 * Decide whether a GUI item is included by evaluating its :included
187 * form if given, and testing its :config form against supplied CONFLIST
188 * configuration variable
189 */
190 int
191 gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist)
192 {
193 /* This function can call lisp */
194
195 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
196 if (!EQ (pgui_item->included, Qt)
197 && NILP (Feval (pgui_item->included)))
198 return 0;
199
200 /* Do :config if conflist is given */
201 if (!NILP (conflist) && !NILP (pgui_item->config)
202 && NILP (Fmemq (pgui_item->config, conflist)))
203 return 0;
204
205 return 1;
206 }
207
208 static DOESNT_RETURN
209 signal_too_long_error (Lisp_Object name)
210 {
211 error ("GUI item %s produces too long displayable string", name);
212 }
213
214 /*
215 * Format "left flush" display portion of an item into BUF, guarded by
216 * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
217 * null character, so actual maximum size of buffer consumed is
218 * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
219 * signaled.
220 * Return value is the offset to the terminating null character into the
221 * buffer.
222 */
223 unsigned int
224 gui_item_display_flush_left (CONST struct gui_item *pgui_item,
225 char* buf, unsigned int buf_len)
226 {
227 unsigned int consumed;
228
229 /* Copy item name first */
230 CHECK_STRING (pgui_item->name);
231 if (XSTRING_LENGTH (pgui_item->name) > buf_len)
232 signal_too_long_error (pgui_item->name);
233 strcpy (buf, XSTRING_DATA (pgui_item->name));
234 buf += (consumed = XSTRING_LENGTH (pgui_item->name));
235 buf_len -= consumed;
236
237 /* Add space and suffix text, if there is a suffix */
238 if (!NILP (pgui_item->suffix))
239 {
240 if (XSTRING_LENGTH (pgui_item->suffix) + 1 > buf_len)
241 signal_too_long_error (pgui_item->name);
242 *(buf++) = ' ';
243 strcpy (buf, XSTRING_DATA (pgui_item->suffix));
244 consumed += XSTRING_LENGTH (pgui_item->suffix) + 1;
245 }
246
247 return consumed;
248 }
249
250 /*
251 * Format "right flush" display portion of an item into BUF, guarded by
252 * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
253 * null character, so actual maximum size of buffer consumed is
254 * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
255 * signaled.
256 * Return value is the offset to the terminating null character into the
257 * buffer.
258 */
259 unsigned int
260 gui_item_display_flush_right (CONST struct gui_item *pgui_item,
261 char* buf, unsigned int buf_len)
262 {
263 *buf = 0;
264
265 /* Have keys? */
266 if (!menubar_show_keybindings)
267 return 0;
268
269 /* Try :keys first */
270 if (!NILP (pgui_item->keys))
271 {
272 CHECK_STRING (pgui_item->keys);
273 if (XSTRING_LENGTH (pgui_item->keys) > buf_len)
274 signal_too_long_error (pgui_item->name);
275 strcpy (buf, XSTRING_DATA (pgui_item->keys));
276 return XSTRING_LENGTH (pgui_item->keys);
277 }
278
279 /* See if we can derive keys out of callback symbol */
280 if (SYMBOLP (pgui_item->callback))
281 {
282 char buf2 [1024];
283 unsigned int len;
284
285 where_is_to_char (pgui_item->callback, buf2);
286 len = strlen (buf2);
287 if (len > buf_len)
288 signal_too_long_error (pgui_item->name);
289 strcpy (buf, buf2);
290 return len;
291 }
292
293 /* No keys - no right flush display */
63 return 0; 294 return 0;
64 } 295 }
65 296
66 #endif /* HAVE_POPUPS */ 297 #endif /* HAVE_POPUPS */
67 298