diff options
Diffstat (limited to 'lisp/tab-line.el')
| -rw-r--r-- | lisp/tab-line.el | 135 |
1 files changed, 86 insertions, 49 deletions
diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 1bdddc2c83e..d5fad353638 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -44,6 +44,7 @@ whether the tab is a buffer, and whether the tab is selected." :type '(repeat (choice (function-item tab-line-tab-face-special) (function-item tab-line-tab-face-inactive-alternating) + (function-item tab-line-tab-face-group) (function :tag "Custom function"))) :group 'tab-line :version "28.1") @@ -55,29 +56,25 @@ whether the tab is a buffer, and whether the tab is selected." :version "27.1") (defface tab-line-tab - '((default - :inherit tab-line) + '((default :inherit tab-line) (((class color) (min-colors 88)) :box (:line-width 1 :style released-button)) - (t - :inverse-video nil)) + (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-tab) + '((default :inherit tab-line-tab) (((class color) (min-colors 88)) :background "grey75") - (t - :inverse-video t)) + (t :inverse-video t)) "Tab line face for non-selected tab." :version "27.1" :group 'tab-line-faces) (defface tab-line-tab-inactive-alternate - `((t (:inherit tab-line-tab-inactive :background "grey65"))) + '((t :inherit tab-line-tab-inactive :background "grey65")) "Alternate face for inactive tab-line tabs. Applied to alternating tabs when option `tab-line-tab-face-functions' includes function @@ -86,18 +83,25 @@ Applied to alternating tabs when option :group 'tab-line-faces) (defface tab-line-tab-special - '((default (:weight bold)) + '((default :weight bold) (((supports :slant italic)) - (:slant italic :weight normal))) + :slant italic :weight normal)) "Face for special (i.e. non-file-backed) tabs. Applied when option `tab-line-tab-face-functions' includes function `tab-line-tab-face-special'." :version "28.1" :group 'tab-line-faces) +(defface tab-line-tab-group + '((t :inherit tab-line :box nil)) + "Face for group tabs. +Applied when option `tab-line-tab-face-functions' includes +function `tab-line-tab-face-group'." + :version "28.1" + :group 'tab-line-faces) + (defface tab-line-tab-current - '((default - :inherit tab-line-tab) + '((default :inherit tab-line-tab) (((class color) (min-colors 88)) :background "grey85")) "Tab line face for tab with current buffer in selected window." @@ -105,7 +109,7 @@ function `tab-line-tab-face-special'." :group 'tab-line-faces) (defface tab-line-highlight - '((default :inherit tab-line-tab)) + '((t :inherit tab-line-tab)) "Tab line face for highlighting." :version "27.1" :group 'tab-line-faces) @@ -178,7 +182,7 @@ If the value is a function, call it with no arguments." (defvar tab-line-new-button (propertize " + " - 'display `(image :type xpm + 'display '(image :type xpm :file "tabs/new.xpm" :margin (2 . 0) :ascent center) @@ -206,7 +210,7 @@ If nil, don't show it at all." (defvar tab-line-close-button (propertize " x" - 'display `(image :type xpm + 'display '(image :type xpm :file "tabs/close.xpm" :margin (2 . 0) :ascent center) @@ -217,7 +221,7 @@ If nil, don't show it at all." (defvar tab-line-left-button (propertize " <" - 'display `(image :type xpm + 'display '(image :type xpm :file "tabs/left-arrow.xpm" :margin (2 . 0) :ascent center) @@ -228,7 +232,7 @@ If nil, don't show it at all." (defvar tab-line-right-button (propertize "> " - 'display `(image :type xpm + 'display '(image :type xpm :file "tabs/right-arrow.xpm" :margin (2 . 0) :ascent center) @@ -294,7 +298,10 @@ be displayed, or just a list of strings to display in the tab line. By default, use function `tab-line-tabs-window-buffers' that returns a list of buffers associated with the selected window. When `tab-line-tabs-mode-buffers', return a list of buffers -with the same major mode as the current buffer." +with the same major mode as the current buffer. +When `tab-line-tabs-buffer-groups', return a list of buffers +grouped either by `tab-line-tabs-buffer-group-function', when set, +or by `tab-line-tabs-buffer-groups'." :type '(choice (const :tag "Window buffers" tab-line-tabs-window-buffers) (const :tag "Same mode buffers" @@ -356,6 +363,11 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.") mode)))) (defun tab-line-tabs-buffer-groups () + "Return a list of tabs that should be displayed in the tab line. +By default return a list of buffers grouped by major mode, +according to `tab-line-tabs-buffer-groups'. +If non-nil, `tab-line-tabs-buffer-group-function' is used to +generate the group name." (if (window-parameter nil 'tab-line-groups) (let* ((buffers (funcall tab-line-tabs-buffer-list-function)) (groups @@ -385,6 +397,7 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.") (set-window-parameter nil 'tab-line-group nil)))) (group-tab `(tab (name . ,group) + (group-tab . t) (select . ,(lambda () (set-window-parameter nil 'tab-line-groups t) (set-window-parameter nil 'tab-line-group group) @@ -430,42 +443,59 @@ 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 + ;; Don't turn mouse-1 into mouse-2 (bug#49247) + 'follow-link 'ignore) + (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)) @@ -506,6 +536,13 @@ When TAB is a non-file-backed buffer, make FACE inherit from (setf face `(:inherit (tab-line-tab-special ,face)))) face) +(defun tab-line-tab-face-group (tab _tabs face _buffer-p _selected-p) + "Return FACE for TAB according to whether it's a group tab. +For use in `tab-line-tab-face-functions'." + (when (alist-get 'group-tab tab) + (setf face `(:inherit (tab-line-tab-group ,face)))) + face) + (defvar tab-line-auto-hscroll) (defun tab-line-format () |