home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / menubar.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-03-13  |  37.6 KB  |  1,317 lines
  1. /* Implements an elisp-programmable menubar.
  2.  
  3. This file is part of GNU Emacs.
  4.  
  5. GNU Emacs is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 1, or (at your option)
  8. any later version.
  9.  
  10. GNU Emacs is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. GNU General Public License for more details.
  14.  
  15. You should have received a copy of the GNU General Public License
  16. along with GNU Emacs; see the file COPYING.  If not, write to
  17. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  18.  
  19. /* created 16-dec-91 by jwz */
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23.  
  24. #include <stdio.h>
  25.  
  26. #include <X11/Intrinsic.h>
  27. #include <X11/StringDefs.h>
  28. #include <X11/Xaw/Paned.h>
  29.  
  30. #include "lwlib.h"
  31.  
  32. #include "screen.h"
  33. #include "events.h"
  34. #include "xterm.h"
  35. #include "window.h"
  36. #include "buffer.h"
  37.  
  38. #ifdef LWLIB_USES_MOTIF
  39. /* right now there is only Motif support for dialog boxes */
  40. # define HAVE_DIALOG_BOXES
  41. #endif
  42.  
  43. /* This variable is 1 if the menubar widget has to be updated. 
  44.  It is set to 1 by set-menubar-dirty-flag and cleared when the widget
  45.  has been indapted. */
  46. static int menubar_has_changed;
  47.  
  48. Lisp_Object Qcurrent_menubar;
  49.  
  50. static void
  51. set_screen_menubar (struct screen *s, int deep_p);
  52.  
  53. /* we need a unique id for each popup menu and dialog box */
  54. unsigned int popup_id_tick;
  55.  
  56. /* count of menus/dboxes currently up */
  57. int popup_menu_up_p;
  58. int dbox_up_p;
  59.  
  60. int menubar_show_keybindings;
  61.  
  62. /* This converts a lisp description of a menubar into a tree of widget_value
  63.    structures.  It allocates widget_values with malloc_widget_value() and
  64.    allocates other storage only for the `key' slot.  All other slots are 
  65.    filled with pointers to Lisp_String data.  We allocate a widget_value
  66.    description of the menu or menubar, and hand it to lwlib, which then 
  67.    makes a copy of it, which it manages internally.  We then immediately
  68.    free our version; it will not be referenced again.
  69.  */
  70. static widget_value *
  71. menu_item_descriptor_to_widget_value (desc, menubar_p, deep_p)
  72.      Lisp_Object desc;
  73.      int menubar_p, deep_p;
  74. {
  75.   widget_value *wv;
  76.   BLOCK_INPUT;
  77.   wv = malloc_widget_value ();
  78.   UNBLOCK_INPUT;
  79.  
  80.   switch (XTYPE (desc))
  81.     {
  82.     case Lisp_String:
  83.       wv->name = (char *) XSTRING (desc)->data;
  84.       wv->value = 0;
  85.       wv->enabled = 1;
  86.       break;
  87.     case Lisp_Vector:
  88.       if (XVECTOR (desc)->size < 3 || XVECTOR (desc)->size > 4)
  89.     Fsignal (Qerror,
  90.          Fcons (build_string("button descriptors must be 3 or 4 long"),
  91.             Fcons (desc, Qnil)));
  92.       CHECK_STRING (XVECTOR (desc)->contents [0], 0);
  93.       wv->name = (char *) XSTRING (XVECTOR (desc)->contents [0])->data;
  94.       if (XVECTOR (desc)->size == 4 && !NILP (XVECTOR (desc)->contents [3]))
  95.     {
  96.       CHECK_STRING (XVECTOR (desc)->contents [3], 0);
  97.       wv->value = (char *) XSTRING (XVECTOR (desc)->contents [3])->data;
  98.     }
  99.       else
  100.     wv->value = 0;
  101.       wv->enabled = (Qnil != XVECTOR (desc)->contents [2]);
  102.       wv->call_data = (XtPointer) (XVECTOR (desc)->contents [1]);
  103.       if (menubar_show_keybindings &&
  104.       SYMBOLP ((Lisp_Object) wv->call_data))
  105.     {
  106.       char buf [1024];
  107.       where_is_to_char ((Lisp_Object) wv->call_data,
  108.                 Fcurrent_local_map (), Qnil, buf);
  109.       if (buf [0])
  110.         {
  111.           int len = strlen (buf) + 1;
  112.           wv->key = xmalloc (len);
  113.           memcpy (wv->key, buf, len);
  114.         }
  115.       else
  116.         wv->key = 0;
  117.     }
  118.       break;
  119.     case Lisp_Cons:
  120.       if (STRINGP (XCONS (desc)->car))
  121.     {
  122.       wv->name = (char *) XSTRING (XCONS (desc)->car)->data;
  123.       desc = Fcdr (desc);
  124.     }
  125.       else if (menubar_p)
  126.     wv->name = "menubar";
  127.       else
  128.     {
  129.       while (1)
  130.         Fsignal (Qerror,
  131.              Fcons (build_string
  132.                 ("menu name (first element) must be a string"),
  133.                 Fcons (desc, Qnil)));
  134.     }
  135.  
  136.       wv->value = 0;
  137.       wv->enabled = 1;
  138.       if (deep_p || menubar_p)
  139.     {
  140.       widget_value *prev = 0, *next;
  141.       for (; !NILP (desc); desc = Fcdr (desc))
  142.         {
  143.           next = menu_item_descriptor_to_widget_value (Fcar (desc),
  144.                                0, deep_p);
  145.           if (! next)
  146.         continue;
  147.           else if (prev)
  148.         prev->next = next;
  149.           else
  150.         wv->contents = next;
  151.           prev = next;
  152.         }
  153.     }
  154.       if (deep_p && !wv->contents)
  155.     {
  156.       free_widget_value (wv);
  157.       wv = 0;
  158.     }
  159.       break;
  160.     default:
  161.       free_widget_value (wv);
  162.       wv = 0;
  163.       if (!NILP (desc)) /* ignore nil for now */
  164.     while (1)
  165.       Fsignal (Qerror, Fcons (build_string ("unrecognised descriptor"),
  166.                   Fcons (desc, Qnil)));
  167.     }
  168.   return wv;
  169. }
  170.  
  171.  
  172. /* This recursively calls free_widget_value() on the tree of widgets.
  173.    It must free all data that was malloc'ed for these widget_values.
  174.    Currently, emacs only allocates new storage for the `key' slot.
  175.    All other slots are pointers into the data of Lisp_Strings, and
  176.    must be left alone.
  177.  */
  178. static void
  179. free_menubar_widget_value_tree (widget_value *wv)
  180. {
  181.   if (! wv) return;
  182.   if (wv->key) xfree (wv->key);
  183.  
  184.   wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
  185.  
  186.   if (wv->contents && (wv->contents != (widget_value*)1))
  187.     {
  188.       free_menubar_widget_value_tree (wv->contents);
  189.       wv->contents = (widget_value *) 0xDEADBEEF;
  190.     }
  191.   if (wv->next)
  192.     {
  193.       free_menubar_widget_value_tree (wv->next);
  194.       wv->next = (widget_value *) 0xDEADBEEF;
  195.     }
  196.   free_widget_value (wv);
  197. }
  198.  
  199.  
  200. /* screen->menubar_data holds a Lisp_Vector.
  201.    In this code, we treat that vector as a menubar_data structure.
  202.  */
  203. struct menubar_data
  204. {
  205.   int size;
  206.   struct Lisp_Vector *next;
  207.  
  208.   /* This is the last buffer for which the menubar was displayed.
  209.      If the buffer has changed, we may have to update things.
  210.    */
  211.   Lisp_Object last_menubar_buffer;
  212.  
  213.   /* This flag tells us if the menubar contents are up-to-date with respect
  214.      to the current menubar structure.  If we want to actually pull down a
  215.      menu and this is false, then we need to update things.
  216.    */
  217.   Lisp_Object menubar_contents_up_to_date;
  218.  
  219.   /* This is a vector of all of the callbacks of the menubar menu buttons.
  220.      This is used only to protect them from being GCed, since the only other
  221.      pointer to these lisp objects might be down in the private lwlib.c
  222.      structures, which GC doesn't know about.
  223.    */
  224.   Lisp_Object menubar_callbacks;
  225. };
  226.  
  227. #define SCREEN_MENUBAR_DATA(screen) \
  228.   ((struct menubar_data *) XVECTOR ((screen)->menubar_data))
  229.  
  230. #define MENUBAR_DATA_SIZE \
  231.   ((sizeof (struct menubar_data) / sizeof (Lisp_Object)) - 2)
  232.  
  233. /* This is like SCREEN_MENUBAR_DATA(s)->menubar_callbacks, but contains an
  234.    alist of (id . vector) for the callbacks of the popup menus and dialog
  235.    boxes.  The menubar_callbacks are really just a degenerate case of this,
  236.    but it is easier if those are screen-local, and popups are global.
  237.  */
  238. static Lisp_Object Vpopup_callbacks;
  239.  
  240.  
  241. static int
  242. gcpro_menu_callbacks_1 (Lisp_Object menu, Lisp_Object *vector, int index)
  243. {
  244.   if (menu == Qnil)
  245.     return index;
  246.   switch (XTYPE (menu))
  247.     {
  248.     case Lisp_Vector:
  249.       if (XVECTOR (menu)->size > 2)
  250.     {
  251.       if (XVECTOR (*vector)->size <= index)
  252.         {
  253.           /* reallocate the vector by doubling its size */
  254.           Lisp_Object new_vector = Fmake_vector (index * 2, Qnil);
  255.           memcpy (XVECTOR (new_vector)->contents,
  256.               XVECTOR (*vector)->contents,
  257.               XVECTOR (*vector)->size * sizeof (Lisp_Object));
  258.           *vector = new_vector;
  259.         }
  260.       XVECTOR (*vector)->contents [index] = XVECTOR (menu)->contents [1];
  261.       index++;
  262.     }
  263.       break;
  264.       
  265.     case Lisp_String:
  266.       break;
  267.  
  268.     case Lisp_Cons:
  269.       {
  270.     Lisp_Object current;
  271.     for (current = menu; !NILP (current); current = Fcdr (current))
  272.       index = gcpro_menu_callbacks_1 (Fcar (current), vector, index);
  273.     break;
  274.       }
  275.     default:
  276.       /* syntax checking has already been done */
  277.       abort ();
  278.     }
  279.   return index;
  280. }
  281.  
  282. static void
  283. gcpro_menu_callbacks (Lisp_Object menu, Lisp_Object *vector)
  284. {
  285.   int i, end;
  286.   if (NILP (*vector))
  287.     *vector = Fmake_vector (make_number (10), Qnil);
  288.   else if (!VECTORP (*vector))
  289.     abort ();
  290.  
  291.   end = gcpro_menu_callbacks_1 (menu, vector, 0);
  292.  
  293.   /* pad it with nil, so that we don't continue protecting things
  294.      we don't need any more */
  295.   for (i = end; i < XVECTOR (*vector)->size; i++)
  296.     XVECTOR (*vector)->contents [i] = Qnil;
  297. }
  298.  
  299. static void
  300. gcpro_popup_callbacks (Lisp_Object id, Lisp_Object menu)
  301. {
  302.   Lisp_Object data;
  303.   if (!NILP (assq_no_quit (id, Vpopup_callbacks)))
  304.     abort ();
  305.   data = Fcons (id, Qnil);
  306.   gcpro_menu_callbacks (menu, &XCONS(data)->cdr);
  307.   Vpopup_callbacks = Fcons (data, Vpopup_callbacks);
  308. }
  309.  
  310. static void
  311. ungcpro_popup_callbacks (Lisp_Object id)
  312. {
  313.   Lisp_Object this = assq_no_quit (id, Vpopup_callbacks);
  314.   if (NILP (this))
  315.     abort ();
  316.   Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks);
  317. }
  318.  
  319.  
  320. extern Lisp_Object Qeval, Vrun_hooks;
  321. Lisp_Object Qactivate_menubar_hook, Vactivate_menubar_hook;
  322. struct screen *x_any_window_to_screen (Window);
  323.  
  324. static void
  325. pre_activate_callback (widget, id, client_data)
  326.      Widget widget;
  327.      LWLIB_ID id;
  328.      XtPointer client_data;
  329. {
  330.   struct gcpro gcpro1;
  331.   struct screen* s = x_any_window_to_screen (XtWindow (widget));
  332.   Lisp_Object menubar_data;
  333.   Lisp_Object rest = Qnil;
  334.   int any_changes = 0;
  335.  
  336.   if (!s)
  337.     s = x_any_window_to_screen (XtWindow (XtParent (widget)));
  338.   if (!s)
  339.     return;
  340.  
  341.   menubar_data = s->menubar_data;
  342.   if (!VECTORP (menubar_data))
  343.     return;
  344.  
  345.   /* make the activate-menubar-hook be a list of functions, not a single
  346.      function, just to simplify things. */
  347.   if (!NILP (Vactivate_menubar_hook) &&
  348.       (!CONSP (Vactivate_menubar_hook) ||
  349.        EQ (XCONS (Vactivate_menubar_hook)->car, Qlambda)))
  350.     Vactivate_menubar_hook = Fcons (Vactivate_menubar_hook, Qnil);
  351.  
  352.   GCPRO1 (rest);
  353.   for (rest = Vactivate_menubar_hook; !NILP (rest); rest = Fcdr (rest))
  354.     if (!EQ (call0 (XCONS (rest)->car), Qt))
  355.       any_changes = 1;
  356.   if (any_changes ||
  357.       NILP (SCREEN_MENUBAR_DATA (s)->menubar_contents_up_to_date))
  358.     set_screen_menubar (s, 1);
  359.   UNGCPRO;
  360. }
  361.  
  362.  
  363. extern Time mouse_timestamp;
  364. extern Time global_mouse_timestamp;
  365. extern Lisp_Object Faccept_process_output ();
  366.  
  367. static void
  368. menubar_selection_callback (Widget ignored_widget,
  369.                 LWLIB_ID ignored_id,
  370.                 XtPointer client_data)
  371. {
  372.   Lisp_Object event, fn, arg;
  373.   Lisp_Object data = (Lisp_Object) client_data;
  374.  
  375.   if (((int) client_data) == 0)
  376.     return;
  377.  
  378.   /* Flush the X and process input */
  379.   Faccept_process_output (Qnil);
  380.  
  381.   if (((int) client_data) == -1)
  382.     {
  383.       fn = intern ("run-hooks");
  384.       arg = intern ("menu-no-selection-hook");
  385.     }
  386.   else if (SYMBOLP (data))
  387.     {
  388.       fn = Qcall_interactively;
  389.       arg = data;
  390.     }
  391.   else if (CONSP (data))
  392.     {
  393.       fn = Qeval;
  394.       arg = data;
  395.     }
  396.   else
  397.     {
  398.       fn = Qeval;
  399.       arg =
  400.     Fcons (intern ("signal"),
  401.            Fcons (Fcons (intern ("quote"), Fcons (Qerror, Qnil)),
  402.               Fcons (Fcons (intern ("quote"),
  403.                     Fcons (Fcons (build_string ("illegal menu callback"),
  404.                           Fcons (data, Qnil)),
  405.                        Qnil)),
  406.                  Qnil)));
  407.     }
  408.  
  409.   event = Fallocate_event ();
  410.   XEVENT (event)->event_type = menu_event;
  411.   XEVENT (event)->event.eval.function = fn;
  412.   XEVENT (event)->event.eval.object = arg;
  413.  
  414.   /* This is the timestamp used for asserting focus so we need to get an
  415.      up-to-date value event if no events has been dispatched to emacs
  416.    */
  417.   mouse_timestamp = global_mouse_timestamp;
  418.  
  419.   enqueue_command_event (event);
  420. }
  421.  
  422. DEFUN ("set-menubar-dirty-flag", Fset_menubar_dirty_flag,
  423.        Sset_menubar_dirty_flag, 0, 0, 0,
  424.        "Tells emacs that the menubar widget has to be updated")
  425.      ()
  426. {
  427.   menubar_has_changed = 1;
  428.   return Qnil;
  429. }
  430.  
  431. #ifdef ENERGIZE
  432. extern int *get_psheets_for_buffer (Lisp_Object, int *);
  433.  
  434. static void
  435. set_panel_button_sensitivity (struct screen* s, widget_value* data)
  436. {
  437.   struct x_display *x = s->display.x;
  438.   struct window *window = XWINDOW (s->selected_window);
  439.   int current_buffer_psheets_count = 0;
  440.   int *current_buffer_psheets =
  441.     get_psheets_for_buffer (window->buffer, ¤t_buffer_psheets_count);
  442.   int panel_enabled = x->desired_psheets || current_buffer_psheets_count;
  443.   widget_value* val;
  444.   for (val = data->contents; val; val = val->next)
  445.     if (!strcmp (val->name, "sheet"))
  446.       {
  447.     val->enabled = panel_enabled;
  448.     return;
  449.       }
  450. }
  451. #endif /* ENERGIZE */
  452.  
  453. static widget_value*
  454. compute_menubar_data (struct screen* s, Lisp_Object menubar, int deep_p)
  455. {
  456.   widget_value* data;
  457.  
  458.   if (NILP (menubar))
  459.     data = 0;
  460.   else
  461.     {
  462.       data = menu_item_descriptor_to_widget_value (menubar, 1, deep_p);
  463. #ifdef ENERGIZE
  464.       if (data)
  465.     set_panel_button_sensitivity (s, data);
  466. #endif
  467.     }
  468.   return data;
  469. }
  470.  
  471. static void
  472. set_screen_menubar (struct screen *s, int deep_p)
  473. {
  474.   widget_value *data;
  475.   Lisp_Object obuf = Fcurrent_buffer ();
  476.   Lisp_Object menubar;
  477.  
  478.   if (! SCREEN_IS_X (s))
  479.     return;
  480.  
  481.   /* evaluate `current-menubar' in the buffer of the selected window of
  482.      the screen in question.
  483.      */
  484.   Fset_buffer (XWINDOW (s->selected_window)->buffer);
  485.   menubar = Fsymbol_value (Qcurrent_menubar);
  486.   Fset_buffer (obuf);
  487.  
  488.   data = compute_menubar_data (s, menubar, deep_p);
  489.  
  490.   if (NILP (s->menubar_data))
  491.     s->menubar_data = Fmake_vector (MENUBAR_DATA_SIZE, Qnil);
  492.  
  493.   {
  494.     Widget menubar_widget = s->display.x->menubar_widget;
  495.     int id = (int) s;
  496.  
  497.     if (data && !data->next && !data->contents)
  498.       abort ();
  499.  
  500.     BLOCK_INPUT;
  501.  
  502.     if (!data)
  503.       {
  504.     if (menubar_widget)
  505.       lw_destroy_all_widgets (id);
  506.     s->display.x->menubar_widget = 0;
  507.       }
  508.     else if (menubar_widget)
  509.       lw_modify_all_widgets (id, data, deep_p ? True : False);
  510.     else
  511.       {
  512.     Widget parent = s->display.x->column_widget;
  513.  
  514.     /* It's the first time we map the menubar so compute its
  515.        contents completely once.  This makes sure that the menubar
  516.        components are created with the right type. */
  517.     if (!deep_p)
  518.       {
  519.         free_menubar_widget_value_tree (data);
  520.         data = compute_menubar_data (s, menubar, 1);
  521.       }
  522.  
  523.     menubar_widget =
  524.       lw_create_widget ("menubar", "menubar", id, data, parent,
  525.                 0, pre_activate_callback,
  526.                 menubar_selection_callback, 0);
  527.     s->display.x->menubar_widget = menubar_widget;
  528.     XtVaSetValues (menubar_widget,
  529.                XtNshowGrip, 0,
  530.                XtNresizeToPreferred, 1,
  531.                XtNallowResize, 1,
  532.                0);
  533.       }
  534.     UNBLOCK_INPUT;
  535.   }
  536.   if (data) free_menubar_widget_value_tree (data);
  537.   SCREEN_MENUBAR_DATA (s)->menubar_contents_up_to_date = deep_p ? Qt : Qnil;
  538.   SCREEN_MENUBAR_DATA (s)->last_menubar_buffer =
  539.     XWINDOW (s->selected_window)->buffer;
  540.   menubar_has_changed = 0;
  541.  
  542.   gcpro_menu_callbacks (menubar, &SCREEN_MENUBAR_DATA (s)->menubar_callbacks);
  543.  
  544. }
  545.  
  546. static LWLIB_ID last_popup_selection_callback_id;
  547.  
  548. static void
  549. popup_selection_callback (widget, id, client_data)
  550.      Widget widget;
  551.      LWLIB_ID id;
  552.      XtPointer client_data;
  553. {
  554.   last_popup_selection_callback_id = id;
  555.   menubar_selection_callback (widget, id, client_data);
  556.   /* lw_destroy_all_widgets() will be called from popup_down_callback() */
  557. }
  558.  
  559. static void
  560. popup_down_callback (widget, id, client_data)
  561.      Widget widget;
  562.      LWLIB_ID id;
  563.      XtPointer client_data;
  564. {
  565.   if (popup_menu_up_p == 0) abort ();
  566.   popup_menu_up_p--;
  567.   /* if this isn't called immediately after the selection callback, then
  568.      there wasn't a menu selection. */
  569.   if (id != last_popup_selection_callback_id)
  570.     menubar_selection_callback (widget, id, (XtPointer) -1);
  571.   BLOCK_INPUT;
  572.   lw_destroy_all_widgets (id);
  573.   UNBLOCK_INPUT;
  574.   ungcpro_popup_callbacks (make_number (id));
  575. }
  576.  
  577. #ifdef HAVE_DIALOG_BOXES
  578.  
  579. static void maybe_run_dbox_text_callback (LWLIB_ID);
  580.  
  581. static void
  582. dbox_selection_callback (widget, id, client_data)
  583.      Widget widget;
  584.      LWLIB_ID id;
  585.      XtPointer client_data;
  586. {
  587.   /* This is called with client_data == -1 when WM_DELETE_WINDOW is sent
  588.      instead of a button being selected. */
  589.   if (dbox_up_p == 0) abort ();
  590.   dbox_up_p--;
  591.   maybe_run_dbox_text_callback (id);
  592.   menubar_selection_callback (widget, id, client_data);
  593.   BLOCK_INPUT;
  594.   lw_destroy_all_widgets (id);
  595.   UNBLOCK_INPUT;
  596.   ungcpro_popup_callbacks (make_number (id));
  597. }
  598.  
  599. static void
  600. maybe_run_dbox_text_callback (LWLIB_ID id)
  601. {
  602.   widget_value *wv;
  603.   int got_some;
  604.   BLOCK_INPUT;
  605.   wv = malloc_widget_value ();
  606.   wv->name = "value";
  607.   got_some = lw_get_some_values (id, wv);
  608.   UNBLOCK_INPUT;
  609.   if (got_some)
  610.     {
  611.       Lisp_Object text_field_callback = (Lisp_Object) wv->call_data;
  612.       char *text_field_value = wv->value;
  613.       if (text_field_value)
  614.     {
  615.       menubar_selection_callback (0, id, (XtPointer)
  616.                       list2 (text_field_callback,
  617.                          build_string (text_field_value)));
  618.       xfree (text_field_value);
  619.     }
  620.     }
  621.   BLOCK_INPUT;
  622.   free_widget_value (wv);
  623.   UNBLOCK_INPUT;
  624. }
  625.  
  626. #endif /* HAVE_DIALOG_BOXES */
  627.  
  628.  
  629. extern int zmacs_regions, zmacs_region_stays;
  630.  
  631. DEFUN ("popup-menu", Fpopup_menu, Spopup_menu, 1, 1, 0,
  632.        "Pop up the given menu.\n\
  633. A menu description is a list of menu items, strings, and submenus.\n\
  634. \n\
  635. The first element of a menu must be a string, which is the name of the\n\
  636. menu.  This is the string that will be displayed in the parent menu, if\n\
  637. any.  For toplevel menus, it is ignored.  This string is not displayed\n\
  638. in the menu itself.\n\
  639. \n\
  640. A menu item is a vector of three or four elements:\n\
  641. \n\
  642.  - the name of the menu item (a string);\n\
  643.  - the `callback' of that item;\n\
  644.  - whether this item is active (selectable);\n\
  645.  - and an optional string to append to the name.\n\
  646. \n\
  647. If the `callback' of a menu item is a symbol, then it must name a command.\n\
  648. It will be invoked with `call-interactively'.  If it is a list, then it is\n\
  649. evaluated with `eval'.\n\
  650. \n\
  651. The fourth element of a menu item is a convenient way of adding the name\n\
  652. of a command's ``argument'' to the menu, like ``Kill Buffer NAME''.\n\
  653. \n\
  654. If an element of a menu is a string, then that string will be presented in\n\
  655. the menu as unselectable text.\n\
  656. \n\
  657. If an element of a menu is a string consisting solely of hyphens, then that\n\
  658. item will be presented as a solid horizontal line.\n\
  659. \n\
  660. If an element of a menu is a list, it is treated as a submenu.  The name of\n\
  661. that submenu (the first element in the list) will be used as the name of the\n\
  662. item representing this menu on the parent.\n\
  663. \n\
  664. The syntax, more precisely:\n\
  665. \n\
  666.    form        :=  <something to pass to `eval'>\n\
  667.    command    :=  <a symbol or string, to pass to `call-interactively'>\n\
  668.    callback     :=  command | form\n\
  669.    active-p    :=  <t or nil, whether this thing is selectable>\n\
  670.    text        :=  <string, non selectable>\n\
  671.    name        :=  <string>\n\
  672.    argument    :=  <string>\n\
  673.    menu-item    :=  '['  name callback active-p [ argument ]  ']'\n\
  674.    menu        :=  '(' name [ menu-item | menu | text ]+ ')'")
  675.      (menu_desc)
  676.      Lisp_Object menu_desc;
  677. {
  678.   int menu_id;
  679.   struct screen *s = selected_screen;
  680.   widget_value *data;
  681.   Widget parent, menu;
  682.  
  683.   if (!SCREEN_IS_X (s)) error ("not an X screen");
  684.   if (SYMBOLP (menu_desc))
  685.     menu_desc = Fsymbol_value (menu_desc);
  686.   CHECK_CONS (menu_desc, 0);
  687.   CHECK_STRING (XCONS (menu_desc)->car, 0);
  688.   data = menu_item_descriptor_to_widget_value (menu_desc, 0, 1);
  689.  
  690.   if (! data) error ("no menu");
  691.   
  692.   parent = s->display.x->widget;
  693.  
  694.   BLOCK_INPUT;
  695.   menu_id = ++popup_id_tick;
  696.   menu = lw_create_widget ("popup", data->name, menu_id, data, parent, 1, 0,
  697.                popup_selection_callback, popup_down_callback);
  698.   free_menubar_widget_value_tree (data);
  699.  
  700.   gcpro_popup_callbacks (make_number (menu_id), menu_desc);
  701.  
  702.   /* Setting zmacs-region-stays is necessary here because executing a command
  703.      from a menu is really a two-command process: the first command (bound to
  704.      the button-click) simply pops up the menu, and returns.  This causes a
  705.      sequence of magic-events (destined for the popup-menu widget) to begin.
  706.      Eventually, a menu item is selected, and a menu-event blip is pushed onto
  707.      the end of the input stream, which is then executed by the event loop.
  708.      
  709.      So there are two command-events, with a bunch of magic-events between
  710.      them.  We don't want the *first* command event to alter the state of the
  711.      region, so that the region can be available as an argument for the second
  712.      command.
  713.    */
  714.   if (zmacs_regions)
  715.     zmacs_region_stays = 1;
  716.  
  717.   popup_menu_up_p++;
  718.   lw_popup_menu (menu);
  719.   UNBLOCK_INPUT;
  720.   return Qnil;
  721. }
  722.  
  723. DEFUN ("popup-menu-up-p", Fpopup_menu_up_p, Spopup_menu_up_p, 0, 0, 0,
  724.        "Returns T if a popup menu is up, NIL otherwise.\n\
  725. See popup-menu.")
  726.      ()
  727. {
  728.   return popup_menu_up_p ? Qt : Qnil;
  729. }
  730.  
  731. #ifdef HAVE_DIALOG_BOXES
  732.  
  733. static char *button_names [] = {
  734.   "button1", "button2", "button3", "button4", "button5",
  735.   "button6", "button7", "button8", "button9", "button10" };
  736.  
  737. static widget_value *
  738. dbox_descriptor_to_widget_value (Lisp_Object desc)
  739. {
  740.   char *name;
  741.   int lbuttons = 0, rbuttons = 0;
  742.   int partition_seen = 0;
  743.   int text_field_p = 0;
  744.   widget_value *prev = 0, *kids = 0;
  745.   int n = 0;
  746.  
  747.   CHECK_CONS (desc, 0);
  748.   CHECK_STRING (XCONS (desc)->car, 0);
  749.   name = (char *) XSTRING (XCONS (desc)->car)->data;
  750.   desc = XCONS (desc)->cdr;
  751.   if (!CONSP (desc))
  752.     error ("dialog boxes must have some buttons");
  753.  
  754.   kids = prev = malloc_widget_value ();
  755.   prev->name = "message";
  756.   prev->value = name;
  757.   prev->enabled = 1;
  758.  
  759.   if (VECTORP (XCONS (desc)->car) &&
  760.       EQ (XVECTOR (XCONS (desc)->car)->contents [0], intern ("text")))
  761.     {
  762.       Lisp_Object button = XCONS (desc)->car;
  763.       widget_value *wv;
  764.       if (XVECTOR (button)->size != 4)
  765.     error ("dialog box text field descriptors must be 4 long");
  766.       CHECK_STRING (XVECTOR (button)->contents [2], 0);
  767.       BLOCK_INPUT;
  768.       wv = malloc_widget_value ();
  769.       UNBLOCK_INPUT;
  770.       wv->name = "value";
  771.       wv->value = (char *) XSTRING (XVECTOR (button)->contents [2])->data;
  772.       wv->enabled = !NILP (XVECTOR (button)->contents [3]);
  773.       wv->call_data = (XtPointer) XVECTOR (button)->contents [1];
  774.       text_field_p = 1;
  775.       prev->next = wv;
  776.       prev = wv;
  777.       desc = Fcdr (desc);
  778.     }
  779.  
  780.   for (; !NILP (desc); desc = Fcdr (desc))
  781.     {
  782.       Lisp_Object button = XCONS (desc)->car;
  783.       Lisp_Object cb;
  784.       int active_p;
  785.       widget_value *wv;
  786.  
  787.       if (NILP (button))
  788.     {
  789.       if (partition_seen)
  790.         error ("more than one partition (nil) seen in dbox spec");
  791.       partition_seen = 1;
  792.       continue;
  793.     }
  794.       CHECK_VECTOR (button, 0);
  795.       if (XVECTOR (button)->size != 3)
  796.     while (1)
  797.       Fsignal (Qerror,
  798.            Fcons (build_string("button descriptors must be 3 long"),
  799.               Fcons (button, Qnil)));
  800.       CHECK_STRING (XVECTOR (button)->contents [0], 0);
  801.       cb = XVECTOR (button)->contents [1];
  802.       
  803.       BLOCK_INPUT;
  804.       wv = malloc_widget_value ();
  805.       UNBLOCK_INPUT;
  806.       wv->name = button_names [n];
  807.       wv->value = (char *) XSTRING (XVECTOR (button)->contents [0])->data;
  808.       wv->enabled = !NILP (XVECTOR (button)->contents [2]);
  809.       wv->call_data = (XtPointer) XVECTOR (button)->contents [1];
  810.  
  811.       if (partition_seen)
  812.     rbuttons++;
  813.       else
  814.     lbuttons++;
  815.       n++;
  816.  
  817.       if (lbuttons > 9 || rbuttons > 9)
  818.     error ("too many buttons (9)"); /* #### this leaks */
  819.  
  820.       prev->next = wv;
  821.       prev = wv;
  822.     }
  823.  
  824.   if (n == 0)
  825.     error ("dialog boxes must have some buttons");
  826.   {
  827.     char type = (text_field_p ? 'P' : 'Q');
  828.     static char dbox_name [255];
  829.     widget_value *dbox;
  830.     sprintf (dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons);
  831.     BLOCK_INPUT;
  832.     dbox = malloc_widget_value ();
  833.     UNBLOCK_INPUT;
  834.     dbox->name = dbox_name;
  835.     dbox->contents = kids;
  836.  
  837.     return dbox;
  838.   }
  839. }
  840.  
  841.  
  842. DEFUN ("popup-dialog-box", Fpopup_dialog_box, Spopup_dialog_box, 1, 1, 0,
  843.        "Pop up a dialog box.\n\
  844. A dialog box description is a list.\n\
  845. \n\
  846.  - The first element of the list is a string to display in the dialog box.\n\
  847.  - The rest of the elements are descriptions of the dialog box's buttons.\n\
  848.    Each one is a vector of three elements:\n\
  849.    - The first element is the text of the button.\n\
  850.    - The second element is the `callback'.\n\
  851.    - The third element is t or nil, whether this button is selectable.\n\
  852. \n\
  853. If the `callback' of a button is a symbol, then it must name a command.\n\
  854. It will be invoked with `call-interactively'.  If it is a list, then it is\n\
  855. evaluated with `eval'.\n\
  856. \n\
  857. One (and only one) of the buttons may be `nil'.  This marker means that all\n\
  858. following buttons should be flushright instead of flushleft.\n\
  859. \n\
  860. The syntax, more precisely:\n\
  861. \n\
  862.    form        :=  <something to pass to `eval'>\n\
  863.    command    :=  <a symbol or string, to pass to `call-interactively'>\n\
  864.    callback     :=  command | form\n\
  865.    active-p    :=  <t or nil, whether this thing is selectable>\n\
  866.    name        :=  <string>\n\
  867.    partition    :=  'nil'\n\
  868.    button    :=  '['  name callback active-p ']'\n\
  869.    dialog    :=  '(' name [ button ]+ [ partition [ button ]+ ] ')'")
  870.      (dbox_desc)
  871.      Lisp_Object dbox_desc;
  872. {
  873.   int dbox_id;
  874.   struct screen *s = selected_screen;
  875.   widget_value *data;
  876.   Widget parent, dbox;
  877.  
  878.   if (!SCREEN_IS_X (s)) error ("not an X screen");
  879.   if (SYMBOLP (dbox_desc))
  880.     dbox_desc = Fsymbol_value (dbox_desc);
  881.   CHECK_CONS (dbox_desc, 0);
  882.   CHECK_STRING (XCONS (dbox_desc)->car, 0);
  883.   data = dbox_descriptor_to_widget_value (dbox_desc);
  884.  
  885.   if (! data) abort ();
  886.   
  887.   parent = s->display.x->widget;
  888.  
  889.   BLOCK_INPUT;
  890.   dbox_id = ++popup_id_tick;
  891.   dbox = lw_create_widget (data->name, "dialog", dbox_id, data, parent, 1, 0,
  892.                dbox_selection_callback, 0);
  893.   lw_modify_all_widgets (dbox_id, data, True);
  894.   lw_modify_all_widgets (dbox_id, data->contents, True);
  895.   free_menubar_widget_value_tree (data);
  896.  
  897.   gcpro_popup_callbacks (make_number (dbox_id), dbox_desc);
  898.  
  899.   /* Setting zmacs-region-stays is necessary here because executing a command
  900.      from a menu is really a two-command process: the first command (bound to
  901.      the button-click) simply pops up the menu, and returns.  This causes a
  902.      sequence of magic-events (destined for the popup-menu widget) to begin.
  903.      Eventually, a menu item is selected, and a menu-event blip is pushed onto
  904.      the end of the input stream, which is then executed by the event loop.
  905.      
  906.      So there are two command-events, with a bunch of magic-events between
  907.      them.  We don't want the *first* command event to alter the state of the
  908.      region, so that the region can be available as an argument for the second
  909.      command.
  910.    */
  911.   if (zmacs_regions)
  912.     zmacs_region_stays = 1;
  913.  
  914.   dbox_up_p++;
  915.   lw_pop_up_all_widgets (dbox_id);
  916.   UNBLOCK_INPUT;
  917.   return Qnil;
  918. }
  919. #endif /* HAVE_DIALOG_BOXES */
  920.  
  921.  
  922. #ifdef ENERGIZE
  923. extern int desired_debuggerpanel_exposed_p;
  924. extern int current_debuggerpanel_exposed_p;
  925. extern int debuggerpanel_sheet;
  926. extern void notify_that_sheet_has_been_hidden (unsigned long);
  927.  
  928. #endif
  929.  
  930. void
  931. update_screen_menubars ()
  932. {
  933.   struct screen* s;
  934.   Lisp_Object tail;
  935.   
  936.   for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
  937.     {
  938.       Lisp_Object screen = XCONS (tail)->car;
  939.       if (!SCREENP (screen))
  940.     continue;
  941.       s = XSCREEN (screen);
  942.       
  943.       if (!SCREEN_IS_X (s))
  944.     continue;
  945.       
  946.       /* If the menubar_has_changed flag was set, or the displayed buffer
  947.      has changed we have to update the menubar. */
  948.       if (menubar_has_changed
  949.       || !VECTORP (s->menubar_data)
  950.       || (SCREEN_MENUBAR_DATA (s)->last_menubar_buffer !=
  951.           XWINDOW (s->selected_window)->buffer))
  952.     if (!MINI_WINDOW_P (XWINDOW (s->selected_window)))
  953. #ifndef LWLIB_USES_OLIT
  954.       set_screen_menubar (s, 0);
  955. #else /* LWLIB_USES_OLIT */
  956.       /* ####  BUG BUG BUG!
  957.      ####  The lwlib OLIT code doesn't correctly implement "non-deep" mode.
  958.      ####  This must be fixed before this is usable at all.
  959.        */
  960.       set_screen_menubar (s, 1);
  961. #endif /* LWLIB_USES_OLIT */
  962.     }
  963. }
  964.  
  965. extern void fix_pane_constraints (Widget);
  966.  
  967. static void
  968. update_one_screen_psheets (screen)
  969.      Lisp_Object screen;
  970. {
  971.   struct screen* s = XSCREEN (screen);
  972.   struct x_display *x = s->display.x;
  973.   int i;
  974.   
  975. #ifdef ENERGIZE
  976.   int *old_sheets = x->current_psheets;
  977.   int *new_sheets = x->desired_psheets;
  978.   int old_count = x->current_psheet_count;
  979.   int new_count = x->desired_psheet_count;
  980.   Lisp_Object old_buf = x->current_psheet_buffer;
  981.   Lisp_Object new_buf = x->desired_psheet_buffer;
  982.   int psheets_changed = (old_sheets != new_sheets
  983.              || old_count != new_count
  984.              || old_buf != new_buf);
  985.   int debuggerpanel_changed = (desired_debuggerpanel_exposed_p
  986.                    != current_debuggerpanel_exposed_p);
  987. #endif
  988.   int menubar_changed;
  989.   
  990.   menubar_changed = (x->menubar_widget
  991.              && !XtIsManaged (x->menubar_widget));
  992.  
  993. #ifdef ENERGIZE
  994.   x->current_psheets = x->desired_psheets;
  995.   x->current_psheet_count = x->desired_psheet_count;
  996.   x->current_psheet_buffer = x->desired_psheet_buffer;
  997. #endif
  998.  
  999.   if (! (menubar_changed
  1000. #ifdef ENERGIZE
  1001.      || psheets_changed || debuggerpanel_changed
  1002. #endif
  1003.      ))
  1004.     return;
  1005.  
  1006.   BLOCK_INPUT;
  1007.   XawPanedSetRefigureMode (x->column_widget, 0);
  1008.   
  1009.   /* the order in which children are managed is the top to
  1010.      bottom order in which they are displayed in the paned window.
  1011.      First, remove the text-area widget.
  1012.    */
  1013.   XtUnmanageChild (x->edit_widget);
  1014.  
  1015. #ifdef ENERGIZE
  1016.   /* Remove the psheets that are there now
  1017.    */
  1018.   if (menubar_changed || debuggerpanel_changed || psheets_changed)
  1019.     {
  1020.       i = old_count;
  1021.       while (i)
  1022.     {
  1023.       Widget w;
  1024.       unsigned long sheet = old_sheets[--i];
  1025.       w = lw_get_widget (sheet, x->column_widget, 0);
  1026.       if (psheets_changed && w)
  1027.         {
  1028.           notify_that_sheet_has_been_hidden (sheet);
  1029.           XtVaSetValues (w, XtNmappedWhenManaged, 0, 0);
  1030.           XtUnmanageChild (w);
  1031.           XtUnmapWidget (w);
  1032.         }
  1033.     }
  1034.     }
  1035.  
  1036.   /* remove debugger panel if present */
  1037.   if (current_debuggerpanel_exposed_p && debuggerpanel_sheet &&
  1038.       (menubar_changed || debuggerpanel_changed))
  1039.     {
  1040.       Widget w;
  1041.       int sheet = debuggerpanel_sheet;
  1042.       w = lw_get_widget (sheet, x->column_widget, 0);
  1043.       if (!desired_debuggerpanel_exposed_p && w)
  1044.     {
  1045.       notify_that_sheet_has_been_hidden (sheet);
  1046.       XtVaSetValues (w, XtNmappedWhenManaged, 0, 0);
  1047.       XtUnmanageChild (w);
  1048.       XtUnmapWidget (w);
  1049.     }
  1050.     }
  1051. #endif
  1052.  
  1053.   /* remove the menubar that is there now, and put up the menubar that
  1054.      should be there.
  1055.    */
  1056.   if (menubar_changed)
  1057.     {
  1058.       XtManageChild (x->menubar_widget);
  1059.       XtMapWidget (x->menubar_widget);
  1060.       XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
  1061.     }
  1062.  
  1063. #ifdef ENERGIZE
  1064.   /* add debugger panel if desired */
  1065.   if (desired_debuggerpanel_exposed_p && debuggerpanel_sheet &&
  1066.       (menubar_changed || debuggerpanel_changed))
  1067.     {
  1068.       Widget w;
  1069.       w = lw_make_widget (debuggerpanel_sheet, x->column_widget, 0);
  1070.       fix_pane_constraints (w);
  1071.       XtManageChild (w);
  1072.       XtMapWidget (w);
  1073.       XtVaSetValues (w, XtNmappedWhenManaged, 1, 0);
  1074.     }
  1075.   
  1076.   /* Add the psheets that should be there now
  1077.    */
  1078.   i = new_count;
  1079.   while (i)
  1080.     {
  1081.       Widget w;
  1082.       unsigned long sheet = new_sheets[--i];
  1083.       w = lw_make_widget (sheet, x->column_widget, 0);
  1084.       fix_pane_constraints (w);
  1085.       /* Put the mappedWhenManaged property back in or the Motif widgets
  1086.      refuse to take the focus! */
  1087.       XtVaSetValues (w, XtNmappedWhenManaged, 1, 0);
  1088.       XtManageChild (w);
  1089.     }
  1090.  
  1091.   /* Give back the focus to emacs if no p_sheets are displayed anymore */
  1092.   if (psheets_changed)
  1093.     Fselect_screen (screen);
  1094. #endif
  1095.  
  1096.   /* Re-manage the text-area widget */
  1097.   XtManageChild (x->edit_widget);
  1098.  
  1099.   /* and now thrash the sizes */
  1100.   XawPanedSetRefigureMode (x->column_widget, 1);
  1101.   UNBLOCK_INPUT;
  1102. }
  1103.  
  1104. void
  1105. update_psheets ()
  1106. {
  1107.   struct screen* s;
  1108.   Lisp_Object tail;
  1109.  
  1110.   for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
  1111.     {
  1112.       Lisp_Object screen = XCONS (tail)->car;
  1113.       struct window* w;
  1114.       struct buffer* buf;
  1115.       if (!SCREENP (screen))
  1116.     continue;
  1117.       s = XSCREEN (screen);
  1118.       w = XWINDOW (s->selected_window);
  1119.       buf = XBUFFER (w->buffer);
  1120.  
  1121.       if (!SCREEN_IS_X (s)
  1122.       || MINI_WINDOW_P (w)
  1123.       || EQ (screen, Vglobal_minibuffer_screen))
  1124.     continue;
  1125.  
  1126.       update_one_screen_psheets (screen);
  1127.     }
  1128. #ifdef ENERGIZE
  1129.   current_debuggerpanel_exposed_p = desired_debuggerpanel_exposed_p;
  1130. #endif
  1131. }
  1132.  
  1133.  
  1134. void
  1135. free_screen_menubar (struct screen *s)    /* called from Fdelete_screen() */
  1136. {
  1137.   Widget menubar_widget;
  1138.   int id;
  1139.  
  1140.   if (! SCREEN_IS_X (s))
  1141.     return;
  1142.   
  1143.   menubar_widget = s->display.x->menubar_widget;
  1144.   id = (int) s;
  1145.   
  1146.   if (menubar_widget)
  1147.     {
  1148.       BLOCK_INPUT;
  1149.       lw_destroy_all_widgets (id);
  1150.       UNBLOCK_INPUT;
  1151.     }
  1152.  
  1153. #ifdef ENERGIZE
  1154.   {
  1155.     /* Also destroy this screen's psheets */
  1156.     Widget parent = s->display.x->column_widget;
  1157.     int *sheets = s->display.x->current_psheets;
  1158.     int i = s->display.x->current_psheet_count;
  1159.     while (i--)
  1160.       {
  1161.     unsigned long sheet = sheets [i];
  1162.     Widget w = lw_get_widget (sheet, parent, 0);
  1163.     if (w)
  1164.       lw_destroy_widget (w);
  1165.       }
  1166.     s->display.x->current_psheet_count = 0;
  1167.  
  1168.     /* Is this necessary? */
  1169.     sheets = s->display.x->desired_psheets;
  1170.     i = s->display.x->desired_psheet_count;
  1171.     while (i--)
  1172.       {
  1173.     unsigned long sheet = sheets [i];
  1174.     Widget w = lw_get_widget (sheet, parent, 0);
  1175.     if (w)
  1176.       lw_destroy_widget (w);
  1177.       }
  1178.     s->display.x->desired_psheet_count = 0;
  1179.  
  1180.     /* sigh... debugger panel is special... */
  1181.     if (debuggerpanel_sheet)
  1182.       {
  1183.     Widget w = lw_get_widget (debuggerpanel_sheet, parent, 0);
  1184.     if (w)
  1185.       lw_destroy_widget (w);
  1186.       }
  1187.   }
  1188. #endif
  1189. }
  1190.  
  1191.  
  1192. void
  1193. syms_of_menubar ()
  1194. {
  1195.   popup_menu_up_p = 0;
  1196.   last_popup_selection_callback_id = -1;
  1197.   popup_id_tick = (1<<16);    /* start big, to not conflict with Energize */
  1198.  
  1199.   Vpopup_callbacks = Qnil;
  1200.   staticpro (&Vpopup_callbacks);
  1201.  
  1202.   defsubr (&Sset_menubar_dirty_flag);
  1203.   defsubr (&Spopup_menu);
  1204.   defsubr (&Spopup_menu_up_p);
  1205. #ifdef HAVE_DIALOG_BOXES
  1206.   defsubr (&Spopup_dialog_box);
  1207. #endif
  1208.  
  1209. /*
  1210.  *
  1211.  *  This DEFVAR_LISP is just for the benefit of make-docfile.  there is no
  1212.  *  C variable Vcurrent_menubar - all C code must access the menubar via
  1213.  *  Qcurrent_menubar because it can be buffer-local.
  1214.  *
  1215.  
  1216.   DEFVAR_LISP ("current-menubar", &Vcurrent_menubar,
  1217.    "The current menubar.  This may be buffer-local.\n\
  1218. \n\
  1219. When the menubar is changed, the function `set-menubar-dirty-flag' has to\n\
  1220. be called for the menubar to be updated on the screen.  See `set-menubar'\n\
  1221. and `set-buffer-menubar'.\n\
  1222. \n\
  1223. A menubar is a list of menus and menu-items.\n\
  1224. A menu is a list of menu items, strings, and submenus.\n\
  1225. \n\
  1226. The first element of a menu must be a string, which is the name of the\n\
  1227. menu.  This is the string that will be displayed in the menubar, or in\n\
  1228. the parent menu.  This string is not displayed in the menu itself.\n\
  1229. \n\
  1230. A menu item is a vector of three or four elements:\n\
  1231. \n\
  1232.  - the name of the menu item (a string);\n\
  1233.  - the `callback' of that item;\n\
  1234.  - whether this item is active (selectable);\n\
  1235.  - and an optional string to append to the name.\n\
  1236. \n\
  1237. If the `callback' of a menu item is a symbol, then it must name a command.
  1238. It will be invoked with `call-interactively'.  If it is a list, then it is
  1239. evaluated with `eval'.\n\
  1240. \n\
  1241. The fourth element of a menu item is a convenient way of adding the name\n\
  1242. of a command's ``argument'' to the menu, like ``Kill Buffer NAME''.\n\
  1243. \n\
  1244. If an element of a menu (or menubar) is a string, then that string will be\n\
  1245. presented in the menu (or menubar) as unselectable text.\n\
  1246. \n\
  1247. If an element of a menu is a string consisting solely of hyphens, then that\n\
  1248. item will be presented as a solid horizontal line.\n\
  1249. \n\
  1250. If an element of a menu is a list, it is treated as a submenu.  The name of\n\
  1251. that submenu (the first element in the list) will be used as the name of\n\
  1252. the item representing this menu on the parent.\n\
  1253. \n\
  1254. If an element of a menubar is `nil', then it is used to represent the\n\
  1255. division between the set of menubar-items which are flushleft and those\n\
  1256. which are flushright.  (Note: this isn't completely implemented yet.)\n\
  1257. \n\
  1258. After the menubar is clicked upon, but before any menus are popped up,\n\
  1259. the functions on the `activate-menubar-hook' are invoked to make changes\n\
  1260. to the menus and menubar.  This is intended to implement lazy alteration\n\
  1261. of the sensitivity of menu items.\n\
  1262. \n\
  1263. The syntax, more precisely:\n\
  1264. \n\
  1265.    form        :=  <something to pass to `eval'>\n\
  1266.    command    :=  <a symbol or string, to pass to `call-interactively'>\n\
  1267.    callback     :=  command | form\n\
  1268.    active-p    :=  <t or nil, whether this thing is selectable>\n\
  1269.    text        :=  <string, non selectable>\n\
  1270.    name        :=  <string>\n\
  1271.    argument    :=  <string>\n\
  1272.    menu-item    :=  '['  name callback active-p [ argument ]  ']'\n\
  1273.    menu        :=  '(' name [ menu-item | menu | text ]+ ')'\n\
  1274.    partition    :=  'nil'\n\
  1275.    menubar    :=  '(' [ menu-item | menu | text ]* [ partition ]\n\
  1276.                 [ menu-item | menu | text ]*\n\
  1277.              ')'");
  1278.  
  1279.   */
  1280.  
  1281.   Qcurrent_menubar = intern ("current-menubar");
  1282.   staticpro (&Qcurrent_menubar);
  1283.   Fset (Qcurrent_menubar, Qnil);
  1284.  
  1285.   DEFVAR_LISP ("activate-menubar-hook", &Vactivate_menubar_hook,
  1286.    "Function or functions called before a menubar menu is pulled down.\n\
  1287. These functions are called with no arguments, and should interrogate and\n\
  1288. modify the value of `current-menubar' as desired.\n\
  1289. \n\
  1290. The functions on this hook are invoked after the mouse goes down, but before\n\
  1291. the menu is mapped, and may be used to activate, deactivate, add, or delete\n\
  1292. items from the menus.\n\
  1293. \n\
  1294. These functions may return the symbol `t' to assert that they have made\n\
  1295. no changes to the menubar.  If any other value is returned, the menubar is\n\
  1296. recomputed.  If `t' is returned but the menubar has been changed, then the\n\
  1297. changes may not show up right away.  Returning `nil' when the menubar has\n\
  1298. not changed is not so bad; more computation will be done, but redisplay of\n\
  1299. the menubar will still be performed optimally.");
  1300.   Vactivate_menubar_hook = Qnil;
  1301.   Qactivate_menubar_hook = intern ("activate-menubar-hook");
  1302.   staticpro (&Qactivate_menubar_hook);
  1303.  
  1304. /*
  1305.  *  This DEFVAR_LISP is just for the benefit of make-docfile.
  1306.   DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook,
  1307.    "Function or functions to call when a menu or dialog box is dismissed\n\
  1308. without a selecting having been made.");
  1309.  */
  1310.   Fset (intern ("menu-no-selection-hook"), Qnil);
  1311.  
  1312.   DEFVAR_BOOL ("menubar-show-keybindings", &menubar_show_keybindings,
  1313.     "If true, the menubar will display keyboard equivalents.\n\
  1314. If false, only the command names will be displayed.");
  1315.   menubar_show_keybindings = 1;
  1316. }
  1317.