path: root/lisp/+modeline.el

;;; +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