From d7c3a4e8254af93b65f3a62b366790782ada449a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ra=C3=BAl=20Benencia?= Date: Fri, 4 Aug 2023 14:34:18 -0700 Subject: emacs: rul-modeline (heavily based on prot-modeline) --- .emacs.d/init.el | 1 + .emacs.d/rul-lisp/packages/rul-modeline.el | 159 +++++++++++++++++++++++++++++ 2 files changed, 160 insertions(+) create mode 100644 .emacs.d/rul-lisp/packages/rul-modeline.el (limited to '.emacs.d') 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) -- cgit v1.2.3