Use images for new/close buttons in tab-bar and tab-line.

* etc/images/tabs/new.xpm:
* etc/images/tabs/close.xpm:
New files.

* lisp/tab-bar.el (tab-bar-separator): New face.
(tab-bar-separator, tab-bar-button-new, tab-bar-button-close):
Use display property with images in default values.

* lisp/tab-line.el (tab-line-button-new, tab-line-button-close):
Use display property with images in default values.

* src/xdisp.c (tab_bar_item_info): Add new arg close_p and set it
to the value of property `close' at charpos.
(get_tab_bar_item): Add new arg close_p.
(handle_tab_bar_click): Add ctrl_modifier when close_p is non-nil.
(Fdump_tab_bar_row): Fix crash for non-X builds.

2 files changed, 159 insertions, 127 deletions

diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 57be4e09a8f..c15eb2979c4 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -47,37 +47,45 @@
   :version "27.1")
 
 (defface tab-bar
-  '((default
-     :box (:line-width 1 :style released-button)
-     :foreground "black"
-     :background "white")
-    (((type x w32 ns) (class color))
-     :background "grey75")
+  '((((type x w32 ns) (class color))
+     :height 1.1
+     :background "grey85"
+     :foreground "black")
     (((type x) (class mono))
-     :background "grey"))
+     :background "grey")
+    (t
+     :inverse-video t))
   "Tab bar face."
   :version "27.1"
   :group 'tab-bar-faces)
 
 (defface tab-bar-tab
-  '((default
-      :inherit tab-bar-tab-inactive)
+  '((((class color) (min-colors 88))
+     :box (:line-width 1 :style released-button))
     (t
-     :background "grey75"))
+     :inverse-video nil))
   "Tab bar face for selected tab."
   :version "27.1"
   :group 'tab-bar-faces)
 
 (defface tab-bar-tab-inactive
-  '((((class color) (min-colors 88))
-     :box (:line-width -15 :style pressed-button)
-     :background "grey60")
+  '((default
+      :inherit tab-bar-tab)
+    (((class color) (min-colors 88))
+     :background "grey75")
     (t
-     :inherit highlight))
+     :inverse-video t))
   "Tab bar face for non-selected tab."
   :version "27.1"
   :group 'tab-bar-faces)
 
+(defface tab-bar-separator
+  '((t
+     :inverse-video nil))
+  "Tab bar face for separator."
+  :version "27.1"
+  :group 'tab-bar-faces)
+
 
 (define-minor-mode tab-bar-mode
   "Toggle the tab bar in all graphical frames (Tab Bar mode)."
@@ -99,7 +107,7 @@
     (global-set-key [(control shift tab)]         'tab-bar-switch-to-prev-tab)
     (global-set-key [(control tab)]               'tab-bar-switch-to-next-tab)))
 
-(defun tab-bar-mouse (event)
+(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."
@@ -113,9 +121,11 @@ on a console which has no window system but does have a mouse."
                  (lambda (_key binding)
                    (when (eq (car-safe binding) 'menu-item)
                      (when (> (+ column (length (nth 1 binding))) x-position)
-                       (call-interactively (nth 2 binding))
+                       ;; TODO: handle close
+                       (unless (get-text-property (- x-position column) 'close (nth 1 binding))
+                         (call-interactively (nth 2 binding)))
                        (throw 'done t))
-                     (setq column (+ column (length (nth 1 binding)) 1))))
+                     (setq column (+ column (length (nth 1 binding))))))
                  keymap))
         ;; Clicking anywhere outside existing tabs will add a new tab
         (tab-bar-add-tab)))))
@@ -149,9 +159,30 @@ Its main job is to show tabs in the tab bar."
           (puthash key tab-bar-map tab-bar-keymap-cache)))))
 
 
-(defvar tab-bar-separator " ")
-(defvar tab-bar-tab-name-add nil)
-(defvar tab-bar-tab-name-close nil)
+(defvar tab-bar-separator
+  (propertize " " 'face 'tab-bar-separator))
+
+(defvar tab-bar-button-new
+  (propertize " + "
+              'display `(image :type xpm
+                               :file ,(expand-file-name
+                                       "images/tabs/new.xpm"
+                                       data-directory)
+                               :margin (2 . 0)
+                               :ascent center))
+  "Button for creating a new tab.")
+
+(defvar tab-bar-button-close
+  (propertize "x"
+              'display `(image :type xpm
+                               :file ,(expand-file-name
+                                       "images/tabs/close.xpm"
+                                       data-directory)
+                               :margin (2 . 0)
+                               :ascent center)
+              'close t
+              :help "Click to close tab")
+  "Button for closing the clicked tab.")
 
 (defun tab-bar-tab-name ()
   "Generate tab name in the context of the selected frame."
@@ -172,54 +203,44 @@ Return its existing value or a new value."
 
 (defun tab-bar-make-keymap-1 ()
   "Generate an actual keymap from `tab-bar-map', without caching."
-  ;; Can't check for char-displayable-p in defvar
-  ;; because this file is preloaded.
-  (unless tab-bar-tab-name-add
-    (setq tab-bar-tab-name-add
-          (if (char-displayable-p ?➕) "➕" "[+]")))
-  (unless tab-bar-tab-name-close
-    (setq tab-bar-tab-name-close
-          ;; Need to add space after Unicode char on terminals
-          ;; to avoid clobbering next char by wide Unicode char.
-          (if (char-displayable-p ?⮿) (if window-system "⮿" "⮿ ") "[x]")))
   (let ((i 0))
     (append
-     '(keymap (mouse-1 . tab-bar-mouse))
+     '(keymap (mouse-1 . tab-bar-handle-mouse))
      (mapcan
       (lambda (tab)
         (setq i (1+ i))
-        (list (cond
-               ((eq (car tab) 'current-tab)
-                `(current-tab
-                  menu-item
-                  ,(propertize (cdr (assq 'name tab)) 'face 'tab-bar-tab)
-                  ignore
-                  :help "Current tab"))
-               (t
-                `(,(intern (format "tab-%i" i))
-                  menu-item
-                  ,(propertize (cdr (assq 'name tab)) 'face 'tab-bar-tab-inactive)
-                  ,(lambda ()
-                     (interactive)
-                     (tab-bar-select-tab tab))
-                  :help "Click to visit tab")))
-              `(,(intern (format "close-tab-%i" i))
-                menu-item
-                ,(concat (propertize tab-bar-tab-name-close
-                                     'face (if (eq (car tab) 'current-tab)
-                                               'tab-bar-tab
-                                             'tab-bar-tab-inactive))
-                         tab-bar-separator)
-                ,(lambda ()
-                   (interactive)
-                   (tab-bar-close-tab tab))
-                :help "Click to close tab")))
+        (append
+         (cond
+          ((eq (car tab) 'current-tab)
+           `((current-tab
+              menu-item
+              ,(propertize (concat (cdr (assq 'name tab))
+                                   (or tab-bar-button-close ""))
+                           'face 'tab-bar-tab)
+              ignore
+              :help "Current tab")))
+          (t
+           `((,(intern (format "tab-%i" i))
+              menu-item
+              ,(propertize (concat (cdr (assq 'name tab))
+                                   (or tab-bar-button-close ""))
+                           'face 'tab-bar-tab-inactive)
+              ,(lambda ()
+                 (interactive)
+                 (tab-bar-select-tab tab))
+              :help "Click to visit tab"))))
+         `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
+            menu-item ""
+            ,(lambda ()
+               (interactive)
+               (tab-bar-close-tab tab))))
+         (when (and (stringp tab-bar-separator)
+                    (> (length tab-bar-separator) 0))
+           `((,(intern (format "sep-%i" i)) menu-item ,tab-bar-separator ignore)))))
       (tab-bar-tabs))
-     `((add-tab menu-item
-                ,(propertize tab-bar-tab-name-add
-                             'face 'tab-bar-tab-inactive)
-                tab-bar-add-tab
-                :help "Click to add tab")))))
+     (when tab-bar-button-new
+       `((add-tab menu-item ,tab-bar-button-new tab-bar-add-tab
+                  :help "New tab"))))))
 
 
 (defun tab-bar-read-tab-name (prompt)
@@ -279,16 +300,16 @@ Return its existing value or a new value."
         (setq tabs (cdr tabs)))
       (force-window-update))))
 
-(defun tab-bar-switch-to-prev-tab ()
-  "Switch to the previous tab."
-  (interactive)
+(defun tab-bar-switch-to-prev-tab (&optional _arg)
+  "Switch to ARGth previous tab."
+  (interactive "p")
   (let ((prev-tab (tab-bar-find-prev-tab)))
     (when prev-tab
       (tab-bar-select-tab (car prev-tab)))))
 
-(defun tab-bar-switch-to-next-tab ()
-  "Switch to the next tab."
-  (interactive)
+(defun tab-bar-switch-to-next-tab (&optional _arg)
+  "Switch to ARGth next tab."
+  (interactive "p")
   (let* ((tabs (tab-bar-tabs))
          (prev-tab (tab-bar-find-prev-tab tabs)))
     (if prev-tab
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 8ade53611f3..6b1ce03d26e 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -42,48 +42,51 @@
   :version "27.1")
 
 (defface tab-line
-  '((default :inherit header-line))
+  '((((type x w32 ns) (class color))
+     :background "grey85"
+     :foreground "black")
+    (((type x) (class mono))
+     :background "grey")
+    (t
+     :inverse-video t))
   "Tab line face."
   :version "27.1"
   :group 'tab-line-faces)
 
-(defface tab-line-highlight
-  '((default :inherit tab-line-tab))
-  "Tab line face for highlighting."
-  :version "27.1"
-  :group 'tab-line-faces)
-
-(defface tab-line-close-highlight
-  '((t :foreground "red"))
-  "Tab line face for highlighting."
-  :version "27.1"
-  :group 'tab-line-faces)
-
 (defface tab-line-tab
   '((((class color) (min-colors 88))
-     :box (:line-width -1 :style pressed-button)
-     :background "white" :foreground "black")
+     :box (:line-width 1 :style released-button)
+     :background "grey85")
     (t
-     :inverse-video t))
+     :inverse-video nil))
   "Tab line face for selected tab."
   :version "27.1"
   :group 'tab-line-faces)
 
 (defface tab-line-tab-inactive
   '((default
-     :inherit tab-line)
-    (((class color) (min-colors 88) (background light))
-     :weight light
-     :box (:line-width -1 :color "grey75" :style released-button)
-     :foreground "grey20" :background "grey90")
-    (((class color) (min-colors 88) (background dark) )
-     :weight light
-     :box (:line-width -1 :color "grey40" :style released-button)
-     :foreground "grey80" :background "grey30"))
+      :inherit tab-line-tab)
+    (((class color) (min-colors 88))
+     :background "grey75")
+    (t
+     :inverse-video t))
   "Tab line face for non-selected tabs."
   :version "27.1"
   :group 'tab-line-faces)
 
+(defface tab-line-highlight
+  '((default :inherit tab-line-tab))
+  "Tab line face for highlighting."
+  :version "27.1"
+  :group 'tab-line-faces)
+
+(defface tab-line-close-highlight
+  '((t :foreground "red"))
+  "Tab line face for highlighting."
+  :version "27.1"
+  :group 'tab-line-faces)
+
+
 (defvar tab-line-tab-map
   (let ((map (make-sparse-keymap)))
     (define-key map [tab-line mouse-1] 'tab-line-select-tab)
@@ -112,15 +115,37 @@
     map)
   "Local keymap to close `tab-line-mode' window tabs.")
 
+
 (defvar tab-line-separator " ")
+
 (defvar tab-line-tab-name-ellipsis
   (if (char-displayable-p ?…) "…" "..."))
-(defvar tab-line-tab-name-add
-  (if (char-displayable-p ?➕) "➕" "[+]"))
-(defvar tab-line-tab-name-close
-  ;; Need to add space after Unicode char on terminals
-  ;; to avoid clobbering next char by wide Unicode char.
-  (if (char-displayable-p ?⮿) (if window-system "⮿" "⮿ ") "[x]"))
+
+(defvar tab-line-button-new
+  (propertize " + "
+              'display `(image :type xpm
+                               :file ,(expand-file-name
+                                       "images/tabs/new.xpm"
+                                       data-directory)
+                               :margin (2 . 0)
+                               :ascent center)
+              'keymap tab-line-add-map
+              'mouse-face 'tab-line-highlight
+              'help-echo "Click to add tab")
+  "Button for creating a new tab.")
+
+(defvar tab-line-button-close
+  (propertize "x"
+              'display `(image :type xpm
+                               :file ,(expand-file-name
+                                       "images/tabs/close.xpm"
+                                       data-directory)
+                               :margin (2 . 0)
+                               :ascent center)
+              'keymap tab-line-tab-close-map
+              'mouse-face 'tab-line-close-highlight
+              'help-echo "Click to close tab")
+  "Button for closing the clicked tab.")
 
 
 (defun tab-line-tab-name (buffer &optional buffers)
@@ -171,39 +196,25 @@ Reduce tab width proportionally to space taken by other tabs."
     (append
      (mapcar
       (lambda (b)
-        (format "%s%s%s"
-                tab-line-separator
-                (apply 'propertize (tab-line-tab-name b buffer-tabs)
-                       `(
-                         buffer ,b
-                         face ,(if (eq b buffer)
-                                   'tab-line-tab
-                                 'tab-line-tab-inactive)
-                         mouse-face tab-line-highlight
-                         keymap ,tab-line-tab-map))
-                (apply 'propertize tab-line-tab-name-close
-                       `(
-                         help-echo "Click to close tab"
-                         buffer ,b
-                         face ,(if (eq b buffer)
-                                   'tab-line-tab
-                                 'tab-line-tab-inactive)
-                         mouse-face tab-line-close-highlight
-                         keymap ,tab-line-tab-close-map))))
+        (concat
+         (or tab-line-separator "")
+         (apply 'propertize (concat (propertize
+                                     (tab-line-tab-name b buffer-tabs)
+                                     'keymap tab-line-tab-map)
+                                    tab-line-button-close)
+                `(
+                  buffer ,b
+                  face ,(if (eq b buffer)
+                            'tab-line-tab
+                          'tab-line-tab-inactive)
+                  mouse-face tab-line-highlight))))
       buffer-tabs)
-     (list (format "%s%s"
-                   tab-line-separator
-                   (apply 'propertize tab-line-tab-name-add
-                          `(
-                            help-echo "Click to add tab"
-                            face tab-line-tab-inactive
-                            mouse-face tab-line-highlight
-                            keymap ,tab-line-add-map)))))))
+     (list (concat tab-line-separator tab-line-button-new)))))
 
 
 (defun tab-line-add-tab (&optional e)
   (interactive "e")
-  (if window-system
+  (if window-system ; (display-popup-menus-p)
       (mouse-buffer-menu e) ; like (buffer-menu-open)
     ;; tty menu doesn't support mouse clicks, so use tmm
     (tmm-prompt (mouse-buffer-menu-keymap))))