Fixes: debbugs:17865
[bpt/emacs.git] / src / menu.c
index cf6ceb5..468f281 100644 (file)
@@ -1,6 +1,6 @@
 /* Platform-independent code for terminal communications.
 
-Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2013 Free Software
+Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2014 Free Software
 Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -30,6 +30,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "termhooks.h"
 #include "blockinput.h"
 #include "dispextern.h"
+#include "buffer.h"
 
 #ifdef USE_X_TOOLKIT
 #include "../lwlib/lwlib.h"
@@ -54,7 +55,7 @@ extern HMENU current_popup_menu;
 static bool
 have_boxes (void)
 {
-#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS)
   if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)))
     return 1;
 #endif
@@ -414,7 +415,8 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
        item_string = concat2 (prefix, item_string);
   }
 
-  if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
+  if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
+       || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame)))
       && !NILP (map))
     /* Indicate visually that this is a submenu.  */
     item_string = concat2 (item_string, build_string (" >"));
@@ -1035,6 +1037,85 @@ find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data
 }
 #endif  /* HAVE_NS */
 
+ptrdiff_t
+menu_item_width (const unsigned char *str)
+{
+  ptrdiff_t len;
+  const unsigned char *p;
+
+  for (len = 0, p = str; *p; )
+    {
+      int ch_len;
+      int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
+
+      len += CHAR_WIDTH (ch);
+      p += ch_len;
+    }
+  return len;
+}
+
+DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
+       2, 3, 0,
+       doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
+X and Y are frame-relative pixel coordinates, assumed to define
+a location within the menu bar.
+If FRAME is nil or omitted, it defaults to the selected frame.
+
+Value is the symbol of the menu at X/Y, or nil if the specified
+coordinates are not within the FRAME's menu bar.  The symbol can
+be used to look up the menu like this:
+
+     (lookup-key MAP [menu-bar SYMBOL])
+
+where MAP is either the current global map or the current local map,
+since menu-bar items come from both.
+
+This function can return non-nil only on a text-terminal frame
+or on an X frame that doesn't use any GUI toolkit.  Otherwise,
+Emacs does not manage the menu bar and cannot convert coordinates
+into menu items.  */)
+  (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
+{
+  int row, col;
+  struct frame *f = decode_any_frame (frame);
+
+  if (!FRAME_LIVE_P (f))
+    return Qnil;
+
+  pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
+  if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
+    {
+      Lisp_Object items, item;
+      int i;
+
+      /* Find the menu bar item under `col'.  */
+      item = Qnil;
+      items = FRAME_MENU_BAR_ITEMS (f);
+      /* This loop assumes a single menu-bar line, and will fail to
+        find an item if it is not in the first line.  Note that
+        make_lispy_event in keyboard.c makes the same assumption.  */
+      for (i = 0; i < ASIZE (items); i += 4)
+       {
+         Lisp_Object pos, str;
+
+         str = AREF (items, i + 1);
+         pos = AREF (items, i + 3);
+         if (NILP (str))
+           return item;
+         if (XINT (pos) <= col
+             /* We use <= so the blank between 2 items on a TTY is
+                considered part of the previous item.  */
+             && col <= XINT (pos) + menu_item_width (SDATA (str)))
+           {
+             item = AREF (items, i);
+             return item;
+           }
+       }
+    }
+  return Qnil;
+}
+
+
 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
        doc: /* Pop up a deck-of-cards menu and return user's selection.
 POSITION is a position specification.  This is either a mouse button event
@@ -1080,7 +1161,7 @@ event (indicating that the user invoked the menu with the mouse) then
 no quit occurs and `x-popup-menu' returns nil.  */)
   (Lisp_Object position, Lisp_Object menu)
 {
-  Lisp_Object keymap, tem;
+  Lisp_Object keymap, tem, tem2;
   int xpos = 0, ypos = 0;
   Lisp_Object title;
   const char *error_name = NULL;
@@ -1089,6 +1170,7 @@ no quit occurs and `x-popup-menu' returns nil.  */)
   Lisp_Object x, y, window;
   bool keymaps = 0;
   bool for_click = 0;
+  bool kbd_menu_navigation = 0;
   ptrdiff_t specpdl_count = SPECPDL_INDEX ();
   struct gcpro gcpro1;
 
@@ -1097,7 +1179,6 @@ no quit occurs and `x-popup-menu' returns nil.  */)
        keybinding equivalents, but we don't do that any more anyway.  */
     return Qnil;
 
-#ifdef HAVE_MENUS
   {
     bool get_current_pos_p = 0;
 
@@ -1122,6 +1203,22 @@ no quit occurs and `x-popup-menu' returns nil.  */)
            for_click = 1;
            tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
            window = Fcar (tem);             /* POSN_WINDOW (tem) */
+           tem2 = Fcar (Fcdr (tem));        /* POSN_POSN (tem) */
+           /* The kbd_menu_navigation flag is set when the menu was
+              invoked by F10, which probably means they have no
+              mouse.  In that case, we let them switch between
+              top-level menu-bar menus by using C-f/C-b and
+              horizontal arrow keys, since they cannot click the
+              mouse to open a different submenu.  This flag is only
+              supported by tty_menu_show.  We set it when POSITION
+              and last_nonmenu_event are different, which means we
+              constructed POSITION by hand (in popup-menu, see
+              menu-bar.el) to look like a mouse click on the menu bar
+              event.  */
+           if (!EQ (POSN_POSN (last_nonmenu_event),
+                    POSN_POSN (position))
+               && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
+             kbd_menu_navigation = 1;
            tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
            x = Fcar (tem);
            y = Fcdr (tem);
@@ -1218,7 +1315,6 @@ no quit occurs and `x-popup-menu' returns nil.  */)
 
     XSETFRAME (Vmenu_updating_frame, f);
   }
-#endif /* HAVE_MENUS */
 
   /* Now parse the lisp menus.  */
   record_unwind_protect_void (unuse_menu_items);
@@ -1301,7 +1397,6 @@ no quit occurs and `x-popup-menu' returns nil.  */)
 
   unbind_to (specpdl_count, Qnil);
 
-#ifdef HAVE_MENUS
 #ifdef HAVE_WINDOW_SYSTEM
   /* Hide a previous tip, if any.  */
   if (!FRAME_TERMCAP_P (f))
@@ -1317,7 +1412,7 @@ no quit occurs and `x-popup-menu' returns nil.  */)
   if (current_popup_menu && FRAME_W32_P (f))
     {
       discard_menu_items ();
-      FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
+      FRAME_DISPLAY_INFO (f)->grabbed = 0;
       UNGCPRO;
       return Qnil;
     }
@@ -1328,7 +1423,6 @@ no quit occurs and `x-popup-menu' returns nil.  */)
 #endif
 
   /* Display them in a menu.  */
-  block_input ();
 
   /* FIXME: Use a terminal hook!  */
 #if defined HAVE_NTGUI
@@ -1344,21 +1438,24 @@ no quit occurs and `x-popup-menu' returns nil.  */)
   else
 #endif
 #if (defined (HAVE_X_WINDOWS) || defined (MSDOS))
-  /* Assume last_event_timestamp is the timestamp of the button event.
-     Is this assumption ever violated?  We can't use the timestamp
-     stored within POSITION because there the top bits from the actual
-     timestamp may be truncated away (Bug#4930).  */
   if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
     selection = xmenu_show (f, xpos, ypos, for_click,
-                           keymaps, title, &error_name,
-                           last_event_timestamp);
+                           keymaps, title, &error_name);
   else
 #endif
+#ifndef MSDOS
   if (FRAME_TERMCAP_P (f))
-    selection = tty_menu_show (f, xpos, ypos, for_click,
-                              keymaps, title, &error_name);
-
-  unblock_input ();
+    {
+      ptrdiff_t count1 = SPECPDL_INDEX ();
+
+      /* Avoid crashes if, e.g., another client will connect while we
+        are in a menu.  */
+      temporarily_switch_to_single_kboard (f);
+      selection = tty_menu_show (f, xpos, ypos, for_click, keymaps, title,
+                                kbd_menu_navigation, &error_name);
+      unbind_to (count1, Qnil);
+    }
+#endif
 
 #ifdef HAVE_NS
   unbind_to (specpdl_count, Qnil);
@@ -1368,17 +1465,153 @@ no quit occurs and `x-popup-menu' returns nil.  */)
 
 #ifdef HAVE_NTGUI     /* FIXME: Is it really w32-specific?  --Stef  */
   if (FRAME_W32_P (f))
-    FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
+    FRAME_DISPLAY_INFO (f)->grabbed = 0;
 #endif
 
-#endif /* HAVE_MENUS */
-
   UNGCPRO;
 
   if (error_name) error ("%s", error_name);
   return selection;
 }
 
+DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
+       doc: /* Pop up a dialog box and return user's selection.
+POSITION specifies which frame to use.
+This is normally a mouse button event or a window or frame.
+If POSITION is t, it means to use the frame the mouse is on.
+The dialog box appears in the middle of the specified frame.
+
+CONTENTS specifies the alternatives to display in the dialog box.
+It is a list of the form (DIALOG ITEM1 ITEM2...).
+Each ITEM is a cons cell (STRING . VALUE).
+The return value is VALUE from the chosen item.
+
+An ITEM may also be just a string--that makes a nonselectable item.
+An ITEM may also be nil--that means to put all preceding items
+on the left of the dialog box and all following items on the right.
+\(By default, approximately half appear on each side.)
+
+If HEADER is non-nil, the frame title for the box is "Information",
+otherwise it is "Question".
+
+If the user gets rid of the dialog box without making a valid choice,
+for instance using the window manager, then this produces a quit and
+`x-popup-dialog' does not return.  */)
+  (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
+{
+  struct frame *f = NULL;
+  Lisp_Object window;
+
+  /* Decode the first argument: find the window or frame to use.  */
+  if (EQ (position, Qt)
+      || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
+                              || EQ (XCAR (position), Qtool_bar))))
+    {
+#if 0 /* Using the frame the mouse is on may not be right.  */
+      /* Use the mouse's current position.  */
+      struct frame *new_f = SELECTED_FRAME ();
+      Lisp_Object bar_window;
+      enum scroll_bar_part part;
+      Time time;
+      Lisp_Object x, y;
+
+      (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
+
+      if (new_f != 0)
+       XSETFRAME (window, new_f);
+      else
+       window = selected_window;
+#endif
+      window = selected_window;
+    }
+  else if (CONSP (position))
+    {
+      Lisp_Object tem = XCAR (position);
+      if (CONSP (tem))
+       window = Fcar (XCDR (position));
+      else
+       {
+         tem = Fcar (XCDR (position));  /* EVENT_START (position) */
+         window = Fcar (tem);       /* POSN_WINDOW (tem) */
+       }
+    }
+  else if (WINDOWP (position) || FRAMEP (position))
+    window = position;
+  else
+    window = Qnil;
+
+  /* Decode where to put the menu.  */
+
+  if (FRAMEP (window))
+    f = XFRAME (window);
+  else if (WINDOWP (window))
+    {
+      CHECK_LIVE_WINDOW (window);
+      f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
+    }
+  else
+    /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
+       but I don't want to make one now.  */
+    CHECK_WINDOW (window);
+
+  /* Force a redisplay before showing the dialog.  If a frame is created
+     just before showing the dialog, its contents may not have been fully
+     drawn, as this depends on timing of events from the X server.  Redisplay
+     is not done when a dialog is shown.  If redisplay could be done in the
+     X event loop (i.e. the X event loop does not run in a signal handler)
+     this would not be needed.
+
+     Do this before creating the widget value that points to Lisp
+     string contents, because Fredisplay may GC and relocate them.  */
+  Fredisplay (Qt);
+
+#if defined USE_X_TOOLKIT || defined USE_GTK
+  if (FRAME_WINDOW_P (f))
+    return xw_popup_dialog (f, header, contents);
+#endif
+#ifdef HAVE_NTGUI
+  if (FRAME_W32_P (f))
+    {
+      Lisp_Object selection = w32_popup_dialog (f, header, contents);
+
+      if (!EQ (selection, Qunsupported__w32_dialog))
+       return selection;
+    }
+#endif
+#ifdef HAVE_NS
+  if (FRAME_NS_P (f))
+    return ns_popup_dialog (position, header, contents);
+#endif
+  /* Display a menu with these alternatives
+     in the middle of frame F.  */
+  {
+    Lisp_Object x, y, frame, newpos, prompt;
+    int x_coord, y_coord;
+
+    prompt = Fcar (contents);
+    if (FRAME_WINDOW_P (f))
+      {
+       x_coord = FRAME_PIXEL_WIDTH (f);
+       y_coord = FRAME_PIXEL_HEIGHT (f);
+      }
+    else
+      {
+       x_coord = FRAME_COLS (f);
+       /* Center the title at frame middle.  (TTY menus have their
+          upper-left corner at the given position.)  */
+       if (STRINGP (prompt))
+         x_coord -= SCHARS (prompt);
+       y_coord = FRAME_LINES (f);
+      }
+    XSETFRAME (frame, f);
+    XSETINT (x, x_coord / 2);
+    XSETINT (y, y_coord / 2);
+    newpos = list2 (list2 (x, y), frame);
+
+    return Fx_popup_menu (newpos, list2 (prompt, contents));
+  }
+}
+
 void
 syms_of_menu (void)
 {
@@ -1387,4 +1620,6 @@ syms_of_menu (void)
   menu_items_inuse = Qnil;
 
   defsubr (&Sx_popup_menu);
+  defsubr (&Sx_popup_dialog);
+  defsubr (&Smenu_bar_menu_at_x_y);
 }