1 files changed, 0 insertions, 394 deletions
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el
deleted file mode 100644
index 6c9debd..0000000
--- a/lisp/+tab-bar.el
+++ /dev/null

@@ -1,394 +0,0 @@
-;;; +tab-bar.el -*- lexical-binding: t; -*-
-;;; Commentary:
-;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use
-;; Emacs 27 on my Windows machine.  Thus, the code in this file.
-;;; Code:
-(require 'acdw)
-(require 'tab-bar)
-(defface +tab-bar-extra
-  '((t :inherit (tab-bar font-lock-comment-face)))
-   "Tab bar face for extra information, like the menu-bar and time."
-   :group 'basic-faces)
-;; Common
-(defun +tab-bar-space (&optional n)
-  "Display a space N characters long, or 1."
-  `((space menu-item ,(+string-repeat (or n 1) " ") ignore)))
-(defun +tab-bar-misc-info ()
-  "Display `mode-line-misc-info', formatted for the tab-bar."
-  `((misc-info menu-item ,(string-trim-right
-                           (format-mode-line mode-line-misc-info))
-               ignore)))
-(defcustom +tracking-hide-when-org-clocking nil
-  "Hide the `tracking-mode' information when clocked in."
-  :type 'boolean)
-(defun format-mode-line-unescaping (construct)
-  "Return a mode-line construct as a string, but unescape `%'s."
-  (format-mode-line
-   (cond ((listp construct)
-          (cl-loop for item in construct
-                   collect (cond ((stringp item)
-                                  (string-replace "%" "%%" item))
-                                 ((and (listp item) (eq :propertize (car item)))
-                                  (format-mode-line-unescaping item))
-                                 (t item))))
-         ((stringp construct) (string-replace "%" "%%" construct))
-         (t construct))))
-(defun +tab-bar-tracking-mode ()
-  "Display `tracking-mode-line-buffers' in the tab-bar."
-  ;; TODO: write something to convert a mode-line construct to a tab-bar
-     ;; construct.
-        (when (and (bound-and-true-p tracking-mode)
-                   (not (and +tracking-hide-when-org-clocking
-                             (bound-and-true-p org-clock-current-task))))
-          (cons (when (> (length tracking-mode-line-buffers) 0)
-                  '(track-mode-line-separator menu-item " " ignore))
-                (cl-loop for i from 0 below (length tracking-mode-line-buffers)
-                         as item = (nth i tracking-mode-line-buffers)
-                         collect (append (list (intern (format "tracking-mode-line-%s" i))
-                                               'menu-item
-                                                (string-trim (format-mode-line-unescaping item)))
-                                         (if-let ((keymap (plist-get item 'keymap)))
-                                             (list (alist-get 'down-mouse-1 (cdadr keymap)))
-                                           (list #'ignore))
-                                         (when-let ((help (plist-get item 'help-echo)))
-                                           (list :help help)))))))
-(defun +tab-bar-timer ()
-  "Display `+timer-string' in the tab-bar."
-  (when (> (length (bound-and-true-p +timer-string)) 0)
-    `((timer-string menu-item
-                    ,(concat " " +timer-string)
-                     (lambda (ev)
-                       (interactive "e")
-                       (cond ((not +timer-timer) nil)
-                             ((equal +timer-string +timer-running-string)
-                              (popup-menu
-                               '("Running timer"
-                                 ["Cancel timer" +timer-cancel t])
-                                ev))
-                             (t (setq +timer-string ""))))))))
-(defun +tab-bar-date ()
-  "Display `display-time-string' in the tab-bar."
-  (when display-time-mode
-    `((date-time-string menu-item
-                        ,(substring-no-properties (concat " " (string-trim display-time-string)))
-                         (lambda (ev)
-                           (interactive "e")
-                           (popup-menu
-                            (append '("Timer")
-                                     (let (r)
-                                       (dolist (time '(3 5 10))
-                                         (push (vector (format "Timer for %d minutes" time)
-                                                       `(lambda () (interactive)
-                                                          (+timer ,time))
-                                                        :active t)
-                                               r))
-                                       (nreverse r))
-                                     '(["Timer for ..." +timer t]))
-                            ev))
-                         :help (discord-date-string)))))
-(defun +tab-bar-notmuch-count ()
-  "Display a notmuch count in the tab-bar."
-  (when (and (executable-find "notmuch")
-             (featurep 'notmuch))
-    (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches)))
-           (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal))
-           (next-count (plist-get next :count)))
-      (when (and next-count (> next-count 0))
-        `((notmuch-count menu-item
-                         ,(format " |%s|" next-count)
-                          ignore
-                          :help ,(format "%s mails requiring attention." next-count)))))))
-(defun +tab-bar-org-clock ()
-  "Display `org-mode-line-string' in the tab-bar."
-  (when (and (fboundp 'org-clocking-p)
-             (org-clocking-p))
-    ;; org-mode-line-string
-       `((org-clocking menu-item
-                       ,org-mode-line-string
-                        (lambda (ev)
-                          (interactive "e")
-                          (let ((menu (make-sparse-keymap
-                                       (or org-clock-current-task "Org-Clock"))))
-                            (map-keymap (lambda (key binding)
-                                          (when (consp binding)
-                                            (define-key-after menu (vector key)
-                                              (copy-sequence binding))))
-                                        (org-clock-menu))
-                            (message "%S" ev)
-                            (popup-menu menu ev)))
-                        :help ,(or (replace-regexp-in-string
-                                    (rx "[[" (group (* (not "]")))
-                                        "][" (group (* (not "]")))
-                                        "]]")
-                                    "\\2"
-                                    org-clock-current-task)
-                                   "Org-Clock")))))
-(defcustom +tab-bar-emms-max-length 24
-  "Maximum length of `+tab-bar-emms'."
-  :type 'number)
-(defun +tab-bar-emms ()
-  "Display EMMS now playing information."
-  (when (and (bound-and-true-p emms-mode-line-mode)
-             emms-player-playing-p)
-    (let ((now-playing (+string-truncate (emms-mode-line-playlist-current)
-                                         (- +tab-bar-emms-max-length 2))))
-      `(emms-now-playing menu-item
-                         ,(concat "{" now-playing "}" " ")
-                          emms-pause
-                          ( :help ,(emms-mode-line-playlist-current))))))
-(defun +tab-bar-bongo ()
-  "Display Bongo now playing information."
-  (when-let ((modep (bound-and-true-p bongo-mode-line-indicator-mode))
-             (buf (cl-some (lambda (b)
-                             (with-current-buffer b
-                               (when-let* ((modep (derived-mode-p 'bongo-playlist-mode))
-                                           (bongo-playlist-buffer b)
-                                           (playingp (bongo-playing-p)))
-                                 b)))
-                           (buffer-list))))
-    `((bongo-now-playing menu-item
-                         ,(concat "{"
-                                  (let ((bongo-field-separator ""))
-                                    (+string-truncate (replace-regexp-in-string
-                                                       "\\(.*\\)\\(.*\\)\\(.*\\)"
-                                                       "\\1: \\3"
-                                                       (bongo-formatted-infoset))
-                                                      ;; This isn't right
-                                                         (- (min 50 (/ (frame-width) 3 )) 2)))
-                                  "}")
-                          (lambda () (interactive)
-                            (let ((bongo-playlist-buffer
-                                   ;; XXX: I'm sure this is terribly inefficient
-                                      (cl-some (lambda (b)
-                                                 (with-current-buffer b
-                                                   (when-let* ((modep (derived-mode-p
-                                                                       'bongo-playlist-mode))
-                                                               (bongo-playlist-buffer b)
-                                                               (playingp (bongo-playing-p)))
-                                                     b)))
-                                               (buffer-list))))
-                              (with-bongo-playlist-buffer
-                               (bongo-pause/resume))))
-                          :help ,(funcall bongo-header-line-function)))))
-(defvar +tab-bar-show-original nil
-  "Original value of `tab-bar-show'.")
-(defun +tab-bar-basename ()
-  "Generate the tab name from the basename of the buffer of the
-  selected window."
-  (let* ((tab-file-name (buffer-file-name (window-buffer
-                                           (minibuffer-selected-window)))))
-    (concat " "
-            (if tab-file-name
-                (file-name-nondirectory tab-file-name)
-              (+tab-bar-tab-name-truncated-left)))))
-;;; FIXME this doesn't work...
-;; (defvar +tab-bar-tab-min-width 8
-     ;;   "Minimum width of a tab on the tab bar.")
-;; (defvar +tab-bar-tab-max-width 24
-     ;;   "Maximum width of a tab on the tab bar.")
-;; (defun +tab-bar-fluid-calculate-width ()
-     ;;   "Calculate the width of each tab in the tab-bar."
-          ;;   (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1)))
-                      ;;          (tab-bar-avail-width (frame-width))
-                                  ;;          (tab-bar-tab-count (length (tab-bar-tabs)))
-                                              ;;          (tab-bar-close-button-char-width 1)
-                                                          ;;          (tab-bar-add-tab-button-char-width 1)
-                                                                      ;;          (tab-bar-total-width
-                                                                                   ;;           (length (mapconcat
-                                                                                                         ;;                    (lambda (el)
-                                                                                                                                 ;;                      (when-let ((str (car-safe (cdr-safe (cdr-safe el)))))
-                                                                                                                                                           ;;                        (substring-no-properties (eval str))))
-                                                                                                                               ;;                    tab-bar-list)))
-                                                                                  ;;          (tab-bar-total-tab-width
-                                                                                               ;;           (+ (* tab-bar-tab-count tab-bar-close-button-char-width)
-                                                                                                               ;;              tab-bar-add-tab-button-char-width
-                                                                                                                               ;;              (length (mapconcat
-                                                                                                                                                        ;;                       (lambda (el)
-                                                                                                                                                                                   ;;                         (substring-no-properties (alist-get 'name el)))
-                                                                                                                                                                                 ;;                       (tab-bar-tabs)))))
-                                                                                              ;;          (tab-bar-total-nontab-width (- tab-bar-total-width
-                                                                                                                                         ;;                                         tab-bar-total-tab-width)))
-                 ;;     (min +tab-bar-tab-max-width
-                             ;;          (max +tab-bar-tab-min-width
-                                              ;;               (/ (- tab-bar-avail-width
-                                                                     ;;                     tab-bar-total-tab-width
-                                                                                            ;;                     tab-bar-total-nontab-width)
-                                                                  ;;                  tab-bar-tab-count)))))
-;; (defun +tab-bar-fluid-width ()
-     ;;   "Generate the tab name to fluidly fit in the given space."
-          ;;   (let* ((tab-file-name (buffer-file-name (window-buffer
-                                                        ;;                                            (minibuffer-selected-window)))))
-                 ;;     (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width))
-                                ;;             (if tab-file-name
-                                                   ;;                 (file-name-nondirectory tab-file-name)
-                                                 ;;               (+tab-bar-tab-name-truncated-left))
-                                               ;;             " ")))
-(defun +tab-bar-tab-name-truncated-left ()
-  "Generate the tab name from the buffer of the selected window.
-This is just like `tab-bar-tab-name-truncated', but truncates the
-name to the left."
-  (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
-         (ellipsis (cond
-                    (tab-bar-tab-name-ellipsis)
-                    ((char-displayable-p ?…) "…")
-                    ("...")))
-         (l-ell (length ellipsis))
-         (l-name (length tab-name)))
-    (if (< (length tab-name) tab-bar-tab-name-truncated-max)
-        tab-name
-      (propertize (concat
-                   (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
-                     ellipsis)
-                   (truncate-string-to-width tab-name l-name
-                                             (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
-                  'help-echo tab-name))))
-(defun +tab-bar-format-align-right ()
-  "Align the rest of tab bar items to the right, pixel-wise."
-  ;; XXX: ideally, wouldn't require `shr' here
-     (require 'shr)                        ; `shr-string-pixel-width'
-     (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format)))
-            (rest (tab-bar-format-list rest))
-            (rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
-            (hpos (shr-string-pixel-width rest))
-            (str (propertize " " 'display `(space :align-to (- right (,hpos))))))
-       `((align-right menu-item ,str ignore))))
-;;; Menu bar
-;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el
-(defun +tab-bar-menu-bar (event)
-  "Pop up the same menu as displayed by the menu bar.
-Used by `tab-bar-format-menu-bar'."
-  (interactive "e")
-  (let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t))))
-    (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
-    (map-keymap (lambda (key binding)
-                  (when (consp binding)
-                    (define-key-after menu (vector key)
-                      (copy-sequence binding))))
-                (menu-bar-keymap))
-    (popup-menu menu event)))
-(defcustom +tab-bar-menu-bar-icon " Emacs "
-  "The string to use for the tab-bar menu icon."
-  :type 'string)
-(defun +tab-bar-format-menu-bar ()
-  "Produce the Menu button for the tab bar that shows the menu bar."
-  `((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra)
-              +tab-bar-menu-bar :help "Menu Bar")))
-;;; Tab bar format tabs
-(require 'el-patch)
-(el-patch-feature tab-bar)
-(with-eval-after-load 'tab-bar
-  (el-patch-defun tab-bar--format-tab (tab i)
-    "Format TAB using its index I and return the result as a keymap."
-    (append
-     (el-patch-remove
-       `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
-     (cond
-      ((eq (car tab) 'current-tab)
-       `((current-tab
-          menu-item
-          ,(funcall tab-bar-tab-name-format-function tab i)
-           ignore
-           :help "Current tab")))
-      (t
-       `((,(intern (format "tab-%i" i))
-           menu-item
-           ,(funcall tab-bar-tab-name-format-function tab i)
-            ,(alist-get 'binding tab)
-             :help "Click to visit tab"))))
-     (when (alist-get 'close-binding tab)
-       `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
-           menu-item ""
-           ,(alist-get 'close-binding tab)))))))
-;; Emacs 27
-(defun +tab-bar-misc-info-27 (output &rest _)
-  "Display `mode-line-misc-info' in the `tab-bar' on Emacs 27.
-This is :filter-return advice for `tab-bar-make-keymap-1'."
-  (let* ((reserve (length (format-mode-line mode-line-misc-info)))
-         (str (propertize " "
-                          'display `(space :align-to (- right (- 0 right-margin)
-                                                        ,reserve)))))
-    (prog1 (append output
-                   `((align-right menu-item ,str nil))
-                    (+tab-bar-misc-info)))))
-;; Emacs 28
-(defvar +tab-bar-format-original nil
-  "Original value of `tab-bar-format'.")
-(defun +tab-bar-misc-info-28 ()
-  "Display `mode-line-misc-info', right-aligned, on Emacs 28."
-  (append (unless (memq 'tab-bar-format-align-right tab-bar-format)
-            '(tab-bar-format-align-right))
-          '(+tab-bar-misc-info)))
-(define-minor-mode +tab-bar-misc-info-mode
-  "Show the `mode-line-misc-info' in the `tab-bar'."
-  :lighter ""
-   :global t
-    (if +tab-bar-misc-info-mode
-        (progn                            ; Enable
-                                            (setq +tab-bar-show-original tab-bar-show)
-                                            (cond
-                                             ((boundp 'tab-bar-format)       ; Emacs 28
-                                              (setq +tab-bar-format-original tab-bar-format)
-                                              (unless (memq '+tab-bar-misc-info tab-bar-format)
-                                                (setq tab-bar-format
-                                                      (append tab-bar-format (+tab-bar-misc-info-28)))))
-                                             ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
-                                              (advice-add 'tab-bar-make-keymap-1 :filter-return
-                                                           '+tab-bar-misc-info-27)))
-                                            (setq tab-bar-show t))
-      (progn                              ; Disable
-                                            (setq tab-bar-show +tab-bar-show-original)
-                                            (cond
-                                             ((boundp 'tab-bar-format)        ; Emacs 28
-                                              (setq tab-bar-format +tab-bar-format-original))
-                                             ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
-                                              (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27))))))
-(provide '+tab-bar)
-;;; +tab-bar.el ends here

diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el deleted file mode 100644 index 6c9debd..0000000 --- a/lisp/+tab-bar.el +++ /dev/null
@@ -1,394 +0,0 @@
1	;;; +tab-bar.el -- lexical-binding: t; --
2
3	;;; Commentary:
4
5	;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use
6	;; Emacs 27 on my Windows machine. Thus, the code in this file.
7
8	;;; Code:
9
10	(require 'acdw)
11	(require 'tab-bar)
12
13	(defface +tab-bar-extra
14	'((t :inherit (tab-bar font-lock-comment-face)))
15	"Tab bar face for extra information, like the menu-bar and time."
16	:group 'basic-faces)
17
18
19	;; Common
20
21	(defun +tab-bar-space (&optional n)
22	"Display a space N characters long, or 1."
23	`((space menu-item ,(+string-repeat (or n 1) " ") ignore)))
24
25	(defun +tab-bar-misc-info ()
26	"Display `mode-line-misc-info', formatted for the tab-bar."
27	`((misc-info menu-item ,(string-trim-right
28	(format-mode-line mode-line-misc-info))
29	ignore)))
30
31	(defcustom +tracking-hide-when-org-clocking nil
32	"Hide the `tracking-mode' information when clocked in."
33	:type 'boolean)
34
35	(defun format-mode-line-unescaping (construct)
36	"Return a mode-line construct as a string, but unescape `%'s."
37	(format-mode-line
38	(cond ((listp construct)
39	(cl-loop for item in construct
40	collect (cond ((stringp item)
41	(string-replace "%" "%%" item))
42	((and (listp item) (eq :propertize (car item)))
43	(format-mode-line-unescaping item))
44	(t item))))
45	((stringp construct) (string-replace "%" "%%" construct))
46	(t construct))))
47
48	(defun +tab-bar-tracking-mode ()
49	"Display `tracking-mode-line-buffers' in the tab-bar."
50	;; TODO: write something to convert a mode-line construct to a tab-bar
51	;; construct.
52	(when (and (bound-and-true-p tracking-mode)
53	(not (and +tracking-hide-when-org-clocking
54	(bound-and-true-p org-clock-current-task))))
55	(cons (when (> (length tracking-mode-line-buffers) 0)
56	'(track-mode-line-separator menu-item " " ignore))
57	(cl-loop for i from 0 below (length tracking-mode-line-buffers)
58	as item = (nth i tracking-mode-line-buffers)
59	collect (append (list (intern (format "tracking-mode-line-%s" i))
60	'menu-item
61	(string-trim (format-mode-line-unescaping item)))
62	(if-let ((keymap (plist-get item 'keymap)))
63	(list (alist-get 'down-mouse-1 (cdadr keymap)))
64	(list #'ignore))
65	(when-let ((help (plist-get item 'help-echo)))
66	(list :help help)))))))
67
68	(defun +tab-bar-timer ()
69	"Display `+timer-string' in the tab-bar."
70	(when (> (length (bound-and-true-p +timer-string)) 0)
71	`((timer-string menu-item
72	,(concat " " +timer-string)
73	(lambda (ev)
74	(interactive "e")
75	(cond ((not +timer-timer) nil)
76	((equal +timer-string +timer-running-string)
77	(popup-menu
78	'("Running timer"
79	["Cancel timer" +timer-cancel t])
80	ev))
81	(t (setq +timer-string ""))))))))
82
83	(defun +tab-bar-date ()
84	"Display `display-time-string' in the tab-bar."
85	(when display-time-mode
86	`((date-time-string menu-item
87	,(substring-no-properties (concat " " (string-trim display-time-string)))
88	(lambda (ev)
89	(interactive "e")
90	(popup-menu
91	(append '("Timer")
92	(let (r)
93	(dolist (time '(3 5 10))
94	(push (vector (format "Timer for %d minutes" time)
95	`(lambda () (interactive)
96	(+timer ,time))
97	:active t)
98	r))
99	(nreverse r))
100	'(["Timer for ..." +timer t]))
101	ev))
102	:help (discord-date-string)))))
103
104	(defun +tab-bar-notmuch-count ()
105	"Display a notmuch count in the tab-bar."
106	(when (and (executable-find "notmuch")
107	(featurep 'notmuch))
108	(let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches)))
109	(next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal))
110	(next-count (plist-get next :count)))
111	(when (and next-count (> next-count 0))
112	`((notmuch-count menu-item
113	,(format " \|%s\|" next-count)
114	ignore
115	:help ,(format "%s mails requiring attention." next-count)))))))
116
117	(defun +tab-bar-org-clock ()
118	"Display `org-mode-line-string' in the tab-bar."
119	(when (and (fboundp 'org-clocking-p)
120	(org-clocking-p))
121	;; org-mode-line-string
122	`((org-clocking menu-item
123	,org-mode-line-string
124	(lambda (ev)
125	(interactive "e")
126	(let ((menu (make-sparse-keymap
127	(or org-clock-current-task "Org-Clock"))))
128	(map-keymap (lambda (key binding)
129	(when (consp binding)
130	(define-key-after menu (vector key)
131	(copy-sequence binding))))
132	(org-clock-menu))
133	(message "%S" ev)
134	(popup-menu menu ev)))
135	:help ,(or (replace-regexp-in-string
136	(rx "[[" (group (* (not "]")))
137	"][" (group (* (not "]")))
138	"]]")
139	"\\2"
140	org-clock-current-task)
141	"Org-Clock")))))
142
143	(defcustom +tab-bar-emms-max-length 24
144	"Maximum length of `+tab-bar-emms'."
145	:type 'number)
146
147	(defun +tab-bar-emms ()
148	"Display EMMS now playing information."
149	(when (and (bound-and-true-p emms-mode-line-mode)
150	emms-player-playing-p)
151	(let ((now-playing (+string-truncate (emms-mode-line-playlist-current)
152	(- +tab-bar-emms-max-length 2))))
153	`(emms-now-playing menu-item
154	,(concat "{" now-playing "}" " ")
155	emms-pause
156	( :help ,(emms-mode-line-playlist-current))))))
157
158	(defun +tab-bar-bongo ()
159	"Display Bongo now playing information."
160	(when-let ((modep (bound-and-true-p bongo-mode-line-indicator-mode))
161	(buf (cl-some (lambda (b)
162	(with-current-buffer b
163	(when-let* ((modep (derived-mode-p 'bongo-playlist-mode))
164	(bongo-playlist-buffer b)
165	(playingp (bongo-playing-p)))
166	b)))
167	(buffer-list))))
168	`((bongo-now-playing menu-item
169	,(concat "{"
170	(let ((bongo-field-separator ""))
171	(+string-truncate (replace-regexp-in-string
172	"\\(.\\)\\(.\\)\\(.*\\)"
173	"\\1: \\3"
174	(bongo-formatted-infoset))
175	;; This isn't right
176	(- (min 50 (/ (frame-width) 3 )) 2)))
177	"}")
178	(lambda () (interactive)
179	(let ((bongo-playlist-buffer
180	;; XXX: I'm sure this is terribly inefficient
181	(cl-some (lambda (b)
182	(with-current-buffer b
183	(when-let* ((modep (derived-mode-p
184	'bongo-playlist-mode))
185	(bongo-playlist-buffer b)
186	(playingp (bongo-playing-p)))
187	b)))
188	(buffer-list))))
189	(with-bongo-playlist-buffer
190	(bongo-pause/resume))))
191	:help ,(funcall bongo-header-line-function)))))
192
193	(defvar +tab-bar-show-original nil
194	"Original value of `tab-bar-show'.")
195
196	(defun +tab-bar-basename ()
197	"Generate the tab name from the basename of the buffer of the
198	selected window."
199	(let* ((tab-file-name (buffer-file-name (window-buffer
200	(minibuffer-selected-window)))))
201	(concat " "
202	(if tab-file-name
203	(file-name-nondirectory tab-file-name)
204	(+tab-bar-tab-name-truncated-left)))))
205
206	;;; FIXME this doesn't work...
207	;; (defvar +tab-bar-tab-min-width 8
208	;; "Minimum width of a tab on the tab bar.")
209
210	;; (defvar +tab-bar-tab-max-width 24
211	;; "Maximum width of a tab on the tab bar.")
212
213	;; (defun +tab-bar-fluid-calculate-width ()
214	;; "Calculate the width of each tab in the tab-bar."
215	;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1)))
216	;; (tab-bar-avail-width (frame-width))
217	;; (tab-bar-tab-count (length (tab-bar-tabs)))
218	;; (tab-bar-close-button-char-width 1)
219	;; (tab-bar-add-tab-button-char-width 1)
220	;; (tab-bar-total-width
221	;; (length (mapconcat
222	;; (lambda (el)
223	;; (when-let ((str (car-safe (cdr-safe (cdr-safe el)))))
224	;; (substring-no-properties (eval str))))
225	;; tab-bar-list)))
226	;; (tab-bar-total-tab-width
227	;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width)
228	;; tab-bar-add-tab-button-char-width
229	;; (length (mapconcat
230	;; (lambda (el)
231	;; (substring-no-properties (alist-get 'name el)))
232	;; (tab-bar-tabs)))))
233	;; (tab-bar-total-nontab-width (- tab-bar-total-width
234	;; tab-bar-total-tab-width)))
235	;; (min +tab-bar-tab-max-width
236	;; (max +tab-bar-tab-min-width
237	;; (/ (- tab-bar-avail-width
238	;; tab-bar-total-tab-width
239	;; tab-bar-total-nontab-width)
240	;; tab-bar-tab-count)))))
241
242	;; (defun +tab-bar-fluid-width ()
243	;; "Generate the tab name to fluidly fit in the given space."
244	;; (let* ((tab-file-name (buffer-file-name (window-buffer
245	;; (minibuffer-selected-window)))))
246	;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width))
247	;; (if tab-file-name
248	;; (file-name-nondirectory tab-file-name)
249	;; (+tab-bar-tab-name-truncated-left))
250	;; " ")))
251
252	(defun +tab-bar-tab-name-truncated-left ()
253	"Generate the tab name from the buffer of the selected window.
254	This is just like `tab-bar-tab-name-truncated', but truncates the
255	name to the left."
256	(let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
257	(ellipsis (cond
258	(tab-bar-tab-name-ellipsis)
259	((char-displayable-p ?…) "…")
260	("...")))
261	(l-ell (length ellipsis))
262	(l-name (length tab-name)))
263	(if (< (length tab-name) tab-bar-tab-name-truncated-max)
264	tab-name
265	(propertize (concat
266	(when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
267	ellipsis)
268	(truncate-string-to-width tab-name l-name
269	(max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
270	'help-echo tab-name))))
271
272	(defun +tab-bar-format-align-right ()
273	"Align the rest of tab bar items to the right, pixel-wise."
274	;; XXX: ideally, wouldn't require `shr' here
275	(require 'shr) ; `shr-string-pixel-width'
276	(let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format)))
277	(rest (tab-bar-format-list rest))
278	(rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
279	(hpos (shr-string-pixel-width rest))
280	(str (propertize " " 'display `(space :align-to (- right (,hpos))))))
281	`((align-right menu-item ,str ignore))))
282
283
284	;;; Menu bar
285	;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el
286
287	(defun +tab-bar-menu-bar (event)
288	"Pop up the same menu as displayed by the menu bar.
289	Used by `tab-bar-format-menu-bar'."
290	(interactive "e")
291	(let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t))))
292	(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
293	(map-keymap (lambda (key binding)
294	(when (consp binding)
295	(define-key-after menu (vector key)
296	(copy-sequence binding))))
297	(menu-bar-keymap))
298	(popup-menu menu event)))
299
300	(defcustom +tab-bar-menu-bar-icon " Emacs "
301	"The string to use for the tab-bar menu icon."
302	:type 'string)
303
304	(defun +tab-bar-format-menu-bar ()
305	"Produce the Menu button for the tab bar that shows the menu bar."
306	`((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra)
307	+tab-bar-menu-bar :help "Menu Bar")))
308
309
310	;;; Tab bar format tabs
311
312	(require 'el-patch)
313	(el-patch-feature tab-bar)
314	(with-eval-after-load 'tab-bar
315	(el-patch-defun tab-bar--format-tab (tab i)
316	"Format TAB using its index I and return the result as a keymap."
317	(append
318	(el-patch-remove
319	`((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
320	(cond
321	((eq (car tab) 'current-tab)
322	`((current-tab
323	menu-item
324	,(funcall tab-bar-tab-name-format-function tab i)
325	ignore
326	:help "Current tab")))
327	(t
328	`((,(intern (format "tab-%i" i))
329	menu-item
330	,(funcall tab-bar-tab-name-format-function tab i)
331	,(alist-get 'binding tab)
332	:help "Click to visit tab"))))
333	(when (alist-get 'close-binding tab)
334	`((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
335	menu-item ""
336	,(alist-get 'close-binding tab)))))))
337
338
339	;; Emacs 27
340
341	(defun +tab-bar-misc-info-27 (output &rest _)
342	"Display `mode-line-misc-info' in the `tab-bar' on Emacs 27.
343	This is :filter-return advice for `tab-bar-make-keymap-1'."
344	(let* ((reserve (length (format-mode-line mode-line-misc-info)))
345	(str (propertize " "
346	'display `(space :align-to (- right (- 0 right-margin)
347	,reserve)))))
348	(prog1 (append output
349	`((align-right menu-item ,str nil))
350	(+tab-bar-misc-info)))))
351
352
353	;; Emacs 28
354
355	(defvar +tab-bar-format-original nil
356	"Original value of `tab-bar-format'.")
357
358	(defun +tab-bar-misc-info-28 ()
359	"Display `mode-line-misc-info', right-aligned, on Emacs 28."
360	(append (unless (memq 'tab-bar-format-align-right tab-bar-format)
361	'(tab-bar-format-align-right))
362	'(+tab-bar-misc-info)))
363
364
365
366	(define-minor-mode +tab-bar-misc-info-mode
367	"Show the `mode-line-misc-info' in the `tab-bar'."
368	:lighter ""
369	:global t
370	(if +tab-bar-misc-info-mode
371	(progn ; Enable
372	(setq +tab-bar-show-original tab-bar-show)
373	(cond
374	((boundp 'tab-bar-format) ; Emacs 28
375	(setq +tab-bar-format-original tab-bar-format)
376	(unless (memq '+tab-bar-misc-info tab-bar-format)
377	(setq tab-bar-format
378	(append tab-bar-format (+tab-bar-misc-info-28)))))
379	((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
380	(advice-add 'tab-bar-make-keymap-1 :filter-return
381	'+tab-bar-misc-info-27)))
382	(setq tab-bar-show t))
383	(progn ; Disable
384	(setq tab-bar-show +tab-bar-show-original)
385	(cond
386	((boundp 'tab-bar-format) ; Emacs 28
387	(setq tab-bar-format +tab-bar-format-original))
388	((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
389	(advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27))))))
390
391
392
393	(provide '+tab-bar)
394	;;; +tab-bar.el ends here