X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fmenubar-x.c;h=207a36fc319ef92ed71f64819e75c57b18f7a0aa;hp=fecb4a7b0cc6b2b888eb991595de34f1d446a2e7;hb=414b512c0774e67ba8e160b605447d862d3be166;hpb=ea1ea793fe6e244ef5555ed983423a204101af13 diff --git a/src/menubar-x.c b/src/menubar-x.c index fecb4a7..207a36f 100644 --- a/src/menubar-x.c +++ b/src/menubar-x.c @@ -1,6 +1,7 @@ /* Implements an elisp-programmable menubar -- X interface. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. + Copyright (C) 2000 Ben Wing. This file is part of XEmacs. @@ -21,7 +22,16 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* created 16-dec-91 by jwz */ +/* This file Mule-ized by Ben Wing, 7-8-00. */ + +/* Authorship: + + Created 16-dec-91 by Jamie Zawinski. + Menu filters and many other keywords added by Stig for 19.12. + Original device-abstraction work and GC cleanup work by Ben Wing for 19.13. + Menu accelerators c. 1997? by ??. Moved here from event-stream.c. + Other work post-1996 by ??. +*/ #include #include "lisp.h" @@ -29,12 +39,15 @@ Boston, MA 02111-1307, USA. */ #include "console-x.h" #include "EmacsFrame.h" #include "gui-x.h" +#include "../lwlib/lwlib.h" #include "buffer.h" #include "commands.h" /* zmacs_regions */ -#include "gui.h" #include "events.h" #include "frame.h" +#include "gui.h" +#include "keymap.h" +#include "menubar.h" #include "opaque.h" #include "window.h" @@ -92,35 +105,26 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, /* This function cannot GC. It is only called from menu_item_descriptor_to_widget_value, which prohibits GC. */ - /* !!#### This function has not been Mule-ized */ int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0); - widget_value *wv; - Lisp_Object wv_closure; int count = specpdl_depth (); int partition_seen = 0; + widget_value *wv = xmalloc_widget_value (); + Lisp_Object wv_closure = make_opaque_ptr (wv); - wv = xmalloc_widget_value (); - - wv_closure = make_opaque_ptr (wv); record_unwind_protect (widget_value_unwind, wv_closure); if (STRINGP (desc)) { - char *string_chars = (char *) XSTRING_DATA (desc); + Bufbyte *string_chars = XSTRING_DATA (desc); wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE : TEXT_TYPE); -#if 1 - /* #### - should internationalize with X resources instead. - Not so! --ben */ - string_chars = GETTEXT (string_chars); -#endif if (wv->type == SEPARATOR_TYPE) { - wv->value = menu_separator_style (string_chars); + wv->value = menu_separator_style_and_to_external (string_chars); } else { - wv->name = string_chars; + LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding); wv->enabled = 1; /* dverna Dec. 98: command_builder_operate_menu_accelerator will manipulate the accel as a Lisp_Object if the widget has a name. @@ -132,9 +136,10 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, else if (VECTORP (desc)) { Lisp_Object gui_item = gui_parse_item_keywords (desc); - if (!button_item_to_widget_value (gui_item, wv, 1, + if (!button_item_to_widget_value (Qmenubar, + gui_item, wv, 1, (menu_type == MENUBAR_TYPE - && depth <= 1))) + && depth <= 1), 1, 1)) { /* :included form was nil */ wv = NULL; @@ -156,9 +161,9 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, int active_spec = 0; wv->type = CASCADE_TYPE; wv->enabled = 1; - wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); + wv->name = add_accel_and_to_external (XCAR (desc)); - accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc))); + accel = gui_name_accelerator (XCAR (desc)); wv->accel = LISP_TO_VOID (accel); desc = Fcdr (desc); @@ -168,8 +173,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, Lisp_Object cascade = desc; desc = Fcdr (desc); if (NILP (desc)) - signal_simple_error ("Keyword in menu lacks a value", - cascade); + syntax_error ("Keyword in menu lacks a value", cascade); val = Fcar (desc); desc = Fcdr (desc); if (EQ (key, Q_included)) @@ -186,14 +190,14 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, || CHARP (val)) wv->accel = LISP_TO_VOID (val); else - signal_simple_error ("bad keyboard accelerator", val); + syntax_error ("bad keyboard accelerator", val); } else if (EQ (key, Q_label)) { /* implement in 21.2 */ } else - signal_simple_error ("Unknown menu cascade keyword", cascade); + syntax_error ("Unknown menu cascade keyword", cascade); } if ((!NILP (config_tag) @@ -226,6 +230,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, incr_wv->type = INCREMENTAL_TYPE; incr_wv->enabled = 1; incr_wv->name = wv->name; + incr_wv->name = xstrdup (wv->name); /* This is automatically GC protected through the call to lw_map_widget_values(); no need to worry. */ @@ -242,11 +247,11 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, widget_value *title_wv = xmalloc_widget_value (); widget_value *sep_wv = xmalloc_widget_value (); title_wv->type = TEXT_TYPE; - title_wv->name = wv->name; + title_wv->name = xstrdup (wv->name); title_wv->enabled = 1; title_wv->next = sep_wv; sep_wv->type = SEPARATOR_TYPE; - sep_wv->value = menu_separator_style ("=="); + sep_wv->value = menu_separator_style_and_to_external ((Bufbyte *) "=="); sep_wv->next = 0; wv->contents = title_wv; @@ -258,7 +263,7 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, widget_value *dummy; /* Add a fake entry so the menus show up */ wv->contents = dummy = xmalloc_widget_value (); - dummy->name = "(inactive)"; + dummy->name = xstrdup ("(inactive)"); dummy->accel = LISP_TO_VOID (Qnil); dummy->enabled = 0; dummy->selected = 0; @@ -268,19 +273,18 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, dummy->next = NULL; goto menu_item_done; - } + } } else if (menubar_root_p) { - wv->name = (char *) "menubar"; + wv->name = xstrdup ("menubar"); wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and this is ignored anyway... */ } else { - signal_simple_error ("Menu name (first element) must be a string", - desc); + syntax_error ("Menu name (first element) must be a string", desc); } if (deep_p || menubar_root_p) @@ -292,8 +296,9 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, if (menubar_root_p && NILP (child)) /* the partition */ { if (partition_seen) - error ( - "More than one partition (nil) in menubar description"); + syntax_error + ("More than one partition (nil) in menubar description", + desc); partition_seen = 1; next = xmalloc_widget_value (); next->type = PUSHRIGHT_TYPE; @@ -316,11 +321,11 @@ menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, wv = NULL; } else if (NILP (desc)) - error ("nil may not appear in menu descriptions"); + syntax_error ("nil may not appear in menu descriptions", desc); else - signal_simple_error ("Unrecognized menu descriptor", desc); + syntax_error ("Unrecognized menu descriptor", desc); -menu_item_done: + menu_item_done: if (wv) { @@ -337,7 +342,7 @@ menu_item_done: static widget_value * menu_item_descriptor_to_widget_value (Lisp_Object desc, int menu_type, /* if this is a menubar, - popup or sub menu */ + popup or sub menu */ int deep_p, /* */ int filter_p) /* if :filter forms should run now */ @@ -361,8 +366,8 @@ int in_menu_callback; static Lisp_Object restore_in_menu_callback (Lisp_Object val) { - in_menu_callback = XINT(val); - return Qnil; + in_menu_callback = XINT (val); + return Qnil; } #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ @@ -469,7 +474,7 @@ pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data) wv->accel = LISP_TO_VOID (Qnil); wv->contents = xmalloc_widget_value (); wv->contents->type = TEXT_TYPE; - wv->contents->name = (char *) "No menu"; + wv->contents->name = xstrdup ("No menu"); wv->contents->next = NULL; wv->contents->accel = LISP_TO_VOID (Qnil); } @@ -512,24 +517,21 @@ pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data) static widget_value * compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p) { - widget_value *data; - if (NILP (menubar)) - data = 0; + return 0; else { - Lisp_Object old_buffer; + widget_value *data; int count = specpdl_depth (); - old_buffer = Fcurrent_buffer (); - record_unwind_protect (Fset_buffer, old_buffer); - Fset_buffer ( XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE, deep_p, 0); - Fset_buffer (old_buffer); unbind_to (count, Qnil); + + return data; } - return data; } static int @@ -539,7 +541,7 @@ set_frame_menubar (struct frame *f, int deep_p, int first_time_p) Lisp_Object menubar; int menubar_visible; long id; - /* As for the toolbar, the minibuffer does not have its own menubar. */ + /* As with the toolbar, the minibuffer does not have its own menubar. */ struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); if (! FRAME_X_P (f)) @@ -570,7 +572,7 @@ set_frame_menubar (struct frame *f, int deep_p, int first_time_p) data = compute_menubar_data (f, menubar, deep_p); if (!data || (!data->next && !data->contents)) - abort (); + ABORT (); if (NILP (FRAME_MENUBAR_DATA (f))) { @@ -660,9 +662,7 @@ popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data) static void -make_dummy_xbutton_event (XEvent *dummy, - Widget daddy, - struct Lisp_Event *eev) +make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev) /* NULL for eev means query pointer */ { XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy; @@ -691,7 +691,7 @@ make_dummy_xbutton_event (XEvent *dummy, XtSetArg (al [1], XtNy, &shelly); XtGetValues (shell, al, 2); } -#endif +#endif XtSetArg (al [0], XtNx, &framex); XtSetArg (al [1], XtNy, &framey); XtGetValues (daddy, al, 2); @@ -781,7 +781,7 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) widget_value *data; Widget parent; Widget menu; - struct Lisp_Event *eev = NULL; + Lisp_Event *eev = NULL; XEvent xev; Lisp_Object frame; @@ -836,7 +836,7 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) them. We don't want the *first* command event to alter the state of the region, so that the region can be available as an argument for the second command. - */ + */ if (zmacs_regions) zmacs_region_stays = 1; @@ -847,9 +847,516 @@ x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) } + +#if defined(LWLIB_MENUBARS_LUCID) +static void +menu_move_up (void) +{ + widget_value *current = lw_get_entries (False); + widget_value *entries = lw_get_entries (True); + widget_value *prev = NULL; + + while (entries != current) + { + if (entries->name /*&& entries->enabled*/) prev = entries; + entries = entries->next; + assert (entries); + } + + if (!prev) + /* move to last item */ + { + while (entries->next) + { + if (entries->name /*&& entries->enabled*/) prev = entries; + entries = entries->next; + } + if (prev) + { + if (entries->name /*&& entries->enabled*/) + prev = entries; + } + else + { + /* no selectable items in this menu, pop up to previous level */ + lw_pop_menu (); + return; + } + } + lw_set_item (prev); +} + +static void +menu_move_down (void) +{ + widget_value *current = lw_get_entries (False); + widget_value *new = current; + + while (new->next) + { + new = new->next; + if (new->name /*&& new->enabled*/) break; + } + + if (new==current||!(new->name/*||new->enabled*/)) + { + new = lw_get_entries (True); + while (new!=current) + { + if (new->name /*&& new->enabled*/) break; + new = new->next; + } + if (new==current&&!(new->name /*|| new->enabled*/)) + { + lw_pop_menu (); + return; + } + } + + lw_set_item (new); +} + +static void +menu_move_left (void) +{ + int level = lw_menu_level (); + int l = level; + widget_value *current; + + while (level-- >= 3) + lw_pop_menu (); + + menu_move_up (); + current = lw_get_entries (False); + if (l > 2 && current->contents) + lw_push_menu (current->contents); +} + +static void +menu_move_right (void) +{ + int level = lw_menu_level (); + int l = level; + widget_value *current; + + while (level-- >= 3) + lw_pop_menu (); + + menu_move_down (); + current = lw_get_entries (False); + if (l > 2 && current->contents) + lw_push_menu (current->contents); +} + +static void +menu_select_item (widget_value *val) +{ + if (val == NULL) + val = lw_get_entries (False); + + /* is match a submenu? */ + + if (val->contents) + { + /* enter the submenu */ + + lw_set_item (val); + lw_push_menu (val->contents); + } + else + { + /* Execute the menu entry by calling the menu's `select' + callback function + */ + lw_kill_menus (val); + } +} + +Lisp_Object +command_builder_operate_menu_accelerator (struct command_builder *builder) +{ + /* this function can GC */ + + struct console *con = XCONSOLE (Vselected_console); + Lisp_Object evee = builder->most_current_event; + Lisp_Object binding; + widget_value *entries; + + extern int lw_menu_accelerate; /* lwlib.c */ + +#if 0 + { + int i; + Lisp_Object t; + char buf[50]; + + t = builder->current_events; + i = 0; + while (!NILP (t)) + { + i++; + sprintf (buf,"OPERATE (%d): ",i); + write_c_string (buf, Qexternal_debugging_output); + print_internal (t, Qexternal_debugging_output, 1); + write_c_string ("\n", Qexternal_debugging_output); + t = XEVENT_NEXT (t); + } + } +#endif /* 0 */ + + /* menu accelerator keys don't go into keyboard macros */ + if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) + con->kbd_macro_ptr = con->kbd_macro_end; + + /* don't echo menu accelerator keys */ + /*reset_key_echo (builder, 1);*/ + + if (!lw_menu_accelerate) + { + /* `convert' mouse display to keyboard display + by entering the open submenu + */ + entries = lw_get_entries (False); + if (entries->contents) + { + lw_push_menu (entries->contents); + lw_display_menu (CurrentTime); + } + } + + /* compare event to the current menu accelerators */ + + entries=lw_get_entries (True); + + while (entries) + { + Lisp_Object accel; + VOID_TO_LISP (accel, entries->accel); + if (entries->name && !NILP (accel)) + { + if (event_matches_key_specifier_p (XEVENT (evee), accel)) + { + /* a match! */ + + menu_select_item (entries); + + if (lw_menu_active) lw_display_menu (CurrentTime); + + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + return Vmenu_accelerator_map; + } + } + entries = entries->next; + } + + /* try to look up event in menu-accelerator-map */ + + binding = event_binding_in (evee, Vmenu_accelerator_map, 1); + + if (NILP (binding)) + { + /* beep at user for undefined key */ + return Qnil; + } + else + { + if (EQ (binding, Qmenu_quit)) + { + /* turn off menus and set quit flag */ + lw_kill_menus (NULL); + Vquit_flag = Qt; + } + else if (EQ (binding, Qmenu_up)) + { + int level = lw_menu_level (); + if (level > 2) + menu_move_up (); + } + else if (EQ (binding, Qmenu_down)) + { + int level = lw_menu_level (); + if (level > 2) + menu_move_down (); + else + menu_select_item (NULL); + } + else if (EQ (binding, Qmenu_left)) + { + int level = lw_menu_level (); + if (level > 3) + { + lw_pop_menu (); + lw_display_menu (CurrentTime); + } + else + menu_move_left (); + } + else if (EQ (binding, Qmenu_right)) + { + int level = lw_menu_level (); + if (level > 2 && + lw_get_entries (False)->contents) + { + widget_value *current = lw_get_entries (False); + if (current->contents) + menu_select_item (NULL); + } + else + menu_move_right (); + } + else if (EQ (binding, Qmenu_select)) + menu_select_item (NULL); + else if (EQ (binding, Qmenu_escape)) + { + int level = lw_menu_level (); + + if (level > 2) + { + lw_pop_menu (); + lw_display_menu (CurrentTime); + } + else + { + /* turn off menus quietly */ + lw_kill_menus (NULL); + } + } + else if (KEYMAPP (binding)) + { + /* prefix key */ + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + return binding; + } + else + { + /* turn off menus and execute binding */ + lw_kill_menus (NULL); + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + return binding; + } + } + + if (lw_menu_active) lw_display_menu (CurrentTime); + + reset_this_command_keys (Vselected_console, 1); + /*reset_command_builder_event_chain (builder);*/ + + return Vmenu_accelerator_map; +} + +static Lisp_Object +menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) +{ + Vmenu_accelerator_prefix = Qnil; + Vmenu_accelerator_modifiers = Qnil; + Vmenu_accelerator_enabled = Qnil; + if (!NILP (errordata)) + { + Lisp_Object args[2]; + + args[0] = build_string ("Error in menu accelerators (setting to nil)"); + /* #### This should call + (with-output-to-string (display-error errordata)) + but that stuff is all in Lisp currently. */ + args[1] = errordata; + warn_when_safe_lispobj + (Qerror, Qwarning, + emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s", + Qnil, -1, 2, args)); + } + + return Qnil; +} + +static Lisp_Object +menu_accelerator_safe_compare (Lisp_Object event0) +{ + if (CONSP (Vmenu_accelerator_prefix)) + { + Lisp_Object t; + t=Vmenu_accelerator_prefix; + while (!NILP (t) + && !NILP (event0) + && event_matches_key_specifier_p (XEVENT (event0), Fcar (t))) + { + t = Fcdr (t); + event0 = XEVENT_NEXT (event0); + } + if (!NILP (t)) + return Qnil; + } + else if (NILP (event0)) + return Qnil; + else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix)) + event0 = XEVENT_NEXT (event0); + else + return Qnil; + return event0; +} + +static Lisp_Object +menu_accelerator_safe_mod_compare (Lisp_Object cons) +{ + return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons)) + ? Qt + : Qnil); +} + +Lisp_Object +command_builder_find_menu_accelerator (struct command_builder *builder) +{ + /* this function can GC */ + Lisp_Object event0 = builder->current_events; + struct console *con = XCONSOLE (Vselected_console); + struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); + Widget menubar_widget; + + /* compare entries in event0 against the menu prefix */ + + if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || + XEVENT (event0)->event_type != key_press_event) + return Qnil; + + if (!NILP (Vmenu_accelerator_prefix)) + { + event0 = condition_case_1 (Qerror, + menu_accelerator_safe_compare, + event0, + menu_accelerator_junk_on_error, + Qnil); + } + + if (NILP (event0)) + return Qnil; + + menubar_widget = FRAME_X_MENUBAR_WIDGET (f); + if (menubar_widget + && CONSP (Vmenu_accelerator_modifiers)) + { + Lisp_Object fake = Qnil; + Lisp_Object last = Qnil; + struct gcpro gcpro1; + Lisp_Object matchp; + + widget_value *val; + LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; + + val = lw_get_all_values (id); + if (val) + { + val = val->contents; + + fake = Fcopy_sequence (Vmenu_accelerator_modifiers); + last = fake; + + while (!NILP (Fcdr (last))) + last = Fcdr (last); + + Fsetcdr (last, Fcons (Qnil, Qnil)); + last = Fcdr (last); + } + + fake = Fcons (Qnil, fake); + + GCPRO1 (fake); + + while (val) + { + Lisp_Object accel; + VOID_TO_LISP (accel, val->accel); + if (val->name && !NILP (accel)) + { + Fsetcar (last, accel); + Fsetcar (fake, event0); + matchp = condition_case_1 (Qerror, + menu_accelerator_safe_mod_compare, + fake, + menu_accelerator_junk_on_error, + Qnil); + if (!NILP (matchp)) + { + /* we found one! */ + + lw_set_menu (menubar_widget, val); + /* yah - yet another hack. + pretend emacs timestamp is the same as an X timestamp, + which for the moment it is. (read events.h) + */ + lw_map_menu (XEVENT (event0)->timestamp); + + if (val->contents) + lw_push_menu (val->contents); + + lw_display_menu (CurrentTime); + + /* menu accelerator keys don't go into keyboard macros */ + if (!NILP (con->defining_kbd_macro) + && NILP (Vexecuting_macro)) + con->kbd_macro_ptr = con->kbd_macro_end; + + /* don't echo menu accelerator keys */ + /*reset_key_echo (builder, 1);*/ + reset_this_command_keys (Vselected_console, 1); + UNGCPRO; + + return Vmenu_accelerator_map; + } + } + + val = val->next; + } + + UNGCPRO; + } + return Qnil; +} + +int +x_kludge_lw_menu_active (void) +{ + return lw_menu_active; +} + +DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* +Make the menubar active. Menu items can be selected using menu accelerators +or by actions defined in menu-accelerator-map. +*/ + ()) +{ + struct console *con = XCONSOLE (Vselected_console); + struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); + LWLIB_ID id; + widget_value *val; + + if (NILP (f->menubar_data)) + error ("Frame has no menubar."); + + id = XPOPUP_DATA (f->menubar_data)->id; + val = lw_get_all_values (id); + val = val->contents; + lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); + lw_map_menu (CurrentTime); + + lw_display_menu (CurrentTime); + + /* menu accelerator keys don't go into keyboard macros */ + if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) + con->kbd_macro_ptr = con->kbd_macro_end; + + return Qnil; +} +#endif /* LWLIB_MENUBARS_LUCID */ + + void syms_of_menubar_x (void) { +#if defined(LWLIB_MENUBARS_LUCID) + DEFSUBR (Faccelerate_menu); +#endif } void