(free_frame_menubar) [USE_X_TOOLKIT]. New function to destroy the X Widget
[bpt/emacs.git] / src / xmenu.c
CommitLineData
dcfdbac7 1/* X Communication module for terminals which understand the X protocol.
c6c5df7f 2 Copyright (C) 1986, 1988, 1993 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
088831f6
RS
157 /* Decode the first argument: find the window and the coordinates. */
158 tem = Fcar (position);
159 if (XTYPE (tem) == Lisp_Cons)
160 {
161 window = Fcar (Fcdr (position));
162 x = Fcar (tem);
163 y = Fcar (Fcdr (tem));
164 }
165 else
166 {
933ff472
RS
167 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
168 window = Fcar (tem); /* POSN_WINDOW (tem) */
169 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
088831f6
RS
170 x = Fcar (tem);
171 y = Fcdr (tem);
172 }
dcfdbac7
JB
173 CHECK_NUMBER (x, 0);
174 CHECK_NUMBER (y, 0);
088831f6 175
7da99777
RS
176 if (XTYPE (window) == Lisp_Frame)
177 {
178 f = XFRAME (window);
18686d47 179
7da99777
RS
180 XMenu_xpos = 0;
181 XMenu_ypos = 0;
182 }
183 else if (XTYPE (window) == Lisp_Window)
184 {
185 CHECK_LIVE_WINDOW (window, 0);
186 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
18686d47
RS
187
188 XMenu_xpos = FONT_WIDTH (f->display.x->font)
189 * XWINDOW (window)->left;
190 XMenu_ypos = FONT_HEIGHT (f->display.x->font)
191 * XWINDOW (window)->top;
7da99777 192 }
378f8939
RS
193 else
194 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
195 but I don't want to make one now. */
196 CHECK_WINDOW (window, 0);
7da99777 197
18686d47
RS
198#ifdef USE_X_TOOLKIT
199 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
200 if (XTYPE (Fcar (position)) != Lisp_Cons
201 && CONSP (tem)
202 && EQ (Fcar (tem), Qmenu_bar))
203 {
204 /* We are in the menubar */
205 XlwMenuWidget mw;
206 int w1 = 0, w2;
207
208 mw = (XlwMenuWidget)f->display.x->menubar_widget;
209 menubarp = 1;
210 for (vw = mw->menu.old_stack [0]->contents; vw; vw = vw->next)
211 {
212 w2 = w1;
213 w1 += string_width (mw, vw->name)
214 + 2 * (mw->menu.horizontal_spacing +
215 mw->menu.shadow_thickness);
216 if (XINT (x) < w1)
217 {
218 XMenu_xpos = w2 + 4;
219 XMenu_ypos = 0;
220 break;
221 }
222 }
223 }
224 else
225 {
226 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
227 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
228 }
229
230 BLOCK_INPUT;
231 XMenu_xpos += (f->display.x->widget->core.x
232 + f->display.x->widget->core.border_width);
233 XMenu_ypos += (f->display.x->widget->core.y
234 + f->display.x->widget->core.border_width
235 + f->display.x->menubar_widget->core.height);
236 UNBLOCK_INPUT;
237
238 val = set_menu_items (menu, &prefixes, &panes, &names,
239 &enables, &menus, &items, &number_of_panes, &obj_list,
240 &title, &error_name);
241 selection = xmenu_show (f, val, XMenu_xpos, XMenu_ypos,
242 menubarp, vw);
243
244 free_menu_items (names, enables, menus, items, number_of_panes, obj_list,
245 title, error_name);
246
247 if (selection != NUL)
248 { /* selected something */
249 XMenu_return = selection;
250 }
251 else
252 { /* nothing selected */
253 XMenu_return = Qnil;
254 }
255
256 return XMenu_return;
257
258#else /* not USE_X_TOOLKIT */
1658603c
RS
259#ifdef HAVE_X11
260 {
261 Window child;
262 int win_x = 0, win_y = 0;
263
264 /* Find the position of the outside upper-left corner of
265 the inner window, with respect to the outer window. */
266 if (f->display.x->parent_desc != ROOT_WINDOW)
267 {
268 BLOCK_INPUT;
269 XTranslateCoordinates (x_current_display,
270
271 /* From-window, to-window. */
272 f->display.x->window_desc,
273 f->display.x->parent_desc,
274
275 /* From-position, to-position. */
276 0, 0, &win_x, &win_y,
277
278 /* Child of window. */
279 &child);
280 UNBLOCK_INPUT;
281 XMenu_xpos += win_x;
282 XMenu_ypos += win_y;
283 }
284 }
18686d47 285#endif /* HAVE_X11 */
1658603c 286
7da99777
RS
287 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
288 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
dcfdbac7 289
7708e9bd
JB
290 XMenu_xpos += f->display.x->left_pos;
291 XMenu_ypos += f->display.x->top_pos;
dcfdbac7 292
18686d47 293
088831f6
RS
294 keymap = Fkeymapp (menu);
295 tem = Qnil;
296 if (XTYPE (menu) == Lisp_Cons)
297 tem = Fkeymapp (Fcar (menu));
298 if (!NILP (keymap))
299 {
300 /* We were given a keymap. Extract menu info from the keymap. */
301 Lisp_Object prompt;
302 keymap = get_keymap (menu);
303
304 /* Search for a string appearing directly as an element of the keymap.
305 That string is the title of the menu. */
306 prompt = map_prompt (keymap);
307 if (!NILP (prompt))
308 title = (char *) XSTRING (prompt)->data;
309
310 /* Extract the detailed info to make one pane. */
aedaff8d 311 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
07a675b7 312 &items, &prefixes, &menu, 1);
088831f6
RS
313 /* The menu title seems to be ignored,
314 so put it in the pane title. */
315 if (menus[0] == 0)
316 menus[0] = title;
317 }
318 else if (!NILP (tem))
dcfdbac7 319 {
088831f6
RS
320 /* We were given a list of keymaps. */
321 Lisp_Object prompt;
322 int nmaps = XFASTINT (Flength (menu));
323 Lisp_Object *maps
324 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
325 int i;
326 title = 0;
327
328 /* The first keymap that has a prompt string
329 supplies the menu title. */
330 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
dcfdbac7 331 {
088831f6
RS
332 maps[i++] = keymap = get_keymap (Fcar (tem));
333
334 prompt = map_prompt (keymap);
335 if (title == 0 && !NILP (prompt))
336 title = (char *) XSTRING (prompt)->data;
dcfdbac7 337 }
088831f6
RS
338
339 /* Extract the detailed info to make one pane. */
aedaff8d 340 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
819012f0 341 &items, &prefixes, maps, nmaps);
088831f6
RS
342 /* The menu title seems to be ignored,
343 so put it in the pane title. */
344 if (menus[0] == 0)
345 menus[0] = title;
346 }
347 else
348 {
349 /* We were given an old-fashioned menu. */
350 ltitle = Fcar (menu);
351 CHECK_STRING (ltitle, 1);
352 title = (char *) XSTRING (ltitle)->data;
819012f0 353 prefixes = 0;
aedaff8d
RS
354 number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
355 &items, Fcdr (menu));
088831f6
RS
356 }
357#ifdef XDEBUG
358 fprintf (stderr, "Panes = %d\n", number_of_panes);
359 for (i = 0; i < number_of_panes; i++)
360 {
361 fprintf (stderr, "Pane %d has lines %d title %s\n",
362 i, items[i], menus[i]);
363 for (j = 0; j < items[i]; j++)
364 fprintf (stderr, " Item %d %s\n", j, names[i][j]);
dcfdbac7
JB
365 }
366#endif
18686d47 367
dcfdbac7 368 BLOCK_INPUT;
c4e5d591
JB
369 {
370 Window root;
371 int root_x, root_y;
372 int dummy_int;
373 unsigned int dummy_uint;
374 Window dummy_window;
375
376 /* Figure out which root window F is on. */
377 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
378 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
379 &dummy_uint, &dummy_uint);
380
381 /* Translate the menu co-ordinates within f to menu co-ordinates
382 on that root window. */
383 if (! XTranslateCoordinates (x_current_display,
384 FRAME_X_WINDOW (f), root,
385 XMenu_xpos, XMenu_ypos, &root_x, &root_y,
386 &dummy_window))
387 /* But XGetGeometry said root was the root window of f's screen! */
388 abort ();
aedaff8d 389 selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
819012f0
RS
390 menus, prefixes, items, number_of_panes, obj_list,
391 title, &error_name);
c4e5d591 392 }
dcfdbac7 393 UNBLOCK_INPUT;
088831f6 394 /* fprintf (stderr, "selection = %x\n", selection); */
dcfdbac7
JB
395 if (selection != NUL)
396 { /* selected something */
397 XMenu_return = selection;
398 }
399 else
400 { /* nothing selected */
401 XMenu_return = Qnil;
402 }
403 /* now free up the strings */
088831f6 404 for (i = 0; i < number_of_panes; i++)
dcfdbac7 405 {
9ac0d9e0
JB
406 xfree (names[i]);
407 xfree (enables[i]);
408 xfree (obj_list[i]);
dcfdbac7 409 }
9ac0d9e0
JB
410 xfree (menus);
411 xfree (obj_list);
412 xfree (names);
413 xfree (enables);
414 xfree (items);
088831f6 415 /* free (title); */
dcfdbac7
JB
416 if (error_name) error (error_name);
417 return XMenu_return;
18686d47
RS
418#endif /* not USE_X_TOOLKIT */
419}
420\f
421#ifdef USE_X_TOOLKIT
422
423static void
424dispatch_dummy_expose (w, x, y)
425 Widget w;
426 int x;
427 int y;
428{
429 XExposeEvent dummy;
430
431 dummy.type = Expose;
432 dummy.window = XtWindow (w);
433 dummy.count = 0;
434 dummy.serial = 0;
435 dummy.send_event = 0;
436 dummy.display = XtDisplay (w);
437 dummy.x = x;
438 dummy.y = y;
439
440 XtDispatchEvent (&dummy);
441}
442
443static int
444string_width (mw, s)
445 XlwMenuWidget mw;
446 char* s;
447{
448 XCharStruct xcs;
449 int drop;
450
451 XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs);
452 return xcs.width;
dcfdbac7
JB
453}
454
18686d47
RS
455static int
456event_is_in_menu_item (mw, event, name, string_w)
457 XlwMenuWidget mw;
458 struct input_event *event;
459 char *name;
460 int *string_w;
461{
462 *string_w += string_width (mw, name)
463 + 2 * (mw->menu.horizontal_spacing + mw->menu.shadow_thickness);
464 return (XINT (event->x) < *string_w);
465}
466
467
468Lisp_Object
469map_event_to_object (event, f)
470 struct input_event *event;
471 FRAME_PTR f;
472{
473 int i,j, string_w;
474 window_state* ws;
475 XlwMenuWidget mw = (XlwMenuWidget) f->display.x->menubar_widget;
476 widget_value *val;
477
478
479 string_w = 0;
480 /* Find the window */
481 for (val = mw->menu.old_stack [0]->contents; val; val = val->next)
482 {
483 ws = &mw->menu.windows [0];
484 if (ws && event_is_in_menu_item (mw, event, val->name, &string_w))
485 {
486 Lisp_Object items;
487 items = FRAME_MENU_BAR_ITEMS (f);
488 for (; CONSP (items); items = XCONS (items)->cdr)
489 if (!strcmp (val->name,
490 XSTRING (Fcar (Fcdr (Fcar (items))))->data))
491 return items;
492 }
493 }
494 return Qnil;
495}
496
497static widget_value *
498set_menu_items (menu, prefixes, panes, names, enables, menus,
499 items, number_of_panes, obj_list, title, error_name)
500 Lisp_Object menu;
501 Lisp_Object **prefixes;
502 int *panes;
503 char ***names[];
504 int ***enables;
505 char ***menus;
506 int **items;
507 int *number_of_panes;
508 Lisp_Object ***obj_list;
509 char **title;
510 char **error_name;
511{
512 Lisp_Object keymap, tem;
513 Lisp_Object ltitle, selection;
514 int i, j;
515 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
516 int last, selidx, lpane, status;
517 int lines, sofar;
518
519 keymap = Fkeymapp (menu);
520 tem = Qnil;
521
522 if (XTYPE (menu) == Lisp_Cons)
523 tem = Fkeymapp (Fcar (menu));
524 if (!NILP (keymap))
525 {
526 /* We were given a keymap. Extract menu info from the keymap. */
527 Lisp_Object prompt;
528 keymap = get_keymap (menu);
529
530 /* Search for a string appearing directly as an element of the keymap.
531 That string is the title of the menu. */
532 prompt = map_prompt (keymap);
533 if (!NILP (prompt))
534 *title = (char *) XSTRING (prompt)->data;
535
536 /* Extract the detailed info to make one pane. */
537 *number_of_panes = keymap_panes (obj_list, menus, names, enables,
538 items, prefixes, menu, 1);
539 /* The menu title seems to be ignored,
540 so put it in the pane title. */
541 if ((*menus)[0] == 0)
542 (*menus)[0] = *title;
543 }
544 else if (!NILP (tem))
545 {
546 /* We were given a list of keymaps. */
547 Lisp_Object prompt;
548 int nmaps = XFASTINT (Flength (menu));
549 Lisp_Object *maps
550 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
551 int i;
552 *title = 0;
553
554 /* The first keymap that has a prompt string
555 supplies the menu title. */
556 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
557 {
558 maps[i++] = keymap = get_keymap (Fcar (tem));
559
560 prompt = map_prompt (keymap);
561 if (*title == 0 && !NILP (prompt))
562 *title = (char *) XSTRING (prompt)->data;
563 }
564
565 /* Extract the detailed info to make one pane. */
566 *number_of_panes = keymap_panes (obj_list, menus, names, enables,
567 items, prefixes, maps, nmaps);
568 /* The menu title seems to be ignored,
569 so put it in the pane title. */
570 if ((*menus)[0] == 0)
571 (*menus)[0] = *title;
572 }
573 else
574 {
575 /* We were given an old-fashioned menu. */
576 ltitle = Fcar (menu);
577 CHECK_STRING (ltitle, 1);
578 *title = (char *) XSTRING (ltitle)->data;
579 *prefixes = 0;
580 *number_of_panes = list_of_panes (obj_list, menus, names, enables,
581 items, Fcdr (menu));
582 }
583
584 *error_name = 0;
585 if (*number_of_panes == 0)
586 return 0;
587
588 *error_name = (char *) 0; /* Initialize error pointer to null */
589
590 wv = malloc_widget_value ();
591 wv->name = "menu";
592 wv->value = 0;
593 wv->enabled = 1;
594 first_wv = wv;
595
596 for (*panes = 0, lines = 0; *panes < *number_of_panes;
597 lines += (*items)[*panes], (*panes)++)
598 ;
599 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
600 /* datap = (char *) xmalloc (lines * sizeof (char));
601 datap_save = datap;*/
602
603 for (*panes = 0, sofar = 0; *panes < *number_of_panes;
604 sofar += (*items)[*panes], (*panes)++)
605 {
606 if (strcmp((*menus)[*panes], ""))
607 {
608 wv = malloc_widget_value ();
609 if (save_wv)
610 save_wv->next = wv;
611 else
612 first_wv->contents = wv;
613 wv->name = (*menus)[*panes];
614 wv->value = 0;
615 wv->enabled = 1;
616 }
617 prev_wv = 0;
618 save_wv = wv;
619
620 for (selidx = 0; selidx < (*items)[*panes]; selidx++)
621 {
622 wv = malloc_widget_value ();
623 if (prev_wv)
624 prev_wv->next = wv;
625 else
626 save_wv->contents = wv;
627 wv->name = (*names)[*panes][selidx];
628 wv->value = 0;
629 selection = (*obj_list)[*panes][selidx];
630 if (*prefixes != 0)
631 {
632 selection = Fcons (selection, Qnil);
633 if (!NILP ((*prefixes)[*panes]))
634 selection = Fcons ((*prefixes)[*panes], selection);
635 }
636 wv->call_data = LISP_TO_VOID(selection);
637 wv->enabled = (*enables)[*panes][selidx];
638 prev_wv = wv;
639 }
640 }
641
642 return (first_wv);
643}
644
645static void
646free_menu_items (names, enables, menus, items, number_of_panes,
647 obj_list, title, error_name)
648 char **names[];
649 int *enables[];
650 char **menus;
651 int *items;
652 int number_of_panes;
653 Lisp_Object **obj_list;
654 char *title;
655 char *error_name;
656{
657 int i;
658 /* now free up the strings */
659 for (i = 0; i < number_of_panes; i++)
660 {
661 xfree (names[i]);
662 xfree (enables[i]);
663 xfree (obj_list[i]);
664 }
665 xfree (menus);
666 xfree (obj_list);
667 xfree (names);
668 xfree (enables);
669 xfree (items);
670 /* free (title); */
671 if (error_name) error (error_name);
672
673}
674
675static Lisp_Object menu_item_selection;
676
677static void
678popup_selection_callback (widget, id, client_data)
679 Widget widget;
680 LWLIB_ID id;
681 XtPointer client_data;
682{
683#if 0
684 last_popup_selection_callback_id = id;
685 menubar_selection_callback (widget, id, client_data);
686 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
687#endif
688 VOID_TO_LISP (menu_item_selection, client_data);
689}
690
691static void
692popup_down_callback (widget, id, client_data)
693 Widget widget;
694 LWLIB_ID id;
695 XtPointer client_data;
696{
697#if 0
698 if (popup_menu_up_p == 0) abort ();
699 popup_menu_up_p--;
700 /* if this isn't called immediately after the selection callback, then
701 there wasn't a menu selection. */
702 if (id != last_popup_selection_callback_id)
703 menubar_selection_callback (widget, id, (XtPointer) -1);
704#endif
705 BLOCK_INPUT;
706 lw_destroy_all_widgets (id);
707 UNBLOCK_INPUT;
708/* ungcpro_popup_callbacks (make_number (id)); */
709}
710
711/* This recursively calls free_widget_value() on the tree of widgets.
712 It must free all data that was malloc'ed for these widget_values.
713 Currently, emacs only allocates new storage for the `key' slot.
714 All other slots are pointers into the data of Lisp_Strings, and
715 must be left alone.
716 */
717void
718free_menubar_widget_value_tree (wv)
719 widget_value *wv;
720{
721 if (! wv) return;
722 if (wv->key) xfree (wv->key);
723
724 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
725
726 if (wv->contents && (wv->contents != (widget_value*)1))
727 {
728 free_menubar_widget_value_tree (wv->contents);
729 wv->contents = (widget_value *) 0xDEADBEEF;
730 }
731 if (wv->next)
732 {
733 free_menubar_widget_value_tree (wv->next);
734 wv->next = (widget_value *) 0xDEADBEEF;
735 }
736 BLOCK_INPUT;
737 free_widget_value (wv);
738 UNBLOCK_INPUT;
739}
740
741static void
742update_one_frame_psheets (f)
743 FRAME_PTR f;
744{
745 struct x_display *x = f->display.x;
746
747 int menubar_changed;
748
749 menubar_changed = (x->menubar_widget
750 && !XtIsManaged (x->menubar_widget));
751
752 if (! (menubar_changed))
753 return;
754
755 BLOCK_INPUT;
756 XawPanedSetRefigureMode (x->column_widget, 0);
757
758 /* the order in which children are managed is the top to
759 bottom order in which they are displayed in the paned window.
760 First, remove the text-area widget.
761 */
762 XtUnmanageChild (x->edit_widget);
763
764 /* remove the menubar that is there now, and put up the menubar that
765 should be there.
766 */
767 if (menubar_changed)
768 {
769 XtManageChild (x->menubar_widget);
770 XtMapWidget (x->menubar_widget);
771 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
772 }
773
774
775 /* Re-manage the text-area widget */
776 XtManageChild (x->edit_widget);
777
778 /* and now thrash the sizes */
779 XawPanedSetRefigureMode (x->column_widget, 1);
780 UNBLOCK_INPUT;
781}
782
783void
784set_frame_menubar (f)
785 FRAME_PTR f;
786{
787 Widget menubar_widget = f->display.x->menubar_widget;
788 int id = (int) f;
789 Lisp_Object tail;
790 widget_value *wv, *save_wv, *first_wv, *prev_wv = 0;
791
792 BLOCK_INPUT;
793
794 wv = malloc_widget_value ();
795 wv->name = "menubar";
796 wv->value = 0;
797 wv->enabled = 1;
798 save_wv = first_wv = wv;
799
800
801 for (tail = FRAME_MENU_BAR_ITEMS (f); CONSP (tail); tail = XCONS (tail)->cdr)
802 {
803 Lisp_Object string;
804
805 string = Fcar (Fcdr (Fcar (tail)));
806
807 wv = malloc_widget_value ();
808 if (prev_wv)
809 prev_wv->next = wv;
810 else
811 save_wv->contents = wv;
812 wv->name = XSTRING (string)->data;
813 wv->value = 0;
814 wv->enabled = 1;
815 prev_wv = wv;
816 }
817
818 if (menubar_widget)
819 lw_modify_all_widgets (id, first_wv, False);
820 else
821 {
822 menubar_widget = lw_create_widget ("menubar", "menubar",
823 id, first_wv,
824 f->display.x->column_widget,
825 0, 0,
826 0, 0);
827 f->display.x->menubar_widget = menubar_widget;
828 XtVaSetValues (menubar_widget,
829 XtNshowGrip, 0,
830 XtNresizeToPreferred, 1,
831 XtNallowResize, 1,
832 0);
833 }
834
835 free_menubar_widget_value_tree (first_wv);
836
837 update_one_frame_psheets (f);
838
839 UNBLOCK_INPUT;
840}
85f487d1
FP
841
842void
843free_frame_menubar (f)
844 FRAME_PTR f;
845{
846 Widget menubar_widget;
847 int id;
848
849 menubar_widget = f->display.x->menubar_widget;
850 id = (int) f;
851
852 if (menubar_widget)
853 {
854 BLOCK_INPUT;
855 lw_destroy_all_widgets (id);
856 UNBLOCK_INPUT;
857 }
858}
18686d47
RS
859#endif /* USE_X_TOOLKIT */
860\f
dcfdbac7
JB
861struct indices {
862 int pane;
863 int line;
864};
865
18686d47
RS
866extern void process_expose_from_menu ();
867
868#ifdef USE_X_TOOLKIT
869extern XtAppContext Xt_app_con;
870
dcfdbac7 871Lisp_Object
18686d47
RS
872xmenu_show (f, val, x, y, menubarp, vw)
873 FRAME_PTR f;
874 widget_value *val;
875 int x;
876 int y;
877 int menubarp;
878 widget_value *vw;
879{
47e8f9a3 880 int menu_id, item_length;
18686d47
RS
881 Lisp_Object selection;
882 Widget menu;
47e8f9a3 883 XlwMenuWidget menuw = (XlwMenuWidget) f->display.x->menubar_widget;
18686d47
RS
884
885 /*
886 * Define and allocate a foreign event queue to hold events
887 * that don't belong to XMenu. These events are later restored
888 * to the X event queue.
889 */
890 typedef struct _xmeventque
891 {
892 XEvent event;
893 struct _xmeventque *next;
894 } XMEventQue;
895
896 XMEventQue *feq = NULL; /* Foreign event queue. */
897 XMEventQue *feq_tmp; /* Foreign event queue temporary. */
898
899 BLOCK_INPUT;
63c414df
FP
900 if (val == 0) return Qnil;
901
18686d47
RS
902 menu_id = ++popup_id_tick;
903 menu = lw_create_widget ("popup", val->name, menu_id, val,
904 f->display.x->widget, 1, 0,
905 popup_selection_callback, popup_down_callback);
906 free_menubar_widget_value_tree (val);
907
908 /* reset the selection */
909 menu_item_selection = Qnil;
910
911 {
912 XButtonPressedEvent dummy;
913 XlwMenuWidget mw;
914
915 mw = ((XlwMenuWidget)
916 ((CompositeWidget)menu)->composite.children[0]);
917
918 dummy.type = ButtonPress;
919 dummy.serial = 0;
920 dummy.send_event = 0;
921 dummy.display = XtDisplay (menu);
922 dummy.window = XtWindow (XtParent (menu));
923 dummy.time = CurrentTime;
924 dummy.button = 0;
925 dummy.x_root = x;
926 dummy.y_root = y;
927
928 if (menubarp)
929 {
18686d47
RS
930 vw->call_data = (XtPointer) 1;
931 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
18686d47
RS
932 }
933
934
935 /* We activate directly the lucid implementation */
936 pop_up_menu (mw, &dummy);
937 }
938
47e8f9a3
FP
939 if (menubarp)
940 {
941 item_length = (x + string_width (menuw, vw->name)
942 + (2 * (menuw->menu.horizontal_spacing
943 + menuw->menu.shadow_thickness))
944 - 4);
945 }
946
18686d47
RS
947 /* Enters XEvent loop */
948 while (1)
949 {
950
951 XEvent event;
952 XtAppNextEvent (Xt_app_con, &event);
953 if (event.type == ButtonRelease)
954 {
955 XtDispatchEvent (&event);
956 break;
957 }
958 else
959 if (event.type == Expose)
960 process_expose_from_menu (event);
47e8f9a3
FP
961 else
962 if (event.type == MotionNotify
9106ccf1
FP
963 && menubarp
964 && ((event.xmotion.y_root
965 >= (f->display.x->widget->core.y
966 + f->display.x->widget->core.border_width))
967 && (event.xmotion.y_root
968 < (f->display.x->widget->core.y
969 + f->display.x->widget->core.border_width
970 + f->display.x->menubar_widget->core.height)))
971 && ((event.xmotion.x_root
972 >= (f->display.x->widget->core.x
973 + f->display.x->widget->core.border_width))
974 && (event.xmotion.x_root
975 < (f->display.x->widget->core.x
976 + f->display.x->widget->core.border_width
977 + f->display.x->widget->core.width)))
47e8f9a3
FP
978 && (event.xmotion.x_root >= item_length
979 || event.xmotion.x_root < (x - 4)))
980 {
981 BLOCK_INPUT;
982 XtUngrabPointer ((Widget)
983 ((XlwMenuWidget)
984 ((CompositeWidget)menu)->composite.children[0]),
985 event.xbutton.time);
986 lw_destroy_all_widgets (menu_id);
987 UNBLOCK_INPUT;
988
989 event.type = ButtonPress;
990 event.xbutton.time = CurrentTime;
991 event.xbutton.button = Button1;
992 event.xbutton.window = XtWindow (f->display.x->menubar_widget);
993 event.xbutton.x = (event.xbutton.x_root
994 - (f->display.x->widget->core.x
995 + f->display.x->widget->core.border_width));
996 XPutBackEvent (XDISPLAY &event);
997 break;
998 }
999
18686d47
RS
1000 XtDispatchEvent (&event);
1001 feq_tmp = (XMEventQue *) malloc (sizeof (XMEventQue));
1002
1003 if (feq_tmp == NULL)
1004 return(Qnil);
1005
1006 feq_tmp->event = event;
1007 feq_tmp->next = feq;
1008 feq = feq_tmp;
1009 }
1010
1011 if (menubarp)
1012 {
18686d47 1013 vw->call_data = (XtPointer) 0;
399703f1 1014 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
18686d47
RS
1015 }
1016
1017 /* Return any foreign events that were queued to the X event queue. */
1018 while (feq != NULL)
1019 {
1020 feq_tmp = feq;
1021 XPutBackEvent (XDISPLAY &feq_tmp->event);
1022 feq = feq_tmp->next;
1023 free ((char *)feq_tmp);
1024 }
1025
1026 UNBLOCK_INPUT;
1027
1028 return menu_item_selection;
1029}
1030
1031#else /* not USE_X_TOOLKIT */
aedaff8d 1032xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
819012f0 1033 prefixes, line_cnt, pane_cnt, item_list, title, error)
dcfdbac7
JB
1034 Window parent;
1035 int startx, starty; /* upper left corner position BROKEN */
1036 char **line_list[]; /* list of strings for items */
86e7b627 1037 int *enable_list[]; /* enable flags of lines */
dcfdbac7 1038 char *pane_list[]; /* list of pane titles */
819012f0 1039 Lisp_Object *prefixes; /* Prefix key for each pane */
dcfdbac7
JB
1040 char *title;
1041 int pane_cnt; /* total number of panes */
1042 Lisp_Object *item_list[]; /* All items */
1043 int line_cnt[]; /* Lines in each pane */
1044 char **error; /* Error returned */
1045{
1046 XMenu *GXMenu;
1047 int last, panes, selidx, lpane, status;
1048 int lines, sofar;
1049 Lisp_Object entry;
1050 /* struct indices *datap, *datap_save; */
1051 char *datap;
1052 int ulx, uly, width, height;
1053 int dispwidth, dispheight;
088831f6 1054
07a675b7 1055 *error = 0;
088831f6
RS
1056 if (pane_cnt == 0)
1057 return 0;
1058
10c48c95 1059 BLOCK_INPUT;
dcfdbac7 1060 *error = (char *) 0; /* Initialize error pointer to null */
18686d47 1061
dcfdbac7
JB
1062 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
1063 if (GXMenu == NUL)
1064 {
1065 *error = "Can't create menu";
10c48c95 1066 UNBLOCK_INPUT;
dcfdbac7
JB
1067 return (0);
1068 }
18686d47 1069
088831f6
RS
1070 for (panes = 0, lines = 0; panes < pane_cnt;
1071 lines += line_cnt[panes], panes++)
dcfdbac7
JB
1072 ;
1073 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
088831f6 1074 /* datap = (char *) xmalloc (lines * sizeof (char));
dcfdbac7
JB
1075 datap_save = datap;*/
1076
088831f6
RS
1077 for (panes = 0, sofar = 0; panes < pane_cnt;
1078 sofar += line_cnt[panes], panes++)
dcfdbac7
JB
1079 {
1080 /* create all the necessary panes */
1081 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
1082 if (lpane == XM_FAILURE)
1083 {
1084 XMenuDestroy (XDISPLAY GXMenu);
1085 *error = "Can't create pane";
10c48c95 1086 UNBLOCK_INPUT;
dcfdbac7
JB
1087 return (0);
1088 }
18686d47 1089
088831f6 1090 for (selidx = 0; selidx < line_cnt[panes]; selidx++)
dcfdbac7
JB
1091 {
1092 /* add the selection stuff to the menus */
1093 /* datap[selidx+sofar].pane = panes;
1094 datap[selidx+sofar].line = selidx; */
1095 if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
aedaff8d
RS
1096 line_list[panes][selidx],
1097 enable_list[panes][selidx])
dcfdbac7
JB
1098 == XM_FAILURE)
1099 {
1100 XMenuDestroy (XDISPLAY GXMenu);
1101 /* free (datap); */
1102 *error = "Can't add selection to menu";
1103 /* error ("Can't add selection to menu"); */
10c48c95 1104 UNBLOCK_INPUT;
dcfdbac7
JB
1105 return (0);
1106 }
1107 }
1108 }
1109 /* all set and ready to fly */
1110 XMenuRecompute (XDISPLAY GXMenu);
1111 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
1112 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
1113 startx = min (startx, dispwidth);
1114 starty = min (starty, dispheight);
1115 startx = max (startx, 1);
1116 starty = max (starty, 1);
1117 XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
1118 &ulx, &uly, &width, &height);
1119 if (ulx+width > dispwidth)
1120 {
1121 startx -= (ulx + width) - dispwidth;
1122 ulx = dispwidth - width;
1123 }
1124 if (uly+height > dispheight)
1125 {
1126 starty -= (uly + height) - dispheight;
1127 uly = dispheight - height;
1128 }
1129 if (ulx < 0) startx -= ulx;
1130 if (uly < 0) starty -= uly;
1131
1132 XMenuSetFreeze (GXMenu, TRUE);
1133 panes = selidx = 0;
1134
1135 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
1136 startx, starty, ButtonReleaseMask, &datap);
1137 switch (status)
1138 {
1139 case XM_SUCCESS:
1140#ifdef XDEBUG
1141 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
1142#endif
1143 entry = item_list[panes][selidx];
819012f0
RS
1144 if (prefixes != 0)
1145 {
1146 entry = Fcons (entry, Qnil);
1147 if (!NILP (prefixes[panes]))
1148 entry = Fcons (prefixes[panes], entry);
1149 }
dcfdbac7
JB
1150 break;
1151 case XM_FAILURE:
088831f6 1152 /* free (datap_save); */
dcfdbac7
JB
1153 XMenuDestroy (XDISPLAY GXMenu);
1154 *error = "Can't activate menu";
1155 /* error ("Can't activate menu"); */
1156 case XM_IA_SELECT:
1157 case XM_NO_SELECT:
1158 entry = Qnil;
1159 break;
1160 }
1161 XMenuDestroy (XDISPLAY GXMenu);
10c48c95 1162 UNBLOCK_INPUT;
088831f6 1163 /* free (datap_save);*/
dcfdbac7
JB
1164 return (entry);
1165}
18686d47 1166#endif /* not USE_X_TOOLKIT */
dcfdbac7
JB
1167
1168syms_of_xmenu ()
1169{
18686d47 1170 popup_id_tick = (1<<16);
dcfdbac7
JB
1171 defsubr (&Sx_popup_menu);
1172}
088831f6
RS
1173\f
1174/* Construct the vectors that describe a menu
aedaff8d 1175 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
1176 Each of those four values is a vector indexed by pane number.
1177 Return the number of panes.
1178
1179 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */
1180
1181int
819012f0 1182keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
088831f6
RS
1183 Lisp_Object ***vector; /* RETURN all menu objects */
1184 char ***panes; /* RETURN pane names */
1185 char ****names; /* RETURN all line names */
aedaff8d 1186 int ***enables; /* RETURN enable-flags of lines */
088831f6 1187 int **items; /* RETURN number of items per pane */
819012f0 1188 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
088831f6
RS
1189 Lisp_Object *keymaps;
1190 int nmaps;
1191{
1192 /* Number of panes we have made. */
1193 int p = 0;
1194 /* Number of panes we have space for. */
1195 int npanes_allocated = nmaps;
1196 int mapno;
1197
1198 if (npanes_allocated < 4)
1199 npanes_allocated = 4;
1200
1201 /* Make space for an estimated number of panes. */
1202 *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
1203 *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
1204 *items = (int *) xmalloc (npanes_allocated * sizeof (int));
1205 *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
aedaff8d 1206 *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
819012f0 1207 *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
088831f6
RS
1208
1209 /* Loop over the given keymaps, making a pane for each map.
1210 But don't make a pane that is empty--ignore that map instead.
1211 P is the number of panes we have made so far. */
1212 for (mapno = 0; mapno < nmaps; mapno++)
aedaff8d 1213 single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
819012f0 1214 prefixes, &p, &npanes_allocated, "");
088831f6
RS
1215
1216 /* Return the number of panes. */
1217 return p;
1218}
1219
71cc5cf3
RS
1220/* This is used as the handler when calling internal_condition_case_1. */
1221
1222static Lisp_Object
1223single_keymap_panes_1 (arg)
1224 Lisp_Object arg;
1225{
1226 return Qnil;
1227}
1228
1229/* This is a recursive subroutine of keymap_panes.
088831f6
RS
1230 It handles one keymap, KEYMAP.
1231 The other arguments are passed along
1232 or point to local variables of the previous function. */
1233
819012f0 1234single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
088831f6
RS
1235 p_ptr, npanes_allocated_ptr, pane_name)
1236 Lisp_Object keymap;
1237 Lisp_Object ***vector; /* RETURN all menu objects */
1238 char ***panes; /* RETURN pane names */
1239 char ****names; /* RETURN all line names */
aedaff8d 1240 int ***enables; /* RETURN enable flags of lines */
088831f6 1241 int **items; /* RETURN number of items per pane */
819012f0 1242 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
088831f6
RS
1243 int *p_ptr;
1244 int *npanes_allocated_ptr;
1245 char *pane_name;
1246{
1247 int i;
1248 Lisp_Object pending_maps;
1249 Lisp_Object tail, item, item1, item2, table;
1250
1251 pending_maps = Qnil;
1252
1253 /* Make sure we have room for another pane. */
1254 if (*p_ptr == *npanes_allocated_ptr)
1255 {
1256 *npanes_allocated_ptr *= 2;
1257
1258 *vector
1259 = (Lisp_Object **) xrealloc (*vector,
1260 *npanes_allocated_ptr * sizeof (Lisp_Object *));
1261 *panes
1262 = (char **) xrealloc (*panes,
1263 *npanes_allocated_ptr * sizeof (char *));
1264 *items
1265 = (int *) xrealloc (*items,
1266 *npanes_allocated_ptr * sizeof (int));
819012f0
RS
1267 *prefixes
1268 = (Lisp_Object *) xrealloc (*prefixes,
1269 (*npanes_allocated_ptr
1270 * sizeof (Lisp_Object)));
088831f6
RS
1271 *names
1272 = (char ***) xrealloc (*names,
1273 *npanes_allocated_ptr * sizeof (char **));
aedaff8d
RS
1274 *enables
1275 = (int **) xrealloc (*enables,
1276 *npanes_allocated_ptr * sizeof (int *));
088831f6
RS
1277 }
1278
1279 /* When a menu comes from keymaps, don't give names to the panes. */
1280 (*panes)[*p_ptr] = pane_name;
1281
819012f0
RS
1282 /* Normally put nil as pane's prefix key.
1283 Caller will override this if appropriate. */
1284 (*prefixes)[*p_ptr] = Qnil;
1285
088831f6
RS
1286 /* Get the length of the list level of the keymap. */
1287 i = XFASTINT (Flength (keymap));
1288
ab6ee1a0
RS
1289 /* Add in lengths of any arrays. */
1290 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
1291 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
1292 i += XVECTOR (XCONS (tail)->car)->size;
088831f6
RS
1293
1294 /* Create vectors for the names and values of the items in the pane.
1295 I is an upper bound for the number of items. */
1296 (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
1297 (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
aedaff8d 1298 (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
088831f6
RS
1299
1300 /* I is now the index of the next unused slots. */
1301 i = 0;
1302 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
1303 {
1304 /* Look at each key binding, and if it has a menu string,
1305 make a menu item from it. */
1306 item = XCONS (tail)->car;
1307 if (XTYPE (item) == Lisp_Cons)
1308 {
1309 item1 = XCONS (item)->cdr;
1310 if (XTYPE (item1) == Lisp_Cons)
1311 {
1312 item2 = XCONS (item1)->car;
1313 if (XTYPE (item2) == Lisp_String)
1314 {
d9dcaf49
RS
1315 Lisp_Object def, tem;
1316 Lisp_Object enabled;
1317
1318 def = Fcdr (item1);
1319 enabled = Qt;
1320 if (XTYPE (def) == Lisp_Symbol)
1321 {
1322 /* No property, or nil, means enable.
1323 Otherwise, enable if value is not nil. */
1324 tem = Fget (def, Qmenu_enable);
1325 if (!NILP (tem))
71cc5cf3
RS
1326 /* (condition-case nil (eval tem)
1327 (error nil)) */
1328 enabled = internal_condition_case_1 (Feval, tem,
1329 Qerror,
1330 single_keymap_panes_1);
d9dcaf49
RS
1331 }
1332 tem = Fkeymapp (def);
088831f6 1333 if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
819012f0 1334 pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)),
088831f6 1335 pending_maps);
aedaff8d 1336 else
088831f6
RS
1337 {
1338 (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
1339 /* The menu item "value" is the key bound here. */
1340 (*vector)[*p_ptr][i] = XCONS (item)->car;
aedaff8d 1341 (*enables)[*p_ptr][i]
24af387f 1342 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
088831f6
RS
1343 i++;
1344 }
1345 }
1346 }
1347 }
ab6ee1a0
RS
1348 else if (XTYPE (item) == Lisp_Vector)
1349 {
1350 /* Loop over the char values represented in the vector. */
1351 int len = XVECTOR (item)->size;
1352 int c;
1353 for (c = 0; c < len; c++)
1354 {
1355 Lisp_Object character;
1356 XFASTINT (character) = c;
1357 item1 = XVECTOR (item)->contents[c];
1358 if (XTYPE (item1) == Lisp_Cons)
1359 {
1360 item2 = XCONS (item1)->car;
1361 if (XTYPE (item2) == Lisp_String)
1362 {
1363 Lisp_Object tem;
d9dcaf49
RS
1364 Lisp_Object def;
1365 Lisp_Object enabled;
1366
1367 def = Fcdr (item1);
1368 enabled = Qt;
1369 if (XTYPE (def) == Lisp_Symbol)
1370 {
1371 tem = Fget (def, Qmenu_enable);
1372 /* No property, or nil, means enable.
1373 Otherwise, enable if value is not nil. */
1374 if (!NILP (tem))
71cc5cf3
RS
1375 /* (condition-case nil (eval tem)
1376 (error nil)) */
1377 enabled = internal_condition_case_1 (Feval, tem,
1378 Qerror,
1379 single_keymap_panes_1);
d9dcaf49
RS
1380 }
1381
1382 tem = Fkeymapp (def);
ab6ee1a0 1383 if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
819012f0 1384 pending_maps = Fcons (Fcons (def, Fcons (item2, character)),
ab6ee1a0 1385 pending_maps);
aedaff8d 1386 else
ab6ee1a0
RS
1387 {
1388 (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
1389 /* The menu item "value" is the key bound here. */
1390 (*vector)[*p_ptr][i] = character;
aedaff8d 1391 (*enables)[*p_ptr][i]
24af387f 1392 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
ab6ee1a0
RS
1393 i++;
1394 }
1395 }
1396 }
1397 }
1398 }
088831f6
RS
1399 }
1400 /* Record the number of items in the pane. */
1401 (*items)[*p_ptr] = i;
1402
1403 /* If we just made an empty pane, get rid of it. */
1404 if (i == 0)
1405 {
9ac0d9e0
JB
1406 xfree ((*vector)[*p_ptr]);
1407 xfree ((*names)[*p_ptr]);
1408 xfree ((*enables)[*p_ptr]);
088831f6
RS
1409 }
1410 /* Otherwise, advance past it. */
1411 else
1412 (*p_ptr)++;
1413
1414 /* Process now any submenus which want to be panes at this level. */
1415 while (!NILP (pending_maps))
1416 {
819012f0
RS
1417 Lisp_Object elt, eltcdr;
1418 int panenum = *p_ptr;
088831f6 1419 elt = Fcar (pending_maps);
819012f0 1420 eltcdr = XCONS (elt)->cdr;
aedaff8d 1421 single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
819012f0 1422 prefixes, p_ptr, npanes_allocated_ptr,
088831f6 1423 /* Add 1 to discard the @. */
819012f0
RS
1424 (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
1425 (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
088831f6
RS
1426 pending_maps = Fcdr (pending_maps);
1427 }
1428}
1429\f
1430/* Construct the vectors that describe a menu
aedaff8d 1431 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
1432 Each of those four values is a vector indexed by pane number.
1433 Return the number of panes.
1434
1435 MENU is the argument that was given to Fx_popup_menu. */
dcfdbac7 1436
088831f6 1437int
aedaff8d 1438list_of_panes (vector, panes, names, enables, items, menu)
dcfdbac7
JB
1439 Lisp_Object ***vector; /* RETURN all menu objects */
1440 char ***panes; /* RETURN pane names */
1441 char ****names; /* RETURN all line names */
aedaff8d 1442 int ***enables; /* RETURN enable flags of lines */
dcfdbac7
JB
1443 int **items; /* RETURN number of items per pane */
1444 Lisp_Object menu;
1445{
1446 Lisp_Object tail, item, item1;
1447 int i;
1448
1449 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
1450
088831f6 1451 i = XFASTINT (Flength (menu));
dcfdbac7
JB
1452
1453 *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
1454 *panes = (char **) xmalloc (i * sizeof (char *));
1455 *items = (int *) xmalloc (i * sizeof (int));
1456 *names = (char ***) xmalloc (i * sizeof (char **));
aedaff8d 1457 *enables = (int **) xmalloc (i * sizeof (int *));
dcfdbac7 1458
088831f6 1459 for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 1460 {
088831f6
RS
1461 item = Fcdr (Fcar (tail));
1462 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
dcfdbac7 1463#ifdef XDEBUG
088831f6 1464 fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
dcfdbac7 1465#endif
088831f6
RS
1466 item1 = Fcar (Fcar (tail));
1467 CHECK_STRING (item1, 1);
dcfdbac7 1468#ifdef XDEBUG
088831f6
RS
1469 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
1470 XSTRING (item1)->data);
dcfdbac7 1471#endif
088831f6 1472 (*panes)[i] = (char *) XSTRING (item1)->data;
aedaff8d 1473 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
088831f6
RS
1474 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
1475 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
1476 ; */
dcfdbac7
JB
1477 }
1478 return i;
1479}
088831f6
RS
1480\f
1481/* Construct the lists of values and names for a single pane, from the
aedaff8d
RS
1482 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags
1483 int *ENABLES. Return the number of items. */
dcfdbac7 1484
088831f6 1485int
aedaff8d 1486list_of_items (vector, names, enables, pane)
dcfdbac7
JB
1487 Lisp_Object **vector; /* RETURN menu "objects" */
1488 char ***names; /* RETURN line names */
aedaff8d 1489 int **enables; /* RETURN enable flags of lines */
dcfdbac7
JB
1490 Lisp_Object pane;
1491{
1492 Lisp_Object tail, item, item1;
1493 int i;
1494
1495 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
1496
f1b28218 1497 i = XFASTINT (Flength (pane));
dcfdbac7
JB
1498
1499 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
1500 *names = (char **) xmalloc (i * sizeof (char *));
aedaff8d 1501 *enables = (int *) xmalloc (i * sizeof (int));
dcfdbac7 1502
088831f6 1503 for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 1504 {
088831f6 1505 item = Fcar (tail);
24af387f
RS
1506 if (STRINGP (item))
1507 {
1508 (*vector)[i] = Qnil;
1509 (*names)[i] = (char *) XSTRING (item)->data;
1510 (*enables)[i] = -1;
1511 }
1512 else
1513 {
1514 CHECK_CONS (item, 0);
1515 (*vector)[i] = Fcdr (item);
1516 item1 = Fcar (item);
1517 CHECK_STRING (item1, 1);
1518 (*names)[i] = (char *) XSTRING (item1)->data;
1519 (*enables)[i] = 1;
1520 }
dcfdbac7
JB
1521 }
1522 return i;
1523}