(Fy_or_n_p): Use a popup menu if reached via mouse command.
[bpt/emacs.git] / src / xmenu.c
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 /* X pop-up deck-of-cards menu facility for gnuemacs.
21 *
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
24 *
25 */
26
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
29
30 #include <stdio.h>
31
32 /* On 4.3 this loses if it comes after xterm.h. */
33 #include <signal.h>
34 #include <config.h>
35 #include "lisp.h"
36 #include "termhooks.h"
37 #include "frame.h"
38 #include "window.h"
39 #include "keyboard.h"
40 #include "blockinput.h"
41
42 /* This may include sys/types.h, and that somehow loses
43 if this is not done before the other system files. */
44 #include "xterm.h"
45
46 /* Load sys/types.h if not already loaded.
47 In some systems loading it twice is suicidal. */
48 #ifndef makedev
49 #include <sys/types.h>
50 #endif
51
52 #include "dispextern.h"
53
54 #ifdef HAVE_X11
55 #include "../oldXMenu/XMenu.h"
56 #else
57 #include <X/XMenu.h>
58 #endif
59
60 #ifdef USE_X_TOOLKIT
61 #include <X11/Xlib.h>
62 #include <X11/IntrinsicP.h>
63 #include <X11/CoreP.h>
64 #include <X11/StringDefs.h>
65 #include <X11/Xaw/Paned.h>
66 #include "../lwlib/lwlib.h"
67 #include "../lwlib/xlwmenuP.h"
68 #endif /* USE_X_TOOLKIT */
69
70 #define min(x,y) (((x) < (y)) ? (x) : (y))
71 #define max(x,y) (((x) > (y)) ? (x) : (y))
72
73 #define NUL 0
74
75 #ifndef TRUE
76 #define TRUE 1
77 #define FALSE 0
78 #endif /* TRUE */
79
80 #ifdef HAVE_X11
81 extern Display *x_current_display;
82 #else
83 #define ButtonReleaseMask ButtonReleased
84 #endif /* not HAVE_X11 */
85
86 extern Lisp_Object Qmenu_enable;
87 extern Lisp_Object Qmenu_bar;
88 Lisp_Object xmenu_show ();
89 extern int x_error_handler ();
90 #ifdef USE_X_TOOLKIT
91 static widget_value *set_menu_items ();
92 static int string_width ();
93 static void free_menu_items ();
94 #endif
95
96 /* we need a unique id for each popup menu and dialog box */
97 unsigned int popup_id_tick;
98
99 /*************************************************************/
100
101 #if 0
102 /* Ignoring the args is easiest. */
103 xmenu_quit ()
104 {
105 error ("Unknown XMenu error");
106 }
107 #endif
108
109 \f
110 DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0,
111 "Pop up a deck-of-cards menu and return user's selection.\n\
112 POSITION is a position specification. This is either a mouse button event\n\
113 or a list ((XOFFSET YOFFSET) WINDOW)\n\
114 where XOFFSET and YOFFSET are positions in characters from the top left\n\
115 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
116 This controls the position of the center of the first line\n\
117 in the first pane of the menu, not the top left of the menu as a whole.\n\
118 \n\
119 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
120 The menu items come from key bindings that have a menu string as well as\n\
121 a definition; actually, the \"definition\" in such a key binding looks like\n\
122 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
123 the keymap as a top-level element.\n\n\
124 You can also use a list of keymaps as MENU.\n\
125 Then each keymap makes a separate pane.\n\
126 When MENU is a keymap or a list of keymaps, the return value\n\
127 is a list of events.\n\n\
128 Alternatively, you can specify a menu of multiple panes\n\
129 with a list of the form (TITLE PANE1 PANE2...),\n\
130 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
131 Each ITEM is normally a cons cell (STRING . VALUE);\n\
132 but a string can appear as an item--that makes a nonselectable line\n\
133 in the menu.\n\
134 With this form of menu, the return value is VALUE from the chosen item.")
135 (position, menu)
136 Lisp_Object position, menu;
137 {
138 int number_of_panes, panes;
139 Lisp_Object XMenu_return, keymap, tem;
140 int XMenu_xpos, XMenu_ypos;
141 char **menus;
142 char ***names;
143 int **enables;
144 Lisp_Object **obj_list;
145 Lisp_Object *prefixes;
146 int *items;
147 char *title;
148 char *error_name;
149 Lisp_Object ltitle, selection;
150 int i, j, menubarp = 0;
151 FRAME_PTR f;
152 Lisp_Object x, y, window;
153 #ifdef USE_X_TOOLKIT
154 widget_value *val, *vw = 0;
155 #endif /* USE_X_TOOLKIT */
156
157 check_x ();
158 /* Decode the first argument: find the window and the coordinates. */
159 tem = Fcar (position);
160 if (XTYPE (tem) == Lisp_Cons)
161 {
162 window = Fcar (Fcdr (position));
163 x = Fcar (tem);
164 y = Fcar (Fcdr (tem));
165 }
166 else
167 {
168 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
169 window = Fcar (tem); /* POSN_WINDOW (tem) */
170 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
171 x = Fcar (tem);
172 y = Fcdr (tem);
173 }
174 CHECK_NUMBER (x, 0);
175 CHECK_NUMBER (y, 0);
176
177 if (XTYPE (window) == Lisp_Frame)
178 {
179 f = XFRAME (window);
180
181 XMenu_xpos = 0;
182 XMenu_ypos = 0;
183 }
184 else if (XTYPE (window) == Lisp_Window)
185 {
186 CHECK_LIVE_WINDOW (window, 0);
187 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
188
189 XMenu_xpos = FONT_WIDTH (f->display.x->font)
190 * XWINDOW (window)->left;
191 XMenu_ypos = FONT_HEIGHT (f->display.x->font)
192 * XWINDOW (window)->top;
193 }
194 else
195 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
196 but I don't want to make one now. */
197 CHECK_WINDOW (window, 0);
198
199 #ifdef USE_X_TOOLKIT
200 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
201 if (XTYPE (Fcar (position)) != Lisp_Cons
202 && CONSP (tem)
203 && EQ (Fcar (tem), Qmenu_bar))
204 {
205 /* We are in the menubar */
206 XlwMenuWidget mw;
207 int w1 = 0, w2;
208
209 mw = (XlwMenuWidget)f->display.x->menubar_widget;
210 menubarp = 1;
211 for (vw = mw->menu.old_stack [0]->contents; vw; vw = vw->next)
212 {
213 w2 = w1;
214 w1 += string_width (mw, vw->name)
215 + 2 * (mw->menu.horizontal_spacing +
216 mw->menu.shadow_thickness);
217 if (XINT (x) < w1)
218 {
219 XMenu_xpos = w2 + 4;
220 XMenu_ypos = 0;
221 break;
222 }
223 }
224 }
225 else
226 {
227 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
228 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
229 }
230
231 BLOCK_INPUT;
232 XMenu_xpos += (f->display.x->widget->core.x
233 + f->display.x->widget->core.border_width);
234 XMenu_ypos += (f->display.x->widget->core.y
235 + f->display.x->widget->core.border_width
236 + f->display.x->menubar_widget->core.height);
237 UNBLOCK_INPUT;
238
239 val = set_menu_items (menu, &prefixes, &panes, &names,
240 &enables, &menus, &items, &number_of_panes, &obj_list,
241 &title, &error_name);
242 selection = xmenu_show (f, val, XMenu_xpos, XMenu_ypos,
243 menubarp, vw);
244
245 free_menu_items (names, enables, menus, items, number_of_panes, obj_list,
246 title, error_name);
247
248 if (selection != NUL)
249 { /* selected something */
250 XMenu_return = selection;
251 }
252 else
253 { /* nothing selected */
254 XMenu_return = Qnil;
255 }
256
257 return XMenu_return;
258
259 #else /* not USE_X_TOOLKIT */
260 #ifdef HAVE_X11
261 {
262 Window child;
263 int win_x = 0, win_y = 0;
264
265 /* Find the position of the outside upper-left corner of
266 the inner window, with respect to the outer window. */
267 if (f->display.x->parent_desc != ROOT_WINDOW)
268 {
269 BLOCK_INPUT;
270 XTranslateCoordinates (x_current_display,
271
272 /* From-window, to-window. */
273 f->display.x->window_desc,
274 f->display.x->parent_desc,
275
276 /* From-position, to-position. */
277 0, 0, &win_x, &win_y,
278
279 /* Child of window. */
280 &child);
281 UNBLOCK_INPUT;
282 XMenu_xpos += win_x;
283 XMenu_ypos += win_y;
284 }
285 }
286 #endif /* HAVE_X11 */
287
288 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
289 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
290
291 XMenu_xpos += f->display.x->left_pos;
292 XMenu_ypos += f->display.x->top_pos;
293
294
295 keymap = Fkeymapp (menu);
296 tem = Qnil;
297 if (XTYPE (menu) == Lisp_Cons)
298 tem = Fkeymapp (Fcar (menu));
299 if (!NILP (keymap))
300 {
301 /* We were given a keymap. Extract menu info from the keymap. */
302 Lisp_Object prompt;
303 keymap = get_keymap (menu);
304
305 /* Search for a string appearing directly as an element of the keymap.
306 That string is the title of the menu. */
307 prompt = map_prompt (keymap);
308 if (!NILP (prompt))
309 title = (char *) XSTRING (prompt)->data;
310
311 /* Extract the detailed info to make one pane. */
312 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
313 &items, &prefixes, &menu, 1);
314 /* The menu title seems to be ignored,
315 so put it in the pane title. */
316 if (menus[0] == 0)
317 menus[0] = title;
318 }
319 else if (!NILP (tem))
320 {
321 /* We were given a list of keymaps. */
322 Lisp_Object prompt;
323 int nmaps = XFASTINT (Flength (menu));
324 Lisp_Object *maps
325 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
326 int i;
327 title = 0;
328
329 /* The first keymap that has a prompt string
330 supplies the menu title. */
331 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
332 {
333 maps[i++] = keymap = get_keymap (Fcar (tem));
334
335 prompt = map_prompt (keymap);
336 if (title == 0 && !NILP (prompt))
337 title = (char *) XSTRING (prompt)->data;
338 }
339
340 /* Extract the detailed info to make one pane. */
341 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
342 &items, &prefixes, maps, nmaps);
343 /* The menu title seems to be ignored,
344 so put it in the pane title. */
345 if (menus[0] == 0)
346 menus[0] = title;
347 }
348 else
349 {
350 /* We were given an old-fashioned menu. */
351 ltitle = Fcar (menu);
352 CHECK_STRING (ltitle, 1);
353 title = (char *) XSTRING (ltitle)->data;
354 prefixes = 0;
355 number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
356 &items, Fcdr (menu));
357 }
358 #ifdef XDEBUG
359 fprintf (stderr, "Panes = %d\n", number_of_panes);
360 for (i = 0; i < number_of_panes; i++)
361 {
362 fprintf (stderr, "Pane %d has lines %d title %s\n",
363 i, items[i], menus[i]);
364 for (j = 0; j < items[i]; j++)
365 fprintf (stderr, " Item %d %s\n", j, names[i][j]);
366 }
367 #endif
368
369 BLOCK_INPUT;
370 {
371 Window root;
372 int root_x, root_y;
373 int dummy_int;
374 unsigned int dummy_uint;
375 Window dummy_window;
376
377 /* Figure out which root window F is on. */
378 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
379 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
380 &dummy_uint, &dummy_uint);
381
382 /* Translate the menu co-ordinates within f to menu co-ordinates
383 on that root window. */
384 if (! XTranslateCoordinates (x_current_display,
385 FRAME_X_WINDOW (f), root,
386 XMenu_xpos, XMenu_ypos, &root_x, &root_y,
387 &dummy_window))
388 /* But XGetGeometry said root was the root window of f's screen! */
389 abort ();
390 selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
391 menus, prefixes, items, number_of_panes, obj_list,
392 title, &error_name);
393 }
394 UNBLOCK_INPUT;
395 /* fprintf (stderr, "selection = %x\n", selection); */
396 if (selection != NUL)
397 { /* selected something */
398 XMenu_return = selection;
399 }
400 else
401 { /* nothing selected */
402 XMenu_return = Qnil;
403 }
404 /* now free up the strings */
405 for (i = 0; i < number_of_panes; i++)
406 {
407 xfree (names[i]);
408 xfree (enables[i]);
409 xfree (obj_list[i]);
410 }
411 xfree (menus);
412 xfree (obj_list);
413 xfree (names);
414 xfree (enables);
415 xfree (items);
416 /* free (title); */
417 if (error_name) error (error_name);
418 return XMenu_return;
419 #endif /* not USE_X_TOOLKIT */
420 }
421 \f
422 #ifdef USE_X_TOOLKIT
423
424 static void
425 dispatch_dummy_expose (w, x, y)
426 Widget w;
427 int x;
428 int y;
429 {
430 XExposeEvent dummy;
431
432 dummy.type = Expose;
433 dummy.window = XtWindow (w);
434 dummy.count = 0;
435 dummy.serial = 0;
436 dummy.send_event = 0;
437 dummy.display = XtDisplay (w);
438 dummy.x = x;
439 dummy.y = y;
440
441 XtDispatchEvent (&dummy);
442 }
443
444 static int
445 string_width (mw, s)
446 XlwMenuWidget mw;
447 char* s;
448 {
449 XCharStruct xcs;
450 int drop;
451
452 XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs);
453 return xcs.width;
454 }
455
456 static int
457 event_is_in_menu_item (mw, event, name, string_w)
458 XlwMenuWidget mw;
459 struct input_event *event;
460 char *name;
461 int *string_w;
462 {
463 *string_w += string_width (mw, name)
464 + 2 * (mw->menu.horizontal_spacing + mw->menu.shadow_thickness);
465 return (XINT (event->x) < *string_w);
466 }
467
468
469 Lisp_Object
470 map_event_to_object (event, f)
471 struct input_event *event;
472 FRAME_PTR f;
473 {
474 int i,j, string_w;
475 window_state* ws;
476 XlwMenuWidget mw = (XlwMenuWidget) f->display.x->menubar_widget;
477 widget_value *val;
478
479
480 string_w = 0;
481 /* Find the window */
482 for (val = mw->menu.old_stack [0]->contents; val; val = val->next)
483 {
484 ws = &mw->menu.windows [0];
485 if (ws && event_is_in_menu_item (mw, event, val->name, &string_w))
486 {
487 Lisp_Object items;
488 items = FRAME_MENU_BAR_ITEMS (f);
489 for (; CONSP (items); items = XCONS (items)->cdr)
490 if (!strcmp (val->name,
491 XSTRING (Fcar (Fcdr (Fcar (items))))->data))
492 return items;
493 }
494 }
495 return Qnil;
496 }
497
498 static widget_value *
499 set_menu_items (menu, prefixes, panes, names, enables, menus,
500 items, number_of_panes, obj_list, title, error_name)
501 Lisp_Object menu;
502 Lisp_Object **prefixes;
503 int *panes;
504 char ***names[];
505 int ***enables;
506 char ***menus;
507 int **items;
508 int *number_of_panes;
509 Lisp_Object ***obj_list;
510 char **title;
511 char **error_name;
512 {
513 Lisp_Object keymap, tem;
514 Lisp_Object ltitle, selection;
515 int i, j;
516 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
517 int last, selidx, lpane, status;
518 int lines, sofar;
519
520 keymap = Fkeymapp (menu);
521 tem = Qnil;
522
523 if (XTYPE (menu) == Lisp_Cons)
524 tem = Fkeymapp (Fcar (menu));
525 if (!NILP (keymap))
526 {
527 /* We were given a keymap. Extract menu info from the keymap. */
528 Lisp_Object prompt;
529 keymap = get_keymap (menu);
530
531 /* Search for a string appearing directly as an element of the keymap.
532 That string is the title of the menu. */
533 prompt = map_prompt (keymap);
534 if (!NILP (prompt))
535 *title = (char *) XSTRING (prompt)->data;
536
537 /* Extract the detailed info to make one pane. */
538 *number_of_panes = keymap_panes (obj_list, menus, names, enables,
539 items, prefixes, menu, 1);
540 /* The menu title seems to be ignored,
541 so put it in the pane title. */
542 if ((*menus)[0] == 0)
543 (*menus)[0] = *title;
544 }
545 else if (!NILP (tem))
546 {
547 /* We were given a list of keymaps. */
548 Lisp_Object prompt;
549 int nmaps = XFASTINT (Flength (menu));
550 Lisp_Object *maps
551 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
552 int i;
553 *title = 0;
554
555 /* The first keymap that has a prompt string
556 supplies the menu title. */
557 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
558 {
559 maps[i++] = keymap = get_keymap (Fcar (tem));
560
561 prompt = map_prompt (keymap);
562 if (*title == 0 && !NILP (prompt))
563 *title = (char *) XSTRING (prompt)->data;
564 }
565
566 /* Extract the detailed info to make one pane. */
567 *number_of_panes = keymap_panes (obj_list, menus, names, enables,
568 items, prefixes, maps, nmaps);
569 /* The menu title seems to be ignored,
570 so put it in the pane title. */
571 if ((*menus)[0] == 0)
572 (*menus)[0] = *title;
573 }
574 else
575 {
576 /* We were given an old-fashioned menu. */
577 ltitle = Fcar (menu);
578 CHECK_STRING (ltitle, 1);
579 *title = (char *) XSTRING (ltitle)->data;
580 *prefixes = 0;
581 *number_of_panes = list_of_panes (obj_list, menus, names, enables,
582 items, Fcdr (menu));
583 }
584
585 *error_name = 0;
586 if (*number_of_panes == 0)
587 return 0;
588
589 *error_name = (char *) 0; /* Initialize error pointer to null */
590
591 wv = malloc_widget_value ();
592 wv->name = "menu";
593 wv->value = 0;
594 wv->enabled = 1;
595 first_wv = wv;
596
597 for (*panes = 0, lines = 0; *panes < *number_of_panes;
598 lines += (*items)[*panes], (*panes)++)
599 ;
600 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
601 /* datap = (char *) xmalloc (lines * sizeof (char));
602 datap_save = datap;*/
603
604 for (*panes = 0, sofar = 0; *panes < *number_of_panes;
605 sofar += (*items)[*panes], (*panes)++)
606 {
607 if (strcmp((*menus)[*panes], ""))
608 {
609 wv = malloc_widget_value ();
610 if (save_wv)
611 save_wv->next = wv;
612 else
613 first_wv->contents = wv;
614 wv->name = (*menus)[*panes];
615 wv->value = 0;
616 wv->enabled = 1;
617 }
618 prev_wv = 0;
619 save_wv = wv;
620
621 for (selidx = 0; selidx < (*items)[*panes]; selidx++)
622 {
623 wv = malloc_widget_value ();
624 if (prev_wv)
625 prev_wv->next = wv;
626 else
627 save_wv->contents = wv;
628 wv->name = (*names)[*panes][selidx];
629 wv->value = 0;
630 selection = (*obj_list)[*panes][selidx];
631 if (*prefixes != 0)
632 {
633 selection = Fcons (selection, Qnil);
634 if (!NILP ((*prefixes)[*panes]))
635 selection = Fcons ((*prefixes)[*panes], selection);
636 }
637 wv->call_data = LISP_TO_VOID(selection);
638 wv->enabled = (*enables)[*panes][selidx];
639 prev_wv = wv;
640 }
641 }
642
643 return (first_wv);
644 }
645
646 static void
647 free_menu_items (names, enables, menus, items, number_of_panes,
648 obj_list, title, error_name)
649 char **names[];
650 int *enables[];
651 char **menus;
652 int *items;
653 int number_of_panes;
654 Lisp_Object **obj_list;
655 char *title;
656 char *error_name;
657 {
658 int i;
659 /* now free up the strings */
660 for (i = 0; i < number_of_panes; i++)
661 {
662 xfree (names[i]);
663 xfree (enables[i]);
664 xfree (obj_list[i]);
665 }
666 xfree (menus);
667 xfree (obj_list);
668 xfree (names);
669 xfree (enables);
670 xfree (items);
671 /* free (title); */
672 if (error_name) error (error_name);
673
674 }
675
676 static Lisp_Object menu_item_selection;
677
678 static void
679 popup_selection_callback (widget, id, client_data)
680 Widget widget;
681 LWLIB_ID id;
682 XtPointer client_data;
683 {
684 VOID_TO_LISP (menu_item_selection, client_data);
685 }
686
687 static void
688 popup_down_callback (widget, id, client_data)
689 Widget widget;
690 LWLIB_ID id;
691 XtPointer client_data;
692 {
693 BLOCK_INPUT;
694 lw_destroy_all_widgets (id);
695 UNBLOCK_INPUT;
696 }
697
698 /* This recursively calls free_widget_value() on the tree of widgets.
699 It must free all data that was malloc'ed for these widget_values.
700 Currently, emacs only allocates new storage for the `key' slot.
701 All other slots are pointers into the data of Lisp_Strings, and
702 must be left alone.
703 */
704 void
705 free_menubar_widget_value_tree (wv)
706 widget_value *wv;
707 {
708 if (! wv) return;
709 if (wv->key) xfree (wv->key);
710
711 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
712
713 if (wv->contents && (wv->contents != (widget_value*)1))
714 {
715 free_menubar_widget_value_tree (wv->contents);
716 wv->contents = (widget_value *) 0xDEADBEEF;
717 }
718 if (wv->next)
719 {
720 free_menubar_widget_value_tree (wv->next);
721 wv->next = (widget_value *) 0xDEADBEEF;
722 }
723 BLOCK_INPUT;
724 free_widget_value (wv);
725 UNBLOCK_INPUT;
726 }
727
728 static void
729 update_one_frame_psheets (f)
730 FRAME_PTR f;
731 {
732 struct x_display *x = f->display.x;
733
734 int menubar_changed;
735
736 menubar_changed = (x->menubar_widget
737 && !XtIsManaged (x->menubar_widget));
738
739 if (! (menubar_changed))
740 return;
741
742 BLOCK_INPUT;
743 XawPanedSetRefigureMode (x->column_widget, 0);
744
745 /* the order in which children are managed is the top to
746 bottom order in which they are displayed in the paned window.
747 First, remove the text-area widget.
748 */
749 XtUnmanageChild (x->edit_widget);
750
751 /* remove the menubar that is there now, and put up the menubar that
752 should be there.
753 */
754 if (menubar_changed)
755 {
756 XtManageChild (x->menubar_widget);
757 XtMapWidget (x->menubar_widget);
758 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
759 }
760
761
762 /* Re-manage the text-area widget */
763 XtManageChild (x->edit_widget);
764
765 /* and now thrash the sizes */
766 XawPanedSetRefigureMode (x->column_widget, 1);
767 UNBLOCK_INPUT;
768 }
769
770 void
771 set_frame_menubar (f)
772 FRAME_PTR f;
773 {
774 Widget menubar_widget = f->display.x->menubar_widget;
775 int id = (int) f;
776 Lisp_Object tail;
777 widget_value *wv, *save_wv, *first_wv, *prev_wv = 0;
778
779 BLOCK_INPUT;
780
781 wv = malloc_widget_value ();
782 wv->name = "menubar";
783 wv->value = 0;
784 wv->enabled = 1;
785 save_wv = first_wv = wv;
786
787
788 for (tail = FRAME_MENU_BAR_ITEMS (f); CONSP (tail); tail = XCONS (tail)->cdr)
789 {
790 Lisp_Object string;
791
792 string = Fcar (Fcdr (Fcar (tail)));
793
794 wv = malloc_widget_value ();
795 if (prev_wv)
796 prev_wv->next = wv;
797 else
798 save_wv->contents = wv;
799 wv->name = XSTRING (string)->data;
800 wv->value = 0;
801 wv->enabled = 1;
802 prev_wv = wv;
803 }
804
805 if (menubar_widget)
806 lw_modify_all_widgets (id, first_wv, False);
807 else
808 {
809 menubar_widget = lw_create_widget ("menubar", "menubar",
810 id, first_wv,
811 f->display.x->column_widget,
812 0, 0,
813 0, 0);
814 f->display.x->menubar_widget = menubar_widget;
815 XtVaSetValues (menubar_widget,
816 XtNshowGrip, 0,
817 XtNresizeToPreferred, 1,
818 XtNallowResize, 1,
819 0);
820 }
821
822 free_menubar_widget_value_tree (first_wv);
823
824 update_one_frame_psheets (f);
825
826 UNBLOCK_INPUT;
827 }
828
829 void
830 free_frame_menubar (f)
831 FRAME_PTR f;
832 {
833 Widget menubar_widget;
834 int id;
835
836 menubar_widget = f->display.x->menubar_widget;
837 id = (int) f;
838
839 if (menubar_widget)
840 {
841 BLOCK_INPUT;
842 lw_destroy_all_widgets (id);
843 UNBLOCK_INPUT;
844 }
845 }
846 #endif /* USE_X_TOOLKIT */
847 \f
848 struct indices {
849 int pane;
850 int line;
851 };
852
853 extern void process_expose_from_menu ();
854
855 #ifdef USE_X_TOOLKIT
856 extern XtAppContext Xt_app_con;
857
858 Lisp_Object
859 xmenu_show (f, val, x, y, menubarp, vw)
860 FRAME_PTR f;
861 widget_value *val;
862 int x;
863 int y;
864 int menubarp;
865 widget_value *vw;
866 {
867 int menu_id, item_length;
868 Lisp_Object selection;
869 Widget menu;
870 XlwMenuWidget menuw = (XlwMenuWidget) f->display.x->menubar_widget;
871
872 /*
873 * Define and allocate a foreign event queue to hold events
874 * that don't belong to XMenu. These events are later restored
875 * to the X event queue.
876 */
877 typedef struct _xmeventque
878 {
879 XEvent event;
880 struct _xmeventque *next;
881 } XMEventQue;
882
883 XMEventQue *feq = NULL; /* Foreign event queue. */
884 XMEventQue *feq_tmp; /* Foreign event queue temporary. */
885
886 BLOCK_INPUT;
887 if (val == 0) return Qnil;
888
889 menu_id = ++popup_id_tick;
890 menu = lw_create_widget ("popup", val->name, menu_id, val,
891 f->display.x->widget, 1, 0,
892 popup_selection_callback, popup_down_callback);
893 free_menubar_widget_value_tree (val);
894
895 /* reset the selection */
896 menu_item_selection = Qnil;
897
898 {
899 XButtonPressedEvent dummy;
900 XlwMenuWidget mw;
901
902 mw = ((XlwMenuWidget)
903 ((CompositeWidget)menu)->composite.children[0]);
904
905 dummy.type = ButtonPress;
906 dummy.serial = 0;
907 dummy.send_event = 0;
908 dummy.display = XtDisplay (menu);
909 dummy.window = XtWindow (XtParent (menu));
910 dummy.time = CurrentTime;
911 dummy.button = 0;
912 dummy.x_root = x;
913 dummy.y_root = y;
914
915 if (menubarp)
916 {
917 vw->call_data = (XtPointer) 1;
918 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
919 }
920
921
922 /* We activate directly the lucid implementation */
923 pop_up_menu (mw, &dummy);
924 }
925
926 if (menubarp)
927 {
928 item_length = (x + string_width (menuw, vw->name)
929 + (2 * (menuw->menu.horizontal_spacing
930 + menuw->menu.shadow_thickness))
931 - 4);
932 }
933
934 /* Enters XEvent loop */
935 while (1)
936 {
937
938 XEvent event;
939 XtAppNextEvent (Xt_app_con, &event);
940 if (event.type == ButtonRelease)
941 {
942 XtDispatchEvent (&event);
943 break;
944 }
945 else
946 if (event.type == Expose)
947 process_expose_from_menu (event);
948 else
949 if (event.type == MotionNotify
950 && menubarp
951 && ((event.xmotion.y_root
952 >= (f->display.x->widget->core.y
953 + f->display.x->widget->core.border_width))
954 && (event.xmotion.y_root
955 < (f->display.x->widget->core.y
956 + f->display.x->widget->core.border_width
957 + f->display.x->menubar_widget->core.height)))
958 && ((event.xmotion.x_root
959 >= (f->display.x->widget->core.x
960 + f->display.x->widget->core.border_width))
961 && (event.xmotion.x_root
962 < (f->display.x->widget->core.x
963 + f->display.x->widget->core.border_width
964 + f->display.x->widget->core.width)))
965 && (event.xmotion.x_root >= item_length
966 || event.xmotion.x_root < (x - 4)))
967 {
968 BLOCK_INPUT;
969 XtUngrabPointer ((Widget)
970 ((XlwMenuWidget)
971 ((CompositeWidget)menu)->composite.children[0]),
972 event.xbutton.time);
973 lw_destroy_all_widgets (menu_id);
974 UNBLOCK_INPUT;
975
976 event.type = ButtonPress;
977 event.xbutton.time = CurrentTime;
978 event.xbutton.button = Button1;
979 event.xbutton.window = XtWindow (f->display.x->menubar_widget);
980 event.xbutton.x = (event.xbutton.x_root
981 - (f->display.x->widget->core.x
982 + f->display.x->widget->core.border_width));
983 XPutBackEvent (XDISPLAY &event);
984 break;
985 }
986
987 XtDispatchEvent (&event);
988 feq_tmp = (XMEventQue *) malloc (sizeof (XMEventQue));
989
990 if (feq_tmp == NULL)
991 return(Qnil);
992
993 feq_tmp->event = event;
994 feq_tmp->next = feq;
995 feq = feq_tmp;
996 }
997
998 if (menubarp)
999 {
1000 vw->call_data = (XtPointer) 0;
1001 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
1002 }
1003
1004 /* Return any foreign events that were queued to the X event queue. */
1005 while (feq != NULL)
1006 {
1007 feq_tmp = feq;
1008 XPutBackEvent (XDISPLAY &feq_tmp->event);
1009 feq = feq_tmp->next;
1010 free ((char *)feq_tmp);
1011 }
1012
1013 UNBLOCK_INPUT;
1014
1015 return menu_item_selection;
1016 }
1017
1018 #else /* not USE_X_TOOLKIT */
1019 xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
1020 prefixes, line_cnt, pane_cnt, item_list, title, error)
1021 Window parent;
1022 int startx, starty; /* upper left corner position BROKEN */
1023 char **line_list[]; /* list of strings for items */
1024 int *enable_list[]; /* enable flags of lines */
1025 char *pane_list[]; /* list of pane titles */
1026 Lisp_Object *prefixes; /* Prefix key for each pane */
1027 char *title;
1028 int pane_cnt; /* total number of panes */
1029 Lisp_Object *item_list[]; /* All items */
1030 int line_cnt[]; /* Lines in each pane */
1031 char **error; /* Error returned */
1032 {
1033 XMenu *GXMenu;
1034 int last, panes, selidx, lpane, status;
1035 int lines, sofar;
1036 Lisp_Object entry;
1037 /* struct indices *datap, *datap_save; */
1038 char *datap;
1039 int ulx, uly, width, height;
1040 int dispwidth, dispheight;
1041
1042 *error = 0;
1043 if (pane_cnt == 0)
1044 return 0;
1045
1046 BLOCK_INPUT;
1047 *error = (char *) 0; /* Initialize error pointer to null */
1048
1049 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
1050 if (GXMenu == NUL)
1051 {
1052 *error = "Can't create menu";
1053 UNBLOCK_INPUT;
1054 return (0);
1055 }
1056
1057 for (panes = 0, lines = 0; panes < pane_cnt;
1058 lines += line_cnt[panes], panes++)
1059 ;
1060 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
1061 /* datap = (char *) xmalloc (lines * sizeof (char));
1062 datap_save = datap;*/
1063
1064 for (panes = 0, sofar = 0; panes < pane_cnt;
1065 sofar += line_cnt[panes], panes++)
1066 {
1067 /* create all the necessary panes */
1068 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
1069 if (lpane == XM_FAILURE)
1070 {
1071 XMenuDestroy (XDISPLAY GXMenu);
1072 *error = "Can't create pane";
1073 UNBLOCK_INPUT;
1074 return (0);
1075 }
1076
1077 for (selidx = 0; selidx < line_cnt[panes]; selidx++)
1078 {
1079 /* add the selection stuff to the menus */
1080 /* datap[selidx+sofar].pane = panes;
1081 datap[selidx+sofar].line = selidx; */
1082 if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
1083 line_list[panes][selidx],
1084 enable_list[panes][selidx])
1085 == XM_FAILURE)
1086 {
1087 XMenuDestroy (XDISPLAY GXMenu);
1088 /* free (datap); */
1089 *error = "Can't add selection to menu";
1090 /* error ("Can't add selection to menu"); */
1091 UNBLOCK_INPUT;
1092 return (0);
1093 }
1094 }
1095 }
1096 /* all set and ready to fly */
1097 XMenuRecompute (XDISPLAY GXMenu);
1098 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
1099 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
1100 startx = min (startx, dispwidth);
1101 starty = min (starty, dispheight);
1102 startx = max (startx, 1);
1103 starty = max (starty, 1);
1104 XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
1105 &ulx, &uly, &width, &height);
1106 if (ulx+width > dispwidth)
1107 {
1108 startx -= (ulx + width) - dispwidth;
1109 ulx = dispwidth - width;
1110 }
1111 if (uly+height > dispheight)
1112 {
1113 starty -= (uly + height) - dispheight;
1114 uly = dispheight - height;
1115 }
1116 if (ulx < 0) startx -= ulx;
1117 if (uly < 0) starty -= uly;
1118
1119 XMenuSetFreeze (GXMenu, TRUE);
1120 panes = selidx = 0;
1121
1122 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
1123 startx, starty, ButtonReleaseMask, &datap);
1124 switch (status)
1125 {
1126 case XM_SUCCESS:
1127 #ifdef XDEBUG
1128 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
1129 #endif
1130 entry = item_list[panes][selidx];
1131 if (prefixes != 0)
1132 {
1133 entry = Fcons (entry, Qnil);
1134 if (!NILP (prefixes[panes]))
1135 entry = Fcons (prefixes[panes], entry);
1136 }
1137 break;
1138 case XM_FAILURE:
1139 /* free (datap_save); */
1140 XMenuDestroy (XDISPLAY GXMenu);
1141 *error = "Can't activate menu";
1142 /* error ("Can't activate menu"); */
1143 case XM_IA_SELECT:
1144 case XM_NO_SELECT:
1145 entry = Qnil;
1146 break;
1147 }
1148 XMenuDestroy (XDISPLAY GXMenu);
1149 UNBLOCK_INPUT;
1150 /* free (datap_save);*/
1151 return (entry);
1152 }
1153 #endif /* not USE_X_TOOLKIT */
1154
1155 syms_of_xmenu ()
1156 {
1157 popup_id_tick = (1<<16);
1158 defsubr (&Sx_popup_menu);
1159 }
1160 \f
1161 /* Figure out the current keyboard equivalent of a menu item ITEM1.
1162 Store the equivalent key sequence in *SAVEDKEY_PTR
1163 and the textual description (to use in the menu display) in *DESCRIP_PTR.
1164 Also cache them in the item itself.
1165 Return the real definition to execute. */
1166
1167 static Lisp_Object
1168 menu_item_equiv_key (item1, savedkey_ptr, descrip_ptr)
1169 Lisp_Object item1;
1170 Lisp_Object *savedkey_ptr, *descrip_ptr;
1171 {
1172 /* This is what is left after the menu item name. */
1173 Lisp_Object overdef;
1174 /* This is the real definition--the function to run. */
1175 Lisp_Object def;
1176 /* These are the saved equivalent keyboard key sequence
1177 and its key-description. */
1178 Lisp_Object savedkey, descrip;
1179 Lisp_Object def1;
1180 int changed = 0;
1181
1182 overdef = def = Fcdr (item1);
1183
1184 /* Get out the saved equivalent-keyboard-key info. */
1185 savedkey = descrip = Qnil;
1186 if (CONSP (overdef) && VECTORP (XCONS (overdef)->car))
1187 {
1188 savedkey = XCONS (overdef)->car;
1189 def = XCONS (def)->cdr;
1190 if (CONSP (def) && STRINGP (XCONS (def)->car))
1191 {
1192 descrip = XCONS (def)->car;
1193 def = XCONS (def)->cdr;
1194 }
1195 }
1196
1197 /* Is it still valid? */
1198 def1 = Qnil;
1199 if (!NILP (savedkey))
1200 def1 = Fkey_binding (savedkey, Qnil);
1201 /* If not, update it. */
1202 if (! EQ (def1, def))
1203 {
1204 changed = 1;
1205 descrip = Qnil;
1206 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
1207 if (VECTORP (savedkey)
1208 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
1209 savedkey = Qnil;
1210 if (!NILP (savedkey))
1211 {
1212 descrip = Fkey_description (savedkey);
1213 descrip = concat2 (make_string (" (", 3), descrip);
1214 descrip = concat2 (descrip, make_string (")", 1));
1215 }
1216 }
1217
1218 /* Store back the recorded keyboard key sequence
1219 if we changed it. */
1220 if (!NILP (savedkey)
1221 && CONSP (overdef) && VECTORP (XCONS (overdef)->car))
1222 {
1223 if (changed)
1224 {
1225 XCONS (overdef)->car = savedkey;
1226 def1 = XCONS (overdef)->cdr;
1227 if (CONSP (def1) && STRINGP (XCONS (def1)->car))
1228 XCONS (def1)->car = descrip;
1229 }
1230 }
1231 /* If we had none but need one now, add it. */
1232 else if (!NILP (savedkey))
1233 XCONS (item1)->cdr
1234 = overdef = Fcons (savedkey, Fcons (descrip, def));
1235 /* If we had one but no longer should have one, delete it. */
1236 else if (CONSP (overdef) && VECTORP (XCONS (overdef)->car))
1237 {
1238 XCONS (item1)->cdr = overdef = XCONS (overdef)->cdr;
1239 if (CONSP (overdef) && STRINGP (XCONS (overdef)->car))
1240 XCONS (item1)->cdr = overdef = XCONS (overdef)->cdr;
1241 }
1242
1243 *savedkey_ptr = savedkey;
1244 *descrip_ptr = descrip;
1245 return def;
1246 }
1247 \f
1248 /* Construct the vectors that describe a menu
1249 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
1250 Each of those four values is a vector indexed by pane number.
1251 Return the number of panes.
1252
1253 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */
1254
1255 int
1256 keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
1257 Lisp_Object ***vector; /* RETURN all menu objects */
1258 char ***panes; /* RETURN pane names */
1259 char ****names; /* RETURN all line names */
1260 int ***enables; /* RETURN enable-flags of lines */
1261 int **items; /* RETURN number of items per pane */
1262 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
1263 Lisp_Object *keymaps;
1264 int nmaps;
1265 {
1266 /* Number of panes we have made. */
1267 int p = 0;
1268 /* Number of panes we have space for. */
1269 int npanes_allocated = nmaps;
1270 int mapno;
1271
1272 if (npanes_allocated < 4)
1273 npanes_allocated = 4;
1274
1275 /* Make space for an estimated number of panes. */
1276 *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
1277 *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
1278 *items = (int *) xmalloc (npanes_allocated * sizeof (int));
1279 *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
1280 *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
1281 *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
1282
1283 /* Loop over the given keymaps, making a pane for each map.
1284 But don't make a pane that is empty--ignore that map instead.
1285 P is the number of panes we have made so far. */
1286 for (mapno = 0; mapno < nmaps; mapno++)
1287 single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
1288 prefixes, &p, &npanes_allocated, "");
1289
1290 /* Return the number of panes. */
1291 return p;
1292 }
1293
1294 /* This is used as the handler when calling internal_condition_case_1. */
1295
1296 static Lisp_Object
1297 single_keymap_panes_1 (arg)
1298 Lisp_Object arg;
1299 {
1300 return Qnil;
1301 }
1302
1303 /* This is a recursive subroutine of keymap_panes.
1304 It handles one keymap, KEYMAP.
1305 The other arguments are passed along
1306 or point to local variables of the previous function. */
1307
1308 single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
1309 p_ptr, npanes_allocated_ptr, pane_name)
1310 Lisp_Object keymap;
1311 Lisp_Object ***vector; /* RETURN all menu objects */
1312 char ***panes; /* RETURN pane names */
1313 char ****names; /* RETURN all line names */
1314 int ***enables; /* RETURN enable flags of lines */
1315 int **items; /* RETURN number of items per pane */
1316 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
1317 int *p_ptr;
1318 int *npanes_allocated_ptr;
1319 char *pane_name;
1320 {
1321 int i;
1322 Lisp_Object pending_maps;
1323 Lisp_Object tail, item, item1, item_string, table;
1324 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1325
1326 pending_maps = Qnil;
1327
1328 /* Make sure we have room for another pane. */
1329 if (*p_ptr == *npanes_allocated_ptr)
1330 {
1331 *npanes_allocated_ptr *= 2;
1332
1333 *vector
1334 = (Lisp_Object **) xrealloc (*vector,
1335 *npanes_allocated_ptr * sizeof (Lisp_Object *));
1336 *panes
1337 = (char **) xrealloc (*panes,
1338 *npanes_allocated_ptr * sizeof (char *));
1339 *items
1340 = (int *) xrealloc (*items,
1341 *npanes_allocated_ptr * sizeof (int));
1342 *prefixes
1343 = (Lisp_Object *) xrealloc (*prefixes,
1344 (*npanes_allocated_ptr
1345 * sizeof (Lisp_Object)));
1346 *names
1347 = (char ***) xrealloc (*names,
1348 *npanes_allocated_ptr * sizeof (char **));
1349 *enables
1350 = (int **) xrealloc (*enables,
1351 *npanes_allocated_ptr * sizeof (int *));
1352 }
1353
1354 /* When a menu comes from keymaps, don't give names to the panes. */
1355 (*panes)[*p_ptr] = pane_name;
1356
1357 /* Normally put nil as pane's prefix key.
1358 Caller will override this if appropriate. */
1359 (*prefixes)[*p_ptr] = Qnil;
1360
1361 /* Get the length of the list level of the keymap. */
1362 i = XFASTINT (Flength (keymap));
1363
1364 /* Add in lengths of any arrays. */
1365 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
1366 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
1367 i += XVECTOR (XCONS (tail)->car)->size;
1368
1369 /* Create vectors for the names and values of the items in the pane.
1370 I is an upper bound for the number of items. */
1371 (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
1372 (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
1373 (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
1374
1375 /* I is now the index of the next unused slots. */
1376 i = 0;
1377 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
1378 {
1379 /* Look at each key binding, and if it has a menu string,
1380 make a menu item from it. */
1381 item = XCONS (tail)->car;
1382 if (XTYPE (item) == Lisp_Cons)
1383 {
1384 item1 = XCONS (item)->cdr;
1385 if (XTYPE (item1) == Lisp_Cons)
1386 {
1387 item_string = XCONS (item1)->car;
1388 if (XTYPE (item_string) == Lisp_String)
1389 {
1390 /* This is the real definition--the function to run. */
1391 Lisp_Object def;
1392 /* These are the saved equivalent keyboard key sequence
1393 and its key-description. */
1394 Lisp_Object savedkey, descrip;
1395 Lisp_Object tem, enabled;
1396
1397 /* If a help string follows the item string,
1398 skip it. */
1399 if (CONSP (XCONS (item1)->cdr)
1400 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
1401 item1 = XCONS (item1)->cdr;
1402
1403 def = menu_item_equiv_key (item1, &savedkey, &descrip);
1404
1405 enabled = Qt;
1406 if (XTYPE (def) == Lisp_Symbol)
1407 {
1408 /* No property, or nil, means enable.
1409 Otherwise, enable if value is not nil. */
1410 tem = Fget (def, Qmenu_enable);
1411 /* GCPRO because we will call eval.
1412 Protecting KEYMAP preserves everything we use;
1413 aside from that, must protect whatever might be
1414 a string. */
1415 GCPRO3 (keymap, def, descrip, item_string);
1416 if (!NILP (tem))
1417 /* (condition-case nil (eval tem)
1418 (error nil)) */
1419 enabled = internal_condition_case_1 (Feval, tem,
1420 Qerror,
1421 single_keymap_panes_1);
1422 UNGCPRO;
1423 }
1424 tem = Fkeymapp (def);
1425 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
1426 pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)),
1427 pending_maps);
1428 else
1429 {
1430 Lisp_Object concat;
1431 if (!NILP (descrip))
1432 concat = concat2 (item_string, descrip);
1433 else
1434 concat = item_string;
1435 (*names)[*p_ptr][i] = (char *) XSTRING (concat)->data;
1436 /* The menu item "value" is the key bound here. */
1437 (*vector)[*p_ptr][i] = XCONS (item)->car;
1438 (*enables)[*p_ptr][i]
1439 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
1440 i++;
1441 }
1442 }
1443 }
1444 }
1445 else if (XTYPE (item) == Lisp_Vector)
1446 {
1447 /* Loop over the char values represented in the vector. */
1448 int len = XVECTOR (item)->size;
1449 int c;
1450 for (c = 0; c < len; c++)
1451 {
1452 Lisp_Object character;
1453 XFASTINT (character) = c;
1454 item1 = XVECTOR (item)->contents[c];
1455 if (XTYPE (item1) == Lisp_Cons)
1456 {
1457 item_string = XCONS (item1)->car;
1458 if (XTYPE (item_string) == Lisp_String)
1459 {
1460 Lisp_Object def;
1461
1462 /* These are the saved equivalent keyboard key sequence
1463 and its key-description. */
1464 Lisp_Object savedkey, descrip;
1465 Lisp_Object tem, enabled;
1466
1467 /* If a help string follows the item string,
1468 skip it. */
1469 if (CONSP (XCONS (item1)->cdr)
1470 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
1471 item1 = XCONS (item1)->cdr;
1472
1473 def = menu_item_equiv_key (item1, &savedkey, &descrip);
1474
1475 enabled = Qt;
1476 if (XTYPE (def) == Lisp_Symbol)
1477 {
1478 tem = Fget (def, Qmenu_enable);
1479 /* GCPRO because we will call eval.
1480 Protecting KEYMAP preserves everything we use;
1481 aside from that, must protect whatever might be
1482 a string. */
1483 GCPRO3 (keymap, def, descrip, item_string);
1484 /* No property, or nil, means enable.
1485 Otherwise, enable if value is not nil. */
1486 if (!NILP (tem))
1487 /* (condition-case nil (eval tem)
1488 (error nil)) */
1489 enabled = internal_condition_case_1 (Feval, tem,
1490 Qerror,
1491 single_keymap_panes_1);
1492 UNGCPRO;
1493 }
1494
1495 tem = Fkeymapp (def);
1496 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
1497 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
1498 pending_maps);
1499 else
1500 {
1501 Lisp_Object concat;
1502 if (!NILP (descrip))
1503 concat = concat2 (item_string, descrip);
1504 else
1505 concat = item_string;
1506 (*names)[*p_ptr][i]
1507 = (char *) XSTRING (concat)->data;
1508 /* The menu item "value" is the key bound here. */
1509 (*vector)[*p_ptr][i] = character;
1510 (*enables)[*p_ptr][i]
1511 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
1512 i++;
1513 }
1514 }
1515 }
1516 }
1517 }
1518 }
1519 /* Record the number of items in the pane. */
1520 (*items)[*p_ptr] = i;
1521
1522 /* If we just made an empty pane, get rid of it. */
1523 if (i == 0)
1524 {
1525 xfree ((*vector)[*p_ptr]);
1526 xfree ((*names)[*p_ptr]);
1527 xfree ((*enables)[*p_ptr]);
1528 }
1529 /* Otherwise, advance past it. */
1530 else
1531 (*p_ptr)++;
1532
1533 /* Process now any submenus which want to be panes at this level. */
1534 while (!NILP (pending_maps))
1535 {
1536 Lisp_Object elt, eltcdr;
1537 int panenum = *p_ptr;
1538 elt = Fcar (pending_maps);
1539 eltcdr = XCONS (elt)->cdr;
1540 single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
1541 prefixes, p_ptr, npanes_allocated_ptr,
1542 /* Add 1 to discard the @. */
1543 (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
1544 (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
1545 pending_maps = Fcdr (pending_maps);
1546 }
1547 }
1548 \f
1549 /* Construct the vectors that describe a menu
1550 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
1551 Each of those four values is a vector indexed by pane number.
1552 Return the number of panes.
1553
1554 MENU is the argument that was given to Fx_popup_menu. */
1555
1556 int
1557 list_of_panes (vector, panes, names, enables, items, menu)
1558 Lisp_Object ***vector; /* RETURN all menu objects */
1559 char ***panes; /* RETURN pane names */
1560 char ****names; /* RETURN all line names */
1561 int ***enables; /* RETURN enable flags of lines */
1562 int **items; /* RETURN number of items per pane */
1563 Lisp_Object menu;
1564 {
1565 Lisp_Object tail, item, item1;
1566 int i;
1567
1568 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
1569
1570 i = XFASTINT (Flength (menu));
1571
1572 *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
1573 *panes = (char **) xmalloc (i * sizeof (char *));
1574 *items = (int *) xmalloc (i * sizeof (int));
1575 *names = (char ***) xmalloc (i * sizeof (char **));
1576 *enables = (int **) xmalloc (i * sizeof (int *));
1577
1578 for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
1579 {
1580 item = Fcdr (Fcar (tail));
1581 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
1582 #ifdef XDEBUG
1583 fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
1584 #endif
1585 item1 = Fcar (Fcar (tail));
1586 CHECK_STRING (item1, 1);
1587 #ifdef XDEBUG
1588 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
1589 XSTRING (item1)->data);
1590 #endif
1591 (*panes)[i] = (char *) XSTRING (item1)->data;
1592 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
1593 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
1594 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
1595 ; */
1596 }
1597 return i;
1598 }
1599 \f
1600 /* Construct the lists of values and names for a single pane, from the
1601 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags
1602 int *ENABLES. Return the number of items. */
1603
1604 int
1605 list_of_items (vector, names, enables, pane)
1606 Lisp_Object **vector; /* RETURN menu "objects" */
1607 char ***names; /* RETURN line names */
1608 int **enables; /* RETURN enable flags of lines */
1609 Lisp_Object pane;
1610 {
1611 Lisp_Object tail, item, item1;
1612 int i;
1613
1614 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
1615
1616 i = XFASTINT (Flength (pane));
1617
1618 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
1619 *names = (char **) xmalloc (i * sizeof (char *));
1620 *enables = (int *) xmalloc (i * sizeof (int));
1621
1622 for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
1623 {
1624 item = Fcar (tail);
1625 if (STRINGP (item))
1626 {
1627 (*vector)[i] = Qnil;
1628 (*names)[i] = (char *) XSTRING (item)->data;
1629 (*enables)[i] = -1;
1630 }
1631 else
1632 {
1633 CHECK_CONS (item, 0);
1634 (*vector)[i] = Fcdr (item);
1635 item1 = Fcar (item);
1636 CHECK_STRING (item1, 1);
1637 (*names)[i] = (char *) XSTRING (item1)->data;
1638 (*enables)[i] = 1;
1639 }
1640 }
1641 return i;
1642 }