unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Adam Porter <adam@alphapapa.net>
To: emacs-devel@gnu.org
Subject: Re: [PATCH] tab-line-alternate-colors
Date: Tue, 15 Dec 2020 21:55:49 -0600	[thread overview]
Message-ID: <874kkmxv3u.fsf@alphapapa.net> (raw)
In-Reply-To: 878s9yxwjc.fsf@alphapapa.net

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

Of course, I should have removed the obsolete defcustom from that
patch.  Here's the corrected one.

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

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

* lisp/tab-line.el:
(tab-line-tab-face-function): New option.
(tab-line-tab-face-functions): New option.
(tab-line-tab-inactive-alternate): New face.
(tab-line-tab-special): New face.
(tab-line-tab-face-inactive-alternating): New function.
(tab-line-tab-face-special): New function.
(tab-line-format-template): Use new function.
---
 lisp/tab-line.el | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 61 insertions(+), 6 deletions(-)

diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 46bf89f..6e77cf5 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,17 @@ tab-line
   :group 'convenience
   :version "27.1")
 
+(defcustom tab-line-tab-face-functions '(tab-line-tab-face-special)
+  "Functions called to modify tab faces.
+Each function is called with five arguments: the tab, a list of
+all tabs, the face returned by the previously called modifier,
+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 :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 +75,25 @@ 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-functions' includes function
+`tab-line-tab-face-inactive-alternating'."
+  :version "28.1"
+  :group 'tab-line-faces)
+
+(defface tab-line-tab-special
+  '((default (:weight bold))
+    (((supports :slant italic))
+     (: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-current
   '((default
       :inherit tab-line-tab)
@@ -412,7 +443,14 @@ 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 (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
@@ -425,11 +463,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 +487,27 @@ tab-line-format-template
                 tab-line-new-button)
        (list tab-line-new-button)))))
 
+(defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p)
+  "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-functions'."
+  (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 buffer-p _selected-p)
+  "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-functions'."
+  ;; 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 buffer-p (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


  reply	other threads:[~2020-12-16  3:55 UTC|newest]

Thread overview: 25+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-12-13  6:04 [PATCH] tab-line-alternate-colors Adam Porter
2020-12-13  6:17 ` Adam Porter
2020-12-13  8:45 ` Juri Linkov
2020-12-13 10:06   ` Adam Porter
2020-12-13 11:13     ` Adam Porter
2020-12-13 15:21     ` Eli Zaretskii
2020-12-14  2:17       ` Adam Porter
2020-12-14 15:34         ` Eli Zaretskii
2020-12-16  2:58           ` Adam Porter
2020-12-16 15:41             ` Eli Zaretskii
2020-12-13 21:25     ` Juri Linkov
2020-12-14  4:33       ` Adam Porter
2020-12-14  9:10         ` Juri Linkov
2020-12-14 10:05           ` Adam Porter
2020-12-14 19:37             ` Juri Linkov
2020-12-16  3:24               ` Adam Porter
2020-12-16  3:55                 ` Adam Porter [this message]
2020-12-16  9:03                 ` Juri Linkov
2020-12-16 10:26                   ` Adam Porter
2020-12-16 20:46                     ` Juri Linkov
2020-12-18  3:55                       ` Adam Porter
2020-12-23 21:07                         ` Juri Linkov
2020-12-24 11:26                           ` Adam Porter
2020-12-14  9:14         ` Adam Porter
2020-12-14 19:33           ` Juri Linkov

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=874kkmxv3u.fsf@alphapapa.net \
    --to=adam@alphapapa.net \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).