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