summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuri Linkov <juri@linkov.net>2021-03-17 19:42:27 +0200
committerJuri Linkov <juri@linkov.net>2021-03-17 19:42:27 +0200
commit0441e605a12a238abebdc9557151dcad87037d64 (patch)
tree77fbb063cd7524078550b53ad3d4f5990768326f
parent6e796b52e1e61c67e5d939bfcc77d34b9d735158 (diff)
downloademacs-0441e605a12a238abebdc9557151dcad87037d64.tar.gz
emacs-0441e605a12a238abebdc9557151dcad87037d64.tar.bz2
emacs-0441e605a12a238abebdc9557151dcad87037d64.zip
* lisp/tab-bar.el: New faces and face options.
* lisp/tab-bar.el (tab-bar-tab-group-current) (tab-bar-tab-group-inactive, tab-bar-tab-ungrouped): New deffaces. (tab-bar-tab-face-function): New defcustom. (tab-bar-tab-face-default): New function. (tab-bar-tab-name-format-default): Use it. (tab-bar-tab-group-format-default): Use tab-bar-tab-group-inactive face. (tab-bar-tab-group-face-function): New defcustom. (tab-bar-tab-group-face-default): New function. (tab-bar--format-tab-group): Add new arg 'current-p'. (tab-bar-format-tabs-groups): Prepend current group name before first tab. Override tab-bar-tab-face-function with tab-bar-tab-group-face-function.
-rw-r--r--lisp/tab-bar.el85
1 files changed, 69 insertions, 16 deletions
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 351c8cff349..45ed2a6b314 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -72,6 +72,24 @@
:version "27.1"
:group 'tab-bar-faces)
+(defface tab-bar-tab-group-current
+ '((t :inherit tab-bar-tab :box nil :weight bold))
+ "Tab bar face for current group tab."
+ :version "28.1"
+ :group 'tab-bar-faces)
+
+(defface tab-bar-tab-group-inactive
+ '((t :inherit (shadow tab-bar-tab-inactive)))
+ "Tab bar face for inactive group tab."
+ :version "28.1"
+ :group 'tab-bar-faces)
+
+(defface tab-bar-tab-ungrouped
+ '((t :inherit (shadow tab-bar-tab-inactive)))
+ "Tab bar face for ungrouped tab when tab groups are used."
+ :version "28.1"
+ :group 'tab-bar-faces)
+
(defcustom tab-bar-select-tab-modifiers '()
"List of modifier keys for selecting a tab by its index digit.
@@ -513,6 +531,16 @@ Return its existing value or a new value."
(set-frame-parameter frame 'tabs tabs))
+(defcustom tab-bar-tab-face-function #'tab-bar-tab-face-default
+ "Function to define a tab face.
+Function gets one argument: a tab."
+ :type 'function
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-face-default (tab)
+ (if (eq (car tab) 'current-tab) 'tab-bar-tab 'tab-bar-tab-inactive))
+
(defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default
"Function to format a tab name.
Function gets two arguments, the tab and its number, and should return
@@ -535,7 +563,7 @@ the formatted tab name to display in the tab bar."
(if current-p 'non-selected 'selected)))
tab-bar-close-button)
""))
- 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive))))
+ 'face (funcall tab-bar-tab-face-function tab))))
(defcustom tab-bar-format '(tab-bar-format-history
tab-bar-format-tabs
@@ -642,19 +670,36 @@ and should return the formatted tab group name to display in the tab bar."
(propertize
(concat (if tab-bar-tab-hints (format "%d " i) "")
(funcall tab-bar-tab-group-function tab))
- 'face 'tab-bar-tab-inactive))
+ 'face 'tab-bar-tab-group-inactive))
-(defun tab-bar--format-tab-group (tab i)
+(defcustom tab-bar-tab-group-face-function #'tab-bar-tab-group-face-default
+ "Function to define a tab group face.
+Function gets one argument: a tab."
+ :type 'function
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-group-face-default (tab)
+ (if (not (or (eq (car tab) 'current-tab)
+ (funcall tab-bar-tab-group-function tab)))
+ 'tab-bar-tab-ungrouped
+ (tab-bar-tab-face-default tab)))
+
+(defun tab-bar--format-tab-group (tab i &optional current-p)
(append
`((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))
`((,(intern (format "group-%i" i))
menu-item
- ,(funcall tab-bar-tab-group-format-function tab i)
- ,(or
- (alist-get 'binding tab)
- `(lambda ()
- (interactive)
- (tab-bar-select-tab ,i)))
+ ,(if current-p
+ (propertize (funcall tab-bar-tab-group-function tab)
+ 'face 'tab-bar-tab-group-current)
+ (funcall tab-bar-tab-group-format-function tab i))
+ ,(if current-p 'ignore
+ (or
+ (alist-get 'binding tab)
+ `(lambda ()
+ (interactive)
+ (tab-bar-select-tab ,i))))
:help "Click to visit group"))))
(defun tab-bar-format-tabs-groups ()
@@ -667,13 +712,21 @@ and should return the formatted tab group name to display in the tab bar."
(lambda (tab)
(let ((tab-group (funcall tab-bar-tab-group-function tab)))
(setq i (1+ i))
- (prog1 (if (or (not tab-group) (equal tab-group current-group))
- ;; Show current group and ungrouped tabs
- (tab-bar--format-tab tab i)
- ;; Otherwise, show first group tab with a group name,
- ;; but hide other group tabs
- (unless (equal previous-group tab-group)
- (tab-bar--format-tab-group tab i)))
+ (prog1 (cond
+ ;; Show current group tabs and ungrouped tabs
+ ((or (equal tab-group current-group) (not tab-group))
+ (append
+ ;; Prepend current group name before first tab
+ (when (and (not (equal previous-group tab-group)) tab-group)
+ (tab-bar--format-tab-group tab i t))
+ ;; Override default tab faces to use group faces
+ (let ((tab-bar-tab-face-function tab-bar-tab-group-face-function))
+ (tab-bar--format-tab tab i))))
+ ;; Show first tab of other groups with a group name
+ ((not (equal previous-group tab-group))
+ (tab-bar--format-tab-group tab i))
+ ;; Hide other group tabs
+ (t nil))
(setq previous-group tab-group))))
tabs)))