emacs: rul-modeline (heavily based on prot-modeline)

2 files changed, 160 insertions, 0 deletions

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 4b70e02..795ed4e 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -154,6 +154,7 @@
 (require 'rul-completion)
 (require 'rul-dart)
 (require 'rul-elfeed)
+(require 'rul-modeline)
 (require 'rul-org)
 (require 'rul-org-roam)
 (require 'rul-wm)
diff --git a/.emacs.d/rul-lisp/packages/rul-modeline.el b/.emacs.d/rul-lisp/packages/rul-modeline.el
new file mode 100644
index 0000000..264719e
--- /dev/null
+++ b/.emacs.d/rul-lisp/packages/rul-modeline.el
@@ -0,0 +1,159 @@
+;; Most of the code in this file is based on:
+;;   https://git.sr.ht/~protesilaos/dotfiles/tree/cf26bc34/item/emacs/.emacs.d/prot-lisp/prot-modeline.el
+;;
+;; All Kudos to Prot.
+
+;;;; Faces
+(defface rul-modeline-indicator-red
+  '((default :inherit bold)
+    (((class color) (min-colors 88) (background light))
+     :foreground "#880000")
+    (((class color) (min-colors 88) (background dark))
+     :foreground "#ff9f9f")
+    (t :foreground "red"))
+  "Face for modeline indicators.")
+
+;;;; Common helper functions
+(defcustom rul-modeline-string-truncate-length 9
+  "String length after which truncation should be done in small windows."
+  :type 'natnum)
+
+(defun rul-modeline--string-truncate-p (str)
+  "Return non-nil if STR should be truncated."
+  (and (< (window-total-width) split-width-threshold)
+       (> (length str) rul-modeline-string-truncate-length)
+       (not (one-window-p :no-minibuffer))))
+
+(defun rul-modeline-string-truncate (str)
+  "Return truncated STR, if appropriate, else return STR.
+Truncation is done up to `rul-modeline-string-truncate-length'."
+  (if (rul-modeline--string-truncate-p str)
+      (concat (substring str 0 rul-modeline-string-truncate-length) "...")
+    str))
+
+;;;; Major mode
+(defun rul-modeline-major-mode-indicator ()
+  "Return appropriate propertized mode line indicator for the major mode."
+  (let ((indicator (cond
+                    ((derived-mode-p 'text-mode) "§")
+                    ((derived-mode-p 'prog-mode) "λ")
+                    ((derived-mode-p 'comint-mode) ">_")
+                    (t "◦"))))
+    (propertize indicator 'face 'shadow)))
+
+(defun rul-modeline-major-mode-name ()
+  "Return capitalized `major-mode' without the -mode suffix."
+  (capitalize (string-replace "-mode" "" (symbol-name major-mode))))
+
+(defun rul-modeline-major-mode-help-echo ()
+  "Return `help-echo' value for `rul-modeline-major-mode'."
+  (if-let ((parent (get major-mode 'derived-mode-parent)))
+      (format "Symbol: `%s'.  Derived from: `%s'" major-mode parent)
+    (format "Symbol: `%s'." major-mode)))
+
+(defvar-local rul-modeline-major-mode
+    (list
+     (propertize "%[" 'face 'rul-modeline-indicator-red)
+     '(:eval
+       (concat
+        (rul-modeline-major-mode-indicator)
+        " "
+        (propertize
+         (rul-modeline-string-truncate
+          (rul-modeline-major-mode-name))
+         'mouse-face 'mode-line-highlight
+         'help-echo (rul-modeline-major-mode-help-echo))))
+     (propertize "%]" 'face 'rul-modeline-indicator-red))
+  "Mode line construct for displaying major modes.")
+
+;(makunbound 'rul-modeline-major-mode)
+
+;;;; Align right
+(defun prot-modeline--right-align-rest ()
+  "Return string if everything after `prot-modeline-align-right'."
+  (format-mode-line
+   `(""
+     ,@(cdr (memq 'prot-modeline-align-right mode-line-format)))))
+
+(defun prot-modeline--right-align-width ()
+  "Return pixel width of `prot-modeline--right-align-rest'."
+  (string-pixel-width (prot-modeline--right-align-rest)))
+
+(defun prot-modeline--box-p ()
+  "Return non-nil if the `mode-line' has a box attribute."
+  (and (face-attribute 'mode-line :box)
+       (null (eq (face-attribute 'mode-line :box) 'unspecified))))
+
+(defun prot-modeline--variable-pitch-p ()
+  "Return non-nil if the `mode-line' inherits `variable-pitch'."
+  (when-let* ((mode-line-inherit (face-attribute 'mode-line :inherit))
+              ((string-match-p "variable-pitch" (symbol-name mode-line-inherit)))
+              (family-face (face-attribute mode-line-inherit :inherit))
+              (variable-pitch
+               (if (listp family-face)
+                   (memq 'variable-pitch family-face)
+                 (eq 'variable-pitch family-face))))
+    variable-pitch))
+
+(defun prot-modeline--magic-number ()
+  "Return constant for use in `prot-modeline-align-right'."
+  (let ((height (face-attribute 'mode-line :height nil 'default))
+        (m-width (string-pixel-width (propertize "m" 'face 'mode-line))))
+    (round height (* m-width (* height m-width 0.001)))))
+
+(defvar-local prot-modeline-align-right
+    '(:eval
+      (propertize
+       " "
+       'display
+       (let ((box-p (prot-modeline--box-p))
+             (variable-pitch-p (prot-modeline--variable-pitch-p))
+             (magic-number (prot-modeline--magic-number)))
+         `(space
+           :align-to
+           (- right
+              right-fringe
+              right-margin
+              ,(ceiling
+                (prot-modeline--right-align-width)
+                (string-pixel-width (propertize "m" 'face 'mode-line)))
+              ,(cond
+                ((and variable-pitch-p box-p)
+                 (* magic-number 0.5))
+                ((and (not variable-pitch-p) box-p)
+                 (* magic-number 0.25))
+                ((and variable-pitch-p (not box-p))
+                 (* magic-number -0.05))
+                (t (* magic-number -0.1))))))))
+  "Mode line construct to align following elements to the right.
+Read Info node `(elisp) Pixel Specification'.")
+
+
+;;;; Variables used in the modeline need to be in `risky-local-variable'.
+(dolist (construct '(
+                     rul-modeline-major-mode
+                     rul-modeline-misc-info
+                     prot-modeline-align-right
+                     ))
+  (put construct 'risky-local-variable t))
+
+;;;; Miscellaneous
+(defvar-local rul-modeline-misc-info
+    '(:eval
+      (when (mode-line-window-selected-p)
+        mode-line-misc-info))
+  "Mode line construct displaying `mode-line-misc-info'.
+Specific to the current window's mode line.")
+
+;;;; Finally, define the modeline format
+(setq-default mode-line-format
+              '("%e"
+                mode-line-front-space
+                mode-line-buffer-identification
+                mode-line-front-space
+                rul-modeline-major-mode
+                prot-modeline-align-right
+                rul-modeline-misc-info
+                ))
+
+(provide 'rul-modeline)