Mercurial > emacs
view src/xmenu.c @ 5843:d01185037467
(batch-update-autoloads): Add missing close paren.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Tue, 08 Feb 1994 04:53:09 +0000 |
parents | 1493700a3d78 |
children | 8dc616f310e8 |
line wrap: on
line source
/* X Communication module for terminals which understand the X protocol. Copyright (C) 1986, 1988, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* X pop-up deck-of-cards menu facility for gnuemacs. * * Written by Jon Arnold and Roman Budzianowski * Mods and rewrite by Robert Krawitz * */ /* Modified by Fred Pierresteguy on December 93 to make the popup menus and menubar use the Xt. */ #include <stdio.h> /* On 4.3 this loses if it comes after xterm.h. */ #include <signal.h> #include <config.h> #include "lisp.h" #include "termhooks.h" #include "frame.h" #include "window.h" #include "keyboard.h" #include "blockinput.h" /* This may include sys/types.h, and that somehow loses if this is not done before the other system files. */ #include "xterm.h" /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev #include <sys/types.h> #endif #include "dispextern.h" #ifdef HAVE_X11 #include "../oldXMenu/XMenu.h" #else #include <X/XMenu.h> #endif #ifdef USE_X_TOOLKIT #include <X11/Xlib.h> #include <X11/IntrinsicP.h> #include <X11/CoreP.h> #include <X11/StringDefs.h> #include <X11/Xaw/Paned.h> #include "../lwlib/lwlib.h" #include "../lwlib/xlwmenuP.h" #endif /* USE_X_TOOLKIT */ #define min(x,y) (((x) < (y)) ? (x) : (y)) #define max(x,y) (((x) > (y)) ? (x) : (y)) #define NUL 0 #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif /* TRUE */ #ifdef HAVE_X11 extern Display *x_current_display; #else #define ButtonReleaseMask ButtonReleased #endif /* not HAVE_X11 */ extern Lisp_Object Qmenu_enable; extern Lisp_Object Qmenu_bar; Lisp_Object xmenu_show (); extern int x_error_handler (); #ifdef USE_X_TOOLKIT static widget_value *set_menu_items (); static int string_width (); static void free_menu_items (); #endif /* we need a unique id for each popup menu and dialog box */ unsigned int popup_id_tick; /*************************************************************/ #if 0 /* Ignoring the args is easiest. */ xmenu_quit () { error ("Unknown XMenu error"); } #endif DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0, "Pop up a deck-of-cards menu and return user's selection.\n\ POSITION is a position specification. This is either a mouse button event\n\ or a list ((XOFFSET YOFFSET) WINDOW)\n\ where XOFFSET and YOFFSET are positions in characters from the top left\n\ corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ This controls the position of the center of the first line\n\ in the first pane of the menu, not the top left of the menu as a whole.\n\ \n\ MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ The menu items come from key bindings that have a menu string as well as\n\ a definition; actually, the \"definition\" in such a key binding looks like\n\ \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ the keymap as a top-level element.\n\n\ You can also use a list of keymaps as MENU.\n\ Then each keymap makes a separate pane.\n\ When MENU is a keymap or a list of keymaps, the return value\n\ is a list of events.\n\n\ Alternatively, you can specify a menu of multiple panes\n\ with a list of the form (TITLE PANE1 PANE2...),\n\ where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ Each ITEM is normally a cons cell (STRING . VALUE);\n\ but a string can appear as an item--that makes a nonselectable line\n\ in the menu.\n\ With this form of menu, the return value is VALUE from the chosen item.") (position, menu) Lisp_Object position, menu; { int number_of_panes, panes; Lisp_Object XMenu_return, keymap, tem; int XMenu_xpos, XMenu_ypos; char **menus; char ***names; int **enables; Lisp_Object **obj_list; Lisp_Object *prefixes; int *items; char *title; char *error_name; Lisp_Object ltitle, selection; int i, j, menubarp = 0; FRAME_PTR f; Lisp_Object x, y, window; #ifdef USE_X_TOOLKIT widget_value *val, *vw = 0; #endif /* USE_X_TOOLKIT */ /* Decode the first argument: find the window and the coordinates. */ tem = Fcar (position); if (XTYPE (tem) == Lisp_Cons) { window = Fcar (Fcdr (position)); x = Fcar (tem); y = Fcar (Fcdr (tem)); } else { tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); y = Fcdr (tem); } CHECK_NUMBER (x, 0); CHECK_NUMBER (y, 0); if (XTYPE (window) == Lisp_Frame) { f = XFRAME (window); XMenu_xpos = 0; XMenu_ypos = 0; } else if (XTYPE (window) == Lisp_Window) { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); XMenu_xpos = FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left; XMenu_ypos = FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top; } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); #ifdef USE_X_TOOLKIT tem = Fcar (Fcdr (Fcar (Fcdr (position)))); if (XTYPE (Fcar (position)) != Lisp_Cons && CONSP (tem) && EQ (Fcar (tem), Qmenu_bar)) { /* We are in the menubar */ XlwMenuWidget mw; int w1 = 0, w2; mw = (XlwMenuWidget)f->display.x->menubar_widget; menubarp = 1; for (vw = mw->menu.old_stack [0]->contents; vw; vw = vw->next) { w2 = w1; w1 += string_width (mw, vw->name) + 2 * (mw->menu.horizontal_spacing + mw->menu.shadow_thickness); if (XINT (x) < w1) { XMenu_xpos = w2 + 4; XMenu_ypos = 0; break; } } } else { XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); } BLOCK_INPUT; XMenu_xpos += (f->display.x->widget->core.x + f->display.x->widget->core.border_width); XMenu_ypos += (f->display.x->widget->core.y + f->display.x->widget->core.border_width + f->display.x->menubar_widget->core.height); UNBLOCK_INPUT; val = set_menu_items (menu, &prefixes, &panes, &names, &enables, &menus, &items, &number_of_panes, &obj_list, &title, &error_name); selection = xmenu_show (f, val, XMenu_xpos, XMenu_ypos, menubarp, vw); free_menu_items (names, enables, menus, items, number_of_panes, obj_list, title, error_name); if (selection != NUL) { /* selected something */ XMenu_return = selection; } else { /* nothing selected */ XMenu_return = Qnil; } return XMenu_return; #else /* not USE_X_TOOLKIT */ #ifdef HAVE_X11 { Window child; int win_x = 0, win_y = 0; /* Find the position of the outside upper-left corner of the inner window, with respect to the outer window. */ if (f->display.x->parent_desc != ROOT_WINDOW) { BLOCK_INPUT; XTranslateCoordinates (x_current_display, /* From-window, to-window. */ f->display.x->window_desc, f->display.x->parent_desc, /* From-position, to-position. */ 0, 0, &win_x, &win_y, /* Child of window. */ &child); UNBLOCK_INPUT; XMenu_xpos += win_x; XMenu_ypos += win_y; } } #endif /* HAVE_X11 */ XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); XMenu_xpos += f->display.x->left_pos; XMenu_ypos += f->display.x->top_pos; keymap = Fkeymapp (menu); tem = Qnil; if (XTYPE (menu) == Lisp_Cons) tem = Fkeymapp (Fcar (menu)); if (!NILP (keymap)) { /* We were given a keymap. Extract menu info from the keymap. */ Lisp_Object prompt; keymap = get_keymap (menu); /* Search for a string appearing directly as an element of the keymap. That string is the title of the menu. */ prompt = map_prompt (keymap); if (!NILP (prompt)) title = (char *) XSTRING (prompt)->data; /* Extract the detailed info to make one pane. */ number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, &items, &prefixes, &menu, 1); /* The menu title seems to be ignored, so put it in the pane title. */ if (menus[0] == 0) menus[0] = title; } else if (!NILP (tem)) { /* We were given a list of keymaps. */ Lisp_Object prompt; int nmaps = XFASTINT (Flength (menu)); Lisp_Object *maps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); int i; title = 0; /* The first keymap that has a prompt string supplies the menu title. */ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) { maps[i++] = keymap = get_keymap (Fcar (tem)); prompt = map_prompt (keymap); if (title == 0 && !NILP (prompt)) title = (char *) XSTRING (prompt)->data; } /* Extract the detailed info to make one pane. */ number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, &items, &prefixes, maps, nmaps); /* The menu title seems to be ignored, so put it in the pane title. */ if (menus[0] == 0) menus[0] = title; } else { /* We were given an old-fashioned menu. */ ltitle = Fcar (menu); CHECK_STRING (ltitle, 1); title = (char *) XSTRING (ltitle)->data; prefixes = 0; number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables, &items, Fcdr (menu)); } #ifdef XDEBUG fprintf (stderr, "Panes = %d\n", number_of_panes); for (i = 0; i < number_of_panes; i++) { fprintf (stderr, "Pane %d has lines %d title %s\n", i, items[i], menus[i]); for (j = 0; j < items[i]; j++) fprintf (stderr, " Item %d %s\n", j, names[i][j]); } #endif BLOCK_INPUT; { Window root; int root_x, root_y; int dummy_int; unsigned int dummy_uint; Window dummy_window; /* Figure out which root window F is on. */ XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root, &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, &dummy_uint, &dummy_uint); /* Translate the menu co-ordinates within f to menu co-ordinates on that root window. */ if (! XTranslateCoordinates (x_current_display, FRAME_X_WINDOW (f), root, XMenu_xpos, XMenu_ypos, &root_x, &root_y, &dummy_window)) /* But XGetGeometry said root was the root window of f's screen! */ abort (); selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables, menus, prefixes, items, number_of_panes, obj_list, title, &error_name); } UNBLOCK_INPUT; /* fprintf (stderr, "selection = %x\n", selection); */ if (selection != NUL) { /* selected something */ XMenu_return = selection; } else { /* nothing selected */ XMenu_return = Qnil; } /* now free up the strings */ for (i = 0; i < number_of_panes; i++) { xfree (names[i]); xfree (enables[i]); xfree (obj_list[i]); } xfree (menus); xfree (obj_list); xfree (names); xfree (enables); xfree (items); /* free (title); */ if (error_name) error (error_name); return XMenu_return; #endif /* not USE_X_TOOLKIT */ } #ifdef USE_X_TOOLKIT static void dispatch_dummy_expose (w, x, y) Widget w; int x; int y; { XExposeEvent dummy; dummy.type = Expose; dummy.window = XtWindow (w); dummy.count = 0; dummy.serial = 0; dummy.send_event = 0; dummy.display = XtDisplay (w); dummy.x = x; dummy.y = y; XtDispatchEvent (&dummy); } static int string_width (mw, s) XlwMenuWidget mw; char* s; { XCharStruct xcs; int drop; XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs); return xcs.width; } static int event_is_in_menu_item (mw, event, name, string_w) XlwMenuWidget mw; struct input_event *event; char *name; int *string_w; { *string_w += string_width (mw, name) + 2 * (mw->menu.horizontal_spacing + mw->menu.shadow_thickness); return (XINT (event->x) < *string_w); } Lisp_Object map_event_to_object (event, f) struct input_event *event; FRAME_PTR f; { int i,j, string_w; window_state* ws; XlwMenuWidget mw = (XlwMenuWidget) f->display.x->menubar_widget; widget_value *val; string_w = 0; /* Find the window */ for (val = mw->menu.old_stack [0]->contents; val; val = val->next) { ws = &mw->menu.windows [0]; if (ws && event_is_in_menu_item (mw, event, val->name, &string_w)) { Lisp_Object items; items = FRAME_MENU_BAR_ITEMS (f); for (; CONSP (items); items = XCONS (items)->cdr) if (!strcmp (val->name, XSTRING (Fcar (Fcdr (Fcar (items))))->data)) return items; } } return Qnil; } static widget_value * set_menu_items (menu, prefixes, panes, names, enables, menus, items, number_of_panes, obj_list, title, error_name) Lisp_Object menu; Lisp_Object **prefixes; int *panes; char ***names[]; int ***enables; char ***menus; int **items; int *number_of_panes; Lisp_Object ***obj_list; char **title; char **error_name; { Lisp_Object keymap, tem; Lisp_Object ltitle, selection; int i, j; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; int last, selidx, lpane, status; int lines, sofar; keymap = Fkeymapp (menu); tem = Qnil; if (XTYPE (menu) == Lisp_Cons) tem = Fkeymapp (Fcar (menu)); if (!NILP (keymap)) { /* We were given a keymap. Extract menu info from the keymap. */ Lisp_Object prompt; keymap = get_keymap (menu); /* Search for a string appearing directly as an element of the keymap. That string is the title of the menu. */ prompt = map_prompt (keymap); if (!NILP (prompt)) *title = (char *) XSTRING (prompt)->data; /* Extract the detailed info to make one pane. */ *number_of_panes = keymap_panes (obj_list, menus, names, enables, items, prefixes, menu, 1); /* The menu title seems to be ignored, so put it in the pane title. */ if ((*menus)[0] == 0) (*menus)[0] = *title; } else if (!NILP (tem)) { /* We were given a list of keymaps. */ Lisp_Object prompt; int nmaps = XFASTINT (Flength (menu)); Lisp_Object *maps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); int i; *title = 0; /* The first keymap that has a prompt string supplies the menu title. */ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) { maps[i++] = keymap = get_keymap (Fcar (tem)); prompt = map_prompt (keymap); if (*title == 0 && !NILP (prompt)) *title = (char *) XSTRING (prompt)->data; } /* Extract the detailed info to make one pane. */ *number_of_panes = keymap_panes (obj_list, menus, names, enables, items, prefixes, maps, nmaps); /* The menu title seems to be ignored, so put it in the pane title. */ if ((*menus)[0] == 0) (*menus)[0] = *title; } else { /* We were given an old-fashioned menu. */ ltitle = Fcar (menu); CHECK_STRING (ltitle, 1); *title = (char *) XSTRING (ltitle)->data; *prefixes = 0; *number_of_panes = list_of_panes (obj_list, menus, names, enables, items, Fcdr (menu)); } *error_name = 0; if (*number_of_panes == 0) return 0; *error_name = (char *) 0; /* Initialize error pointer to null */ wv = malloc_widget_value (); wv->name = "menu"; wv->value = 0; wv->enabled = 1; first_wv = wv; for (*panes = 0, lines = 0; *panes < *number_of_panes; lines += (*items)[*panes], (*panes)++) ; /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ /* datap = (char *) xmalloc (lines * sizeof (char)); datap_save = datap;*/ for (*panes = 0, sofar = 0; *panes < *number_of_panes; sofar += (*items)[*panes], (*panes)++) { if (strcmp((*menus)[*panes], "")) { wv = malloc_widget_value (); if (save_wv) save_wv->next = wv; else first_wv->contents = wv; wv->name = (*menus)[*panes]; wv->value = 0; wv->enabled = 1; } prev_wv = 0; save_wv = wv; for (selidx = 0; selidx < (*items)[*panes]; selidx++) { wv = malloc_widget_value (); if (prev_wv) prev_wv->next = wv; else save_wv->contents = wv; wv->name = (*names)[*panes][selidx]; wv->value = 0; selection = (*obj_list)[*panes][selidx]; if (*prefixes != 0) { selection = Fcons (selection, Qnil); if (!NILP ((*prefixes)[*panes])) selection = Fcons ((*prefixes)[*panes], selection); } wv->call_data = LISP_TO_VOID(selection); wv->enabled = (*enables)[*panes][selidx]; prev_wv = wv; } } return (first_wv); } static void free_menu_items (names, enables, menus, items, number_of_panes, obj_list, title, error_name) char **names[]; int *enables[]; char **menus; int *items; int number_of_panes; Lisp_Object **obj_list; char *title; char *error_name; { int i; /* now free up the strings */ for (i = 0; i < number_of_panes; i++) { xfree (names[i]); xfree (enables[i]); xfree (obj_list[i]); } xfree (menus); xfree (obj_list); xfree (names); xfree (enables); xfree (items); /* free (title); */ if (error_name) error (error_name); } static Lisp_Object menu_item_selection; static void popup_selection_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { #if 0 last_popup_selection_callback_id = id; menubar_selection_callback (widget, id, client_data); /* lw_destroy_all_widgets() will be called from popup_down_callback() */ #endif VOID_TO_LISP (menu_item_selection, client_data); } static void popup_down_callback (widget, id, client_data) Widget widget; LWLIB_ID id; XtPointer client_data; { #if 0 if (popup_menu_up_p == 0) abort (); popup_menu_up_p--; /* if this isn't called immediately after the selection callback, then there wasn't a menu selection. */ if (id != last_popup_selection_callback_id) menubar_selection_callback (widget, id, (XtPointer) -1); #endif BLOCK_INPUT; lw_destroy_all_widgets (id); UNBLOCK_INPUT; /* ungcpro_popup_callbacks (make_number (id)); */ } /* This recursively calls free_widget_value() on the tree of widgets. It must free all data that was malloc'ed for these widget_values. Currently, emacs only allocates new storage for the `key' slot. All other slots are pointers into the data of Lisp_Strings, and must be left alone. */ void free_menubar_widget_value_tree (wv) widget_value *wv; { if (! wv) return; if (wv->key) xfree (wv->key); wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; if (wv->contents && (wv->contents != (widget_value*)1)) { free_menubar_widget_value_tree (wv->contents); wv->contents = (widget_value *) 0xDEADBEEF; } if (wv->next) { free_menubar_widget_value_tree (wv->next); wv->next = (widget_value *) 0xDEADBEEF; } BLOCK_INPUT; free_widget_value (wv); UNBLOCK_INPUT; } static void update_one_frame_psheets (f) FRAME_PTR f; { struct x_display *x = f->display.x; int menubar_changed; menubar_changed = (x->menubar_widget && !XtIsManaged (x->menubar_widget)); if (! (menubar_changed)) return; BLOCK_INPUT; XawPanedSetRefigureMode (x->column_widget, 0); /* the order in which children are managed is the top to bottom order in which they are displayed in the paned window. First, remove the text-area widget. */ XtUnmanageChild (x->edit_widget); /* remove the menubar that is there now, and put up the menubar that should be there. */ if (menubar_changed) { XtManageChild (x->menubar_widget); XtMapWidget (x->menubar_widget); XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0); } /* Re-manage the text-area widget */ XtManageChild (x->edit_widget); /* and now thrash the sizes */ XawPanedSetRefigureMode (x->column_widget, 1); UNBLOCK_INPUT; } void set_frame_menubar (f) FRAME_PTR f; { Widget menubar_widget = f->display.x->menubar_widget; int id = (int) f; Lisp_Object tail; widget_value *wv, *save_wv, *first_wv, *prev_wv = 0; BLOCK_INPUT; wv = malloc_widget_value (); wv->name = "menubar"; wv->value = 0; wv->enabled = 1; save_wv = first_wv = wv; for (tail = FRAME_MENU_BAR_ITEMS (f); CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object string; string = Fcar (Fcdr (Fcar (tail))); wv = malloc_widget_value (); if (prev_wv) prev_wv->next = wv; else save_wv->contents = wv; wv->name = XSTRING (string)->data; wv->value = 0; wv->enabled = 1; prev_wv = wv; } if (menubar_widget) lw_modify_all_widgets (id, first_wv, False); else { menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv, f->display.x->column_widget, 0, 0, 0, 0); f->display.x->menubar_widget = menubar_widget; XtVaSetValues (menubar_widget, XtNshowGrip, 0, XtNresizeToPreferred, 1, XtNallowResize, 1, 0); } free_menubar_widget_value_tree (first_wv); update_one_frame_psheets (f); UNBLOCK_INPUT; } #endif /* USE_X_TOOLKIT */ struct indices { int pane; int line; }; extern void process_expose_from_menu (); #ifdef USE_X_TOOLKIT extern XtAppContext Xt_app_con; Lisp_Object xmenu_show (f, val, x, y, menubarp, vw) FRAME_PTR f; widget_value *val; int x; int y; int menubarp; widget_value *vw; { int menu_id, id = (int)f; Lisp_Object selection; Widget menu; /* * Define and allocate a foreign event queue to hold events * that don't belong to XMenu. These events are later restored * to the X event queue. */ typedef struct _xmeventque { XEvent event; struct _xmeventque *next; } XMEventQue; XMEventQue *feq = NULL; /* Foreign event queue. */ XMEventQue *feq_tmp; /* Foreign event queue temporary. */ BLOCK_INPUT; menu_id = ++popup_id_tick; menu = lw_create_widget ("popup", val->name, menu_id, val, f->display.x->widget, 1, 0, popup_selection_callback, popup_down_callback); free_menubar_widget_value_tree (val); /* reset the selection */ menu_item_selection = Qnil; { XButtonPressedEvent dummy; XlwMenuWidget mw; mw = ((XlwMenuWidget) ((CompositeWidget)menu)->composite.children[0]); dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; dummy.display = XtDisplay (menu); dummy.window = XtWindow (XtParent (menu)); dummy.time = CurrentTime; dummy.button = 0; dummy.x_root = x; dummy.y_root = y; if (menubarp) { vw->call_data = (XtPointer) 1; dispatch_dummy_expose (f->display.x->menubar_widget, x, y); } /* We activate directly the lucid implementation */ pop_up_menu (mw, &dummy); } /* Enters XEvent loop */ while (1) { XEvent event; XtAppNextEvent (Xt_app_con, &event); if (event.type == ButtonRelease) { XtDispatchEvent (&event); break; } else if (event.type == Expose) process_expose_from_menu (event); XtDispatchEvent (&event); feq_tmp = (XMEventQue *) malloc (sizeof (XMEventQue)); if (feq_tmp == NULL) return(Qnil); feq_tmp->event = event; feq_tmp->next = feq; feq = feq_tmp; } if (menubarp) { vw->call_data = (XtPointer) 0; dispatch_dummy_expose (f->display.x->menubar_widget, x, y); } /* Return any foreign events that were queued to the X event queue. */ while (feq != NULL) { feq_tmp = feq; XPutBackEvent (XDISPLAY &feq_tmp->event); feq = feq_tmp->next; free ((char *)feq_tmp); } UNBLOCK_INPUT; return menu_item_selection; } #else /* not USE_X_TOOLKIT */ xmenu_show (parent, startx, starty, line_list, enable_list, pane_list, prefixes, line_cnt, pane_cnt, item_list, title, error) Window parent; int startx, starty; /* upper left corner position BROKEN */ char **line_list[]; /* list of strings for items */ int *enable_list[]; /* enable flags of lines */ char *pane_list[]; /* list of pane titles */ Lisp_Object *prefixes; /* Prefix key for each pane */ char *title; int pane_cnt; /* total number of panes */ Lisp_Object *item_list[]; /* All items */ int line_cnt[]; /* Lines in each pane */ char **error; /* Error returned */ { XMenu *GXMenu; int last, panes, selidx, lpane, status; int lines, sofar; Lisp_Object entry; /* struct indices *datap, *datap_save; */ char *datap; int ulx, uly, width, height; int dispwidth, dispheight; *error = 0; if (pane_cnt == 0) return 0; BLOCK_INPUT; *error = (char *) 0; /* Initialize error pointer to null */ GXMenu = XMenuCreate (XDISPLAY parent, "emacs"); if (GXMenu == NUL) { *error = "Can't create menu"; UNBLOCK_INPUT; return (0); } for (panes = 0, lines = 0; panes < pane_cnt; lines += line_cnt[panes], panes++) ; /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ /* datap = (char *) xmalloc (lines * sizeof (char)); datap_save = datap;*/ for (panes = 0, sofar = 0; panes < pane_cnt; sofar += line_cnt[panes], panes++) { /* create all the necessary panes */ lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE); if (lpane == XM_FAILURE) { XMenuDestroy (XDISPLAY GXMenu); *error = "Can't create pane"; UNBLOCK_INPUT; return (0); } for (selidx = 0; selidx < line_cnt[panes]; selidx++) { /* add the selection stuff to the menus */ /* datap[selidx+sofar].pane = panes; datap[selidx+sofar].line = selidx; */ if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0, line_list[panes][selidx], enable_list[panes][selidx]) == XM_FAILURE) { XMenuDestroy (XDISPLAY GXMenu); /* free (datap); */ *error = "Can't add selection to menu"; /* error ("Can't add selection to menu"); */ UNBLOCK_INPUT; return (0); } } } /* all set and ready to fly */ XMenuRecompute (XDISPLAY GXMenu); dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display)); dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display)); startx = min (startx, dispwidth); starty = min (starty, dispheight); startx = max (startx, 1); starty = max (starty, 1); XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty, &ulx, &uly, &width, &height); if (ulx+width > dispwidth) { startx -= (ulx + width) - dispwidth; ulx = dispwidth - width; } if (uly+height > dispheight) { starty -= (uly + height) - dispheight; uly = dispheight - height; } if (ulx < 0) startx -= ulx; if (uly < 0) starty -= uly; XMenuSetFreeze (GXMenu, TRUE); panes = selidx = 0; status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx, startx, starty, ButtonReleaseMask, &datap); switch (status) { case XM_SUCCESS: #ifdef XDEBUG fprintf (stderr, "pane= %d line = %d\n", panes, selidx); #endif entry = item_list[panes][selidx]; if (prefixes != 0) { entry = Fcons (entry, Qnil); if (!NILP (prefixes[panes])) entry = Fcons (prefixes[panes], entry); } break; case XM_FAILURE: /* free (datap_save); */ XMenuDestroy (XDISPLAY GXMenu); *error = "Can't activate menu"; /* error ("Can't activate menu"); */ case XM_IA_SELECT: case XM_NO_SELECT: entry = Qnil; break; } XMenuDestroy (XDISPLAY GXMenu); UNBLOCK_INPUT; /* free (datap_save);*/ return (entry); } #endif /* not USE_X_TOOLKIT */ syms_of_xmenu () { popup_id_tick = (1<<16); defsubr (&Sx_popup_menu); } /* Construct the vectors that describe a menu and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. Each of those four values is a vector indexed by pane number. Return the number of panes. KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */ int keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps) Lisp_Object ***vector; /* RETURN all menu objects */ char ***panes; /* RETURN pane names */ char ****names; /* RETURN all line names */ int ***enables; /* RETURN enable-flags of lines */ int **items; /* RETURN number of items per pane */ Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ Lisp_Object *keymaps; int nmaps; { /* Number of panes we have made. */ int p = 0; /* Number of panes we have space for. */ int npanes_allocated = nmaps; int mapno; if (npanes_allocated < 4) npanes_allocated = 4; /* Make space for an estimated number of panes. */ *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *)); *panes = (char **) xmalloc (npanes_allocated * sizeof (char *)); *items = (int *) xmalloc (npanes_allocated * sizeof (int)); *names = (char ***) xmalloc (npanes_allocated * sizeof (char **)); *enables = (int **) xmalloc (npanes_allocated * sizeof (int *)); *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object)); /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. P is the number of panes we have made so far. */ for (mapno = 0; mapno < nmaps; mapno++) single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items, prefixes, &p, &npanes_allocated, ""); /* Return the number of panes. */ return p; } /* This is used as the handler when calling internal_condition_case_1. */ static Lisp_Object single_keymap_panes_1 (arg) Lisp_Object arg; { return Qnil; } /* This is a recursive subroutine of keymap_panes. It handles one keymap, KEYMAP. The other arguments are passed along or point to local variables of the previous function. */ single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes, p_ptr, npanes_allocated_ptr, pane_name) Lisp_Object keymap; Lisp_Object ***vector; /* RETURN all menu objects */ char ***panes; /* RETURN pane names */ char ****names; /* RETURN all line names */ int ***enables; /* RETURN enable flags of lines */ int **items; /* RETURN number of items per pane */ Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ int *p_ptr; int *npanes_allocated_ptr; char *pane_name; { int i; Lisp_Object pending_maps; Lisp_Object tail, item, item1, item2, table; pending_maps = Qnil; /* Make sure we have room for another pane. */ if (*p_ptr == *npanes_allocated_ptr) { *npanes_allocated_ptr *= 2; *vector = (Lisp_Object **) xrealloc (*vector, *npanes_allocated_ptr * sizeof (Lisp_Object *)); *panes = (char **) xrealloc (*panes, *npanes_allocated_ptr * sizeof (char *)); *items = (int *) xrealloc (*items, *npanes_allocated_ptr * sizeof (int)); *prefixes = (Lisp_Object *) xrealloc (*prefixes, (*npanes_allocated_ptr * sizeof (Lisp_Object))); *names = (char ***) xrealloc (*names, *npanes_allocated_ptr * sizeof (char **)); *enables = (int **) xrealloc (*enables, *npanes_allocated_ptr * sizeof (int *)); } /* When a menu comes from keymaps, don't give names to the panes. */ (*panes)[*p_ptr] = pane_name; /* Normally put nil as pane's prefix key. Caller will override this if appropriate. */ (*prefixes)[*p_ptr] = Qnil; /* Get the length of the list level of the keymap. */ i = XFASTINT (Flength (keymap)); /* Add in lengths of any arrays. */ for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) if (XTYPE (XCONS (tail)->car) == Lisp_Vector) i += XVECTOR (XCONS (tail)->car)->size; /* Create vectors for the names and values of the items in the pane. I is an upper bound for the number of items. */ (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *)); (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int)); /* I is now the index of the next unused slots. */ i = 0; for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { /* Look at each key binding, and if it has a menu string, make a menu item from it. */ item = XCONS (tail)->car; if (XTYPE (item) == Lisp_Cons) { item1 = XCONS (item)->cdr; if (XTYPE (item1) == Lisp_Cons) { item2 = XCONS (item1)->car; if (XTYPE (item2) == Lisp_String) { Lisp_Object def, tem; Lisp_Object enabled; def = Fcdr (item1); enabled = Qt; if (XTYPE (def) == Lisp_Symbol) { /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ tem = Fget (def, Qmenu_enable); if (!NILP (tem)) /* (condition-case nil (eval tem) (error nil)) */ enabled = internal_condition_case_1 (Feval, tem, Qerror, single_keymap_panes_1); } tem = Fkeymapp (def); if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)), pending_maps); else { (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; /* The menu item "value" is the key bound here. */ (*vector)[*p_ptr][i] = XCONS (item)->car; (*enables)[*p_ptr][i] = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); i++; } } } } else if (XTYPE (item) == Lisp_Vector) { /* Loop over the char values represented in the vector. */ int len = XVECTOR (item)->size; int c; for (c = 0; c < len; c++) { Lisp_Object character; XFASTINT (character) = c; item1 = XVECTOR (item)->contents[c]; if (XTYPE (item1) == Lisp_Cons) { item2 = XCONS (item1)->car; if (XTYPE (item2) == Lisp_String) { Lisp_Object tem; Lisp_Object def; Lisp_Object enabled; def = Fcdr (item1); enabled = Qt; if (XTYPE (def) == Lisp_Symbol) { tem = Fget (def, Qmenu_enable); /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ if (!NILP (tem)) /* (condition-case nil (eval tem) (error nil)) */ enabled = internal_condition_case_1 (Feval, tem, Qerror, single_keymap_panes_1); } tem = Fkeymapp (def); if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item2, character)), pending_maps); else { (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; /* The menu item "value" is the key bound here. */ (*vector)[*p_ptr][i] = character; (*enables)[*p_ptr][i] = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); i++; } } } } } } /* Record the number of items in the pane. */ (*items)[*p_ptr] = i; /* If we just made an empty pane, get rid of it. */ if (i == 0) { xfree ((*vector)[*p_ptr]); xfree ((*names)[*p_ptr]); xfree ((*enables)[*p_ptr]); } /* Otherwise, advance past it. */ else (*p_ptr)++; /* Process now any submenus which want to be panes at this level. */ while (!NILP (pending_maps)) { Lisp_Object elt, eltcdr; int panenum = *p_ptr; elt = Fcar (pending_maps); eltcdr = XCONS (elt)->cdr; single_keymap_panes (Fcar (elt), panes, vector, names, enables, items, prefixes, p_ptr, npanes_allocated_ptr, /* Add 1 to discard the @. */ (char *) XSTRING (XCONS (eltcdr)->car)->data + 1); (*prefixes)[panenum] = XCONS (eltcdr)->cdr; pending_maps = Fcdr (pending_maps); } } /* Construct the vectors that describe a menu and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. Each of those four values is a vector indexed by pane number. Return the number of panes. MENU is the argument that was given to Fx_popup_menu. */ int list_of_panes (vector, panes, names, enables, items, menu) Lisp_Object ***vector; /* RETURN all menu objects */ char ***panes; /* RETURN pane names */ char ****names; /* RETURN all line names */ int ***enables; /* RETURN enable flags of lines */ int **items; /* RETURN number of items per pane */ Lisp_Object menu; { Lisp_Object tail, item, item1; int i; if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu); i = XFASTINT (Flength (menu)); *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *)); *panes = (char **) xmalloc (i * sizeof (char *)); *items = (int *) xmalloc (i * sizeof (int)); *names = (char ***) xmalloc (i * sizeof (char **)); *enables = (int **) xmalloc (i * sizeof (int *)); for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++) { item = Fcdr (Fcar (tail)); if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item); #ifdef XDEBUG fprintf (stderr, "list_of_panes check tail, i=%d\n", i); #endif item1 = Fcar (Fcar (tail)); CHECK_STRING (item1, 1); #ifdef XDEBUG fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i, XSTRING (item1)->data); #endif (*panes)[i] = (char *) XSTRING (item1)->data; (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item); /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1); bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1) ; */ } return i; } /* Construct the lists of values and names for a single pane, from the alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags int *ENABLES. Return the number of items. */ int list_of_items (vector, names, enables, pane) Lisp_Object **vector; /* RETURN menu "objects" */ char ***names; /* RETURN line names */ int **enables; /* RETURN enable flags of lines */ Lisp_Object pane; { Lisp_Object tail, item, item1; int i; if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane); i = XFASTINT (Flength (pane)); *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); *names = (char **) xmalloc (i * sizeof (char *)); *enables = (int *) xmalloc (i * sizeof (int)); for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++) { item = Fcar (tail); if (STRINGP (item)) { (*vector)[i] = Qnil; (*names)[i] = (char *) XSTRING (item)->data; (*enables)[i] = -1; } else { CHECK_CONS (item, 0); (*vector)[i] = Fcdr (item); item1 = Fcar (item); CHECK_STRING (item1, 1); (*names)[i] = (char *) XSTRING (item1)->data; (*enables)[i] = 1; } } return i; }