emacs/lisp/+modeline.el

427 lines
20 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 '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")))
(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)))))
(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)))))
(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