--- /dev/null
+/* Implements an elisp-programmable menubar.
+ Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+
+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 2, 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; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in FSF. */
+
+/* #### There ain't much here because menubars have not been
+ properly abstracted yet. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "device.h"
+#include "frame.h"
+#include "gui.h"
+#include "menubar.h"
+#include "redisplay.h"
+#include "window.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;
+
+Lisp_Object Vmenubar_pointer_glyph;
+
+static int
+menubar_variable_changed (Lisp_Object sym, Lisp_Object *val,
+ Lisp_Object in_object, int 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 specifier, struct window *w,
+ Lisp_Object oldval)
+{
+ MARK_MENUBAR_CHANGED;
+}
+
+static void
+menubar_visible_p_changed_in_frame (Lisp_Object specifier, struct frame *f,
+ Lisp_Object 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, struct gui_item* pgui_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 stirng */
+ 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 (pgui_item, key, val);
+ }
+
+ /* 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))
+{
+ Lisp_Object path_entry, submenu_desc, submenu;
+ struct gcpro gcpro1;
+ struct gui_item gui_item;
+
+ gui_item_init (&gui_item);
+ GCPRO_GUI_ITEM (&gui_item);
+
+ EXTERNAL_LIST_LOOP (path_entry, 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 (gui_item.filter))
+ desc = call1 (gui_item.filter, desc);
+
+ /* Find the next menu on the path inside this one */
+ EXTERNAL_LIST_LOOP (submenu_desc, desc)
+ {
+ submenu = XCAR (submenu_desc);
+ if (CONSP (submenu)
+ && STRINGP (XCAR (submenu))
+ && !NILP (Fstring_equal (XCAR (submenu), XCAR (path_entry))))
+ {
+ 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 given menu.
+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 <active-p> ]
+ [ "name" callback <active-p> <suffix> ]
+ [ "name" callback :<keyword> <value> :<keyword> <value> ... ]
+
+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 <form> Same as <active-p> 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 <form> Same as <suffix> 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 <style> Specifies what kind of object this menu item is:
+
+ nil A normal menu item.
+ toggle A toggle button.
+ radio A radio button.
+
+ The only difference between toggle and radio buttons is
+ how they are displayed. But for consistency, a toggle
+ button should be used when there is one option whose
+ value can be turned on or off, and radio buttons should
+ be used when there is a set of mutually exclusive
+ options. When using a group of radio buttons, you
+ should arrange for no more than one to be marked as
+ selected at a time.
+
+ :selected <form> Meaningful only when STYLE is `toggle' or `radio'.
+ This specifies whether the button will be in the
+ selected or unselected state.
+
+For example:
+
+ [ "Save As..." write-file t ]
+ [ "Revert Buffer" revert-buffer (buffer-modified-p) ]
+ [ "Read Only" toggle-read-only :style toggle :selected buffer-read-only ]
+
+See menubar.el for many more examples.
+*/
+ (menu_desc, event))
+{
+ struct frame *f = decode_frame(Qnil);
+ MAYBE_FRAMEMETH (f, popup_menu, (menu_desc,event));
+ return Qnil;
+}
+
+DEFUN ("normalize-menu-item-name", Fnormalize_menu_item_name, 1, 2, 0, /*
+Convert a menu item name string into normal form, and return the new string.
+Menu item names should be converted to normal form before being compared.
+*/
+ (name, buffer))
+{
+ struct buffer *buf = decode_buffer (buffer, 0);
+ struct Lisp_String *n;
+ Charcount end;
+ int i;
+ Bufbyte *name_data;
+ Bufbyte *string_result;
+ Bufbyte *string_result_ptr;
+ Emchar elt;
+ int expecting_underscore = 0;
+
+ CHECK_STRING (name);
+
+ n = XSTRING (name);
+ end = string_char_length (n);
+ name_data = string_data (n);
+
+ string_result = (Bufbyte *) alloca (end * MAX_EMCHAR_LEN);
+ string_result_ptr = string_result;
+ for (i = 0; i < end; i++)
+ {
+ elt = charptr_emchar (name_data);
+ elt = DOWNCASE (buf, elt);
+ if (expecting_underscore)
+ {
+ expecting_underscore = 0;
+ switch (elt)
+ {
+ case '%':
+ /* Allow `%%' to mean `%'. */
+ string_result_ptr += set_charptr_emchar (string_result_ptr, '%');
+ break;
+ case '_':
+ break;
+ default:
+ string_result_ptr += set_charptr_emchar (string_result_ptr, '%');
+ string_result_ptr += set_charptr_emchar (string_result_ptr, elt);
+ }
+ }
+ else if (elt == '%')
+ expecting_underscore = 1;
+ else
+ string_result_ptr += set_charptr_emchar (string_result_ptr, elt);
+ INC_CHARPTR (name_data);
+ }
+
+ return make_string (string_result, string_result_ptr - string_result);
+}
+
+void
+syms_of_menubar (void)
+{
+ defsymbol (&Qcurrent_menubar, "current-menubar");
+ DEFSUBR (Fpopup_menu);
+ DEFSUBR (Fnormalize_menu_item_name);
+ DEFSUBR (Fmenu_find_real_submenu);
+}
+
+void
+vars_of_menubar (void)
+{
+ {
+ /* put in Vblank_menubar a menubar value which has no visible
+ * items. This is a bit tricky due to various quirks. We
+ * could use '(["" nil nil]), but this is apparently equivalent
+ * to '(nil), and a new frame created with this menubar will
+ * get a vertically-squished menubar. If we use " " as the
+ * button title instead of "", we get an etched button border.
+ * So we use
+ * '(("No active menubar" ["" nil nil]))
+ * which creates a menu whose title is "No active menubar",
+ * and this works fine.
+ */
+
+ Lisp_Object menu_item[3];
+ static CONST char *blank_msg = "No active menubar";
+
+ menu_item[0] = build_string ("");
+ menu_item[1] = Qnil;
+ menu_item[2] = Qnil;
+ Vblank_menubar = Fcons (Fcons (build_string (blank_msg),
+ Fcons (Fvector (3, &menu_item[0]),
+ Qnil)),
+ Qnil);
+ Vblank_menubar = Fpurecopy (Vblank_menubar);
+ staticpro (&Vblank_menubar);
+ }
+
+ DEFVAR_BOOL ("popup-menu-titles", &popup_menu_titles /*
+If true, popup menus will have title bars at the top.
+*/ );
+ popup_menu_titles = 1;
+
+ /* #### Replace current menubar with a specifier. */
+
+ /* All C code must access the menubar via Qcurrent_menubar
+ because it can be buffer-local. Note that Vcurrent_menubar
+ doesn't need to exist at all, except for the magic function. */
+
+ DEFVAR_LISP_MAGIC ("current-menubar", &Vcurrent_menubar /*
+The current menubar. This may be buffer-local.
+
+When the menubar is changed, the function `set-menubar-dirty-flag' has to
+be called for the menubar to be updated on the frame. See `set-menubar'
+and `set-buffer-menubar'.
+
+A menubar is a list of menus and menu-items.
+A menu is a list of menu items, keyword-value pairs, 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.
+
+Immediately following the name string of the menu, any of three
+optional keyword-value pairs is permitted.
+
+If an element of a menu (or menubar) is a string, then that string will be
+presented 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.
+
+If an element of a menubar is `nil', then it is used to represent the
+division between the set of menubar-items which are flushleft and those
+which are flushright.
+
+Otherwise, the element must be a vector, which describes a menu item.
+A menu item can have any of the following forms:
+
+ [ "name" callback <active-p> ]
+ [ "name" callback <active-p> <suffix> ]
+ [ "name" callback :<keyword> <value> :<keyword> <value> ... ]
+
+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 <form> Same as <active-p> 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 <form> Same as <suffix> 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 <style> Specifies what kind of object this menu item is:
+
+ nil A normal menu item.
+ toggle A toggle button.
+ radio A radio button.
+ button A menubar button.
+
+ The only difference between toggle and radio buttons is
+ how they are displayed. But for consistency, a toggle
+ button should be used when there is one option whose
+ value can be turned on or off, and radio buttons should
+ be used when there is a set of mutually exclusive
+ options. When using a group of radio buttons, you
+ should arrange for no more than one to be marked as
+ selected at a time.
+
+ :selected <form> Meaningful only when STYLE is `toggle', `radio' or
+ `button'. This specifies whether the button will be in
+ the selected or unselected state.
+
+ :included <form> This can be used to control the visibility of a menu or
+ menu item. The form is evaluated and the menu or menu
+ item is only displayed if the result is non-nil.
+
+ :config <symbol> This is an efficient shorthand for
+ :included (memq symbol menubar-configuration)
+ See the variable `menubar-configuration'.
+
+ :filter <function> A menu filter can only be used in a menu item list.
+ (i.e.: not in a menu item itself). It is used to
+ sensitize or incrementally create a submenu only when
+ it is selected by the user and not every time the
+ menubar is activated. The filter function is passed
+ the list of menu items in the submenu and must return a
+ list of menu items to be used for the menu. It is
+ called only when the menu is about to be displayed, so
+ other menus may already be displayed. Vile and
+ terrible things will happen if a menu filter function
+ changes the current buffer, window, or frame. It
+ also should not raise, lower, or iconify any frames.
+ Basically, the filter function should have no
+ side-effects.
+
+For example:
+
+ ("File"
+ :filter file-menu-filter ; file-menu-filter is a function that takes
+ ; one argument (a list of menu items) and
+ ; returns a list of menu items
+ [ "Save As..." write-file t ]
+ [ "Revert Buffer" revert-buffer (buffer-modified-p) ]
+ [ "Read Only" toggle-read-only :style toggle
+ :selected buffer-read-only ]
+ )
+
+See x-menubar.el for many more examples.
+
+After the menubar is clicked upon, but before any menus are popped up,
+the functions on the `activate-menubar-hook' are invoked to make top-level
+changes to the menus and menubar. Note, however, that the use of menu
+filters (using the :filter keyword) is usually a more efficient way to
+dynamically alter or sensitize menus.
+*/, menubar_variable_changed);
+
+ Vcurrent_menubar = Qnil;
+
+ DEFVAR_LISP ("activate-menubar-hook", &Vactivate_menubar_hook /*
+Function or functions called before a menubar menu is pulled down.
+These functions are called with no arguments, and should interrogate and
+modify the value of `current-menubar' as desired.
+
+The functions on this hook are invoked after the mouse goes down, but before
+the menu is mapped, and may be used to activate, deactivate, add, or delete
+items from the menus. However, it is probably the case that using a :filter
+keyword in a submenu would be a more efficient way of updating menus. See
+the documentation of `current-menubar'.
+
+These functions may return the symbol `t' to assert that they have made
+no changes to the menubar. If any other value is returned, the menubar is
+recomputed. If `t' is returned but the menubar has been changed, then the
+changes may not show up right away. Returning `nil' when the menubar has
+not changed is not so bad; more computation will be done, but redisplay of
+the menubar will still be performed optimally.
+*/ );
+ Vactivate_menubar_hook = Qnil;
+ defsymbol (&Qactivate_menubar_hook, "activate-menubar-hook");
+
+ DEFVAR_BOOL ("menubar-show-keybindings", &menubar_show_keybindings /*
+If true, the menubar will display keyboard equivalents.
+If false, only the command names will be displayed.
+*/ );
+ menubar_show_keybindings = 1;
+
+ DEFVAR_LISP_MAGIC ("menubar-configuration", &Vmenubar_configuration /*
+A list of symbols, against which the value of the :config tag for each
+menubar item will be compared. If a menubar item has a :config tag, then
+it is omitted from the menubar if that tag is not a member of the
+`menubar-configuration' list.
+*/ , menubar_variable_changed);
+ Vmenubar_configuration = Qnil;
+
+ DEFVAR_LISP ("menubar-pointer-glyph", &Vmenubar_pointer_glyph /*
+*The shape of the mouse-pointer when over the menubar.
+This is a glyph; use `set-glyph-image' to change it.
+If unspecified in a particular domain, the window-system-provided
+default pointer is used.
+*/ );
+
+ Fprovide (intern ("menubar"));
+}
+
+void
+specifier_vars_of_menubar (void)
+{
+ DEFVAR_SPECIFIER ("menubar-visible-p", &Vmenubar_visible_p /*
+*Whether the menubar is visible.
+This is a specifier; use `set-specifier' to change it.
+*/ );
+ Vmenubar_visible_p = Fmake_specifier (Qboolean);
+
+ set_specifier_fallback (Vmenubar_visible_p, list1 (Fcons (Qnil, Qt)));
+ set_specifier_caching (Vmenubar_visible_p,
+ slot_offset (struct window,
+ menubar_visible_p),
+ menubar_visible_p_changed,
+ slot_offset (struct frame,
+ menubar_visible_p),
+ menubar_visible_p_changed_in_frame);
+}
+
+void
+complex_vars_of_menubar (void)
+{
+ Vmenubar_pointer_glyph = Fmake_glyph_internal (Qpointer);
+}
projects / chise / xemacs-chise.git.1 / blobdiff