1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-03 11:33:37 +00:00

* lisp/tab-line.el (tab-line-tab-name-format-function): New defcustom.

(tab-line-tab-name-format-default): New function as the default value.
(tab-line-format-template): Funcall tab-line-tab-name-format-function.
This is like recently added tab-bar-tab-name-format-function.
This commit is contained in:
Juri Linkov 2021-02-23 21:01:31 +02:00
parent 0b9fda1fd9
commit 29c0b640ba
2 changed files with 47 additions and 30 deletions

View File

@ -501,6 +501,9 @@ It also supports a negative argument.
---
*** New user option 'tab-bar-tab-name-format-function'.
---
*** New user option 'tab-line-tab-name-format-function'.
---
*** The tabs in the tab line can now be scrolled using horizontal scroll.
If your mouse or trackpad supports it, you can now scroll tabs when

View File

@ -430,42 +430,56 @@ variable `tab-line-tabs-function'."
next-buffers)))
(defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default
"Function to format a tab name.
Function gets two arguments: the tab and a list of all tabs, and
should return the formatted tab name to display in the tab line."
:type 'function
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
(force-mode-line-update))
:group 'tab-line
:version "28.1")
(defun tab-line-tab-name-format-default (tab tabs)
(let* ((buffer-p (bufferp tab))
(selected-p (if buffer-p
(eq tab (window-buffer))
(cdr (assq 'selected tab))))
(name (if buffer-p
(funcall tab-line-tab-name-function tab tabs)
(cdr (assq 'name tab))))
(face (if selected-p
(if (eq (selected-window) (old-selected-window))
'tab-line-tab-current
'tab-line-tab)
'tab-line-tab-inactive)))
(dolist (fn tab-line-tab-face-functions)
(setf face (funcall fn tab tabs face buffer-p selected-p)))
(apply 'propertize
(concat (propertize name 'keymap tab-line-tab-map)
(or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
tab-line-close-button-show
(not (eq tab-line-close-button-show
(if selected-p 'non-selected 'selected)))
tab-line-close-button)
""))
`(
tab ,tab
,@(if selected-p '(selected t))
face ,face
mouse-face tab-line-highlight))))
(defun tab-line-format-template (tabs)
"Template for displaying tab line for selected window."
(let* ((selected-buffer (window-buffer))
(separator (or tab-line-separator (if window-system " " "|")))
(let* ((separator (or tab-line-separator (if window-system " " "|")))
(hscroll (window-parameter nil 'tab-line-hscroll))
(strings
(mapcar
(lambda (tab)
(let* ((buffer-p (bufferp tab))
(selected-p (if buffer-p
(eq tab selected-buffer)
(cdr (assq 'selected tab))))
(name (if buffer-p
(funcall tab-line-tab-name-function tab tabs)
(cdr (assq 'name tab))))
(face (if selected-p
(if (eq (selected-window) (old-selected-window))
'tab-line-tab-current
'tab-line-tab)
'tab-line-tab-inactive)))
(dolist (fn tab-line-tab-face-functions)
(setf face (funcall fn tab tabs face buffer-p selected-p)))
(concat
separator
(apply 'propertize
(concat (propertize name 'keymap tab-line-tab-map)
(or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
tab-line-close-button-show
(not (eq tab-line-close-button-show
(if selected-p 'non-selected 'selected)))
tab-line-close-button) ""))
`(
tab ,tab
,@(if selected-p '(selected t))
face ,face
mouse-face tab-line-highlight)))))
(concat separator
(funcall tab-line-tab-name-format-function tab tabs)))
tabs))
(hscroll-data (tab-line-auto-hscroll strings hscroll)))
(setq hscroll (nth 1 hscroll-data))