ui/modeline: major refactor of +light modeline

modules/ui/modeline/+light.el

@@ -1,36 +1,95 @@
 ;;; ui/modeline/+default.el -*- lexical-binding: t; -*-
 
-(defvar +modeline-height 33)
-(defvar +modeline-bar-width 3)
-
 ;; This is a slimmed down version of `doom-modeline' that manipulates
-;; `mode-line-format' directly. Its purpose is to be a *significantly* lighter
+;; `mode-line-format' directly. Its purpose is to be truer to the original goal
-;; modeline for doom. Upstream has generalized and grown too much so I've
+;; of Doom's modeline: to be more performant and minimalistic alternative to
-;; returned to the roots.
+;; other modeline packages and to be abstraction-light. Too much abstraction is
+;; too much magic.
 ;;
-;; TODO Refactor me
+;; Warning: this is still a WIP!
 
-(defface +modeline-success-highlight '((t (:inherit mode-line-highlight)))
+(defun +modeline--set-var-and-refresh-bars-fn (&optional symbol value)
-  "TODO")
+  (when symbol
+    (set-default symbol value))
+  (when doom-init-time
+    (+modeline-refresh-bars-h)))
+
+
+;;
+;;; Variables
+
+(defcustom +modeline-height 31
+  "The height of the modeline.
+
+This is enforced by the xpm bitmap bar in `+modeline-bar'. Without it (and in
+the terminal), this variable does nothing.
+
+Use `setq!' to adjust this variable live, as it will trigger an refresh of the
+bars in the modeline. `setq' will not."
+  :type 'integer
+  :set #'+modeline--set-var-and-refresh-bars-fn)
+
+(defcustom +modeline-bar-width 3
+  "The width of the bar in the modeline.
+
+If nil, the bar will be made transparent and 1 pixel wide, as to be invisible,
+but without sacrificing its ability to enforce `+modeline-height'.
+
+Use `setq!' to adjust this variable live, as it will trigger an refresh of the
+bars in the modeline. `setq' will not."
+  :type 'integer
+  :set #'+modeline--set-var-and-refresh-bars-fn)
+
+(defvar +modeline-format-alist ()
+  "An alist of modeline formats defined with `def-modeline!'.
+
+Each entry's CAR is the name and CDR is a cons cell whose CAR is the left-hand
+side of the modeline, and whose CDR is the right-hand side.")
+
+
+;;
+;;; Faces
+
+(defface +modeline-bar '((t (:inherit highlight)))
+  "Face used for left-most bar on the mode-line of an active window.")
+
+(defface +modeline-bar-inactive '((t (:inherit mode-line-inactive)))
+  "Face used for left-most bar on the mode-line of an inactive window.")
+
+(defface +modeline-highlight
+  '((t (:inherit mode-line-highlight)))
+  "Face used for highlighted modeline panels (like search counts).")
+
+(defface +modeline-alternate-highlight
+  '((t (:inherit mode-line-highlight)))
+  "Alternative face used for highlighted modeline panels (like search counts).")
+
+
+;;
+;;; Helpers
 
 (defvar +modeline--redisplayed-p nil)
 (defadvice! modeline-recalculate-height-a (&optional _force &rest _ignored)
+  "Ensure that window resizing functions take modeline height into account."
   :before '(fit-window-to-buffer resize-temp-buffer-window)
   (unless +modeline--redisplayed-p
     (setq-local +modeline--redisplayed-p t)
     (redisplay t)))
 
 ;;; `active'
-(defvar selected-window (selected-window))
+(defvar +modeline--active-window (selected-window))
-(defun active () (eq (selected-window) selected-window))
+
+(defun +modeline-active ()
+  "Return non-nil if the selected window has an active modeline."
+  (eq (selected-window) +modeline--active-window))
+
 (add-hook! 'pre-redisplay-functions
-  (defun set-selected-window (&rest _)
+  (defun +modeline-set-selected-window-h (&rest _)
-    "Set the variable `selected-window' appropriately."
+    "Track the active modeline's window in `+modeline--active-window'."
     (let ((win (selected-window)))
       (unless (minibuffer-window-active-p win)
-        (setq selected-window (frame-selected-window))))))
+        (setq +modeline--active-window (frame-selected-window))))))
 
-;;; Helpers
 (defun +modeline--make-xpm (color width height)
   "Create an XPM bitmap via COLOR, WIDTH and HEIGHT. Inspired by `powerline''s `pl/+modeline--make-xpm'."
   (propertize
@@ -67,48 +126,93 @@
                       (propertize label 'face face))
               'help-echo help-echo))
 
+(defun set-modeline! (name &optional default)
+  "Set the modeline to NAME.
+If DEFAULT is non-nil, apply to all future buffers. Modelines are defined with
+`def-modeline!'."
+  (if-let (format (assq name +modeline-format-alist))
+      (cl-destructuring-bind (lhs . rhs) (cdr format)
+        (if default
+            (setq-default +modeline-format-left lhs
+                          +modeline-format-right rhs)
+          (setq +modeline-format-left lhs
+                +modeline-format-right rhs)))
+    (error "Could not find %S modeline format" name)))
+
+(defun set-modeline-hook! (hooks name)
+  "Set the modeline to NAME on HOOKS.
+See `def-modeline!' on how modelines are defined."
+  (let ((fn (intern (format "+modeline-set-%s-format-h" name))))
+    (dolist (hook (doom-enlist hooks))
+      (add-hook hook fn))))
+
+(defmacro def-modeline! (name lhs rhs)
+  "Define a modeline format by NAME.
+LHS and RHS are the formats representing the left and right hand side of the
+mode-line, respectively. See the variable `format-mode-line' for details on what
+LHS and RHS will accept."
+  `(progn
+     (setf (alist-get ',name +modeline-format-alist)
+           (cons ,lhs ,rhs))
+     (defun ,(intern (format "+modeline-set-%s-format-h" name)) (&rest _)
+       "TODO"
+       (set-modeline! ',name))))
+
+(defmacro def-modeline-var! (name body &optional docstring &rest plist)
+  "TODO"
+  (unless (stringp docstring)
+    (push docstring plist)
+    (setq docstring nil))
+  `(progn
+     (,(if (plist-get plist :local) 'defvar-local 'defvar)
+      ,name ,body ,docstring)
+     (put ',name 'risky-local-variable t)))
+
 
 ;;
 ;;; Segments
 
+(def-modeline-var! +modeline-format-left nil
+  "The left-hand side of the modeline."
+  :local t)
+
+(def-modeline-var! +modeline-format-right nil
+  "The right-hand side of the modeline."
+  :local t)
+
+
 ;;; `+modeline-bar'
-(defvar +modeline-bar "")
+(progn
-(defvar +modeline-inactive-bar "")
+  (def-modeline-var! +modeline-bar "")
-(put '+modeline-bar 'risky-local-variable t)
+  (def-modeline-var! +modeline-inactive-bar "")
-(put '+modeline-inactive-bar 'risky-local-variable t)
 
-(defface +modeline-bar '((t (:inherit highlight)))
+  (add-hook! '(doom-init-ui-hook doom-load-theme-hook) :append
-  "The face used for the left-most bar on the mode-line of an active window.")
-
-(defface +modeline-bar-inactive '((t (:inherit mode-line-inactive)))
-  "The face used for the left-most bar on the mode-line of an inactive window.")
-
-(add-hook! 'doom-load-theme-hook
     (defun +modeline-refresh-bars-h ()
-    (let ((width (or +modeline-bar-width 1)))
+      (let ((width (or +modeline-bar-width 1))
+            (height (max +modeline-height 0)))
         (setq +modeline-bar
-            (+modeline--make-xpm (if +modeline-bar-width (face-background '+modeline-bar nil 'inherit))
+              (+modeline--make-xpm
-                                 width (max +modeline-height (frame-char-height)))
+               (and +modeline-bar-width
+                    (face-background '+modeline-bar nil 'inherit))
+               width height)
               +modeline-inactive-bar
-            (+modeline--make-xpm (if +modeline-bar-width (face-background '+modeline-bar-inactive nil 'inherit))
+              (+modeline--make-xpm
-                                 width (max +modeline-height (frame-char-height)))))))
+               (and +modeline-bar-width
+                    (face-background '+modeline-bar-inactive nil 'inherit))
+               width height)))))
 
-(defvar +modeline--old-height nil)
+  (add-hook! 'doom-change-font-size-hook
-(defun +modeline-adjust-height-h ()
+    (defun +modeline-adjust-height-h ()
-  (unless +modeline--old-height
+      (defvar +modeline--old-height +modeline-height)
-    (setq +modeline--old-height +modeline-height))
       (let ((default-height +modeline--old-height)
             (scale (or (frame-parameter nil 'font-scale) 0)))
+        (setq +modeline-height
               (if (> scale 0)
-        (let* ((font-size (string-to-number
+                  (+ default-height (* (or (frame-parameter nil 'font-scale) 1)
-                           (aref (doom--font-name (frame-parameter nil 'font)
+                                       doom-font-increment))
-                                                  (selected-frame))
+                default-height))
-                                 xlfd-regexp-pixelsize-subnum)))
+        (when doom-init-time
-               (scale (frame-parameter nil 'font-scale)))
+          (+modeline-refresh-bars-h))))))
-          (setq +modeline-height (+ default-height (* scale doom-font-increment))))
-      (setq +modeline-height default-height))
-    (setq +modeline-bar (+modeline--make-xpm nil 1 +modeline-height))))
-(add-hook 'doom-change-font-size-hook #'+modeline-adjust-height-h)
 
 
 ;;; `+modeline-matches'
@@ -118,19 +222,18 @@
     :config
     ;; anzu and evil-anzu expose current/total state that can be displayed in the
     ;; mode-line.
-    (defun doom-modeline-fix-anzu-count (positions here)
+    (defadvice! +modeline-fix-anzu-count-a (positions here)
       "Calulate anzu counts via POSITIONS and HERE."
+      :override #'anzu--where-is-here
       (cl-loop for (start . end) in positions
                collect t into before
                when (and (>= here start) (<= here end))
                return (length before)
                finally return 0))
 
-    (advice-add #'anzu--where-is-here :override #'doom-modeline-fix-anzu-count)
-
     (setq anzu-cons-mode-line-p nil) ; manage modeline segment ourselves
     ;; Ensure anzu state is cleared when searches & iedit are done
-    (add-hook 'isearch-mode-end-hook #'anzu--reset-status t)
+    (add-hook 'isearch-mode-end-hook #'anzu--reset-status 'append)
     (add-hook 'iedit-mode-end-hook #'anzu--reset-status)
     (advice-add #'evil-force-normal-state :before #'anzu--reset-status)
     ;; Fix matches segment mirroring across all buffers
@@ -160,7 +263,7 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
                 (format " %s+ " total))
                (t
                 (format " %s/%d " here total))))
-       'face (if (active) 'mode-line-highlight))))
+       'face (if (+modeline-active) '+modeline-highlight))))
 
   (defun +modeline--evil-substitute ()
     "Show number of matches for evil-ex substitutions and highlights in real time."
@@ -176,23 +279,23 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
          (if pattern
              (format " %s matches " (how-many pattern (car range) (cdr range)))
            " - "))
-       'face (if (active) 'mode-line-highlight))))
+       'face (if (+modeline-active) '+modeline-highlight))))
 
-  (defun +mode-line--multiple-cursors ()
+  (defun +modeline--multiple-cursors ()
     "Show the number of multiple cursors."
     (when (bound-and-true-p evil-mc-cursor-list)
       (let ((count (length evil-mc-cursor-list)))
         (when (> count 0)
-          (let ((face (cond ((not (active)) 'mode-line-inactive)
+          (let ((face (cond ((not (+modeline-active)) 'mode-line-inactive)
-                            (evil-mc-frozen 'mode-line-highlight)
+                            (evil-mc-frozen '+modeline-highlight)
-                            ('+modeline-success-highlight))))
+                            ('+modeline-alternate-highlight))))
             (concat (propertize " " 'face face)
                     (all-the-icons-faicon "i-cursor" :face face :v-adjust -0.0575)
                     (propertize " " 'face `(:inherit (variable-pitch ,face)))
                     (propertize (format "%d " count)
                                 'face face)))))))
 
-  (defun mode-line--overlay< (a b)
+  (defun +modeline--overlay< (a b)
     "Sort overlay A and B."
     (< (overlay-start a) (overlay-start b)))
 
@@ -211,55 +314,53 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
                  (if this-oc
                      (- length
                         (length (memq this-oc (sort (append iedit-occurrences-overlays nil)
-                                                    #'mode-line--overlay<)))
+                                                    #'+modeline--overlay<)))
                         -1)
                    "-")
                  length))
-       'face (if (active) 'mode-line-highlight))))
+       'face (if (+modeline-active) '+modeline-highlight))))
 
   (defun +modeline--macro-recording ()
     "Display current Emacs or evil macro being recorded."
-    (when (and (active)
+    (when (and (+modeline-active)
                (or defining-kbd-macro
                    executing-kbd-macro))
-      (let ((sep (propertize " " 'face 'mode-line-highlight)))
+      (let ((sep (propertize " " 'face '+modeline-highlight)))
         (concat sep
                 (propertize (if (bound-and-true-p evil-this-macro)
                                 (char-to-string evil-this-macro)
                               "Macro")
-                            'face 'mode-line-highlight)
+                            'face '+modeline-highlight)
                 sep
                 (all-the-icons-octicon "triangle-right"
-                                       :face 'mode-line-highlight
+                                       :face '+modeline-highlight
                                        :v-adjust -0.05)
                 sep))))
 
-  (defvar +modeline-matches
+  (def-modeline-var! +modeline-matches
     '(:eval
       (let ((meta (concat (+modeline--macro-recording)
                           (+modeline--anzu)
                           (+modeline--evil-substitute)
                           (+modeline--iedit)
-                          (+mode-line--multiple-cursors))))
+                          (+modeline--multiple-cursors))))
         (or (and (not (equal meta "")) meta)
-            " %I "))))
+            " %I ")))))
-  (put '+modeline-matches 'risky-local-variable t))
 
 
 ;;; `+modeline-modes'
-(defvar +modeline-modes ; remove minor modes
+(def-modeline-var! +modeline-modes ; remove minor modes
   '(""
     (:propertize mode-name
                  face bold
-                mouse-face mode-line-highlight)
+                 mouse-face +modeline-highlight)
     mode-line-process
     "%n"
-   "%]"
     " "))
 
 
 ;;; `+modeline-buffer-identification'
-(defconst +modeline-buffer-identification ; slightly more informative buffer id
+(def-modeline-var! +modeline-buffer-identification ; slightly more informative buffer id
   '((:eval
      (propertize
       (let ((buffer-file-name (buffer-file-name (buffer-base-buffer))))
@@ -270,23 +371,25 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
             "%b"))
       'face (cond ((buffer-modified-p)
                    '(error bold mode-line-buffer-id))
-                  ((active)
+                  ((+modeline-active)
                    'mode-line-buffer-id))
       'help-echo buffer-file-name))
     (buffer-read-only (:propertize " RO" face warning))))
 
 
 ;;; `+modeline-position'
-(defvar +modeline-position '("  %l:%C %p  "))
+(def-modeline-var! +modeline-position '("  %l:%C %p  "))
 
 
 ;;; `+modeline-checker'
-(defvar-local +modeline-checker nil
+(progn
-  "Displays color-coded error status in the current buffer with pretty
+  (def-modeline-var! +modeline-checker nil
-icons.")
+    "Displays color-coded error status & icon for the current buffer."
-(put '+modeline-checker 'risky-local-variable t)
+    :local t)
 
-(defun +modeline-checker-update (&optional status)
+  (add-hook! '(flycheck-status-changed-functions
+               flycheck-mode-hook)
+    (defun +modeline-checker-update (&optional status)
       "Update flycheck text via STATUS."
       (setq +modeline-checker
             (pcase status
@@ -309,30 +412,17 @@ icons.")
               (`running     (+modeline-format-icon "access_time" "*" 'font-lock-comment-face "Running..."))
               (`errored     (+modeline-format-icon "sim_card_alert" "!" 'error "Errored!"))
               (`interrupted (+modeline-format-icon "pause" "!" 'font-lock-comment-face "Interrupted"))
-          (`suspicious  (+modeline-format-icon "priority_high" "!" 'error "Suspicious")))))
+              (`suspicious  (+modeline-format-icon "priority_high" "!" 'error "Suspicious")))))))
-(add-hook 'flycheck-status-changed-functions #'+modeline-checker-update)
-(add-hook 'flycheck-mode-hook #'+modeline-checker-update)
 
 
 ;;; `+modeline-selection-info'
-(defsubst doom-modeline-column (pos)
+(progn
+  (defsubst +modeline--column (pos)
     "Get the column of the position `POS'."
     (save-excursion (goto-char pos)
                     (current-column)))
 
-(defun add-selection-segment ()
+  (def-modeline-var! +modeline-selection-info
-  (add-to-list '+modeline-format-left '+modeline-selection-info 'append))
-(defun remove-selection-segment ()
-  (delq! '+modeline-selection-info +modeline-format-left))
-
-(if (featurep 'evil)
-    (progn
-      (add-hook 'evil-visual-state-entry-hook #'add-selection-segment)
-      (add-hook 'evil-visual-state-exit-hook #'remove-selection-segment))
-  (add-hook 'activate-mark-hook #'add-selection-segment)
-  (add-hook 'deactivate-mark-hook #'remove-selection-segment))
-
-(defvar +modeline-selection-info
     '(:eval
       (when (or mark-active
                 (and (bound-and-true-p evil-local-mode)
@@ -347,8 +437,8 @@ icons.")
                      (cond ((or (bound-and-true-p rectangle-mark-mode)
                                 (and (bound-and-true-p evil-visual-selection)
                                      (eq 'block evil-visual-selection)))
-                          (let ((cols (abs (- (doom-modeline-column end)
+                            (let ((cols (abs (- (+modeline--column end)
-                                              (doom-modeline-column beg)))))
+                                                (+modeline--column beg)))))
                               (format "%dx%dB" lines cols)))
                            ((and (bound-and-true-p evil-visual-selection)
                                  (eq evil-visual-selection 'line))
@@ -359,14 +449,25 @@ icons.")
                      (when (derived-mode-p 'text-mode)
                        (format " %dW" (count-words beg end)))
                      " "))
-         'face (if (active) 'success)))))
+           'face (if (+modeline-active) 'success)))))
     "Information about the current selection, such as how many characters and
 lines are selected, or the NxM dimensions of a block selection.")
-(put '+modeline-selection-info 'risky-local-variable t)
+
+  (defun +modeline-add-selection-segment-h ()
+    (add-to-list '+modeline-format-left '+modeline-selection-info 'append))
+  (defun +modeline-remove-selection-segment-h ()
+    (delq! '+modeline-selection-info +modeline-format-left))
+
+  (if (featurep 'evil)
+      (progn
+        (add-hook 'evil-visual-state-entry-hook #'+modeline-add-selection-segment-h)
+        (add-hook 'evil-visual-state-exit-hook #'+modeline-remove-selection-segment-h))
+    (add-hook 'activate-mark-hook #'+modeline-add-selection-segment-h)
+    (add-hook 'deactivate-mark-hook #'+modeline-remove-selection-segment-h)))
 
 
 ;;; `+modeline-encoding'
-(defconst +modeline-encoding
+(def-modeline-var! +modeline-encoding
   '(:eval
     (concat (pcase (coding-system-eol-type buffer-file-coding-system)
               (0 " LF ")
@@ -378,29 +479,18 @@ lines are selected, or the NxM dimensions of a block selection.")
                   "UTF-8"
                 (upcase (symbol-name (plist-get sys :name)))))
             "  ")))
-(put '+modeline-encoding 'risky-local-variable t)
 
 
 ;;
-;;; Setup
+;;; Default modeline
 
-(defvar-local +modeline-format-left nil)
+(def-modeline! :main
-(put '+modeline-format-left 'risky-local-variable t)
-
-
-(defvar-local +modeline-format-right nil)
-(put '+modeline-format-right 'risky-local-variable t)
-
-(setq-default
- +modeline-format-left
   '(""
     +modeline-matches
     " "
     +modeline-buffer-identification
     +modeline-position)
-
+  '(""
- +modeline-format-right
- `(""
     mode-line-misc-info
     +modeline-modes
     (vc-mode ("  "
@@ -408,9 +498,34 @@ lines are selected, or the NxM dimensions of a block selection.")
               vc-mode " "))
     " "
     +modeline-encoding
-   (+modeline-checker ("" +modeline-checker "   ")))
+    (+modeline-checker ("" +modeline-checker "   "))))
 
- ;;
+(def-modeline! project
+  `(" "
+    ,(all-the-icons-octicon
+      "file-directory"
+      :face 'bold
+      :v-adjust -0.05
+      :height 1.25)
+    (:propertize (" " (:eval (abbreviate-file-name default-directory)))
+                 face bold))
+  '("" +modeline-modes))
+
+(def-modeline! special
+  '("" +modeline-matches
+    " " +modeline-buffer-identification)
+  '("" +modeline-modes))
+
+;; TODO (def-modeline! pdf ...)
+;; TODO (def-modeline! helm ...)
+
+
+;;
+;;; Bootstrap
+
+(size-indication-mode +1) ; filesize in modeline
+
+(setq-default
  mode-line-format
  '(""
    +modeline-bar
@@ -423,54 +538,21 @@ lines are selected, or the NxM dimensions of a block selection.")
                            ,(string-width
                              (format-mode-line '("" +modeline-format-right))))))))
    +modeline-format-right))
-
 (with-current-buffer "*Messages*"
   (setq mode-line-format (default-value 'mode-line-format)))
 
 
-;;
-;;; Other modelines
-
-(defun set-project-modeline ()
-  (setq +modeline-format-left
-        `(" "
-          ,(all-the-icons-octicon
-            "file-directory"
-            :face 'bold
-            :v-adjust -0.05
-            :height 1.25)
-          (:propertize (" " (:eval (abbreviate-file-name default-directory)))
-                       face bold))
-        +modeline-format-right
-        '("" +modeline-modes)))
-
-(defun set-special-modeline ()
-  (setq +modeline-format-left
-        '(""
-          +modeline-matches
-          " "
-          +modeline-buffer-identification)
-        +modeline-format-right
-        '("" +modeline-modes)))
-
-(defun set-pdf-modeline ()) ; TODO `set-pdf-modeline'
-
-
-;;
-;;; Bootstrap
-
-(size-indication-mode +1) ; filesize in modeline
-(add-hook '+doom-dashboard-mode-hook #'set-project-modeline)
-(add-hook 'doom-load-theme-hook #'+modeline-refresh-bars-h)
-
 ;; Other modes
-(defun set-modeline-in-magit ()
+(set-modeline! :main 'default)
-  (if (eq major-mode 'magit-status-mode)
+(set-modeline-hook! '+doom-dashboard-mode-hook 'project)
-      (set-project-modeline)
+(set-modeline-hook! 'pdf-tools-enabled-hook 'pdf)
-    (hide-mode-line-mode)))
+(set-modeline-hook! '(special-mode-hook
-(add-hook 'magit-mode-hook #'set-modeline-in-magit)
+                      image-mode-hook
+                      circe-mode-hook)
+                    'special)
 
-(add-hook 'special-mode-hook #'set-special-modeline)
+(add-hook! 'magit-mode-hook
-(add-hook 'image-mode-hook #'set-special-modeline)
+  (defun +modeline-init-project-or-hide-h ()
-(add-hook 'circe-mode-hook #'set-special-modeline)
+    (if (eq major-mode 'magit-status-mode)
-(add-hook 'pdf-tools-enabled-hook #'set-pdf-modeline)
+        (set-modeline! 'project)
+      (hide-mode-line-mode +1))))