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