Re: [PATCH] tab-line-alternate-colors

[Adam Porter <adam@alphapapa.net>]

[-- Attachment #1: Type: text/plain, Size: 2092 bytes --]

Juri Linkov <juri@linkov.net> writes:

>>> Thanks, it would be nice to support displaying tabs in alternating
>>> colors.  But there are endless possibilities for look and feel of
>>> tabs, so instead of hard-coding only one of them for alternating
>>> colors, I suggest to add a customizable function with a name like
>>> 'tab-line-tab-face' that with a tab provided as its arg (and a list of
>>> tabs to be able to find the ordinal number of the given tab) would
>>> return its face to use.
>>
>> Yes, that seems like a good idea.  Something like this?  I also added
>> another face for non-file-backed buffers, which helps distinguish them.
>
> What if some users might want to display tabs with rainbow colors?
> Then this too specific option tab-line-alternate-colors won't help.
>
> What I suggest is that defcustom tab-line-tab-face-function could
> provide a separate function choice, e.g. tab-line-tab-face-alternate,
> so when customized to tab-line-tab-face-alternate, this function
> could call the default function tab-line-tab-face-default,
> and if the default function returns 'tab-line-tab-inactive',
> then replace it with 'tab-line-tab-inactive-alternate'
> depending on whether the tab is odd/even.

Okay, here's my next proposal: The tab-line-tab-face-default function
returns a face, and then a new option, tab-line-tab-face-modifiers, is a
list of functions, each of which is called with that face and returns
it, possibly modified.  This seems like a flexible mechanism which makes
it possible to modify the faces orthogonally according to arbitrary
criteria, and it can be used to add the alternating colors and
special-buffer faces when applicable (when so-configured by the user).
It could also be used to do a "rainbow" of faces, as you mentioned, etc.

To address Eli's feedback, in this patch I also defined the alternate
face to have a certain background color by default rather than
inheriting from mode-line.

However, the issue regarding italic slant on terminals remains; I'll be
glad to do whatever you or Eli suggest.

Thanks to you and Eli for your help.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 6013 bytes --]

From 74bea2f33da16d8d79c8e010435096ca00b4c646 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sun, 13 Dec 2020 05:54:28 +0000
Subject: [PATCH] New tab-line options, faces, and functions

* lisp/tab-line.el:
(tab-line-tab-face-function): New option.
(tab-line-tab-face-modifiers): New option.
(tab-line-tab-inactive-alternate): New face.
(tab-line-tab-special): New face.
(tab-line-tab-face-default): New function.
(tab-line-tab-face-inactive-alternating): New function.
(tab-line-tab-face-special): New function.
(tab-line-format-template): Use new face-default function.

With thanks to Juri Linkov and Eli Zaretskii for their guidance.
---
 lisp/tab-line.el | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 84 insertions(+), 6 deletions(-)

diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 46bf89f..278ff30 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -27,6 +27,7 @@
 
 ;;; Code:
 
+(require 'cl-lib)
 (require 'seq) ; tab-line.el is not pre-loaded so it's safe to use it here
 
 \f
@@ -35,6 +36,26 @@ tab-line
   :group 'convenience
   :version "27.1")
 
+(defcustom tab-line-tab-face-function #'tab-line-tab-face-default
+  "Function called to get a tab's face.
+The function is called with two arguments: the tab and a list of
+all tabs."
+  :type '(choice (function-item :tag "Default" tab-line-tab-face-default)
+                 (function :tag "Custom function"))
+  :group 'tab-line
+  :version "28.1")
+
+(defcustom tab-line-tab-face-modifiers '(tab-line-tab-face-special)
+  "Functions called to modify tab faces.
+Each function is called with three arguments: the tab, a list of
+all tabs, and the face returned by the previously called
+modifier."
+  :type '(set (function-item tab-line-tab-face-special)
+              (function-item tab-line-tab-face-inactive-alternating)
+              (function :tag "Custom function"))
+  :group 'tab-line
+  :version "28.1")
+
 (defgroup tab-line-faces '((tab-line custom-face)) ; tab-line is defined in faces.el
   "Faces used in the tab line."
   :group 'tab-line
@@ -63,6 +84,22 @@ tab-line-tab-inactive
   :version "27.1"
   :group 'tab-line-faces)
 
+(defface tab-line-tab-inactive-alternate
+  `((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-modifiers' includes function
+`tab-line-tab-face-inactive-alternating'."
+  :version "28.1"
+  :group 'tab-line-faces)
+
+(defface tab-line-tab-special '((t (:slant italic)))
+  "Face for special (i.e. non-file-backed) tabs.
+Applied when option `tab-line-tab-face-modifiers' includes
+function `tab-line-tab-face-special'."
+  :version "28.1"
+  :group 'tab-line-faces)
+
 (defface tab-line-tab-current
   '((default
       :inherit tab-line-tab)
@@ -412,7 +449,11 @@ tab-line-format-template
                                   (cdr (assq 'selected tab))))
                     (name (if buffer-p
                               (funcall tab-line-tab-name-function tab tabs)
-                            (cdr (assq 'name tab)))))
+                            (cdr (assq 'name tab))))
+                    (face (funcall tab-line-tab-face-function
+                                   tab tabs)))
+               (dolist (fn tab-line-tab-face-modifiers)
+                 (setf face (funcall fn tab tabs face)))
                (concat
                 separator
                 (apply 'propertize
@@ -425,11 +466,7 @@ tab-line-format-template
                        `(
                          tab ,tab
                          ,@(if selected-p '(selected t))
-                         face ,(if selected-p
-                                   (if (eq (selected-window) (old-selected-window))
-                                       'tab-line-tab-current
-                                     'tab-line-tab)
-                                 'tab-line-tab-inactive)
+                         face ,face
                          mouse-face tab-line-highlight)))))
            tabs))
          (hscroll-data (tab-line-auto-hscroll strings hscroll)))
@@ -453,6 +490,47 @@ tab-line-format-template
                 tab-line-new-button)
        (list tab-line-new-button)))))
 
+(defun tab-line-tab-face-default (tab _tabs)
+  "Return face for TAB.
+If TAB is selected, return `tab-line-tab-current' if the tab's
+window is also selected, otherwise `tab-line-tab'.  Otherwise,
+return `tab-line-tab-inactive'.  For use as
+`tab-line-tab-face-function'."
+  (let* ((buffer-p (bufferp tab))
+	 (selected-p (if buffer-p
+			 (eq tab (window-buffer))
+		       (cdr (assq 'selected tab)))))
+    (if selected-p
+	(if (eq (selected-window) (old-selected-window))
+	    'tab-line-tab-current
+	  'tab-line-tab)
+      'tab-line-tab-inactive)))
+
+(defun tab-line-tab-face-inactive-alternating (tab tabs face)
+  "Return FACE for TAB in TABS with alternation.
+When TAB is an inactive buffer and is even-numbered, make FACE
+inherit from `tab-line-tab-inactive-alternate'.  For use in
+`tab-line-tab-face-modifiers'."
+  (let* ((buffer-p (bufferp tab))
+	 (selected-p (if buffer-p
+			 (eq tab (window-buffer))
+		       (cdr (assq 'selected tab)))))
+    (when (and (not selected-p) (cl-evenp (cl-position tab tabs)))
+      (setf face `(:inherit (tab-line-tab-inactive-alternate ,face)))))
+  face)
+
+(defun tab-line-tab-face-special (tab _tabs face)
+  "Return FACE for TAB according to whether it's special.
+When TAB is a non-file-backed buffer, make FACE inherit from
+`tab-line-tab-special'.  For use in
+`tab-line-tab-face-modifiers'."
+  ;; FIXME: When the face `tab-line' inherits from the face
+  ;; `variable-pitch', the face `tab-line-tab-special' doesn't seem to
+  ;; apply properly (e.g. its :slant has no effect).
+  (when (and (bufferp tab) (not (buffer-file-name tab)))
+    (setf face `(:inherit (tab-line-tab-special ,face))))
+  face)
+
 (defvar tab-line-auto-hscroll)
 
 (defun tab-line-format ()
-- 
2.7.4