488 lines
21 KiB
EmacsLisp
488 lines
21 KiB
EmacsLisp
;;; +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
|