;;; +modeline.el --- my modeline customizations -*- lexical-binding: t; -*- ;;; Commentary: ;; `+modeline.el' is kind of a dumping ground for various ;; modeline-related functions. I probably don't use everything in ;; here. Credit given where possible. ;;; Code: (require '+util) (require 'simple-modeline) (require 'minions) (defgroup +modeline nil "Various customization options for my modeline things." :prefix "+modeline-" :group 'simple-modeline) (defcustom +modeline-default-spacer " " "Default spacer to use for modeline elements. All modeline elements take an optional argument, `spacer', which will default to this string.") ;;; Combinators (defun +modeline-concat (segments &optional separator) "Concatenate multiple `simple-modeline'-style SEGMENTS. SEGMENTS is a list of either modeline segment-functions (see `simple-modeline' functions for an example of types of functions), though it can also contain cons cells of the form (SEGMENT . PREDICATE). Segments are separated from each other using SEPARATOR, which defaults to a \" \". Only segments that evaluate to a non-trivial string (that is, a string not equal to \"\") will be separated, for a cleaner look. This function makes a lambda, so you can throw it straight into `simple-modeline-segments'." (setq separator (or separator +modeline-default-spacer)) (lambda () (apply #'concat (let (this-sep result-list) (dolist (segment segments) (push (funcall (or (car-safe segment) segment) this-sep) result-list) (if (or (cdr-safe segment) (and (car result-list) (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)) (nreverse result-list))))) ;;; Modeline segments (defun +modeline-sanitize-string (string) "Sanitize a string for `format-mode-line'." (when string (string-replace "%" "%%" string))) (defcustom +modeline-buffer-name-max-length 0 "Maximum length of `+modeline-buffer-name'. If > 0 and < 1, use that portion of the window's width. If > 1, use that many characters. If anything else, don't limit. If the buffer name is longer than the max length, it will be shortened and appended with `truncate-string-ellipsis'." :type '(choice (const :tag "No maximum length" 0) (natnum :tag "Number of characters") (float :tag "Fraction of window's width"))) (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) (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." :type 'string) (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))) (defun +modeline-major-mode (&optional spacer) "Display the current `major-mode'." (concat (or spacer +modeline-default-spacer) (propertize ;; (+string-truncate (format-mode-line mode-name) 16) (format-mode-line mode-name) 'face 'font-lock-keyword-face 'keymap mode-line-major-mode-keymap 'help-echo (concat (format-mode-line mode-name) " mode\nmouse-1: show menu.") 'mouse-face 'mode-line-highlight))) (defcustom +modeline-modified-icon-alist '((ephemeral . "*") (readonly . "=") (modified . "+") (special . "~") (t . "-")) "\"Icons\" to display depending on buffer status in modeline. The CAR of each field is one of `readonly', `modified', `special', `ephemeral', or t, and the CDR is a string to display in that mode. `readonly' is true if the buffer is read-only and visiting a file. `modified' is true if the buffer is modified. `special' is true if the buffer is a special-mode or derived buffer. `ephemeral' is true if the buffer is not visiting a file. t is the fall-back, shown when nothing else in the alist applies. The order of elements matters: whichever one matches first is applied." :type '(alist :key-type symbol :value-type string) :options '("readonly" "modified" "special" "t")) (defcustom +modeline-modified-icon-special-modes '(special-mode) "Modes to apply the `special-mode' icon to in the `+modeline-modified'." :type '(repeat function)) (defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified' "Display a color-coded \"icon\" indicator for the buffer's status." (let* ((icon (catch :icon (dolist (cell +modeline-modified-icon-alist) (when (pcase (car cell) ('ephemeral (not (buffer-file-name))) ('readonly buffer-read-only) ('modified (buffer-modified-p)) ('special (apply 'derived-mode-p +modeline-modified-icon-special-modes)) ('t t) (_ nil)) (throw :icon cell)))))) (concat (or spacer +modeline-default-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) (concat (or spacer +modeline-default-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 (concat (or spacer +modeline-default-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)." :init-value t :global t :group 'mode-line) (defun +modeline--percentage () "Return point's progress through current file as a percentage." (let ((tot (count-screen-lines (point-min) (point-max) :ignore-invisible))) (floor (* 100 (/ (float (line-number-at-pos)) tot))))) (defun +modeline--buffer-contained-in-window-p () "Whether the buffer is totally contained within its window." (let ((window-min (save-excursion (move-to-window-line 0) (point))) (window-max (save-excursion (move-to-window-line -1) (point)))) (and (<= window-min (point-min)) (>= window-max (point-max))))) (defun +modeline-file-percentage (&optional spacer) "Display the position in the current file." (when file-percentage-mode ;; (let ((perc (+modeline--percentage))) ;; (propertize (concat (or spacer +modeline-default-spacer) ;; (cond ;; ((+modeline--buffer-contained-in-window-p) "All") ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") ;; ((= (line-number-at-pos) (line-number-at-pos (point-max))) "Bot") ;; ;; Why the 10 %s? Not sure. `format' knocks them ;; ;; down to 5, then `format-mode-line' kills all but ;; ;; two. If I use only 8, the margin is much too ;; ;; large. Something else is obviously going on, but ;; ;; I'm at a loss as to what it could be. ;; (t (format "%d%%%%%%%%%%" perc)))) ;; ;; 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")) "%%%%"))))) (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) (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))))) (define-minor-mode region-indicator-mode "Toggle the region indicator in the mode line." :init-value t :global t :group 'mode-line) (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)) "")) (defun +modeline-line (&optional spacer) (when line-number-mode (concat (or spacer +modeline-default-spacer) "%2l"))) (defun +modeline-column (&optional spacer) (when column-number-mode (concat (or spacer +modeline-default-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." (funcall (+modeline-concat '(+modeline-line +modeline-column) "|"))) (defcustom +modeline-position-function nil "Function to use instead of `+modeline-position' in modeline." :type '(choice (const :tag "None" nil) function) :local t) (defun +modeline-position (&optional _) "Display the current cursor position. 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." (funcall (if +modeline-position-function +modeline-position-function (+modeline-concat '(+modeline-region +modeline-line-column +modeline-file-percentage))))) (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) (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))) "")) (defun +modeline-track (&optional spacer) "Display `tracking-mode' information." (when tracking-mode tracking-mode-line-buffers)) (defun +modeline-anzu (&optional spacer) "Display `anzu--update-mode-line'." (concat (or spacer +modeline-default-spacer) (anzu--update-mode-line))) (defun +modeline-text-scale (&optional spacer) "Display text scaling level." ;; adapted from https://github.com/seagle0128/doom-modeline (when (and (boundp 'text-scale-mode-amount) (/= text-scale-mode-amount 0)) (format (if (> text-scale-mode-amount 0) "%s(%+d)" "%s(%-d)") (or spacer +modeline-default-spacer) text-scale-mode-amount))) (defun +modeline-ace-window-display (&optional spacer) "Display `ace-window-display-mode' information in the modeline." (when (and +ace-window-display-mode ace-window-mode) (concat (or spacer +modeline-default-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) (concat (or spacer +modeline-default-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 (concat (or spacer +modeline-default-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.") (defun +modeline-kmacro-indicator (&optional spacer) "Display an indicator when recording a kmacro." (when defining-kbd-macro (concat (or spacer +modeline-default-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