diff options
Diffstat (limited to 'lisp/+tab-bar.el')
-rw-r--r-- | lisp/+tab-bar.el | 394 |
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 @@ | |||
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 | ||