diff options
author | Case Duckworth | 2022-05-10 08:33:05 -0500 |
---|---|---|
committer | Case Duckworth | 2022-05-10 08:33:05 -0500 |
commit | 40c8fe07fab9aa7572f448034fc1a7e5119b8e84 (patch) | |
tree | 145b5922baf3b1e105e38c655a907886ae310592 | |
parent | Further modeline changes (diff) | |
download | emacs-40c8fe07fab9aa7572f448034fc1a7e5119b8e84.tar.gz emacs-40c8fe07fab9aa7572f448034fc1a7e5119b8e84.zip |
Add +modeline-spacer
-rw-r--r-- | lisp/+modeline.el | 172 |
1 files changed, 103 insertions, 69 deletions
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index df9d504..de0d947 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el | |||
@@ -55,6 +55,22 @@ This function makes a lambda, so you can throw it straight into | |||
55 | (push +modeline-default-spacer result-list)) | 55 | (push +modeline-default-spacer result-list)) |
56 | (nreverse result-list))))) | 56 | (nreverse result-list))))) |
57 | 57 | ||
58 | (defun +modeline-spacer (&optional n spacer &rest strings) | ||
59 | "Make an N-length SPACER, or prepend SPACER to STRINGS. | ||
60 | When called with no arguments, insert `+modeline-default-spacer'. | ||
61 | N will repeat SPACER N times, and defaults to 1. SPACER defaults | ||
62 | to `+modeline-default-spacer', but can be any string. STRINGS | ||
63 | should form a mode-line construct when `concat'ed." | ||
64 | (declare (indent 2)) | ||
65 | (let ((spacer (or spacer +modeline-default-spacer)) | ||
66 | (n (or n 1)) | ||
67 | (strings (cond ((null strings) '("")) | ||
68 | ((atom strings) (list strings)) | ||
69 | (t strings))) | ||
70 | r) | ||
71 | (dotimes (_ n) (push spacer r)) | ||
72 | (apply #'concat (apply #'concat r) strings))) | ||
73 | |||
58 | ;;; Modeline segments | 74 | ;;; Modeline segments |
59 | 75 | ||
60 | (defun +modeline-sanitize-string (string) | 76 | (defun +modeline-sanitize-string (string) |
@@ -80,26 +96,26 @@ and appended with `truncate-string-ellipsis'." | |||
80 | (defun +modeline-buffer-name (&optional spacer) ; gonsie | 96 | (defun +modeline-buffer-name (&optional spacer) ; gonsie |
81 | "Display the buffer name." | 97 | "Display the buffer name." |
82 | (let ((bufname (string-trim (string-replace "%" "" (buffer-name))))) | 98 | (let ((bufname (string-trim (string-replace "%" "" (buffer-name))))) |
83 | (concat (or spacer +modeline-default-spacer) | 99 | (+modeline-spacer nil nil |
84 | (if (and +modeline-buffer-position (fboundp +modeline-buffer-position)) | 100 | (if (and +modeline-buffer-position (fboundp +modeline-buffer-position)) |
85 | (funcall +modeline-buffer-position) | 101 | (funcall +modeline-buffer-position) |
86 | (propertize (cond | 102 | (propertize (cond |
87 | ((ignore-errors | 103 | ((ignore-errors |
88 | (and (> +modeline-buffer-name-max-length 0) | 104 | (and (> +modeline-buffer-name-max-length 0) |
89 | (< +modeline-buffer-name-max-length 1))) | 105 | (< +modeline-buffer-name-max-length 1))) |
90 | (truncate-string-to-width bufname | 106 | (truncate-string-to-width bufname |
91 | (* (window-total-width) | 107 | (* (window-total-width) |
92 | +modeline-buffer-name-max-length) | 108 | +modeline-buffer-name-max-length) |
93 | nil nil t)) | 109 | nil nil t)) |
94 | ((ignore-errors | 110 | ((ignore-errors |
95 | (> +modeline-buffer-name-max-length 1)) | 111 | (> +modeline-buffer-name-max-length 1)) |
96 | (truncate-string-to-width bufname | 112 | (truncate-string-to-width bufname |
97 | +modeline-buffer-name-max-length | 113 | +modeline-buffer-name-max-length |
98 | nil nil t)) | 114 | nil nil t)) |
99 | (t bufname)) | 115 | (t bufname)) |
100 | 'help-echo (or (buffer-file-name) | 116 | 'help-echo (or (buffer-file-name) |
101 | (buffer-name)) | 117 | (buffer-name)) |
102 | 'mouse-face 'mode-line-highlight))))) | 118 | 'mouse-face 'mode-line-highlight))))) |
103 | 119 | ||
104 | (defcustom +modeline-minions-icon "&" | 120 | (defcustom +modeline-minions-icon "&" |
105 | "The \"icon\" for `+modeline-minions' button." | 121 | "The \"icon\" for `+modeline-minions' button." |
@@ -107,25 +123,44 @@ and appended with `truncate-string-ellipsis'." | |||
107 | 123 | ||
108 | (defun +modeline-minions (&optional spacer) | 124 | (defun +modeline-minions (&optional spacer) |
109 | "Display a button for `minions-minor-modes-menu'." | 125 | "Display a button for `minions-minor-modes-menu'." |
110 | (concat (or spacer +modeline-default-spacer) | 126 | (+modeline-spacer nil nil |
111 | (propertize | 127 | (propertize |
112 | +modeline-minions-icon | 128 | +modeline-minions-icon |
113 | 'help-echo "Minor modes menu\nmouse-1: show menu." | 129 | 'help-echo "Minor modes menu\nmouse-1: show menu." |
114 | 'local-map (purecopy (simple-modeline-make-mouse-map | 130 | 'local-map (purecopy (simple-modeline-make-mouse-map |
115 | 'mouse-1 | 131 | 'mouse-1 |
116 | (lambda (event) | 132 | (lambda (event) |
117 | (interactive "e") | 133 | (interactive "e") |
118 | (with-selected-window | 134 | (with-selected-window |
119 | (posn-window (event-start event)) | 135 | (posn-window (event-start event)) |
120 | (minions-minor-modes-menu))))) | 136 | (minions-minor-modes-menu))))) |
121 | 'mouse-face 'mode-line-highlight))) | 137 | 'mouse-face 'mode-line-highlight))) |
138 | |||
139 | (defcustom +modeline-major-mode-faces '((text-mode . font-lock-string-face) | ||
140 | (prog-mode . font-lock-keyword-face) | ||
141 | (t . font-lock-warning-face)) | ||
142 | "Mode->face mapping for `+modeline-major-mode'. | ||
143 | If the current mode is derived from the car of a cell, the face | ||
144 | in the cdr will be applied to the major-mode in the mode line." | ||
145 | :type '(alist :key-type function | ||
146 | :value-type face)) | ||
122 | 147 | ||
123 | (defun +modeline-major-mode (&optional spacer) | 148 | (defun +modeline-major-mode (&optional spacer) |
124 | "Display the current `major-mode'." | 149 | "Display the current `major-mode'." |
125 | (concat (or spacer +modeline-default-spacer) | 150 | (+modeline-spacer nil nil |
151 | "(" | ||
126 | (propertize ;; (+string-truncate (format-mode-line mode-name) 16) | 152 | (propertize ;; (+string-truncate (format-mode-line mode-name) 16) |
127 | (format-mode-line mode-name) | 153 | (format-mode-line mode-name) |
128 | 'face 'font-lock-keyword-face | 154 | 'face (if (actually-selected-window-p) |
155 | ;; XXX: This is probably really inefficient. I need to | ||
156 | ;; simply detect which mode it's in when I change major | ||
157 | ;; modes (`change-major-mode-hook') and change the face | ||
158 | ;; there, probably. | ||
159 | (catch :done (dolist (cel +modeline-major-mode-faces) | ||
160 | (when (derived-mode-p (car cel)) | ||
161 | (throw :done (cdr cel)))) | ||
162 | (alist-get t +modeline-major-mode-faces)) | ||
163 | 'mode-line-inactive) | ||
129 | 'keymap (let ((map (make-sparse-keymap))) | 164 | 'keymap (let ((map (make-sparse-keymap))) |
130 | (bindings--define-key map [mode-line down-mouse-1] | 165 | (bindings--define-key map [mode-line down-mouse-1] |
131 | `(menu-item "Menu Bar" ignore | 166 | `(menu-item "Menu Bar" ignore |
@@ -138,7 +173,8 @@ and appended with `truncate-string-ellipsis'." | |||
138 | "mouse-1: show menu" | 173 | "mouse-1: show menu" |
139 | "mouse-2: describe mode" | 174 | "mouse-2: describe mode" |
140 | "mouse-3: display minor modes") | 175 | "mouse-3: display minor modes") |
141 | 'mouse-face 'mode-line-highlight))) | 176 | 'mouse-face 'mode-line-highlight) |
177 | ")")) | ||
142 | 178 | ||
143 | (defcustom +modeline-modified-icon-alist '((ephemeral . "*") | 179 | (defcustom +modeline-modified-icon-alist '((ephemeral . "*") |
144 | (readonly . "=") | 180 | (readonly . "=") |
@@ -180,7 +216,7 @@ The order of elements matters: whichever one matches first is applied." | |||
180 | ('t t) | 216 | ('t t) |
181 | (_ nil)) | 217 | (_ nil)) |
182 | (throw :icon cell)))))) | 218 | (throw :icon cell)))))) |
183 | (concat (or spacer +modeline-default-spacer) | 219 | (+modeline-spacer nil nil |
184 | (propertize (or (cdr-safe icon) "") | 220 | (propertize (or (cdr-safe icon) "") |
185 | 'help-echo (format "Buffer \"%s\" is %s." | 221 | 'help-echo (format "Buffer \"%s\" is %s." |
186 | (buffer-name) | 222 | (buffer-name) |
@@ -192,7 +228,7 @@ The order of elements matters: whichever one matches first is applied." | |||
192 | (defun +modeline-narrowed (&optional spacer) | 228 | (defun +modeline-narrowed (&optional spacer) |
193 | "Display an indication that the buffer is narrowed." | 229 | "Display an indication that the buffer is narrowed." |
194 | (when (buffer-narrowed-p) | 230 | (when (buffer-narrowed-p) |
195 | (concat (or spacer +modeline-default-spacer) | 231 | (+modeline-spacer nil nil |
196 | (propertize "N" | 232 | (propertize "N" |
197 | 'help-echo (format "%s\n%s" | 233 | 'help-echo (format "%s\n%s" |
198 | "Buffer is narrowed." | 234 | "Buffer is narrowed." |
@@ -205,7 +241,7 @@ The order of elements matters: whichever one matches first is applied." | |||
205 | (defun +modeline-reading-mode (&optional spacer) | 241 | (defun +modeline-reading-mode (&optional spacer) |
206 | "Display an indication that the buffer is in `reading-mode'." | 242 | "Display an indication that the buffer is in `reading-mode'." |
207 | (when reading-mode | 243 | (when reading-mode |
208 | (concat (or spacer +modeline-default-spacer) | 244 | (+modeline-spacer nil nil |
209 | (propertize | 245 | (propertize |
210 | (concat "R" (when (bound-and-true-p +eww-readable-p) "w")) | 246 | (concat "R" (when (bound-and-true-p +eww-readable-p) "w")) |
211 | 'help-echo (format "%s\n%s" | 247 | 'help-echo (format "%s\n%s" |
@@ -243,7 +279,7 @@ The order of elements matters: whichever one matches first is applied." | |||
243 | "Display the position in the current file." | 279 | "Display the position in the current file." |
244 | (when file-percentage-mode | 280 | (when file-percentage-mode |
245 | ;; (let ((perc (+modeline--percentage))) | 281 | ;; (let ((perc (+modeline--percentage))) |
246 | ;; (propertize (concat (or spacer +modeline-default-spacer) | 282 | ;; (propertize (+modeline-spacer nil nil |
247 | ;; (cond | 283 | ;; (cond |
248 | ;; ((+modeline--buffer-contained-in-window-p) "All") | 284 | ;; ((+modeline--buffer-contained-in-window-p) "All") |
249 | ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") | 285 | ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") |
@@ -257,18 +293,16 @@ The order of elements matters: whichever one matches first is applied." | |||
257 | ;; ;; TODO: add scroll-up and scroll-down bindings. | 293 | ;; ;; TODO: add scroll-up and scroll-down bindings. |
258 | ;; )) | 294 | ;; )) |
259 | (let ((perc (format-mode-line '(-3 "%p")))) | 295 | (let ((perc (format-mode-line '(-3 "%p")))) |
260 | (concat (or spacer +modeline-default-spacer) | 296 | (+modeline-spacer nil nil |
261 | perc | 297 | (pcase perc |
262 | (unless (seq-some (lambda (s) (string= perc s)) | 298 | ((or "Top" "Bot" "All") perc) |
263 | '("Top" "Bot" "All")) | 299 | (_ (format ".%02d" (string-to-number (substring perc 0 2))))))))) |
264 | "%%%%") | ||
265 | " ")))) | ||
266 | 300 | ||
267 | (defun +modeline-file-percentage-icon (&optional spacer) | 301 | (defun +modeline-file-percentage-icon (&optional spacer) |
268 | "Display the position in the current file as an icon." | 302 | "Display the position in the current file as an icon." |
269 | (when file-percentage-mode | 303 | (when file-percentage-mode |
270 | (let ((perc (+modeline--percentage))) | 304 | (let ((perc (+modeline--percentage))) |
271 | (propertize (concat (or spacer +modeline-default-spacer) | 305 | (propertize (+modeline-spacer nil nil |
272 | (cond | 306 | (cond |
273 | ((+modeline--buffer-contained-in-window-p) "⏹") | 307 | ((+modeline--buffer-contained-in-window-p) "⏹") |
274 | ((= perc 0) "▇") | 308 | ((= perc 0) "▇") |
@@ -302,23 +336,23 @@ The order of elements matters: whichever one matches first is applied." | |||
302 | 336 | ||
303 | (defun +modeline-line (&optional spacer) | 337 | (defun +modeline-line (&optional spacer) |
304 | (when line-number-mode | 338 | (when line-number-mode |
305 | (concat (or spacer +modeline-default-spacer) "%2l"))) | 339 | (+modeline-spacer nil nil "%2l"))) |
306 | 340 | ||
307 | (defun +modeline-column (&optional spacer) | 341 | (defun +modeline-column (&optional spacer) |
308 | (when column-number-mode | 342 | (when column-number-mode |
309 | (concat (or spacer +modeline-default-spacer) | 343 | (+modeline-spacer nil nil |
310 | (if column-number-indicator-zero-based "%2c" "%2C")))) | 344 | (if column-number-indicator-zero-based "%2c" "%2C")))) |
311 | 345 | ||
312 | (defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline' | 346 | (defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline' |
313 | "Display the current cursor line and column depending on modes." | 347 | "Display the current cursor line and column depending on modes." |
314 | (concat (or spacer +modeline-default-spacer) | 348 | (+modeline-spacer nil nil |
315 | (+modeline-line "") | 349 | (+modeline-line "") |
316 | "|" | 350 | "|" |
317 | (+modeline-column ""))) | 351 | (+modeline-column ""))) |
318 | 352 | ||
319 | (defcustom +modeline-position-function nil | 353 | (defcustom +modeline-position-function nil |
320 | "Function to use instead of `+modeline-position' in modeline." | 354 | "Function to use instead of `+modeline-position' in modeline." |
321 | :type '(choice (const :tag "None" nil) | 355 | :type '(choice (const :tag "Default" nil) |
322 | function) | 356 | function) |
323 | :local t) | 357 | :local t) |
324 | 358 | ||
@@ -327,17 +361,17 @@ The order of elements matters: whichever one matches first is applied." | |||
327 | See `line-number-mode', `column-number-mode', and | 361 | See `line-number-mode', `column-number-mode', and |
328 | `file-percentage-mode'. If `+modeline-position-function' is set | 362 | `file-percentage-mode'. If `+modeline-position-function' is set |
329 | to a function in the current buffer, call that function instead." | 363 | to a function in the current buffer, call that function instead." |
330 | (concat (or spacer +modeline-default-spacer) | 364 | (+modeline-spacer nil nil |
331 | (if +modeline-position-function | 365 | (cond ((functionp +modeline-position-function) |
332 | (funcall +modeline-position-function) | 366 | (funcall +modeline-position-function)) |
333 | (concat (+modeline-region) | 367 | (t (concat (+modeline-region) |
334 | (+modeline-line-column))))) | 368 | (+modeline-line-column)))))) |
335 | 369 | ||
336 | (defun +modeline-vc (&optional spacer) | 370 | (defun +modeline-vc (&optional spacer) |
337 | "Display the version control branch of the current buffer in the modeline." | 371 | "Display the version control branch of the current buffer in the modeline." |
338 | ;; from https://www.gonsie.com/blorg/modeline.html, from Doom | 372 | ;; from https://www.gonsie.com/blorg/modeline.html, from Doom |
339 | (if-let ((backend (vc-backend buffer-file-name))) | 373 | (if-let ((backend (vc-backend buffer-file-name))) |
340 | (concat (or spacer +modeline-default-spacer) | 374 | (+modeline-spacer nil nil |
341 | (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))) | 375 | (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))) |
342 | "")) | 376 | "")) |
343 | 377 | ||
@@ -348,7 +382,7 @@ to a function in the current buffer, call that function instead." | |||
348 | 382 | ||
349 | (defun +modeline-anzu (&optional spacer) | 383 | (defun +modeline-anzu (&optional spacer) |
350 | "Display `anzu--update-mode-line'." | 384 | "Display `anzu--update-mode-line'." |
351 | (concat (or spacer +modeline-default-spacer) | 385 | (+modeline-spacer nil nil |
352 | (anzu--update-mode-line))) | 386 | (anzu--update-mode-line))) |
353 | 387 | ||
354 | (defun +modeline-text-scale (&optional spacer) | 388 | (defun +modeline-text-scale (&optional spacer) |
@@ -364,13 +398,13 @@ to a function in the current buffer, call that function instead." | |||
364 | "Display `ace-window-display-mode' information in the modeline." | 398 | "Display `ace-window-display-mode' information in the modeline." |
365 | (when (and +ace-window-display-mode | 399 | (when (and +ace-window-display-mode |
366 | ace-window-mode) | 400 | ace-window-mode) |
367 | (concat (or spacer +modeline-default-spacer) | 401 | (+modeline-spacer nil nil |
368 | (window-parameter (selected-window) 'ace-window-path)))) | 402 | (window-parameter (selected-window) 'ace-window-path)))) |
369 | 403 | ||
370 | (defun +modeline-god-mode (&optional spacer) | 404 | (defun +modeline-god-mode (&optional spacer) |
371 | "Display an icon when `god-mode' is active." | 405 | "Display an icon when `god-mode' is active." |
372 | (when (and (boundp 'god-local-mode) god-local-mode) | 406 | (when (and (boundp 'god-local-mode) god-local-mode) |
373 | (concat (or spacer +modeline-default-spacer) | 407 | (+modeline-spacer nil nil |
374 | (propertize "Ω" | 408 | (propertize "Ω" |
375 | 'help-echo (concat "God mode is active." | 409 | 'help-echo (concat "God mode is active." |
376 | "\nmouse-1: exit God mode.") | 410 | "\nmouse-1: exit God mode.") |
@@ -388,7 +422,7 @@ to a function in the current buffer, call that function instead." | |||
388 | (defun +modeline-input-method (&optional spacer) | 422 | (defun +modeline-input-method (&optional spacer) |
389 | "Display which input method is active." | 423 | "Display which input method is active." |
390 | (when current-input-method | 424 | (when current-input-method |
391 | (concat (or spacer +modeline-default-spacer) | 425 | (+modeline-spacer nil nil |
392 | (propertize current-input-method-title | 426 | (propertize current-input-method-title |
393 | 'help-echo (format | 427 | 'help-echo (format |
394 | (concat "Current input method: %s\n" | 428 | (concat "Current input method: %s\n" |
@@ -398,15 +432,15 @@ to a function in the current buffer, call that function instead." | |||
398 | 'local-map (purecopy | 432 | 'local-map (purecopy |
399 | (let ((map (make-sparse-keymap))) | 433 | (let ((map (make-sparse-keymap))) |
400 | (define-key map [mode-line mouse-1] | 434 | (define-key map [mode-line mouse-1] |
401 | (lambda (e) | 435 | (lambda (e) |
402 | (interactive "e") | 436 | (interactive "e") |
403 | (with-selected-window (posn-window (event-start e)) | 437 | (with-selected-window (posn-window (event-start e)) |
404 | (describe-current-input-method)))) | 438 | (describe-current-input-method)))) |
405 | (define-key map [mode-line mouse-3] | 439 | (define-key map [mode-line mouse-3] |
406 | (lambda (e) | 440 | (lambda (e) |
407 | (interactive "e") | 441 | (interactive "e") |
408 | (with-selected-window (posn-window (event-start e)) | 442 | (with-selected-window (posn-window (event-start e)) |
409 | (toggle-input-method nil :interactive)))) | 443 | (toggle-input-method nil :interactive)))) |
410 | map)) | 444 | map)) |
411 | 'mouse-face 'mode-line-highlight)))) | 445 | 'mouse-face 'mode-line-highlight)))) |
412 | 446 | ||
@@ -416,7 +450,7 @@ to a function in the current buffer, call that function instead." | |||
416 | (defun +modeline-kmacro-indicator (&optional spacer) | 450 | (defun +modeline-kmacro-indicator (&optional spacer) |
417 | "Display an indicator when recording a kmacro." | 451 | "Display an indicator when recording a kmacro." |
418 | (when defining-kbd-macro | 452 | (when defining-kbd-macro |
419 | (concat (or spacer +modeline-default-spacer) | 453 | (+modeline-spacer nil nil |
420 | (propertize "●" | 454 | (propertize "●" |
421 | 'face '+modeline-kmacro-indicator | 455 | 'face '+modeline-kmacro-indicator |
422 | 'help-echo (format (concat "Defining a macro\n" | 456 | 'help-echo (format (concat "Defining a macro\n" |