about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2022-02-16 23:06:05 -0600
committerCase Duckworth2022-02-16 23:06:05 -0600
commit83de113f4e9d2cde0a0ff6c2d56dbc2cba21b938 (patch)
treec6500b713b025257fd5d06685feddbd3e36ba7e7
parentAdd chat-disconnect (diff)
downloademacs-83de113f4e9d2cde0a0ff6c2d56dbc2cba21b938.tar.gz
emacs-83de113f4e9d2cde0a0ff6c2d56dbc2cba21b938.zip
Add bunches of tab-bar stuff
-rw-r--r--lisp/+tab-bar.el144
1 files changed, 91 insertions, 53 deletions
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index 169cb53..b88b7eb 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el
@@ -20,7 +20,7 @@
20(defun +tab-bar-misc-info () 20(defun +tab-bar-misc-info ()
21 "Display `mode-line-misc-info', formatted for the tab-bar." 21 "Display `mode-line-misc-info', formatted for the tab-bar."
22 `((misc-info menu-item ,(string-trim-right 22 `((misc-info menu-item ,(string-trim-right
23 (format-mode-line mode-line-misc-info)) 23 (format-mode-line mode-line-misc-info))
24 ignore))) 24 ignore)))
25 25
26(defun +tab-bar-tracking-mode () 26(defun +tab-bar-tracking-mode ()
@@ -28,26 +28,64 @@
28 ;; TODO: write something to convert a mode-line construct to a tab-bar 28 ;; TODO: write something to convert a mode-line construct to a tab-bar
29 ;; construct. 29 ;; construct.
30 (when tracking-mode 30 (when tracking-mode
31 (cl-loop for i from 0 below (length tracking-mode-line-buffers) 31 (cons (when (> (length tracking-mode-line-buffers) 0)
32 as item = (nth i tracking-mode-line-buffers) 32 '(track-mode-line-separator menu-item " " ignore))
33 collect (append (list (intern (format "tracking-mode-line-%s" i)) 33 (cl-loop for i from 0 below (length tracking-mode-line-buffers)
34 'menu-item 34 as item = (nth i tracking-mode-line-buffers)
35 (format-mode-line item)) 35 collect (append (list (intern (format "tracking-mode-line-%s" i))
36 (if-let ((keymap (plist-get item 'keymap))) 36 'menu-item
37 (list (alist-get 'down-mouse-1 (cdadr keymap))) 37 (string-trim (format-mode-line item)))
38 (list #'ignore)) 38 (if-let ((keymap (plist-get item 'keymap)))
39 (when-let ((help (plist-get item 'help-echo))) 39 (list (alist-get 'down-mouse-1 (cdadr keymap)))
40 (list :help help)))))) 40 (list #'ignore))
41 (when-let ((help (plist-get item 'help-echo)))
42 (list :help help)))))))
41 43
42(defun +tab-bar-date () 44(defun +tab-bar-date ()
43 "Display `display-time-string' in the tab-bar." 45 "Display `display-time-string' in the tab-bar."
44 (when display-time-mode 46 (when display-time-mode
45 `((date-time-string menu-item 47 `((date-time-string menu-item
46 ,(propertize display-time-string 48 ,(propertize (concat " " display-time-string))
47 'face 'font-lock-comment-face)
48 ignore 49 ignore
49 :help (discord-date-string))))) 50 :help (discord-date-string)))))
50 51
52(defun +tab-bar-notmuch-count ()
53 "Display a notmuch count in the tab-bar."
54 (when (featurep 'notmuch)
55 (let* ((counts (notmuch-hello-query-counts notmuch-saved-searches))
56 (next (cl-find "next" counts :key (lambda (l) (plist-get l :name)) :test 'equal))
57 (next-count (plist-get next :count)))
58 (when (and next-count (> next-count 0))
59 `((notmuch-count menu-item
60 ,(format " |%s|" next-count)
61 ignore
62 :help ,(format "%s mails requiring attention." next-count)))))))
63
64(defun +tab-bar-org-clock ()
65 "Display `org-mode-line-string' in the tab-bar."
66 (when (org-clocking-p)
67 ;; org-mode-line-string
68 `((org-clocking menu-item
69 ,org-mode-line-string
70 (lambda (ev)
71 (interactive "e")
72 (let ((menu (make-sparse-keymap
73 (or org-clock-current-task "Org-Clock"))))
74 (map-keymap (lambda (key binding)
75 (when (consp binding)
76 (define-key-after menu (vector key)
77 (copy-sequence binding))))
78 (org-clock-menu))
79 (message "%S" ev)
80 (popup-menu menu ev)))
81 :help ,(or (replace-regexp-in-string
82 (rx "[[" (group (* (not "]")))
83 "][" (group (* (not "]")))
84 "]]")
85 "\\2"
86 org-clock-current-task)
87 "Org-Clock")))))
88
51(defcustom +tab-bar-emms-max-length 24 89(defcustom +tab-bar-emms-max-length 24
52 "Maximum length of `+tab-bar-emms'." 90 "Maximum length of `+tab-bar-emms'."
53 :type 'number) 91 :type 'number)
@@ -85,16 +123,16 @@
85 (lambda () (interactive) 123 (lambda () (interactive)
86 (let ((bongo-playlist-buffer 124 (let ((bongo-playlist-buffer
87 ;; XXX: I'm sure this is terribly inefficient 125 ;; XXX: I'm sure this is terribly inefficient
88 (cl-some (lambda (b) 126 (cl-some (lambda (b)
89 (with-current-buffer b 127 (with-current-buffer b
90 (when-let* ((modep (derived-mode-p 128 (when-let* ((modep (derived-mode-p
91 'bongo-playlist-mode)) 129 'bongo-playlist-mode))
92 (bongo-playlist-buffer b) 130 (bongo-playlist-buffer b)
93 (playingp (bongo-playing-p))) 131 (playingp (bongo-playing-p)))
94 b))) 132 b)))
95 (buffer-list)))) 133 (buffer-list))))
96 (with-bongo-playlist-buffer 134 (with-bongo-playlist-buffer
97 (bongo-pause/resume)))) 135 (bongo-pause/resume))))
98 :help ,(funcall bongo-header-line-function))))) 136 :help ,(funcall bongo-header-line-function)))))
99 137
100(defvar +tab-bar-show-original nil 138(defvar +tab-bar-show-original nil
@@ -161,19 +199,19 @@
161This is just like `tab-bar-tab-name-truncated', but truncates the 199This is just like `tab-bar-tab-name-truncated', but truncates the
162name to the left." 200name to the left."
163 (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window)))) 201 (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
164 (ellipsis (cond 202 (ellipsis (cond
165 (tab-bar-tab-name-ellipsis) 203 (tab-bar-tab-name-ellipsis)
166 ((char-displayable-p ?…) "…") 204 ((char-displayable-p ?…) "…")
167 ("..."))) 205 ("...")))
168 (l-ell (length ellipsis)) 206 (l-ell (length ellipsis))
169 (l-name (length tab-name))) 207 (l-name (length tab-name)))
170 (if (< (length tab-name) tab-bar-tab-name-truncated-max) 208 (if (< (length tab-name) tab-bar-tab-name-truncated-max)
171 tab-name 209 tab-name
172 (propertize (concat 210 (propertize (concat
173 (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max) 211 (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
174 ellipsis) 212 ellipsis)
175 (truncate-string-to-width tab-name l-name 213 (truncate-string-to-width tab-name l-name
176 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell)))) 214 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
177 'help-echo tab-name)))) 215 'help-echo tab-name))))
178 216
179 217
@@ -209,27 +247,27 @@ Used by `tab-bar-format-menu-bar'."
209(el-patch-feature tab-bar) 247(el-patch-feature tab-bar)
210(with-eval-after-load 'tab-bar 248(with-eval-after-load 'tab-bar
211 (el-patch-defun tab-bar--format-tab (tab i) 249 (el-patch-defun tab-bar--format-tab (tab i)
212 "Format TAB using its index I and return the result as a keymap." 250 "Format TAB using its index I and return the result as a keymap."
213 (append 251 (append
214 (el-patch-remove 252 (el-patch-remove
215 `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))) 253 `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
216 (cond 254 (cond
217 ((eq (car tab) 'current-tab) 255 ((eq (car tab) 'current-tab)
218 `((current-tab 256 `((current-tab
219 menu-item 257 menu-item
220 ,(funcall tab-bar-tab-name-format-function tab i) 258 ,(funcall tab-bar-tab-name-format-function tab i)
221 ignore 259 ignore
222 :help "Current tab"))) 260 :help "Current tab")))
223 (t 261 (t
224 `((,(intern (format "tab-%i" i)) 262 `((,(intern (format "tab-%i" i))
225 menu-item 263 menu-item
226 ,(funcall tab-bar-tab-name-format-function tab i) 264 ,(funcall tab-bar-tab-name-format-function tab i)
227 ,(alist-get 'binding tab) 265 ,(alist-get 'binding tab)
228 :help "Click to visit tab")))) 266 :help "Click to visit tab"))))
229 (when (alist-get 'close-binding tab) 267 (when (alist-get 'close-binding tab)
230 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) 268 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
231 menu-item "" 269 menu-item ""
232 ,(alist-get 'close-binding tab))))))) 270 ,(alist-get 'close-binding tab)))))))
233 271
234 272
235;; Emacs 27 273;; Emacs 27
@@ -242,8 +280,8 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
242 'display `(space :align-to (- right (- 0 right-margin) 280 'display `(space :align-to (- right (- 0 right-margin)
243 ,reserve))))) 281 ,reserve)))))
244 (prog1 (append output 282 (prog1 (append output
245 `((align-right menu-item ,str nil)) 283 `((align-right menu-item ,str nil))
246 (+tab-bar-misc-info))))) 284 (+tab-bar-misc-info)))))
247 285
248 286
249;; Emacs 28 287;; Emacs 28