git.chise.org Git - chise/xemacs-chise.git.1/blob - src/menubar.c

   1 /* Implements an elisp-programmable menubar.
   2    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: Not in FSF. */
  23
  24 /* #### There ain't much here because menubars have not been
  25    properly abstracted yet. */
  26
  27 #include <config.h>
  28 #include "lisp.h"
  29
  30 #include "buffer.h"
  31 #include "device.h"
  32 #include "frame.h"
  33 #include "gui.h"
  34 #include "menubar.h"
  35 #include "redisplay.h"
  36 #include "window.h"
  37
  38 int menubar_show_keybindings;
  39 Lisp_Object Vmenubar_configuration;
  40
  41 Lisp_Object Qcurrent_menubar;
  42
  43 Lisp_Object Qactivate_menubar_hook, Vactivate_menubar_hook;
  44
  45 Lisp_Object Vmenubar_visible_p;
  46
  47 static Lisp_Object Vcurrent_menubar; /* DO NOT ever reference this.
  48                                         Always go through Qcurrent_menubar.
  49                                         See below. */
  50
  51 Lisp_Object Vblank_menubar;
  52
  53 int popup_menu_titles;
  54
  55 Lisp_Object Vmenubar_pointer_glyph;
  56
  57 static int
  58 menubar_variable_changed (Lisp_Object sym, Lisp_Object *val,
  59                           Lisp_Object in_object, int flags)
  60 {
  61   MARK_MENUBAR_CHANGED;
  62   return 0;
  63 }
  64
  65 void
  66 update_frame_menubars (struct frame *f)
  67 {
  68   if (f->menubar_changed || f->windows_changed)
  69     MAYBE_FRAMEMETH (f, update_frame_menubars, (f));
  70
  71   f->menubar_changed = 0;
  72 }
  73
  74 void
  75 free_frame_menubars (struct frame *f)
  76 {
  77   /* If we had directly allocated any memory for the menubars instead
  78      of using all Lisp_Objects this is where we would now free it. */
  79
  80   MAYBE_FRAMEMETH (f, free_frame_menubars, (f));
  81 }
  82
  83 static void
  84 menubar_visible_p_changed (Lisp_Object specifier, struct window *w,
  85                            Lisp_Object oldval)
  86 {
  87   MARK_MENUBAR_CHANGED;
  88 }
  89
  90 static void
  91 menubar_visible_p_changed_in_frame (Lisp_Object specifier, struct frame *f,
  92                                     Lisp_Object oldval)
  93 {
  94   update_frame_menubars (f);
  95 }
  96
  97 Lisp_Object
  98 current_frame_menubar (CONST struct frame* f)
  99 {
 100   struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
 101   return symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
 102 }
 103
 104 Lisp_Object
 105 menu_parse_submenu_keywords (Lisp_Object desc, struct gui_item* pgui_item)
 106 {
 107   /* Menu descriptor should be a list */
 108   CHECK_CONS (desc);
 109
 110   /* First element may be menu name, although can be omitted.
 111      Let's think that if stuff begins with anything than a keyword
 112      or a list (submenu), this is a menu name, expected to be a string */
 113   if (!KEYWORDP (XCAR (desc)) && !CONSP (XCAR (desc)))
 114     {
 115       CHECK_STRING (XCAR (desc));
 116       pgui_item->name = XCAR (desc);
 117       desc = XCDR (desc);
 118       if (!NILP (desc))
 119         CHECK_CONS (desc);
 120     }
 121
 122   /* Walk along all key-value pairs */
 123   while (!NILP(desc) && KEYWORDP (XCAR (desc)))
 124     {
 125       Lisp_Object key, val;
 126       key = XCAR (desc);
 127       desc = XCDR (desc);
 128       CHECK_CONS (desc);
 129       val = XCAR (desc);
 130       desc = XCDR (desc);
 131       if (!NILP (desc))
 132         CHECK_CONS (desc);
 133       gui_item_add_keyval_pair (pgui_item, key, val);
 134     }
 135
 136   /* Return the rest - supposed to be a list of items */
 137   return desc;
 138 }
 139
 140 DEFUN ("menu-find-real-submenu", Fmenu_find_real_submenu, 2, 2, 0, /*
 141 Find a submenu descriptor within DESC by following PATH.
 142 This function finds a submenu descriptor, either from the description
 143 DESC or generated by a filter within DESC. The function regards :config
 144 and :included keywords in the DESC, and expands submenus along the
 145 PATH using :filter functions. Return value is a descriptor for the
 146 submenu, NOT expanded and NOT checked against :config and :included.
 147 Also, individual menu items are not looked for, only submenus.
 148
 149 See also 'find-menu-item'.
 150 */
 151        (desc, path))
 152 {
 153   Lisp_Object path_entry, submenu_desc, submenu;
 154   struct gcpro gcpro1;
 155   struct gui_item gui_item;
 156
 157   gui_item_init (&gui_item);
 158   GCPRO_GUI_ITEM (&gui_item);
 159
 160   EXTERNAL_LIST_LOOP (path_entry, path)
 161     {
 162       /* Verify that DESC describes a menu, not single item */
 163       if (!CONSP (desc))
 164         RETURN_UNGCPRO (Qnil);
 165
 166       /* Parse this menu */
 167       desc = menu_parse_submenu_keywords (desc, &gui_item);
 168
 169       /* Check that this (sub)menu is active */
 170       if (!gui_item_active_p (&gui_item))
 171         RETURN_UNGCPRO (Qnil);
 172
 173       /* Apply :filter */
 174       if (!NILP (gui_item.filter))
 175         desc = call1 (gui_item.filter, desc);
 176
 177       /* Find the next menu on the path inside this one */
 178       EXTERNAL_LIST_LOOP (submenu_desc, desc)
 179         {
 180           submenu = XCAR (submenu_desc);
 181           if (CONSP (submenu)
 182               && STRINGP (XCAR (submenu))
 183               && !NILP (Fstring_equal (XCAR (submenu), XCAR (path_entry))))
 184             {
 185               desc = submenu;
 186               goto descend;
 187             }
 188         }
 189       /* Submenu not found */
 190       RETURN_UNGCPRO (Qnil);
 191
 192     descend:
 193       /* Prepare for the next iteration */
 194       gui_item_init (&gui_item);
 195     }
 196
 197   /* We have successfully descended down the end of the path */
 198   UNGCPRO;
 199   return desc;
 200 }
 201
 202 DEFUN ("popup-menu", Fpopup_menu, 1, 2, 0, /*
 203 Pop up the given menu.
 204 A menu description is a list of menu items, strings, and submenus.
 205
 206 The first element of a menu must be a string, which is the name of the menu.
 207 This is the string that will be displayed in the parent menu, if any.  For
 208 toplevel menus, it is ignored.  This string is not displayed in the menu
 209 itself.
 210
 211 If an element of a menu is a string, then that string will be presented in
 212 the menu as unselectable text.
 213
 214 If an element of a menu is a string consisting solely of hyphens, then that
 215 item will be presented as a solid horizontal line.
 216
 217 If an element of a menu is a list, it is treated as a submenu.  The name of
 218 that submenu (the first element in the list) will be used as the name of the
 219 item representing this menu on the parent.
 220
 221 Otherwise, the element must be a vector, which describes a menu item.
 222 A menu item can have any of the following forms:
 223
 224  [ "name" callback <active-p> ]
 225  [ "name" callback <active-p> <suffix> ]
 226  [ "name" callback :<keyword> <value>  :<keyword> <value> ... ]
 227
 228 The name is the string to display on the menu; it is filtered through the
 229 resource database, so it is possible for resources to override what string
 230 is actually displayed.
 231
 232 If the `callback' of a menu item is a symbol, then it must name a command.
 233 It will be invoked with `call-interactively'.  If it is a list, then it is
 234 evaluated with `eval'.
 235
 236 The possible keywords are this:
 237
 238  :active   <form>    Same as <active-p> in the first two forms: the
 239                      expression is evaluated just before the menu is
 240                      displayed, and the menu will be selectable only if
 241                      the result is non-nil.
 242
 243  :suffix   <form>    Same as <suffix> in the second form: the expression
 244                      is evaluated just before the menu is displayed and
 245                      resulting string is appended to the displayed name,
 246                      providing a convenient way of adding the name of a
 247                      command's ``argument'' to the menu, like
 248                      ``Kill Buffer NAME''.
 249
 250  :keys     "string"  Normally, the keyboard equivalents of commands in
 251                      menus are displayed when the `callback' is a symbol.
 252                      This can be used to specify keys for more complex menu
 253                      items.  It is passed through `substitute-command-keys'
 254                      first.
 255
 256  :style    <style>   Specifies what kind of object this menu item is:
 257
 258                         nil     A normal menu item.
 259                         toggle  A toggle button.
 260                         radio   A radio button.
 261
 262                      The only difference between toggle and radio buttons is
 263                      how they are displayed.  But for consistency, a toggle
 264                      button should be used when there is one option whose
 265                      value can be turned on or off, and radio buttons should
 266                      be used when there is a set of mutually exclusive
 267                      options.  When using a group of radio buttons, you
 268                      should arrange for no more than one to be marked as
 269                      selected at a time.
 270
 271  :selected <form>    Meaningful only when STYLE is `toggle' or `radio'.
 272                      This specifies whether the button will be in the
 273                      selected or unselected state.
 274
 275 For example:
 276
 277  [ "Save As..."    write-file  t ]
 278  [ "Revert Buffer" revert-buffer (buffer-modified-p) ]
 279  [ "Read Only"     toggle-read-only :style toggle :selected buffer-read-only ]
 280
 281 See menubar.el for many more examples.
 282 */
 283        (menu_desc, event))
 284 {
 285   struct frame *f = decode_frame(Qnil);
 286   MAYBE_FRAMEMETH (f, popup_menu, (menu_desc,event));
 287   return Qnil;
 288 }
 289
 290 DEFUN ("normalize-menu-item-name", Fnormalize_menu_item_name, 1, 2, 0, /*
 291 Convert a menu item name string into normal form, and return the new string.
 292 Menu item names should be converted to normal form before being compared.
 293 */
 294        (name, buffer))
 295 {
 296   struct buffer *buf = decode_buffer (buffer, 0);
 297   struct Lisp_String *n;
 298   Charcount end;
 299   int i;
 300   Bufbyte *name_data;
 301   Bufbyte *string_result;
 302   Bufbyte *string_result_ptr;
 303   Emchar elt;
 304   int expecting_underscore = 0;
 305
 306   CHECK_STRING (name);
 307
 308   n = XSTRING (name);
 309   end = string_char_length (n);
 310   name_data = string_data (n);
 311
 312   string_result = (Bufbyte *) alloca (end * MAX_EMCHAR_LEN);
 313   string_result_ptr = string_result;
 314   for (i = 0; i < end; i++)
 315     {
 316       elt = charptr_emchar (name_data);
 317       elt = DOWNCASE (buf, elt);
 318       if (expecting_underscore)
 319         {
 320           expecting_underscore = 0;
 321           switch (elt)
 322             {
 323             case '%':
 324               /* Allow `%%' to mean `%'.  */
 325               string_result_ptr += set_charptr_emchar (string_result_ptr, '%');
 326               break;
 327             case '_':
 328               break;
 329             default:
 330               string_result_ptr += set_charptr_emchar (string_result_ptr, '%');
 331               string_result_ptr += set_charptr_emchar (string_result_ptr, elt);
 332             }
 333         }
 334       else if (elt == '%')
 335         expecting_underscore = 1;
 336       else
 337         string_result_ptr += set_charptr_emchar (string_result_ptr, elt);
 338       INC_CHARPTR (name_data);
 339     }
 340
 341   return make_string (string_result, string_result_ptr - string_result);
 342 }
 343
 344 void
 345 syms_of_menubar (void)
 346 {
 347   defsymbol (&Qcurrent_menubar, "current-menubar");
 348   DEFSUBR (Fpopup_menu);
 349   DEFSUBR (Fnormalize_menu_item_name);
 350   DEFSUBR (Fmenu_find_real_submenu);
 351 }
 352
 353 void
 354 vars_of_menubar (void)
 355 {
 356   {
 357     /* put in Vblank_menubar a menubar value which has no visible
 358      * items.  This is a bit tricky due to various quirks.  We
 359      * could use '(["" nil nil]), but this is apparently equivalent
 360      * to '(nil), and a new frame created with this menubar will
 361      * get a vertically-squished menubar.  If we use " " as the
 362      * button title instead of "", we get an etched button border.
 363      * So we use
 364      *  '(("No active menubar" ["" nil nil]))
 365      * which creates a menu whose title is "No active menubar",
 366      * and this works fine.
 367      */
 368
 369     Lisp_Object menu_item[3];
 370     static CONST char *blank_msg = "No active menubar";
 371
 372     menu_item[0] = build_string ("");
 373     menu_item[1] = Qnil;
 374     menu_item[2] = Qnil;
 375     Vblank_menubar = Fcons (Fcons (build_string (blank_msg),
 376                                    Fcons (Fvector (3, &menu_item[0]),
 377                                           Qnil)),
 378                             Qnil);
 379     Vblank_menubar = Fpurecopy (Vblank_menubar);
 380     staticpro (&Vblank_menubar);
 381   }
 382
 383   DEFVAR_BOOL ("popup-menu-titles", &popup_menu_titles /*
 384 If true, popup menus will have title bars at the top.
 385 */ );
 386   popup_menu_titles = 1;
 387
 388   /* #### Replace current menubar with a specifier. */
 389
 390   /* All C code must access the menubar via Qcurrent_menubar
 391      because it can be buffer-local.  Note that Vcurrent_menubar
 392      doesn't need to exist at all, except for the magic function. */
 393
 394   DEFVAR_LISP_MAGIC ("current-menubar", &Vcurrent_menubar /*
 395 The current menubar.  This may be buffer-local.
 396
 397 When the menubar is changed, the function `set-menubar-dirty-flag' has to
 398 be called for the menubar to be updated on the frame.  See `set-menubar'
 399 and `set-buffer-menubar'.
 400
 401 A menubar is a list of menus and menu-items.
 402 A menu is a list of menu items, keyword-value pairs, strings, and submenus.
 403
 404 The first element of a menu must be a string, which is the name of the menu.
 405 This is the string that will be displayed in the parent menu, if any.  For
 406 toplevel menus, it is ignored.  This string is not displayed in the menu
 407 itself.
 408
 409 Immediately following the name string of the menu, any of three
 410 optional keyword-value pairs is permitted.
 411
 412 If an element of a menu (or menubar) is a string, then that string will be
 413 presented as unselectable text.
 414
 415 If an element of a menu is a string consisting solely of hyphens, then that
 416 item will be presented as a solid horizontal line.
 417
 418 If an element of a menu is a list, it is treated as a submenu.  The name of
 419 that submenu (the first element in the list) will be used as the name of the
 420 item representing this menu on the parent.
 421
 422 If an element of a menubar is `nil', then it is used to represent the
 423 division between the set of menubar-items which are flushleft and those
 424 which are flushright.
 425
 426 Otherwise, the element must be a vector, which describes a menu item.
 427 A menu item can have any of the following forms:
 428
 429  [ "name" callback <active-p> ]
 430  [ "name" callback <active-p> <suffix> ]
 431  [ "name" callback :<keyword> <value>  :<keyword> <value> ... ]
 432
 433 The name is the string to display on the menu; it is filtered through the
 434 resource database, so it is possible for resources to override what string
 435 is actually displayed.
 436
 437 If the `callback' of a menu item is a symbol, then it must name a command.
 438 It will be invoked with `call-interactively'.  If it is a list, then it is
 439 evaluated with `eval'.
 440
 441 The possible keywords are this:
 442
 443  :active   <form>    Same as <active-p> in the first two forms: the
 444                      expression is evaluated just before the menu is
 445                      displayed, and the menu will be selectable only if
 446                      the result is non-nil.
 447
 448  :suffix   <form>    Same as <suffix> in the second form: the expression
 449                      is evaluated just before the menu is displayed and
 450                      resulting string is appended to the displayed name,
 451                      providing a convenient way of adding the name of a
 452                      command's ``argument'' to the menu, like
 453                      ``Kill Buffer NAME''.
 454
 455  :keys     "string"  Normally, the keyboard equivalents of commands in
 456                      menus are displayed when the `callback' is a symbol.
 457                      This can be used to specify keys for more complex menu
 458                      items.  It is passed through `substitute-command-keys'
 459                      first.
 460
 461  :style    <style>   Specifies what kind of object this menu item is:
 462
 463                         nil     A normal menu item.
 464                         toggle  A toggle button.
 465                         radio   A radio button.
 466                         button  A menubar button.
 467
 468                      The only difference between toggle and radio buttons is
 469                      how they are displayed.  But for consistency, a toggle
 470                      button should be used when there is one option whose
 471                      value can be turned on or off, and radio buttons should
 472                      be used when there is a set of mutually exclusive
 473                      options.  When using a group of radio buttons, you
 474                      should arrange for no more than one to be marked as
 475                      selected at a time.
 476
 477  :selected <form>    Meaningful only when STYLE is `toggle', `radio' or
 478                      `button'.  This specifies whether the button will be in
 479                      the selected or unselected state.
 480
 481  :included <form>    This can be used to control the visibility of a menu or
 482                      menu item.  The form is evaluated and the menu or menu
 483                      item is only displayed if the result is non-nil.
 484
 485  :config  <symbol>   This is an efficient shorthand for
 486                          :included (memq symbol menubar-configuration)
 487                      See the variable `menubar-configuration'.
 488
 489  :filter <function>  A menu filter can only be used in a menu item list.
 490                      (i.e.:  not in a menu item itself).  It is used to
 491                      sensitize or incrementally create a submenu only when
 492                      it is selected by the user and not every time the
 493                      menubar is activated.  The filter function is passed
 494                      the list of menu items in the submenu and must return a
 495                      list of menu items to be used for the menu.  It is
 496                      called only when the menu is about to be displayed, so
 497                      other menus may already be displayed.  Vile and
 498                      terrible things will happen if a menu filter function
 499                      changes the current buffer, window, or frame.  It
 500                      also should not raise, lower, or iconify any frames.
 501                      Basically, the filter function should have no
 502                      side-effects.
 503
 504  :key-sequence keys  Used in FSF Emacs as an hint to an equivalent keybinding.
 505                      Ignored by XEnacs for easymenu.el compatability.
 506
 507  :label <form>       (unimplemented!) Like :suffix, but replaces label
 508                      completely.
 509                      (might be added in 21.2).
 510
 511 For example:
 512
 513  ("File"
 514   :filter file-menu-filter      ; file-menu-filter is a function that takes
 515                                 ; one argument (a list of menu items) and
 516                                 ; returns a list of menu items
 517   [ "Save As..."    write-file  t ]
 518   [ "Revert Buffer" revert-buffer (buffer-modified-p) ]
 519   [ "Read Only"     toggle-read-only :style toggle
 520                       :selected buffer-read-only ]
 521   )
 522
 523 See x-menubar.el for many more examples.
 524
 525 After the menubar is clicked upon, but before any menus are popped up,
 526 the functions on the `activate-menubar-hook' are invoked to make top-level
 527 changes to the menus and menubar.  Note, however, that the use of menu
 528 filters (using the :filter keyword) is usually a more efficient way to
 529 dynamically alter or sensitize menus.
 530 */, menubar_variable_changed);
 531
 532   Vcurrent_menubar = Qnil;
 533
 534   DEFVAR_LISP ("activate-menubar-hook", &Vactivate_menubar_hook /*
 535 Function or functions called before a menubar menu is pulled down.
 536 These functions are called with no arguments, and should interrogate and
 537 modify the value of `current-menubar' as desired.
 538
 539 The functions on this hook are invoked after the mouse goes down, but before
 540 the menu is mapped, and may be used to activate, deactivate, add, or delete
 541 items from the menus.  However, it is probably the case that using a :filter
 542 keyword in a submenu would be a more efficient way of updating menus.  See
 543 the documentation of `current-menubar'.
 544
 545 These functions may return the symbol `t' to assert that they have made
 546 no changes to the menubar.  If any other value is returned, the menubar is
 547 recomputed.  If `t' is returned but the menubar has been changed, then the
 548 changes may not show up right away.  Returning `nil' when the menubar has
 549 not changed is not so bad; more computation will be done, but redisplay of
 550 the menubar will still be performed optimally.
 551 */ );
 552   Vactivate_menubar_hook = Qnil;
 553   defsymbol (&Qactivate_menubar_hook, "activate-menubar-hook");
 554
 555   DEFVAR_BOOL ("menubar-show-keybindings", &menubar_show_keybindings /*
 556 If true, the menubar will display keyboard equivalents.
 557 If false, only the command names will be displayed.
 558 */ );
 559   menubar_show_keybindings = 1;
 560
 561   DEFVAR_LISP_MAGIC ("menubar-configuration", &Vmenubar_configuration /*
 562 A list of symbols, against which the value of the :config tag for each
 563 menubar item will be compared.  If a menubar item has a :config tag, then
 564 it is omitted from the menubar if that tag is not a member of the
 565 `menubar-configuration' list.
 566 */ , menubar_variable_changed);
 567   Vmenubar_configuration = Qnil;
 568
 569   DEFVAR_LISP ("menubar-pointer-glyph", &Vmenubar_pointer_glyph /*
 570 *The shape of the mouse-pointer when over the menubar.
 571 This is a glyph; use `set-glyph-image' to change it.
 572 If unspecified in a particular domain, the window-system-provided
 573 default pointer is used.
 574 */ );
 575
 576   Fprovide (intern ("menubar"));
 577 }
 578
 579 void
 580 specifier_vars_of_menubar (void)
 581 {
 582   DEFVAR_SPECIFIER ("menubar-visible-p", &Vmenubar_visible_p /*
 583 *Whether the menubar is visible.
 584 This is a specifier; use `set-specifier' to change it.
 585 */ );
 586   Vmenubar_visible_p = Fmake_specifier (Qboolean);
 587
 588   set_specifier_fallback (Vmenubar_visible_p, list1 (Fcons (Qnil, Qt)));
 589   set_specifier_caching (Vmenubar_visible_p,
 590                          slot_offset (struct window,
 591                                       menubar_visible_p),
 592                          menubar_visible_p_changed,
 593                          slot_offset (struct frame,
 594                                       menubar_visible_p),
 595                          menubar_visible_p_changed_in_frame);
 596 }
 597
 598 void
 599 complex_vars_of_menubar (void)
 600 {
 601   Vmenubar_pointer_glyph = Fmake_glyph_internal (Qpointer);
 602 }