(Fy_or_n_p): Use a popup menu if reached via mouse command.
[bpt/emacs.git] / src / xmenu.c
CommitLineData
dcfdbac7 1/* X Communication module for terminals which understand the X protocol.
b5b4d636 2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
dcfdbac7
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
774910eb 8the Free Software Foundation; either version 2, or (at your option)
dcfdbac7
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the 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
18686d47
RS
27/* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
29
dcfdbac7 30#include <stdio.h>
dcfdbac7
JB
31
32/* On 4.3 this loses if it comes after xterm.h. */
33#include <signal.h>
18160b98 34#include <config.h>
dcfdbac7 35#include "lisp.h"
18686d47 36#include "termhooks.h"
7708e9bd 37#include "frame.h"
dcfdbac7 38#include "window.h"
031b0e31 39#include "keyboard.h"
9ac0d9e0 40#include "blockinput.h"
dcfdbac7
JB
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
18686d47
RS
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
dcfdbac7
JB
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
d065dd2e 78#endif /* TRUE */
dcfdbac7
JB
79
80#ifdef HAVE_X11
81extern Display *x_current_display;
82#else
83#define ButtonReleaseMask ButtonReleased
84#endif /* not HAVE_X11 */
85
6904bdcd 86extern Lisp_Object Qmenu_enable;
18686d47 87extern Lisp_Object Qmenu_bar;
dcfdbac7
JB
88Lisp_Object xmenu_show ();
89extern int x_error_handler ();
18686d47
RS
90#ifdef USE_X_TOOLKIT
91static widget_value *set_menu_items ();
92static int string_width ();
93static void free_menu_items ();
94#endif
95
96/* we need a unique id for each popup menu and dialog box */
97unsigned int popup_id_tick;
dcfdbac7
JB
98
99/*************************************************************/
100
101#if 0
102/* Ignoring the args is easiest. */
103xmenu_quit ()
104{
105 error ("Unknown XMenu error");
106}
107#endif
108
18686d47 109\f
dcfdbac7
JB
110DEFUN ("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\
088831f6
RS
112POSITION is a position specification. This is either a mouse button event\n\
113or a list ((XOFFSET YOFFSET) WINDOW)\n\
dcfdbac7 114where XOFFSET and YOFFSET are positions in characters from the top left\n\
7da99777 115corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
dcfdbac7
JB
116This controls the position of the center of the first line\n\
117in the first pane of the menu, not the top left of the menu as a whole.\n\
118\n\
088831f6
RS
119MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
120The menu items come from key bindings that have a menu string as well as\n\
121a 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\
123the keymap as a top-level element.\n\n\
124You can also use a list of keymaps as MENU.\n\
819012f0
RS
125 Then each keymap makes a separate pane.\n\
126When MENU is a keymap or a list of keymaps, the return value\n\
127is a list of events.\n\n\
088831f6 128Alternatively, you can specify a menu of multiple panes\n\
24af387f
RS
129 with a list of the form (TITLE PANE1 PANE2...),\n\
130where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
131Each ITEM is normally a cons cell (STRING . VALUE);\n\
132but a string can appear as an item--that makes a nonselectable line\n\
819012f0
RS
133in the menu.\n\
134With this form of menu, the return value is VALUE from the chosen item.")
088831f6
RS
135 (position, menu)
136 Lisp_Object position, menu;
dcfdbac7 137{
18686d47 138 int number_of_panes, panes;
088831f6 139 Lisp_Object XMenu_return, keymap, tem;
dcfdbac7
JB
140 int XMenu_xpos, XMenu_ypos;
141 char **menus;
142 char ***names;
aedaff8d 143 int **enables;
dcfdbac7 144 Lisp_Object **obj_list;
819012f0 145 Lisp_Object *prefixes;
dcfdbac7
JB
146 int *items;
147 char *title;
148 char *error_name;
149 Lisp_Object ltitle, selection;
18686d47 150 int i, j, menubarp = 0;
7708e9bd 151 FRAME_PTR f;
dcfdbac7 152 Lisp_Object x, y, window;
18686d47
RS
153#ifdef USE_X_TOOLKIT
154 widget_value *val, *vw = 0;
155#endif /* USE_X_TOOLKIT */
dcfdbac7 156
326d7fc1 157 check_x ();
088831f6
RS
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 {
933ff472
RS
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) */
088831f6
RS
171 x = Fcar (tem);
172 y = Fcdr (tem);
173 }
dcfdbac7
JB
174 CHECK_NUMBER (x, 0);
175 CHECK_NUMBER (y, 0);
088831f6 176
7da99777
RS
177 if (XTYPE (window) == Lisp_Frame)
178 {
179 f = XFRAME (window);
18686d47 180
7da99777
RS
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)));
18686d47
RS
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;
7da99777 193 }
378f8939
RS
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);
7da99777 198
18686d47
RS
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 */
1658603c
RS
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 }
18686d47 286#endif /* HAVE_X11 */
1658603c 287
7da99777
RS
288 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
289 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
dcfdbac7 290
7708e9bd
JB
291 XMenu_xpos += f->display.x->left_pos;
292 XMenu_ypos += f->display.x->top_pos;
dcfdbac7 293
18686d47 294
088831f6
RS
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. */
aedaff8d 312 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
07a675b7 313 &items, &prefixes, &menu, 1);
088831f6
RS
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))
dcfdbac7 320 {
088831f6
RS
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))
dcfdbac7 332 {
088831f6
RS
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;
dcfdbac7 338 }
088831f6
RS
339
340 /* Extract the detailed info to make one pane. */
aedaff8d 341 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
819012f0 342 &items, &prefixes, maps, nmaps);
088831f6
RS
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;
819012f0 354 prefixes = 0;
aedaff8d
RS
355 number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
356 &items, Fcdr (menu));
088831f6
RS
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]);
dcfdbac7
JB
366 }
367#endif
18686d47 368
dcfdbac7 369 BLOCK_INPUT;
c4e5d591
JB
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 ();
aedaff8d 390 selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
819012f0
RS
391 menus, prefixes, items, number_of_panes, obj_list,
392 title, &error_name);
c4e5d591 393 }
dcfdbac7 394 UNBLOCK_INPUT;
088831f6 395 /* fprintf (stderr, "selection = %x\n", selection); */
dcfdbac7
JB
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 */
088831f6 405 for (i = 0; i < number_of_panes; i++)
dcfdbac7 406 {
9ac0d9e0
JB
407 xfree (names[i]);
408 xfree (enables[i]);
409 xfree (obj_list[i]);
dcfdbac7 410 }
9ac0d9e0
JB
411 xfree (menus);
412 xfree (obj_list);
413 xfree (names);
414 xfree (enables);
415 xfree (items);
088831f6 416 /* free (title); */
dcfdbac7
JB
417 if (error_name) error (error_name);
418 return XMenu_return;
18686d47
RS
419#endif /* not USE_X_TOOLKIT */
420}
421\f
422#ifdef USE_X_TOOLKIT
423
424static void
425dispatch_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
444static int
445string_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;
dcfdbac7
JB
454}
455
18686d47
RS
456static int
457event_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
469Lisp_Object
470map_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
498static widget_value *
499set_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
646static void
647free_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
676static Lisp_Object menu_item_selection;
677
678static void
679popup_selection_callback (widget, id, client_data)
680 Widget widget;
681 LWLIB_ID id;
682 XtPointer client_data;
683{
18686d47
RS
684 VOID_TO_LISP (menu_item_selection, client_data);
685}
686
687static void
688popup_down_callback (widget, id, client_data)
689 Widget widget;
690 LWLIB_ID id;
691 XtPointer client_data;
692{
18686d47
RS
693 BLOCK_INPUT;
694 lw_destroy_all_widgets (id);
695 UNBLOCK_INPUT;
18686d47
RS
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 */
704void
705free_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
728static void
729update_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
770void
771set_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}
85f487d1
FP
828
829void
830free_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}
18686d47
RS
846#endif /* USE_X_TOOLKIT */
847\f
dcfdbac7
JB
848struct indices {
849 int pane;
850 int line;
851};
852
18686d47
RS
853extern void process_expose_from_menu ();
854
855#ifdef USE_X_TOOLKIT
856extern XtAppContext Xt_app_con;
857
dcfdbac7 858Lisp_Object
18686d47
RS
859xmenu_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{
47e8f9a3 867 int menu_id, item_length;
18686d47
RS
868 Lisp_Object selection;
869 Widget menu;
47e8f9a3 870 XlwMenuWidget menuw = (XlwMenuWidget) f->display.x->menubar_widget;
18686d47
RS
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;
63c414df
FP
887 if (val == 0) return Qnil;
888
18686d47
RS
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 {
18686d47
RS
917 vw->call_data = (XtPointer) 1;
918 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
18686d47
RS
919 }
920
921
922 /* We activate directly the lucid implementation */
923 pop_up_menu (mw, &dummy);
924 }
925
47e8f9a3
FP
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
18686d47
RS
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);
47e8f9a3
FP
948 else
949 if (event.type == MotionNotify
9106ccf1
FP
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)))
47e8f9a3
FP
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
18686d47
RS
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 {
18686d47 1000 vw->call_data = (XtPointer) 0;
399703f1 1001 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
18686d47
RS
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 */
aedaff8d 1019xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
819012f0 1020 prefixes, line_cnt, pane_cnt, item_list, title, error)
dcfdbac7
JB
1021 Window parent;
1022 int startx, starty; /* upper left corner position BROKEN */
1023 char **line_list[]; /* list of strings for items */
86e7b627 1024 int *enable_list[]; /* enable flags of lines */
dcfdbac7 1025 char *pane_list[]; /* list of pane titles */
819012f0 1026 Lisp_Object *prefixes; /* Prefix key for each pane */
dcfdbac7
JB
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;
088831f6 1041
07a675b7 1042 *error = 0;
088831f6
RS
1043 if (pane_cnt == 0)
1044 return 0;
1045
10c48c95 1046 BLOCK_INPUT;
dcfdbac7 1047 *error = (char *) 0; /* Initialize error pointer to null */
18686d47 1048
dcfdbac7
JB
1049 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
1050 if (GXMenu == NUL)
1051 {
1052 *error = "Can't create menu";
10c48c95 1053 UNBLOCK_INPUT;
dcfdbac7
JB
1054 return (0);
1055 }
18686d47 1056
088831f6
RS
1057 for (panes = 0, lines = 0; panes < pane_cnt;
1058 lines += line_cnt[panes], panes++)
dcfdbac7
JB
1059 ;
1060 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
088831f6 1061 /* datap = (char *) xmalloc (lines * sizeof (char));
dcfdbac7
JB
1062 datap_save = datap;*/
1063
088831f6
RS
1064 for (panes = 0, sofar = 0; panes < pane_cnt;
1065 sofar += line_cnt[panes], panes++)
dcfdbac7
JB
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";
10c48c95 1073 UNBLOCK_INPUT;
dcfdbac7
JB
1074 return (0);
1075 }
18686d47 1076
088831f6 1077 for (selidx = 0; selidx < line_cnt[panes]; selidx++)
dcfdbac7
JB
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,
aedaff8d
RS
1083 line_list[panes][selidx],
1084 enable_list[panes][selidx])
dcfdbac7
JB
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"); */
10c48c95 1091 UNBLOCK_INPUT;
dcfdbac7
JB
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];
819012f0
RS
1131 if (prefixes != 0)
1132 {
1133 entry = Fcons (entry, Qnil);
1134 if (!NILP (prefixes[panes]))
1135 entry = Fcons (prefixes[panes], entry);
1136 }
dcfdbac7
JB
1137 break;
1138 case XM_FAILURE:
088831f6 1139 /* free (datap_save); */
dcfdbac7
JB
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);
10c48c95 1149 UNBLOCK_INPUT;
088831f6 1150 /* free (datap_save);*/
dcfdbac7
JB
1151 return (entry);
1152}
18686d47 1153#endif /* not USE_X_TOOLKIT */
dcfdbac7
JB
1154
1155syms_of_xmenu ()
1156{
18686d47 1157 popup_id_tick = (1<<16);
dcfdbac7
JB
1158 defsubr (&Sx_popup_menu);
1159}
088831f6 1160\f
fa6d54d9
RS
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
1167static Lisp_Object
1168menu_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;
b5b4d636 1186 if (CONSP (overdef) && VECTORP (XCONS (overdef)->car))
fa6d54d9
RS
1187 {
1188 savedkey = XCONS (overdef)->car;
1189 def = XCONS (def)->cdr;
b5b4d636 1190 if (CONSP (def) && STRINGP (XCONS (def)->car))
fa6d54d9
RS
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)
b5b4d636 1221 && CONSP (overdef) && VECTORP (XCONS (overdef)->car))
fa6d54d9
RS
1222 {
1223 if (changed)
1224 {
1225 XCONS (overdef)->car = savedkey;
1226 def1 = XCONS (overdef)->cdr;
b5b4d636 1227 if (CONSP (def1) && STRINGP (XCONS (def1)->car))
fa6d54d9
RS
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));
b5b4d636
RS
1235 /* If we had one but no longer should have one, delete it. */
1236 else if (CONSP (overdef) && VECTORP (XCONS (overdef)->car))
fa6d54d9
RS
1237 {
1238 XCONS (item1)->cdr = overdef = XCONS (overdef)->cdr;
b5b4d636 1239 if (CONSP (overdef) && STRINGP (XCONS (overdef)->car))
fa6d54d9
RS
1240 XCONS (item1)->cdr = overdef = XCONS (overdef)->cdr;
1241 }
1242
1243 *savedkey_ptr = savedkey;
1244 *descrip_ptr = descrip;
1245 return def;
1246}
1247\f
088831f6 1248/* Construct the vectors that describe a menu
aedaff8d 1249 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
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
1255int
819012f0 1256keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
088831f6
RS
1257 Lisp_Object ***vector; /* RETURN all menu objects */
1258 char ***panes; /* RETURN pane names */
1259 char ****names; /* RETURN all line names */
aedaff8d 1260 int ***enables; /* RETURN enable-flags of lines */
088831f6 1261 int **items; /* RETURN number of items per pane */
819012f0 1262 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
088831f6
RS
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 **));
aedaff8d 1280 *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
819012f0 1281 *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
088831f6
RS
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++)
aedaff8d 1287 single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
819012f0 1288 prefixes, &p, &npanes_allocated, "");
088831f6
RS
1289
1290 /* Return the number of panes. */
1291 return p;
1292}
1293
71cc5cf3
RS
1294/* This is used as the handler when calling internal_condition_case_1. */
1295
1296static Lisp_Object
1297single_keymap_panes_1 (arg)
1298 Lisp_Object arg;
1299{
1300 return Qnil;
1301}
1302
1303/* This is a recursive subroutine of keymap_panes.
088831f6
RS
1304 It handles one keymap, KEYMAP.
1305 The other arguments are passed along
1306 or point to local variables of the previous function. */
1307
819012f0 1308single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
088831f6
RS
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 */
aedaff8d 1314 int ***enables; /* RETURN enable flags of lines */
088831f6 1315 int **items; /* RETURN number of items per pane */
819012f0 1316 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
088831f6
RS
1317 int *p_ptr;
1318 int *npanes_allocated_ptr;
1319 char *pane_name;
1320{
1321 int i;
1322 Lisp_Object pending_maps;
b5b4d636
RS
1323 Lisp_Object tail, item, item1, item_string, table;
1324 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
088831f6
RS
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));
819012f0
RS
1342 *prefixes
1343 = (Lisp_Object *) xrealloc (*prefixes,
1344 (*npanes_allocated_ptr
1345 * sizeof (Lisp_Object)));
088831f6
RS
1346 *names
1347 = (char ***) xrealloc (*names,
1348 *npanes_allocated_ptr * sizeof (char **));
aedaff8d
RS
1349 *enables
1350 = (int **) xrealloc (*enables,
1351 *npanes_allocated_ptr * sizeof (int *));
088831f6
RS
1352 }
1353
1354 /* When a menu comes from keymaps, don't give names to the panes. */
1355 (*panes)[*p_ptr] = pane_name;
1356
819012f0
RS
1357 /* Normally put nil as pane's prefix key.
1358 Caller will override this if appropriate. */
1359 (*prefixes)[*p_ptr] = Qnil;
1360
088831f6
RS
1361 /* Get the length of the list level of the keymap. */
1362 i = XFASTINT (Flength (keymap));
1363
ab6ee1a0
RS
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;
088831f6
RS
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 *));
aedaff8d 1373 (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
088831f6
RS
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 {
b5b4d636
RS
1387 item_string = XCONS (item1)->car;
1388 if (XTYPE (item_string) == Lisp_String)
088831f6 1389 {
fa6d54d9
RS
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
b5b4d636
RS
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
fa6d54d9 1403 def = menu_item_equiv_key (item1, &savedkey, &descrip);
d9dcaf49 1404
d9dcaf49
RS
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);
b5b4d636
RS
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);
d9dcaf49 1416 if (!NILP (tem))
71cc5cf3
RS
1417 /* (condition-case nil (eval tem)
1418 (error nil)) */
1419 enabled = internal_condition_case_1 (Feval, tem,
1420 Qerror,
1421 single_keymap_panes_1);
b5b4d636 1422 UNGCPRO;
d9dcaf49
RS
1423 }
1424 tem = Fkeymapp (def);
b5b4d636
RS
1425 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
1426 pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)),
088831f6 1427 pending_maps);
aedaff8d 1428 else
088831f6 1429 {
fa6d54d9
RS
1430 Lisp_Object concat;
1431 if (!NILP (descrip))
b5b4d636 1432 concat = concat2 (item_string, descrip);
fa6d54d9 1433 else
b5b4d636 1434 concat = item_string;
fa6d54d9 1435 (*names)[*p_ptr][i] = (char *) XSTRING (concat)->data;
088831f6
RS
1436 /* The menu item "value" is the key bound here. */
1437 (*vector)[*p_ptr][i] = XCONS (item)->car;
aedaff8d 1438 (*enables)[*p_ptr][i]
24af387f 1439 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
088831f6
RS
1440 i++;
1441 }
1442 }
1443 }
1444 }
ab6ee1a0
RS
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 {
b5b4d636
RS
1457 item_string = XCONS (item1)->car;
1458 if (XTYPE (item_string) == Lisp_String)
ab6ee1a0 1459 {
d9dcaf49 1460 Lisp_Object def;
d9dcaf49 1461
fa6d54d9
RS
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
b5b4d636
RS
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
fa6d54d9
RS
1473 def = menu_item_equiv_key (item1, &savedkey, &descrip);
1474
d9dcaf49
RS
1475 enabled = Qt;
1476 if (XTYPE (def) == Lisp_Symbol)
1477 {
1478 tem = Fget (def, Qmenu_enable);
b5b4d636
RS
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);
d9dcaf49
RS
1484 /* No property, or nil, means enable.
1485 Otherwise, enable if value is not nil. */
1486 if (!NILP (tem))
71cc5cf3
RS
1487 /* (condition-case nil (eval tem)
1488 (error nil)) */
1489 enabled = internal_condition_case_1 (Feval, tem,
1490 Qerror,
1491 single_keymap_panes_1);
b5b4d636 1492 UNGCPRO;
d9dcaf49
RS
1493 }
1494
1495 tem = Fkeymapp (def);
b5b4d636
RS
1496 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
1497 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
ab6ee1a0 1498 pending_maps);
aedaff8d 1499 else
ab6ee1a0 1500 {
fa6d54d9
RS
1501 Lisp_Object concat;
1502 if (!NILP (descrip))
b5b4d636 1503 concat = concat2 (item_string, descrip);
fa6d54d9 1504 else
b5b4d636 1505 concat = item_string;
fa6d54d9
RS
1506 (*names)[*p_ptr][i]
1507 = (char *) XSTRING (concat)->data;
ab6ee1a0
RS
1508 /* The menu item "value" is the key bound here. */
1509 (*vector)[*p_ptr][i] = character;
aedaff8d 1510 (*enables)[*p_ptr][i]
24af387f 1511 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
ab6ee1a0
RS
1512 i++;
1513 }
1514 }
1515 }
1516 }
1517 }
088831f6
RS
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 {
9ac0d9e0
JB
1525 xfree ((*vector)[*p_ptr]);
1526 xfree ((*names)[*p_ptr]);
1527 xfree ((*enables)[*p_ptr]);
088831f6
RS
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 {
819012f0
RS
1536 Lisp_Object elt, eltcdr;
1537 int panenum = *p_ptr;
088831f6 1538 elt = Fcar (pending_maps);
819012f0 1539 eltcdr = XCONS (elt)->cdr;
aedaff8d 1540 single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
819012f0 1541 prefixes, p_ptr, npanes_allocated_ptr,
088831f6 1542 /* Add 1 to discard the @. */
819012f0
RS
1543 (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
1544 (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
088831f6
RS
1545 pending_maps = Fcdr (pending_maps);
1546 }
1547}
1548\f
1549/* Construct the vectors that describe a menu
aedaff8d 1550 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
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. */
dcfdbac7 1555
088831f6 1556int
aedaff8d 1557list_of_panes (vector, panes, names, enables, items, menu)
dcfdbac7
JB
1558 Lisp_Object ***vector; /* RETURN all menu objects */
1559 char ***panes; /* RETURN pane names */
1560 char ****names; /* RETURN all line names */
aedaff8d 1561 int ***enables; /* RETURN enable flags of lines */
dcfdbac7
JB
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
088831f6 1570 i = XFASTINT (Flength (menu));
dcfdbac7
JB
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 **));
aedaff8d 1576 *enables = (int **) xmalloc (i * sizeof (int *));
dcfdbac7 1577
088831f6 1578 for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 1579 {
088831f6
RS
1580 item = Fcdr (Fcar (tail));
1581 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
dcfdbac7 1582#ifdef XDEBUG
088831f6 1583 fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
dcfdbac7 1584#endif
088831f6
RS
1585 item1 = Fcar (Fcar (tail));
1586 CHECK_STRING (item1, 1);
dcfdbac7 1587#ifdef XDEBUG
088831f6
RS
1588 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
1589 XSTRING (item1)->data);
dcfdbac7 1590#endif
088831f6 1591 (*panes)[i] = (char *) XSTRING (item1)->data;
aedaff8d 1592 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
088831f6
RS
1593 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
1594 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
1595 ; */
dcfdbac7
JB
1596 }
1597 return i;
1598}
088831f6
RS
1599\f
1600/* Construct the lists of values and names for a single pane, from the
aedaff8d
RS
1601 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags
1602 int *ENABLES. Return the number of items. */
dcfdbac7 1603
088831f6 1604int
aedaff8d 1605list_of_items (vector, names, enables, pane)
dcfdbac7
JB
1606 Lisp_Object **vector; /* RETURN menu "objects" */
1607 char ***names; /* RETURN line names */
aedaff8d 1608 int **enables; /* RETURN enable flags of lines */
dcfdbac7
JB
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
f1b28218 1616 i = XFASTINT (Flength (pane));
dcfdbac7
JB
1617
1618 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
1619 *names = (char **) xmalloc (i * sizeof (char *));
aedaff8d 1620 *enables = (int *) xmalloc (i * sizeof (int));
dcfdbac7 1621
088831f6 1622 for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 1623 {
088831f6 1624 item = Fcar (tail);
24af387f
RS
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 }
dcfdbac7
JB
1640 }
1641 return i;
1642}