about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-05-10 13:57:19 -0500
committerCase Duckworth2022-05-10 13:57:19 -0500
commit1492d153f05656a4b3212c06ada412c3f32a8e28 (patch)
treef7492c7b9f2c8e18e15b02ac17c8ceadbd695490 /lisp
parentFix load order (diff)
downloademacs-1492d153f05656a4b3212c06ada412c3f32a8e28.tar.gz
emacs-1492d153f05656a4b3212c06ada412c3f32a8e28.zip
Further mode line changes
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+modeline.el325
1 files changed, 163 insertions, 162 deletions
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index de0d947..f408757 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el
@@ -51,8 +51,8 @@ This function makes a lambda, so you can throw it straight into
51 (not (equal (car result-list) "")))) 51 (not (equal (car result-list) ""))))
52 (setq this-sep separator) 52 (setq this-sep separator)
53 (setq this-sep nil))) 53 (setq this-sep nil)))
54 (unless (seq-some #'null result-list) 54 ;; (unless (seq-some #'null result-list)
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) 58(defun +modeline-spacer (&optional n spacer &rest strings)
@@ -64,11 +64,12 @@ should form a mode-line construct when `concat'ed."
64 (declare (indent 2)) 64 (declare (indent 2))
65 (let ((spacer (or spacer +modeline-default-spacer)) 65 (let ((spacer (or spacer +modeline-default-spacer))
66 (n (or n 1)) 66 (n (or n 1))
67 (strings (cond ((null strings) '("")) 67 (strings (cond((null strings) '(""))
68 ((atom strings) (list strings)) 68 ((equal strings '("")) nil)
69 (t strings))) 69 ((atom strings) (list strings))
70 (t strings)))
70 r) 71 r)
71 (dotimes (_ n) (push spacer r)) 72 (when strings (dotimes (_ n) (push spacer r)))
72 (apply #'concat (apply #'concat r) strings))) 73 (apply #'concat (apply #'concat r) strings)))
73 74
74;;; Modeline segments 75;;; Modeline segments
@@ -96,7 +97,7 @@ and appended with `truncate-string-ellipsis'."
96(defun +modeline-buffer-name (&optional spacer) ; gonsie 97(defun +modeline-buffer-name (&optional spacer) ; gonsie
97 "Display the buffer name." 98 "Display the buffer name."
98 (let ((bufname (string-trim (string-replace "%" "" (buffer-name))))) 99 (let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))
99 (+modeline-spacer nil nil 100 (+modeline-spacer nil spacer
100 (if (and +modeline-buffer-position (fboundp +modeline-buffer-position)) 101 (if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
101 (funcall +modeline-buffer-position) 102 (funcall +modeline-buffer-position)
102 (propertize (cond 103 (propertize (cond
@@ -123,7 +124,7 @@ and appended with `truncate-string-ellipsis'."
123 124
124(defun +modeline-minions (&optional spacer) 125(defun +modeline-minions (&optional spacer)
125 "Display a button for `minions-minor-modes-menu'." 126 "Display a button for `minions-minor-modes-menu'."
126 (+modeline-spacer nil nil 127 (+modeline-spacer nil spacer
127 (propertize 128 (propertize
128 +modeline-minions-icon 129 +modeline-minions-icon
129 'help-echo "Minor modes menu\nmouse-1: show menu." 130 'help-echo "Minor modes menu\nmouse-1: show menu."
@@ -147,34 +148,34 @@ in the cdr will be applied to the major-mode in the mode line."
147 148
148(defun +modeline-major-mode (&optional spacer) 149(defun +modeline-major-mode (&optional spacer)
149 "Display the current `major-mode'." 150 "Display the current `major-mode'."
150 (+modeline-spacer nil nil 151 (+modeline-spacer nil spacer
151 "(" 152 "("
152 (propertize ;; (+string-truncate (format-mode-line mode-name) 16) 153 (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
153 (format-mode-line mode-name) 154 (format-mode-line mode-name)
154 'face (if (actually-selected-window-p) 155 'face (if (actually-selected-window-p)
155 ;; XXX: This is probably really inefficient. I need to 156 ;; XXX: This is probably really inefficient. I need to
156 ;; simply detect which mode it's in when I change major 157 ;; simply detect which mode it's in when I change major
157 ;; modes (`change-major-mode-hook') and change the face 158 ;; modes (`change-major-mode-hook') and change the face
158 ;; there, probably. 159 ;; there, probably.
159 (catch :done (dolist (cel +modeline-major-mode-faces) 160 (catch :done (dolist (cel +modeline-major-mode-faces)
160 (when (derived-mode-p (car cel)) 161 (when (derived-mode-p (car cel))
161 (throw :done (cdr cel)))) 162 (throw :done (cdr cel))))
162 (alist-get t +modeline-major-mode-faces)) 163 (alist-get t +modeline-major-mode-faces))
163 'mode-line-inactive) 164 'unspecified)
164 'keymap (let ((map (make-sparse-keymap))) 165 'keymap (let ((map (make-sparse-keymap)))
165 (bindings--define-key map [mode-line down-mouse-1] 166 (bindings--define-key map [mode-line down-mouse-1]
166 `(menu-item "Menu Bar" ignore 167 `(menu-item "Menu Bar" ignore
167 :filter ,(lambda (_) (mouse-menu-major-mode-map)))) 168 :filter ,(lambda (_) (mouse-menu-major-mode-map))))
168 (define-key map [mode-line mouse-2] 'describe-mode) 169 (define-key map [mode-line mouse-2] 'describe-mode)
169 (bindings--define-key map [mode-line down-mouse-3] 170 (bindings--define-key map [mode-line down-mouse-3]
170 `(menu-item "Minions" minions-minor-modes-menu)) 171 `(menu-item "Minions" minions-minor-modes-menu))
171 map) 172 map)
172 'help-echo (+concat (list (format-mode-line mode-name) " mode") 173 'help-echo (+concat (list (format-mode-line mode-name) " mode")
173 "mouse-1: show menu" 174 "mouse-1: show menu"
174 "mouse-2: describe mode" 175 "mouse-2: describe mode"
175 "mouse-3: display minor modes") 176 "mouse-3: display minor modes")
176 'mouse-face 'mode-line-highlight) 177 'mouse-face 'mode-line-highlight)
177 ")")) 178 ")"))
178 179
179(defcustom +modeline-modified-icon-alist '((ephemeral . "*") 180(defcustom +modeline-modified-icon-alist '((ephemeral . "*")
180 (readonly . "=") 181 (readonly . "=")
@@ -216,48 +217,48 @@ The order of elements matters: whichever one matches first is applied."
216 ('t t) 217 ('t t)
217 (_ nil)) 218 (_ nil))
218 (throw :icon cell)))))) 219 (throw :icon cell))))))
219 (+modeline-spacer nil nil 220 (+modeline-spacer nil spacer
220 (propertize (or (cdr-safe icon) "") 221 (propertize (or (cdr-safe icon) "")
221 'help-echo (format "Buffer \"%s\" is %s." 222 'help-echo (format "Buffer \"%s\" is %s."
222 (buffer-name) 223 (buffer-name)
223 (pcase (car-safe icon) 224 (pcase (car-safe icon)
224 ('t "unmodified") 225 ('t "unmodified")
225 ('nil "unknown") 226 ('nil "unknown")
226 (_ (car-safe icon)))))))) 227 (_ (car-safe icon))))))))
227 228
228(defun +modeline-narrowed (&optional spacer) 229(defun +modeline-narrowed (&optional spacer)
229 "Display an indication that the buffer is narrowed." 230 "Display an indication that the buffer is narrowed."
230 (when (buffer-narrowed-p) 231 (when (buffer-narrowed-p)
231 (+modeline-spacer nil nil 232 (+modeline-spacer nil spacer
232 (propertize "N" 233 (propertize "N"
233 'help-echo (format "%s\n%s" 234 'help-echo (format "%s\n%s"
234 "Buffer is narrowed." 235 "Buffer is narrowed."
235 "mouse-2: widen buffer.") 236 "mouse-2: widen buffer.")
236 'local-map (purecopy (simple-modeline-make-mouse-map 237 'local-map (purecopy (simple-modeline-make-mouse-map
237 'mouse-2 'mode-line-widen)) 238 'mouse-2 'mode-line-widen))
238 'face 'font-lock-doc-face 239 'face 'font-lock-doc-face
239 'mouse-face 'mode-line-highlight)))) 240 'mouse-face 'mode-line-highlight))))
240 241
241(defun +modeline-reading-mode (&optional spacer) 242(defun +modeline-reading-mode (&optional spacer)
242 "Display an indication that the buffer is in `reading-mode'." 243 "Display an indication that the buffer is in `reading-mode'."
243 (when reading-mode 244 (when reading-mode
244 (+modeline-spacer nil nil 245 (+modeline-spacer nil spacer
245 (propertize 246 (propertize
246 (concat "R" (when (bound-and-true-p +eww-readable-p) "w")) 247 (concat "R" (when (bound-and-true-p +eww-readable-p) "w"))
247 'help-echo (format "%s\n%s" 248 'help-echo (format "%s\n%s"
248 "Buffer is in reading-mode." 249 "Buffer is in reading-mode."
249 "mouse-2: disable reading-mode.") 250 "mouse-2: disable reading-mode.")
250 'local-map (purecopy 251 'local-map (purecopy
251 (simple-modeline-make-mouse-map 252 (simple-modeline-make-mouse-map
252 'mouse-2 (lambda (ev) 253 'mouse-2 (lambda (ev)
253 (interactive "e") 254 (interactive "e")
254 (with-selected-window 255 (with-selected-window
255 (posn-window 256 (posn-window
256 (event-start ev)) 257 (event-start ev))
257 (reading-mode -1) 258 (reading-mode -1)
258 (force-mode-line-update))))) 259 (force-mode-line-update)))))
259 'face 'font-lock-doc-face 260 'face 'font-lock-doc-face
260 'mouse-face 'mode-line-highlight)))) 261 'mouse-face 'mode-line-highlight))))
261 262
262(define-minor-mode file-percentage-mode 263(define-minor-mode file-percentage-mode
263 "Toggle the percentage display in the mode line (File Percentage Mode)." 264 "Toggle the percentage display in the mode line (File Percentage Mode)."
@@ -279,7 +280,7 @@ The order of elements matters: whichever one matches first is applied."
279 "Display the position in the current file." 280 "Display the position in the current file."
280 (when file-percentage-mode 281 (when file-percentage-mode
281 ;; (let ((perc (+modeline--percentage))) 282 ;; (let ((perc (+modeline--percentage)))
282 ;; (propertize (+modeline-spacer nil nil 283 ;; (propertize (+modeline-spacer nil spacer
283 ;; (cond 284 ;; (cond
284 ;; ((+modeline--buffer-contained-in-window-p) "All") 285 ;; ((+modeline--buffer-contained-in-window-p) "All")
285 ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") 286 ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top")
@@ -293,25 +294,27 @@ The order of elements matters: whichever one matches first is applied."
293 ;; ;; TODO: add scroll-up and scroll-down bindings. 294 ;; ;; TODO: add scroll-up and scroll-down bindings.
294 ;; )) 295 ;; ))
295 (let ((perc (format-mode-line '(-3 "%p")))) 296 (let ((perc (format-mode-line '(-3 "%p"))))
296 (+modeline-spacer nil nil 297 (+modeline-spacer nil spacer
297 (pcase perc 298 (pcase perc
298 ((or "Top" "Bot" "All") perc) 299 ("Top" ".^^")
300 ("Bot" ".__")
301 ("All" ".::")
299 (_ (format ".%02d" (string-to-number (substring perc 0 2))))))))) 302 (_ (format ".%02d" (string-to-number (substring perc 0 2)))))))))
300 303
301(defun +modeline-file-percentage-icon (&optional spacer) 304(defun +modeline-file-percentage-icon (&optional spacer)
302 "Display the position in the current file as an icon." 305 "Display the position in the current file as an icon."
303 (when file-percentage-mode 306 (when file-percentage-mode
304 (let ((perc (+modeline--percentage))) 307 (let ((perc (+modeline--percentage)))
305 (propertize (+modeline-spacer nil nil 308 (propertize (+modeline-spacer nil spacer
306 (cond 309 (cond
307 ((+modeline--buffer-contained-in-window-p) "⏹") 310 ((+modeline--buffer-contained-in-window-p) "⏹")
308 ((= perc 0) "▇") 311 ((= perc 0) "▇")
309 ((< perc 20) "▆") 312 ((< perc 20) "▆")
310 ((< perc 40) "▅") 313 ((< perc 40) "▅")
311 ((< perc 60) "▄") 314 ((< perc 60) "▄")
312 ((< perc 80) "▃") 315 ((< perc 80) "▃")
313 ((< perc 100) "▂") 316 ((< perc 100) "▂")
314 ((>= perc 100) "▁"))) 317 ((>= perc 100) "▁")))
315 'help-echo (format "Point is %d%% through the buffer." 318 'help-echo (format "Point is %d%% through the buffer."
316 perc))))) 319 perc)))))
317 320
@@ -321,34 +324,32 @@ The order of elements matters: whichever one matches first is applied."
321 324
322(defun +modeline-region (&optional spacer) 325(defun +modeline-region (&optional spacer)
323 "Display an indicator if the region is active." 326 "Display an indicator if the region is active."
324 (if (and region-indicator-mode 327 (when (and region-indicator-mode
325 (region-active-p)) 328 (region-active-p))
326 (format "%s%s" 329 (+modeline-spacer nil spacer
327 (or spacer +modeline-default-spacer) 330 (propertize (format "%s%d"
328 (propertize (format "%s%d" 331 (if (and (< (point) (mark))) "-" "+")
329 (if (and (< (point) (mark))) "-" "+") 332 (apply '+ (mapcar (lambda (pos)
330 (apply '+ (mapcar (lambda (pos) 333 (- (cdr pos)
331 (- (cdr pos) 334 (car pos)))
332 (car pos))) 335 (region-bounds))))
333 (region-bounds)))) 336 'font-lock-face 'font-lock-variable-name-face))))
334 'font-lock-face 'font-lock-variable-name-face))
335 ""))
336 337
337(defun +modeline-line (&optional spacer) 338(defun +modeline-line (&optional spacer)
338 (when line-number-mode 339 (when line-number-mode
339 (+modeline-spacer nil nil "%2l"))) 340 (+modeline-spacer nil spacer "%2l")))
340 341
341(defun +modeline-column (&optional spacer) 342(defun +modeline-column (&optional spacer)
342 (when column-number-mode 343 (when column-number-mode
343 (+modeline-spacer nil nil 344 (+modeline-spacer nil spacer
344 (if column-number-indicator-zero-based "%2c" "%2C")))) 345 (if column-number-indicator-zero-based "%2c" "%2C"))))
345 346
346(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline' 347(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline'
347 "Display the current cursor line and column depending on modes." 348 "Display the current cursor line and column depending on modes."
348 (+modeline-spacer nil nil 349 (+modeline-spacer nil spacer
349 (+modeline-line "") 350 (+modeline-line "")
350 "|" 351 "|"
351 (+modeline-column ""))) 352 (+modeline-column "")))
352 353
353(defcustom +modeline-position-function nil 354(defcustom +modeline-position-function nil
354 "Function to use instead of `+modeline-position' in modeline." 355 "Function to use instead of `+modeline-position' in modeline."
@@ -361,18 +362,18 @@ The order of elements matters: whichever one matches first is applied."
361See `line-number-mode', `column-number-mode', and 362See `line-number-mode', `column-number-mode', and
362`file-percentage-mode'. If `+modeline-position-function' is set 363`file-percentage-mode'. If `+modeline-position-function' is set
363to a function in the current buffer, call that function instead." 364to a function in the current buffer, call that function instead."
364 (+modeline-spacer nil nil 365 (+modeline-spacer nil spacer
365 (cond ((functionp +modeline-position-function) 366 (cond ((functionp +modeline-position-function)
366 (funcall +modeline-position-function)) 367 (funcall +modeline-position-function))
367 (t (concat (+modeline-region) 368 (t (concat (+modeline-region)
368 (+modeline-line-column)))))) 369 (+modeline-line-column))))))
369 370
370(defun +modeline-vc (&optional spacer) 371(defun +modeline-vc (&optional spacer)
371 "Display the version control branch of the current buffer in the modeline." 372 "Display the version control branch of the current buffer in the modeline."
372 ;; from https://www.gonsie.com/blorg/modeline.html, from Doom 373 ;; from https://www.gonsie.com/blorg/modeline.html, from Doom
373 (if-let ((backend (vc-backend buffer-file-name))) 374 (if-let ((backend (vc-backend buffer-file-name)))
374 (+modeline-spacer nil nil 375 (+modeline-spacer nil spacer
375 (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))) 376 (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))
376 "")) 377 ""))
377 378
378(defun +modeline-track (&optional spacer) 379(defun +modeline-track (&optional spacer)
@@ -382,8 +383,8 @@ to a function in the current buffer, call that function instead."
382 383
383(defun +modeline-anzu (&optional spacer) 384(defun +modeline-anzu (&optional spacer)
384 "Display `anzu--update-mode-line'." 385 "Display `anzu--update-mode-line'."
385 (+modeline-spacer nil nil 386 (+modeline-spacer nil spacer
386 (anzu--update-mode-line))) 387 (anzu--update-mode-line)))
387 388
388(defun +modeline-text-scale (&optional spacer) 389(defun +modeline-text-scale (&optional spacer)
389 "Display text scaling level." 390 "Display text scaling level."
@@ -398,51 +399,51 @@ to a function in the current buffer, call that function instead."
398 "Display `ace-window-display-mode' information in the modeline." 399 "Display `ace-window-display-mode' information in the modeline."
399 (when (and +ace-window-display-mode 400 (when (and +ace-window-display-mode
400 ace-window-mode) 401 ace-window-mode)
401 (+modeline-spacer nil nil 402 (+modeline-spacer nil spacer
402 (window-parameter (selected-window) 'ace-window-path)))) 403 (window-parameter (selected-window) 'ace-window-path))))
403 404
404(defun +modeline-god-mode (&optional spacer) 405(defun +modeline-god-mode (&optional spacer)
405 "Display an icon when `god-mode' is active." 406 "Display an icon when `god-mode' is active."
406 (when (and (boundp 'god-local-mode) god-local-mode) 407 (when (and (boundp 'god-local-mode) god-local-mode)
407 (+modeline-spacer nil nil 408 (+modeline-spacer nil spacer
408 (propertize "Ω" 409 (propertize "Ω"
409 'help-echo (concat "God mode is active." 410 'help-echo (concat "God mode is active."
410 "\nmouse-1: exit God mode.") 411 "\nmouse-1: exit God mode.")
411 'local-map (purecopy 412 'local-map (purecopy
412 (simple-modeline-make-mouse-map 413 (simple-modeline-make-mouse-map
413 'mouse-1 (lambda (e) 414 'mouse-1 (lambda (e)
414 (interactive "e") 415 (interactive "e")
415 (with-selected-window 416 (with-selected-window
416 (posn-window 417 (posn-window
417 (event-start e)) 418 (event-start e))
418 (god-local-mode -1) 419 (god-local-mode -1)
419 (force-mode-line-update))))) 420 (force-mode-line-update)))))
420 'mouse-face 'mode-line-highlight)))) 421 'mouse-face 'mode-line-highlight))))
421 422
422(defun +modeline-input-method (&optional spacer) 423(defun +modeline-input-method (&optional spacer)
423 "Display which input method is active." 424 "Display which input method is active."
424 (when current-input-method 425 (when current-input-method
425 (+modeline-spacer nil nil 426 (+modeline-spacer nil spacer
426 (propertize current-input-method-title 427 (propertize current-input-method-title
427 'help-echo (format 428 'help-echo (format
428 (concat "Current input method: %s\n" 429 (concat "Current input method: %s\n"
429 "mouse-1: Describe current input method\n" 430 "mouse-1: Describe current input method\n"
430 "mouse-3: Toggle input method") 431 "mouse-3: Toggle input method")
431 current-input-method) 432 current-input-method)
432 'local-map (purecopy 433 'local-map (purecopy
433 (let ((map (make-sparse-keymap))) 434 (let ((map (make-sparse-keymap)))
434 (define-key map [mode-line mouse-1] 435 (define-key map [mode-line mouse-1]
435 (lambda (e) 436 (lambda (e)
436 (interactive "e") 437 (interactive "e")
437 (with-selected-window (posn-window (event-start e)) 438 (with-selected-window (posn-window (event-start e))
438 (describe-current-input-method)))) 439 (describe-current-input-method))))
439 (define-key map [mode-line mouse-3] 440 (define-key map [mode-line mouse-3]
440 (lambda (e) 441 (lambda (e)
441 (interactive "e") 442 (interactive "e")
442 (with-selected-window (posn-window (event-start e)) 443 (with-selected-window (posn-window (event-start e))
443 (toggle-input-method nil :interactive)))) 444 (toggle-input-method nil :interactive))))
444 map)) 445 map))
445 'mouse-face 'mode-line-highlight)))) 446 'mouse-face 'mode-line-highlight))))
446 447
447(defface +modeline-kmacro-indicator '((t :foreground "Firebrick")) 448(defface +modeline-kmacro-indicator '((t :foreground "Firebrick"))
448 "Face for the kmacro indicator in the modeline.") 449 "Face for the kmacro indicator in the modeline.")
@@ -450,20 +451,20 @@ to a function in the current buffer, call that function instead."
450(defun +modeline-kmacro-indicator (&optional spacer) 451(defun +modeline-kmacro-indicator (&optional spacer)
451 "Display an indicator when recording a kmacro." 452 "Display an indicator when recording a kmacro."
452 (when defining-kbd-macro 453 (when defining-kbd-macro
453 (+modeline-spacer nil nil 454 (+modeline-spacer nil spacer
454 (propertize "●" 455 (propertize "●"
455 'face '+modeline-kmacro-indicator 456 'face '+modeline-kmacro-indicator
456 'help-echo (format (concat "Defining a macro\n" 457 'help-echo (format (concat "Defining a macro\n"
457 "Current step: %d\n" 458 "Current step: %d\n"
458 "mouse-1: Stop recording") 459 "mouse-1: Stop recording")
459 kmacro-counter) 460 kmacro-counter)
460 'local-map (purecopy (simple-modeline-make-mouse-map 461 'local-map (purecopy (simple-modeline-make-mouse-map
461 'mouse-1 (lambda (e) 462 'mouse-1 (lambda (e)
462 (interactive "e") 463 (interactive "e")
463 (with-selected-window 464 (with-selected-window
464 (posn-window (event-start e)) 465 (posn-window (event-start e))
465 (kmacro-end-macro nil))))) 466 (kmacro-end-macro nil)))))
466 'mouse-face 'mode-line-highlight)))) 467 'mouse-face 'mode-line-highlight))))
467 468
468(provide '+modeline) 469(provide '+modeline)
469;;; +modeline.el ends here 470;;; +modeline.el ends here