summary refs log tree commit diff stats
path: root/lisp/+tab-bar.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/+tab-bar.el')
-rw-r--r--lisp/+tab-bar.el314
1 files changed, 157 insertions, 157 deletions
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index 3e6968e..7ff991c 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el
@@ -12,8 +12,8 @@
12 12
13(defface +tab-bar-extra 13(defface +tab-bar-extra
14 '((t :inherit (tab-bar font-lock-comment-face))) 14 '((t :inherit (tab-bar font-lock-comment-face)))
15 "Tab bar face for extra information, like the menu-bar and time." 15 "Tab bar face for extra information, like the menu-bar and time."
16 :group 'basic-faces) 16 :group 'basic-faces)
17 17
18 18
19;; Common 19;; Common
@@ -35,97 +35,97 @@
35(defun +tab-bar-tracking-mode () 35(defun +tab-bar-tracking-mode ()
36 "Display `tracking-mode-line-buffers' in the tab-bar." 36 "Display `tracking-mode-line-buffers' in the tab-bar."
37 ;; TODO: write something to convert a mode-line construct to a tab-bar 37 ;; TODO: write something to convert a mode-line construct to a tab-bar
38 ;; construct. 38 ;; construct.
39 (when (and (bound-and-true-p tracking-mode) 39 (when (and (bound-and-true-p tracking-mode)
40 (not (and +tracking-hide-when-org-clocking 40 (not (and +tracking-hide-when-org-clocking
41 (bound-and-true-p org-clock-current-task)))) 41 (bound-and-true-p org-clock-current-task))))
42 (cons (when (> (length tracking-mode-line-buffers) 0) 42 (cons (when (> (length tracking-mode-line-buffers) 0)
43 '(track-mode-line-separator menu-item " " ignore)) 43 '(track-mode-line-separator menu-item " " ignore))
44 (cl-loop for i from 0 below (length tracking-mode-line-buffers) 44 (cl-loop for i from 0 below (length tracking-mode-line-buffers)
45 as item = (nth i tracking-mode-line-buffers) 45 as item = (nth i tracking-mode-line-buffers)
46 collect (append (list (intern (format "tracking-mode-line-%s" i)) 46 collect (append (list (intern (format "tracking-mode-line-%s" i))
47 'menu-item 47 'menu-item
48 (string-trim (format-mode-line item))) 48 (string-trim (format-mode-line item)))
49 (if-let ((keymap (plist-get item 'keymap))) 49 (if-let ((keymap (plist-get item 'keymap)))
50 (list (alist-get 'down-mouse-1 (cdadr keymap))) 50 (list (alist-get 'down-mouse-1 (cdadr keymap)))
51 (list #'ignore)) 51 (list #'ignore))
52 (when-let ((help (plist-get item 'help-echo))) 52 (when-let ((help (plist-get item 'help-echo)))
53 (list :help help))))))) 53 (list :help help)))))))
54 54
55(defun +tab-bar-timer () 55(defun +tab-bar-timer ()
56 "Display `+timer-string' in the tab-bar." 56 "Display `+timer-string' in the tab-bar."
57 (when +timer-string 57 (when (> (length (bound-and-true-p +timer-string)) 0)
58 `((timer-string menu-item 58 `((timer-string menu-item
59 ,(concat " " +timer-string) 59 ,(concat " " +timer-string)
60 (lambda (ev) 60 (lambda (ev)
61 (interactive "e") 61 (interactive "e")
62 (cond ((not +timer-timer) nil) 62 (cond ((not +timer-timer) nil)
63 ((equal +timer-string +timer-running-string) 63 ((equal +timer-string +timer-running-string)
64 (popup-menu 64 (popup-menu
65 '("Running timer" 65 '("Running timer"
66 ["Cancel timer" +timer-cancel t]) 66 ["Cancel timer" +timer-cancel t])
67 ev)) 67 ev))
68 (t (setq +timer-string "")))))))) 68 (t (setq +timer-string ""))))))))
69 69
70(defun +tab-bar-date () 70(defun +tab-bar-date ()
71 "Display `display-time-string' in the tab-bar." 71 "Display `display-time-string' in the tab-bar."
72 (when display-time-mode 72 (when display-time-mode
73 `((date-time-string menu-item 73 `((date-time-string menu-item
74 ,(substring-no-properties (concat " " (string-trim display-time-string))) 74 ,(substring-no-properties (concat " " (string-trim display-time-string)))
75 (lambda (ev) 75 (lambda (ev)
76 (interactive "e") 76 (interactive "e")
77 (popup-menu 77 (popup-menu
78 (append '("Timer") 78 (append '("Timer")
79 (let (r) 79 (let (r)
80 (dolist (time '(3 5 10)) 80 (dolist (time '(3 5 10))
81 (push (vector (format "Timer for %d minutes" time) 81 (push (vector (format "Timer for %d minutes" time)
82 `(lambda () (interactive) 82 `(lambda () (interactive)
83 (+timer ,time)) 83 (+timer ,time))
84 :active t) 84 :active t)
85 r)) 85 r))
86 (nreverse r)) 86 (nreverse r))
87 '(["Timer for ..." +timer t])) 87 '(["Timer for ..." +timer t]))
88 ev)) 88 ev))
89 :help (discord-date-string))))) 89 :help (discord-date-string)))))
90 90
91(defun +tab-bar-notmuch-count () 91(defun +tab-bar-notmuch-count ()
92 "Display a notmuch count in the tab-bar." 92 "Display a notmuch count in the tab-bar."
93 (when (and (executable-find "notmuch") 93 (when (and (executable-find "notmuch")
94 (featurep 'notmuch)) 94 (featurep 'notmuch))
95 (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) 95 (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches)))
96 (next (cl-find "inbox" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) 96 (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal))
97 (next-count (plist-get next :count))) 97 (next-count (plist-get next :count)))
98 (when (and next-count (> next-count 0)) 98 (when (and next-count (> next-count 0))
99 `((notmuch-count menu-item 99 `((notmuch-count menu-item
100 ,(format " |%s|" next-count) 100 ,(format " |%s|" next-count)
101 ignore 101 ignore
102 :help ,(format "%s mails requiring attention." next-count))))))) 102 :help ,(format "%s mails requiring attention." next-count)))))))
103 103
104(defun +tab-bar-org-clock () 104(defun +tab-bar-org-clock ()
105 "Display `org-mode-line-string' in the tab-bar." 105 "Display `org-mode-line-string' in the tab-bar."
106 (when (and (fboundp 'org-clocking-p) 106 (when (and (fboundp 'org-clocking-p)
107 (org-clocking-p)) 107 (org-clocking-p))
108 ;; org-mode-line-string 108 ;; org-mode-line-string
109 `((org-clocking menu-item 109 `((org-clocking menu-item
110 ,org-mode-line-string 110 ,org-mode-line-string
111 (lambda (ev) 111 (lambda (ev)
112 (interactive "e") 112 (interactive "e")
113 (let ((menu (make-sparse-keymap 113 (let ((menu (make-sparse-keymap
114 (or org-clock-current-task "Org-Clock")))) 114 (or org-clock-current-task "Org-Clock"))))
115 (map-keymap (lambda (key binding) 115 (map-keymap (lambda (key binding)
116 (when (consp binding) 116 (when (consp binding)
117 (define-key-after menu (vector key) 117 (define-key-after menu (vector key)
118 (copy-sequence binding)))) 118 (copy-sequence binding))))
119 (org-clock-menu)) 119 (org-clock-menu))
120 (message "%S" ev) 120 (message "%S" ev)
121 (popup-menu menu ev))) 121 (popup-menu menu ev)))
122 :help ,(or (replace-regexp-in-string 122 :help ,(or (replace-regexp-in-string
123 (rx "[[" (group (* (not "]"))) 123 (rx "[[" (group (* (not "]")))
124 "][" (group (* (not "]"))) 124 "][" (group (* (not "]")))
125 "]]") 125 "]]")
126 "\\2" 126 "\\2"
127 org-clock-current-task) 127 org-clock-current-task)
128 "Org-Clock"))))) 128 "Org-Clock")))))
129 129
130(defcustom +tab-bar-emms-max-length 24 130(defcustom +tab-bar-emms-max-length 24
131 "Maximum length of `+tab-bar-emms'." 131 "Maximum length of `+tab-bar-emms'."
@@ -139,8 +139,8 @@
139 (- +tab-bar-emms-max-length 2)))) 139 (- +tab-bar-emms-max-length 2))))
140 `(emms-now-playing menu-item 140 `(emms-now-playing menu-item
141 ,(concat "{" now-playing "}" " ") 141 ,(concat "{" now-playing "}" " ")
142 emms-pause 142 emms-pause
143 ( :help ,(emms-mode-line-playlist-current)))))) 143 ( :help ,(emms-mode-line-playlist-current))))))
144 144
145(defun +tab-bar-bongo () 145(defun +tab-bar-bongo ()
146 "Display Bongo now playing information." 146 "Display Bongo now playing information."
@@ -160,22 +160,22 @@
160 "\\1: \\3" 160 "\\1: \\3"
161 (bongo-formatted-infoset)) 161 (bongo-formatted-infoset))
162 ;; This isn't right 162 ;; This isn't right
163 (- (min 50 (/ (frame-width) 3 )) 2))) 163 (- (min 50 (/ (frame-width) 3 )) 2)))
164 "}") 164 "}")
165 (lambda () (interactive) 165 (lambda () (interactive)
166 (let ((bongo-playlist-buffer 166 (let ((bongo-playlist-buffer
167 ;; XXX: I'm sure this is terribly inefficient 167 ;; XXX: I'm sure this is terribly inefficient
168 (cl-some (lambda (b) 168 (cl-some (lambda (b)
169 (with-current-buffer b 169 (with-current-buffer b
170 (when-let* ((modep (derived-mode-p 170 (when-let* ((modep (derived-mode-p
171 'bongo-playlist-mode)) 171 'bongo-playlist-mode))
172 (bongo-playlist-buffer b) 172 (bongo-playlist-buffer b)
173 (playingp (bongo-playing-p))) 173 (playingp (bongo-playing-p)))
174 b))) 174 b)))
175 (buffer-list)))) 175 (buffer-list))))
176 (with-bongo-playlist-buffer 176 (with-bongo-playlist-buffer
177 (bongo-pause/resume)))) 177 (bongo-pause/resume))))
178 :help ,(funcall bongo-header-line-function))))) 178 :help ,(funcall bongo-header-line-function)))))
179 179
180(defvar +tab-bar-show-original nil 180(defvar +tab-bar-show-original nil
181 "Original value of `tab-bar-show'.") 181 "Original value of `tab-bar-show'.")
@@ -192,49 +192,49 @@
192 192
193;;; FIXME this doesn't work... 193;;; FIXME this doesn't work...
194;; (defvar +tab-bar-tab-min-width 8 194;; (defvar +tab-bar-tab-min-width 8
195;; "Minimum width of a tab on the tab bar.") 195 ;; "Minimum width of a tab on the tab bar.")
196 196
197;; (defvar +tab-bar-tab-max-width 24 197;; (defvar +tab-bar-tab-max-width 24
198;; "Maximum width of a tab on the tab bar.") 198 ;; "Maximum width of a tab on the tab bar.")
199 199
200;; (defun +tab-bar-fluid-calculate-width () 200;; (defun +tab-bar-fluid-calculate-width ()
201;; "Calculate the width of each tab in the tab-bar." 201 ;; "Calculate the width of each tab in the tab-bar."
202;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) 202 ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1)))
203;; (tab-bar-avail-width (frame-width)) 203 ;; (tab-bar-avail-width (frame-width))
204;; (tab-bar-tab-count (length (tab-bar-tabs))) 204 ;; (tab-bar-tab-count (length (tab-bar-tabs)))
205;; (tab-bar-close-button-char-width 1) 205 ;; (tab-bar-close-button-char-width 1)
206;; (tab-bar-add-tab-button-char-width 1) 206 ;; (tab-bar-add-tab-button-char-width 1)
207;; (tab-bar-total-width 207 ;; (tab-bar-total-width
208;; (length (mapconcat 208 ;; (length (mapconcat
209;; (lambda (el) 209 ;; (lambda (el)
210;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) 210 ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el)))))
211;; (substring-no-properties (eval str)))) 211 ;; (substring-no-properties (eval str))))
212;; tab-bar-list))) 212 ;; tab-bar-list)))
213;; (tab-bar-total-tab-width 213 ;; (tab-bar-total-tab-width
214;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) 214 ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width)
215;; tab-bar-add-tab-button-char-width 215 ;; tab-bar-add-tab-button-char-width
216;; (length (mapconcat 216 ;; (length (mapconcat
217;; (lambda (el) 217 ;; (lambda (el)
218;; (substring-no-properties (alist-get 'name el))) 218 ;; (substring-no-properties (alist-get 'name el)))
219;; (tab-bar-tabs))))) 219 ;; (tab-bar-tabs)))))
220;; (tab-bar-total-nontab-width (- tab-bar-total-width 220 ;; (tab-bar-total-nontab-width (- tab-bar-total-width
221;; tab-bar-total-tab-width))) 221 ;; tab-bar-total-tab-width)))
222;; (min +tab-bar-tab-max-width 222 ;; (min +tab-bar-tab-max-width
223;; (max +tab-bar-tab-min-width 223 ;; (max +tab-bar-tab-min-width
224;; (/ (- tab-bar-avail-width 224 ;; (/ (- tab-bar-avail-width
225;; tab-bar-total-tab-width 225 ;; tab-bar-total-tab-width
226;; tab-bar-total-nontab-width) 226 ;; tab-bar-total-nontab-width)
227;; tab-bar-tab-count))))) 227 ;; tab-bar-tab-count)))))
228 228
229;; (defun +tab-bar-fluid-width () 229;; (defun +tab-bar-fluid-width ()
230;; "Generate the tab name to fluidly fit in the given space." 230 ;; "Generate the tab name to fluidly fit in the given space."
231;; (let* ((tab-file-name (buffer-file-name (window-buffer 231 ;; (let* ((tab-file-name (buffer-file-name (window-buffer
232;; (minibuffer-selected-window))))) 232 ;; (minibuffer-selected-window)))))
233;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) 233 ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width))
234;; (if tab-file-name 234 ;; (if tab-file-name
235;; (file-name-nondirectory tab-file-name) 235 ;; (file-name-nondirectory tab-file-name)
236;; (+tab-bar-tab-name-truncated-left)) 236 ;; (+tab-bar-tab-name-truncated-left))
237;; " "))) 237 ;; " ")))
238 238
239(defun +tab-bar-tab-name-truncated-left () 239(defun +tab-bar-tab-name-truncated-left ()
240 "Generate the tab name from the buffer of the selected window. 240 "Generate the tab name from the buffer of the selected window.
@@ -259,13 +259,13 @@ name to the left."
259(defun +tab-bar-format-align-right () 259(defun +tab-bar-format-align-right ()
260 "Align the rest of tab bar items to the right, pixel-wise." 260 "Align the rest of tab bar items to the right, pixel-wise."
261 ;; XXX: ideally, wouldn't require `shr' here 261 ;; XXX: ideally, wouldn't require `shr' here
262 (require 'shr) ; `shr-string-pixel-width' 262 (require 'shr) ; `shr-string-pixel-width'
263 (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) 263 (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format)))
264 (rest (tab-bar-format-list rest)) 264 (rest (tab-bar-format-list rest))
265 (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) 265 (rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
266 (hpos (shr-string-pixel-width rest)) 266 (hpos (shr-string-pixel-width rest))
267 (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) 267 (str (propertize " " 'display `(space :align-to (- right (,hpos))))))
268 `((align-right menu-item ,str ignore)))) 268 `((align-right menu-item ,str ignore))))
269 269
270 270
271;;; Menu bar 271;;; Menu bar
@@ -309,18 +309,18 @@ Used by `tab-bar-format-menu-bar'."
309 `((current-tab 309 `((current-tab
310 menu-item 310 menu-item
311 ,(funcall tab-bar-tab-name-format-function tab i) 311 ,(funcall tab-bar-tab-name-format-function tab i)
312 ignore 312 ignore
313 :help "Current tab"))) 313 :help "Current tab")))
314 (t 314 (t
315 `((,(intern (format "tab-%i" i)) 315 `((,(intern (format "tab-%i" i))
316 menu-item 316 menu-item
317 ,(funcall tab-bar-tab-name-format-function tab i) 317 ,(funcall tab-bar-tab-name-format-function tab i)
318 ,(alist-get 'binding tab) 318 ,(alist-get 'binding tab)
319 :help "Click to visit tab")))) 319 :help "Click to visit tab"))))
320 (when (alist-get 'close-binding tab) 320 (when (alist-get 'close-binding tab)
321 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) 321 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
322 menu-item "" 322 menu-item ""
323 ,(alist-get 'close-binding tab))))))) 323 ,(alist-get 'close-binding tab)))))))
324 324
325 325
326;; Emacs 27 326;; Emacs 27
@@ -334,7 +334,7 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
334 ,reserve))))) 334 ,reserve)))))
335 (prog1 (append output 335 (prog1 (append output
336 `((align-right menu-item ,str nil)) 336 `((align-right menu-item ,str nil))
337 (+tab-bar-misc-info))))) 337 (+tab-bar-misc-info)))))
338 338
339 339
340;; Emacs 28 340;; Emacs 28
@@ -353,27 +353,27 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
353(define-minor-mode +tab-bar-misc-info-mode 353(define-minor-mode +tab-bar-misc-info-mode
354 "Show the `mode-line-misc-info' in the `tab-bar'." 354 "Show the `mode-line-misc-info' in the `tab-bar'."
355 :lighter "" 355 :lighter ""
356 :global t 356 :global t
357 (if +tab-bar-misc-info-mode 357 (if +tab-bar-misc-info-mode
358 (progn ; Enable 358 (progn ; Enable
359 (setq +tab-bar-show-original tab-bar-show) 359 (setq +tab-bar-show-original tab-bar-show)
360 (cond 360 (cond
361 ((boundp 'tab-bar-format) ; Emacs 28 361 ((boundp 'tab-bar-format) ; Emacs 28
362 (setq +tab-bar-format-original tab-bar-format) 362 (setq +tab-bar-format-original tab-bar-format)
363 (unless (memq '+tab-bar-misc-info tab-bar-format) 363 (unless (memq '+tab-bar-misc-info tab-bar-format)
364 (setq tab-bar-format 364 (setq tab-bar-format
365 (append tab-bar-format (+tab-bar-misc-info-28))))) 365 (append tab-bar-format (+tab-bar-misc-info-28)))))
366 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 366 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
367 (advice-add 'tab-bar-make-keymap-1 :filter-return 367 (advice-add 'tab-bar-make-keymap-1 :filter-return
368 '+tab-bar-misc-info-27))) 368 '+tab-bar-misc-info-27)))
369 (setq tab-bar-show t)) 369 (setq tab-bar-show t))
370 (progn ; Disable 370 (progn ; Disable
371 (setq tab-bar-show +tab-bar-show-original) 371 (setq tab-bar-show +tab-bar-show-original)
372 (cond 372 (cond
373 ((boundp 'tab-bar-format) ; Emacs 28 373 ((boundp 'tab-bar-format) ; Emacs 28
374 (setq tab-bar-format +tab-bar-format-original)) 374 (setq tab-bar-format +tab-bar-format-original))
375 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 375 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
376 (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) 376 (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27))))))
377 377
378 378
379 379
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.