Initial revision
[bpt/emacs.git] / src / xmenu.c
CommitLineData
dcfdbac7 1/* X Communication module for terminals which understand the X protocol.
774910eb 2 Copyright (C) 1986, 1988, 1992 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
dcfdbac7
JB
27#ifdef XDEBUG
28#include <stdio.h>
29#endif
30
31/* On 4.3 this loses if it comes after xterm.h. */
32#include <signal.h>
33#include "config.h"
34#include "lisp.h"
7708e9bd 35#include "frame.h"
dcfdbac7 36#include "window.h"
031b0e31 37#include "keyboard.h"
9ac0d9e0 38#include "blockinput.h"
dcfdbac7
JB
39
40/* This may include sys/types.h, and that somehow loses
41 if this is not done before the other system files. */
42#include "xterm.h"
43
44/* Load sys/types.h if not already loaded.
45 In some systems loading it twice is suicidal. */
46#ifndef makedev
47#include <sys/types.h>
48#endif
49
50#include "dispextern.h"
51
52#ifdef HAVE_X11
53#include "../oldXMenu/XMenu.h"
54#else
55#include <X/XMenu.h>
56#endif
57
58#define min(x,y) (((x) < (y)) ? (x) : (y))
59#define max(x,y) (((x) > (y)) ? (x) : (y))
60
61#define NUL 0
62
63#ifndef TRUE
64#define TRUE 1
65#define FALSE 0
66#endif TRUE
67
68#ifdef HAVE_X11
69extern Display *x_current_display;
70#else
71#define ButtonReleaseMask ButtonReleased
72#endif /* not HAVE_X11 */
73
6904bdcd 74extern Lisp_Object Qmenu_enable;
dcfdbac7
JB
75Lisp_Object xmenu_show ();
76extern int x_error_handler ();
77
78/*************************************************************/
79
80#if 0
81/* Ignoring the args is easiest. */
82xmenu_quit ()
83{
84 error ("Unknown XMenu error");
85}
86#endif
87
88DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0,
89 "Pop up a deck-of-cards menu and return user's selection.\n\
088831f6
RS
90POSITION is a position specification. This is either a mouse button event\n\
91or a list ((XOFFSET YOFFSET) WINDOW)\n\
dcfdbac7 92where XOFFSET and YOFFSET are positions in characters from the top left\n\
7da99777 93corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
dcfdbac7
JB
94This controls the position of the center of the first line\n\
95in the first pane of the menu, not the top left of the menu as a whole.\n\
96\n\
088831f6
RS
97MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
98The menu items come from key bindings that have a menu string as well as\n\
99a definition; actually, the \"definition\" in such a key binding looks like\n\
100\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
101the keymap as a top-level element.\n\n\
102You can also use a list of keymaps as MENU.\n\
103 Then each keymap makes a separate pane.\n\n\
104Alternatively, you can specify a menu of multiple panes\n\
24af387f
RS
105 with a list of the form (TITLE PANE1 PANE2...),\n\
106where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
107Each ITEM is normally a cons cell (STRING . VALUE);\n\
108but a string can appear as an item--that makes a nonselectable line\n\
109in the menu.")
088831f6
RS
110 (position, menu)
111 Lisp_Object position, menu;
dcfdbac7
JB
112{
113 int number_of_panes;
088831f6 114 Lisp_Object XMenu_return, keymap, tem;
dcfdbac7
JB
115 int XMenu_xpos, XMenu_ypos;
116 char **menus;
117 char ***names;
aedaff8d 118 int **enables;
dcfdbac7
JB
119 Lisp_Object **obj_list;
120 int *items;
121 char *title;
122 char *error_name;
123 Lisp_Object ltitle, selection;
124 int i, j;
7708e9bd 125 FRAME_PTR f;
dcfdbac7
JB
126 Lisp_Object x, y, window;
127
088831f6
RS
128 /* Decode the first argument: find the window and the coordinates. */
129 tem = Fcar (position);
130 if (XTYPE (tem) == Lisp_Cons)
131 {
132 window = Fcar (Fcdr (position));
133 x = Fcar (tem);
134 y = Fcar (Fcdr (tem));
135 }
136 else
137 {
933ff472
RS
138 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
139 window = Fcar (tem); /* POSN_WINDOW (tem) */
140 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
088831f6
RS
141 x = Fcar (tem);
142 y = Fcdr (tem);
143 }
dcfdbac7
JB
144 CHECK_NUMBER (x, 0);
145 CHECK_NUMBER (y, 0);
088831f6 146
7da99777
RS
147 if (XTYPE (window) == Lisp_Frame)
148 {
149 f = XFRAME (window);
150
151 XMenu_xpos = 0;
152 XMenu_ypos = 0;
153 }
154 else if (XTYPE (window) == Lisp_Window)
155 {
156 CHECK_LIVE_WINDOW (window, 0);
157 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
158
159 XMenu_xpos = FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left;
160 XMenu_ypos = FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top;
161 }
162
163 XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
164 XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
dcfdbac7 165
7708e9bd
JB
166 XMenu_xpos += f->display.x->left_pos;
167 XMenu_ypos += f->display.x->top_pos;
dcfdbac7 168
088831f6
RS
169 keymap = Fkeymapp (menu);
170 tem = Qnil;
171 if (XTYPE (menu) == Lisp_Cons)
172 tem = Fkeymapp (Fcar (menu));
173 if (!NILP (keymap))
174 {
175 /* We were given a keymap. Extract menu info from the keymap. */
176 Lisp_Object prompt;
177 keymap = get_keymap (menu);
178
179 /* Search for a string appearing directly as an element of the keymap.
180 That string is the title of the menu. */
181 prompt = map_prompt (keymap);
182 if (!NILP (prompt))
183 title = (char *) XSTRING (prompt)->data;
184
185 /* Extract the detailed info to make one pane. */
aedaff8d
RS
186 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
187 &items, &menu, 1);
088831f6
RS
188 /* The menu title seems to be ignored,
189 so put it in the pane title. */
190 if (menus[0] == 0)
191 menus[0] = title;
192 }
193 else if (!NILP (tem))
dcfdbac7 194 {
088831f6
RS
195 /* We were given a list of keymaps. */
196 Lisp_Object prompt;
197 int nmaps = XFASTINT (Flength (menu));
198 Lisp_Object *maps
199 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
200 int i;
201 title = 0;
202
203 /* The first keymap that has a prompt string
204 supplies the menu title. */
205 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
dcfdbac7 206 {
088831f6
RS
207 maps[i++] = keymap = get_keymap (Fcar (tem));
208
209 prompt = map_prompt (keymap);
210 if (title == 0 && !NILP (prompt))
211 title = (char *) XSTRING (prompt)->data;
dcfdbac7 212 }
088831f6
RS
213
214 /* Extract the detailed info to make one pane. */
aedaff8d
RS
215 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
216 &items, maps, nmaps);
088831f6
RS
217 /* The menu title seems to be ignored,
218 so put it in the pane title. */
219 if (menus[0] == 0)
220 menus[0] = title;
221 }
222 else
223 {
224 /* We were given an old-fashioned menu. */
225 ltitle = Fcar (menu);
226 CHECK_STRING (ltitle, 1);
227 title = (char *) XSTRING (ltitle)->data;
aedaff8d
RS
228 number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
229 &items, Fcdr (menu));
088831f6
RS
230 }
231#ifdef XDEBUG
232 fprintf (stderr, "Panes = %d\n", number_of_panes);
233 for (i = 0; i < number_of_panes; i++)
234 {
235 fprintf (stderr, "Pane %d has lines %d title %s\n",
236 i, items[i], menus[i]);
237 for (j = 0; j < items[i]; j++)
238 fprintf (stderr, " Item %d %s\n", j, names[i][j]);
dcfdbac7
JB
239 }
240#endif
241 BLOCK_INPUT;
c4e5d591
JB
242 {
243 Window root;
244 int root_x, root_y;
245 int dummy_int;
246 unsigned int dummy_uint;
247 Window dummy_window;
248
249 /* Figure out which root window F is on. */
250 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
251 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
252 &dummy_uint, &dummy_uint);
253
254 /* Translate the menu co-ordinates within f to menu co-ordinates
255 on that root window. */
256 if (! XTranslateCoordinates (x_current_display,
257 FRAME_X_WINDOW (f), root,
258 XMenu_xpos, XMenu_ypos, &root_x, &root_y,
259 &dummy_window))
260 /* But XGetGeometry said root was the root window of f's screen! */
261 abort ();
262
aedaff8d
RS
263 selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
264 menus, items, number_of_panes, obj_list, title,
c4e5d591
JB
265 &error_name);
266 }
dcfdbac7 267 UNBLOCK_INPUT;
088831f6 268 /* fprintf (stderr, "selection = %x\n", selection); */
dcfdbac7
JB
269 if (selection != NUL)
270 { /* selected something */
271 XMenu_return = selection;
272 }
273 else
274 { /* nothing selected */
275 XMenu_return = Qnil;
276 }
277 /* now free up the strings */
088831f6 278 for (i = 0; i < number_of_panes; i++)
dcfdbac7 279 {
9ac0d9e0
JB
280 xfree (names[i]);
281 xfree (enables[i]);
282 xfree (obj_list[i]);
dcfdbac7 283 }
9ac0d9e0
JB
284 xfree (menus);
285 xfree (obj_list);
286 xfree (names);
287 xfree (enables);
288 xfree (items);
088831f6 289 /* free (title); */
dcfdbac7
JB
290 if (error_name) error (error_name);
291 return XMenu_return;
292}
293
294struct indices {
295 int pane;
296 int line;
297};
298
299Lisp_Object
aedaff8d
RS
300xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
301 line_cnt, pane_cnt, item_list, title, error)
dcfdbac7
JB
302 Window parent;
303 int startx, starty; /* upper left corner position BROKEN */
304 char **line_list[]; /* list of strings for items */
aedaff8d 305 int *enable_list[]; /* list of strings for items */
dcfdbac7
JB
306 char *pane_list[]; /* list of pane titles */
307 char *title;
308 int pane_cnt; /* total number of panes */
309 Lisp_Object *item_list[]; /* All items */
310 int line_cnt[]; /* Lines in each pane */
311 char **error; /* Error returned */
312{
313 XMenu *GXMenu;
314 int last, panes, selidx, lpane, status;
315 int lines, sofar;
316 Lisp_Object entry;
317 /* struct indices *datap, *datap_save; */
318 char *datap;
319 int ulx, uly, width, height;
320 int dispwidth, dispheight;
088831f6
RS
321
322 if (pane_cnt == 0)
323 return 0;
324
10c48c95 325 BLOCK_INPUT;
dcfdbac7
JB
326 *error = (char *) 0; /* Initialize error pointer to null */
327 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
328 if (GXMenu == NUL)
329 {
330 *error = "Can't create menu";
10c48c95 331 UNBLOCK_INPUT;
dcfdbac7
JB
332 return (0);
333 }
334
088831f6
RS
335 for (panes = 0, lines = 0; panes < pane_cnt;
336 lines += line_cnt[panes], panes++)
dcfdbac7
JB
337 ;
338 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
088831f6 339 /* datap = (char *) xmalloc (lines * sizeof (char));
dcfdbac7
JB
340 datap_save = datap;*/
341
088831f6
RS
342 for (panes = 0, sofar = 0; panes < pane_cnt;
343 sofar += line_cnt[panes], panes++)
dcfdbac7
JB
344 {
345 /* create all the necessary panes */
346 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
347 if (lpane == XM_FAILURE)
348 {
349 XMenuDestroy (XDISPLAY GXMenu);
350 *error = "Can't create pane";
10c48c95 351 UNBLOCK_INPUT;
dcfdbac7
JB
352 return (0);
353 }
088831f6 354 for (selidx = 0; selidx < line_cnt[panes]; selidx++)
dcfdbac7
JB
355 {
356 /* add the selection stuff to the menus */
357 /* datap[selidx+sofar].pane = panes;
358 datap[selidx+sofar].line = selidx; */
359 if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
aedaff8d
RS
360 line_list[panes][selidx],
361 enable_list[panes][selidx])
dcfdbac7
JB
362 == XM_FAILURE)
363 {
364 XMenuDestroy (XDISPLAY GXMenu);
365 /* free (datap); */
366 *error = "Can't add selection to menu";
367 /* error ("Can't add selection to menu"); */
10c48c95 368 UNBLOCK_INPUT;
dcfdbac7
JB
369 return (0);
370 }
371 }
372 }
373 /* all set and ready to fly */
374 XMenuRecompute (XDISPLAY GXMenu);
375 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
376 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
377 startx = min (startx, dispwidth);
378 starty = min (starty, dispheight);
379 startx = max (startx, 1);
380 starty = max (starty, 1);
381 XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
382 &ulx, &uly, &width, &height);
383 if (ulx+width > dispwidth)
384 {
385 startx -= (ulx + width) - dispwidth;
386 ulx = dispwidth - width;
387 }
388 if (uly+height > dispheight)
389 {
390 starty -= (uly + height) - dispheight;
391 uly = dispheight - height;
392 }
393 if (ulx < 0) startx -= ulx;
394 if (uly < 0) starty -= uly;
395
396 XMenuSetFreeze (GXMenu, TRUE);
397 panes = selidx = 0;
398
399 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
400 startx, starty, ButtonReleaseMask, &datap);
401 switch (status)
402 {
403 case XM_SUCCESS:
404#ifdef XDEBUG
405 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
406#endif
407 entry = item_list[panes][selidx];
408 break;
409 case XM_FAILURE:
088831f6 410 /* free (datap_save); */
dcfdbac7
JB
411 XMenuDestroy (XDISPLAY GXMenu);
412 *error = "Can't activate menu";
413 /* error ("Can't activate menu"); */
414 case XM_IA_SELECT:
415 case XM_NO_SELECT:
416 entry = Qnil;
417 break;
418 }
419 XMenuDestroy (XDISPLAY GXMenu);
10c48c95 420 UNBLOCK_INPUT;
088831f6 421 /* free (datap_save);*/
dcfdbac7
JB
422 return (entry);
423}
424
425syms_of_xmenu ()
426{
427 defsubr (&Sx_popup_menu);
428}
088831f6
RS
429\f
430/* Construct the vectors that describe a menu
aedaff8d 431 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
432 Each of those four values is a vector indexed by pane number.
433 Return the number of panes.
434
435 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */
436
437int
aedaff8d 438keymap_panes (vector, panes, names, enables, items, keymaps, nmaps)
088831f6
RS
439 Lisp_Object ***vector; /* RETURN all menu objects */
440 char ***panes; /* RETURN pane names */
441 char ****names; /* RETURN all line names */
aedaff8d 442 int ***enables; /* RETURN enable-flags of lines */
088831f6
RS
443 int **items; /* RETURN number of items per pane */
444 Lisp_Object *keymaps;
445 int nmaps;
446{
447 /* Number of panes we have made. */
448 int p = 0;
449 /* Number of panes we have space for. */
450 int npanes_allocated = nmaps;
451 int mapno;
452
453 if (npanes_allocated < 4)
454 npanes_allocated = 4;
455
456 /* Make space for an estimated number of panes. */
457 *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
458 *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
459 *items = (int *) xmalloc (npanes_allocated * sizeof (int));
460 *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
aedaff8d 461 *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
088831f6
RS
462
463 /* Loop over the given keymaps, making a pane for each map.
464 But don't make a pane that is empty--ignore that map instead.
465 P is the number of panes we have made so far. */
466 for (mapno = 0; mapno < nmaps; mapno++)
aedaff8d 467 single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
088831f6
RS
468 &p, &npanes_allocated, "");
469
470 /* Return the number of panes. */
471 return p;
472}
473
474/* This is a recursive subroutine of the previous function.
475 It handles one keymap, KEYMAP.
476 The other arguments are passed along
477 or point to local variables of the previous function. */
478
aedaff8d 479single_keymap_panes (keymap, panes, vector, names, enables, items,
088831f6
RS
480 p_ptr, npanes_allocated_ptr, pane_name)
481 Lisp_Object keymap;
482 Lisp_Object ***vector; /* RETURN all menu objects */
483 char ***panes; /* RETURN pane names */
484 char ****names; /* RETURN all line names */
aedaff8d 485 int ***enables; /* RETURN enable flags of lines */
088831f6
RS
486 int **items; /* RETURN number of items per pane */
487 int *p_ptr;
488 int *npanes_allocated_ptr;
489 char *pane_name;
490{
491 int i;
492 Lisp_Object pending_maps;
493 Lisp_Object tail, item, item1, item2, table;
494
495 pending_maps = Qnil;
496
497 /* Make sure we have room for another pane. */
498 if (*p_ptr == *npanes_allocated_ptr)
499 {
500 *npanes_allocated_ptr *= 2;
501
502 *vector
503 = (Lisp_Object **) xrealloc (*vector,
504 *npanes_allocated_ptr * sizeof (Lisp_Object *));
505 *panes
506 = (char **) xrealloc (*panes,
507 *npanes_allocated_ptr * sizeof (char *));
508 *items
509 = (int *) xrealloc (*items,
510 *npanes_allocated_ptr * sizeof (int));
511 *names
512 = (char ***) xrealloc (*names,
513 *npanes_allocated_ptr * sizeof (char **));
aedaff8d
RS
514 *enables
515 = (int **) xrealloc (*enables,
516 *npanes_allocated_ptr * sizeof (int *));
088831f6
RS
517 }
518
519 /* When a menu comes from keymaps, don't give names to the panes. */
520 (*panes)[*p_ptr] = pane_name;
521
522 /* Get the length of the list level of the keymap. */
523 i = XFASTINT (Flength (keymap));
524
ab6ee1a0
RS
525 /* Add in lengths of any arrays. */
526 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
527 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
528 i += XVECTOR (XCONS (tail)->car)->size;
088831f6
RS
529
530 /* Create vectors for the names and values of the items in the pane.
531 I is an upper bound for the number of items. */
532 (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
533 (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
aedaff8d 534 (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
088831f6
RS
535
536 /* I is now the index of the next unused slots. */
537 i = 0;
538 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
539 {
540 /* Look at each key binding, and if it has a menu string,
541 make a menu item from it. */
542 item = XCONS (tail)->car;
543 if (XTYPE (item) == Lisp_Cons)
544 {
545 item1 = XCONS (item)->cdr;
546 if (XTYPE (item1) == Lisp_Cons)
547 {
548 item2 = XCONS (item1)->car;
549 if (XTYPE (item2) == Lisp_String)
550 {
d9dcaf49
RS
551 Lisp_Object def, tem;
552 Lisp_Object enabled;
553
554 def = Fcdr (item1);
555 enabled = Qt;
556 if (XTYPE (def) == Lisp_Symbol)
557 {
558 /* No property, or nil, means enable.
559 Otherwise, enable if value is not nil. */
560 tem = Fget (def, Qmenu_enable);
561 if (!NILP (tem))
562 enabled = Feval (tem);
563 }
564 tem = Fkeymapp (def);
088831f6 565 if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
d9dcaf49 566 pending_maps = Fcons (Fcons (def, item2),
088831f6 567 pending_maps);
aedaff8d 568 else
088831f6
RS
569 {
570 (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
571 /* The menu item "value" is the key bound here. */
572 (*vector)[*p_ptr][i] = XCONS (item)->car;
aedaff8d 573 (*enables)[*p_ptr][i]
24af387f 574 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
088831f6
RS
575 i++;
576 }
577 }
578 }
579 }
ab6ee1a0
RS
580 else if (XTYPE (item) == Lisp_Vector)
581 {
582 /* Loop over the char values represented in the vector. */
583 int len = XVECTOR (item)->size;
584 int c;
585 for (c = 0; c < len; c++)
586 {
587 Lisp_Object character;
588 XFASTINT (character) = c;
589 item1 = XVECTOR (item)->contents[c];
590 if (XTYPE (item1) == Lisp_Cons)
591 {
592 item2 = XCONS (item1)->car;
593 if (XTYPE (item2) == Lisp_String)
594 {
595 Lisp_Object tem;
d9dcaf49
RS
596 Lisp_Object def;
597 Lisp_Object enabled;
598
599 def = Fcdr (item1);
600 enabled = Qt;
601 if (XTYPE (def) == Lisp_Symbol)
602 {
603 tem = Fget (def, Qmenu_enable);
604 /* No property, or nil, means enable.
605 Otherwise, enable if value is not nil. */
606 if (!NILP (tem))
607 enabled = Feval (tem);
608 }
609
610 tem = Fkeymapp (def);
ab6ee1a0 611 if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
d9dcaf49 612 pending_maps = Fcons (Fcons (def, item2),
ab6ee1a0 613 pending_maps);
aedaff8d 614 else
ab6ee1a0
RS
615 {
616 (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
617 /* The menu item "value" is the key bound here. */
618 (*vector)[*p_ptr][i] = character;
aedaff8d 619 (*enables)[*p_ptr][i]
24af387f 620 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
ab6ee1a0
RS
621 i++;
622 }
623 }
624 }
625 }
626 }
088831f6
RS
627 }
628 /* Record the number of items in the pane. */
629 (*items)[*p_ptr] = i;
630
631 /* If we just made an empty pane, get rid of it. */
632 if (i == 0)
633 {
9ac0d9e0
JB
634 xfree ((*vector)[*p_ptr]);
635 xfree ((*names)[*p_ptr]);
636 xfree ((*enables)[*p_ptr]);
088831f6
RS
637 }
638 /* Otherwise, advance past it. */
639 else
640 (*p_ptr)++;
641
642 /* Process now any submenus which want to be panes at this level. */
643 while (!NILP (pending_maps))
644 {
645 Lisp_Object elt;
646 elt = Fcar (pending_maps);
aedaff8d 647 single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
088831f6
RS
648 p_ptr, npanes_allocated_ptr,
649 /* Add 1 to discard the @. */
650 (char *) XSTRING (XCONS (elt)->cdr)->data + 1);
651 pending_maps = Fcdr (pending_maps);
652 }
653}
654\f
655/* Construct the vectors that describe a menu
aedaff8d 656 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
657 Each of those four values is a vector indexed by pane number.
658 Return the number of panes.
659
660 MENU is the argument that was given to Fx_popup_menu. */
dcfdbac7 661
088831f6 662int
aedaff8d 663list_of_panes (vector, panes, names, enables, items, menu)
dcfdbac7
JB
664 Lisp_Object ***vector; /* RETURN all menu objects */
665 char ***panes; /* RETURN pane names */
666 char ****names; /* RETURN all line names */
aedaff8d 667 int ***enables; /* RETURN enable flags of lines */
dcfdbac7
JB
668 int **items; /* RETURN number of items per pane */
669 Lisp_Object menu;
670{
671 Lisp_Object tail, item, item1;
672 int i;
673
674 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
675
088831f6 676 i = XFASTINT (Flength (menu));
dcfdbac7
JB
677
678 *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
679 *panes = (char **) xmalloc (i * sizeof (char *));
680 *items = (int *) xmalloc (i * sizeof (int));
681 *names = (char ***) xmalloc (i * sizeof (char **));
aedaff8d 682 *enables = (int **) xmalloc (i * sizeof (int *));
dcfdbac7 683
088831f6 684 for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 685 {
088831f6
RS
686 item = Fcdr (Fcar (tail));
687 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
dcfdbac7 688#ifdef XDEBUG
088831f6 689 fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
dcfdbac7 690#endif
088831f6
RS
691 item1 = Fcar (Fcar (tail));
692 CHECK_STRING (item1, 1);
dcfdbac7 693#ifdef XDEBUG
088831f6
RS
694 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
695 XSTRING (item1)->data);
dcfdbac7 696#endif
088831f6 697 (*panes)[i] = (char *) XSTRING (item1)->data;
aedaff8d 698 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
088831f6
RS
699 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
700 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
701 ; */
dcfdbac7
JB
702 }
703 return i;
704}
088831f6
RS
705\f
706/* Construct the lists of values and names for a single pane, from the
aedaff8d
RS
707 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags
708 int *ENABLES. Return the number of items. */
dcfdbac7 709
088831f6 710int
aedaff8d 711list_of_items (vector, names, enables, pane)
dcfdbac7
JB
712 Lisp_Object **vector; /* RETURN menu "objects" */
713 char ***names; /* RETURN line names */
aedaff8d 714 int **enables; /* RETURN enable flags of lines */
dcfdbac7
JB
715 Lisp_Object pane;
716{
717 Lisp_Object tail, item, item1;
718 int i;
719
720 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
721
f1b28218 722 i = XFASTINT (Flength (pane));
dcfdbac7
JB
723
724 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
725 *names = (char **) xmalloc (i * sizeof (char *));
aedaff8d 726 *enables = (int *) xmalloc (i * sizeof (int));
dcfdbac7 727
088831f6 728 for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 729 {
088831f6 730 item = Fcar (tail);
24af387f
RS
731 if (STRINGP (item))
732 {
733 (*vector)[i] = Qnil;
734 (*names)[i] = (char *) XSTRING (item)->data;
735 (*enables)[i] = -1;
736 }
737 else
738 {
739 CHECK_CONS (item, 0);
740 (*vector)[i] = Fcdr (item);
741 item1 = Fcar (item);
742 CHECK_STRING (item1, 1);
743 (*names)[i] = (char *) XSTRING (item1)->data;
744 (*enables)[i] = 1;
745 }
dcfdbac7
JB
746 }
747 return i;
748}