This commit was generated by cvs2svn to compensate for changes in r41, which
[chise/xemacs-chise.git.1] / 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 }