feature/tab-bar-events 794fdce: Improve tab-bar event handling (bug#41343)

[Juri Linkov]

branch: feature/tab-bar-events
commit 794fdce55d097f2b58ce37818edffb2deef7b9de
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    Improve tab-bar event handling (bug#41343)
    
    * lisp/tab-bar.el (tab-bar--key-to-number): Rename from tab--key-to-number.
    (tab-bar--event-to-item): New function from tab-bar-handle-mouse.
    (tab-bar-mouse-select-tab, tab-bar-mouse-close-tab)
    (tab-bar-mouse-context-menu, tab-bar-mouse-move-tab):
    Use tab-bar--event-to-item.
    
    * src/menu.c (x_popup_menu_1): Handle Qtab_bar in the second list element.
    
    * src/xdisp.c (tty_get_tab_bar_item): Change arg 'end' to bool 'close_p'.
    (tty_get_tab_bar_item): Detect if the close button was clicked.
    (tty_handle_tab_bar_click): Return a list with caption that has
    text properties.
---
 lisp/tab-bar.el | 96 ++++++++++++++++++++++++++-------------------------------
 src/menu.c      |  9 ++++--
 src/w32term.c   | 10 +++---
 src/xdisp.c     | 44 +++++++++++++-------------
 src/xterm.c     | 10 +++---
 5 files changed, 82 insertions(+), 87 deletions(-)

diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index ef7babb..aac7bb5 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -221,61 +221,53 @@ a list of frames to update."
       (tab-bar--define-keys)
     (tab-bar--undefine-keys)))
 
-(defun tab--key-to-number (key)
-  (unless (or (null key) (eq key 'current-tab))
-    (string-to-number
-     (string-replace "tab-" "" (format "%S" key)))))
-
-(defun tab-bar-handle-mouse (event)
-  "Text-mode emulation of switching tabs on the tab bar.
-This command is used when you click the mouse in the tab bar
-on a console which has no window system but does have a mouse."
-  (interactive "e")
-  (let* ((x-position (car (posn-x-y (event-start event))))
-         (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps))) 
[tab-bar]))
-         (column 0))
-    (when x-position
-      (unless (catch 'done
-                (map-keymap
-                 (lambda (key binding)
-                   (when (eq (car-safe binding) 'menu-item)
-                     (when (> (+ column (length (nth 1 binding))) x-position)
-                       (if (get-text-property
-                            (- x-position column) 'close-tab (nth 1 binding))
-                           (tab-bar-close-tab (tab--key-to-number key))
-                         (if (nth 2 binding)
-                             (call-interactively (nth 2 binding))
-                           (tab-bar-select-tab (tab--key-to-number key))))
-                       (throw 'done t))
-                     (setq column (+ column (length (nth 1 binding))))))
-                 keymap))
-        ;; Clicking anywhere outside existing tabs will add a new tab
-        (tab-bar-new-tab)))))
+(defun tab-bar--key-to-number (key)
+  (let ((key-name (format "%S" key)))
+    (when (string-prefix-p "tab-" key-name)
+      (string-to-number (string-replace "tab-" "" key-name)))))
+
+(defun tab-bar--event-to-item (posn)
+  (if (posn-window posn)
+      (let ((caption (car (posn-string posn))))
+        (when caption
+          (get-text-property 0 'menu-item caption)))
+    ;; Text-mode emulation of switching tabs on the tab bar.
+    ;; This code is used when you click the mouse in the tab bar
+    ;; on a console which has no window system but does have a mouse.
+    (let* ((x-position (car (posn-x-y posn)))
+           (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps))) 
[tab-bar]))
+           (column 0))
+      (when x-position
+        (catch 'done
+          (map-keymap
+           (lambda (key binding)
+             (when (eq (car-safe binding) 'menu-item)
+               (when (> (+ column (length (nth 1 binding))) x-position)
+                 (throw 'done (list
+                               key (nth 2 binding)
+                               (get-text-property
+                                (- x-position column) 'close-tab (nth 1 
binding)))))
+               (setq column (+ column (length (nth 1 binding))))))
+           keymap))))))
 
 (defun tab-bar-mouse-select-tab (event)
   (interactive "e")
-  (if (posn-window (event-start event))
-      (let* ((caption (car (posn-string (event-start event))))
-             (item (and caption (get-text-property 0 'menu-item caption))))
-        (if (nth 2 item)
-            (tab-bar-close-tab (tab--key-to-number (nth 0 item)))
-          (if (functionp (nth 1 item))
-              (call-interactively (nth 1 item))
-            (tab-bar-select-tab (tab--key-to-number (nth 0 item))))))
-    ;; TTY
-    (tab-bar-handle-mouse event)))
+  (let ((item (tab-bar--event-to-item (event-start event))))
+    (if (nth 2 item)
+        (tab-bar-close-tab (tab-bar--key-to-number (nth 0 item)))
+      (if (functionp (nth 1 item))
+          (call-interactively (nth 1 item))
+        (tab-bar-select-tab (tab-bar--key-to-number (nth 0 item)))))))
 
 (defun tab-bar-mouse-close-tab (event)
   (interactive "e")
-  (let* ((caption (car (posn-string (event-start event))))
-         (item (and caption (get-text-property 0 'menu-item caption))))
-    (tab-bar-close-tab (tab--key-to-number (nth 0 item)))))
+  (let ((item (tab-bar--event-to-item (event-start event))))
+    (tab-bar-close-tab (tab-bar--key-to-number (nth 0 item)))))
 
 (defun tab-bar-mouse-context-menu (event)
   (interactive "e")
-  (let* ((caption (car (posn-string (event-start event))))
-         (item (and caption (get-text-property 0 'menu-item caption)))
-         (tab-number (tab--key-to-number (nth 0 item)))
+  (let* ((item (tab-bar--event-to-item (event-start event)))
+         (tab-number (tab-bar--key-to-number (nth 0 item)))
          (menu (make-sparse-keymap "Context Menu")))
 
     (define-key-after menu [close]
@@ -287,12 +279,12 @@ on a console which has no window system but does have a 
mouse."
 
 (defun tab-bar-mouse-move-tab (event)
   (interactive "e")
-  (let* ((caption (car (posn-string (event-start event))))
-         (item (and caption (get-text-property 0 'menu-item caption)))
-         (from (tab--key-to-number (nth 0 item)))
-         (caption (car (posn-string (event-end event))))
-         (item (and caption (get-text-property 0 'menu-item caption)))
-         (to (tab--key-to-number (nth 0 item))))
+  (let ((from (tab-bar--key-to-number
+               (nth 0 (tab-bar--event-to-item
+                       (event-start event)))))
+        (to (tab-bar--key-to-number
+             (nth 0 (tab-bar--event-to-item
+                     (event-end event))))))
     (tab-bar-move-tab-to to from)))
 
 (defun toggle-tab-bar-mode-from-frame (&optional arg)
diff --git a/src/menu.c b/src/menu.c
index 3b1d740..990a74b 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1127,9 +1127,12 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
 
     /* Decode the first argument: find the window and the coordinates.  */
     if (EQ (position, Qt)
-       || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
-                                || EQ (XCAR (position), Qtab_bar)
-                                || EQ (XCAR (position), Qtool_bar))))
+       || (CONSP (position)
+           && (EQ (XCAR (position), Qmenu_bar)
+               || EQ (XCAR (position), Qtab_bar)
+               || (CONSP (XCDR (position))
+                   && EQ (XCAR (XCDR (position)), Qtab_bar))
+               || EQ (XCAR (position), Qtool_bar))))
       {
        get_current_pos_p = 1;
       }
diff --git a/src/w32term.c b/src/w32term.c
index c9570b0..aca4739 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -5186,7 +5186,7 @@ w32_read_socket (struct terminal *terminal,
          {
             /* If we decide we want to generate an event to be seen
                by the rest of Emacs, we put it here.  */
-           Lisp_Object tab_bar_key = Qnil;
+           Lisp_Object tab_bar_arg = Qnil;
            bool tab_bar_p = 0;
            bool tool_bar_p = 0;
            int button = 0;
@@ -5209,12 +5209,12 @@ w32_read_socket (struct terminal *terminal,
 
                     if (EQ (window, f->tab_bar_window))
                       {
-                        tab_bar_key = w32_handle_tab_bar_click (f, &inev);
+                        tab_bar_arg = w32_handle_tab_bar_click (f, &inev);
                         tab_bar_p = 1;
                       }
                   }
 
-                if ((tab_bar_p && NILP (tab_bar_key))
+                if ((tab_bar_p && NILP (tab_bar_arg))
                    || (dpyinfo->w32_focus_frame
                        && f != dpyinfo->w32_focus_frame
                        /* This does not help when the click happens in
@@ -5222,8 +5222,8 @@ w32_read_socket (struct terminal *terminal,
                        && !frame_ancestor_p (f, dpyinfo->w32_focus_frame)))
                  inev.kind = NO_EVENT;
 
-                 if (!NILP (tab_bar_key))
-                   inev.arg = tab_bar_key;
+                 if (!NILP (tab_bar_arg))
+                   inev.arg = tab_bar_arg;
 
                 /* Is this in the tool-bar?  */
                 if (WINDOWP (f->tool_bar_window)
diff --git a/src/xdisp.c b/src/xdisp.c
index 4a5ab17..91f9bb9 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -13891,7 +13891,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y)
 
 /* Find the tab-bar item at X coordinate and return its information.  */
 static Lisp_Object
-tty_get_tab_bar_item (struct frame *f, int x, int *idx, ptrdiff_t *end)
+tty_get_tab_bar_item (struct frame *f, int x, int *prop_idx, bool *close_p)
 {
   ptrdiff_t clen = 0;
 
@@ -13904,8 +13904,11 @@ tty_get_tab_bar_item (struct frame *f, int x, int 
*idx, ptrdiff_t *end)
       clen += SCHARS (caption);
       if (x < clen)
        {
-         *idx = i;
-         *end = clen;
+         *prop_idx = i;
+         *close_p = !NILP (Fget_text_property (make_fixnum (SCHARS (caption)
+                                                            - (clen - x)),
+                                               Qclose_tab,
+                                               caption));
          return caption;
        }
     }
@@ -13928,8 +13931,8 @@ tty_handle_tab_bar_click (struct frame *f, int x, int 
y, bool down_p,
 
   /* Find the tab-bar item where the X,Y coordinates belong.  */
   int prop_idx;
-  ptrdiff_t clen;
-  Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &clen);
+  bool close_p;
+  Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &close_p);
 
   if (NILP (caption))
     return Qnil;
@@ -13941,24 +13944,21 @@ tty_handle_tab_bar_click (struct frame *f, int x, int 
y, bool down_p,
   if (down_p)
     f->last_tab_bar_item = prop_idx;
   else
-    {
-      f->last_tab_bar_item = -1;
-    }
+    f->last_tab_bar_item = -1;
 
-  /* Generate a TAB_BAR_EVENT event.  */
-  Lisp_Object key = AREF (f->tab_bar_items,
-                         prop_idx * TAB_BAR_ITEM_NSLOTS
-                         + TAB_BAR_ITEM_KEY);
-  /* Kludge alert: we assume the last two characters of a tab
-     label are " x", and treat clicks on those 2 characters as a
-     Close Tab command.  */
-  eassert (STRINGP (caption));
-  int lastc = SSDATA (caption)[SCHARS (caption) - 1];
-  bool close_p = false;
-  if ((x == clen - 1 || (clen > 1 && x == clen - 2)) && lastc == 'x')
-    close_p = true;
+  caption = Fcopy_sequence (caption);
 
-  return list3 (Qtab_bar, key, close_p ? Qt : Qnil);
+  AUTO_LIST2 (props, Qmenu_item,
+             list3 (AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS
+                          + TAB_BAR_ITEM_KEY),
+                    AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS
+                          + TAB_BAR_ITEM_BINDING),
+                    close_p ? Qt : Qnil));
+
+  Fadd_text_properties (make_fixnum (0), make_fixnum (SCHARS (caption)),
+                       props, caption);
+
+  return Fcons (Qtab_bar, Fcons (caption, make_fixnum (0)));
 }
 
 
@@ -33524,7 +33524,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
          && y < FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f)))
     {
       int prop_idx;
-      ptrdiff_t ignore;
+      bool ignore;
       Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &ignore);
 
       if (!NILP (caption))
diff --git a/src/xterm.c b/src/xterm.c
index 57229d3..846b67b 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -9166,7 +9166,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
       {
         /* If we decide we want to generate an event to be seen
            by the rest of Emacs, we put it here.  */
-        Lisp_Object tab_bar_key = Qnil;
+        Lisp_Object tab_bar_arg = Qnil;
         bool tab_bar_p = false;
         bool tool_bar_p = false;
 
@@ -9216,7 +9216,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                 tab_bar_p = EQ (window, f->tab_bar_window);
 
                 if (tab_bar_p)
-                 tab_bar_key = handle_tab_bar_click
+                 tab_bar_arg = handle_tab_bar_click
                    (f, x, y, event->xbutton.type == ButtonPress,
                     x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
               }
@@ -9240,7 +9240,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
               }
 #endif /* !USE_GTK */
 
-            if (!(tab_bar_p && NILP (tab_bar_key)) && !tool_bar_p)
+            if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p)
 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
               if (! popup_activated ())
 #endif
@@ -9259,8 +9259,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                   else
                     x_construct_mouse_click (&inev.ie, &event->xbutton, f);
 
-                 if (!NILP (tab_bar_key))
-                   inev.ie.arg = tab_bar_key;
+                 if (!NILP (tab_bar_arg))
+                   inev.ie.arg = tab_bar_arg;
                 }
             if (FRAME_X_EMBEDDED_P (f))
               xembed_send_message (f, event->xbutton.time,