(server-process-filter): Use server-switch-buffer.
[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
RS
194 number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
195 &items, &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
RS
331
332 if (pane_cnt == 0)
333 return 0;
334
10c48c95 335 BLOCK_INPUT;
dcfdbac7
JB
336 *error = (char *) 0; /* Initialize error pointer to null */
337 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
338 if (GXMenu == NUL)
339 {
340 *error = "Can't create menu";
10c48c95 341 UNBLOCK_INPUT;
dcfdbac7
JB
342 return (0);
343 }
344
088831f6
RS
345 for (panes = 0, lines = 0; panes < pane_cnt;
346 lines += line_cnt[panes], panes++)
dcfdbac7
JB
347 ;
348 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
088831f6 349 /* datap = (char *) xmalloc (lines * sizeof (char));
dcfdbac7
JB
350 datap_save = datap;*/
351
088831f6
RS
352 for (panes = 0, sofar = 0; panes < pane_cnt;
353 sofar += line_cnt[panes], panes++)
dcfdbac7
JB
354 {
355 /* create all the necessary panes */
356 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
357 if (lpane == XM_FAILURE)
358 {
359 XMenuDestroy (XDISPLAY GXMenu);
360 *error = "Can't create pane";
10c48c95 361 UNBLOCK_INPUT;
dcfdbac7
JB
362 return (0);
363 }
088831f6 364 for (selidx = 0; selidx < line_cnt[panes]; selidx++)
dcfdbac7
JB
365 {
366 /* add the selection stuff to the menus */
367 /* datap[selidx+sofar].pane = panes;
368 datap[selidx+sofar].line = selidx; */
369 if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
aedaff8d
RS
370 line_list[panes][selidx],
371 enable_list[panes][selidx])
dcfdbac7
JB
372 == XM_FAILURE)
373 {
374 XMenuDestroy (XDISPLAY GXMenu);
375 /* free (datap); */
376 *error = "Can't add selection to menu";
377 /* error ("Can't add selection to menu"); */
10c48c95 378 UNBLOCK_INPUT;
dcfdbac7
JB
379 return (0);
380 }
381 }
382 }
383 /* all set and ready to fly */
384 XMenuRecompute (XDISPLAY GXMenu);
385 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
386 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
387 startx = min (startx, dispwidth);
388 starty = min (starty, dispheight);
389 startx = max (startx, 1);
390 starty = max (starty, 1);
391 XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
392 &ulx, &uly, &width, &height);
393 if (ulx+width > dispwidth)
394 {
395 startx -= (ulx + width) - dispwidth;
396 ulx = dispwidth - width;
397 }
398 if (uly+height > dispheight)
399 {
400 starty -= (uly + height) - dispheight;
401 uly = dispheight - height;
402 }
403 if (ulx < 0) startx -= ulx;
404 if (uly < 0) starty -= uly;
405
406 XMenuSetFreeze (GXMenu, TRUE);
407 panes = selidx = 0;
408
409 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
410 startx, starty, ButtonReleaseMask, &datap);
411 switch (status)
412 {
413 case XM_SUCCESS:
414#ifdef XDEBUG
415 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
416#endif
417 entry = item_list[panes][selidx];
819012f0
RS
418 if (prefixes != 0)
419 {
420 entry = Fcons (entry, Qnil);
421 if (!NILP (prefixes[panes]))
422 entry = Fcons (prefixes[panes], entry);
423 }
dcfdbac7
JB
424 break;
425 case XM_FAILURE:
088831f6 426 /* free (datap_save); */
dcfdbac7
JB
427 XMenuDestroy (XDISPLAY GXMenu);
428 *error = "Can't activate menu";
429 /* error ("Can't activate menu"); */
430 case XM_IA_SELECT:
431 case XM_NO_SELECT:
432 entry = Qnil;
433 break;
434 }
435 XMenuDestroy (XDISPLAY GXMenu);
10c48c95 436 UNBLOCK_INPUT;
088831f6 437 /* free (datap_save);*/
dcfdbac7
JB
438 return (entry);
439}
440
441syms_of_xmenu ()
442{
443 defsubr (&Sx_popup_menu);
444}
088831f6
RS
445\f
446/* Construct the vectors that describe a menu
aedaff8d 447 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
448 Each of those four values is a vector indexed by pane number.
449 Return the number of panes.
450
451 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */
452
453int
819012f0 454keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
088831f6
RS
455 Lisp_Object ***vector; /* RETURN all menu objects */
456 char ***panes; /* RETURN pane names */
457 char ****names; /* RETURN all line names */
aedaff8d 458 int ***enables; /* RETURN enable-flags of lines */
088831f6 459 int **items; /* RETURN number of items per pane */
819012f0 460 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
088831f6
RS
461 Lisp_Object *keymaps;
462 int nmaps;
463{
464 /* Number of panes we have made. */
465 int p = 0;
466 /* Number of panes we have space for. */
467 int npanes_allocated = nmaps;
468 int mapno;
469
470 if (npanes_allocated < 4)
471 npanes_allocated = 4;
472
473 /* Make space for an estimated number of panes. */
474 *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
475 *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
476 *items = (int *) xmalloc (npanes_allocated * sizeof (int));
477 *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
aedaff8d 478 *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
819012f0 479 *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
088831f6
RS
480
481 /* Loop over the given keymaps, making a pane for each map.
482 But don't make a pane that is empty--ignore that map instead.
483 P is the number of panes we have made so far. */
484 for (mapno = 0; mapno < nmaps; mapno++)
aedaff8d 485 single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
819012f0 486 prefixes, &p, &npanes_allocated, "");
088831f6
RS
487
488 /* Return the number of panes. */
489 return p;
490}
491
492/* This is a recursive subroutine of the previous function.
493 It handles one keymap, KEYMAP.
494 The other arguments are passed along
495 or point to local variables of the previous function. */
496
819012f0 497single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
088831f6
RS
498 p_ptr, npanes_allocated_ptr, pane_name)
499 Lisp_Object keymap;
500 Lisp_Object ***vector; /* RETURN all menu objects */
501 char ***panes; /* RETURN pane names */
502 char ****names; /* RETURN all line names */
aedaff8d 503 int ***enables; /* RETURN enable flags of lines */
088831f6 504 int **items; /* RETURN number of items per pane */
819012f0 505 Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */
088831f6
RS
506 int *p_ptr;
507 int *npanes_allocated_ptr;
508 char *pane_name;
509{
510 int i;
511 Lisp_Object pending_maps;
512 Lisp_Object tail, item, item1, item2, table;
513
514 pending_maps = Qnil;
515
516 /* Make sure we have room for another pane. */
517 if (*p_ptr == *npanes_allocated_ptr)
518 {
519 *npanes_allocated_ptr *= 2;
520
521 *vector
522 = (Lisp_Object **) xrealloc (*vector,
523 *npanes_allocated_ptr * sizeof (Lisp_Object *));
524 *panes
525 = (char **) xrealloc (*panes,
526 *npanes_allocated_ptr * sizeof (char *));
527 *items
528 = (int *) xrealloc (*items,
529 *npanes_allocated_ptr * sizeof (int));
819012f0
RS
530 *prefixes
531 = (Lisp_Object *) xrealloc (*prefixes,
532 (*npanes_allocated_ptr
533 * sizeof (Lisp_Object)));
088831f6
RS
534 *names
535 = (char ***) xrealloc (*names,
536 *npanes_allocated_ptr * sizeof (char **));
aedaff8d
RS
537 *enables
538 = (int **) xrealloc (*enables,
539 *npanes_allocated_ptr * sizeof (int *));
088831f6
RS
540 }
541
542 /* When a menu comes from keymaps, don't give names to the panes. */
543 (*panes)[*p_ptr] = pane_name;
544
819012f0
RS
545 /* Normally put nil as pane's prefix key.
546 Caller will override this if appropriate. */
547 (*prefixes)[*p_ptr] = Qnil;
548
088831f6
RS
549 /* Get the length of the list level of the keymap. */
550 i = XFASTINT (Flength (keymap));
551
ab6ee1a0
RS
552 /* Add in lengths of any arrays. */
553 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
554 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
555 i += XVECTOR (XCONS (tail)->car)->size;
088831f6
RS
556
557 /* Create vectors for the names and values of the items in the pane.
558 I is an upper bound for the number of items. */
559 (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
560 (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
aedaff8d 561 (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
088831f6
RS
562
563 /* I is now the index of the next unused slots. */
564 i = 0;
565 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
566 {
567 /* Look at each key binding, and if it has a menu string,
568 make a menu item from it. */
569 item = XCONS (tail)->car;
570 if (XTYPE (item) == Lisp_Cons)
571 {
572 item1 = XCONS (item)->cdr;
573 if (XTYPE (item1) == Lisp_Cons)
574 {
575 item2 = XCONS (item1)->car;
576 if (XTYPE (item2) == Lisp_String)
577 {
d9dcaf49
RS
578 Lisp_Object def, tem;
579 Lisp_Object enabled;
580
581 def = Fcdr (item1);
582 enabled = Qt;
583 if (XTYPE (def) == Lisp_Symbol)
584 {
585 /* No property, or nil, means enable.
586 Otherwise, enable if value is not nil. */
587 tem = Fget (def, Qmenu_enable);
588 if (!NILP (tem))
589 enabled = Feval (tem);
590 }
591 tem = Fkeymapp (def);
088831f6 592 if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
819012f0 593 pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)),
088831f6 594 pending_maps);
aedaff8d 595 else
088831f6
RS
596 {
597 (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
598 /* The menu item "value" is the key bound here. */
599 (*vector)[*p_ptr][i] = XCONS (item)->car;
aedaff8d 600 (*enables)[*p_ptr][i]
24af387f 601 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
088831f6
RS
602 i++;
603 }
604 }
605 }
606 }
ab6ee1a0
RS
607 else if (XTYPE (item) == Lisp_Vector)
608 {
609 /* Loop over the char values represented in the vector. */
610 int len = XVECTOR (item)->size;
611 int c;
612 for (c = 0; c < len; c++)
613 {
614 Lisp_Object character;
615 XFASTINT (character) = c;
616 item1 = XVECTOR (item)->contents[c];
617 if (XTYPE (item1) == Lisp_Cons)
618 {
619 item2 = XCONS (item1)->car;
620 if (XTYPE (item2) == Lisp_String)
621 {
622 Lisp_Object tem;
d9dcaf49
RS
623 Lisp_Object def;
624 Lisp_Object enabled;
625
626 def = Fcdr (item1);
627 enabled = Qt;
628 if (XTYPE (def) == Lisp_Symbol)
629 {
630 tem = Fget (def, Qmenu_enable);
631 /* No property, or nil, means enable.
632 Otherwise, enable if value is not nil. */
633 if (!NILP (tem))
634 enabled = Feval (tem);
635 }
636
637 tem = Fkeymapp (def);
ab6ee1a0 638 if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
819012f0 639 pending_maps = Fcons (Fcons (def, Fcons (item2, character)),
ab6ee1a0 640 pending_maps);
aedaff8d 641 else
ab6ee1a0
RS
642 {
643 (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
644 /* The menu item "value" is the key bound here. */
645 (*vector)[*p_ptr][i] = character;
aedaff8d 646 (*enables)[*p_ptr][i]
24af387f 647 = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
ab6ee1a0
RS
648 i++;
649 }
650 }
651 }
652 }
653 }
088831f6
RS
654 }
655 /* Record the number of items in the pane. */
656 (*items)[*p_ptr] = i;
657
658 /* If we just made an empty pane, get rid of it. */
659 if (i == 0)
660 {
9ac0d9e0
JB
661 xfree ((*vector)[*p_ptr]);
662 xfree ((*names)[*p_ptr]);
663 xfree ((*enables)[*p_ptr]);
088831f6
RS
664 }
665 /* Otherwise, advance past it. */
666 else
667 (*p_ptr)++;
668
669 /* Process now any submenus which want to be panes at this level. */
670 while (!NILP (pending_maps))
671 {
819012f0
RS
672 Lisp_Object elt, eltcdr;
673 int panenum = *p_ptr;
088831f6 674 elt = Fcar (pending_maps);
819012f0 675 eltcdr = XCONS (elt)->cdr;
aedaff8d 676 single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
819012f0 677 prefixes, p_ptr, npanes_allocated_ptr,
088831f6 678 /* Add 1 to discard the @. */
819012f0
RS
679 (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
680 (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
088831f6
RS
681 pending_maps = Fcdr (pending_maps);
682 }
683}
684\f
685/* Construct the vectors that describe a menu
aedaff8d 686 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
088831f6
RS
687 Each of those four values is a vector indexed by pane number.
688 Return the number of panes.
689
690 MENU is the argument that was given to Fx_popup_menu. */
dcfdbac7 691
088831f6 692int
aedaff8d 693list_of_panes (vector, panes, names, enables, items, menu)
dcfdbac7
JB
694 Lisp_Object ***vector; /* RETURN all menu objects */
695 char ***panes; /* RETURN pane names */
696 char ****names; /* RETURN all line names */
aedaff8d 697 int ***enables; /* RETURN enable flags of lines */
dcfdbac7
JB
698 int **items; /* RETURN number of items per pane */
699 Lisp_Object menu;
700{
701 Lisp_Object tail, item, item1;
702 int i;
703
704 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
705
088831f6 706 i = XFASTINT (Flength (menu));
dcfdbac7
JB
707
708 *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
709 *panes = (char **) xmalloc (i * sizeof (char *));
710 *items = (int *) xmalloc (i * sizeof (int));
711 *names = (char ***) xmalloc (i * sizeof (char **));
aedaff8d 712 *enables = (int **) xmalloc (i * sizeof (int *));
dcfdbac7 713
088831f6 714 for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 715 {
088831f6
RS
716 item = Fcdr (Fcar (tail));
717 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
dcfdbac7 718#ifdef XDEBUG
088831f6 719 fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
dcfdbac7 720#endif
088831f6
RS
721 item1 = Fcar (Fcar (tail));
722 CHECK_STRING (item1, 1);
dcfdbac7 723#ifdef XDEBUG
088831f6
RS
724 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
725 XSTRING (item1)->data);
dcfdbac7 726#endif
088831f6 727 (*panes)[i] = (char *) XSTRING (item1)->data;
aedaff8d 728 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
088831f6
RS
729 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
730 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
731 ; */
dcfdbac7
JB
732 }
733 return i;
734}
088831f6
RS
735\f
736/* Construct the lists of values and names for a single pane, from the
aedaff8d
RS
737 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags
738 int *ENABLES. Return the number of items. */
dcfdbac7 739
088831f6 740int
aedaff8d 741list_of_items (vector, names, enables, pane)
dcfdbac7
JB
742 Lisp_Object **vector; /* RETURN menu "objects" */
743 char ***names; /* RETURN line names */
aedaff8d 744 int **enables; /* RETURN enable flags of lines */
dcfdbac7
JB
745 Lisp_Object pane;
746{
747 Lisp_Object tail, item, item1;
748 int i;
749
750 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
751
f1b28218 752 i = XFASTINT (Flength (pane));
dcfdbac7
JB
753
754 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
755 *names = (char **) xmalloc (i * sizeof (char *));
aedaff8d 756 *enables = (int *) xmalloc (i * sizeof (int));
dcfdbac7 757
088831f6 758 for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
dcfdbac7 759 {
088831f6 760 item = Fcar (tail);
24af387f
RS
761 if (STRINGP (item))
762 {
763 (*vector)[i] = Qnil;
764 (*names)[i] = (char *) XSTRING (item)->data;
765 (*enables)[i] = -1;
766 }
767 else
768 {
769 CHECK_CONS (item, 0);
770 (*vector)[i] = Fcdr (item);
771 item1 = Fcar (item);
772 CHECK_STRING (item1, 1);
773 (*names)[i] = (char *) XSTRING (item1)->data;
774 (*enables)[i] = 1;
775 }
dcfdbac7
JB
776 }
777 return i;
778}