From 1492d153f05656a4b3212c06ada412c3f32a8e28 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 10 May 2022 13:57:19 -0500
Subject: Further mode line changes
---
lisp/+modeline.el | 325 +++++++++++++++++++++++++++---------------------------
1 file changed, 163 insertions(+), 162 deletions(-)
(limited to 'lisp')
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
(not (equal (car result-list) ""))))
(setq this-sep separator)
(setq this-sep nil)))
- (unless (seq-some #'null result-list)
- (push +modeline-default-spacer result-list))
+ ;; (unless (seq-some #'null result-list)
+ ;; (push +modeline-default-spacer result-list))
(nreverse result-list)))))
(defun +modeline-spacer (&optional n spacer &rest strings)
@@ -64,11 +64,12 @@ should form a mode-line construct when `concat'ed."
(declare (indent 2))
(let ((spacer (or spacer +modeline-default-spacer))
(n (or n 1))
- (strings (cond ((null strings) '(""))
- ((atom strings) (list strings))
- (t strings)))
+ (strings (cond((null strings) '(""))
+ ((equal strings '("")) nil)
+ ((atom strings) (list strings))
+ (t strings)))
r)
- (dotimes (_ n) (push spacer r))
+ (when strings (dotimes (_ n) (push spacer r)))
(apply #'concat (apply #'concat r) strings)))
;;; Modeline segments
@@ -96,7 +97,7 @@ and appended with `truncate-string-ellipsis'."
(defun +modeline-buffer-name (&optional spacer) ; gonsie
"Display the buffer name."
(let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))
- (+modeline-spacer nil nil
+ (+modeline-spacer nil spacer
(if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
(funcall +modeline-buffer-position)
(propertize (cond
@@ -123,7 +124,7 @@ and appended with `truncate-string-ellipsis'."
(defun +modeline-minions (&optional spacer)
"Display a button for `minions-minor-modes-menu'."
- (+modeline-spacer nil nil
+ (+modeline-spacer nil spacer
(propertize
+modeline-minions-icon
'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."
(defun +modeline-major-mode (&optional spacer)
"Display the current `major-mode'."
- (+modeline-spacer nil nil
- "("
- (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
- (format-mode-line mode-name)
- 'face (if (actually-selected-window-p)
- ;; XXX: This is probably really inefficient. I need to
- ;; simply detect which mode it's in when I change major
- ;; modes (`change-major-mode-hook') and change the face
- ;; there, probably.
- (catch :done (dolist (cel +modeline-major-mode-faces)
- (when (derived-mode-p (car cel))
- (throw :done (cdr cel))))
- (alist-get t +modeline-major-mode-faces))
- 'mode-line-inactive)
- 'keymap (let ((map (make-sparse-keymap)))
- (bindings--define-key map [mode-line down-mouse-1]
- `(menu-item "Menu Bar" ignore
- :filter ,(lambda (_) (mouse-menu-major-mode-map))))
- (define-key map [mode-line mouse-2] 'describe-mode)
- (bindings--define-key map [mode-line down-mouse-3]
- `(menu-item "Minions" minions-minor-modes-menu))
- map)
- 'help-echo (+concat (list (format-mode-line mode-name) " mode")
- "mouse-1: show menu"
- "mouse-2: describe mode"
- "mouse-3: display minor modes")
- 'mouse-face 'mode-line-highlight)
- ")"))
+ (+modeline-spacer nil spacer
+ "("
+ (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
+ (format-mode-line mode-name)
+ 'face (if (actually-selected-window-p)
+ ;; XXX: This is probably really inefficient. I need to
+ ;; simply detect which mode it's in when I change major
+ ;; modes (`change-major-mode-hook') and change the face
+ ;; there, probably.
+ (catch :done (dolist (cel +modeline-major-mode-faces)
+ (when (derived-mode-p (car cel))
+ (throw :done (cdr cel))))
+ (alist-get t +modeline-major-mode-faces))
+ 'unspecified)
+ 'keymap (let ((map (make-sparse-keymap)))
+ (bindings--define-key map [mode-line down-mouse-1]
+ `(menu-item "Menu Bar" ignore
+ :filter ,(lambda (_) (mouse-menu-major-mode-map))))
+ (define-key map [mode-line mouse-2] 'describe-mode)
+ (bindings--define-key map [mode-line down-mouse-3]
+ `(menu-item "Minions" minions-minor-modes-menu))
+ map)
+ 'help-echo (+concat (list (format-mode-line mode-name) " mode")
+ "mouse-1: show menu"
+ "mouse-2: describe mode"
+ "mouse-3: display minor modes")
+ 'mouse-face 'mode-line-highlight)
+ ")"))
(defcustom +modeline-modified-icon-alist '((ephemeral . "*")
(readonly . "=")
@@ -216,48 +217,48 @@ The order of elements matters: whichever one matches first is applied."
('t t)
(_ nil))
(throw :icon cell))))))
- (+modeline-spacer nil nil
- (propertize (or (cdr-safe icon) "")
- 'help-echo (format "Buffer \"%s\" is %s."
- (buffer-name)
- (pcase (car-safe icon)
- ('t "unmodified")
- ('nil "unknown")
- (_ (car-safe icon))))))))
+ (+modeline-spacer nil spacer
+ (propertize (or (cdr-safe icon) "")
+ 'help-echo (format "Buffer \"%s\" is %s."
+ (buffer-name)
+ (pcase (car-safe icon)
+ ('t "unmodified")
+ ('nil "unknown")
+ (_ (car-safe icon))))))))
(defun +modeline-narrowed (&optional spacer)
"Display an indication that the buffer is narrowed."
(when (buffer-narrowed-p)
- (+modeline-spacer nil nil
- (propertize "N"
- 'help-echo (format "%s\n%s"
- "Buffer is narrowed."
- "mouse-2: widen buffer.")
- 'local-map (purecopy (simple-modeline-make-mouse-map
- 'mouse-2 'mode-line-widen))
- 'face 'font-lock-doc-face
- 'mouse-face 'mode-line-highlight))))
+ (+modeline-spacer nil spacer
+ (propertize "N"
+ 'help-echo (format "%s\n%s"
+ "Buffer is narrowed."
+ "mouse-2: widen buffer.")
+ 'local-map (purecopy (simple-modeline-make-mouse-map
+ 'mouse-2 'mode-line-widen))
+ 'face 'font-lock-doc-face
+ 'mouse-face 'mode-line-highlight))))
(defun +modeline-reading-mode (&optional spacer)
"Display an indication that the buffer is in `reading-mode'."
(when reading-mode
- (+modeline-spacer nil nil
- (propertize
- (concat "R" (when (bound-and-true-p +eww-readable-p) "w"))
- 'help-echo (format "%s\n%s"
- "Buffer is in reading-mode."
- "mouse-2: disable reading-mode.")
- 'local-map (purecopy
- (simple-modeline-make-mouse-map
- 'mouse-2 (lambda (ev)
- (interactive "e")
- (with-selected-window
- (posn-window
- (event-start ev))
- (reading-mode -1)
- (force-mode-line-update)))))
- 'face 'font-lock-doc-face
- 'mouse-face 'mode-line-highlight))))
+ (+modeline-spacer nil spacer
+ (propertize
+ (concat "R" (when (bound-and-true-p +eww-readable-p) "w"))
+ 'help-echo (format "%s\n%s"
+ "Buffer is in reading-mode."
+ "mouse-2: disable reading-mode.")
+ 'local-map (purecopy
+ (simple-modeline-make-mouse-map
+ 'mouse-2 (lambda (ev)
+ (interactive "e")
+ (with-selected-window
+ (posn-window
+ (event-start ev))
+ (reading-mode -1)
+ (force-mode-line-update)))))
+ 'face 'font-lock-doc-face
+ 'mouse-face 'mode-line-highlight))))
(define-minor-mode file-percentage-mode
"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."
"Display the position in the current file."
(when file-percentage-mode
;; (let ((perc (+modeline--percentage)))
- ;; (propertize (+modeline-spacer nil nil
+ ;; (propertize (+modeline-spacer nil spacer
;; (cond
;; ((+modeline--buffer-contained-in-window-p) "All")
;; ((= (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."
;; ;; TODO: add scroll-up and scroll-down bindings.
;; ))
(let ((perc (format-mode-line '(-3 "%p"))))
- (+modeline-spacer nil nil
+ (+modeline-spacer nil spacer
(pcase perc
- ((or "Top" "Bot" "All") perc)
+ ("Top" ".^^")
+ ("Bot" ".__")
+ ("All" ".::")
(_ (format ".%02d" (string-to-number (substring perc 0 2)))))))))
(defun +modeline-file-percentage-icon (&optional spacer)
"Display the position in the current file as an icon."
(when file-percentage-mode
(let ((perc (+modeline--percentage)))
- (propertize (+modeline-spacer nil nil
- (cond
- ((+modeline--buffer-contained-in-window-p) "⏹")
- ((= perc 0) "▇")
- ((< perc 20) "▆")
- ((< perc 40) "▅")
- ((< perc 60) "▄")
- ((< perc 80) "▃")
- ((< perc 100) "▂")
- ((>= perc 100) "▁")))
+ (propertize (+modeline-spacer nil spacer
+ (cond
+ ((+modeline--buffer-contained-in-window-p) "⏹")
+ ((= perc 0) "▇")
+ ((< perc 20) "▆")
+ ((< perc 40) "▅")
+ ((< perc 60) "▄")
+ ((< perc 80) "▃")
+ ((< perc 100) "▂")
+ ((>= perc 100) "▁")))
'help-echo (format "Point is %d%% through the buffer."
perc)))))
@@ -321,34 +324,32 @@ The order of elements matters: whichever one matches first is applied."
(defun +modeline-region (&optional spacer)
"Display an indicator if the region is active."
- (if (and region-indicator-mode
- (region-active-p))
- (format "%s%s"
- (or spacer +modeline-default-spacer)
- (propertize (format "%s%d"
- (if (and (< (point) (mark))) "-" "+")
- (apply '+ (mapcar (lambda (pos)
- (- (cdr pos)
- (car pos)))
- (region-bounds))))
- 'font-lock-face 'font-lock-variable-name-face))
- ""))
+ (when (and region-indicator-mode
+ (region-active-p))
+ (+modeline-spacer nil spacer
+ (propertize (format "%s%d"
+ (if (and (< (point) (mark))) "-" "+")
+ (apply '+ (mapcar (lambda (pos)
+ (- (cdr pos)
+ (car pos)))
+ (region-bounds))))
+ 'font-lock-face 'font-lock-variable-name-face))))
(defun +modeline-line (&optional spacer)
(when line-number-mode
- (+modeline-spacer nil nil "%2l")))
+ (+modeline-spacer nil spacer "%2l")))
(defun +modeline-column (&optional spacer)
(when column-number-mode
- (+modeline-spacer nil nil
- (if column-number-indicator-zero-based "%2c" "%2C"))))
+ (+modeline-spacer nil spacer
+ (if column-number-indicator-zero-based "%2c" "%2C"))))
(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline'
"Display the current cursor line and column depending on modes."
- (+modeline-spacer nil nil
- (+modeline-line "")
- "|"
- (+modeline-column "")))
+ (+modeline-spacer nil spacer
+ (+modeline-line "")
+ "|"
+ (+modeline-column "")))
(defcustom +modeline-position-function nil
"Function to use instead of `+modeline-position' in modeline."
@@ -361,18 +362,18 @@ The order of elements matters: whichever one matches first is applied."
See `line-number-mode', `column-number-mode', and
`file-percentage-mode'. If `+modeline-position-function' is set
to a function in the current buffer, call that function instead."
- (+modeline-spacer nil nil
- (cond ((functionp +modeline-position-function)
- (funcall +modeline-position-function))
- (t (concat (+modeline-region)
- (+modeline-line-column))))))
+ (+modeline-spacer nil spacer
+ (cond ((functionp +modeline-position-function)
+ (funcall +modeline-position-function))
+ (t (concat (+modeline-region)
+ (+modeline-line-column))))))
(defun +modeline-vc (&optional spacer)
"Display the version control branch of the current buffer in the modeline."
;; from https://www.gonsie.com/blorg/modeline.html, from Doom
(if-let ((backend (vc-backend buffer-file-name)))
- (+modeline-spacer nil nil
- (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))
+ (+modeline-spacer nil spacer
+ (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))
""))
(defun +modeline-track (&optional spacer)
@@ -382,8 +383,8 @@ to a function in the current buffer, call that function instead."
(defun +modeline-anzu (&optional spacer)
"Display `anzu--update-mode-line'."
- (+modeline-spacer nil nil
- (anzu--update-mode-line)))
+ (+modeline-spacer nil spacer
+ (anzu--update-mode-line)))
(defun +modeline-text-scale (&optional spacer)
"Display text scaling level."
@@ -398,51 +399,51 @@ to a function in the current buffer, call that function instead."
"Display `ace-window-display-mode' information in the modeline."
(when (and +ace-window-display-mode
ace-window-mode)
- (+modeline-spacer nil nil
- (window-parameter (selected-window) 'ace-window-path))))
+ (+modeline-spacer nil spacer
+ (window-parameter (selected-window) 'ace-window-path))))
(defun +modeline-god-mode (&optional spacer)
"Display an icon when `god-mode' is active."
(when (and (boundp 'god-local-mode) god-local-mode)
- (+modeline-spacer nil nil
- (propertize "Ω"
- 'help-echo (concat "God mode is active."
- "\nmouse-1: exit God mode.")
- 'local-map (purecopy
- (simple-modeline-make-mouse-map
- 'mouse-1 (lambda (e)
- (interactive "e")
- (with-selected-window
- (posn-window
- (event-start e))
- (god-local-mode -1)
- (force-mode-line-update)))))
- 'mouse-face 'mode-line-highlight))))
+ (+modeline-spacer nil spacer
+ (propertize "Ω"
+ 'help-echo (concat "God mode is active."
+ "\nmouse-1: exit God mode.")
+ 'local-map (purecopy
+ (simple-modeline-make-mouse-map
+ 'mouse-1 (lambda (e)
+ (interactive "e")
+ (with-selected-window
+ (posn-window
+ (event-start e))
+ (god-local-mode -1)
+ (force-mode-line-update)))))
+ 'mouse-face 'mode-line-highlight))))
(defun +modeline-input-method (&optional spacer)
"Display which input method is active."
(when current-input-method
- (+modeline-spacer nil nil
- (propertize current-input-method-title
- 'help-echo (format
- (concat "Current input method: %s\n"
- "mouse-1: Describe current input method\n"
- "mouse-3: Toggle input method")
- current-input-method)
- 'local-map (purecopy
- (let ((map (make-sparse-keymap)))
- (define-key map [mode-line mouse-1]
- (lambda (e)
- (interactive "e")
- (with-selected-window (posn-window (event-start e))
- (describe-current-input-method))))
- (define-key map [mode-line mouse-3]
- (lambda (e)
- (interactive "e")
- (with-selected-window (posn-window (event-start e))
- (toggle-input-method nil :interactive))))
- map))
- 'mouse-face 'mode-line-highlight))))
+ (+modeline-spacer nil spacer
+ (propertize current-input-method-title
+ 'help-echo (format
+ (concat "Current input method: %s\n"
+ "mouse-1: Describe current input method\n"
+ "mouse-3: Toggle input method")
+ current-input-method)
+ 'local-map (purecopy
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1]
+ (lambda (e)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start e))
+ (describe-current-input-method))))
+ (define-key map [mode-line mouse-3]
+ (lambda (e)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start e))
+ (toggle-input-method nil :interactive))))
+ map))
+ 'mouse-face 'mode-line-highlight))))
(defface +modeline-kmacro-indicator '((t :foreground "Firebrick"))
"Face for the kmacro indicator in the modeline.")
@@ -450,20 +451,20 @@ to a function in the current buffer, call that function instead."
(defun +modeline-kmacro-indicator (&optional spacer)
"Display an indicator when recording a kmacro."
(when defining-kbd-macro
- (+modeline-spacer nil nil
- (propertize "●"
- 'face '+modeline-kmacro-indicator
- 'help-echo (format (concat "Defining a macro\n"
- "Current step: %d\n"
- "mouse-1: Stop recording")
- kmacro-counter)
- 'local-map (purecopy (simple-modeline-make-mouse-map
- 'mouse-1 (lambda (e)
- (interactive "e")
- (with-selected-window
- (posn-window (event-start e))
- (kmacro-end-macro nil)))))
- 'mouse-face 'mode-line-highlight))))
+ (+modeline-spacer nil spacer
+ (propertize "●"
+ 'face '+modeline-kmacro-indicator
+ 'help-echo (format (concat "Defining a macro\n"
+ "Current step: %d\n"
+ "mouse-1: Stop recording")
+ kmacro-counter)
+ 'local-map (purecopy (simple-modeline-make-mouse-map
+ 'mouse-1 (lambda (e)
+ (interactive "e")
+ (with-selected-window
+ (posn-window (event-start e))
+ (kmacro-end-macro nil)))))
+ 'mouse-face 'mode-line-highlight))))
(provide '+modeline)
;;; +modeline.el ends here
--
cgit 1.4.1-21-gabe81