xemacs-beta: src/menubar-x.c comparison

comparison src/menubar-x.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 /* 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.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 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 <config.h>
 #include "lisp.h"
 #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"
 static int set_frame_menubar (struct frame *f,
 			      int deep_p,
 					int depth)
 {
 /* 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);
 int count = specpdl_depth ();
 int partition_seen = 0;
 widget_value *wv = xmalloc_widget_value ();
 Lisp_Object 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 = xstrdup (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.
 	     Since simple labels have a name, but no accel, we *must* set it
 	     to nil */
 	}
 }
 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;
 	  goto menu_item_done;
 	}
 	  Lisp_Object accel;
 	  int included_spec = 0;
 	  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));
-	  wv->name = xstrdup (wv->name);
+	  accel = gui_name_accelerator (XCAR (desc));
-	  accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc)));
 	  wv->accel = LISP_TO_VOID (accel);
 	  desc = Fcdr (desc);
 	  while (key = Fcar (desc), KEYWORDP (key))
 	    {
 	      Lisp_Object cascade = desc;
 	      desc = Fcdr (desc);
 	      if (NILP (desc))
-		signal_simple_error ("Keyword in menu lacks a value",
+		syntax_error ("Keyword in menu lacks a value", cascade);
-				     cascade);
 	      val = Fcar (desc);
 	      desc = Fcdr (desc);
 	      if (EQ (key, Q_included))
 		include_p = val, included_spec = 1;
 	      else if (EQ (key, Q_config))
 		{
 		  if ( SYMBOLP (val)
 		       || 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)
 	       && NILP (Fmemq (config_tag, Vmenubar_configuration)))
 	      || (included_spec && NILP (Feval (include_p))))
 	      title_wv->type = TEXT_TYPE;
 	      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 ("==");
 	      sep_wv->next = 0;
 	      wv->contents = title_wv;
 	      prev = sep_wv;
 	    }
 	      dummy->type = BUTTON_TYPE;
 	      dummy->call_data = NULL;
 	      dummy->next = NULL;
 	      goto menu_item_done;
-	}
+	    }
 	}
 else if (menubar_root_p)
 	{
 	  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",
+	  syntax_error ("Menu name (first element) must be a string", desc);
-desc);
 	}
 if (deep_p || menubar_root_p)
 	{
 	  widget_value *next;
 	    {
 	      Lisp_Object child = Fcar (desc);
 	      if (menubar_root_p && NILP (child))	/* the partition */
 		{
 		  if (partition_seen)
-		    error (
+		    syntax_error
-		     "More than one partition (nil) in menubar description");
+		      ("More than one partition (nil) in menubar description",
+		       desc);
 		  partition_seen = 1;
 		  next = xmalloc_widget_value ();
 		  next->type = PUSHRIGHT_TYPE;
 		}
 	      else
 	}
 if (deep_p && !wv->contents)
 	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:
 if (wv)
 {
 /* Completed normally.  Clear out the object that widget_value_unwind()
 	 will be called with to tell it not to free the wv (as we are
 }
 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 */
 {
 widget_value *wv;
 int in_menu_callback;
 static Lisp_Object
 restore_in_menu_callback (Lisp_Object val)
 {
 in_menu_callback = XINT (val);
 return Qnil;
 }
 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
 #if 0
 /* #### Sort of a hack needed to process Vactivate_menubar_hook
 So there are two command-events, with a bunch of magic-events between
 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;
 popup_up_p++;
 lw_popup_menu (menu, &xev);
 /* this speeds up display of pop-up menus */
 XFlush (XtDisplay (parent));
 }
+#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;
+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
 console_type_create_menubar_x (void)
 {

Mercurial > hg > xemacs-beta

comparison src/menubar-x.c @ 442:abe6d1db359e r21-2-36