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 | } | |
85f487d1 FP |
841 | |
842 | void | |
843 | free_frame_menubar (f) | |
844 | FRAME_PTR f; | |
845 | { | |
846 | Widget menubar_widget; | |
847 | int id; | |
848 | ||
849 | menubar_widget = f->display.x->menubar_widget; | |
850 | id = (int) f; | |
851 | ||
852 | if (menubar_widget) | |
853 | { | |
854 | BLOCK_INPUT; | |
855 | lw_destroy_all_widgets (id); | |
856 | UNBLOCK_INPUT; | |
857 | } | |
858 | } | |
18686d47 RS |
859 | #endif /* USE_X_TOOLKIT */ |
860 | \f | |
dcfdbac7 JB |
861 | struct indices { |
862 | int pane; | |
863 | int line; | |
864 | }; | |
865 | ||
18686d47 RS |
866 | extern void process_expose_from_menu (); |
867 | ||
868 | #ifdef USE_X_TOOLKIT | |
869 | extern XtAppContext Xt_app_con; | |
870 | ||
dcfdbac7 | 871 | Lisp_Object |
18686d47 RS |
872 | xmenu_show (f, val, x, y, menubarp, vw) |
873 | FRAME_PTR f; | |
874 | widget_value *val; | |
875 | int x; | |
876 | int y; | |
877 | int menubarp; | |
878 | widget_value *vw; | |
879 | { | |
47e8f9a3 | 880 | int menu_id, item_length; |
18686d47 RS |
881 | Lisp_Object selection; |
882 | Widget menu; | |
47e8f9a3 | 883 | XlwMenuWidget menuw = (XlwMenuWidget) f->display.x->menubar_widget; |
18686d47 RS |
884 | |
885 | /* | |
886 | * Define and allocate a foreign event queue to hold events | |
887 | * that don't belong to XMenu. These events are later restored | |
888 | * to the X event queue. | |
889 | */ | |
890 | typedef struct _xmeventque | |
891 | { | |
892 | XEvent event; | |
893 | struct _xmeventque *next; | |
894 | } XMEventQue; | |
895 | ||
896 | XMEventQue *feq = NULL; /* Foreign event queue. */ | |
897 | XMEventQue *feq_tmp; /* Foreign event queue temporary. */ | |
898 | ||
899 | BLOCK_INPUT; | |
63c414df FP |
900 | if (val == 0) return Qnil; |
901 | ||
18686d47 RS |
902 | menu_id = ++popup_id_tick; |
903 | menu = lw_create_widget ("popup", val->name, menu_id, val, | |
904 | f->display.x->widget, 1, 0, | |
905 | popup_selection_callback, popup_down_callback); | |
906 | free_menubar_widget_value_tree (val); | |
907 | ||
908 | /* reset the selection */ | |
909 | menu_item_selection = Qnil; | |
910 | ||
911 | { | |
912 | XButtonPressedEvent dummy; | |
913 | XlwMenuWidget mw; | |
914 | ||
915 | mw = ((XlwMenuWidget) | |
916 | ((CompositeWidget)menu)->composite.children[0]); | |
917 | ||
918 | dummy.type = ButtonPress; | |
919 | dummy.serial = 0; | |
920 | dummy.send_event = 0; | |
921 | dummy.display = XtDisplay (menu); | |
922 | dummy.window = XtWindow (XtParent (menu)); | |
923 | dummy.time = CurrentTime; | |
924 | dummy.button = 0; | |
925 | dummy.x_root = x; | |
926 | dummy.y_root = y; | |
927 | ||
928 | if (menubarp) | |
929 | { | |
18686d47 RS |
930 | vw->call_data = (XtPointer) 1; |
931 | dispatch_dummy_expose (f->display.x->menubar_widget, x, y); | |
18686d47 RS |
932 | } |
933 | ||
934 | ||
935 | /* We activate directly the lucid implementation */ | |
936 | pop_up_menu (mw, &dummy); | |
937 | } | |
938 | ||
47e8f9a3 FP |
939 | if (menubarp) |
940 | { | |
941 | item_length = (x + string_width (menuw, vw->name) | |
942 | + (2 * (menuw->menu.horizontal_spacing | |
943 | + menuw->menu.shadow_thickness)) | |
944 | - 4); | |
945 | } | |
946 | ||
18686d47 RS |
947 | /* Enters XEvent loop */ |
948 | while (1) | |
949 | { | |
950 | ||
951 | XEvent event; | |
952 | XtAppNextEvent (Xt_app_con, &event); | |
953 | if (event.type == ButtonRelease) | |
954 | { | |
955 | XtDispatchEvent (&event); | |
956 | break; | |
957 | } | |
958 | else | |
959 | if (event.type == Expose) | |
960 | process_expose_from_menu (event); | |
47e8f9a3 FP |
961 | else |
962 | if (event.type == MotionNotify | |
9106ccf1 FP |
963 | && menubarp |
964 | && ((event.xmotion.y_root | |
965 | >= (f->display.x->widget->core.y | |
966 | + f->display.x->widget->core.border_width)) | |
967 | && (event.xmotion.y_root | |
968 | < (f->display.x->widget->core.y | |
969 | + f->display.x->widget->core.border_width | |
970 | + f->display.x->menubar_widget->core.height))) | |
971 | && ((event.xmotion.x_root | |
972 | >= (f->display.x->widget->core.x | |
973 | + f->display.x->widget->core.border_width)) | |
974 | && (event.xmotion.x_root | |
975 | < (f->display.x->widget->core.x | |
976 | + f->display.x->widget->core.border_width | |
977 | + f->display.x->widget->core.width))) | |
47e8f9a3 FP |
978 | && (event.xmotion.x_root >= item_length |
979 | || event.xmotion.x_root < (x - 4))) | |
980 | { | |
981 | BLOCK_INPUT; | |
982 | XtUngrabPointer ((Widget) | |
983 | ((XlwMenuWidget) | |
984 | ((CompositeWidget)menu)->composite.children[0]), | |
985 | event.xbutton.time); | |
986 | lw_destroy_all_widgets (menu_id); | |
987 | UNBLOCK_INPUT; | |
988 | ||
989 | event.type = ButtonPress; | |
990 | event.xbutton.time = CurrentTime; | |
991 | event.xbutton.button = Button1; | |
992 | event.xbutton.window = XtWindow (f->display.x->menubar_widget); | |
993 | event.xbutton.x = (event.xbutton.x_root | |
994 | - (f->display.x->widget->core.x | |
995 | + f->display.x->widget->core.border_width)); | |
996 | XPutBackEvent (XDISPLAY &event); | |
997 | break; | |
998 | } | |
999 | ||
18686d47 RS |
1000 | XtDispatchEvent (&event); |
1001 | feq_tmp = (XMEventQue *) malloc (sizeof (XMEventQue)); | |
1002 | ||
1003 | if (feq_tmp == NULL) | |
1004 | return(Qnil); | |
1005 | ||
1006 | feq_tmp->event = event; | |
1007 | feq_tmp->next = feq; | |
1008 | feq = feq_tmp; | |
1009 | } | |
1010 | ||
1011 | if (menubarp) | |
1012 | { | |
18686d47 | 1013 | vw->call_data = (XtPointer) 0; |
399703f1 | 1014 | dispatch_dummy_expose (f->display.x->menubar_widget, x, y); |
18686d47 RS |
1015 | } |
1016 | ||
1017 | /* Return any foreign events that were queued to the X event queue. */ | |
1018 | while (feq != NULL) | |
1019 | { | |
1020 | feq_tmp = feq; | |
1021 | XPutBackEvent (XDISPLAY &feq_tmp->event); | |
1022 | feq = feq_tmp->next; | |
1023 | free ((char *)feq_tmp); | |
1024 | } | |
1025 | ||
1026 | UNBLOCK_INPUT; | |
1027 | ||
1028 | return menu_item_selection; | |
1029 | } | |
1030 | ||
1031 | #else /* not USE_X_TOOLKIT */ | |
aedaff8d | 1032 | xmenu_show (parent, startx, starty, line_list, enable_list, pane_list, |
819012f0 | 1033 | prefixes, line_cnt, pane_cnt, item_list, title, error) |
dcfdbac7 JB |
1034 | Window parent; |
1035 | int startx, starty; /* upper left corner position BROKEN */ | |
1036 | char **line_list[]; /* list of strings for items */ | |
86e7b627 | 1037 | int *enable_list[]; /* enable flags of lines */ |
dcfdbac7 | 1038 | char *pane_list[]; /* list of pane titles */ |
819012f0 | 1039 | Lisp_Object *prefixes; /* Prefix key for each pane */ |
dcfdbac7 JB |
1040 | char *title; |
1041 | int pane_cnt; /* total number of panes */ | |
1042 | Lisp_Object *item_list[]; /* All items */ | |
1043 | int line_cnt[]; /* Lines in each pane */ | |
1044 | char **error; /* Error returned */ | |
1045 | { | |
1046 | XMenu *GXMenu; | |
1047 | int last, panes, selidx, lpane, status; | |
1048 | int lines, sofar; | |
1049 | Lisp_Object entry; | |
1050 | /* struct indices *datap, *datap_save; */ | |
1051 | char *datap; | |
1052 | int ulx, uly, width, height; | |
1053 | int dispwidth, dispheight; | |
088831f6 | 1054 | |
07a675b7 | 1055 | *error = 0; |
088831f6 RS |
1056 | if (pane_cnt == 0) |
1057 | return 0; | |
1058 | ||
10c48c95 | 1059 | BLOCK_INPUT; |
dcfdbac7 | 1060 | *error = (char *) 0; /* Initialize error pointer to null */ |
18686d47 | 1061 | |
dcfdbac7 JB |
1062 | GXMenu = XMenuCreate (XDISPLAY parent, "emacs"); |
1063 | if (GXMenu == NUL) | |
1064 | { | |
1065 | *error = "Can't create menu"; | |
10c48c95 | 1066 | UNBLOCK_INPUT; |
dcfdbac7 JB |
1067 | return (0); |
1068 | } | |
18686d47 | 1069 | |
088831f6 RS |
1070 | for (panes = 0, lines = 0; panes < pane_cnt; |
1071 | lines += line_cnt[panes], panes++) | |
dcfdbac7 JB |
1072 | ; |
1073 | /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ | |
088831f6 | 1074 | /* datap = (char *) xmalloc (lines * sizeof (char)); |
dcfdbac7 JB |
1075 | datap_save = datap;*/ |
1076 | ||
088831f6 RS |
1077 | for (panes = 0, sofar = 0; panes < pane_cnt; |
1078 | sofar += line_cnt[panes], panes++) | |
dcfdbac7 JB |
1079 | { |
1080 | /* create all the necessary panes */ | |
1081 | lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE); | |
1082 | if (lpane == XM_FAILURE) | |
1083 | { | |
1084 | XMenuDestroy (XDISPLAY GXMenu); | |
1085 | *error = "Can't create pane"; | |
10c48c95 | 1086 | UNBLOCK_INPUT; |
dcfdbac7 JB |
1087 | return (0); |
1088 | } | |
18686d47 | 1089 | |
088831f6 | 1090 | for (selidx = 0; selidx < line_cnt[panes]; selidx++) |
dcfdbac7 JB |
1091 | { |
1092 | /* add the selection stuff to the menus */ | |
1093 | /* datap[selidx+sofar].pane = panes; | |
1094 | datap[selidx+sofar].line = selidx; */ | |
1095 | if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0, | |
aedaff8d RS |
1096 | line_list[panes][selidx], |
1097 | enable_list[panes][selidx]) | |
dcfdbac7 JB |
1098 | == XM_FAILURE) |
1099 | { | |
1100 | XMenuDestroy (XDISPLAY GXMenu); | |
1101 | /* free (datap); */ | |
1102 | *error = "Can't add selection to menu"; | |
1103 | /* error ("Can't add selection to menu"); */ | |
10c48c95 | 1104 | UNBLOCK_INPUT; |
dcfdbac7 JB |
1105 | return (0); |
1106 | } | |
1107 | } | |
1108 | } | |
1109 | /* all set and ready to fly */ | |
1110 | XMenuRecompute (XDISPLAY GXMenu); | |
1111 | dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display)); | |
1112 | dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display)); | |
1113 | startx = min (startx, dispwidth); | |
1114 | starty = min (starty, dispheight); | |
1115 | startx = max (startx, 1); | |
1116 | starty = max (starty, 1); | |
1117 | XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty, | |
1118 | &ulx, &uly, &width, &height); | |
1119 | if (ulx+width > dispwidth) | |
1120 | { | |
1121 | startx -= (ulx + width) - dispwidth; | |
1122 | ulx = dispwidth - width; | |
1123 | } | |
1124 | if (uly+height > dispheight) | |
1125 | { | |
1126 | starty -= (uly + height) - dispheight; | |
1127 | uly = dispheight - height; | |
1128 | } | |
1129 | if (ulx < 0) startx -= ulx; | |
1130 | if (uly < 0) starty -= uly; | |
1131 | ||
1132 | XMenuSetFreeze (GXMenu, TRUE); | |
1133 | panes = selidx = 0; | |
1134 | ||
1135 | status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx, | |
1136 | startx, starty, ButtonReleaseMask, &datap); | |
1137 | switch (status) | |
1138 | { | |
1139 | case XM_SUCCESS: | |
1140 | #ifdef XDEBUG | |
1141 | fprintf (stderr, "pane= %d line = %d\n", panes, selidx); | |
1142 | #endif | |
1143 | entry = item_list[panes][selidx]; | |
819012f0 RS |
1144 | if (prefixes != 0) |
1145 | { | |
1146 | entry = Fcons (entry, Qnil); | |
1147 | if (!NILP (prefixes[panes])) | |
1148 | entry = Fcons (prefixes[panes], entry); | |
1149 | } | |
dcfdbac7 JB |
1150 | break; |
1151 | case XM_FAILURE: | |
088831f6 | 1152 | /* free (datap_save); */ |
dcfdbac7 JB |
1153 | XMenuDestroy (XDISPLAY GXMenu); |
1154 | *error = "Can't activate menu"; | |
1155 | /* error ("Can't activate menu"); */ | |
1156 | case XM_IA_SELECT: | |
1157 | case XM_NO_SELECT: | |
1158 | entry = Qnil; | |
1159 | break; | |
1160 | } | |
1161 | XMenuDestroy (XDISPLAY GXMenu); | |
10c48c95 | 1162 | UNBLOCK_INPUT; |
088831f6 | 1163 | /* free (datap_save);*/ |
dcfdbac7 JB |
1164 | return (entry); |
1165 | } | |
18686d47 | 1166 | #endif /* not USE_X_TOOLKIT */ |
dcfdbac7 JB |
1167 | |
1168 | syms_of_xmenu () | |
1169 | { | |
18686d47 | 1170 | popup_id_tick = (1<<16); |
dcfdbac7 JB |
1171 | defsubr (&Sx_popup_menu); |
1172 | } | |
088831f6 RS |
1173 | \f |
1174 | /* Construct the vectors that describe a menu | |
aedaff8d | 1175 | and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. |
088831f6 RS |
1176 | Each of those four values is a vector indexed by pane number. |
1177 | Return the number of panes. | |
1178 | ||
1179 | KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */ | |
1180 | ||
1181 | int | |
819012f0 | 1182 | keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps) |
088831f6 RS |
1183 | Lisp_Object ***vector; /* RETURN all menu objects */ |
1184 | char ***panes; /* RETURN pane names */ | |
1185 | char ****names; /* RETURN all line names */ | |
aedaff8d | 1186 | int ***enables; /* RETURN enable-flags of lines */ |
088831f6 | 1187 | int **items; /* RETURN number of items per pane */ |
819012f0 | 1188 | Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ |
088831f6 RS |
1189 | Lisp_Object *keymaps; |
1190 | int nmaps; | |
1191 | { | |
1192 | /* Number of panes we have made. */ | |
1193 | int p = 0; | |
1194 | /* Number of panes we have space for. */ | |
1195 | int npanes_allocated = nmaps; | |
1196 | int mapno; | |
1197 | ||
1198 | if (npanes_allocated < 4) | |
1199 | npanes_allocated = 4; | |
1200 | ||
1201 | /* Make space for an estimated number of panes. */ | |
1202 | *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *)); | |
1203 | *panes = (char **) xmalloc (npanes_allocated * sizeof (char *)); | |
1204 | *items = (int *) xmalloc (npanes_allocated * sizeof (int)); | |
1205 | *names = (char ***) xmalloc (npanes_allocated * sizeof (char **)); | |
aedaff8d | 1206 | *enables = (int **) xmalloc (npanes_allocated * sizeof (int *)); |
819012f0 | 1207 | *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object)); |
088831f6 RS |
1208 | |
1209 | /* Loop over the given keymaps, making a pane for each map. | |
1210 | But don't make a pane that is empty--ignore that map instead. | |
1211 | P is the number of panes we have made so far. */ | |
1212 | for (mapno = 0; mapno < nmaps; mapno++) | |
aedaff8d | 1213 | single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items, |
819012f0 | 1214 | prefixes, &p, &npanes_allocated, ""); |
088831f6 RS |
1215 | |
1216 | /* Return the number of panes. */ | |
1217 | return p; | |
1218 | } | |
1219 | ||
71cc5cf3 RS |
1220 | /* This is used as the handler when calling internal_condition_case_1. */ |
1221 | ||
1222 | static Lisp_Object | |
1223 | single_keymap_panes_1 (arg) | |
1224 | Lisp_Object arg; | |
1225 | { | |
1226 | return Qnil; | |
1227 | } | |
1228 | ||
1229 | /* This is a recursive subroutine of keymap_panes. | |
088831f6 RS |
1230 | It handles one keymap, KEYMAP. |
1231 | The other arguments are passed along | |
1232 | or point to local variables of the previous function. */ | |
1233 | ||
819012f0 | 1234 | single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes, |
088831f6 RS |
1235 | p_ptr, npanes_allocated_ptr, pane_name) |
1236 | Lisp_Object keymap; | |
1237 | Lisp_Object ***vector; /* RETURN all menu objects */ | |
1238 | char ***panes; /* RETURN pane names */ | |
1239 | char ****names; /* RETURN all line names */ | |
aedaff8d | 1240 | int ***enables; /* RETURN enable flags of lines */ |
088831f6 | 1241 | int **items; /* RETURN number of items per pane */ |
819012f0 | 1242 | Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ |
088831f6 RS |
1243 | int *p_ptr; |
1244 | int *npanes_allocated_ptr; | |
1245 | char *pane_name; | |
1246 | { | |
1247 | int i; | |
1248 | Lisp_Object pending_maps; | |
1249 | Lisp_Object tail, item, item1, item2, table; | |
1250 | ||
1251 | pending_maps = Qnil; | |
1252 | ||
1253 | /* Make sure we have room for another pane. */ | |
1254 | if (*p_ptr == *npanes_allocated_ptr) | |
1255 | { | |
1256 | *npanes_allocated_ptr *= 2; | |
1257 | ||
1258 | *vector | |
1259 | = (Lisp_Object **) xrealloc (*vector, | |
1260 | *npanes_allocated_ptr * sizeof (Lisp_Object *)); | |
1261 | *panes | |
1262 | = (char **) xrealloc (*panes, | |
1263 | *npanes_allocated_ptr * sizeof (char *)); | |
1264 | *items | |
1265 | = (int *) xrealloc (*items, | |
1266 | *npanes_allocated_ptr * sizeof (int)); | |
819012f0 RS |
1267 | *prefixes |
1268 | = (Lisp_Object *) xrealloc (*prefixes, | |
1269 | (*npanes_allocated_ptr | |
1270 | * sizeof (Lisp_Object))); | |
088831f6 RS |
1271 | *names |
1272 | = (char ***) xrealloc (*names, | |
1273 | *npanes_allocated_ptr * sizeof (char **)); | |
aedaff8d RS |
1274 | *enables |
1275 | = (int **) xrealloc (*enables, | |
1276 | *npanes_allocated_ptr * sizeof (int *)); | |
088831f6 RS |
1277 | } |
1278 | ||
1279 | /* When a menu comes from keymaps, don't give names to the panes. */ | |
1280 | (*panes)[*p_ptr] = pane_name; | |
1281 | ||
819012f0 RS |
1282 | /* Normally put nil as pane's prefix key. |
1283 | Caller will override this if appropriate. */ | |
1284 | (*prefixes)[*p_ptr] = Qnil; | |
1285 | ||
088831f6 RS |
1286 | /* Get the length of the list level of the keymap. */ |
1287 | i = XFASTINT (Flength (keymap)); | |
1288 | ||
ab6ee1a0 RS |
1289 | /* Add in lengths of any arrays. */ |
1290 | for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
1291 | if (XTYPE (XCONS (tail)->car) == Lisp_Vector) | |
1292 | i += XVECTOR (XCONS (tail)->car)->size; | |
088831f6 RS |
1293 | |
1294 | /* Create vectors for the names and values of the items in the pane. | |
1295 | I is an upper bound for the number of items. */ | |
1296 | (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); | |
1297 | (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *)); | |
aedaff8d | 1298 | (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int)); |
088831f6 RS |
1299 | |
1300 | /* I is now the index of the next unused slots. */ | |
1301 | i = 0; | |
1302 | for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) | |
1303 | { | |
1304 | /* Look at each key binding, and if it has a menu string, | |
1305 | make a menu item from it. */ | |
1306 | item = XCONS (tail)->car; | |
1307 | if (XTYPE (item) == Lisp_Cons) | |
1308 | { | |
1309 | item1 = XCONS (item)->cdr; | |
1310 | if (XTYPE (item1) == Lisp_Cons) | |
1311 | { | |
1312 | item2 = XCONS (item1)->car; | |
1313 | if (XTYPE (item2) == Lisp_String) | |
1314 | { | |
d9dcaf49 RS |
1315 | Lisp_Object def, tem; |
1316 | Lisp_Object enabled; | |
1317 | ||
1318 | def = Fcdr (item1); | |
1319 | enabled = Qt; | |
1320 | if (XTYPE (def) == Lisp_Symbol) | |
1321 | { | |
1322 | /* No property, or nil, means enable. | |
1323 | Otherwise, enable if value is not nil. */ | |
1324 | tem = Fget (def, Qmenu_enable); | |
1325 | if (!NILP (tem)) | |
71cc5cf3 RS |
1326 | /* (condition-case nil (eval tem) |
1327 | (error nil)) */ | |
1328 | enabled = internal_condition_case_1 (Feval, tem, | |
1329 | Qerror, | |
1330 | single_keymap_panes_1); | |
d9dcaf49 RS |
1331 | } |
1332 | tem = Fkeymapp (def); | |
088831f6 | 1333 | if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) |
819012f0 | 1334 | pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)), |
088831f6 | 1335 | pending_maps); |
aedaff8d | 1336 | else |
088831f6 RS |
1337 | { |
1338 | (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; | |
1339 | /* The menu item "value" is the key bound here. */ | |
1340 | (*vector)[*p_ptr][i] = XCONS (item)->car; | |
aedaff8d | 1341 | (*enables)[*p_ptr][i] |
24af387f | 1342 | = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); |
088831f6 RS |
1343 | i++; |
1344 | } | |
1345 | } | |
1346 | } | |
1347 | } | |
ab6ee1a0 RS |
1348 | else if (XTYPE (item) == Lisp_Vector) |
1349 | { | |
1350 | /* Loop over the char values represented in the vector. */ | |
1351 | int len = XVECTOR (item)->size; | |
1352 | int c; | |
1353 | for (c = 0; c < len; c++) | |
1354 | { | |
1355 | Lisp_Object character; | |
1356 | XFASTINT (character) = c; | |
1357 | item1 = XVECTOR (item)->contents[c]; | |
1358 | if (XTYPE (item1) == Lisp_Cons) | |
1359 | { | |
1360 | item2 = XCONS (item1)->car; | |
1361 | if (XTYPE (item2) == Lisp_String) | |
1362 | { | |
1363 | Lisp_Object tem; | |
d9dcaf49 RS |
1364 | Lisp_Object def; |
1365 | Lisp_Object enabled; | |
1366 | ||
1367 | def = Fcdr (item1); | |
1368 | enabled = Qt; | |
1369 | if (XTYPE (def) == Lisp_Symbol) | |
1370 | { | |
1371 | tem = Fget (def, Qmenu_enable); | |
1372 | /* No property, or nil, means enable. | |
1373 | Otherwise, enable if value is not nil. */ | |
1374 | if (!NILP (tem)) | |
71cc5cf3 RS |
1375 | /* (condition-case nil (eval tem) |
1376 | (error nil)) */ | |
1377 | enabled = internal_condition_case_1 (Feval, tem, | |
1378 | Qerror, | |
1379 | single_keymap_panes_1); | |
d9dcaf49 RS |
1380 | } |
1381 | ||
1382 | tem = Fkeymapp (def); | |
ab6ee1a0 | 1383 | if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) |
819012f0 | 1384 | pending_maps = Fcons (Fcons (def, Fcons (item2, character)), |
ab6ee1a0 | 1385 | pending_maps); |
aedaff8d | 1386 | else |
ab6ee1a0 RS |
1387 | { |
1388 | (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; | |
1389 | /* The menu item "value" is the key bound here. */ | |
1390 | (*vector)[*p_ptr][i] = character; | |
aedaff8d | 1391 | (*enables)[*p_ptr][i] |
24af387f | 1392 | = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); |
ab6ee1a0 RS |
1393 | i++; |
1394 | } | |
1395 | } | |
1396 | } | |
1397 | } | |
1398 | } | |
088831f6 RS |
1399 | } |
1400 | /* Record the number of items in the pane. */ | |
1401 | (*items)[*p_ptr] = i; | |
1402 | ||
1403 | /* If we just made an empty pane, get rid of it. */ | |
1404 | if (i == 0) | |
1405 | { | |
9ac0d9e0 JB |
1406 | xfree ((*vector)[*p_ptr]); |
1407 | xfree ((*names)[*p_ptr]); | |
1408 | xfree ((*enables)[*p_ptr]); | |
088831f6 RS |
1409 | } |
1410 | /* Otherwise, advance past it. */ | |
1411 | else | |
1412 | (*p_ptr)++; | |
1413 | ||
1414 | /* Process now any submenus which want to be panes at this level. */ | |
1415 | while (!NILP (pending_maps)) | |
1416 | { | |
819012f0 RS |
1417 | Lisp_Object elt, eltcdr; |
1418 | int panenum = *p_ptr; | |
088831f6 | 1419 | elt = Fcar (pending_maps); |
819012f0 | 1420 | eltcdr = XCONS (elt)->cdr; |
aedaff8d | 1421 | single_keymap_panes (Fcar (elt), panes, vector, names, enables, items, |
819012f0 | 1422 | prefixes, p_ptr, npanes_allocated_ptr, |
088831f6 | 1423 | /* Add 1 to discard the @. */ |
819012f0 RS |
1424 | (char *) XSTRING (XCONS (eltcdr)->car)->data + 1); |
1425 | (*prefixes)[panenum] = XCONS (eltcdr)->cdr; | |
088831f6 RS |
1426 | pending_maps = Fcdr (pending_maps); |
1427 | } | |
1428 | } | |
1429 | \f | |
1430 | /* Construct the vectors that describe a menu | |
aedaff8d | 1431 | and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. |
088831f6 RS |
1432 | Each of those four values is a vector indexed by pane number. |
1433 | Return the number of panes. | |
1434 | ||
1435 | MENU is the argument that was given to Fx_popup_menu. */ | |
dcfdbac7 | 1436 | |
088831f6 | 1437 | int |
aedaff8d | 1438 | list_of_panes (vector, panes, names, enables, items, menu) |
dcfdbac7 JB |
1439 | Lisp_Object ***vector; /* RETURN all menu objects */ |
1440 | char ***panes; /* RETURN pane names */ | |
1441 | char ****names; /* RETURN all line names */ | |
aedaff8d | 1442 | int ***enables; /* RETURN enable flags of lines */ |
dcfdbac7 JB |
1443 | int **items; /* RETURN number of items per pane */ |
1444 | Lisp_Object menu; | |
1445 | { | |
1446 | Lisp_Object tail, item, item1; | |
1447 | int i; | |
1448 | ||
1449 | if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu); | |
1450 | ||
088831f6 | 1451 | i = XFASTINT (Flength (menu)); |
dcfdbac7 JB |
1452 | |
1453 | *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *)); | |
1454 | *panes = (char **) xmalloc (i * sizeof (char *)); | |
1455 | *items = (int *) xmalloc (i * sizeof (int)); | |
1456 | *names = (char ***) xmalloc (i * sizeof (char **)); | |
aedaff8d | 1457 | *enables = (int **) xmalloc (i * sizeof (int *)); |
dcfdbac7 | 1458 | |
088831f6 | 1459 | for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++) |
dcfdbac7 | 1460 | { |
088831f6 RS |
1461 | item = Fcdr (Fcar (tail)); |
1462 | if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item); | |
dcfdbac7 | 1463 | #ifdef XDEBUG |
088831f6 | 1464 | fprintf (stderr, "list_of_panes check tail, i=%d\n", i); |
dcfdbac7 | 1465 | #endif |
088831f6 RS |
1466 | item1 = Fcar (Fcar (tail)); |
1467 | CHECK_STRING (item1, 1); | |
dcfdbac7 | 1468 | #ifdef XDEBUG |
088831f6 RS |
1469 | fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i, |
1470 | XSTRING (item1)->data); | |
dcfdbac7 | 1471 | #endif |
088831f6 | 1472 | (*panes)[i] = (char *) XSTRING (item1)->data; |
aedaff8d | 1473 | (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item); |
088831f6 RS |
1474 | /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1); |
1475 | bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1) | |
1476 | ; */ | |
dcfdbac7 JB |
1477 | } |
1478 | return i; | |
1479 | } | |
088831f6 RS |
1480 | \f |
1481 | /* Construct the lists of values and names for a single pane, from the | |
aedaff8d RS |
1482 | alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags |
1483 | int *ENABLES. Return the number of items. */ | |
dcfdbac7 | 1484 | |
088831f6 | 1485 | int |
aedaff8d | 1486 | list_of_items (vector, names, enables, pane) |
dcfdbac7 JB |
1487 | Lisp_Object **vector; /* RETURN menu "objects" */ |
1488 | char ***names; /* RETURN line names */ | |
aedaff8d | 1489 | int **enables; /* RETURN enable flags of lines */ |
dcfdbac7 JB |
1490 | Lisp_Object pane; |
1491 | { | |
1492 | Lisp_Object tail, item, item1; | |
1493 | int i; | |
1494 | ||
1495 | if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane); | |
1496 | ||
f1b28218 | 1497 | i = XFASTINT (Flength (pane)); |
dcfdbac7 JB |
1498 | |
1499 | *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); | |
1500 | *names = (char **) xmalloc (i * sizeof (char *)); | |
aedaff8d | 1501 | *enables = (int *) xmalloc (i * sizeof (int)); |
dcfdbac7 | 1502 | |
088831f6 | 1503 | for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++) |
dcfdbac7 | 1504 | { |
088831f6 | 1505 | item = Fcar (tail); |
24af387f RS |
1506 | if (STRINGP (item)) |
1507 | { | |
1508 | (*vector)[i] = Qnil; | |
1509 | (*names)[i] = (char *) XSTRING (item)->data; | |
1510 | (*enables)[i] = -1; | |
1511 | } | |
1512 | else | |
1513 | { | |
1514 | CHECK_CONS (item, 0); | |
1515 | (*vector)[i] = Fcdr (item); | |
1516 | item1 = Fcar (item); | |
1517 | CHECK_STRING (item1, 1); | |
1518 | (*names)[i] = (char *) XSTRING (item1)->data; | |
1519 | (*enables)[i] = 1; | |
1520 | } | |
dcfdbac7 JB |
1521 | } |
1522 | return i; | |
1523 | } |