summary refs log tree commit diff stats
path: root/lisp/+modeline.el
diff options
context:
space:
mode:
authorCase Duckworth2022-05-12 22:37:16 -0500
committerCase Duckworth2022-05-12 22:37:47 -0500
commit134409aa670be39e676f093f5aa5b5b941126375 (patch)
tree80ebd0451f13768499c389ee886ab5a88cebdf50 /lisp/+modeline.el
parentmeh (diff)
downloademacs-134409aa670be39e676f093f5aa5b5b941126375.tar.gz
emacs-134409aa670be39e676f093f5aa5b5b941126375.zip
Modeline stuff!
Diffstat (limited to 'lisp/+modeline.el')
-rw-r--r--lisp/+modeline.el124
1 files changed, 63 insertions, 61 deletions
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index f408757..86dbad4 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el
@@ -25,35 +25,27 @@ will default to this string.")
25;;; Combinators 25;;; Combinators
26 26
27(defun +modeline-concat (segments &optional separator) 27(defun +modeline-concat (segments &optional separator)
28 "Concatenate multiple `simple-modeline'-style SEGMENTS. 28 "Concatenate multiple functional modeline SEGMENTS.
29SEGMENTS is a list of either modeline segment-functions (see 29Each segment in SEGMENTS is a function returning a mode-line
30`simple-modeline' functions for an example of types of 30construct.
31functions), though it can also contain cons cells of the 31
32form (SEGMENT . PREDICATE). 32Segments are separated using SEPARATOR, which defaults to
33 33`+modeline-default-spacer'. Only segments that evaluate to a
34Segments are separated from each other using SEPARATOR, which 34non-zero-length string will be separated, for a cleaner look.
35defaults to a \" \". Only segments that evaluate to a 35
36non-trivial string (that is, a string not equal to \"\") will be 36This function returns a lambda that should be `:eval'd or
37separated, for a cleaner look. 37`funcall'd in a mode-line context."
38 38 (let ((separator (or separator +modeline-default-spacer)))
39This function makes a lambda, so you can throw it straight into 39 (lambda ()
40`simple-modeline-segments'." 40 (let (this-sep result)
41 (setq separator (or separator +modeline-default-spacer)) 41 (dolist (segment segments)
42 (lambda () 42 (let ((segstr (funcall segment this-sep)))
43 (apply #'concat 43 (when (and segstr
44 (let (this-sep result-list) 44 (not (equal segstr "")))
45 (dolist (segment segments) 45 (push segstr result)
46 (push (funcall (or (car-safe segment) segment) 46 (setq this-sep separator))))
47 this-sep) 47 (apply #'concat
48 result-list) 48 (nreverse result))))))
49 (if (or (cdr-safe segment)
50 (and (car result-list)
51 (not (equal (car result-list) ""))))
52 (setq this-sep separator)
53 (setq this-sep nil)))
54 ;; (unless (seq-some #'null result-list)
55 ;; (push +modeline-default-spacer result-list))
56 (nreverse result-list)))))
57 49
58(defun +modeline-spacer (&optional n spacer &rest strings) 50(defun +modeline-spacer (&optional n spacer &rest strings)
59 "Make an N-length SPACER, or prepend SPACER to STRINGS. 51 "Make an N-length SPACER, or prepend SPACER to STRINGS.
@@ -152,7 +144,7 @@ in the cdr will be applied to the major-mode in the mode line."
152 "(" 144 "("
153 (propertize ;; (+string-truncate (format-mode-line mode-name) 16) 145 (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
154 (format-mode-line mode-name) 146 (format-mode-line mode-name)
155 'face (if (actually-selected-window-p) 147 'face (when (actually-selected-window-p)
156 ;; XXX: This is probably really inefficient. I need to 148 ;; XXX: This is probably really inefficient. I need to
157 ;; simply detect which mode it's in when I change major 149 ;; simply detect which mode it's in when I change major
158 ;; modes (`change-major-mode-hook') and change the face 150 ;; modes (`change-major-mode-hook') and change the face
@@ -160,8 +152,7 @@ in the cdr will be applied to the major-mode in the mode line."
160 (catch :done (dolist (cel +modeline-major-mode-faces) 152 (catch :done (dolist (cel +modeline-major-mode-faces)
161 (when (derived-mode-p (car cel)) 153 (when (derived-mode-p (car cel))
162 (throw :done (cdr cel)))) 154 (throw :done (cdr cel))))
163 (alist-get t +modeline-major-mode-faces)) 155 (alist-get t +modeline-major-mode-faces)))
164 'unspecified)
165 'keymap (let ((map (make-sparse-keymap))) 156 'keymap (let ((map (make-sparse-keymap)))
166 (bindings--define-key map [mode-line down-mouse-1] 157 (bindings--define-key map [mode-line down-mouse-1]
167 `(menu-item "Menu Bar" ignore 158 `(menu-item "Menu Bar" ignore
@@ -293,13 +284,26 @@ The order of elements matters: whichever one matches first is applied."
293 ;; (t (format "%d%%%%%%%%%%" perc)))) 284 ;; (t (format "%d%%%%%%%%%%" perc))))
294 ;; ;; TODO: add scroll-up and scroll-down bindings. 285 ;; ;; TODO: add scroll-up and scroll-down bindings.
295 ;; )) 286 ;; ))
296 (let ((perc (format-mode-line '(-3 "%p")))) 287 (let ((perc (format-mode-line '(-2 "%p"))))
297 (+modeline-spacer nil spacer 288 (+modeline-spacer nil spacer
289 "/"
298 (pcase perc 290 (pcase perc
299 ("Top" ".^^") 291 ("To" "Top")
300 ("Bot" ".__") 292 ("Bo" "Bot")
301 ("All" ".::") 293 ("Al" "All")
302 (_ (format ".%02d" (string-to-number (substring perc 0 2))))))))) 294 (_ (format ".%02d" (string-to-number perc))))))))
295
296(defun +modeline-file-percentage-ascii-icon (&optional spacer)
297 (when file-percentage-mode
298 (+modeline-spacer nil spacer
299 (let ((perc (format-mode-line '(-2 "%p"))))
300 (pcase perc
301 ("To" "/\\")
302 ("Bo" "\\/")
303 ("Al" "[]")
304 (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|"))
305 (perc (string-to-number perc)))
306 (aref vec (floor (/ perc 17))))))))))
303 307
304(defun +modeline-file-percentage-icon (&optional spacer) 308(defun +modeline-file-percentage-icon (&optional spacer)
305 "Display the position in the current file as an icon." 309 "Display the position in the current file as an icon."
@@ -307,14 +311,14 @@ The order of elements matters: whichever one matches first is applied."
307 (let ((perc (+modeline--percentage))) 311 (let ((perc (+modeline--percentage)))
308 (propertize (+modeline-spacer nil spacer 312 (propertize (+modeline-spacer nil spacer
309 (cond 313 (cond
310 ((+modeline--buffer-contained-in-window-p) "") 314 ((+modeline--buffer-contained-in-window-p) "111")
311 ((= perc 0) "") 315 ((= perc 0) "000")
312 ((< perc 20) "") 316 ((< perc 20) "001")
313 ((< perc 40) "") 317 ((< perc 40) "010")
314 ((< perc 60) "") 318 ((< perc 60) "011")
315 ((< perc 80) "") 319 ((< perc 80) "100")
316 ((< perc 100) "") 320 ((< perc 100) "101")
317 ((>= perc 100) ""))) 321 ((>= perc 100) "110")))
318 'help-echo (format "Point is %d%% through the buffer." 322 'help-echo (format "Point is %d%% through the buffer."
319 perc))))) 323 perc)))))
320 324
@@ -327,30 +331,25 @@ The order of elements matters: whichever one matches first is applied."
327 (when (and region-indicator-mode 331 (when (and region-indicator-mode
328 (region-active-p)) 332 (region-active-p))
329 (+modeline-spacer nil spacer 333 (+modeline-spacer nil spacer
330 (propertize (format "%s%d" 334 (propertize (format "%d%s"
331 (if (and (< (point) (mark))) "-" "+")
332 (apply '+ (mapcar (lambda (pos) 335 (apply '+ (mapcar (lambda (pos)
333 (- (cdr pos) 336 (- (cdr pos)
334 (car pos))) 337 (car pos)))
335 (region-bounds)))) 338 (region-bounds)))
339 (if (and (< (point) (mark))) "-" "+"))
336 'font-lock-face 'font-lock-variable-name-face)))) 340 'font-lock-face 'font-lock-variable-name-face))))
337 341
338(defun +modeline-line (&optional spacer) 342(defun +modeline-line (&optional spacer)
339 (when line-number-mode 343 (when line-number-mode
340 (+modeline-spacer nil spacer "%2l"))) 344 (+modeline-spacer nil spacer
345 "%l")))
341 346
342(defun +modeline-column (&optional spacer) 347(defun +modeline-column (&optional spacer)
343 (when column-number-mode 348 (when column-number-mode
344 (+modeline-spacer nil spacer 349 (+modeline-spacer nil spacer
350 "|"
345 (if column-number-indicator-zero-based "%2c" "%2C")))) 351 (if column-number-indicator-zero-based "%2c" "%2C"))))
346 352
347(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline'
348 "Display the current cursor line and column depending on modes."
349 (+modeline-spacer nil spacer
350 (+modeline-line "")
351 "|"
352 (+modeline-column "")))
353
354(defcustom +modeline-position-function nil 353(defcustom +modeline-position-function nil
355 "Function to use instead of `+modeline-position' in modeline." 354 "Function to use instead of `+modeline-position' in modeline."
356 :type '(choice (const :tag "Default" nil) 355 :type '(choice (const :tag "Default" nil)
@@ -362,11 +361,14 @@ The order of elements matters: whichever one matches first is applied."
362See `line-number-mode', `column-number-mode', and 361See `line-number-mode', `column-number-mode', and
363`file-percentage-mode'. If `+modeline-position-function' is set 362`file-percentage-mode'. If `+modeline-position-function' is set
364to a function in the current buffer, call that function instead." 363to a function in the current buffer, call that function instead."
365 (+modeline-spacer nil spacer 364 (cond ((functionp +modeline-position-function)
366 (cond ((functionp +modeline-position-function) 365 (+modeline-spacer nil spacer
367 (funcall +modeline-position-function)) 366 (funcall +modeline-position-function)))
368 (t (concat (+modeline-region) 367 (t (funcall (+modeline-concat '(+modeline-region
369 (+modeline-line-column)))))) 368 +modeline-line
369 +modeline-column
370 +modeline-file-percentage)
371 "")))))
370 372
371(defun +modeline-vc (&optional spacer) 373(defun +modeline-vc (&optional spacer)
372 "Display the version control branch of the current buffer in the modeline." 374 "Display the version control branch of the current buffer in the modeline."