aboutsummaryrefslogtreecommitdiff
path: root/.emacs.d/rul-lisp/packages/rul-modeline.el
blob: 264719e748f268f029707b5fbae0e4aeb8a267db (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
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)
nihil fit ex nihilo