Commit | Line | Data |
---|---|---|
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 | |
4 | This file is part of GNU Emacs. | |
5 | ||
6 | GNU Emacs is free software; you can redistribute it and/or modify | |
7 | it under the terms of the GNU General Public License as published by | |
774910eb | 8 | the Free Software Foundation; either version 2, or (at your option) |
dcfdbac7 JB |
9 | any later version. |
10 | ||
11 | GNU Emacs is distributed in the hope that it will be useful, | |
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | GNU General Public License for more details. | |
15 | ||
16 | You should have received a copy of the GNU General Public License | |
17 | along with GNU Emacs; see the file COPYING. If not, write to | |
18 | the 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 | |
69 | extern Display *x_current_display; | |
70 | #else | |
71 | #define ButtonReleaseMask ButtonReleased | |
72 | #endif /* not HAVE_X11 */ | |
73 | ||
6904bdcd | 74 | extern Lisp_Object Qmenu_enable; |
dcfdbac7 JB |
75 | Lisp_Object xmenu_show (); |
76 | extern int x_error_handler (); | |
77 | ||
78 | /*************************************************************/ | |
79 | ||
80 | #if 0 | |
81 | /* Ignoring the args is easiest. */ | |
82 | xmenu_quit () | |
83 | { | |
84 | error ("Unknown XMenu error"); | |
85 | } | |
86 | #endif | |
87 | ||
88 | DEFUN ("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 |
90 | POSITION is a position specification. This is either a mouse button event\n\ |
91 | or a list ((XOFFSET YOFFSET) WINDOW)\n\ | |
dcfdbac7 | 92 | where XOFFSET and YOFFSET are positions in characters from the top left\n\ |
7da99777 | 93 | corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ |
dcfdbac7 JB |
94 | This controls the position of the center of the first line\n\ |
95 | in the first pane of the menu, not the top left of the menu as a whole.\n\ | |
96 | \n\ | |
088831f6 RS |
97 | MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ |
98 | The menu items come from key bindings that have a menu string as well as\n\ | |
99 | a 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\ | |
101 | the keymap as a top-level element.\n\n\ | |
102 | You can also use a list of keymaps as MENU.\n\ | |
819012f0 RS |
103 | Then each keymap makes a separate pane.\n\ |
104 | When MENU is a keymap or a list of keymaps, the return value\n\ | |
105 | is a list of events.\n\n\ | |
088831f6 | 106 | Alternatively, you can specify a menu of multiple panes\n\ |
24af387f RS |
107 | with a list of the form (TITLE PANE1 PANE2...),\n\ |
108 | where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ | |
109 | Each ITEM is normally a cons cell (STRING . VALUE);\n\ | |
110 | but a string can appear as an item--that makes a nonselectable line\n\ | |
819012f0 RS |
111 | in the menu.\n\ |
112 | With 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 | ||
331 | struct indices { | |
332 | int pane; | |
333 | int line; | |
334 | }; | |
335 | ||
336 | Lisp_Object | |
aedaff8d | 337 | xmenu_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 | ||
470 | syms_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 | ||
482 | int | |
819012f0 | 483 | keymap_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 | 526 | single_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 | 721 | int |
aedaff8d | 722 | list_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 | 769 | int |
aedaff8d | 770 | list_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 | } |