summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2022-05-10 08:33:05 -0500
committerCase Duckworth2022-05-10 08:33:05 -0500
commit40c8fe07fab9aa7572f448034fc1a7e5119b8e84 (patch)
tree145b5922baf3b1e105e38c655a907886ae310592
parentFurther modeline changes (diff)
downloademacs-40c8fe07fab9aa7572f448034fc1a7e5119b8e84.tar.gz
emacs-40c8fe07fab9aa7572f448034fc1a7e5119b8e84.zip
Add +modeline-spacer
-rw-r--r--lisp/+modeline.el172
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.
60When called with no arguments, insert `+modeline-default-spacer'.
61N will repeat SPACER N times, and defaults to 1. SPACER defaults
62to `+modeline-default-spacer', but can be any string. STRINGS
63should 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'.
143If the current mode is derived from the car of a cell, the face
144in 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."
327See `line-number-mode', `column-number-mode', and 361See `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
329to a function in the current buffer, call that function instead." 363to 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"