Mercurial > emacs
comparison src/w32menu.c @ 13434:53ba95a88cf2
Initial revision
author | Geoff Voelker <voelker@cs.washington.edu> |
---|---|
date | Tue, 07 Nov 1995 07:52:28 +0000 |
parents | |
children | 621a575db6f7 |
comparison
equal
deleted
inserted
replaced
13433:21a9f15132d7 | 13434:53ba95a88cf2 |
---|---|
1 /* X Communication module for terminals which understand the X protocol. | |
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. | |
3 | |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
8 the Free Software Foundation; either version 2, or (at your option) | |
9 any later version. | |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 /* Written by Kevin Gallo. */ | |
21 | |
22 #include <signal.h> | |
23 #include <config.h> | |
24 | |
25 #include <stdio.h> | |
26 #include "lisp.h" | |
27 #include "termhooks.h" | |
28 #include "frame.h" | |
29 #include "window.h" | |
30 #include "keyboard.h" | |
31 #include "blockinput.h" | |
32 | |
33 /* This may include sys/types.h, and that somehow loses | |
34 if this is not done before the other system files. */ | |
35 #include "w32term.h" | |
36 | |
37 /* Load sys/types.h if not already loaded. | |
38 In some systems loading it twice is suicidal. */ | |
39 #ifndef makedev | |
40 #include <sys/types.h> | |
41 #endif | |
42 | |
43 #include "dispextern.h" | |
44 | |
45 #define min(x, y) (((x) < (y)) ? (x) : (y)) | |
46 #define max(x, y) (((x) > (y)) ? (x) : (y)) | |
47 | |
48 typedef struct menu_map | |
49 { | |
50 Lisp_Object menu_items; | |
51 int menu_items_allocated; | |
52 int menu_items_used; | |
53 } menu_map; | |
54 | |
55 extern Lisp_Object Qmenu_enable; | |
56 extern Lisp_Object Qmenu_bar; | |
57 | |
58 static Lisp_Object win32_dialog_show (); | |
59 static Lisp_Object win32menu_show (); | |
60 | |
61 static HMENU keymap_panes (); | |
62 static HMENU single_keymap_panes (); | |
63 static HMENU list_of_panes (); | |
64 static HMENU list_of_items (); | |
65 | |
66 static HMENU create_menu_items (); | |
67 | |
68 /* Initialize the menu_items structure if we haven't already done so. | |
69 Also mark it as currently empty. */ | |
70 | |
71 static void | |
72 init_menu_items (lpmm) | |
73 menu_map * lpmm; | |
74 { | |
75 if (NILP (lpmm->menu_items)) | |
76 { | |
77 lpmm->menu_items_allocated = 60; | |
78 lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated), | |
79 Qnil); | |
80 } | |
81 | |
82 lpmm->menu_items_used = 0; | |
83 } | |
84 | |
85 /* Call when finished using the data for the current menu | |
86 in menu_items. */ | |
87 | |
88 static void | |
89 discard_menu_items (lpmm) | |
90 menu_map * lpmm; | |
91 { | |
92 lpmm->menu_items = Qnil; | |
93 lpmm->menu_items_allocated = lpmm->menu_items_used = 0; | |
94 } | |
95 | |
96 /* Make the menu_items vector twice as large. */ | |
97 | |
98 static void | |
99 grow_menu_items (lpmm) | |
100 menu_map * lpmm; | |
101 { | |
102 Lisp_Object new; | |
103 int old_size = lpmm->menu_items_allocated; | |
104 | |
105 lpmm->menu_items_allocated *= 2; | |
106 new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil); | |
107 bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents, | |
108 old_size * sizeof (Lisp_Object)); | |
109 | |
110 lpmm->menu_items = new; | |
111 } | |
112 | |
113 /* Indicate boundary between left and right. */ | |
114 | |
115 static void | |
116 add_left_right_boundary (hmenu) | |
117 HMENU hmenu; | |
118 { | |
119 AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL); | |
120 } | |
121 | |
122 /* Push one menu item into the current pane. | |
123 NAME is the string to display. ENABLE if non-nil means | |
124 this item can be selected. KEY is the key generated by | |
125 choosing this item. EQUIV is the textual description | |
126 of the keyboard equivalent for this item (or nil if none). */ | |
127 | |
128 static void | |
129 add_menu_item (lpmm, hmenu, name, enable, key) | |
130 menu_map * lpmm; | |
131 HMENU hmenu; | |
132 Lisp_Object name; | |
133 UINT enable; | |
134 Lisp_Object key; | |
135 { | |
136 UINT fuFlags; | |
137 | |
138 if (NILP (name) | |
139 || ((char *) XSTRING (name)->data)[0] == 0 | |
140 || strcmp ((char *) XSTRING (name)->data, "--") == 0) | |
141 fuFlags = MF_SEPARATOR; | |
142 else if (enable) | |
143 fuFlags = MF_STRING; | |
144 else | |
145 fuFlags = MF_STRING | MF_GRAYED; | |
146 | |
147 AppendMenu (hmenu, | |
148 fuFlags, | |
149 lpmm->menu_items_used + 1, | |
150 (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data); | |
151 | |
152 lpmm->menu_items_used++; | |
153 #if 0 | |
154 if (lpmm->menu_items_used >= lpmm->menu_items_allocated) | |
155 grow_menu_items (lpmm); | |
156 | |
157 XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++], | |
158 Lisp_Cons, | |
159 key); | |
160 #endif | |
161 } | |
162 | |
163 /* Figure out the current keyboard equivalent of a menu item ITEM1. | |
164 The item string for menu display should be ITEM_STRING. | |
165 Store the equivalent keyboard key sequence's | |
166 textual description into *DESCRIP_PTR. | |
167 Also cache them in the item itself. | |
168 Return the real definition to execute. */ | |
169 | |
170 static Lisp_Object | |
171 menu_item_equiv_key (item_string, item1, descrip_ptr) | |
172 Lisp_Object item_string; | |
173 Lisp_Object item1; | |
174 Lisp_Object *descrip_ptr; | |
175 { | |
176 /* This is the real definition--the function to run. */ | |
177 Lisp_Object def; | |
178 /* This is the sublist that records cached equiv key data | |
179 so we can save time. */ | |
180 Lisp_Object cachelist; | |
181 /* These are the saved equivalent keyboard key sequence | |
182 and its key-description. */ | |
183 Lisp_Object savedkey, descrip; | |
184 Lisp_Object def1; | |
185 int changed = 0; | |
186 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
187 | |
188 /* If a help string follows the item string, skip it. */ | |
189 if (CONSP (XCONS (item1)->cdr) | |
190 && STRINGP (XCONS (XCONS (item1)->cdr)->car)) | |
191 item1 = XCONS (item1)->cdr; | |
192 | |
193 def = Fcdr (item1); | |
194 | |
195 /* Get out the saved equivalent-keyboard-key info. */ | |
196 cachelist = savedkey = descrip = Qnil; | |
197 if (CONSP (def) && CONSP (XCONS (def)->car) | |
198 && (NILP (XCONS (XCONS (def)->car)->car) | |
199 || VECTORP (XCONS (XCONS (def)->car)->car))) | |
200 { | |
201 cachelist = XCONS (def)->car; | |
202 def = XCONS (def)->cdr; | |
203 savedkey = XCONS (cachelist)->car; | |
204 descrip = XCONS (cachelist)->cdr; | |
205 } | |
206 | |
207 GCPRO4 (def, def1, savedkey, descrip); | |
208 | |
209 /* Is it still valid? */ | |
210 def1 = Qnil; | |
211 if (!NILP (savedkey)) | |
212 def1 = Fkey_binding (savedkey, Qnil); | |
213 /* If not, update it. */ | |
214 if (! EQ (def1, def) | |
215 /* If the command is an alias for another | |
216 (such as easymenu.el and lmenu.el set it up), | |
217 check if the original command matches the cached command. */ | |
218 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) | |
219 && EQ (def1, XSYMBOL (def)->function)) | |
220 /* If something had no key binding before, don't recheck it-- | |
221 doing that takes too much time and makes menus too slow. */ | |
222 && !(!NILP (cachelist) && NILP (savedkey))) | |
223 { | |
224 changed = 1; | |
225 descrip = Qnil; | |
226 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); | |
227 /* If the command is an alias for another | |
228 (such as easymenu.el and lmenu.el set it up), | |
229 see if the original command name has equivalent keys. */ | |
230 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)) | |
231 savedkey = Fwhere_is_internal (XSYMBOL (def)->function, | |
232 Qnil, Qt, Qnil); | |
233 | |
234 if (VECTORP (savedkey) | |
235 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar)) | |
236 savedkey = Qnil; | |
237 if (!NILP (savedkey)) | |
238 { | |
239 descrip = Fkey_description (savedkey); | |
240 descrip = concat2 (make_string (" (", 3), descrip); | |
241 descrip = concat2 (descrip, make_string (")", 1)); | |
242 } | |
243 } | |
244 | |
245 /* Cache the data we just got in a sublist of the menu binding. */ | |
246 if (NILP (cachelist)) | |
247 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def); | |
248 else if (changed) | |
249 { | |
250 XCONS (cachelist)->car = savedkey; | |
251 XCONS (cachelist)->cdr = descrip; | |
252 } | |
253 | |
254 UNGCPRO; | |
255 *descrip_ptr = descrip; | |
256 return def; | |
257 } | |
258 | |
259 /* This is used as the handler when calling internal_condition_case_1. */ | |
260 | |
261 static Lisp_Object | |
262 menu_item_enabled_p_1 (arg) | |
263 Lisp_Object arg; | |
264 { | |
265 return Qnil; | |
266 } | |
267 | |
268 /* Return non-nil if the command DEF is enabled when used as a menu item. | |
269 This is based on looking for a menu-enable property. | |
270 If NOTREAL is set, don't bother really computing this. */ | |
271 | |
272 static Lisp_Object | |
273 menu_item_enabled_p (def, notreal) | |
274 Lisp_Object def; | |
275 { | |
276 Lisp_Object enabled, tem; | |
277 | |
278 enabled = Qt; | |
279 if (notreal) | |
280 return enabled; | |
281 if (XTYPE (def) == Lisp_Symbol) | |
282 { | |
283 /* No property, or nil, means enable. | |
284 Otherwise, enable if value is not nil. */ | |
285 tem = Fget (def, Qmenu_enable); | |
286 if (!NILP (tem)) | |
287 /* (condition-case nil (eval tem) | |
288 (error nil)) */ | |
289 enabled = internal_condition_case_1 (Feval, tem, Qerror, | |
290 menu_item_enabled_p_1); | |
291 } | |
292 return enabled; | |
293 } | |
294 | |
295 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, | |
296 and generate menu panes for them in menu_items. | |
297 If NOTREAL is nonzero, | |
298 don't bother really computing whether an item is enabled. */ | |
299 | |
300 static HMENU | |
301 keymap_panes (lpmm, keymaps, nmaps, notreal) | |
302 menu_map * lpmm; | |
303 Lisp_Object *keymaps; | |
304 int nmaps; | |
305 int notreal; | |
306 { | |
307 int mapno; | |
308 | |
309 // init_menu_items (lpmm); | |
310 | |
311 if (nmaps > 1) | |
312 { | |
313 HMENU hmenu; | |
314 | |
315 if (!notreal) | |
316 { | |
317 hmenu = CreateMenu (); | |
318 | |
319 if (!hmenu) return (NULL); | |
320 } | |
321 else | |
322 { | |
323 hmenu = NULL; | |
324 } | |
325 | |
326 /* Loop over the given keymaps, making a pane for each map. | |
327 But don't make a pane that is empty--ignore that map instead. | |
328 P is the number of panes we have made so far. */ | |
329 for (mapno = 0; mapno < nmaps; mapno++) | |
330 { | |
331 HMENU new_hmenu; | |
332 | |
333 new_hmenu = single_keymap_panes (lpmm, keymaps[mapno], | |
334 Qnil, Qnil, notreal); | |
335 | |
336 if (!notreal && new_hmenu) | |
337 { | |
338 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, ""); | |
339 } | |
340 } | |
341 | |
342 return (hmenu); | |
343 } | |
344 else | |
345 { | |
346 return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal)); | |
347 } | |
348 } | |
349 | |
350 /* This is a recursive subroutine of keymap_panes. | |
351 It handles one keymap, KEYMAP. | |
352 The other arguments are passed along | |
353 or point to local variables of the previous function. | |
354 If NOTREAL is nonzero, | |
355 don't bother really computing whether an item is enabled. */ | |
356 | |
357 HMENU | |
358 single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) | |
359 menu_map * lpmm; | |
360 Lisp_Object keymap; | |
361 Lisp_Object pane_name; | |
362 Lisp_Object prefix; | |
363 int notreal; | |
364 { | |
365 Lisp_Object pending_maps; | |
366 Lisp_Object tail, item, item1, item_string, table; | |
367 HMENU hmenu; | |
368 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
369 | |
370 if (!notreal) | |
371 { | |
372 hmenu = CreateMenu (); | |
373 if (hmenu == NULL) return NULL; | |
374 } | |
375 else | |
376 { | |
377 hmenu = NULL; | |
378 } | |
379 | |
380 pending_maps = Qnil; | |
381 | |
382 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
383 { | |
384 /* Look at each key binding, and if it has a menu string, | |
385 make a menu item from it. */ | |
386 | |
387 item = XCONS (tail)->car; | |
388 | |
389 if (CONSP (item)) | |
390 { | |
391 item1 = XCONS (item)->cdr; | |
392 | |
393 if (XTYPE (item1) == Lisp_Cons) | |
394 { | |
395 item_string = XCONS (item1)->car; | |
396 if (XTYPE (item_string) == Lisp_String) | |
397 { | |
398 /* This is the real definition--the function to run. */ | |
399 | |
400 Lisp_Object def; | |
401 | |
402 /* These are the saved equivalent keyboard key sequence | |
403 and its key-description. */ | |
404 | |
405 Lisp_Object descrip; | |
406 Lisp_Object tem, enabled; | |
407 | |
408 /* GCPRO because ...enabled_p will call eval | |
409 and ..._equiv_key may autoload something. | |
410 Protecting KEYMAP preserves everything we use; | |
411 aside from that, must protect whatever might be | |
412 a string. Since there's no GCPRO5, we refetch | |
413 item_string instead of protecting it. */ | |
414 | |
415 descrip = def = Qnil; | |
416 GCPRO4 (keymap, pending_maps, def, prefix); | |
417 | |
418 def = menu_item_equiv_key (item_string, item1, &descrip); | |
419 enabled = menu_item_enabled_p (def, notreal); | |
420 | |
421 UNGCPRO; | |
422 | |
423 item_string = XCONS (item1)->car; | |
424 | |
425 tem = Fkeymapp (def); | |
426 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
427 { | |
428 pending_maps = Fcons (Fcons (def, | |
429 Fcons (item_string, | |
430 XCONS (item)->car)), | |
431 pending_maps); | |
432 } | |
433 else | |
434 { | |
435 Lisp_Object submap; | |
436 | |
437 GCPRO4 (keymap, pending_maps, item, item_string); | |
438 | |
439 submap = get_keymap_1 (def, 0, 1); | |
440 | |
441 UNGCPRO; | |
442 | |
443 if (NILP (submap)) | |
444 { | |
445 if (!notreal) | |
446 { | |
447 add_menu_item (lpmm, | |
448 hmenu, | |
449 item_string, | |
450 !NILP (enabled), | |
451 Fcons (XCONS (item)->car, prefix)); | |
452 } | |
453 } | |
454 else | |
455 /* Display a submenu. */ | |
456 { | |
457 HMENU new_hmenu = single_keymap_panes (lpmm, | |
458 submap, | |
459 item_string, | |
460 XCONS (item)->car, | |
461 notreal); | |
462 | |
463 if (!notreal) | |
464 { | |
465 AppendMenu (hmenu, MF_POPUP, | |
466 (UINT)new_hmenu, | |
467 (char *) XSTRING (item_string)->data); | |
468 } | |
469 } | |
470 } | |
471 } | |
472 } | |
473 } | |
474 else if (VECTORP (item)) | |
475 { | |
476 /* Loop over the char values represented in the vector. */ | |
477 int len = XVECTOR (item)->size; | |
478 int c; | |
479 for (c = 0; c < len; c++) | |
480 { | |
481 Lisp_Object character; | |
482 XSETFASTINT (character, c); | |
483 item1 = XVECTOR (item)->contents[c]; | |
484 if (CONSP (item1)) | |
485 { | |
486 item_string = XCONS (item1)->car; | |
487 if (STRINGP (item_string)) | |
488 { | |
489 Lisp_Object def; | |
490 | |
491 /* These are the saved equivalent keyboard key sequence | |
492 and its key-description. */ | |
493 Lisp_Object descrip; | |
494 Lisp_Object tem, enabled; | |
495 | |
496 /* GCPRO because ...enabled_p will call eval | |
497 and ..._equiv_key may autoload something. | |
498 Protecting KEYMAP preserves everything we use; | |
499 aside from that, must protect whatever might be | |
500 a string. Since there's no GCPRO5, we refetch | |
501 item_string instead of protecting it. */ | |
502 GCPRO4 (keymap, pending_maps, def, descrip); | |
503 descrip = def = Qnil; | |
504 | |
505 def = menu_item_equiv_key (item_string, item1, &descrip); | |
506 enabled = menu_item_enabled_p (def, notreal); | |
507 | |
508 UNGCPRO; | |
509 | |
510 item_string = XCONS (item1)->car; | |
511 | |
512 tem = Fkeymapp (def); | |
513 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
514 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), | |
515 pending_maps); | |
516 else | |
517 { | |
518 Lisp_Object submap; | |
519 | |
520 GCPRO4 (keymap, pending_maps, descrip, item_string); | |
521 | |
522 submap = get_keymap_1 (def, 0, 1); | |
523 | |
524 UNGCPRO; | |
525 | |
526 if (NILP (submap)) | |
527 { | |
528 if (!notreal) | |
529 { | |
530 add_menu_item (lpmm, | |
531 hmenu, | |
532 item_string, | |
533 !NILP (enabled), | |
534 character); | |
535 } | |
536 } | |
537 else | |
538 /* Display a submenu. */ | |
539 { | |
540 HMENU new_hmenu = single_keymap_panes (lpmm, | |
541 submap, | |
542 Qnil, | |
543 character, | |
544 notreal); | |
545 | |
546 if (!notreal) | |
547 { | |
548 AppendMenu (hmenu,MF_POPUP, | |
549 (UINT)new_hmenu, | |
550 (char *)XSTRING (item_string)->data); | |
551 } | |
552 } | |
553 } | |
554 } | |
555 } | |
556 } | |
557 } | |
558 } | |
559 | |
560 /* Process now any submenus which want to be panes at this level. */ | |
561 while (!NILP (pending_maps)) | |
562 { | |
563 Lisp_Object elt, eltcdr, string; | |
564 elt = Fcar (pending_maps); | |
565 eltcdr = XCONS (elt)->cdr; | |
566 string = XCONS (eltcdr)->car; | |
567 /* We no longer discard the @ from the beginning of the string here. | |
568 Instead, we do this in win32menu_show. */ | |
569 { | |
570 HMENU new_hmenu = single_keymap_panes (lpmm, | |
571 Fcar (elt), | |
572 string, | |
573 XCONS (eltcdr)->cdr, notreal); | |
574 | |
575 if (!notreal) | |
576 { | |
577 AppendMenu (hmenu, MF_POPUP, | |
578 (UINT)new_hmenu, | |
579 (char *) XSTRING (string)->data); | |
580 } | |
581 } | |
582 | |
583 pending_maps = Fcdr (pending_maps); | |
584 } | |
585 | |
586 return (hmenu); | |
587 } | |
588 | |
589 /* Push all the panes and items of a menu decsribed by the | |
590 alist-of-alists MENU. | |
591 This handles old-fashioned calls to x-popup-menu. */ | |
592 | |
593 static HMENU | |
594 list_of_panes (lpmm, menu) | |
595 menu_map * lpmm; | |
596 Lisp_Object menu; | |
597 { | |
598 Lisp_Object tail; | |
599 HMENU hmenu; | |
600 | |
601 hmenu = CreateMenu (); | |
602 if (hmenu == NULL) return NULL; | |
603 | |
604 // init_menu_items (lpmm); | |
605 | |
606 for (tail = menu; !NILP (tail); tail = Fcdr (tail)) | |
607 { | |
608 Lisp_Object elt, pane_name, pane_data; | |
609 HMENU new_hmenu; | |
610 | |
611 elt = Fcar (tail); | |
612 pane_name = Fcar (elt); | |
613 CHECK_STRING (pane_name, 0); | |
614 pane_data = Fcdr (elt); | |
615 CHECK_CONS (pane_data, 0); | |
616 | |
617 new_hmenu = list_of_items (lpmm, pane_data); | |
618 if (new_hmenu == NULL) goto error; | |
619 | |
620 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, | |
621 (char *) XSTRING (pane_name)->data); | |
622 } | |
623 | |
624 return (hmenu); | |
625 | |
626 error: | |
627 DestroyMenu (hmenu); | |
628 | |
629 return (NULL); | |
630 } | |
631 | |
632 /* Push the items in a single pane defined by the alist PANE. */ | |
633 | |
634 static HMENU | |
635 list_of_items (lpmm, pane) | |
636 menu_map * lpmm; | |
637 Lisp_Object pane; | |
638 { | |
639 Lisp_Object tail, item, item1; | |
640 HMENU hmenu; | |
641 | |
642 hmenu = CreateMenu (); | |
643 if (hmenu == NULL) return NULL; | |
644 | |
645 for (tail = pane; !NILP (tail); tail = Fcdr (tail)) | |
646 { | |
647 item = Fcar (tail); | |
648 if (STRINGP (item)) | |
649 add_menu_item (lpmm, hmenu, item, Qnil, Qnil); | |
650 else if (NILP (item)) | |
651 add_left_right_boundary (); | |
652 else | |
653 { | |
654 CHECK_CONS (item, 0); | |
655 item1 = Fcar (item); | |
656 CHECK_STRING (item1, 1); | |
657 add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item)); | |
658 } | |
659 } | |
660 | |
661 return (hmenu); | |
662 } | |
663 | |
664 | |
665 HMENU | |
666 create_menu_items (lpmm, menu, notreal) | |
667 menu_map * lpmm; | |
668 Lisp_Object menu; | |
669 int notreal; | |
670 { | |
671 Lisp_Object title; | |
672 Lisp_Object keymap, tem; | |
673 HMENU hmenu; | |
674 | |
675 title = Qnil; | |
676 | |
677 /* Decode the menu items from what was specified. */ | |
678 | |
679 keymap = Fkeymapp (menu); | |
680 tem = Qnil; | |
681 if (XTYPE (menu) == Lisp_Cons) | |
682 tem = Fkeymapp (Fcar (menu)); | |
683 | |
684 if (!NILP (keymap)) | |
685 { | |
686 /* We were given a keymap. Extract menu info from the keymap. */ | |
687 Lisp_Object prompt; | |
688 keymap = get_keymap (menu); | |
689 | |
690 /* Extract the detailed info to make one pane. */ | |
691 hmenu = keymap_panes (lpmm, &keymap, 1, notreal); | |
692 | |
693 #if 0 | |
694 /* Search for a string appearing directly as an element of the keymap. | |
695 That string is the title of the menu. */ | |
696 prompt = map_prompt (keymap); | |
697 | |
698 /* Make that be the pane title of the first pane. */ | |
699 if (!NILP (prompt) && menu_items_n_panes >= 0) | |
700 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt; | |
701 #endif | |
702 } | |
703 else if (!NILP (tem)) | |
704 { | |
705 /* We were given a list of keymaps. */ | |
706 int nmaps = XFASTINT (Flength (menu)); | |
707 Lisp_Object *maps | |
708 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); | |
709 int i; | |
710 | |
711 title = Qnil; | |
712 | |
713 /* The first keymap that has a prompt string | |
714 supplies the menu title. */ | |
715 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) | |
716 { | |
717 Lisp_Object prompt; | |
718 | |
719 maps[i++] = keymap = get_keymap (Fcar (tem)); | |
720 #if 0 | |
721 prompt = map_prompt (keymap); | |
722 if (NILP (title) && !NILP (prompt)) | |
723 title = prompt; | |
724 #endif | |
725 } | |
726 | |
727 /* Extract the detailed info to make one pane. */ | |
728 hmenu = keymap_panes (lpmm, maps, nmaps, notreal); | |
729 | |
730 #if 0 | |
731 /* Make the title be the pane title of the first pane. */ | |
732 if (!NILP (title) && menu_items_n_panes >= 0) | |
733 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title; | |
734 #endif | |
735 } | |
736 else | |
737 { | |
738 /* We were given an old-fashioned menu. */ | |
739 title = Fcar (menu); | |
740 CHECK_STRING (title, 1); | |
741 | |
742 hmenu = list_of_panes (lpmm, Fcdr (menu)); | |
743 } | |
744 | |
745 return (hmenu); | |
746 } | |
747 | |
748 /* This is a recursive subroutine of keymap_panes. | |
749 It handles one keymap, KEYMAP. | |
750 The other arguments are passed along | |
751 or point to local variables of the previous function. | |
752 If NOTREAL is nonzero, | |
753 don't bother really computing whether an item is enabled. */ | |
754 | |
755 Lisp_Object | |
756 get_single_keymap_event (keymap, lpnum) | |
757 Lisp_Object keymap; | |
758 int * lpnum; | |
759 { | |
760 Lisp_Object pending_maps; | |
761 Lisp_Object tail, item, item1, item_string, table; | |
762 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
763 | |
764 pending_maps = Qnil; | |
765 | |
766 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
767 { | |
768 /* Look at each key binding, and if it has a menu string, | |
769 make a menu item from it. */ | |
770 | |
771 item = XCONS (tail)->car; | |
772 | |
773 if (XTYPE (item) == Lisp_Cons) | |
774 { | |
775 item1 = XCONS (item)->cdr; | |
776 | |
777 if (CONSP (item1)) | |
778 { | |
779 item_string = XCONS (item1)->car; | |
780 if (XTYPE (item_string) == Lisp_String) | |
781 { | |
782 /* This is the real definition--the function to run. */ | |
783 | |
784 Lisp_Object def; | |
785 | |
786 /* These are the saved equivalent keyboard key sequence | |
787 and its key-description. */ | |
788 | |
789 Lisp_Object descrip; | |
790 Lisp_Object tem, enabled; | |
791 | |
792 /* GCPRO because ...enabled_p will call eval | |
793 and ..._equiv_key may autoload something. | |
794 Protecting KEYMAP preserves everything we use; | |
795 aside from that, must protect whatever might be | |
796 a string. Since there's no GCPRO5, we refetch | |
797 item_string instead of protecting it. */ | |
798 | |
799 descrip = def = Qnil; | |
800 GCPRO3 (keymap, pending_maps, def); | |
801 | |
802 def = menu_item_equiv_key (item_string, item1, &descrip); | |
803 | |
804 UNGCPRO; | |
805 | |
806 item_string = XCONS (item1)->car; | |
807 | |
808 tem = Fkeymapp (def); | |
809 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
810 { | |
811 pending_maps = Fcons (Fcons (def, | |
812 Fcons (item_string, | |
813 XCONS (item)->car)), | |
814 pending_maps); | |
815 } | |
816 else | |
817 { | |
818 Lisp_Object submap; | |
819 | |
820 GCPRO4 (keymap, pending_maps, item, item_string); | |
821 | |
822 submap = get_keymap_1 (def, 0, 1); | |
823 | |
824 UNGCPRO; | |
825 | |
826 if (NILP (submap)) | |
827 { | |
828 if (--(*lpnum) == 0) | |
829 { | |
830 return (Fcons (XCONS (item)->car, Qnil)); | |
831 } | |
832 } | |
833 else | |
834 /* Display a submenu. */ | |
835 { | |
836 Lisp_Object event = get_single_keymap_event (submap, | |
837 lpnum); | |
838 | |
839 if (*lpnum <= 0) | |
840 { | |
841 if (!NILP (XCONS (item)->car)) | |
842 event = Fcons (XCONS (item)->car, event); | |
843 | |
844 return (event); | |
845 } | |
846 } | |
847 } | |
848 } | |
849 } | |
850 } | |
851 else if (VECTORP (item)) | |
852 { | |
853 /* Loop over the char values represented in the vector. */ | |
854 int len = XVECTOR (item)->size; | |
855 int c; | |
856 for (c = 0; c < len; c++) | |
857 { | |
858 Lisp_Object character; | |
859 XSETFASTINT (character, c); | |
860 item1 = XVECTOR (item)->contents[c]; | |
861 if (XTYPE (item1) == Lisp_Cons) | |
862 { | |
863 item_string = XCONS (item1)->car; | |
864 if (XTYPE (item_string) == Lisp_String) | |
865 { | |
866 Lisp_Object def; | |
867 | |
868 /* These are the saved equivalent keyboard key sequence | |
869 and its key-description. */ | |
870 Lisp_Object descrip; | |
871 Lisp_Object tem, enabled; | |
872 | |
873 /* GCPRO because ...enabled_p will call eval | |
874 and ..._equiv_key may autoload something. | |
875 Protecting KEYMAP preserves everything we use; | |
876 aside from that, must protect whatever might be | |
877 a string. Since there's no GCPRO5, we refetch | |
878 item_string instead of protecting it. */ | |
879 GCPRO4 (keymap, pending_maps, def, descrip); | |
880 descrip = def = Qnil; | |
881 | |
882 def = menu_item_equiv_key (item_string, item1, &descrip); | |
883 | |
884 UNGCPRO; | |
885 | |
886 item_string = XCONS (item1)->car; | |
887 | |
888 tem = Fkeymapp (def); | |
889 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) | |
890 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), | |
891 pending_maps); | |
892 else | |
893 { | |
894 Lisp_Object submap; | |
895 | |
896 GCPRO4 (keymap, pending_maps, descrip, item_string); | |
897 | |
898 submap = get_keymap_1 (def, 0, 1); | |
899 | |
900 UNGCPRO; | |
901 | |
902 if (NILP (submap)) | |
903 { | |
904 if (--(*lpnum) == 0) | |
905 { | |
906 return (Fcons (character, Qnil)); | |
907 } | |
908 } | |
909 else | |
910 /* Display a submenu. */ | |
911 { | |
912 Lisp_Object event = get_single_keymap_event (submap, | |
913 lpnum); | |
914 | |
915 if (*lpnum <= 0) | |
916 { | |
917 if (!NILP (character)) | |
918 event = Fcons (character, event); | |
919 | |
920 return (event); | |
921 } | |
922 } | |
923 } | |
924 } | |
925 } | |
926 } | |
927 } | |
928 } | |
929 | |
930 /* Process now any submenus which want to be panes at this level. */ | |
931 while (!NILP (pending_maps)) | |
932 { | |
933 Lisp_Object elt, eltcdr, string; | |
934 elt = Fcar (pending_maps); | |
935 eltcdr = XCONS (elt)->cdr; | |
936 string = XCONS (eltcdr)->car; | |
937 /* We no longer discard the @ from the beginning of the string here. | |
938 Instead, we do this in win32menu_show. */ | |
939 { | |
940 Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum); | |
941 | |
942 if (*lpnum <= 0) | |
943 { | |
944 if (!NILP (XCONS (eltcdr)->cdr)) | |
945 event = Fcons (XCONS (eltcdr)->cdr, event); | |
946 | |
947 return (event); | |
948 } | |
949 } | |
950 | |
951 pending_maps = Fcdr (pending_maps); | |
952 } | |
953 | |
954 return (Qnil); | |
955 } | |
956 | |
957 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, | |
958 and generate menu panes for them in menu_items. | |
959 If NOTREAL is nonzero, | |
960 don't bother really computing whether an item is enabled. */ | |
961 | |
962 static Lisp_Object | |
963 get_keymap_event (keymaps, nmaps, lpnum) | |
964 Lisp_Object *keymaps; | |
965 int nmaps; | |
966 int * lpnum; | |
967 { | |
968 int mapno; | |
969 Lisp_Object event = Qnil; | |
970 | |
971 /* Loop over the given keymaps, making a pane for each map. | |
972 But don't make a pane that is empty--ignore that map instead. | |
973 P is the number of panes we have made so far. */ | |
974 for (mapno = 0; mapno < nmaps; mapno++) | |
975 { | |
976 event = get_single_keymap_event (keymaps[mapno], lpnum); | |
977 | |
978 if (*lpnum <= 0) break; | |
979 } | |
980 | |
981 return (event); | |
982 } | |
983 | |
984 static Lisp_Object | |
985 get_list_of_items_event (pane, lpnum) | |
986 Lisp_Object pane; | |
987 int * lpnum; | |
988 { | |
989 Lisp_Object tail, item, item1; | |
990 | |
991 for (tail = pane; !NILP (tail); tail = Fcdr (tail)) | |
992 { | |
993 item = Fcar (tail); | |
994 if (STRINGP (item)) | |
995 { | |
996 if (-- (*lpnum) == 0) | |
997 { | |
998 return (Qnil); | |
999 } | |
1000 } | |
1001 else if (!NILP (item)) | |
1002 { | |
1003 if (--(*lpnum) == 0) | |
1004 { | |
1005 CHECK_CONS (item, 0); | |
1006 return (Fcdr (item)); | |
1007 } | |
1008 } | |
1009 } | |
1010 | |
1011 return (Qnil); | |
1012 } | |
1013 | |
1014 /* Push all the panes and items of a menu decsribed by the | |
1015 alist-of-alists MENU. | |
1016 This handles old-fashioned calls to x-popup-menu. */ | |
1017 | |
1018 static Lisp_Object | |
1019 get_list_of_panes_event (menu, lpnum) | |
1020 Lisp_Object menu; | |
1021 int * lpnum; | |
1022 { | |
1023 Lisp_Object tail; | |
1024 | |
1025 for (tail = menu; !NILP (tail); tail = Fcdr (tail)) | |
1026 { | |
1027 Lisp_Object elt, pane_name, pane_data; | |
1028 Lisp_Object event; | |
1029 | |
1030 elt = Fcar (tail); | |
1031 pane_data = Fcdr (elt); | |
1032 CHECK_CONS (pane_data, 0); | |
1033 | |
1034 event = get_list_of_items_event (pane_data, lpnum); | |
1035 | |
1036 if (*lpnum <= 0) | |
1037 { | |
1038 return (event); | |
1039 } | |
1040 } | |
1041 | |
1042 return (Qnil); | |
1043 } | |
1044 | |
1045 Lisp_Object | |
1046 get_menu_event (menu, lpnum) | |
1047 Lisp_Object menu; | |
1048 int * lpnum; | |
1049 { | |
1050 Lisp_Object keymap, tem; | |
1051 Lisp_Object event; | |
1052 | |
1053 /* Decode the menu items from what was specified. */ | |
1054 | |
1055 keymap = Fkeymapp (menu); | |
1056 tem = Qnil; | |
1057 if (XTYPE (menu) == Lisp_Cons) | |
1058 tem = Fkeymapp (Fcar (menu)); | |
1059 | |
1060 if (!NILP (keymap)) | |
1061 { | |
1062 keymap = get_keymap (menu); | |
1063 | |
1064 event = get_keymap_event (menu, 1, lpnum); | |
1065 } | |
1066 else if (!NILP (tem)) | |
1067 { | |
1068 /* We were given a list of keymaps. */ | |
1069 int nmaps = XFASTINT (Flength (menu)); | |
1070 Lisp_Object *maps | |
1071 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); | |
1072 int i; | |
1073 | |
1074 /* The first keymap that has a prompt string | |
1075 supplies the menu title. */ | |
1076 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) | |
1077 { | |
1078 Lisp_Object prompt; | |
1079 | |
1080 maps[i++] = keymap = get_keymap (Fcar (tem)); | |
1081 } | |
1082 | |
1083 event = get_keymap_event (maps, nmaps, lpnum); | |
1084 } | |
1085 else | |
1086 { | |
1087 /* We were given an old-fashioned menu. */ | |
1088 event = get_list_of_panes_event (Fcdr (menu), lpnum); | |
1089 } | |
1090 | |
1091 return (event); | |
1092 } | |
1093 | |
1094 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, | |
1095 "Pop up a deck-of-cards menu and return user's selection.\n\ | |
1096 POSITION is a position specification. This is either a mouse button event\n\ | |
1097 or a list ((XOFFSET YOFFSET) WINDOW)\n\ | |
1098 where XOFFSET and YOFFSET are positions in pixels from the top left\n\ | |
1099 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ | |
1100 This controls the position of the center of the first line\n\ | |
1101 in the first pane of the menu, not the top left of the menu as a whole.\n\ | |
1102 If POSITION is t, it means to use the current mouse position.\n\ | |
1103 \n\ | |
1104 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ | |
1105 The menu items come from key bindings that have a menu string as well as\n\ | |
1106 a definition; actually, the \"definition\" in such a key binding looks like\n\ | |
1107 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ | |
1108 the keymap as a top-level element.\n\n\ | |
1109 You can also use a list of keymaps as MENU.\n\ | |
1110 Then each keymap makes a separate pane.\n\ | |
1111 When MENU is a keymap or a list of keymaps, the return value\n\ | |
1112 is a list of events.\n\n\ | |
1113 Alternatively, you can specify a menu of multiple panes\n\ | |
1114 with a list of the form (TITLE PANE1 PANE2...),\n\ | |
1115 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ | |
1116 Each ITEM is normally a cons cell (STRING . VALUE);\n\ | |
1117 but a string can appear as an item--that makes a nonselectable line\n\ | |
1118 in the menu.\n\ | |
1119 With this form of menu, the return value is VALUE from the chosen item.\n\ | |
1120 \n\ | |
1121 If POSITION is nil, don't display the menu at all, just precalculate the\n\ | |
1122 cached information about equivalent key sequences.") | |
1123 (position, menu) | |
1124 Lisp_Object position, menu; | |
1125 { | |
1126 int number_of_panes, panes; | |
1127 Lisp_Object keymap, tem; | |
1128 int xpos, ypos; | |
1129 Lisp_Object title; | |
1130 char *error_name; | |
1131 Lisp_Object selection; | |
1132 int i, j; | |
1133 FRAME_PTR f; | |
1134 Lisp_Object x, y, window; | |
1135 int keymaps = 0; | |
1136 int menubarp = 0; | |
1137 struct gcpro gcpro1; | |
1138 HMENU hmenu; | |
1139 menu_map mm; | |
1140 | |
1141 if (! NILP (position)) | |
1142 { | |
1143 /* Decode the first argument: find the window and the coordinates. */ | |
1144 if (EQ (position, Qt)) | |
1145 { | |
1146 /* Use the mouse's current position. */ | |
1147 FRAME_PTR new_f = 0; | |
1148 Lisp_Object bar_window; | |
1149 int part; | |
1150 unsigned long time; | |
1151 | |
1152 if (mouse_position_hook) | |
1153 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); | |
1154 if (new_f != 0) | |
1155 XSETFRAME (window, new_f); | |
1156 else | |
1157 { | |
1158 window = selected_window; | |
1159 XSETFASTINT (x, 0); | |
1160 XSETFASTINT (y, 0); | |
1161 } | |
1162 } | |
1163 else | |
1164 { | |
1165 tem = Fcar (position); | |
1166 if (CONSP (tem)) | |
1167 { | |
1168 window = Fcar (Fcdr (position)); | |
1169 x = Fcar (tem); | |
1170 y = Fcar (Fcdr (tem)); | |
1171 } | |
1172 else | |
1173 { | |
1174 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ | |
1175 window = Fcar (tem); /* POSN_WINDOW (tem) */ | |
1176 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ | |
1177 x = Fcar (tem); | |
1178 y = Fcdr (tem); | |
1179 | |
1180 /* Determine whether this menu is handling a menu bar click. */ | |
1181 tem = Fcar (Fcdr (Fcar (Fcdr (position)))); | |
1182 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar)) | |
1183 menubarp = 1; | |
1184 } | |
1185 } | |
1186 | |
1187 CHECK_NUMBER (x, 0); | |
1188 CHECK_NUMBER (y, 0); | |
1189 | |
1190 /* Decode where to put the menu. */ | |
1191 | |
1192 if (FRAMEP (window)) | |
1193 { | |
1194 f = XFRAME (window); | |
1195 | |
1196 xpos = 0; | |
1197 ypos = 0; | |
1198 } | |
1199 else if (WINDOWP (window)) | |
1200 { | |
1201 CHECK_LIVE_WINDOW (window, 0); | |
1202 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); | |
1203 | |
1204 xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left); | |
1205 ypos = (f->output_data.win32->line_height * XWINDOW (window)->top); | |
1206 } | |
1207 else | |
1208 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, | |
1209 but I don't want to make one now. */ | |
1210 CHECK_WINDOW (window, 0); | |
1211 | |
1212 xpos += XINT (x); | |
1213 ypos += XINT (y); | |
1214 } | |
1215 | |
1216 title = Qnil; | |
1217 GCPRO1 (title); | |
1218 | |
1219 discard_menu_items (&mm); | |
1220 hmenu = create_menu_items (&mm, menu, NILP (position)); | |
1221 | |
1222 if (NILP (position)) | |
1223 { | |
1224 discard_menu_items (&mm); | |
1225 UNGCPRO; | |
1226 return Qnil; | |
1227 } | |
1228 | |
1229 /* Display them in a menu. */ | |
1230 BLOCK_INPUT; | |
1231 | |
1232 selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name); | |
1233 | |
1234 UNBLOCK_INPUT; | |
1235 | |
1236 discard_menu_items (&mm); | |
1237 DestroyMenu (hmenu); | |
1238 | |
1239 UNGCPRO; | |
1240 | |
1241 if (error_name) error (error_name); | |
1242 return selection; | |
1243 } | |
1244 | |
1245 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, | |
1246 "Pop up a dialog box and return user's selection.\n\ | |
1247 POSITION specifies which frame to use.\n\ | |
1248 This is normally a mouse button event or a window or frame.\n\ | |
1249 If POSITION is t, it means to use the frame the mouse is on.\n\ | |
1250 The dialog box appears in the middle of the specified frame.\n\ | |
1251 \n\ | |
1252 CONTENTS specifies the alternatives to display in the dialog box.\n\ | |
1253 It is a list of the form (TITLE ITEM1 ITEM2...).\n\ | |
1254 Each ITEM is a cons cell (STRING . VALUE).\n\ | |
1255 The return value is VALUE from the chosen item.\n\n\ | |
1256 An ITEM may also be just a string--that makes a nonselectable item.\n\ | |
1257 An ITEM may also be nil--that means to put all preceding items\n\ | |
1258 on the left of the dialog box and all following items on the right.\n\ | |
1259 \(By default, approximately half appear on each side.)") | |
1260 (position, contents) | |
1261 Lisp_Object position, contents; | |
1262 { | |
1263 FRAME_PTR f; | |
1264 Lisp_Object window; | |
1265 | |
1266 /* Decode the first argument: find the window or frame to use. */ | |
1267 if (EQ (position, Qt)) | |
1268 { | |
1269 /* Decode the first argument: find the window and the coordinates. */ | |
1270 if (EQ (position, Qt)) | |
1271 window = selected_window; | |
1272 } | |
1273 else if (CONSP (position)) | |
1274 { | |
1275 Lisp_Object tem; | |
1276 tem = Fcar (position); | |
1277 if (XTYPE (tem) == Lisp_Cons) | |
1278 window = Fcar (Fcdr (position)); | |
1279 else | |
1280 { | |
1281 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ | |
1282 window = Fcar (tem); /* POSN_WINDOW (tem) */ | |
1283 } | |
1284 } | |
1285 else if (WINDOWP (position) || FRAMEP (position)) | |
1286 window = position; | |
1287 | |
1288 /* Decode where to put the menu. */ | |
1289 | |
1290 if (FRAMEP (window)) | |
1291 f = XFRAME (window); | |
1292 else if (WINDOWP (window)) | |
1293 { | |
1294 CHECK_LIVE_WINDOW (window, 0); | |
1295 f = XFRAME (WINDOW_FRAME (XWINDOW (window))); | |
1296 } | |
1297 else | |
1298 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, | |
1299 but I don't want to make one now. */ | |
1300 CHECK_WINDOW (window, 0); | |
1301 | |
1302 #if 1 | |
1303 /* Display a menu with these alternatives | |
1304 in the middle of frame F. */ | |
1305 { | |
1306 Lisp_Object x, y, frame, newpos; | |
1307 XSETFRAME (frame, f); | |
1308 XSETINT (x, x_pixel_width (f) / 2); | |
1309 XSETINT (y, x_pixel_height (f) / 2); | |
1310 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); | |
1311 | |
1312 return Fx_popup_menu (newpos, | |
1313 Fcons (Fcar (contents), Fcons (contents, Qnil))); | |
1314 } | |
1315 #else | |
1316 { | |
1317 Lisp_Object title; | |
1318 char *error_name; | |
1319 Lisp_Object selection; | |
1320 | |
1321 /* Decode the dialog items from what was specified. */ | |
1322 title = Fcar (contents); | |
1323 CHECK_STRING (title, 1); | |
1324 | |
1325 list_of_panes (Fcons (contents, Qnil)); | |
1326 | |
1327 /* Display them in a dialog box. */ | |
1328 BLOCK_INPUT; | |
1329 selection = win32_dialog_show (f, 0, 0, title, &error_name); | |
1330 UNBLOCK_INPUT; | |
1331 | |
1332 discard_menu_items (); | |
1333 | |
1334 if (error_name) error (error_name); | |
1335 return selection; | |
1336 } | |
1337 #endif | |
1338 } | |
1339 | |
1340 Lisp_Object | |
1341 get_frame_menubar_event (f, num) | |
1342 FRAME_PTR f; | |
1343 int num; | |
1344 { | |
1345 Lisp_Object tail, items; | |
1346 int i; | |
1347 struct gcpro gcpro1; | |
1348 | |
1349 BLOCK_INPUT; | |
1350 | |
1351 GCPRO1 (items); | |
1352 | |
1353 if (NILP (items = FRAME_MENU_BAR_ITEMS (f))) | |
1354 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); | |
1355 | |
1356 for (i = 0; i < XVECTOR (items)->size; i += 3) | |
1357 { | |
1358 Lisp_Object event; | |
1359 | |
1360 event = get_menu_event (XVECTOR (items)->contents[i + 2], &num); | |
1361 | |
1362 if (num <= 0) | |
1363 { | |
1364 UNGCPRO; | |
1365 UNBLOCK_INPUT; | |
1366 return (Fcons (XVECTOR (items)->contents[i], event)); | |
1367 } | |
1368 } | |
1369 | |
1370 UNGCPRO; | |
1371 UNBLOCK_INPUT; | |
1372 | |
1373 return (Qnil); | |
1374 } | |
1375 | |
1376 void | |
1377 set_frame_menubar (f, first_time) | |
1378 FRAME_PTR f; | |
1379 int first_time; | |
1380 { | |
1381 Lisp_Object tail, items; | |
1382 HMENU hmenu; | |
1383 int i; | |
1384 struct gcpro gcpro1; | |
1385 menu_map mm; | |
1386 | |
1387 BLOCK_INPUT; | |
1388 | |
1389 GCPRO1 (items); | |
1390 | |
1391 if (NILP (items = FRAME_MENU_BAR_ITEMS (f))) | |
1392 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); | |
1393 | |
1394 hmenu = CreateMenu (); | |
1395 | |
1396 if (!hmenu) goto error; | |
1397 | |
1398 discard_menu_items (&mm); | |
1399 | |
1400 for (i = 0; i < XVECTOR (items)->size; i += 3) | |
1401 { | |
1402 Lisp_Object string; | |
1403 int keymaps; | |
1404 CHAR *error; | |
1405 HMENU new_hmenu; | |
1406 | |
1407 string = XVECTOR (items)->contents[i + 1]; | |
1408 if (NILP (string)) | |
1409 break; | |
1410 | |
1411 new_hmenu = create_menu_items (&mm, | |
1412 XVECTOR (items)->contents[i + 2], | |
1413 0); | |
1414 | |
1415 if (!new_hmenu) | |
1416 continue; | |
1417 | |
1418 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, | |
1419 (char *) XSTRING (string)->data); | |
1420 } | |
1421 | |
1422 { | |
1423 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f)); | |
1424 SetMenu (FRAME_WIN32_WINDOW (f), hmenu); | |
1425 DestroyMenu (old); | |
1426 } | |
1427 | |
1428 error: | |
1429 UNGCPRO; | |
1430 UNBLOCK_INPUT; | |
1431 } | |
1432 | |
1433 void | |
1434 free_frame_menubar (f) | |
1435 FRAME_PTR f; | |
1436 { | |
1437 BLOCK_INPUT; | |
1438 | |
1439 { | |
1440 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f)); | |
1441 SetMenu (FRAME_WIN32_WINDOW (f), NULL); | |
1442 DestroyMenu (old); | |
1443 } | |
1444 | |
1445 UNBLOCK_INPUT; | |
1446 } | |
1447 /* Called from Fwin32_create_frame to create the inital menubar of a frame | |
1448 before it is mapped, so that the window is mapped with the menubar already | |
1449 there instead of us tacking it on later and thrashing the window after it | |
1450 is visible. */ | |
1451 void | |
1452 initialize_frame_menubar (f) | |
1453 FRAME_PTR f; | |
1454 { | |
1455 set_frame_menubar (f, 1); | |
1456 } | |
1457 | |
1458 #if 0 | |
1459 /* If the mouse has moved to another menu bar item, | |
1460 return 1 and unread a button press event for that item. | |
1461 Otherwise return 0. */ | |
1462 | |
1463 static int | |
1464 check_mouse_other_menu_bar (f) | |
1465 FRAME_PTR f; | |
1466 { | |
1467 FRAME_PTR new_f; | |
1468 Lisp_Object bar_window; | |
1469 int part; | |
1470 Lisp_Object x, y; | |
1471 unsigned long time; | |
1472 | |
1473 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); | |
1474 | |
1475 if (f == new_f && other_menu_bar_item_p (f, x, y)) | |
1476 { | |
1477 unread_menu_bar_button (f, x); | |
1478 return 1; | |
1479 } | |
1480 | |
1481 return 0; | |
1482 } | |
1483 #endif | |
1484 | |
1485 | |
1486 #if 0 | |
1487 static HMENU | |
1488 create_menu (keymaps, error) | |
1489 int keymaps; | |
1490 char **error; | |
1491 { | |
1492 HMENU hmenu = NULL; /* the menu we are currently working on */ | |
1493 HMENU first_hmenu = NULL; | |
1494 | |
1495 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU)); | |
1496 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used * | |
1497 sizeof (Lisp_Object)); | |
1498 int submenu_depth = 0; | |
1499 int i; | |
1500 | |
1501 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) | |
1502 { | |
1503 *error = "Empty menu"; | |
1504 return NULL; | |
1505 } | |
1506 | |
1507 i = 0; | |
1508 | |
1509 /* Loop over all panes and items, filling in the tree. */ | |
1510 | |
1511 while (i < menu_items_used) | |
1512 { | |
1513 if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) | |
1514 { | |
1515 submenu_stack[submenu_depth++] = hmenu; | |
1516 i++; | |
1517 } | |
1518 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) | |
1519 { | |
1520 hmenu = submenu_stack[--submenu_depth]; | |
1521 i++; | |
1522 } | |
1523 #if 0 | |
1524 else if (EQ (XVECTOR (menu_items)->contents[i], Qt) | |
1525 && submenu_depth != 0) | |
1526 i += MENU_ITEMS_PANE_LENGTH; | |
1527 #endif | |
1528 /* Ignore a nil in the item list. | |
1529 It's meaningful only for dialog boxes. */ | |
1530 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) | |
1531 i += 1; | |
1532 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) | |
1533 { | |
1534 /* Create a new pane. */ | |
1535 | |
1536 Lisp_Object pane_name; | |
1537 char *pane_string; | |
1538 | |
1539 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; | |
1540 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); | |
1541 | |
1542 if (!hmenu || strcmp (pane_string, "")) | |
1543 { | |
1544 HMENU new_hmenu = CreateMenu (); | |
1545 | |
1546 if (!new_hmenu) | |
1547 { | |
1548 *error = "Could not create menu pane"; | |
1549 goto error; | |
1550 } | |
1551 | |
1552 if (hmenu) | |
1553 { | |
1554 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string); | |
1555 } | |
1556 | |
1557 hmenu = new_hmenu; | |
1558 | |
1559 if (!first_hmenu) first_hmenu = hmenu; | |
1560 } | |
1561 i += MENU_ITEMS_PANE_LENGTH; | |
1562 } | |
1563 else | |
1564 { | |
1565 /* Create a new item within current pane. */ | |
1566 | |
1567 Lisp_Object item_name, enable, descrip; | |
1568 UINT fuFlags; | |
1569 | |
1570 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; | |
1571 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; | |
1572 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; | |
1573 | |
1574 if (((char *) XSTRING (item_name)->data)[0] == 0 | |
1575 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0) | |
1576 fuFlags = MF_SEPARATOR; | |
1577 else if (NILP (enable) || !XUINT(enable)) | |
1578 fuFlags = MF_STRING | MF_GRAYED; | |
1579 else | |
1580 fuFlags = MF_STRING; | |
1581 | |
1582 AppendMenu (hmenu, | |
1583 fuFlags, | |
1584 i, | |
1585 (char *) XSTRING (item_name)->data); | |
1586 | |
1587 // if (!NILP (descrip)) | |
1588 // hmenu->key = (char *) XSTRING (descrip)->data; | |
1589 | |
1590 i += MENU_ITEMS_ITEM_LENGTH; | |
1591 } | |
1592 } | |
1593 | |
1594 return (first_hmenu); | |
1595 | |
1596 error: | |
1597 if (first_hmenu) DestroyMenu (first_hmenu); | |
1598 return (NULL); | |
1599 } | |
1600 | |
1601 #endif | |
1602 | |
1603 /* win32menu_show actually displays a menu using the panes and items in | |
1604 menu_items and returns the value selected from it. | |
1605 There are two versions of win32menu_show, one for Xt and one for Xlib. | |
1606 Both assume input is blocked by the caller. */ | |
1607 | |
1608 /* F is the frame the menu is for. | |
1609 X and Y are the frame-relative specified position, | |
1610 relative to the inside upper left corner of the frame F. | |
1611 MENUBARP is 1 if the click that asked for this menu came from the menu bar. | |
1612 KEYMAPS is 1 if this menu was specified with keymaps; | |
1613 in that case, we return a list containing the chosen item's value | |
1614 and perhaps also the pane's prefix. | |
1615 TITLE is the specified menu title. | |
1616 ERROR is a place to store an error message string in case of failure. | |
1617 (We return nil on failure, but the value doesn't actually matter.) */ | |
1618 | |
1619 | |
1620 static Lisp_Object | |
1621 win32menu_show (f, x, y, menu, hmenu, error) | |
1622 FRAME_PTR f; | |
1623 int x; | |
1624 int y; | |
1625 Lisp_Object menu; | |
1626 HMENU hmenu; | |
1627 char **error; | |
1628 { | |
1629 int i , menu_selection; | |
1630 POINT pos; | |
1631 | |
1632 *error = NULL; | |
1633 | |
1634 if (!hmenu) | |
1635 { | |
1636 *error = "Empty menu"; | |
1637 return Qnil; | |
1638 } | |
1639 | |
1640 pos.x = x; | |
1641 pos.y = y; | |
1642 | |
1643 /* Offset the coordinates to root-relative. */ | |
1644 ClientToScreen (FRAME_WIN32_WINDOW (f), &pos); | |
1645 | |
1646 #if 0 | |
1647 /* If the mouse moves out of the menu before we show the menu, | |
1648 don't show it at all. */ | |
1649 if (check_mouse_other_menu_bar (f)) | |
1650 { | |
1651 DestroyMenu (hmenu); | |
1652 return Qnil; | |
1653 } | |
1654 #endif | |
1655 | |
1656 /* Display the menu. */ | |
1657 menu_selection = TrackPopupMenu (hmenu, | |
1658 0x10, | |
1659 pos.x, pos.y, | |
1660 0, | |
1661 FRAME_WIN32_WINDOW (f), | |
1662 NULL); | |
1663 if (menu_selection == -1) | |
1664 { | |
1665 *error = "Invalid menu specification"; | |
1666 return Qnil; | |
1667 } | |
1668 | |
1669 /* Find the selected item, and its pane, to return | |
1670 the proper value. */ | |
1671 | |
1672 #if 1 | |
1673 if (menu_selection > 0) | |
1674 { | |
1675 return get_menu_event (menu, menu_selection); | |
1676 } | |
1677 #else | |
1678 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used) | |
1679 { | |
1680 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]); | |
1681 } | |
1682 #endif | |
1683 | |
1684 return Qnil; | |
1685 } | |
1686 | |
1687 #if 0 | |
1688 static char * button_names [] = | |
1689 { | |
1690 "button1", "button2", "button3", "button4", "button5", | |
1691 "button6", "button7", "button8", "button9", "button10" | |
1692 }; | |
1693 | |
1694 static Lisp_Object | |
1695 win32_dialog_show (f, menubarp, keymaps, title, error) | |
1696 FRAME_PTR f; | |
1697 int menubarp; | |
1698 int keymaps; | |
1699 Lisp_Object title; | |
1700 char **error; | |
1701 { | |
1702 int i, nb_buttons=0; | |
1703 HMENU hmenu; | |
1704 char dialog_name[6]; | |
1705 | |
1706 /* Number of elements seen so far, before boundary. */ | |
1707 int left_count = 0; | |
1708 /* 1 means we've seen the boundary between left-hand elts and right-hand. */ | |
1709 int boundary_seen = 0; | |
1710 | |
1711 *error = NULL; | |
1712 | |
1713 if (menu_items_n_panes > 1) | |
1714 { | |
1715 *error = "Multiple panes in dialog box"; | |
1716 return Qnil; | |
1717 } | |
1718 | |
1719 /* Create a tree of widget_value objects | |
1720 representing the text label and buttons. */ | |
1721 { | |
1722 Lisp_Object pane_name, prefix; | |
1723 char *pane_string; | |
1724 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME]; | |
1725 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX]; | |
1726 pane_string = (NILP (pane_name) | |
1727 ? "" : (char *) XSTRING (pane_name)->data); | |
1728 prev_wv = malloc_widget_value (); | |
1729 prev_wv->value = pane_string; | |
1730 if (keymaps && !NILP (prefix)) | |
1731 prev_wv->name++; | |
1732 prev_wv->enabled = 1; | |
1733 prev_wv->name = "message"; | |
1734 first_wv = prev_wv; | |
1735 | |
1736 /* Loop over all panes and items, filling in the tree. */ | |
1737 i = MENU_ITEMS_PANE_LENGTH; | |
1738 while (i < menu_items_used) | |
1739 { | |
1740 | |
1741 /* Create a new item within current pane. */ | |
1742 Lisp_Object item_name, enable, descrip; | |
1743 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; | |
1744 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; | |
1745 descrip | |
1746 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; | |
1747 | |
1748 if (NILP (item_name)) | |
1749 { | |
1750 free_menubar_widget_value_tree (first_wv); | |
1751 *error = "Submenu in dialog items"; | |
1752 return Qnil; | |
1753 } | |
1754 if (EQ (item_name, Qquote)) | |
1755 { | |
1756 /* This is the boundary between left-side elts | |
1757 and right-side elts. Stop incrementing right_count. */ | |
1758 boundary_seen = 1; | |
1759 i++; | |
1760 continue; | |
1761 } | |
1762 if (nb_buttons >= 10) | |
1763 { | |
1764 free_menubar_widget_value_tree (first_wv); | |
1765 *error = "Too many dialog items"; | |
1766 return Qnil; | |
1767 } | |
1768 | |
1769 wv = malloc_widget_value (); | |
1770 prev_wv->next = wv; | |
1771 wv->name = (char *) button_names[nb_buttons]; | |
1772 if (!NILP (descrip)) | |
1773 wv->key = (char *) XSTRING (descrip)->data; | |
1774 wv->value = (char *) XSTRING (item_name)->data; | |
1775 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; | |
1776 wv->enabled = !NILP (enable); | |
1777 prev_wv = wv; | |
1778 | |
1779 if (! boundary_seen) | |
1780 left_count++; | |
1781 | |
1782 nb_buttons++; | |
1783 i += MENU_ITEMS_ITEM_LENGTH; | |
1784 } | |
1785 | |
1786 /* If the boundary was not specified, | |
1787 by default put half on the left and half on the right. */ | |
1788 if (! boundary_seen) | |
1789 left_count = nb_buttons - nb_buttons / 2; | |
1790 | |
1791 wv = malloc_widget_value (); | |
1792 wv->name = dialog_name; | |
1793 | |
1794 /* Dialog boxes use a really stupid name encoding | |
1795 which specifies how many buttons to use | |
1796 and how many buttons are on the right. | |
1797 The Q means something also. */ | |
1798 dialog_name[0] = 'Q'; | |
1799 dialog_name[1] = '0' + nb_buttons; | |
1800 dialog_name[2] = 'B'; | |
1801 dialog_name[3] = 'R'; | |
1802 /* Number of buttons to put on the right. */ | |
1803 dialog_name[4] = '0' + nb_buttons - left_count; | |
1804 dialog_name[5] = 0; | |
1805 wv->contents = first_wv; | |
1806 first_wv = wv; | |
1807 } | |
1808 | |
1809 /* Actually create the dialog. */ | |
1810 dialog_id = ++popup_id_tick; | |
1811 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, | |
1812 f->output_data.win32->widget, 1, 0, | |
1813 dialog_selection_callback, 0); | |
1814 #if 0 /* This causes crashes, and seems to be redundant -- rms. */ | |
1815 lw_modify_all_widgets (dialog_id, first_wv, True); | |
1816 #endif | |
1817 lw_modify_all_widgets (dialog_id, first_wv->contents, True); | |
1818 /* Free the widget_value objects we used to specify the contents. */ | |
1819 free_menubar_widget_value_tree (first_wv); | |
1820 | |
1821 /* No selection has been chosen yet. */ | |
1822 menu_item_selection = 0; | |
1823 | |
1824 /* Display the menu. */ | |
1825 lw_pop_up_all_widgets (dialog_id); | |
1826 | |
1827 /* Process events that apply to the menu. */ | |
1828 while (1) | |
1829 { | |
1830 XEvent event; | |
1831 | |
1832 XtAppNextEvent (Xt_app_con, &event); | |
1833 if (event.type == ButtonRelease) | |
1834 { | |
1835 XtDispatchEvent (&event); | |
1836 break; | |
1837 } | |
1838 else if (event.type == Expose) | |
1839 process_expose_from_menu (event); | |
1840 XtDispatchEvent (&event); | |
1841 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu) | |
1842 { | |
1843 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue)); | |
1844 | |
1845 if (queue_tmp != NULL) | |
1846 { | |
1847 queue_tmp->event = event; | |
1848 queue_tmp->next = queue; | |
1849 queue = queue_tmp; | |
1850 } | |
1851 } | |
1852 } | |
1853 pop_down: | |
1854 | |
1855 /* State that no mouse buttons are now held. | |
1856 That is not necessarily true, but the fiction leads to reasonable | |
1857 results, and it is a pain to ask which are actually held now | |
1858 or track this in the loop above. */ | |
1859 win32_mouse_grabbed = 0; | |
1860 | |
1861 /* Unread any events that we got but did not handle. */ | |
1862 while (queue != NULL) | |
1863 { | |
1864 queue_tmp = queue; | |
1865 XPutBackEvent (XDISPLAY &queue_tmp->event); | |
1866 queue = queue_tmp->next; | |
1867 free ((char *)queue_tmp); | |
1868 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */ | |
1869 interrupt_input_pending = 1; | |
1870 } | |
1871 | |
1872 /* Find the selected item, and its pane, to return | |
1873 the proper value. */ | |
1874 if (menu_item_selection != 0) | |
1875 { | |
1876 Lisp_Object prefix; | |
1877 | |
1878 prefix = Qnil; | |
1879 i = 0; | |
1880 while (i < menu_items_used) | |
1881 { | |
1882 Lisp_Object entry; | |
1883 | |
1884 if (EQ (XVECTOR (menu_items)->contents[i], Qt)) | |
1885 { | |
1886 prefix | |
1887 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; | |
1888 i += MENU_ITEMS_PANE_LENGTH; | |
1889 } | |
1890 else | |
1891 { | |
1892 entry | |
1893 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; | |
1894 if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) | |
1895 { | |
1896 if (keymaps != 0) | |
1897 { | |
1898 entry = Fcons (entry, Qnil); | |
1899 if (!NILP (prefix)) | |
1900 entry = Fcons (prefix, entry); | |
1901 } | |
1902 return entry; | |
1903 } | |
1904 i += MENU_ITEMS_ITEM_LENGTH; | |
1905 } | |
1906 } | |
1907 } | |
1908 | |
1909 return Qnil; | |
1910 } | |
1911 #endif | |
1912 | |
1913 syms_of_win32menu () | |
1914 { | |
1915 defsubr (&Sx_popup_menu); | |
1916 defsubr (&Sx_popup_dialog); | |
1917 } |