From aab5bfd074e57d06a79e39d7c7c4760e1f385a06 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 17 Oct 2022 21:41:28 -0500 Subject: Bankruptcy 9 --- lisp/+modeline.el | 488 ------------------------------------------------------ 1 file changed, 488 deletions(-) delete mode 100644 lisp/+modeline.el (limited to 'lisp/+modeline.el') diff --git a/lisp/+modeline.el b/lisp/+modeline.el deleted file mode 100644 index c6e8463..0000000 --- a/lisp/+modeline.el +++ /dev/null @@ -1,488 +0,0 @@ -;;; +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 'actually-selected-window) -(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 functional modeline SEGMENTS. -Each segment in SEGMENTS is a function returning a mode-line -construct. - -Segments are separated using SEPARATOR, which defaults to -`+modeline-default-spacer'. Only segments that evaluate to a -non-zero-length string will be separated, for a cleaner look. - -This function returns a lambda that should be `:eval'd or -`funcall'd in a mode-line context." - (let ((separator (or separator +modeline-default-spacer))) - (lambda () - (let (this-sep result) - (dolist (segment segments) - (let ((segstr (funcall segment this-sep))) - (when (and segstr - (not (equal segstr ""))) - (push segstr result) - (setq this-sep separator)))) - (apply #'concat - (nreverse result)))))) - -(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) '("")) - ((equal strings '("")) nil) - ((atom strings) (list strings)) - (t strings))) - r) - (when strings (dotimes (_ n) (push spacer r))) - (apply #'concat (apply #'concat r) strings))) - -;;; 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"))) - -(defcustom +modeline-buffer-position nil - "What to put in the `+modeline-buffer-name' position." - :type 'function - :local t) - -(defun +modeline-buffer-name (&optional spacer) ; gonsie - "Display the buffer name." - (let ((bufname (string-trim (string-replace "%" "%%%%" (buffer-name))))) - (+modeline-spacer nil 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))))) - -(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'." - (+modeline-spacer nil 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))) - -(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)) - -(defface +modeline-major-mode-face nil - "Face for modeline major-mode.") - -(defun +modeline-major-mode (&optional spacer) - "Display the current `major-mode'." - (+modeline-spacer nil spacer - "(" - (propertize ;; (+string-truncate (format-mode-line mode-name) 16) - (format-mode-line mode-name) - 'face (when (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)) - '+modeline-major-mode-face) - '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 . "=") - (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)))))) - (+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 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 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 (+modeline-spacer nil 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 '(-2 "%p")))) - (+modeline-spacer nil spacer - "/" - (pcase perc - ("To" "Top") - ("Bo" "Bot") - ("Al" "All") - (_ (format ".%02d" (string-to-number perc)))))))) - -(defun +modeline-file-percentage-ascii-icon (&optional spacer) - (when file-percentage-mode - (+modeline-spacer nil spacer - (let ((perc (format-mode-line '(-2 "%p")))) - (pcase perc - ("To" "/\\") - ("Bo" "\\/") - ("Al" "[]") - (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|")) - (perc (string-to-number perc))) - (aref vec (floor (/ perc 17)))))))))) - -(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 spacer - (cond - ((+modeline--buffer-contained-in-window-p) "111") - ((= perc 0) "000") - ((< perc 20) "001") - ((< perc 40) "010") - ((< perc 60) "011") - ((< perc 80) "100") - ((< perc 100) "101") - ((>= perc 100) "110"))) - '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." - (when (and region-indicator-mode - (region-active-p)) - (+modeline-spacer nil spacer - (propertize (format "%d%s" - (apply '+ (mapcar (lambda (pos) - (- (cdr pos) - (car pos))) - (region-bounds))) - (if (and (< (point) (mark))) "-" "+")) - 'font-lock-face 'font-lock-variable-name-face)))) - -(defun +modeline-line (&optional spacer) - (when line-number-mode - (+modeline-spacer nil spacer - "%3l"))) - -(defun +modeline-column (&optional spacer) - (when column-number-mode - (+modeline-spacer nil spacer - "|" - (if column-number-indicator-zero-based "%2c" "%2C")))) - -(defcustom +modeline-position-function nil - "Function to use instead of `+modeline-position' in modeline." - :type '(choice (const :tag "Default" nil) - function) - :local t) - -(defun +modeline-position (&optional spacer) - "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." - (cond ((functionp +modeline-position-function) - (when-let* ((str (funcall +modeline-position-function))) - (+modeline-spacer nil spacer str))) - (t (funcall (+modeline-concat '(+modeline-region - +modeline-line - +modeline-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 - (when-let ((backend (vc-backend buffer-file-name))) - (+modeline-spacer nil 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'." - (+modeline-spacer nil 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)) - (+modeline-spacer nil spacer - (concat (if (> text-scale-mode-amount 0) "+" "-") - (number-to-string 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) - (+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 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 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 - (+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)))) - -(defface +nyan-mode-line nil - "Face for nyan-cat in mode line.") - -(defun +modeline-nyan-on-focused (&optional spacer) - "Display the cat from `nyan-mode', but only on the focused window." - (require 'nyan-mode) - (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode)) - (actually-selected-window-p)) - (+modeline-spacer nil spacer - (propertize (nyan-create) 'face '+nyan-mode-line)))) - -(provide '+modeline) -;;; +modeline.el ends here -- cgit 1.4.1-21-gabe81