Add +modeline-spacer

This commit is contained in:
Case Duckworth 2022-05-10 08:33:05 -05:00
parent 222a20c7c1
commit 40c8fe07fa
1 changed files with 103 additions and 69 deletions

View File

@ -55,6 +55,22 @@ This function makes a lambda, so you can throw it straight into
(push +modeline-default-spacer result-list))
(nreverse result-list)))))
(defun +modeline-spacer (&optional n spacer &rest strings)
"Make an N-length SPACER, or prepend SPACER to STRINGS.
When called with no arguments, insert `+modeline-default-spacer'.
N will repeat SPACER N times, and defaults to 1. SPACER defaults
to `+modeline-default-spacer', but can be any string. STRINGS
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)))
r)
(dotimes (_ n) (push spacer r))
(apply #'concat (apply #'concat r) strings)))
;;; Modeline segments
(defun +modeline-sanitize-string (string)
@ -80,26 +96,26 @@ 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)))))
(concat (or spacer +modeline-default-spacer)
(if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
(funcall +modeline-buffer-position)
(propertize (cond
((ignore-errors
(and (> +modeline-buffer-name-max-length 0)
(< +modeline-buffer-name-max-length 1)))
(truncate-string-to-width bufname
(* (window-total-width)
+modeline-buffer-name-max-length)
nil nil t))
((ignore-errors
(> +modeline-buffer-name-max-length 1))
(truncate-string-to-width bufname
+modeline-buffer-name-max-length
nil nil t))
(t bufname))
'help-echo (or (buffer-file-name)
(buffer-name))
'mouse-face 'mode-line-highlight)))))
(+modeline-spacer nil nil
(if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
(funcall +modeline-buffer-position)
(propertize (cond
((ignore-errors
(and (> +modeline-buffer-name-max-length 0)
(< +modeline-buffer-name-max-length 1)))
(truncate-string-to-width bufname
(* (window-total-width)
+modeline-buffer-name-max-length)
nil nil t))
((ignore-errors
(> +modeline-buffer-name-max-length 1))
(truncate-string-to-width bufname
+modeline-buffer-name-max-length
nil nil t))
(t bufname))
'help-echo (or (buffer-file-name)
(buffer-name))
'mouse-face 'mode-line-highlight)))))
(defcustom +modeline-minions-icon "&"
"The \"icon\" for `+modeline-minions' button."
@ -107,25 +123,44 @@ and appended with `truncate-string-ellipsis'."
(defun +modeline-minions (&optional spacer)
"Display a button for `minions-minor-modes-menu'."
(concat (or spacer +modeline-default-spacer)
(propertize
+modeline-minions-icon
'help-echo "Minor modes menu\nmouse-1: show menu."
'local-map (purecopy (simple-modeline-make-mouse-map
'mouse-1
(lambda (event)
(interactive "e")
(with-selected-window
(posn-window (event-start event))
(minions-minor-modes-menu)))))
'mouse-face 'mode-line-highlight)))
(+modeline-spacer nil nil
(propertize
+modeline-minions-icon
'help-echo "Minor modes menu\nmouse-1: show menu."
'local-map (purecopy (simple-modeline-make-mouse-map
'mouse-1
(lambda (event)
(interactive "e")
(with-selected-window
(posn-window (event-start event))
(minions-minor-modes-menu)))))
'mouse-face 'mode-line-highlight)))
(defcustom +modeline-major-mode-faces '((text-mode . font-lock-string-face)
(prog-mode . font-lock-keyword-face)
(t . font-lock-warning-face))
"Mode->face mapping for `+modeline-major-mode'.
If the current mode is derived from the car of a cell, the face
in the cdr will be applied to the major-mode in the mode line."
:type '(alist :key-type function
:value-type face))
(defun +modeline-major-mode (&optional spacer)
"Display the current `major-mode'."
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
"("
(propertize ;; (+string-truncate (format-mode-line mode-name) 16)
(format-mode-line mode-name)
'face 'font-lock-keyword-face
'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
@ -138,7 +173,8 @@ and appended with `truncate-string-ellipsis'."
"mouse-1: show menu"
"mouse-2: describe mode"
"mouse-3: display minor modes")
'mouse-face 'mode-line-highlight)))
'mouse-face 'mode-line-highlight)
")"))
(defcustom +modeline-modified-icon-alist '((ephemeral . "*")
(readonly . "=")
@ -180,7 +216,7 @@ The order of elements matters: whichever one matches first is applied."
('t t)
(_ nil))
(throw :icon cell))))))
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(propertize (or (cdr-safe icon) "")
'help-echo (format "Buffer \"%s\" is %s."
(buffer-name)
@ -192,7 +228,7 @@ The order of elements matters: whichever one matches first is applied."
(defun +modeline-narrowed (&optional spacer)
"Display an indication that the buffer is narrowed."
(when (buffer-narrowed-p)
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(propertize "N"
'help-echo (format "%s\n%s"
"Buffer is narrowed."
@ -205,7 +241,7 @@ The order of elements matters: whichever one matches first is applied."
(defun +modeline-reading-mode (&optional spacer)
"Display an indication that the buffer is in `reading-mode'."
(when reading-mode
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(propertize
(concat "R" (when (bound-and-true-p +eww-readable-p) "w"))
'help-echo (format "%s\n%s"
@ -243,7 +279,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 (concat (or spacer +modeline-default-spacer)
;; (propertize (+modeline-spacer nil nil
;; (cond
;; ((+modeline--buffer-contained-in-window-p) "All")
;; ((= (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."
;; ;; TODO: add scroll-up and scroll-down bindings.
;; ))
(let ((perc (format-mode-line '(-3 "%p"))))
(concat (or spacer +modeline-default-spacer)
perc
(unless (seq-some (lambda (s) (string= perc s))
'("Top" "Bot" "All"))
"%%%%")
" "))))
(+modeline-spacer nil nil
(pcase perc
((or "Top" "Bot" "All") perc)
(_ (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 (concat (or spacer +modeline-default-spacer)
(propertize (+modeline-spacer nil nil
(cond
((+modeline--buffer-contained-in-window-p) "")
((= perc 0) "")
@ -302,23 +336,23 @@ The order of elements matters: whichever one matches first is applied."
(defun +modeline-line (&optional spacer)
(when line-number-mode
(concat (or spacer +modeline-default-spacer) "%2l")))
(+modeline-spacer nil nil "%2l")))
(defun +modeline-column (&optional spacer)
(when column-number-mode
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(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."
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(+modeline-line "")
"|"
(+modeline-column "")))
(defcustom +modeline-position-function nil
"Function to use instead of `+modeline-position' in modeline."
:type '(choice (const :tag "None" nil)
:type '(choice (const :tag "Default" nil)
function)
:local t)
@ -327,17 +361,17 @@ 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."
(concat (or spacer +modeline-default-spacer)
(if +modeline-position-function
(funcall +modeline-position-function)
(concat (+modeline-region)
(+modeline-line-column)))))
(+modeline-spacer nil nil
(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)))
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))
""))
@ -348,7 +382,7 @@ to a function in the current buffer, call that function instead."
(defun +modeline-anzu (&optional spacer)
"Display `anzu--update-mode-line'."
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(anzu--update-mode-line)))
(defun +modeline-text-scale (&optional spacer)
@ -364,13 +398,13 @@ 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)
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(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)
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(propertize "Ω"
'help-echo (concat "God mode is active."
"\nmouse-1: exit God mode.")
@ -388,7 +422,7 @@ to a function in the current buffer, call that function instead."
(defun +modeline-input-method (&optional spacer)
"Display which input method is active."
(when current-input-method
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(propertize current-input-method-title
'help-echo (format
(concat "Current input method: %s\n"
@ -398,15 +432,15 @@ to a function in the current buffer, call that function instead."
'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))))
(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))))
(lambda (e)
(interactive "e")
(with-selected-window (posn-window (event-start e))
(toggle-input-method nil :interactive))))
map))
'mouse-face 'mode-line-highlight))))
@ -416,7 +450,7 @@ 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
(concat (or spacer +modeline-default-spacer)
(+modeline-spacer nil nil
(propertize ""
'face '+modeline-kmacro-indicator
'help-echo (format (concat "Defining a macro\n"