/* Implements an elisp-programmable menubar. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. XEmacs 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 3 of the License, or (at your option) any later version. XEmacs 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 XEmacs. If not, see . */ /* Synched up with: Not in FSF. */ /* Authorship: Created by Ben Wing as part of device-abstraction work for 19.12. Menu filters and many other keywords added by Stig for 19.12. Menu accelerators c. 1997? by ??. Moved here from event-stream.c. Much other work post-1996 by ??. */ #include #include "lisp.h" #include "buffer.h" #include "device-impl.h" #include "frame-impl.h" #include "gui.h" #include "keymap.h" #include "menubar.h" #include "redisplay.h" #include "specifier.h" #include "window-impl.h" int menubar_show_keybindings; Lisp_Object Vmenubar_configuration; Lisp_Object Qcurrent_menubar; Lisp_Object Qactivate_menubar_hook, Vactivate_menubar_hook; Lisp_Object Vmenubar_visible_p; static Lisp_Object Vcurrent_menubar; /* DO NOT ever reference this. Always go through Qcurrent_menubar. See below. */ Lisp_Object Vblank_menubar; int popup_menu_titles; int in_menu_callback; Lisp_Object Vmenubar_pointer_glyph; /* prefix key(s) that must match in order to activate menu. This is ugly. fix me. */ Lisp_Object Vmenu_accelerator_prefix; /* list of modifier keys to match accelerator for top level menus */ Lisp_Object Vmenu_accelerator_modifiers; /* whether menu accelerators are enabled */ Lisp_Object Vmenu_accelerator_enabled; /* keymap for auxiliary menu accelerator functions */ Lisp_Object Vmenu_accelerator_map; Lisp_Object Qmenu_force; Lisp_Object Qmenu_fallback; Lisp_Object Qmenu_quit; Lisp_Object Qmenu_up; Lisp_Object Qmenu_down; Lisp_Object Qmenu_left; Lisp_Object Qmenu_right; Lisp_Object Qmenu_select; Lisp_Object Qmenu_escape; static int menubar_variable_changed (Lisp_Object UNUSED (sym), Lisp_Object *UNUSED (val), Lisp_Object UNUSED (in_object), int UNUSED (flags)) { MARK_MENUBAR_CHANGED; return 0; } void update_frame_menubars (struct frame *f) { if (f->menubar_changed || f->windows_changed) MAYBE_FRAMEMETH (f, update_frame_menubars, (f)); f->menubar_changed = 0; } void free_frame_menubars (struct frame *f) { /* If we had directly allocated any memory for the menubars instead of using all Lisp_Objects this is where we would now free it. */ MAYBE_FRAMEMETH (f, free_frame_menubars, (f)); } static void menubar_visible_p_changed (Lisp_Object UNUSED (specifier), struct window *UNUSED (w), Lisp_Object UNUSED (oldval)) { MARK_MENUBAR_CHANGED; } static void menubar_visible_p_changed_in_frame (Lisp_Object UNUSED (specifier), struct frame *f, Lisp_Object UNUSED (oldval)) { update_frame_menubars (f); } Lisp_Object current_frame_menubar (const struct frame* f) { struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); return symbol_value_in_buffer (Qcurrent_menubar, w->buffer); } Lisp_Object menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item) { Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); /* Menu descriptor should be a list */ CHECK_CONS (desc); /* First element may be menu name, although can be omitted. Let's think that if stuff begins with anything than a keyword or a list (submenu), this is a menu name, expected to be a string */ if (!KEYWORDP (XCAR (desc)) && !CONSP (XCAR (desc))) { CHECK_STRING (XCAR (desc)); pgui_item->name = XCAR (desc); desc = XCDR (desc); if (!NILP (desc)) CHECK_CONS (desc); } /* Walk along all key-value pairs */ while (!NILP(desc) && KEYWORDP (XCAR (desc))) { Lisp_Object key, val; key = XCAR (desc); desc = XCDR (desc); CHECK_CONS (desc); val = XCAR (desc); desc = XCDR (desc); if (!NILP (desc)) CHECK_CONS (desc); gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME); } /* Return the rest - supposed to be a list of items */ return desc; } DEFUN ("menu-find-real-submenu", Fmenu_find_real_submenu, 2, 2, 0, /* Find a submenu descriptor within DESC by following PATH. This function finds a submenu descriptor, either from the description DESC or generated by a filter within DESC. The function regards :config and :included keywords in the DESC, and expands submenus along the PATH using :filter functions. Return value is a descriptor for the submenu, NOT expanded and NOT checked against :config and :included. Also, individual menu items are not looked for, only submenus. See also 'find-menu-item'. */ (desc, path)) { struct gcpro gcpro1, gcpro2; Lisp_Object gui_item = allocate_gui_item (); Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); GCPRO2 (gui_item, desc); { EXTERNAL_LIST_LOOP_2 (elt, path) { /* Verify that DESC describes a menu, not single item */ if (!CONSP (desc)) RETURN_UNGCPRO (Qnil); /* Parse this menu */ desc = menu_parse_submenu_keywords (desc, gui_item); /* Check that this (sub)menu is active */ if (!gui_item_active_p (gui_item)) RETURN_UNGCPRO (Qnil); /* Apply :filter */ if (!NILP (pgui_item->filter)) desc = call1 (pgui_item->filter, desc); /* Find the next menu on the path inside this one */ { EXTERNAL_LIST_LOOP_2 (submenu, desc) { if (CONSP (submenu) && STRINGP (XCAR (submenu)) && !NILP (Fstring_equal (XCAR (submenu), elt))) { desc = submenu; goto descend; } } } /* Submenu not found */ RETURN_UNGCPRO (Qnil); descend: /* Prepare for the next iteration */ gui_item_init (gui_item); } } /* We have successfully descended down the end of the path */ UNGCPRO; return desc; } DEFUN ("popup-menu", Fpopup_menu, 1, 2, 0, /* Pop up the menu described by MENU-DESCRIPTION. A menu description is a list of menu items, strings, and submenus. The first element of a menu must be a string, which is the name of the menu. This is the string that will be displayed in the parent menu, if any. For toplevel menus, it is ignored. This string is not displayed in the menu itself. If an element of a menu is a string, then that string will be presented in the menu as unselectable text. If an element of a menu is a string consisting solely of hyphens, then that item will be presented as a solid horizontal line. If an element of a menu is a list, it is treated as a submenu. The name of that submenu (the first element in the list) will be used as the name of the item representing this menu on the parent. Otherwise, the element must be a vector, which describes a menu item. A menu item can have any of the following forms: [ "name" callback ] [ "name" callback ] [ "name" callback : : ... ] The name is the string to display on the menu; it is filtered through the resource database, so it is possible for resources to override what string is actually displayed. If the `callback' of a menu item is a symbol, then it must name a command. It will be invoked with `call-interactively'. If it is a list, then it is evaluated with `eval'. The possible keywords are this: :active
Same as in the first two forms: the expression is evaluated just before the menu is displayed, and the menu will be selectable only if the result is non-nil. :suffix Same as in the second form: the expression is evaluated just before the menu is displayed and resulting string is appended to the displayed name, providing a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. :keys "string" Normally, the keyboard equivalents of commands in menus are displayed when the `callback' is a symbol. This can be used to specify keys for more complex menu items. It is passed through `substitute-command-keys' first. :style