diff options
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/+emacs.el | 3 | ||||
-rw-r--r-- | lisp/+modeline.el | 124 | ||||
-rw-r--r-- | lisp/+org-wc.el | 97 | ||||
-rw-r--r-- | lisp/+tab-bar.el | 78 |
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. |
29 | SEGMENTS is a list of either modeline segment-functions (see | 29 | Each segment in SEGMENTS is a function returning a mode-line |
30 | `simple-modeline' functions for an example of types of | 30 | construct. |
31 | functions), though it can also contain cons cells of the | 31 | |
32 | form (SEGMENT . PREDICATE). | 32 | Segments are separated using SEPARATOR, which defaults to |
33 | 33 | `+modeline-default-spacer'. Only segments that evaluate to a | |
34 | Segments are separated from each other using SEPARATOR, which | 34 | non-zero-length string will be separated, for a cleaner look. |
35 | defaults to a \" \". Only segments that evaluate to a | 35 | |
36 | non-trivial string (that is, a string not equal to \"\") will be | 36 | This function returns a lambda that should be `:eval'd or |
37 | separated, for a cleaner look. | 37 | `funcall'd in a mode-line context." |
38 | 38 | (let ((separator (or separator +modeline-default-spacer))) | |
39 | This 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." | |||
362 | See `line-number-mode', `column-number-mode', and | 361 | See `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 |
364 | to a function in the current buffer, call that function instead." | 363 | to 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 |