1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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
8 the Free Software Foundation; either version 2, or (at your option)
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.
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. */
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
27 /* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
32 /* On 4.3 this loses if it comes after xterm.h. */
36 #include "termhooks.h"
40 #include "blockinput.h"
42 /* This may include sys/types.h, and that somehow loses
43 if this is not done before the other system files. */
46 /* Load sys/types.h if not already loaded.
47 In some systems loading it twice is suicidal. */
49 #include <sys/types.h>
52 #include "dispextern.h"
55 #include "../oldXMenu/XMenu.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 */
70 #define min(x,y) (((x) < (y)) ? (x) : (y))
71 #define max(x,y) (((x) > (y)) ? (x) : (y))
81 extern Display
*x_current_display
;
83 #define ButtonReleaseMask ButtonReleased
84 #endif /* not HAVE_X11 */
86 extern Lisp_Object Qmenu_enable
;
87 extern Lisp_Object Qmenu_bar
;
88 Lisp_Object
xmenu_show ();
89 extern int x_error_handler ();
91 static widget_value
*set_menu_items ();
92 static int string_width ();
93 static void free_menu_items ();
96 /* we need a unique id for each popup menu and dialog box */
97 unsigned int popup_id_tick
;
99 /*************************************************************/
102 /* Ignoring the args is easiest. */
105 error ("Unknown XMenu error");
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\
112 POSITION is a position specification. This is either a mouse button event\n\
113 or a list ((XOFFSET YOFFSET) WINDOW)\n\
114 where XOFFSET and YOFFSET are positions in characters from the top left\n\
115 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
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\
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\
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\
128 Alternatively, you can specify a menu of multiple panes\n\
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\
134 With this form of menu, the return value is VALUE from the chosen item.")
136 Lisp_Object position
, menu
;
138 int number_of_panes
, panes
;
139 Lisp_Object XMenu_return
, keymap
, tem
;
140 int XMenu_xpos
, XMenu_ypos
;
144 Lisp_Object
**obj_list
;
145 Lisp_Object
*prefixes
;
149 Lisp_Object ltitle
, selection
;
150 int i
, j
, menubarp
= 0;
152 Lisp_Object x
, y
, window
;
154 widget_value
*val
, *vw
= 0;
155 #endif /* USE_X_TOOLKIT */
158 /* Decode the first argument: find the window and the coordinates. */
159 tem
= Fcar (position
);
160 if (XTYPE (tem
) == Lisp_Cons
)
162 window
= Fcar (Fcdr (position
));
164 y
= Fcar (Fcdr (tem
));
168 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
169 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
170 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
177 if (XTYPE (window
) == Lisp_Frame
)
184 else if (XTYPE (window
) == Lisp_Window
)
186 CHECK_LIVE_WINDOW (window
, 0);
187 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
189 XMenu_xpos
= FONT_WIDTH (f
->display
.x
->font
)
190 * XWINDOW (window
)->left
;
191 XMenu_ypos
= FONT_HEIGHT (f
->display
.x
->font
)
192 * XWINDOW (window
)->top
;
195 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
196 but I don't want to make one now. */
197 CHECK_WINDOW (window
, 0);
200 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
201 if (XTYPE (Fcar (position
)) != Lisp_Cons
203 && EQ (Fcar (tem
), Qmenu_bar
))
205 /* We are in the menubar */
209 mw
= (XlwMenuWidget
)f
->display
.x
->menubar_widget
;
211 for (vw
= mw
->menu
.old_stack
[0]->contents
; vw
; vw
= vw
->next
)
214 w1
+= string_width (mw
, vw
->name
)
215 + 2 * (mw
->menu
.horizontal_spacing
+
216 mw
->menu
.shadow_thickness
);
227 XMenu_xpos
+= FONT_WIDTH (f
->display
.x
->font
) * XINT (x
);
228 XMenu_ypos
+= FONT_HEIGHT (f
->display
.x
->font
) * XINT (y
);
232 XMenu_xpos
+= (f
->display
.x
->widget
->core
.x
233 + f
->display
.x
->widget
->core
.border_width
);
234 XMenu_ypos
+= (f
->display
.x
->widget
->core
.y
235 + f
->display
.x
->widget
->core
.border_width
236 + f
->display
.x
->menubar_widget
->core
.height
);
239 val
= set_menu_items (menu
, &prefixes
, &panes
, &names
,
240 &enables
, &menus
, &items
, &number_of_panes
, &obj_list
,
241 &title
, &error_name
);
242 selection
= xmenu_show (f
, val
, XMenu_xpos
, XMenu_ypos
,
245 free_menu_items (names
, enables
, menus
, items
, number_of_panes
, obj_list
,
248 if (selection
!= NUL
)
249 { /* selected something */
250 XMenu_return
= selection
;
253 { /* nothing selected */
259 #else /* not USE_X_TOOLKIT */
263 int win_x
= 0, win_y
= 0;
265 /* Find the position of the outside upper-left corner of
266 the inner window, with respect to the outer window. */
267 if (f
->display
.x
->parent_desc
!= ROOT_WINDOW
)
270 XTranslateCoordinates (x_current_display
,
272 /* From-window, to-window. */
273 f
->display
.x
->window_desc
,
274 f
->display
.x
->parent_desc
,
276 /* From-position, to-position. */
277 0, 0, &win_x
, &win_y
,
279 /* Child of window. */
286 #endif /* HAVE_X11 */
288 XMenu_xpos
+= FONT_WIDTH (f
->display
.x
->font
) * XINT (x
);
289 XMenu_ypos
+= FONT_HEIGHT (f
->display
.x
->font
) * XINT (y
);
291 XMenu_xpos
+= f
->display
.x
->left_pos
;
292 XMenu_ypos
+= f
->display
.x
->top_pos
;
295 keymap
= Fkeymapp (menu
);
297 if (XTYPE (menu
) == Lisp_Cons
)
298 tem
= Fkeymapp (Fcar (menu
));
301 /* We were given a keymap. Extract menu info from the keymap. */
303 keymap
= get_keymap (menu
);
305 /* Search for a string appearing directly as an element of the keymap.
306 That string is the title of the menu. */
307 prompt
= map_prompt (keymap
);
309 title
= (char *) XSTRING (prompt
)->data
;
311 /* Extract the detailed info to make one pane. */
312 number_of_panes
= keymap_panes (&obj_list
, &menus
, &names
, &enables
,
313 &items
, &prefixes
, &menu
, 1);
314 /* The menu title seems to be ignored,
315 so put it in the pane title. */
319 else if (!NILP (tem
))
321 /* We were given a list of keymaps. */
323 int nmaps
= XFASTINT (Flength (menu
));
325 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
329 /* The first keymap that has a prompt string
330 supplies the menu title. */
331 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
333 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
335 prompt
= map_prompt (keymap
);
336 if (title
== 0 && !NILP (prompt
))
337 title
= (char *) XSTRING (prompt
)->data
;
340 /* Extract the detailed info to make one pane. */
341 number_of_panes
= keymap_panes (&obj_list
, &menus
, &names
, &enables
,
342 &items
, &prefixes
, maps
, nmaps
);
343 /* The menu title seems to be ignored,
344 so put it in the pane title. */
350 /* We were given an old-fashioned menu. */
351 ltitle
= Fcar (menu
);
352 CHECK_STRING (ltitle
, 1);
353 title
= (char *) XSTRING (ltitle
)->data
;
355 number_of_panes
= list_of_panes (&obj_list
, &menus
, &names
, &enables
,
356 &items
, Fcdr (menu
));
359 fprintf (stderr
, "Panes = %d\n", number_of_panes
);
360 for (i
= 0; i
< number_of_panes
; i
++)
362 fprintf (stderr
, "Pane %d has lines %d title %s\n",
363 i
, items
[i
], menus
[i
]);
364 for (j
= 0; j
< items
[i
]; j
++)
365 fprintf (stderr
, " Item %d %s\n", j
, names
[i
][j
]);
374 unsigned int dummy_uint
;
377 /* Figure out which root window F is on. */
378 XGetGeometry (x_current_display
, FRAME_X_WINDOW (f
), &root
,
379 &dummy_int
, &dummy_int
, &dummy_uint
, &dummy_uint
,
380 &dummy_uint
, &dummy_uint
);
382 /* Translate the menu co-ordinates within f to menu co-ordinates
383 on that root window. */
384 if (! XTranslateCoordinates (x_current_display
,
385 FRAME_X_WINDOW (f
), root
,
386 XMenu_xpos
, XMenu_ypos
, &root_x
, &root_y
,
388 /* But XGetGeometry said root was the root window of f's screen! */
390 selection
= xmenu_show (root
, XMenu_xpos
, XMenu_ypos
, names
, enables
,
391 menus
, prefixes
, items
, number_of_panes
, obj_list
,
395 /* fprintf (stderr, "selection = %x\n", selection); */
396 if (selection
!= NUL
)
397 { /* selected something */
398 XMenu_return
= selection
;
401 { /* nothing selected */
404 /* now free up the strings */
405 for (i
= 0; i
< number_of_panes
; i
++)
417 if (error_name
) error (error_name
);
419 #endif /* not USE_X_TOOLKIT */
425 dispatch_dummy_expose (w
, x
, y
)
433 dummy
.window
= XtWindow (w
);
436 dummy
.send_event
= 0;
437 dummy
.display
= XtDisplay (w
);
441 XtDispatchEvent (&dummy
);
452 XTextExtents (mw
->menu
.font
, s
, strlen (s
), &drop
, &drop
, &drop
, &xcs
);
457 event_is_in_menu_item (mw
, event
, name
, string_w
)
459 struct input_event
*event
;
463 *string_w
+= string_width (mw
, name
)
464 + 2 * (mw
->menu
.horizontal_spacing
+ mw
->menu
.shadow_thickness
);
465 return (XINT (event
->x
) < *string_w
);
470 map_event_to_object (event
, f
)
471 struct input_event
*event
;
476 XlwMenuWidget mw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
481 /* Find the window */
482 for (val
= mw
->menu
.old_stack
[0]->contents
; val
; val
= val
->next
)
484 ws
= &mw
->menu
.windows
[0];
485 if (ws
&& event_is_in_menu_item (mw
, event
, val
->name
, &string_w
))
488 items
= FRAME_MENU_BAR_ITEMS (f
);
489 for (; CONSP (items
); items
= XCONS (items
)->cdr
)
490 if (!strcmp (val
->name
,
491 XSTRING (Fcar (Fcdr (Fcar (items
))))->data
))
498 static widget_value
*
499 set_menu_items (menu
, prefixes
, panes
, names
, enables
, menus
,
500 items
, number_of_panes
, obj_list
, title
, error_name
)
502 Lisp_Object
**prefixes
;
508 int *number_of_panes
;
509 Lisp_Object
***obj_list
;
513 Lisp_Object keymap
, tem
;
514 Lisp_Object ltitle
, selection
;
516 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
517 int last
, selidx
, lpane
, status
;
520 keymap
= Fkeymapp (menu
);
523 if (XTYPE (menu
) == Lisp_Cons
)
524 tem
= Fkeymapp (Fcar (menu
));
527 /* We were given a keymap. Extract menu info from the keymap. */
529 keymap
= get_keymap (menu
);
531 /* Search for a string appearing directly as an element of the keymap.
532 That string is the title of the menu. */
533 prompt
= map_prompt (keymap
);
535 *title
= (char *) XSTRING (prompt
)->data
;
537 /* Extract the detailed info to make one pane. */
538 *number_of_panes
= keymap_panes (obj_list
, menus
, names
, enables
,
539 items
, prefixes
, menu
, 1);
540 /* The menu title seems to be ignored,
541 so put it in the pane title. */
542 if ((*menus
)[0] == 0)
543 (*menus
)[0] = *title
;
545 else if (!NILP (tem
))
547 /* We were given a list of keymaps. */
549 int nmaps
= XFASTINT (Flength (menu
));
551 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
555 /* The first keymap that has a prompt string
556 supplies the menu title. */
557 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
559 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
561 prompt
= map_prompt (keymap
);
562 if (*title
== 0 && !NILP (prompt
))
563 *title
= (char *) XSTRING (prompt
)->data
;
566 /* Extract the detailed info to make one pane. */
567 *number_of_panes
= keymap_panes (obj_list
, menus
, names
, enables
,
568 items
, prefixes
, maps
, nmaps
);
569 /* The menu title seems to be ignored,
570 so put it in the pane title. */
571 if ((*menus
)[0] == 0)
572 (*menus
)[0] = *title
;
576 /* We were given an old-fashioned menu. */
577 ltitle
= Fcar (menu
);
578 CHECK_STRING (ltitle
, 1);
579 *title
= (char *) XSTRING (ltitle
)->data
;
581 *number_of_panes
= list_of_panes (obj_list
, menus
, names
, enables
,
586 if (*number_of_panes
== 0)
589 *error_name
= (char *) 0; /* Initialize error pointer to null */
591 wv
= malloc_widget_value ();
597 for (*panes
= 0, lines
= 0; *panes
< *number_of_panes
;
598 lines
+= (*items
)[*panes
], (*panes
)++)
600 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
601 /* datap = (char *) xmalloc (lines * sizeof (char));
602 datap_save = datap;*/
604 for (*panes
= 0, sofar
= 0; *panes
< *number_of_panes
;
605 sofar
+= (*items
)[*panes
], (*panes
)++)
607 if (strcmp((*menus
)[*panes
], ""))
609 wv
= malloc_widget_value ();
613 first_wv
->contents
= wv
;
614 wv
->name
= (*menus
)[*panes
];
621 for (selidx
= 0; selidx
< (*items
)[*panes
]; selidx
++)
623 wv
= malloc_widget_value ();
627 save_wv
->contents
= wv
;
628 wv
->name
= (*names
)[*panes
][selidx
];
630 selection
= (*obj_list
)[*panes
][selidx
];
633 selection
= Fcons (selection
, Qnil
);
634 if (!NILP ((*prefixes
)[*panes
]))
635 selection
= Fcons ((*prefixes
)[*panes
], selection
);
637 wv
->call_data
= LISP_TO_VOID(selection
);
638 wv
->enabled
= (*enables
)[*panes
][selidx
];
647 free_menu_items (names
, enables
, menus
, items
, number_of_panes
,
648 obj_list
, title
, error_name
)
654 Lisp_Object
**obj_list
;
659 /* now free up the strings */
660 for (i
= 0; i
< number_of_panes
; i
++)
672 if (error_name
) error (error_name
);
676 static Lisp_Object menu_item_selection
;
679 popup_selection_callback (widget
, id
, client_data
)
682 XtPointer client_data
;
684 VOID_TO_LISP (menu_item_selection
, client_data
);
688 popup_down_callback (widget
, id
, client_data
)
691 XtPointer client_data
;
694 lw_destroy_all_widgets (id
);
698 /* This recursively calls free_widget_value() on the tree of widgets.
699 It must free all data that was malloc'ed for these widget_values.
700 Currently, emacs only allocates new storage for the `key' slot.
701 All other slots are pointers into the data of Lisp_Strings, and
705 free_menubar_widget_value_tree (wv
)
709 if (wv
->key
) xfree (wv
->key
);
711 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
713 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
715 free_menubar_widget_value_tree (wv
->contents
);
716 wv
->contents
= (widget_value
*) 0xDEADBEEF;
720 free_menubar_widget_value_tree (wv
->next
);
721 wv
->next
= (widget_value
*) 0xDEADBEEF;
724 free_widget_value (wv
);
729 update_one_frame_psheets (f
)
732 struct x_display
*x
= f
->display
.x
;
736 menubar_changed
= (x
->menubar_widget
737 && !XtIsManaged (x
->menubar_widget
));
739 if (! (menubar_changed
))
743 XawPanedSetRefigureMode (x
->column_widget
, 0);
745 /* the order in which children are managed is the top to
746 bottom order in which they are displayed in the paned window.
747 First, remove the text-area widget.
749 XtUnmanageChild (x
->edit_widget
);
751 /* remove the menubar that is there now, and put up the menubar that
756 XtManageChild (x
->menubar_widget
);
757 XtMapWidget (x
->menubar_widget
);
758 XtVaSetValues (x
->menubar_widget
, XtNmappedWhenManaged
, 1, 0);
762 /* Re-manage the text-area widget */
763 XtManageChild (x
->edit_widget
);
765 /* and now thrash the sizes */
766 XawPanedSetRefigureMode (x
->column_widget
, 1);
771 set_frame_menubar (f
)
774 Widget menubar_widget
= f
->display
.x
->menubar_widget
;
777 widget_value
*wv
, *save_wv
, *first_wv
, *prev_wv
= 0;
781 wv
= malloc_widget_value ();
782 wv
->name
= "menubar";
785 save_wv
= first_wv
= wv
;
788 for (tail
= FRAME_MENU_BAR_ITEMS (f
); CONSP (tail
); tail
= XCONS (tail
)->cdr
)
792 string
= Fcar (Fcdr (Fcar (tail
)));
794 wv
= malloc_widget_value ();
798 save_wv
->contents
= wv
;
799 wv
->name
= XSTRING (string
)->data
;
806 lw_modify_all_widgets (id
, first_wv
, False
);
809 menubar_widget
= lw_create_widget ("menubar", "menubar",
811 f
->display
.x
->column_widget
,
814 f
->display
.x
->menubar_widget
= menubar_widget
;
815 XtVaSetValues (menubar_widget
,
817 XtNresizeToPreferred
, 1,
822 free_menubar_widget_value_tree (first_wv
);
824 update_one_frame_psheets (f
);
830 free_frame_menubar (f
)
833 Widget menubar_widget
;
836 menubar_widget
= f
->display
.x
->menubar_widget
;
842 lw_destroy_all_widgets (id
);
846 #endif /* USE_X_TOOLKIT */
853 extern void process_expose_from_menu ();
856 extern XtAppContext Xt_app_con
;
859 xmenu_show (f
, val
, x
, y
, menubarp
, vw
)
867 int menu_id
, item_length
;
868 Lisp_Object selection
;
870 XlwMenuWidget menuw
= (XlwMenuWidget
) f
->display
.x
->menubar_widget
;
873 * Define and allocate a foreign event queue to hold events
874 * that don't belong to XMenu. These events are later restored
875 * to the X event queue.
877 typedef struct _xmeventque
880 struct _xmeventque
*next
;
883 XMEventQue
*feq
= NULL
; /* Foreign event queue. */
884 XMEventQue
*feq_tmp
; /* Foreign event queue temporary. */
887 if (val
== 0) return Qnil
;
889 menu_id
= ++popup_id_tick
;
890 menu
= lw_create_widget ("popup", val
->name
, menu_id
, val
,
891 f
->display
.x
->widget
, 1, 0,
892 popup_selection_callback
, popup_down_callback
);
893 free_menubar_widget_value_tree (val
);
895 /* reset the selection */
896 menu_item_selection
= Qnil
;
899 XButtonPressedEvent dummy
;
902 mw
= ((XlwMenuWidget
)
903 ((CompositeWidget
)menu
)->composite
.children
[0]);
905 dummy
.type
= ButtonPress
;
907 dummy
.send_event
= 0;
908 dummy
.display
= XtDisplay (menu
);
909 dummy
.window
= XtWindow (XtParent (menu
));
910 dummy
.time
= CurrentTime
;
917 vw
->call_data
= (XtPointer
) 1;
918 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
922 /* We activate directly the lucid implementation */
923 pop_up_menu (mw
, &dummy
);
928 item_length
= (x
+ string_width (menuw
, vw
->name
)
929 + (2 * (menuw
->menu
.horizontal_spacing
930 + menuw
->menu
.shadow_thickness
))
934 /* Enters XEvent loop */
939 XtAppNextEvent (Xt_app_con
, &event
);
940 if (event
.type
== ButtonRelease
)
942 XtDispatchEvent (&event
);
946 if (event
.type
== Expose
)
947 process_expose_from_menu (event
);
949 if (event
.type
== MotionNotify
951 && ((event
.xmotion
.y_root
952 >= (f
->display
.x
->widget
->core
.y
953 + f
->display
.x
->widget
->core
.border_width
))
954 && (event
.xmotion
.y_root
955 < (f
->display
.x
->widget
->core
.y
956 + f
->display
.x
->widget
->core
.border_width
957 + f
->display
.x
->menubar_widget
->core
.height
)))
958 && ((event
.xmotion
.x_root
959 >= (f
->display
.x
->widget
->core
.x
960 + f
->display
.x
->widget
->core
.border_width
))
961 && (event
.xmotion
.x_root
962 < (f
->display
.x
->widget
->core
.x
963 + f
->display
.x
->widget
->core
.border_width
964 + f
->display
.x
->widget
->core
.width
)))
965 && (event
.xmotion
.x_root
>= item_length
966 || event
.xmotion
.x_root
< (x
- 4)))
969 XtUngrabPointer ((Widget
)
971 ((CompositeWidget
)menu
)->composite
.children
[0]),
973 lw_destroy_all_widgets (menu_id
);
976 event
.type
= ButtonPress
;
977 event
.xbutton
.time
= CurrentTime
;
978 event
.xbutton
.button
= Button1
;
979 event
.xbutton
.window
= XtWindow (f
->display
.x
->menubar_widget
);
980 event
.xbutton
.x
= (event
.xbutton
.x_root
981 - (f
->display
.x
->widget
->core
.x
982 + f
->display
.x
->widget
->core
.border_width
));
983 XPutBackEvent (XDISPLAY
&event
);
987 XtDispatchEvent (&event
);
988 feq_tmp
= (XMEventQue
*) malloc (sizeof (XMEventQue
));
993 feq_tmp
->event
= event
;
1000 vw
->call_data
= (XtPointer
) 0;
1001 dispatch_dummy_expose (f
->display
.x
->menubar_widget
, x
, y
);
1004 /* Return any foreign events that were queued to the X event queue. */
1008 XPutBackEvent (XDISPLAY
&feq_tmp
->event
);
1009 feq
= feq_tmp
->next
;
1010 free ((char *)feq_tmp
);
1015 return menu_item_selection
;
1018 #else /* not USE_X_TOOLKIT */
1019 xmenu_show (parent
, startx
, starty
, line_list
, enable_list
, pane_list
,
1020 prefixes
, line_cnt
, pane_cnt
, item_list
, title
, error
)
1022 int startx
, starty
; /* upper left corner position BROKEN */
1023 char **line_list
[]; /* list of strings for items */
1024 int *enable_list
[]; /* enable flags of lines */
1025 char *pane_list
[]; /* list of pane titles */
1026 Lisp_Object
*prefixes
; /* Prefix key for each pane */
1028 int pane_cnt
; /* total number of panes */
1029 Lisp_Object
*item_list
[]; /* All items */
1030 int line_cnt
[]; /* Lines in each pane */
1031 char **error
; /* Error returned */
1034 int last
, panes
, selidx
, lpane
, status
;
1037 /* struct indices *datap, *datap_save; */
1039 int ulx
, uly
, width
, height
;
1040 int dispwidth
, dispheight
;
1047 *error
= (char *) 0; /* Initialize error pointer to null */
1049 GXMenu
= XMenuCreate (XDISPLAY parent
, "emacs");
1052 *error
= "Can't create menu";
1057 for (panes
= 0, lines
= 0; panes
< pane_cnt
;
1058 lines
+= line_cnt
[panes
], panes
++)
1060 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
1061 /* datap = (char *) xmalloc (lines * sizeof (char));
1062 datap_save = datap;*/
1064 for (panes
= 0, sofar
= 0; panes
< pane_cnt
;
1065 sofar
+= line_cnt
[panes
], panes
++)
1067 /* create all the necessary panes */
1068 lpane
= XMenuAddPane (XDISPLAY GXMenu
, pane_list
[panes
], TRUE
);
1069 if (lpane
== XM_FAILURE
)
1071 XMenuDestroy (XDISPLAY GXMenu
);
1072 *error
= "Can't create pane";
1077 for (selidx
= 0; selidx
< line_cnt
[panes
]; selidx
++)
1079 /* add the selection stuff to the menus */
1080 /* datap[selidx+sofar].pane = panes;
1081 datap[selidx+sofar].line = selidx; */
1082 if (XMenuAddSelection (XDISPLAY GXMenu
, lpane
, 0,
1083 line_list
[panes
][selidx
],
1084 enable_list
[panes
][selidx
])
1087 XMenuDestroy (XDISPLAY GXMenu
);
1089 *error
= "Can't add selection to menu";
1090 /* error ("Can't add selection to menu"); */
1096 /* all set and ready to fly */
1097 XMenuRecompute (XDISPLAY GXMenu
);
1098 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
1099 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
1100 startx
= min (startx
, dispwidth
);
1101 starty
= min (starty
, dispheight
);
1102 startx
= max (startx
, 1);
1103 starty
= max (starty
, 1);
1104 XMenuLocate (XDISPLAY GXMenu
, 0, 0, startx
, starty
,
1105 &ulx
, &uly
, &width
, &height
);
1106 if (ulx
+width
> dispwidth
)
1108 startx
-= (ulx
+ width
) - dispwidth
;
1109 ulx
= dispwidth
- width
;
1111 if (uly
+height
> dispheight
)
1113 starty
-= (uly
+ height
) - dispheight
;
1114 uly
= dispheight
- height
;
1116 if (ulx
< 0) startx
-= ulx
;
1117 if (uly
< 0) starty
-= uly
;
1119 XMenuSetFreeze (GXMenu
, TRUE
);
1122 status
= XMenuActivate (XDISPLAY GXMenu
, &panes
, &selidx
,
1123 startx
, starty
, ButtonReleaseMask
, &datap
);
1128 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
1130 entry
= item_list
[panes
][selidx
];
1133 entry
= Fcons (entry
, Qnil
);
1134 if (!NILP (prefixes
[panes
]))
1135 entry
= Fcons (prefixes
[panes
], entry
);
1139 /* free (datap_save); */
1140 XMenuDestroy (XDISPLAY GXMenu
);
1141 *error
= "Can't activate menu";
1142 /* error ("Can't activate menu"); */
1148 XMenuDestroy (XDISPLAY GXMenu
);
1150 /* free (datap_save);*/
1153 #endif /* not USE_X_TOOLKIT */
1157 popup_id_tick
= (1<<16);
1158 defsubr (&Sx_popup_menu
);
1161 /* Figure out the current keyboard equivalent of a menu item ITEM1.
1162 Store the equivalent key sequence in *SAVEDKEY_PTR
1163 and the textual description (to use in the menu display) in *DESCRIP_PTR.
1164 Also cache them in the item itself.
1165 Return the real definition to execute. */
1168 menu_item_equiv_key (item1
, savedkey_ptr
, descrip_ptr
)
1170 Lisp_Object
*savedkey_ptr
, *descrip_ptr
;
1172 /* This is what is left after the menu item name. */
1173 Lisp_Object overdef
;
1174 /* This is the real definition--the function to run. */
1176 /* These are the saved equivalent keyboard key sequence
1177 and its key-description. */
1178 Lisp_Object savedkey
, descrip
;
1182 overdef
= def
= Fcdr (item1
);
1184 /* Get out the saved equivalent-keyboard-key info. */
1185 savedkey
= descrip
= Qnil
;
1186 if (CONSP (overdef
) && VECTORP (XCONS (overdef
)->car
))
1188 savedkey
= XCONS (overdef
)->car
;
1189 def
= XCONS (def
)->cdr
;
1190 if (CONSP (def
) && STRINGP (XCONS (def
)->car
))
1192 descrip
= XCONS (def
)->car
;
1193 def
= XCONS (def
)->cdr
;
1197 /* Is it still valid? */
1199 if (!NILP (savedkey
))
1200 def1
= Fkey_binding (savedkey
, Qnil
);
1201 /* If not, update it. */
1202 if (! EQ (def1
, def
))
1206 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
1207 if (VECTORP (savedkey
)
1208 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
1210 if (!NILP (savedkey
))
1212 descrip
= Fkey_description (savedkey
);
1213 descrip
= concat2 (make_string (" (", 3), descrip
);
1214 descrip
= concat2 (descrip
, make_string (")", 1));
1218 /* Store back the recorded keyboard key sequence
1219 if we changed it. */
1220 if (!NILP (savedkey
)
1221 && CONSP (overdef
) && VECTORP (XCONS (overdef
)->car
))
1225 XCONS (overdef
)->car
= savedkey
;
1226 def1
= XCONS (overdef
)->cdr
;
1227 if (CONSP (def1
) && STRINGP (XCONS (def1
)->car
))
1228 XCONS (def1
)->car
= descrip
;
1231 /* If we had none but need one now, add it. */
1232 else if (!NILP (savedkey
))
1234 = overdef
= Fcons (savedkey
, Fcons (descrip
, def
));
1235 /* If we had one but no longer should have one, delete it. */
1236 else if (CONSP (overdef
) && VECTORP (XCONS (overdef
)->car
))
1238 XCONS (item1
)->cdr
= overdef
= XCONS (overdef
)->cdr
;
1239 if (CONSP (overdef
) && STRINGP (XCONS (overdef
)->car
))
1240 XCONS (item1
)->cdr
= overdef
= XCONS (overdef
)->cdr
;
1243 *savedkey_ptr
= savedkey
;
1244 *descrip_ptr
= descrip
;
1248 /* Construct the vectors that describe a menu
1249 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
1250 Each of those four values is a vector indexed by pane number.
1251 Return the number of panes.
1253 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */
1256 keymap_panes (vector
, panes
, names
, enables
, items
, prefixes
, keymaps
, nmaps
)
1257 Lisp_Object
***vector
; /* RETURN all menu objects */
1258 char ***panes
; /* RETURN pane names */
1259 char ****names
; /* RETURN all line names */
1260 int ***enables
; /* RETURN enable-flags of lines */
1261 int **items
; /* RETURN number of items per pane */
1262 Lisp_Object
**prefixes
; /* RETURN vector of prefix keys, per pane */
1263 Lisp_Object
*keymaps
;
1266 /* Number of panes we have made. */
1268 /* Number of panes we have space for. */
1269 int npanes_allocated
= nmaps
;
1272 if (npanes_allocated
< 4)
1273 npanes_allocated
= 4;
1275 /* Make space for an estimated number of panes. */
1276 *vector
= (Lisp_Object
**) xmalloc (npanes_allocated
* sizeof (Lisp_Object
*));
1277 *panes
= (char **) xmalloc (npanes_allocated
* sizeof (char *));
1278 *items
= (int *) xmalloc (npanes_allocated
* sizeof (int));
1279 *names
= (char ***) xmalloc (npanes_allocated
* sizeof (char **));
1280 *enables
= (int **) xmalloc (npanes_allocated
* sizeof (int *));
1281 *prefixes
= (Lisp_Object
*) xmalloc (npanes_allocated
* sizeof (Lisp_Object
));
1283 /* Loop over the given keymaps, making a pane for each map.
1284 But don't make a pane that is empty--ignore that map instead.
1285 P is the number of panes we have made so far. */
1286 for (mapno
= 0; mapno
< nmaps
; mapno
++)
1287 single_keymap_panes (keymaps
[mapno
], panes
, vector
, names
, enables
, items
,
1288 prefixes
, &p
, &npanes_allocated
, "");
1290 /* Return the number of panes. */
1294 /* This is used as the handler when calling internal_condition_case_1. */
1297 single_keymap_panes_1 (arg
)
1303 /* This is a recursive subroutine of keymap_panes.
1304 It handles one keymap, KEYMAP.
1305 The other arguments are passed along
1306 or point to local variables of the previous function. */
1308 single_keymap_panes (keymap
, panes
, vector
, names
, enables
, items
, prefixes
,
1309 p_ptr
, npanes_allocated_ptr
, pane_name
)
1311 Lisp_Object
***vector
; /* RETURN all menu objects */
1312 char ***panes
; /* RETURN pane names */
1313 char ****names
; /* RETURN all line names */
1314 int ***enables
; /* RETURN enable flags of lines */
1315 int **items
; /* RETURN number of items per pane */
1316 Lisp_Object
**prefixes
; /* RETURN vector of prefix keys, per pane */
1318 int *npanes_allocated_ptr
;
1322 Lisp_Object pending_maps
;
1323 Lisp_Object tail
, item
, item1
, item_string
, table
;
1324 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1326 pending_maps
= Qnil
;
1328 /* Make sure we have room for another pane. */
1329 if (*p_ptr
== *npanes_allocated_ptr
)
1331 *npanes_allocated_ptr
*= 2;
1334 = (Lisp_Object
**) xrealloc (*vector
,
1335 *npanes_allocated_ptr
* sizeof (Lisp_Object
*));
1337 = (char **) xrealloc (*panes
,
1338 *npanes_allocated_ptr
* sizeof (char *));
1340 = (int *) xrealloc (*items
,
1341 *npanes_allocated_ptr
* sizeof (int));
1343 = (Lisp_Object
*) xrealloc (*prefixes
,
1344 (*npanes_allocated_ptr
1345 * sizeof (Lisp_Object
)));
1347 = (char ***) xrealloc (*names
,
1348 *npanes_allocated_ptr
* sizeof (char **));
1350 = (int **) xrealloc (*enables
,
1351 *npanes_allocated_ptr
* sizeof (int *));
1354 /* When a menu comes from keymaps, don't give names to the panes. */
1355 (*panes
)[*p_ptr
] = pane_name
;
1357 /* Normally put nil as pane's prefix key.
1358 Caller will override this if appropriate. */
1359 (*prefixes
)[*p_ptr
] = Qnil
;
1361 /* Get the length of the list level of the keymap. */
1362 i
= XFASTINT (Flength (keymap
));
1364 /* Add in lengths of any arrays. */
1365 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
1366 if (XTYPE (XCONS (tail
)->car
) == Lisp_Vector
)
1367 i
+= XVECTOR (XCONS (tail
)->car
)->size
;
1369 /* Create vectors for the names and values of the items in the pane.
1370 I is an upper bound for the number of items. */
1371 (*vector
)[*p_ptr
] = (Lisp_Object
*) xmalloc (i
* sizeof (Lisp_Object
));
1372 (*names
)[*p_ptr
] = (char **) xmalloc (i
* sizeof (char *));
1373 (*enables
)[*p_ptr
] = (int *) xmalloc (i
* sizeof (int));
1375 /* I is now the index of the next unused slots. */
1377 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
1379 /* Look at each key binding, and if it has a menu string,
1380 make a menu item from it. */
1381 item
= XCONS (tail
)->car
;
1382 if (XTYPE (item
) == Lisp_Cons
)
1384 item1
= XCONS (item
)->cdr
;
1385 if (XTYPE (item1
) == Lisp_Cons
)
1387 item_string
= XCONS (item1
)->car
;
1388 if (XTYPE (item_string
) == Lisp_String
)
1390 /* This is the real definition--the function to run. */
1392 /* These are the saved equivalent keyboard key sequence
1393 and its key-description. */
1394 Lisp_Object savedkey
, descrip
;
1395 Lisp_Object tem
, enabled
;
1397 /* If a help string follows the item string,
1399 if (CONSP (XCONS (item1
)->cdr
)
1400 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
1401 item1
= XCONS (item1
)->cdr
;
1403 def
= menu_item_equiv_key (item1
, &savedkey
, &descrip
);
1406 if (XTYPE (def
) == Lisp_Symbol
)
1408 /* No property, or nil, means enable.
1409 Otherwise, enable if value is not nil. */
1410 tem
= Fget (def
, Qmenu_enable
);
1411 /* GCPRO because we will call eval.
1412 Protecting KEYMAP preserves everything we use;
1413 aside from that, must protect whatever might be
1415 GCPRO3 (keymap
, def
, descrip
, item_string
);
1417 /* (condition-case nil (eval tem)
1419 enabled
= internal_condition_case_1 (Feval
, tem
,
1421 single_keymap_panes_1
);
1424 tem
= Fkeymapp (def
);
1425 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
1426 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, XCONS (item
)->car
)),
1431 if (!NILP (descrip
))
1432 concat
= concat2 (item_string
, descrip
);
1434 concat
= item_string
;
1435 (*names
)[*p_ptr
][i
] = (char *) XSTRING (concat
)->data
;
1436 /* The menu item "value" is the key bound here. */
1437 (*vector
)[*p_ptr
][i
] = XCONS (item
)->car
;
1438 (*enables
)[*p_ptr
][i
]
1439 = (NILP (def
) ? -1 : !NILP (enabled
) ? 1 : 0);
1445 else if (XTYPE (item
) == Lisp_Vector
)
1447 /* Loop over the char values represented in the vector. */
1448 int len
= XVECTOR (item
)->size
;
1450 for (c
= 0; c
< len
; c
++)
1452 Lisp_Object character
;
1453 XFASTINT (character
) = c
;
1454 item1
= XVECTOR (item
)->contents
[c
];
1455 if (XTYPE (item1
) == Lisp_Cons
)
1457 item_string
= XCONS (item1
)->car
;
1458 if (XTYPE (item_string
) == Lisp_String
)
1462 /* These are the saved equivalent keyboard key sequence
1463 and its key-description. */
1464 Lisp_Object savedkey
, descrip
;
1465 Lisp_Object tem
, enabled
;
1467 /* If a help string follows the item string,
1469 if (CONSP (XCONS (item1
)->cdr
)
1470 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
1471 item1
= XCONS (item1
)->cdr
;
1473 def
= menu_item_equiv_key (item1
, &savedkey
, &descrip
);
1476 if (XTYPE (def
) == Lisp_Symbol
)
1478 tem
= Fget (def
, Qmenu_enable
);
1479 /* GCPRO because we will call eval.
1480 Protecting KEYMAP preserves everything we use;
1481 aside from that, must protect whatever might be
1483 GCPRO3 (keymap
, def
, descrip
, item_string
);
1484 /* No property, or nil, means enable.
1485 Otherwise, enable if value is not nil. */
1487 /* (condition-case nil (eval tem)
1489 enabled
= internal_condition_case_1 (Feval
, tem
,
1491 single_keymap_panes_1
);
1495 tem
= Fkeymapp (def
);
1496 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
1497 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
1502 if (!NILP (descrip
))
1503 concat
= concat2 (item_string
, descrip
);
1505 concat
= item_string
;
1507 = (char *) XSTRING (concat
)->data
;
1508 /* The menu item "value" is the key bound here. */
1509 (*vector
)[*p_ptr
][i
] = character
;
1510 (*enables
)[*p_ptr
][i
]
1511 = (NILP (def
) ? -1 : !NILP (enabled
) ? 1 : 0);
1519 /* Record the number of items in the pane. */
1520 (*items
)[*p_ptr
] = i
;
1522 /* If we just made an empty pane, get rid of it. */
1525 xfree ((*vector
)[*p_ptr
]);
1526 xfree ((*names
)[*p_ptr
]);
1527 xfree ((*enables
)[*p_ptr
]);
1529 /* Otherwise, advance past it. */
1533 /* Process now any submenus which want to be panes at this level. */
1534 while (!NILP (pending_maps
))
1536 Lisp_Object elt
, eltcdr
;
1537 int panenum
= *p_ptr
;
1538 elt
= Fcar (pending_maps
);
1539 eltcdr
= XCONS (elt
)->cdr
;
1540 single_keymap_panes (Fcar (elt
), panes
, vector
, names
, enables
, items
,
1541 prefixes
, p_ptr
, npanes_allocated_ptr
,
1542 /* Add 1 to discard the @. */
1543 (char *) XSTRING (XCONS (eltcdr
)->car
)->data
+ 1);
1544 (*prefixes
)[panenum
] = XCONS (eltcdr
)->cdr
;
1545 pending_maps
= Fcdr (pending_maps
);
1549 /* Construct the vectors that describe a menu
1550 and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
1551 Each of those four values is a vector indexed by pane number.
1552 Return the number of panes.
1554 MENU is the argument that was given to Fx_popup_menu. */
1557 list_of_panes (vector
, panes
, names
, enables
, items
, menu
)
1558 Lisp_Object
***vector
; /* RETURN all menu objects */
1559 char ***panes
; /* RETURN pane names */
1560 char ****names
; /* RETURN all line names */
1561 int ***enables
; /* RETURN enable flags of lines */
1562 int **items
; /* RETURN number of items per pane */
1565 Lisp_Object tail
, item
, item1
;
1568 if (XTYPE (menu
) != Lisp_Cons
) menu
= wrong_type_argument (Qlistp
, menu
);
1570 i
= XFASTINT (Flength (menu
));
1572 *vector
= (Lisp_Object
**) xmalloc (i
* sizeof (Lisp_Object
*));
1573 *panes
= (char **) xmalloc (i
* sizeof (char *));
1574 *items
= (int *) xmalloc (i
* sizeof (int));
1575 *names
= (char ***) xmalloc (i
* sizeof (char **));
1576 *enables
= (int **) xmalloc (i
* sizeof (int *));
1578 for (i
= 0, tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
), i
++)
1580 item
= Fcdr (Fcar (tail
));
1581 if (XTYPE (item
) != Lisp_Cons
) (void) wrong_type_argument (Qlistp
, item
);
1583 fprintf (stderr
, "list_of_panes check tail, i=%d\n", i
);
1585 item1
= Fcar (Fcar (tail
));
1586 CHECK_STRING (item1
, 1);
1588 fprintf (stderr
, "list_of_panes check pane, i=%d%s\n", i
,
1589 XSTRING (item1
)->data
);
1591 (*panes
)[i
] = (char *) XSTRING (item1
)->data
;
1592 (*items
)[i
] = list_of_items ((*vector
)+i
, (*names
)+i
, (*enables
)+i
, item
);
1593 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
1594 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
1600 /* Construct the lists of values and names for a single pane, from the
1601 alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags
1602 int *ENABLES. Return the number of items. */
1605 list_of_items (vector
, names
, enables
, pane
)
1606 Lisp_Object
**vector
; /* RETURN menu "objects" */
1607 char ***names
; /* RETURN line names */
1608 int **enables
; /* RETURN enable flags of lines */
1611 Lisp_Object tail
, item
, item1
;
1614 if (XTYPE (pane
) != Lisp_Cons
) pane
= wrong_type_argument (Qlistp
, pane
);
1616 i
= XFASTINT (Flength (pane
));
1618 *vector
= (Lisp_Object
*) xmalloc (i
* sizeof (Lisp_Object
));
1619 *names
= (char **) xmalloc (i
* sizeof (char *));
1620 *enables
= (int *) xmalloc (i
* sizeof (int));
1622 for (i
= 0, tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
), i
++)
1627 (*vector
)[i
] = Qnil
;
1628 (*names
)[i
] = (char *) XSTRING (item
)->data
;
1633 CHECK_CONS (item
, 0);
1634 (*vector
)[i
] = Fcdr (item
);
1635 item1
= Fcar (item
);
1636 CHECK_STRING (item1
, 1);
1637 (*names
)[i
] = (char *) XSTRING (item1
)->data
;