xemacs-beta: src/menubar.c comparison

comparison src/menubar.c @ 428:3ecd8885ac67 r21-2-22

Import from CVS: tag r21-2-22

author	cvs
date	Mon, 13 Aug 2007 11:28:15 +0200
parents
children	84b14dcb0985

comparison

equal deleted inserted replaced

-:0a0253eac470
+:3ecd8885ac67
+/* 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, Lisp_Object gui_item)
+{
+struct 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))
+{
+Lisp_Object path_entry, submenu_desc, submenu;
+struct gcpro gcpro1;
+Lisp_Object gui_item = allocate_gui_item ();
+struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item);
+GCPRO1 (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 (pgui_item->filter))
+	desc = call1 (pgui_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);
+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.
+:key-sequence keys  Used in FSF Emacs as an hint to an equivalent keybinding.
+Ignored by XEnacs for easymenu.el compatability.
+:label <form>       (unimplemented!) Like :suffix, but replaces label
+completely.
+(might be added in 21.2).
+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);
+}

Mercurial > hg > xemacs-beta

comparison src/menubar.c @ 428:3ecd8885ac67 r21-2-22