XEmacs 21.2-b1

[chise/xemacs-chise.git.1] / src / menubar.c

/* 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);
}