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 | ||
18686d47 RS |
27 | /* Modified by Fred Pierresteguy on December 93 |
28 | to make the popup menus and menubar use the Xt. */ | |
29 | ||
dcfdbac7 | 30 | #include <stdio.h> |
dcfdbac7 JB |
31 | |
32 | /* On 4.3 this loses if it comes after xterm.h. */ | |
33 | #include <signal.h> | |
18160b98 | 34 | #include <config.h> |
dcfdbac7 | 35 | #include "lisp.h" |
18686d47 | 36 | #include "termhooks.h" |
7708e9bd | 37 | #include "frame.h" |
dcfdbac7 | 38 | #include "window.h" |
031b0e31 | 39 | #include "keyboard.h" |
9ac0d9e0 | 40 | #include "blockinput.h" |
dcfdbac7 JB |
41 | |
42 | /* This may include sys/types.h, and that somehow loses | |
43 | if this is not done before the other system files. */ | |
44 | #include "xterm.h" | |
45 | ||
46 | /* Load sys/types.h if not already loaded. | |
47 | In some systems loading it twice is suicidal. */ | |
48 | #ifndef makedev | |
49 | #include <sys/types.h> | |
50 | #endif | |
51 | ||
52 | #include "dispextern.h" | |
53 | ||
54 | #ifdef HAVE_X11 | |
55 | #include "../oldXMenu/XMenu.h" | |
56 | #else | |
57 | #include <X/XMenu.h> | |
58 | #endif | |
59 | ||
18686d47 RS |
60 | #ifdef USE_X_TOOLKIT |
61 | #include <X11/Xlib.h> | |
62 | #include <X11/IntrinsicP.h> | |
63 | #include <X11/CoreP.h> | |
64 | #include <X11/StringDefs.h> | |
65 | #include <X11/Xaw/Paned.h> | |
66 | #include "../lwlib/lwlib.h" | |
67 | #include "../lwlib/xlwmenuP.h" | |
68 | #endif /* USE_X_TOOLKIT */ | |
69 | ||
dcfdbac7 JB |
70 | #define min(x,y) (((x) < (y)) ? (x) : (y)) |
71 | #define max(x,y) (((x) > (y)) ? (x) : (y)) | |
72 | ||
73 | #define NUL 0 | |
74 | ||
75 | #ifndef TRUE | |
76 | #define TRUE 1 | |
77 | #define FALSE 0 | |
d065dd2e | 78 | #endif /* TRUE */ |
dcfdbac7 JB |
79 | |
80 | #ifdef HAVE_X11 | |
81 | extern Display *x_current_display; | |
82 | #else | |
83 | #define ButtonReleaseMask ButtonReleased | |
84 | #endif /* not HAVE_X11 */ | |
85 | ||
6904bdcd | 86 | extern Lisp_Object Qmenu_enable; |
18686d47 | 87 | extern Lisp_Object Qmenu_bar; |
dcfdbac7 JB |
88 | Lisp_Object xmenu_show (); |
89 | extern int x_error_handler (); | |
18686d47 RS |
90 | #ifdef USE_X_TOOLKIT |
91 | static widget_value *set_menu_items (); | |
92 | static int string_width (); | |
93 | static void free_menu_items (); | |
94 | #endif | |
95 | ||
96 | /* we need a unique id for each popup menu and dialog box */ | |
97 | unsigned int popup_id_tick; | |
dcfdbac7 JB |
98 | |
99 | /*************************************************************/ | |
100 | ||
101 | #if 0 | |
102 | /* Ignoring the args is easiest. */ | |
103 | xmenu_quit () | |
104 | { | |
105 | error ("Unknown XMenu error"); | |
106 | } | |
107 | #endif | |
108 | ||
18686d47 | 109 | \f |
dcfdbac7 JB |
110 | DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0, |
111 | "Pop up a deck-of-cards menu and return user's selection.\n\ | |
088831f6 RS |
112 | POSITION is a position specification. This is either a mouse button event\n\ |
113 | or a list ((XOFFSET YOFFSET) WINDOW)\n\ | |
dcfdbac7 | 114 | where XOFFSET and YOFFSET are positions in characters from the top left\n\ |
7da99777 | 115 | corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ |
dcfdbac7 JB |
116 | This controls the position of the center of the first line\n\ |
117 | in the first pane of the menu, not the top left of the menu as a whole.\n\ | |
118 | \n\ | |
088831f6 RS |
119 | MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ |
120 | The menu items come from key bindings that have a menu string as well as\n\ | |
121 | a definition; actually, the \"definition\" in such a key binding looks like\n\ | |
122 | \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ | |
123 | the keymap as a top-level element.\n\n\ | |
124 | You can also use a list of keymaps as MENU.\n\ | |
819012f0 RS |
125 | Then each keymap makes a separate pane.\n\ |
126 | When MENU is a keymap or a list of keymaps, the return value\n\ | |
127 | is a list of events.\n\n\ | |
088831f6 | 128 | Alternatively, you can specify a menu of multiple panes\n\ |
24af387f RS |
129 | with a list of the form (TITLE PANE1 PANE2...),\n\ |
130 | where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ | |
131 | Each ITEM is normally a cons cell (STRING . VALUE);\n\ | |
132 | but a string can appear as an item--that makes a nonselectable line\n\ | |
819012f0 RS |
133 | in the menu.\n\ |
134 | With this form of menu, the return value is VALUE from the chosen item.") | |
088831f6 RS |
135 | (position, menu) |
136 | Lisp_Object position, menu; | |
dcfdbac7 | 137 | { |
18686d47 | 138 | int number_of_panes, panes; |
088831f6 | 139 | Lisp_Object XMenu_return, keymap, tem; |
dcfdbac7 JB |
140 | int XMenu_xpos, XMenu_ypos; |
141 | char **menus; | |
142 | char ***names; | |
aedaff8d | 143 | int **enables; |
dcfdbac7 | 144 | Lisp_Object **obj_list; |
819012f0 | 145 | Lisp_Object *prefixes; |
dcfdbac7 JB |
146 | int *items; |
147 | char *title; | |
148 | char *error_name; | |
149 | Lisp_Object ltitle, selection; | |
18686d47 | 150 | int i, j, menubarp = 0; |
7708e9bd | 151 | FRAME_PTR f; |
dcfdbac7 | 152 | Lisp_Object x, y, window; |
18686d47 RS |
153 | #ifdef USE_X_TOOLKIT |
154 | widget_value *val, *vw = 0; | |
155 | #endif /* USE_X_TOOLKIT */ | |
dcfdbac7 | 156 | |
088831f6 RS |
157 | /* Decode the first argument: find the window and the coordinates. */ |
158 | tem = Fcar (position); | |
159 | if (XTYPE (tem) == Lisp_Cons) | |
160 | { | |
161 | window = Fcar (Fcdr (position)); | |
162 | x = Fcar (tem); | |
163 | y = Fcar (Fcdr (tem)); | |
164 | } | |
165 | else | |
166 | { | |
933ff472 RS |
167 | tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ |
168 | window = Fcar (tem); /* POSN_WINDOW (tem) */ | |
169 | tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ | |
088831f6 RS |
170 | x = Fcar (tem); |
171 | y = Fcdr (tem); | |
172 | } | |
dcfdbac7 JB |
173 | CHECK_NUMBER (x, 0); |
174 | CHECK_NUMBER (y, 0); | |
088831f6 | 175 | |
7da99777 RS |
176 | if (XTYPE (window) == Lisp_Frame) |
177 | { | |
178 | f = XFRAME (window); | |
18686d47 | 179 | |
7da99777 RS |
180 | XMenu_xpos = 0; |
181 | XMenu_ypos = 0; | |
182 | } | |
183 | else if (XTYPE (window) == Lisp_Window) | |
184 | { | |
185 | CHECK_LIVE_WINDOW (window, 0); | |
186 | f = XFRAME (WINDOW_FRAME (XWINDOW (window))); | |
18686d47 RS |
187 | |
188 | XMenu_xpos = FONT_WIDTH (f->display.x->font) | |
189 | * XWINDOW (window)->left; | |
190 | XMenu_ypos = FONT_HEIGHT (f->display.x->font) | |
191 | * XWINDOW (window)->top; | |
7da99777 | 192 | } |
378f8939 RS |
193 | else |
194 | /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, | |
195 | but I don't want to make one now. */ | |
196 | CHECK_WINDOW (window, 0); | |
7da99777 | 197 | |
18686d47 RS |
198 | #ifdef USE_X_TOOLKIT |
199 | tem = Fcar (Fcdr (Fcar (Fcdr (position)))); | |
200 | if (XTYPE (Fcar (position)) != Lisp_Cons | |
201 | && CONSP (tem) | |
202 | && EQ (Fcar (tem), Qmenu_bar)) | |
203 | { | |
204 | /* We are in the menubar */ | |
205 | XlwMenuWidget mw; | |
206 | int w1 = 0, w2; | |
207 | ||
208 | mw = (XlwMenuWidget)f->display.x->menubar_widget; | |
209 | menubarp = 1; | |
210 | for (vw = mw->menu.old_stack [0]->contents; vw; vw = vw->next) | |
211 | { | |
212 | w2 = w1; | |
213 | w1 += string_width (mw, vw->name) | |
214 | + 2 * (mw->menu.horizontal_spacing + | |
215 | mw->menu.shadow_thickness); | |
216 | if (XINT (x) < w1) | |
217 | { | |
218 | XMenu_xpos = w2 + 4; | |
219 | XMenu_ypos = 0; | |
220 | break; | |
221 | } | |
222 | } | |
223 | } | |
224 | else | |
225 | { | |
226 | XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); | |
227 | XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); | |
228 | } | |
229 | ||
230 | BLOCK_INPUT; | |
231 | XMenu_xpos += (f->display.x->widget->core.x | |
232 | + f->display.x->widget->core.border_width); | |
233 | XMenu_ypos += (f->display.x->widget->core.y | |
234 | + f->display.x->widget->core.border_width | |
235 | + f->display.x->menubar_widget->core.height); | |
236 | UNBLOCK_INPUT; | |
237 | ||
238 | val = set_menu_items (menu, &prefixes, &panes, &names, | |
239 | &enables, &menus, &items, &number_of_panes, &obj_list, | |
240 | &title, &error_name); | |
241 | selection = xmenu_show (f, val, XMenu_xpos, XMenu_ypos, | |
242 | menubarp, vw); | |
243 | ||
244 | free_menu_items (names, enables, menus, items, number_of_panes, obj_list, | |
245 | title, error_name); | |
246 | ||
247 | if (selection != NUL) | |
248 | { /* selected something */ | |
249 | XMenu_return = selection; | |
250 | } | |
251 | else | |
252 | { /* nothing selected */ | |
253 | XMenu_return = Qnil; | |
254 | } | |
255 | ||
256 | return XMenu_return; | |
257 | ||
258 | #else /* not USE_X_TOOLKIT */ | |
1658603c RS |
259 | #ifdef HAVE_X11 |
260 | { | |
261 | Window child; | |
262 | int win_x = 0, win_y = 0; | |
263 | ||
264 | /* Find the position of the outside upper-left corner of | |
265 | the inner window, with respect to the outer window. */ | |
266 | if (f->display.x->parent_desc != ROOT_WINDOW) | |
267 | { | |
268 | BLOCK_INPUT; | |
269 | XTranslateCoordinates (x_current_display, | |
270 | ||
271 | /* From-window, to-window. */ | |
272 | f->display.x->window_desc, | |
273 | f->display.x->parent_desc, | |
274 | ||
275 | /* From-position, to-position. */ | |
276 | 0, 0, &win_x, &win_y, | |
277 | ||
278 | /* Child of window. */ | |
279 | &child); | |
280 | UNBLOCK_INPUT; | |
281 | XMenu_xpos += win_x; | |
282 | XMenu_ypos += win_y; | |
283 | } | |
284 | } | |
18686d47 | 285 | #endif /* HAVE_X11 */ |
1658603c | 286 | |
7da99777 RS |
287 | XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); |
288 | XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); | |
dcfdbac7 | 289 | |
7708e9bd JB |
290 | XMenu_xpos += f->display.x->left_pos; |
291 | XMenu_ypos += f->display.x->top_pos; | |
dcfdbac7 | 292 | |
18686d47 | 293 | |
088831f6 RS |
294 | keymap = Fkeymapp (menu); |
295 | tem = Qnil; | |
296 | if (XTYPE (menu) == Lisp_Cons) | |
297 | tem = Fkeymapp (Fcar (menu)); | |
298 | if (!NILP (keymap)) | |
299 | { | |
300 | /* We were given a keymap. Extract menu info from the keymap. */ | |
301 | Lisp_Object prompt; | |
302 | keymap = get_keymap (menu); | |
303 | ||
304 | /* Search for a string appearing directly as an element of the keymap. | |
305 | That string is the title of the menu. */ | |
306 | prompt = map_prompt (keymap); | |
307 | if (!NILP (prompt)) | |
308 | title = (char *) XSTRING (prompt)->data; | |
309 | ||
310 | /* Extract the detailed info to make one pane. */ | |
aedaff8d | 311 | number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, |
07a675b7 | 312 | &items, &prefixes, &menu, 1); |
088831f6 RS |
313 | /* The menu title seems to be ignored, |
314 | so put it in the pane title. */ | |
315 | if (menus[0] == 0) | |
316 | menus[0] = title; | |
317 | } | |
318 | else if (!NILP (tem)) | |
dcfdbac7 | 319 | { |
088831f6 RS |
320 | /* We were given a list of keymaps. */ |
321 | Lisp_Object prompt; | |
322 | int nmaps = XFASTINT (Flength (menu)); | |
323 | Lisp_Object *maps | |
324 | = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); | |
325 | int i; | |
326 | title = 0; | |
327 | ||
328 | /* The first keymap that has a prompt string | |
329 | supplies the menu title. */ | |
330 | for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) | |
dcfdbac7 | 331 | { |
088831f6 RS |
332 | maps[i++] = keymap = get_keymap (Fcar (tem)); |
333 | ||
334 | prompt = map_prompt (keymap); | |
335 | if (title == 0 && !NILP (prompt)) | |
336 | title = (char *) XSTRING (prompt)->data; | |
dcfdbac7 | 337 | } |
088831f6 RS |
338 | |
339 | /* Extract the detailed info to make one pane. */ | |
aedaff8d | 340 | number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, |
819012f0 | 341 | &items, &prefixes, maps, nmaps); |
088831f6 RS |
342 | /* The menu title seems to be ignored, |
343 | so put it in the pane title. */ | |
344 | if (menus[0] == 0) | |
345 | menus[0] = title; | |
346 | } | |
347 | else | |
348 | { | |
349 | /* We were given an old-fashioned menu. */ | |
350 | ltitle = Fcar (menu); | |
351 | CHECK_STRING (ltitle, 1); | |
352 | title = (char *) XSTRING (ltitle)->data; | |
819012f0 | 353 | prefixes = 0; |
aedaff8d RS |
354 | number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables, |
355 | &items, Fcdr (menu)); | |
088831f6 RS |
356 | } |
357 | #ifdef XDEBUG | |
358 | fprintf (stderr, "Panes = %d\n", number_of_panes); | |
359 | for (i = 0; i < number_of_panes; i++) | |
360 | { | |
361 | fprintf (stderr, "Pane %d has lines %d title %s\n", | |
362 | i, items[i], menus[i]); | |
363 | for (j = 0; j < items[i]; j++) | |
364 | fprintf (stderr, " Item %d %s\n", j, names[i][j]); | |
dcfdbac7 JB |
365 | } |
366 | #endif | |
18686d47 | 367 | |
dcfdbac7 | 368 | BLOCK_INPUT; |
c4e5d591 JB |
369 | { |
370 | Window root; | |
371 | int root_x, root_y; | |
372 | int dummy_int; | |
373 | unsigned int dummy_uint; | |
374 | Window dummy_window; | |
375 | ||
376 | /* Figure out which root window F is on. */ | |
377 | XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root, | |
378 | &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, | |
379 | &dummy_uint, &dummy_uint); | |
380 | ||
381 | /* Translate the menu co-ordinates within f to menu co-ordinates | |
382 | on that root window. */ | |
383 | if (! XTranslateCoordinates (x_current_display, | |
384 | FRAME_X_WINDOW (f), root, | |
385 | XMenu_xpos, XMenu_ypos, &root_x, &root_y, | |
386 | &dummy_window)) | |
387 | /* But XGetGeometry said root was the root window of f's screen! */ | |
388 | abort (); | |
aedaff8d | 389 | selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables, |
819012f0 RS |
390 | menus, prefixes, items, number_of_panes, obj_list, |
391 | title, &error_name); | |
c4e5d591 | 392 | } |
dcfdbac7 | 393 | UNBLOCK_INPUT; |
088831f6 | 394 | /* fprintf (stderr, "selection = %x\n", selection); */ |
dcfdbac7 JB |
395 | if (selection != NUL) |
396 | { /* selected something */ | |
397 | XMenu_return = selection; | |
398 | } | |
399 | else | |
400 | { /* nothing selected */ | |
401 | XMenu_return = Qnil; | |
402 | } | |
403 | /* now free up the strings */ | |
088831f6 | 404 | for (i = 0; i < number_of_panes; i++) |
dcfdbac7 | 405 | { |
9ac0d9e0 JB |
406 | xfree (names[i]); |
407 | xfree (enables[i]); | |
408 | xfree (obj_list[i]); | |
dcfdbac7 | 409 | } |
9ac0d9e0 JB |
410 | xfree (menus); |
411 | xfree (obj_list); | |
412 | xfree (names); | |
413 | xfree (enables); | |
414 | xfree (items); | |
088831f6 | 415 | /* free (title); */ |
dcfdbac7 JB |
416 | if (error_name) error (error_name); |
417 | return XMenu_return; | |
18686d47 RS |
418 | #endif /* not USE_X_TOOLKIT */ |
419 | } | |
420 | \f | |
421 | #ifdef USE_X_TOOLKIT | |
422 | ||
423 | static void | |
424 | dispatch_dummy_expose (w, x, y) | |
425 | Widget w; | |
426 | int x; | |
427 | int y; | |
428 | { | |
429 | XExposeEvent dummy; | |
430 | ||
431 | dummy.type = Expose; | |
432 | dummy.window = XtWindow (w); | |
433 | dummy.count = 0; | |
434 | dummy.serial = 0; | |
435 | dummy.send_event = 0; | |
436 | dummy.display = XtDisplay (w); | |
437 | dummy.x = x; | |
438 | dummy.y = y; | |
439 | ||
440 | XtDispatchEvent (&dummy); | |
441 | } | |
442 | ||
443 | static int | |
444 | string_width (mw, s) | |
445 | XlwMenuWidget mw; | |
446 | char* s; | |
447 | { | |
448 | XCharStruct xcs; | |
449 | int drop; | |
450 | ||
451 | XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs); | |
452 | return xcs.width; | |
dcfdbac7 JB |
453 | } |
454 | ||
18686d47 RS |
455 | static int |
456 | event_is_in_menu_item (mw, event, name, string_w) | |
457 | XlwMenuWidget mw; | |
458 | struct input_event *event; | |
459 | char *name; | |
460 | int *string_w; | |
461 | { | |
462 | *string_w += string_width (mw, name) | |
463 | + 2 * (mw->menu.horizontal_spacing + mw->menu.shadow_thickness); | |
464 | return (XINT (event->x) < *string_w); | |
465 | } | |
466 | ||
467 | ||
468 | Lisp_Object | |
469 | map_event_to_object (event, f) | |
470 | struct input_event *event; | |
471 | FRAME_PTR f; | |
472 | { | |
473 | int i,j, string_w; | |
474 | window_state* ws; | |
475 | XlwMenuWidget mw = (XlwMenuWidget) f->display.x->menubar_widget; | |
476 | widget_value *val; | |
477 | ||
478 | ||
479 | string_w = 0; | |
480 | /* Find the window */ | |
481 | for (val = mw->menu.old_stack [0]->contents; val; val = val->next) | |
482 | { | |
483 | ws = &mw->menu.windows [0]; | |
484 | if (ws && event_is_in_menu_item (mw, event, val->name, &string_w)) | |
485 | { | |
486 | Lisp_Object items; | |
487 | items = FRAME_MENU_BAR_ITEMS (f); | |
488 | for (; CONSP (items); items = XCONS (items)->cdr) | |
489 | if (!strcmp (val->name, | |
490 | XSTRING (Fcar (Fcdr (Fcar (items))))->data)) | |
491 | return items; | |
492 | } | |
493 | } | |
494 | return Qnil; | |
495 | } | |
496 | ||
497 | static widget_value * | |
498 | set_menu_items (menu, prefixes, panes, names, enables, menus, | |
499 | items, number_of_panes, obj_list, title, error_name) | |
500 | Lisp_Object menu; | |
501 | Lisp_Object **prefixes; | |
502 | int *panes; | |
503 | char ***names[]; | |
504 | int ***enables; | |
505 | char ***menus; | |
506 | int **items; | |
507 | int *number_of_panes; | |
508 | Lisp_Object ***obj_list; | |
509 | char **title; | |
510 | char **error_name; | |
511 | { | |
512 | Lisp_Object keymap, tem; | |
513 | Lisp_Object ltitle, selection; | |
514 | int i, j; | |
515 | widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; | |
516 | int last, selidx, lpane, status; | |
517 | int lines, sofar; | |
518 | ||
519 | keymap = Fkeymapp (menu); | |
520 | tem = Qnil; | |
521 | ||
522 | if (XTYPE (menu) == Lisp_Cons) | |
523 | tem = Fkeymapp (Fcar (menu)); | |
524 | if (!NILP (keymap)) | |
525 | { | |
526 | /* We were given a keymap. Extract menu info from the keymap. */ | |
527 | Lisp_Object prompt; | |
528 | keymap = get_keymap (menu); | |
529 | ||
530 | /* Search for a string appearing directly as an element of the keymap. | |
531 | That string is the title of the menu. */ | |
532 | prompt = map_prompt (keymap); | |
533 | if (!NILP (prompt)) | |
534 | *title = (char *) XSTRING (prompt)->data; | |
535 | ||
536 | /* Extract the detailed info to make one pane. */ | |
537 | *number_of_panes = keymap_panes (obj_list, menus, names, enables, | |
538 | items, prefixes, menu, 1); | |
539 | /* The menu title seems to be ignored, | |
540 | so put it in the pane title. */ | |
541 | if ((*menus)[0] == 0) | |
542 | (*menus)[0] = *title; | |
543 | } | |
544 | else if (!NILP (tem)) | |
545 | { | |
546 | /* We were given a list of keymaps. */ | |
547 | Lisp_Object prompt; | |
548 | int nmaps = XFASTINT (Flength (menu)); | |
549 | Lisp_Object *maps | |
550 | = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); | |
551 | int i; | |
552 | *title = 0; | |
553 | ||
554 | /* The first keymap that has a prompt string | |
555 | supplies the menu title. */ | |
556 | for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) | |
557 | { | |
558 | maps[i++] = keymap = get_keymap (Fcar (tem)); | |
559 | ||
560 | prompt = map_prompt (keymap); | |
561 | if (*title == 0 && !NILP (prompt)) | |
562 | *title = (char *) XSTRING (prompt)->data; | |
563 | } | |
564 | ||
565 | /* Extract the detailed info to make one pane. */ | |
566 | *number_of_panes = keymap_panes (obj_list, menus, names, enables, | |
567 | items, prefixes, maps, nmaps); | |
568 | /* The menu title seems to be ignored, | |
569 | so put it in the pane title. */ | |
570 | if ((*menus)[0] == 0) | |
571 | (*menus)[0] = *title; | |
572 | } | |
573 | else | |
574 | { | |
575 | /* We were given an old-fashioned menu. */ | |
576 | ltitle = Fcar (menu); | |
577 | CHECK_STRING (ltitle, 1); | |
578 | *title = (char *) XSTRING (ltitle)->data; | |
579 | *prefixes = 0; | |
580 | *number_of_panes = list_of_panes (obj_list, menus, names, enables, | |
581 | items, Fcdr (menu)); | |
582 | } | |
583 | ||
584 | *error_name = 0; | |
585 | if (*number_of_panes == 0) | |
586 | return 0; | |
587 | ||
588 | *error_name = (char *) 0; /* Initialize error pointer to null */ | |
589 | ||
590 | wv = malloc_widget_value (); | |
591 | wv->name = "menu"; | |
592 | wv->value = 0; | |
593 | wv->enabled = 1; | |
594 | first_wv = wv; | |
595 | ||
596 | for (*panes = 0, lines = 0; *panes < *number_of_panes; | |
597 | lines += (*items)[*panes], (*panes)++) | |
598 | ; | |
599 | /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ | |
600 | /* datap = (char *) xmalloc (lines * sizeof (char)); | |
601 | datap_save = datap;*/ | |
602 | ||
603 | for (*panes = 0, sofar = 0; *panes < *number_of_panes; | |
604 | sofar += (*items)[*panes], (*panes)++) | |
605 | { | |
606 | if (strcmp((*menus)[*panes], "")) | |
607 | { | |
608 | wv = malloc_widget_value (); | |
609 | if (save_wv) | |
610 | save_wv->next = wv; | |
611 | else | |
612 | first_wv->contents = wv; | |
613 | wv->name = (*menus)[*panes]; | |
614 | wv->value = 0; | |
615 | wv->enabled = 1; | |
616 | } | |
617 | prev_wv = 0; | |
618 | save_wv = wv; | |
619 | ||
620 | for (selidx = 0; selidx < (*items)[*panes]; selidx++) | |
621 | { | |
622 | wv = malloc_widget_value (); | |
623 | if (prev_wv) | |
624 | prev_wv->next = wv; | |
625 | else | |
626 | save_wv->contents = wv; | |
627 | wv->name = (*names)[*panes][selidx]; | |
628 | wv->value = 0; | |
629 | selection = (*obj_list)[*panes][selidx]; | |
630 | if (*prefixes != 0) | |
631 | { | |
632 | selection = Fcons (selection, Qnil); | |
633 | if (!NILP ((*prefixes)[*panes])) | |
634 | selection = Fcons ((*prefixes)[*panes], selection); | |
635 | } | |
636 | wv->call_data = LISP_TO_VOID(selection); | |
637 | wv->enabled = (*enables)[*panes][selidx]; | |
638 | prev_wv = wv; | |
639 | } | |
640 | } | |
641 | ||
642 | return (first_wv); | |
643 | } | |
644 | ||
645 | static void | |
646 | free_menu_items (names, enables, menus, items, number_of_panes, | |
647 | obj_list, title, error_name) | |
648 | char **names[]; | |
649 | int *enables[]; | |
650 | char **menus; | |
651 | int *items; | |
652 | int number_of_panes; | |
653 | Lisp_Object **obj_list; | |
654 | char *title; | |
655 | char *error_name; | |
656 | { | |
657 | int i; | |
658 | /* now free up the strings */ | |
659 | for (i = 0; i < number_of_panes; i++) | |
660 | { | |
661 | xfree (names[i]); | |
662 | xfree (enables[i]); | |
663 | xfree (obj_list[i]); | |
664 | } | |
665 | xfree (menus); | |
666 | xfree (obj_list); | |
667 | xfree (names); | |
668 | xfree (enables); | |
669 | xfree (items); | |
670 | /* free (title); */ | |
671 | if (error_name) error (error_name); | |
672 | ||
673 | } | |
674 | ||
675 | static Lisp_Object menu_item_selection; | |
676 | ||
677 | static void | |
678 | popup_selection_callback (widget, id, client_data) | |
679 | Widget widget; | |
680 | LWLIB_ID id; | |
681 | XtPointer client_data; | |
682 | { | |
683 | #if 0 | |
684 | last_popup_selection_callback_id = id; | |
685 | menubar_selection_callback (widget, id, client_data); | |
686 | /* lw_destroy_all_widgets() will be called from popup_down_callback() */ | |
687 | #endif | |
688 | VOID_TO_LISP (menu_item_selection, client_data); | |
689 | } | |
690 | ||
691 | static void | |
692 | popup_down_callback (widget, id, client_data) | |
693 | Widget widget; | |
694 | LWLIB_ID id; | |
695 | XtPointer client_data; | |
696 | { | |
697 | #if 0 | |
698 | if (popup_menu_up_p == 0) abort (); | |
699 | popup_menu_up_p--; | |
700 | /* if this isn't called immediately after the selection callback, then | |
701 | there wasn't a menu selection. */ | |
702 | if (id != last_popup_selection_callback_id) | |
703 | menubar_selection_callback (widget, id, (XtPointer) -1); | |
704 | #endif | |
705 | BLOCK_INPUT; | |
706 | lw_destroy_all_widgets (id); | |
707 | UNBLOCK_INPUT; | |
708 | /* ungcpro_popup_callbacks (make_number (id)); */ | |
709 | } | |
710 | ||
711 | /* This recursively calls free_widget_value() on the tree of widgets. | |
712 | It must free all data that was malloc'ed for these widget_values. | |
713 | Currently, emacs only allocates new storage for the `key' slot. | |
714 | All other slots are pointers into the data of Lisp_Strings, and | |
715 | must be left alone. | |
716 | */ | |
717 | void | |
718 | free_menubar_widget_value_tree (wv) | |
719 | widget_value *wv; | |
720 | { | |
721 | if (! wv) return; | |
722 | if (wv->key) xfree (wv->key); | |
723 | ||
724 | wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; | |
725 | ||
726 | if (wv->contents && (wv->contents != (widget_value*)1)) | |
727 | { | |
728 | free_menubar_widget_value_tree (wv->contents); | |
729 | wv->contents = (widget_value *) 0xDEADBEEF; | |
730 | } | |
731 | if (wv->next) | |
732 | { | |
733 | free_menubar_widget_value_tree (wv->next); | |
734 | wv->next = (widget_value *) 0xDEADBEEF; | |
735 | } | |
736 | BLOCK_INPUT; | |
737 | free_widget_value (wv); | |
738 | UNBLOCK_INPUT; | |
739 | } | |
740 | ||
741 | static void | |
742 | update_one_frame_psheets (f) | |
743 | FRAME_PTR f; | |
744 | { | |
745 | struct x_display *x = f->display.x; | |
746 | ||
747 | int menubar_changed; | |
748 | ||
749 | menubar_changed = (x->menubar_widget | |
750 | && !XtIsManaged (x->menubar_widget)); | |
751 | ||
752 | if (! (menubar_changed)) | |
753 | return; | |
754 | ||
755 | BLOCK_INPUT; | |
756 | XawPanedSetRefigureMode (x->column_widget, 0); | |
757 | ||
758 | /* the order in which children are managed is the top to | |
759 | bottom order in which they are displayed in the paned window. | |
760 | First, remove the text-area widget. | |
761 | */ | |
762 | XtUnmanageChild (x->edit_widget); | |
763 | ||
764 | /* remove the menubar that is there now, and put up the menubar that | |
765 | should be there. | |
766 | */ | |
767 | if (menubar_changed) | |
768 | { | |
769 | XtManageChild (x->menubar_widget); | |
770 | XtMapWidget (x->menubar_widget); | |
771 | XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0); | |
772 | } | |
773 | ||
774 | ||
775 | /* Re-manage the text-area widget */ | |
776 | XtManageChild (x->edit_widget); | |
777 | ||
778 | /* and now thrash the sizes */ | |
779 | XawPanedSetRefigureMode (x->column_widget, 1); | |
780 | UNBLOCK_INPUT; | |
781 | } | |
782 | ||
783 | void | |
784 | set_frame_menubar (f) | |
785 | FRAME_PTR f; | |
786 | { | |
787 | Widget menubar_widget = f->display.x->menubar_widget; | |
788 | int id = (int) f; | |
789 | Lisp_Object tail; | |
790 | widget_value *wv, *save_wv, *first_wv, *prev_wv = 0; | |
791 | ||
792 | BLOCK_INPUT; | |
793 | ||
794 | wv = malloc_widget_value (); | |
795 | wv->name = "menubar"; | |
796 | wv->value = 0; | |
797 | wv->enabled = 1; | |
798 | save_wv = first_wv = wv; | |
799 | ||
800 | ||
801 | for (tail = FRAME_MENU_BAR_ITEMS (f); CONSP (tail); tail = XCONS (tail)->cdr) | |
802 | { | |
803 | Lisp_Object string; | |
804 | ||
805 | string = Fcar (Fcdr (Fcar (tail))); | |
806 | ||
807 | wv = malloc_widget_value (); | |
808 | if (prev_wv) | |
809 | prev_wv->next = wv; | |
810 | else | |
811 | save_wv->contents = wv; | |
812 | wv->name = XSTRING (string)->data; | |
813 | wv->value = 0; | |
814 | wv->enabled = 1; | |
815 | prev_wv = wv; | |
816 | } | |
817 | ||
818 | if (menubar_widget) | |
819 | lw_modify_all_widgets (id, first_wv, False); | |
820 | else | |
821 | { | |
822 | menubar_widget = lw_create_widget ("menubar", "menubar", | |
823 | id, first_wv, | |
824 | f->display.x->column_widget, | |
825 | 0, 0, | |
826 | 0, 0); | |
827 | f->display.x->menubar_widget = menubar_widget; | |
828 | XtVaSetValues (menubar_widget, | |
829 | XtNshowGrip, 0, | |
830 | XtNresizeToPreferred, 1, | |
831 | XtNallowResize, 1, | |
832 | 0); | |
833 | } | |
834 | ||
835 | free_menubar_widget_value_tree (first_wv); | |
836 | ||
837 | update_one_frame_psheets (f); | |
838 | ||
839 | UNBLOCK_INPUT; | |
840 | } | |
841 | #endif /* USE_X_TOOLKIT */ | |
842 | \f | |
dcfdbac7 JB |
843 | struct indices { |
844 | int pane; | |
845 | int line; | |
846 | }; | |
847 | ||
18686d47 RS |
848 | extern void process_expose_from_menu (); |
849 | ||
850 | #ifdef USE_X_TOOLKIT | |
851 | extern XtAppContext Xt_app_con; | |
852 | ||
dcfdbac7 | 853 | Lisp_Object |
18686d47 RS |
854 | xmenu_show (f, val, x, y, menubarp, vw) |
855 | FRAME_PTR f; | |
856 | widget_value *val; | |
857 | int x; | |
858 | int y; | |
859 | int menubarp; | |
860 | widget_value *vw; | |
861 | { | |
862 | int menu_id, id = (int)f; | |
863 | Lisp_Object selection; | |
864 | Widget menu; | |
865 | ||
866 | /* | |
867 | * Define and allocate a foreign event queue to hold events | |
868 | * that don't belong to XMenu. These events are later restored | |
869 | * to the X event queue. | |
870 | */ | |
871 | typedef struct _xmeventque | |
872 | { | |
873 | XEvent event; | |
874 | struct _xmeventque *next; | |
875 | } XMEventQue; | |
876 | ||
877 | XMEventQue *feq = NULL; /* Foreign event queue. */ | |
878 | XMEventQue *feq_tmp; /* Foreign event queue temporary. */ | |
879 | ||
880 | BLOCK_INPUT; | |
881 | menu_id = ++popup_id_tick; | |
882 | menu = lw_create_widget ("popup", val->name, menu_id, val, | |
883 | f->display.x->widget, 1, 0, | |
884 | popup_selection_callback, popup_down_callback); | |
885 | free_menubar_widget_value_tree (val); | |
886 | ||
887 | /* reset the selection */ | |
888 | menu_item_selection = Qnil; | |
889 | ||
890 | { | |
891 | XButtonPressedEvent dummy; | |
892 | XlwMenuWidget mw; | |
893 | ||
894 | mw = ((XlwMenuWidget) | |
895 | ((CompositeWidget)menu)->composite.children[0]); | |
896 | ||
897 | dummy.type = ButtonPress; | |
898 | dummy.serial = 0; | |
899 | dummy.send_event = 0; | |
900 | dummy.display = XtDisplay (menu); | |
901 | dummy.window = XtWindow (XtParent (menu)); | |
902 | dummy.time = CurrentTime; | |
903 | dummy.button = 0; | |
904 | dummy.x_root = x; | |
905 | dummy.y_root = y; | |
906 | ||
907 | if (menubarp) | |
908 | { | |
18686d47 RS |
909 | vw->call_data = (XtPointer) 1; |
910 | dispatch_dummy_expose (f->display.x->menubar_widget, x, y); | |
18686d47 RS |
911 | } |
912 | ||
913 | ||
914 | /* We activate directly the lucid implementation */ | |
915 | pop_up_menu (mw, &dummy); | |
916 | } | |
917 | ||
918 | /* Enters XEvent loop */ | |
919 | while (1) | |
920 | { | |
921 | ||
922 | XEvent event; | |
923 | XtAppNextEvent (Xt_app_con, &event); | |
924 | if (event.type == ButtonRelease) | |
925 | { | |
926 | XtDispatchEvent (&event); | |
927 | break; | |
928 | } | |
929 | else | |
930 | if (event.type == Expose) | |
931 | process_expose_from_menu (event); | |
932 | XtDispatchEvent (&event); | |
933 | feq_tmp = (XMEventQue *) malloc (sizeof (XMEventQue)); | |
934 | ||
935 | if (feq_tmp == NULL) | |
936 | return(Qnil); | |
937 | ||
938 | feq_tmp->event = event; | |
939 | feq_tmp->next = feq; | |
940 | feq = feq_tmp; | |
941 | } | |
942 | ||
943 | if (menubarp) | |
944 | { | |
18686d47 | 945 | vw->call_data = (XtPointer) 0; |
399703f1 | 946 | dispatch_dummy_expose (f->display.x->menubar_widget, x, y); |
18686d47 RS |
947 | } |
948 | ||
949 | /* Return any foreign events that were queued to the X event queue. */ | |
950 | while (feq != NULL) | |
951 | { | |
952 | feq_tmp = feq; | |
953 | XPutBackEvent (XDISPLAY &feq_tmp->event); | |
954 | feq = feq_tmp->next; | |
955 | free ((char *)feq_tmp); | |
956 | } | |
957 | ||
958 | UNBLOCK_INPUT; | |
959 | ||
960 | return menu_item_selection; | |
961 | } | |
962 | ||
963 | #else /* not USE_X_TOOLKIT */ | |
aedaff8d | 964 | xmenu_show (parent, startx, starty, line_list, enable_list, pane_list, |
819012f0 | 965 | prefixes, line_cnt, pane_cnt, item_list, title, error) |
dcfdbac7 JB |
966 | Window parent; |
967 | int startx, starty; /* upper left corner position BROKEN */ | |
968 | char **line_list[]; /* list of strings for items */ | |
86e7b627 | 969 | int *enable_list[]; /* enable flags of lines */ |
dcfdbac7 | 970 | char *pane_list[]; /* list of pane titles */ |
819012f0 | 971 | Lisp_Object *prefixes; /* Prefix key for each pane */ |
dcfdbac7 JB |
972 | char *title; |
973 | int pane_cnt; /* total number of panes */ | |
974 | Lisp_Object *item_list[]; /* All items */ | |
975 | int line_cnt[]; /* Lines in each pane */ | |
976 | char **error; /* Error returned */ | |
977 | { | |
978 | XMenu *GXMenu; | |
979 | int last, panes, selidx, lpane, status; | |
980 | int lines, sofar; | |
981 | Lisp_Object entry; | |
982 | /* struct indices *datap, *datap_save; */ | |
983 | char *datap; | |
984 | int ulx, uly, width, height; | |
985 | int dispwidth, dispheight; | |
088831f6 | 986 | |
07a675b7 | 987 | *error = 0; |
088831f6 RS |
988 | if (pane_cnt == 0) |
989 | return 0; | |
990 | ||
10c48c95 | 991 | BLOCK_INPUT; |
dcfdbac7 | 992 | *error = (char *) 0; /* Initialize error pointer to null */ |
18686d47 | 993 | |
dcfdbac7 JB |
994 | GXMenu = XMenuCreate (XDISPLAY parent, "emacs"); |
995 | if (GXMenu == NUL) | |
996 | { | |
997 | *error = "Can't create menu"; | |
10c48c95 | 998 | UNBLOCK_INPUT; |
dcfdbac7 JB |
999 | return (0); |
1000 | } | |
18686d47 | 1001 | |
088831f6 RS |
1002 | for (panes = 0, lines = 0; panes < pane_cnt; |
1003 | lines += line_cnt[panes], panes++) | |
dcfdbac7 JB |
1004 | ; |
1005 | /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ | |
088831f6 | 1006 | /* datap = (char *) xmalloc (lines * sizeof (char)); |
dcfdbac7 JB |
1007 | datap_save = datap;*/ |
1008 | ||
088831f6 RS |
1009 | for (panes = 0, sofar = 0; panes < pane_cnt; |
1010 | sofar += line_cnt[panes], panes++) | |
dcfdbac7 JB |
1011 | { |
1012 | /* create all the necessary panes */ | |
1013 | lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE); | |
1014 | if (lpane == XM_FAILURE) | |
1015 | { | |
1016 | XMenuDestroy (XDISPLAY GXMenu); | |
1017 | *error = "Can't create pane"; | |
10c48c95 | 1018 | UNBLOCK_INPUT; |
dcfdbac7 JB |
1019 | return (0); |
1020 | } | |
18686d47 | 1021 | |
088831f6 | 1022 | for (selidx = 0; selidx < line_cnt[panes]; selidx++) |
dcfdbac7 JB |
1023 | { |
1024 | /* add the selection stuff to the menus */ | |
1025 | /* datap[selidx+sofar].pane = panes; | |
1026 | datap[selidx+sofar].line = selidx; */ | |
1027 | if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0, | |
aedaff8d RS |
1028 | line_list[panes][selidx], |
1029 | enable_list[panes][selidx]) | |
dcfdbac7 JB |
1030 | == XM_FAILURE) |
1031 | { | |
1032 | XMenuDestroy (XDISPLAY GXMenu); | |
1033 | /* free (datap); */ | |
1034 | *error = "Can't add selection to menu"; | |
1035 | /* error ("Can't add selection to menu"); */ | |
10c48c95 | 1036 | UNBLOCK_INPUT; |
dcfdbac7 JB |
1037 | return (0); |
1038 | } | |
1039 | } | |
1040 | } | |
1041 | /* all set and ready to fly */ | |
1042 | XMenuRecompute (XDISPLAY GXMenu); | |
1043 | dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display)); | |
1044 | dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display)); | |
1045 | startx = min (startx, dispwidth); | |
1046 | starty = min (starty, dispheight); | |
1047 | startx = max (startx, 1); | |
1048 | starty = max (starty, 1); | |
1049 | XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty, | |
1050 | &ulx, &uly, &width, &height); | |
1051 | if (ulx+width > dispwidth) | |
1052 | { | |
1053 | startx -= (ulx + width) - dispwidth; | |
1054 | ulx = dispwidth - width; | |
1055 | } | |
1056 | if (uly+height > dispheight) | |
1057 | { | |
1058 | starty -= (uly + height) - dispheight; | |
1059 | uly = dispheight - height; | |
1060 | } | |
1061 | if (ulx < 0) startx -= ulx; | |
1062 | if (uly < 0) starty -= uly; | |
1063 | ||
1064 | XMenuSetFreeze (GXMenu, TRUE); | |
1065 | panes = selidx = 0; | |
1066 | ||
1067 | status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx, | |
1068 | startx, starty, ButtonReleaseMask, &datap); | |
1069 | switch (status) | |
1070 | { | |
1071 | case XM_SUCCESS: | |
1072 | #ifdef XDEBUG | |
1073 | fprintf (stderr, "pane= %d line = %d\n", panes, selidx); | |
1074 | #endif | |
1075 | entry = item_list[panes][selidx]; | |
819012f0 RS |
1076 | if (prefixes != 0) |
1077 | { | |
1078 | entry = Fcons (entry, Qnil); | |
1079 | if (!NILP (prefixes[panes])) | |
1080 | entry = Fcons (prefixes[panes], entry); | |
1081 | } | |
dcfdbac7 JB |
1082 | break; |
1083 | case XM_FAILURE: | |
088831f6 | 1084 | /* free (datap_save); */ |
dcfdbac7 JB |
1085 | XMenuDestroy (XDISPLAY GXMenu); |
1086 | *error = "Can't activate menu"; | |
1087 | /* error ("Can't activate menu"); */ | |
1088 | case XM_IA_SELECT: | |
1089 | case XM_NO_SELECT: | |
1090 | entry = Qnil; | |
1091 | break; | |
1092 | } | |
1093 | XMenuDestroy (XDISPLAY GXMenu); | |
10c48c95 | 1094 | UNBLOCK_INPUT; |
088831f6 | 1095 | /* free (datap_save);*/ |
dcfdbac7 JB |
1096 | return (entry); |
1097 | } | |
18686d47 | 1098 | #endif /* not USE_X_TOOLKIT */ |
dcfdbac7 JB |
1099 | |
1100 | syms_of_xmenu () | |
1101 | { | |
18686d47 | 1102 | popup_id_tick = (1<<16); |
dcfdbac7 JB |
1103 | defsubr (&Sx_popup_menu); |
1104 | } | |
088831f6 RS |
1105 | \f |
1106 | /* Construct the vectors that describe a menu | |
aedaff8d | 1107 | and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. |
088831f6 RS |
1108 | Each of those four values is a vector indexed by pane number. |
1109 | Return the number of panes. | |
1110 | ||
1111 | KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */ | |
1112 | ||
1113 | int | |
819012f0 | 1114 | keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps) |
088831f6 RS |
1115 | Lisp_Object ***vector; /* RETURN all menu objects */ |
1116 | char ***panes; /* RETURN pane names */ | |
1117 | char ****names; /* RETURN all line names */ | |
aedaff8d | 1118 | int ***enables; /* RETURN enable-flags of lines */ |
088831f6 | 1119 | int **items; /* RETURN number of items per pane */ |
819012f0 | 1120 | Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ |
088831f6 RS |
1121 | Lisp_Object *keymaps; |
1122 | int nmaps; | |
1123 | { | |
1124 | /* Number of panes we have made. */ | |
1125 | int p = 0; | |
1126 | /* Number of panes we have space for. */ | |
1127 | int npanes_allocated = nmaps; | |
1128 | int mapno; | |
1129 | ||
1130 | if (npanes_allocated < 4) | |
1131 | npanes_allocated = 4; | |
1132 | ||
1133 | /* Make space for an estimated number of panes. */ | |
1134 | *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *)); | |
1135 | *panes = (char **) xmalloc (npanes_allocated * sizeof (char *)); | |
1136 | *items = (int *) xmalloc (npanes_allocated * sizeof (int)); | |
1137 | *names = (char ***) xmalloc (npanes_allocated * sizeof (char **)); | |
aedaff8d | 1138 | *enables = (int **) xmalloc (npanes_allocated * sizeof (int *)); |
819012f0 | 1139 | *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object)); |
088831f6 RS |
1140 | |
1141 | /* Loop over the given keymaps, making a pane for each map. | |
1142 | But don't make a pane that is empty--ignore that map instead. | |
1143 | P is the number of panes we have made so far. */ | |
1144 | for (mapno = 0; mapno < nmaps; mapno++) | |
aedaff8d | 1145 | single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items, |
819012f0 | 1146 | prefixes, &p, &npanes_allocated, ""); |
088831f6 RS |
1147 | |
1148 | /* Return the number of panes. */ | |
1149 | return p; | |
1150 | } | |
1151 | ||
1152 | /* This is a recursive subroutine of the previous function. | |
1153 | It handles one keymap, KEYMAP. | |
1154 | The other arguments are passed along | |
1155 | or point to local variables of the previous function. */ | |
1156 | ||
819012f0 | 1157 | single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes, |
088831f6 RS |
1158 | p_ptr, npanes_allocated_ptr, pane_name) |
1159 | Lisp_Object keymap; | |
1160 | Lisp_Object ***vector; /* RETURN all menu objects */ | |
1161 | char ***panes; /* RETURN pane names */ | |
1162 | char ****names; /* RETURN all line names */ | |
aedaff8d | 1163 | int ***enables; /* RETURN enable flags of lines */ |
088831f6 | 1164 | int **items; /* RETURN number of items per pane */ |
819012f0 | 1165 | Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ |
088831f6 RS |
1166 | int *p_ptr; |
1167 | int *npanes_allocated_ptr; | |
1168 | char *pane_name; | |
1169 | { | |
1170 | int i; | |
1171 | Lisp_Object pending_maps; | |
1172 | Lisp_Object tail, item, item1, item2, table; | |
1173 | ||
1174 | pending_maps = Qnil; | |
1175 | ||
1176 | /* Make sure we have room for another pane. */ | |
1177 | if (*p_ptr == *npanes_allocated_ptr) | |
1178 | { | |
1179 | *npanes_allocated_ptr *= 2; | |
1180 | ||
1181 | *vector | |
1182 | = (Lisp_Object **) xrealloc (*vector, | |
1183 | *npanes_allocated_ptr * sizeof (Lisp_Object *)); | |
1184 | *panes | |
1185 | = (char **) xrealloc (*panes, | |
1186 | *npanes_allocated_ptr * sizeof (char *)); | |
1187 | *items | |
1188 | = (int *) xrealloc (*items, | |
1189 | *npanes_allocated_ptr * sizeof (int)); | |
819012f0 RS |
1190 | *prefixes |
1191 | = (Lisp_Object *) xrealloc (*prefixes, | |
1192 | (*npanes_allocated_ptr | |
1193 | * sizeof (Lisp_Object))); | |
088831f6 RS |
1194 | *names |
1195 | = (char ***) xrealloc (*names, | |
1196 | *npanes_allocated_ptr * sizeof (char **)); | |
aedaff8d RS |
1197 | *enables |
1198 | = (int **) xrealloc (*enables, | |
1199 | *npanes_allocated_ptr * sizeof (int *)); | |
088831f6 RS |
1200 | } |
1201 | ||
1202 | /* When a menu comes from keymaps, don't give names to the panes. */ | |
1203 | (*panes)[*p_ptr] = pane_name; | |
1204 | ||
819012f0 RS |
1205 | /* Normally put nil as pane's prefix key. |
1206 | Caller will override this if appropriate. */ | |
1207 | (*prefixes)[*p_ptr] = Qnil; | |
1208 | ||
088831f6 RS |
1209 | /* Get the length of the list level of the keymap. */ |
1210 | i = XFASTINT (Flength (keymap)); | |
1211 | ||
ab6ee1a0 RS |
1212 | /* Add in lengths of any arrays. */ |
1213 | for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
1214 | if (XTYPE (XCONS (tail)->car) == Lisp_Vector) | |
1215 | i += XVECTOR (XCONS (tail)->car)->size; | |
088831f6 RS |
1216 | |
1217 | /* Create vectors for the names and values of the items in the pane. | |
1218 | I is an upper bound for the number of items. */ | |
1219 | (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); | |
1220 | (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *)); | |
aedaff8d | 1221 | (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int)); |
088831f6 RS |
1222 | |
1223 | /* I is now the index of the next unused slots. */ | |
1224 | i = 0; | |
1225 | for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
1226 | { | |
1227 | /* Look at each key binding, and if it has a menu string, | |
1228 | make a menu item from it. */ | |
1229 | item = XCONS (tail)->car; | |
1230 | if (XTYPE (item) == Lisp_Cons) | |
1231 | { | |
1232 | item1 = XCONS (item)->cdr; | |
1233 | if (XTYPE (item1) == Lisp_Cons) | |
1234 | { | |
1235 | item2 = XCONS (item1)->car; | |
1236 | if (XTYPE (item2) == Lisp_String) | |
1237 | { | |
d9dcaf49 RS |
1238 | Lisp_Object def, tem; |
1239 | Lisp_Object enabled; | |
1240 | ||
1241 | def = Fcdr (item1); | |
1242 | enabled = Qt; | |
1243 | if (XTYPE (def) == Lisp_Symbol) | |
1244 | { | |
1245 | /* No property, or nil, means enable. | |
1246 | Otherwise, enable if value is not nil. */ | |
1247 | tem = Fget (def, Qmenu_enable); | |
1248 | if (!NILP (tem)) | |
1249 | enabled = Feval (tem); | |
1250 | } | |
1251 | tem = Fkeymapp (def); | |
088831f6 | 1252 | if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) |
819012f0 | 1253 | pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)), |
088831f6 | 1254 | pending_maps); |
aedaff8d | 1255 | else |
088831f6 RS |
1256 | { |
1257 | (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; | |
1258 | /* The menu item "value" is the key bound here. */ | |
1259 | (*vector)[*p_ptr][i] = XCONS (item)->car; | |
aedaff8d | 1260 | (*enables)[*p_ptr][i] |
24af387f | 1261 | = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); |
088831f6 RS |
1262 | i++; |
1263 | } | |
1264 | } | |
1265 | } | |
1266 | } | |
ab6ee1a0 RS |
1267 | else if (XTYPE (item) == Lisp_Vector) |
1268 | { | |
1269 | /* Loop over the char values represented in the vector. */ | |
1270 | int len = XVECTOR (item)->size; | |
1271 | int c; | |
1272 | for (c = 0; c < len; c++) | |
1273 | { | |
1274 | Lisp_Object character; | |
1275 | XFASTINT (character) = c; | |
1276 | item1 = XVECTOR (item)->contents[c]; | |
1277 | if (XTYPE (item1) == Lisp_Cons) | |
1278 | { | |
1279 | item2 = XCONS (item1)->car; | |
1280 | if (XTYPE (item2) == Lisp_String) | |
1281 | { | |
1282 | Lisp_Object tem; | |
d9dcaf49 RS |
1283 | Lisp_Object def; |
1284 | Lisp_Object enabled; | |
1285 | ||
1286 | def = Fcdr (item1); | |
1287 | enabled = Qt; | |
1288 | if (XTYPE (def) == Lisp_Symbol) | |
1289 | { | |
1290 | tem = Fget (def, Qmenu_enable); | |
1291 | /* No property, or nil, means enable. | |
1292 | Otherwise, enable if value is not nil. */ | |
1293 | if (!NILP (tem)) | |
1294 | enabled = Feval (tem); | |
1295 | } | |
1296 | ||
1297 | tem = Fkeymapp (def); | |
ab6ee1a0 | 1298 | if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) |
819012f0 | 1299 | pending_maps = Fcons (Fcons (def, Fcons (item2, character)), |
ab6ee1a0 | 1300 | pending_maps); |
aedaff8d | 1301 | else |
ab6ee1a0 RS |
1302 | { |
1303 | (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; | |
1304 | /* The menu item "value" is the key bound here. */ | |
1305 | (*vector)[*p_ptr][i] = character; | |
aedaff8d | 1306 | (*enables)[*p_ptr][i] |
24af387f | 1307 | = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); |
ab6ee1a0 RS |
1308 | i++; |
1309 | } | |
1310 | } | |
1311 | } | |
1312 | } | |
1313 | } | |
088831f6 RS |
1314 | } |
1315 | /* Record the number of items in the pane. */ | |
1316 | (*items)[*p_ptr] = i; | |
1317 | ||
1318 | /* If we just made an empty pane, get rid of it. */ | |
1319 | if (i == 0) | |
1320 | { | |
9ac0d9e0 JB |
1321 | xfree ((*vector)[*p_ptr]); |
1322 | xfree ((*names)[*p_ptr]); | |
1323 | xfree ((*enables)[*p_ptr]); | |
088831f6 RS |
1324 | } |
1325 | /* Otherwise, advance past it. */ | |
1326 | else | |
1327 | (*p_ptr)++; | |
1328 | ||
1329 | /* Process now any submenus which want to be panes at this level. */ | |
1330 | while (!NILP (pending_maps)) | |
1331 | { | |
819012f0 RS |
1332 | Lisp_Object elt, eltcdr; |
1333 | int panenum = *p_ptr; | |
088831f6 | 1334 | elt = Fcar (pending_maps); |
819012f0 | 1335 | eltcdr = XCONS (elt)->cdr; |
aedaff8d | 1336 | single_keymap_panes (Fcar (elt), panes, vector, names, enables, items, |
819012f0 | 1337 | prefixes, p_ptr, npanes_allocated_ptr, |
088831f6 | 1338 | /* Add 1 to discard the @. */ |
819012f0 RS |
1339 | (char *) XSTRING (XCONS (eltcdr)->car)->data + 1); |
1340 | (*prefixes)[panenum] = XCONS (eltcdr)->cdr; | |
088831f6 RS |
1341 | pending_maps = Fcdr (pending_maps); |
1342 | } | |
1343 | } | |
1344 | \f | |
1345 | /* Construct the vectors that describe a menu | |
aedaff8d | 1346 | and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. |
088831f6 RS |
1347 | Each of those four values is a vector indexed by pane number. |
1348 | Return the number of panes. | |
1349 | ||
1350 | MENU is the argument that was given to Fx_popup_menu. */ | |
dcfdbac7 | 1351 | |
088831f6 | 1352 | int |
aedaff8d | 1353 | list_of_panes (vector, panes, names, enables, items, menu) |
dcfdbac7 JB |
1354 | Lisp_Object ***vector; /* RETURN all menu objects */ |
1355 | char ***panes; /* RETURN pane names */ | |
1356 | char ****names; /* RETURN all line names */ | |
aedaff8d | 1357 | int ***enables; /* RETURN enable flags of lines */ |
dcfdbac7 JB |
1358 | int **items; /* RETURN number of items per pane */ |
1359 | Lisp_Object menu; | |
1360 | { | |
1361 | Lisp_Object tail, item, item1; | |
1362 | int i; | |
1363 | ||
1364 | if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu); | |
1365 | ||
088831f6 | 1366 | i = XFASTINT (Flength (menu)); |
dcfdbac7 JB |
1367 | |
1368 | *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *)); | |
1369 | *panes = (char **) xmalloc (i * sizeof (char *)); | |
1370 | *items = (int *) xmalloc (i * sizeof (int)); | |
1371 | *names = (char ***) xmalloc (i * sizeof (char **)); | |
aedaff8d | 1372 | *enables = (int **) xmalloc (i * sizeof (int *)); |
dcfdbac7 | 1373 | |
088831f6 | 1374 | for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++) |
dcfdbac7 | 1375 | { |
088831f6 RS |
1376 | item = Fcdr (Fcar (tail)); |
1377 | if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item); | |
dcfdbac7 | 1378 | #ifdef XDEBUG |
088831f6 | 1379 | fprintf (stderr, "list_of_panes check tail, i=%d\n", i); |
dcfdbac7 | 1380 | #endif |
088831f6 RS |
1381 | item1 = Fcar (Fcar (tail)); |
1382 | CHECK_STRING (item1, 1); | |
dcfdbac7 | 1383 | #ifdef XDEBUG |
088831f6 RS |
1384 | fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i, |
1385 | XSTRING (item1)->data); | |
dcfdbac7 | 1386 | #endif |
088831f6 | 1387 | (*panes)[i] = (char *) XSTRING (item1)->data; |
aedaff8d | 1388 | (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item); |
088831f6 RS |
1389 | /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1); |
1390 | bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1) | |
1391 | ; */ | |
dcfdbac7 JB |
1392 | } |
1393 | return i; | |
1394 | } | |
088831f6 RS |
1395 | \f |
1396 | /* Construct the lists of values and names for a single pane, from the | |
aedaff8d RS |
1397 | alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags |
1398 | int *ENABLES. Return the number of items. */ | |
dcfdbac7 | 1399 | |
088831f6 | 1400 | int |
aedaff8d | 1401 | list_of_items (vector, names, enables, pane) |
dcfdbac7 JB |
1402 | Lisp_Object **vector; /* RETURN menu "objects" */ |
1403 | char ***names; /* RETURN line names */ | |
aedaff8d | 1404 | int **enables; /* RETURN enable flags of lines */ |
dcfdbac7 JB |
1405 | Lisp_Object pane; |
1406 | { | |
1407 | Lisp_Object tail, item, item1; | |
1408 | int i; | |
1409 | ||
1410 | if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane); | |
1411 | ||
f1b28218 | 1412 | i = XFASTINT (Flength (pane)); |
dcfdbac7 JB |
1413 | |
1414 | *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); | |
1415 | *names = (char **) xmalloc (i * sizeof (char *)); | |
aedaff8d | 1416 | *enables = (int *) xmalloc (i * sizeof (int)); |
dcfdbac7 | 1417 | |
088831f6 | 1418 | for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++) |
dcfdbac7 | 1419 | { |
088831f6 | 1420 | item = Fcar (tail); |
24af387f RS |
1421 | if (STRINGP (item)) |
1422 | { | |
1423 | (*vector)[i] = Qnil; | |
1424 | (*names)[i] = (char *) XSTRING (item)->data; | |
1425 | (*enables)[i] = -1; | |
1426 | } | |
1427 | else | |
1428 | { | |
1429 | CHECK_CONS (item, 0); | |
1430 | (*vector)[i] = Fcdr (item); | |
1431 | item1 = Fcar (item); | |
1432 | CHECK_STRING (item1, 1); | |
1433 | (*names)[i] = (char *) XSTRING (item1)->data; | |
1434 | (*enables)[i] = 1; | |
1435 | } | |
dcfdbac7 JB |
1436 | } |
1437 | return i; | |
1438 | } |