summary refs log tree commit diff stats
path: root/lisp
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
parentmeh (diff)
downloademacs-134409aa670be39e676f093f5aa5b5b941126375.tar.gz
emacs-134409aa670be39e676f093f5aa5b5b941126375.zip
Modeline stuff!
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+emacs.el3
-rw-r--r--lisp/+modeline.el124
-rw-r--r--lisp/+org-wc.el97
-rw-r--r--lisp/+tab-bar.el78
4 files changed, 215 insertions, 87 deletions
diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 7851c43..3c5d383 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el
@@ -190,7 +190,8 @@ Do this only if the buffer is not visiting a file."
190 file-name-shadow-mode 190 file-name-shadow-mode
191 minibuffer-electric-default-mode 191 minibuffer-electric-default-mode
192 delete-selection-mode 192 delete-selection-mode
193 column-number-mode)) 193 ;; column-number-mode
194 ))
194 (when (fboundp enable-mode) 195 (when (fboundp enable-mode)
195 (funcall enable-mode +1))) 196 (funcall enable-mode +1)))
196 197
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."
diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el new file mode 100644 index 0000000..7ab0050 --- /dev/null +++ b/lisp/+org-wc.el
@@ -0,0 +1,97 @@
1;;; +org-wc.el --- org-wc in the modeline -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'org-wc)
8(require '+modeline)
9(require 'cl-lib)
10
11(defgroup +org-wc nil
12 "Extra fast word-counting in `org-mode'"
13 :group 'org-wc
14 :group 'org)
15
16(defvar-local +org-wc-word-count nil
17 "Running total of words in this buffer.")
18
19(defcustom +org-wc-update-after-funcs '(org-narrow-to-subtree
20 org-narrow-to-block
21 org-narrow-to-element
22 org-capture-narrow
23 org-taskwise-narrow-to-task)
24 "Functions after which to update the word count."
25 :type '(repeat function))
26
27(defcustom +org-wc-deletion-idle-timer 0.25
28 "Length of time, in seconds, to wait before updating word-count."
29 :type 'number)
30
31(defcustom +org-wc-huge-change 5000
32 "Number of characters that constitute a \"huge\" insertion."
33 :type 'number)
34
35(defvar-local +org-wc-update-timer nil)
36
37(defun +org-wc-delayed-update (&rest _)
38 (if +org-wc-update-timer
39 (setq +org-wc-update-timer nil)
40 (setq +org-wc-update-timer
41 (run-with-idle-timer +org-wc-deletion-idle-timer nil #'+org-wc-update))))
42
43(defun +org-wc-force-update ()
44 (interactive)
45 (message "Counting words...")
46 (when (timerp +org-wc-update-timer)
47 (cancel-timer +org-wc-update-timer))
48 (+org-wc-update)
49 (message "Counting words...done"))
50
51(defun +org-wc-update ()
52 (dlet ((+org-wc-counting t))
53 (+org-wc-buffer)
54 (force-mode-line-update)
55 (setq +org-wc-update-timer nil)))
56
57(defun +org-wc-changed (start end length)
58 (+org-wc-delayed-update))
59
60(defun +org-wc-buffer ()
61 "Count the words in the buffer."
62 (when (derived-mode-p 'org-mode)
63 (setq +org-wc-word-count
64 (org-word-count-aux (point-min) (point-max)))))
65
66(defvar +org-wc-counting nil
67 "Are we currently counting?")
68
69(defun +org-wc-recount-widen (&rest _)
70 (when (and (not +org-wc-counting))
71 (+org-wc-update)))
72
73(defun +org-wc-modeline ()
74 (when +org-wc-word-count
75 (format " %sw" +org-wc-word-count)))
76
77(define-minor-mode +org-wc-mode
78 "Count words in `org-mode' buffers in the mode-line."
79 :lighter ""
80 :keymap (let ((map (make-sparse-keymap)))
81 (define-key map (kbd "C-c C-.") #'+org-wc-force-update)
82 map)
83 (if +org-wc-mode
84 (progn ; turn on
85 (+org-wc-buffer)
86 (add-hook 'after-change-functions #'+org-wc-delayed-update nil t)
87 (setq-local +modeline-position-function #'+org-wc-modeline)
88 (dolist (fn +org-wc-update-after-funcs)
89 (advice-add fn :after #'+org-wc-update)))
90 (progn ; turn off
91 (remove-hook 'after-change-functions #'+org-wc-delayed-update t)
92 (kill-local-variable '+modeline-position-function)
93 (dolist (fn +org-wc-update-after-funcs)
94 (advice-remove fn #'+org-wc-update)))))
95
96(provide '+org-wc)
97;;; +org-wc.el ends here
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index dce84d8..95f657d 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el
@@ -47,12 +47,40 @@
47 (when-let ((help (plist-get item 'help-echo))) 47 (when-let ((help (plist-get item 'help-echo)))
48 (list :help help))))))) 48 (list :help help)))))))
49 49
50(defun +tab-bar-timer ()
51 "Display `+timer-string' in the tab-bar."
52 (when +timer-string
53 `((timer-string menu-item
54 ,(concat " " +timer-string)
55 (lambda (ev)
56 (interactive "e")
57 (cond ((not +timer-timer) nil)
58 ((equal +timer-string +timer-running-string)
59 (popup-menu
60 '("Running timer"
61 ["Cancel timer" +timer-cancel t])
62 ev))
63 (t (setq +timer-string ""))))))))
64
50(defun +tab-bar-date () 65(defun +tab-bar-date ()
51 "Display `display-time-string' in the tab-bar." 66 "Display `display-time-string' in the tab-bar."
52 (when display-time-mode 67 (when display-time-mode
53 `((date-time-string menu-item 68 `((date-time-string menu-item
54 ,(propertize (concat " " display-time-string)) 69 ,(propertize (concat " " display-time-string))
55 ignore 70 (lambda (ev)
71 (interactive "e")
72 (popup-menu
73 (append '("Timer")
74 (let (r)
75 (dolist (time '(3 5 10))
76 (push (vector (format "Timer for %d minutes" time)
77 `(lambda () (interactive)
78 (+timer ,time))
79 :active t)
80 r))
81 (nreverse r))
82 '(["Timer for ..." +timer t]))
83 ev))
56 :help (discord-date-string))))) 84 :help (discord-date-string)))))
57 85
58(defun +tab-bar-notmuch-count () 86(defun +tab-bar-notmuch-count ()
@@ -220,7 +248,7 @@ name to the left."
220 (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max) 248 (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
221 ellipsis) 249 ellipsis)
222 (truncate-string-to-width tab-name l-name 250 (truncate-string-to-width tab-name l-name
223 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell)))) 251 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
224 'help-echo tab-name)))) 252 'help-echo tab-name))))
225 253
226(defun +tab-bar-format-align-right () 254(defun +tab-bar-format-align-right ()
@@ -267,27 +295,27 @@ Used by `tab-bar-format-menu-bar'."
267(el-patch-feature tab-bar) 295(el-patch-feature tab-bar)
268(with-eval-after-load 'tab-bar 296(with-eval-after-load 'tab-bar
269 (el-patch-defun tab-bar--format-tab (tab i) 297 (el-patch-defun tab-bar--format-tab (tab i)
270 "Format TAB using its index I and return the result as a keymap." 298 "Format TAB using its index I and return the result as a keymap."
271 (append 299 (append
272 (el-patch-remove 300 (el-patch-remove
273 `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))) 301 `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
274 (cond 302 (cond
275 ((eq (car tab) 'current-tab) 303 ((eq (car tab) 'current-tab)
276 `((current-tab 304 `((current-tab
277 menu-item 305 menu-item
278 ,(funcall tab-bar-tab-name-format-function tab i) 306 ,(funcall tab-bar-tab-name-format-function tab i)
279 ignore 307 ignore
280 :help "Current tab"))) 308 :help "Current tab")))
281 (t 309 (t
282 `((,(intern (format "tab-%i" i)) 310 `((,(intern (format "tab-%i" i))
283 menu-item 311 menu-item
284 ,(funcall tab-bar-tab-name-format-function tab i) 312 ,(funcall tab-bar-tab-name-format-function tab i)
285 ,(alist-get 'binding tab) 313 ,(alist-get 'binding tab)
286 :help "Click to visit tab")))) 314 :help "Click to visit tab"))))
287 (when (alist-get 'close-binding tab) 315 (when (alist-get 'close-binding tab)
288 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) 316 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
289 menu-item "" 317 menu-item ""
290 ,(alist-get 'close-binding tab))))))) 318 ,(alist-get 'close-binding tab)))))))
291 319
292 320
293;; Emacs 27 321;; Emacs 27
@@ -300,8 +328,8 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
300 'display `(space :align-to (- right (- 0 right-margin) 328 'display `(space :align-to (- right (- 0 right-margin)
301 ,reserve))))) 329 ,reserve)))))
302 (prog1 (append output 330 (prog1 (append output
303 `((align-right menu-item ,str nil)) 331 `((align-right menu-item ,str nil))
304 (+tab-bar-misc-info))))) 332 (+tab-bar-misc-info)))))
305 333
306 334
307;; Emacs 28 335;; Emacs 28