Make TTY menus work with xterm-mouse-mode

* src/term.c (mouse_get_xy): Call 'mouse_position' passing it the
value of 'tty-menu-calls-mouse-position-function' as the
argument.
(syms_of_term) <tty-menu-calls-mouse-position-function>: New
DEFVAR_BOOL.
* src/frame.c (mouse_position): New function, with most of the
code from Fmouse_position, but call 'mouse-position-function' only
if called with non-zero argument.
(Fmouse_position): Call 'mouse_position' to do the job.

* lisp/xt-mouse.el (xterm-mouse-translate-1): Respect
'track-mouse'.
(xterm-mouse-mode): Set 'tty-menu-calls-mouse-position-function'
when setting 'mouse-position-function'.
(xterm-mouse-tracking-enable-sequence): Use SET_ANY_EVENT_MOUSE
(0x1003) so that mouse movement can be reported even if no buttons
are pressed.  Doc fix.
* lisp/menu-bar.el (menu-bar-define-mouse-key): New function.
(tty-menu-navigation-map): Call it.

* doc/lispref/frames.texi (Mouse Position): Document
'tty-menu-calls-mouse-position-function'.

* etc/NEWS: Announce 'tty-menu-calls-mouse-position-function'.

diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 22d32c00d9be3b61020a5ab026d2db673385a1ff..e3d0fdeb2773ee80cfd5258fe58e1519da14a432 100644 (file)
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -3526,6 +3526,13 @@ This abnormal hook exists for the benefit of packages like
 @file{xt-mouse.el} that need to do mouse handling at the Lisp level.
 @end defvar
 
+@defvar tty-menu-calls-mouse-position-function
+If non-@code{nil}, TTY menus will call @code{mouse-position-function}
+as described above.  This exists for cases where
+@code{mouse-position-function} is not safe to be called by the TTY
+menus, such as if it could trigger redisplay.
+@end defvar
+
 @defun set-mouse-position frame x y
 This function @dfn{warps the mouse} to position @var{x}, @var{y} in
 frame @var{frame}.  The arguments @var{x} and @var{y} are integers,

diff --git a/etc/NEWS b/etc/NEWS
index 11c19b378a69101995cbc2d06245f3d7b0819526..a212edfcfb2bca838ffcc9e7d21b28330ecbcbfa 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1748,6 +1748,14 @@ convert them to a list '(R G B)' of primary color values.
 This user option can be one of the predefined styles or a function to
 personalize the uniquified buffer name.
 
++++
+** New variable 'tty-menu-calls-mouse-position-function'.
+This controls whether 'mouse-position-function' is called by functions
+that retrieve the mouse position when that happens during TTY menu
+handling.  Lisp programs that set 'mouse-position-function' should
+also set this variable non-nil if they are compatible with the tty
+menu handling.
+
 +++
 ** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'.
 

diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 8690569ac0a305d9bb38e9392162ff9e1930c29e..e78c1a6c70735b4a8a501fa2c048bab4943abe13 100644 (file)
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -2762,6 +2762,16 @@ This is the keyboard interface to \\[mouse-buffer-menu]."
                 (menu-bar-buffer-vector item)))))
     km))
 
+(defun menu-bar-define-mouse-key (map key def)
+  "Like `define-key', but adds all possible prefixes for the mouse."
+  (define-key map (vector key) def)
+  (mapc (lambda (prefix) (define-key map (vector prefix key) def))
+        ;; This list only needs to contain special window areas that
+        ;; are rendered in TTYs.  No need for *-scroll-bar, *-fringe,
+        ;; or *-divider.
+        '(tab-line header-line menu-bar tab-bar mode-line vertical-line
+          left-margin right-margin)))
+
 (defvar tty-menu-navigation-map
   (let ((map (make-sparse-keymap)))
     ;; The next line is disabled because it breaks interpretation of
@@ -2796,39 +2806,33 @@ This is the keyboard interface to \\[mouse-buffer-menu]."
     (define-key map [?\C-j] 'tty-menu-select)
     (define-key map [return] 'tty-menu-select)
     (define-key map [linefeed] 'tty-menu-select)
-    (define-key map [mouse-1] 'tty-menu-select)
-    (define-key map [drag-mouse-1] 'tty-menu-select)
-    (define-key map [mouse-2] 'tty-menu-select)
-    (define-key map [drag-mouse-2] 'tty-menu-select)
-    (define-key map [mouse-3] 'tty-menu-select)
-    (define-key map [drag-mouse-3] 'tty-menu-select)
-    (define-key map [wheel-down] 'tty-menu-next-item)
-    (define-key map [wheel-up] 'tty-menu-prev-item)
-    (define-key map [wheel-left] 'tty-menu-prev-menu)
-    (define-key map [wheel-right] 'tty-menu-next-menu)
-    ;; The following 4 bindings are for those whose text-mode mouse
+    (menu-bar-define-mouse-key map 'mouse-1 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'drag-mouse-1 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'mouse-2 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'drag-mouse-2 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'mouse-3 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'drag-mouse-3 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'wheel-down 'tty-menu-next-item)
+    (menu-bar-define-mouse-key map 'wheel-up 'tty-menu-prev-item)
+    (menu-bar-define-mouse-key map 'wheel-left 'tty-menu-prev-menu)
+    (menu-bar-define-mouse-key map 'wheel-right 'tty-menu-next-menu)
+    ;; The following 6 bindings are for those whose text-mode mouse
     ;; lack the wheel.
-    (define-key map [S-mouse-1] 'tty-menu-next-item)
-    (define-key map [S-drag-mouse-1] 'tty-menu-next-item)
-    (define-key map [S-mouse-2] 'tty-menu-prev-item)
-    (define-key map [S-drag-mouse-2] 'tty-menu-prev-item)
-    (define-key map [S-mouse-3] 'tty-menu-prev-item)
-    (define-key map [S-drag-mouse-3] 'tty-menu-prev-item)
-    (define-key map [header-line mouse-1] 'tty-menu-select)
-    (define-key map [header-line drag-mouse-1] 'tty-menu-select)
+    (menu-bar-define-mouse-key map 'S-mouse-1 'tty-menu-next-item)
+    (menu-bar-define-mouse-key map 'S-drag-mouse-1 'tty-menu-next-item)
+    (menu-bar-define-mouse-key map 'S-mouse-2 'tty-menu-prev-item)
+    (menu-bar-define-mouse-key map 'S-drag-mouse-2 'tty-menu-prev-item)
+    (menu-bar-define-mouse-key map 'S-mouse-3 'tty-menu-prev-item)
+    (menu-bar-define-mouse-key map 'S-drag-mouse-3 'tty-menu-prev-item)
     ;; The down-mouse events must be bound to tty-menu-ignore, so that
     ;; only releasing the mouse button pops up the menu.
-    (define-key map [mode-line down-mouse-1] 'tty-menu-ignore)
-    (define-key map [mode-line down-mouse-2] 'tty-menu-ignore)
-    (define-key map [mode-line down-mouse-3] 'tty-menu-ignore)
-    (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore)
-    (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore)
-    (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore)
-    (define-key map [down-mouse-1] 'tty-menu-ignore)
-    (define-key map [C-down-mouse-1] 'tty-menu-ignore)
-    (define-key map [C-down-mouse-2] 'tty-menu-ignore)
-    (define-key map [C-down-mouse-3] 'tty-menu-ignore)
-    (define-key map [mouse-movement] 'tty-menu-mouse-movement)
+    (menu-bar-define-mouse-key map 'down-mouse-1 'tty-menu-ignore)
+    (menu-bar-define-mouse-key map 'down-mouse-2 'tty-menu-ignore)
+    (menu-bar-define-mouse-key map 'down-mouse-3 'tty-menu-ignore)
+    (menu-bar-define-mouse-key map 'C-down-mouse-1 'tty-menu-ignore)
+    (menu-bar-define-mouse-key map 'C-down-mouse-2 'tty-menu-ignore)
+    (menu-bar-define-mouse-key map 'C-down-mouse-3 'tty-menu-ignore)
+    (menu-bar-define-mouse-key map 'mouse-movement 'tty-menu-mouse-movement)
     map)
   "Keymap used while processing TTY menus.")
 

diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 362d29b943d74ad417bdb614f067117cdb8bdaf7..3c0dfb65ecfe5b4341cce3e53c67067911a10d87 100644 (file)
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -76,7 +76,11 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
               ;; to guard against that.
               (copy-sequence event))
        vec)
-       (is-move vec)
+       (is-move
+        (if track-mouse vec
+          ;; Mouse movement events are currently supposed to be
+          ;; suppressed.  Return no event.
+          []))
        (t
        (let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
               (down-data (nth 1 down))
@@ -321,11 +325,13 @@ down the SHIFT key while pressing the mouse button."
   (if xterm-mouse-mode
       ;; Turn it on
       (progn
-       (setq mouse-position-function #'xterm-mouse-position-function)
+        (setq mouse-position-function #'xterm-mouse-position-function
+              tty-menu-calls-mouse-position-function t)
         (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list)))
     ;; Turn it off
     (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list))
-    (setq mouse-position-function nil)))
+    (setq mouse-position-function nil
+          tty-menu-calls-mouse-position-function nil)))
 
 (defun xterm-mouse-tracking-enable-sequence ()
   "Return a control sequence to enable XTerm mouse tracking.
@@ -339,8 +345,8 @@ modern xterms:
             position (<= 223), which can be reported in this
             basic mode.
 
-\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse
-            motion events during dragging operations.
+\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse
+            motion events.
 
 \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an
             extension to the basic mouse mode, which uses UTF-8
@@ -360,7 +366,7 @@ given escape sequence takes precedence over the former."
   (apply #'concat (xterm-mouse--tracking-sequence ?h)))
 
 (defconst xterm-mouse-tracking-enable-sequence
-  "\e[?1000h\e[?1002h\e[?1005h\e[?1006h"
+  "\e[?1000h\e[?1003h\e[?1005h\e[?1006h"
   "Control sequence to enable xterm mouse tracking.
 Enables basic mouse tracking, mouse motion events and finally
 extended tracking on terminals that support it. The following
@@ -371,8 +377,8 @@ escape sequences are understood by modern xterms:
             position (<= 223), which can be reported in this
             basic mode.
 
-\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse
-            motion events during dragging operations.
+\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse
+            motion events.
 
 \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension
             to the basic mouse mode, which uses UTF-8
@@ -400,7 +406,7 @@ The control sequence resets the modes set by
   (apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l))))
 
 (defconst xterm-mouse-tracking-disable-sequence
-  "\e[?1006l\e[?1005l\e[?1002l\e[?1000l"
+  "\e[?1006l\e[?1005l\e[?1003l\e[?1000l"
   "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
 
 (make-obsolete-variable
@@ -414,7 +420,7 @@ SUFFIX is the last character of each escape sequence (?h to
 enable, ?l to disable)."
   (mapcar
    (lambda (code) (format "\e[?%d%c" code suffix))
-   `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006)))
+   `(1000 1003 ,@(when xterm-mouse-utf-8 '(1005)) 1006)))
 
 (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
   "Enable xterm mouse tracking on TERMINAL."

diff --git a/src/frame.c b/src/frame.c
index 0b707c2af876bc63a11501be4ed501a3f9fd63f0..5d967a59ce33b91a0d2da7b44e2b68e6994d0f73 100644 (file)
--- a/src/frame.c
+++ b/src/frame.c
@@ -2433,6 +2433,12 @@ If `mouse-position-function' is non-nil, `mouse-position' calls it,
 passing the normal return value to that function as an argument,
 and returns whatever that function returns.  */)
   (void)
+{
+  return mouse_position (true);
+}
+
+Lisp_Object
+mouse_position (bool call_mouse_position_function)
 {
   struct frame *f;
   Lisp_Object lispy_dummy;
@@ -2462,7 +2468,7 @@ and returns whatever that function returns.  */)
     }
   XSETFRAME (lispy_dummy, f);
   retval = Fcons (lispy_dummy, Fcons (x, y));
-  if (!NILP (Vmouse_position_function))
+  if (call_mouse_position_function && !NILP (Vmouse_position_function))
     retval = call1 (Vmouse_position_function, retval);
   return retval;
 }

diff --git a/src/frame.h b/src/frame.h
index 476bac67faff49b3b8ab7e0de770a5715a29d1b9..16ecfd311c367aa11186473294a385dbf7a54525 100644 (file)
--- a/src/frame.h
+++ b/src/frame.h
@@ -1361,6 +1361,7 @@ extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object);
 extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object);
 extern void frame_size_history_add (struct frame *f, Lisp_Object fun_symbol,
                                    int width, int height, Lisp_Object rest);
+extern Lisp_Object mouse_position (bool);
 
 extern Lisp_Object Vframe_list;
 

diff --git a/src/term.c b/src/term.c
index 53a1016183bcd833f66ee24741dfb1fe24a88fcc..ff1aabfed2388f9b637b3dac34c0b90d7e08559b 100644 (file)
--- a/src/term.c
+++ b/src/term.c
@@ -2804,16 +2804,15 @@ tty_menu_calc_size (tty_menu *menu, int *width, int *height)
 static void
 mouse_get_xy (int *x, int *y)
 {
-  struct frame *sf = SELECTED_FRAME ();
-  Lisp_Object lmx = Qnil, lmy = Qnil, lisp_dummy;
-  enum scroll_bar_part part_dummy;
-  Time time_dummy;
-
-  if (FRAME_TERMINAL (sf)->mouse_position_hook)
-    (*FRAME_TERMINAL (sf)->mouse_position_hook) (&sf, -1,
-                                                 &lisp_dummy, &part_dummy,
-                                                &lmx, &lmy,
-                                                &time_dummy);
+  Lisp_Object lmx = Qnil, lmy = Qnil;
+  Lisp_Object mouse = mouse_position (tty_menu_calls_mouse_position_function);
+
+  if (EQ (selected_frame, XCAR (mouse)))
+    {
+      lmx = XCAR (XCDR (mouse));
+      lmy = XCDR (XCDR (mouse));
+    }
+
   if (!NILP (lmx))
     {
       *x = XFIXNUM (lmx);
@@ -4554,6 +4553,13 @@ What means \"very visible\" is up to your terminal.  It may make the cursor
 bigger, or it may make it blink, or it may do nothing at all.  */);
   visible_cursor = 1;
 
+  DEFVAR_BOOL ("tty-menu-calls-mouse-position-function",
+               tty_menu_calls_mouse_position_function,
+    doc: /* Non-nil means TTY menu code will call `mouse-position-function'.
+This should be set if the function in `mouse-position-function' does not
+trigger redisplay.  */);
+  tty_menu_calls_mouse_position_function = 0;
+
   defsubr (&Stty_display_color_p);
   defsubr (&Stty_display_color_cells);
   defsubr (&Stty_no_underline);