From 40c8fe07fab9aa7572f448034fc1a7e5119b8e84 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 10 May 2022 08:33:05 -0500 Subject: Add +modeline-spacer --- lisp/+modeline.el | 172 ++++++++++++++++++++++++++++++++---------------------- 1 file 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 (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" -- cgit 1.4.1-21-gabe81