summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-04-20 10:44:51 -0500
committerCase Duckworth2022-04-20 10:44:51 -0500
commit28d11fd0e8db7fb7456ebd285174822b2056e645 (patch)
tree796fd191a1d084918ac7053ef7a8d909b00985e9 /lisp
parentDon't indicate buffer boundaries (diff)
downloademacs-28d11fd0e8db7fb7456ebd285174822b2056e645.tar.gz
emacs-28d11fd0e8db7fb7456ebd285174822b2056e645.zip
bleh
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+ace-window.el17
-rw-r--r--lisp/+modeline.el142
-rw-r--r--lisp/+org.el1
-rw-r--r--lisp/+setup.el2
-rw-r--r--lisp/+tab-bar.el19
5 files changed, 130 insertions, 51 deletions
diff --git a/lisp/+ace-window.el b/lisp/+ace-window.el index fca27d9..9e631a2 100644 --- a/lisp/+ace-window.el +++ b/lisp/+ace-window.el
@@ -10,15 +10,21 @@
10 ;; This is stolen from ace-window.el but with the mode-line stuff ripped out. 10 ;; This is stolen from ace-window.el but with the mode-line stuff ripped out.
11 :global t 11 :global t
12 (if +ace-window-display-mode 12 (if +ace-window-display-mode
13 (progn 13 (progn ; Enable
14 (aw-update) 14 (aw-update)
15 (force-mode-line-update t) 15 (force-mode-line-update t)
16 (add-hook 'window-configuration-change-hook 'aw-update) 16 (add-hook 'window-configuration-change-hook 'aw-update)
17 (add-hook 'after-make-frame-functions 'aw--after-make-frame t) 17 (add-hook 'after-make-frame-functions 'aw--after-make-frame t)
18 (advice-add 'aw--lead-overlay :override 'ignore)) 18 (advice-add 'aw--lead-overlay :override 'ignore))
19 (remove-hook 'window-configuration-change-hook 'aw-update) 19 (progn ; Disable
20 (remove-hook 'after-make-frame-functions 'aw--after-make-frame) 20 (remove-hook 'window-configuration-change-hook 'aw-update)
21 (advice-remove 'aw--lead-overlay 'ignore))) 21 (remove-hook 'after-make-frame-functions 'aw--after-make-frame)
22 (advice-remove 'aw--lead-overlay 'ignore))))
23
24;; (defun +ace-window--mode-line-hint (path leaf)
25;; (let ((wnd (cdr leaf)))
26;; (with-selected-window wnd
27;; ())))
22 28
23;;;###autoload 29;;;###autoload
24(defun +ace-window-or-switch-buffer (arg) 30(defun +ace-window-or-switch-buffer (arg)
@@ -30,8 +36,5 @@ Switch to most recent buffer otherwise."
30 (switch-to-buffer nil) 36 (switch-to-buffer nil)
31 (ace-window arg))) 37 (ace-window arg)))
32 38
33(defun +ace-window@disable-overlay (_fn &rest _args)
34 "ADVICE for FN `aw--lead-overlay' (and ARGS) to not show overlays.")
35
36(provide '+ace-window) 39(provide '+ace-window)
37;;; +ace-window.el ends here 40;;; +ace-window.el ends here
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 3cc8806..3a922e3 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el
@@ -32,7 +32,7 @@ functions), though it can also contain cons cells of the
32form (SEGMENT . PREDICATE). 32form (SEGMENT . PREDICATE).
33 33
34Segments are separated from each other using SEPARATOR, which 34Segments are separated from each other using SEPARATOR, which
35defaults to a \" \". space. Only segments that evaluate to a 35defaults to a \" \". Only segments that evaluate to a
36non-trivial string (that is, a string not equal to \"\") will be 36non-trivial string (that is, a string not equal to \"\") will be
37separated, for a cleaner look. 37separated, for a cleaner look.
38 38
@@ -42,18 +42,18 @@ This function makes a lambda, so you can throw it straight into
42 (lambda () 42 (lambda ()
43 (apply #'concat 43 (apply #'concat
44 (let (this-sep result-list) 44 (let (this-sep result-list)
45 (dolist (segment segments) 45 (dolist (segment segments)
46 (push (funcall (or (car-safe segment) segment) 46 (push (funcall (or (car-safe segment) segment)
47 this-sep) 47 this-sep)
48 result-list) 48 result-list)
49 (if (or (cdr-safe segment) 49 (if (or (cdr-safe segment)
50 (and (car result-list) 50 (and (car result-list)
51 (not (equal (car result-list) "")))) 51 (not (equal (car result-list) ""))))
52 (setq this-sep separator) 52 (setq this-sep separator)
53 (setq this-sep nil))) 53 (setq this-sep nil)))
54 (unless (seq-some #'null result-list) 54 (unless (seq-some #'null result-list)
55 (push +modeline-default-spacer result-list)) 55 (push +modeline-default-spacer result-list))
56 (nreverse result-list))))) 56 (nreverse result-list)))))
57 57
58;;; Modeline segments 58;;; Modeline segments
59 59
@@ -62,14 +62,36 @@ This function makes a lambda, so you can throw it straight into
62 (when string 62 (when string
63 (string-replace "%" "%%" string))) 63 (string-replace "%" "%%" string)))
64 64
65(defcustom +modeline-buffer-name-max-length 0
66 "Maximum length of `+modeline-buffer-name'.
67If > 0 and < 1, use that portion of the window's width. If > 1,
68use that many characters. If anything else, don't limit. If the
69buffer name is longer than the max length, it will be shortened
70and appended with `truncate-string-ellipsis'."
71 :type '(choice (const :tag "No maximum length" 0)
72 (natnum :tag "Number of characters")
73 (float :tag "Fraction of window's width")))
74
65(defun +modeline-buffer-name (&optional spacer) ; gonsie 75(defun +modeline-buffer-name (&optional spacer) ; gonsie
66 "Display the buffer name." 76 "Display the buffer name."
67 (let ((bufname (string-trim (string-replace "%" "" (buffer-name))))) 77 (let ((bufname (string-trim (string-replace "%" "" (buffer-name)))))
68 (concat (or spacer +modeline-default-spacer) 78 (concat (or spacer +modeline-default-spacer)
69 (propertize bufname 79 (propertize (cond
70 'help-echo (or (buffer-file-name) 80 ((ignore-errors
71 (buffer-name)) 81 (and (> +modeline-buffer-name-max-length 0)
72 'mouse-face 'mode-line-highlight)))) 82 (< +modeline-buffer-name-max-length 1)))
83 (truncate-string-to-width bufname
84 (* (window-total-width) +modeline-buffer-name-max-length)
85 nil nil t))
86 ((ignore-errors
87 (> +modeline-buffer-name-max-length 1))
88 (truncate-string-to-width bufname
89 +modeline-buffer-name-max-length
90 nil nil t))
91 (t bufname))
92 'help-echo (or (buffer-file-name)
93 (buffer-name))
94 'mouse-face 'mode-line-highlight))))
73 95
74(defcustom +modeline-minions-icon "&" 96(defcustom +modeline-minions-icon "&"
75 "The \"icon\" for `+modeline-minions' button." 97 "The \"icon\" for `+modeline-minions' button."
@@ -188,20 +210,49 @@ The order of elements matters: whichever one matches first is applied."
188 "Toggle the percentage display in the mode line (File Percentage Mode)." 210 "Toggle the percentage display in the mode line (File Percentage Mode)."
189 :init-value t :global t :group 'mode-line) 211 :init-value t :global t :group 'mode-line)
190 212
213(defun +modeline--percentage ()
214 "Return point's progress through current file as a percentage."
215 (let ((tot (count-screen-lines (point-min) (point-max) :ignore-invisible)))
216 (floor (* 100 (/ (float (line-number-at-pos)) tot)))))
217
218(defun +modeline--buffer-contained-in-window-p ()
219 "Whether the buffer is totally contained within its window."
220 (let ((window-min (save-excursion (move-to-window-line 0) (point)))
221 (window-max (save-excursion (move-to-window-line -1) (point))))
222 (and (<= window-min (point-min))
223 (>= window-max (point-max)))))
224
191(defun +modeline-file-percentage (&optional spacer) 225(defun +modeline-file-percentage (&optional spacer)
192 "Display the position in the current file." 226 "Display the position in the current file."
193 (when file-percentage-mode 227 (when file-percentage-mode
194 (let* ((tot (count-lines (point-min) (point-max) :ignore-invisible)) 228 ;; (let ((perc (+modeline--percentage)))
195 (perc (/ (* 100 (line-number-at-pos)) tot)) 229 ;; (propertize (concat (or spacer +modeline-default-spacer)
196 (window-min (save-excursion (move-to-window-line 0) 230 ;; (cond
197 (point))) 231 ;; ((+modeline--buffer-contained-in-window-p) "All")
198 (window-max (save-excursion (move-to-window-line -1) 232 ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top")
199 (point)))) 233 ;; ((= (line-number-at-pos) (line-number-at-pos (point-max))) "Bot")
234 ;; ;; Why the 10 %s? Not sure. `format' knocks them
235 ;; ;; down to 5, then `format-mode-line' kills all but
236 ;; ;; two. If I use only 8, the margin is much too
237 ;; ;; large. Something else is obviously going on, but
238 ;; ;; I'm at a loss as to what it could be.
239 ;; (t (format "%d%%%%%%%%%%" perc))))
240 ;; ;; TODO: add scroll-up and scroll-down bindings.
241 ;; ))
242 (let ((perc (format-mode-line '(-3 "%p"))))
243 (concat (or spacer +modeline-default-spacer)
244 perc
245 (unless (seq-some (lambda (s) (string= perc s))
246 '("Top" "Bot" "All"))
247 "%%%%")))))
248
249(defun +modeline-file-percentage-icon (&optional spacer)
250 "Display the position in the current file as an icon."
251 (when file-percentage-mode
252 (let ((perc (+modeline--percentage)))
200 (propertize (concat (or spacer +modeline-default-spacer) 253 (propertize (concat (or spacer +modeline-default-spacer)
201 (cond 254 (cond
202 ((and (<= window-min (point-min)) 255 ((+modeline--buffer-contained-in-window-p) "⏹")
203 (>= window-max (point-max)))
204 "█")
205 ((= perc 0) "▇") 256 ((= perc 0) "▇")
206 ((< perc 20) "▆") 257 ((< perc 20) "▆")
207 ((< perc 40) "▅") 258 ((< perc 40) "▅")
@@ -231,24 +282,37 @@ The order of elements matters: whichever one matches first is applied."
231 'font-lock-face 'font-lock-variable-name-face)) 282 'font-lock-face 'font-lock-variable-name-face))
232 "")) 283 ""))
233 284
285(defun +modeline-line (&optional spacer)
286 (when line-number-mode
287 (concat (or spacer +modeline-default-spacer) "%2l")))
288
289(defun +modeline-column (&optional spacer)
290 (when column-number-mode
291 (concat (or spacer +modeline-default-spacer)
292 (if column-number-indicator-zero-based "%2c" "%2C"))))
293
234(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline' 294(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline'
235 "Display the current cursor line and column depending on modes." 295 "Display the current cursor line and column depending on modes."
236 (let ((sep "|") (before "") (after "") 296 (funcall (+modeline-concat '(+modeline-line
237 (line-fmt (if line-number-mode "%2l" "")) 297 +modeline-column)
238 (col-fmt (if column-number-mode 298 "|")))
239 (if column-number-indicator-zero-based 299
240 "%2c" 300(defcustom +modeline-position-function nil
241 "%2C") 301 "Function to use instead of `+modeline-position' in modeline."
242 ""))) 302 :type '(choice (const :tag "None" nil)
243 (concat (or spacer +modeline-default-spacer) 303 function)
244 before line-fmt sep col-fmt after))) 304 :local t)
245 305
246(defun +modeline-position (&optional _) 306(defun +modeline-position (&optional _)
247 "Display the current cursor position. 307 "Display the current cursor position.
248See `line-number-mode', `column-number-mode', `file-percentage-mode'" 308See `line-number-mode', `column-number-mode', and
249 (append (+modeline-line-column) 309`file-percentage-mode'. If `+modeline-position-function' is set
250 (+modeline-region) 310to a function in the current buffer, call that function instead."
251 (+modeline-file-percentage))) 311 (funcall (if +modeline-position-function
312 +modeline-position-function
313 (+modeline-concat '(+modeline-region
314 +modeline-line-column
315 +modeline-file-percentage)))))
252 316
253(defun +modeline-vc (&optional spacer) 317(defun +modeline-vc (&optional spacer)
254 "Display the version control branch of the current buffer in the modeline." 318 "Display the version control branch of the current buffer in the modeline."
diff --git a/lisp/+org.el b/lisp/+org.el index 2a57fe2..e39bdc1 100644 --- a/lisp/+org.el +++ b/lisp/+org.el
@@ -338,6 +338,7 @@ Return as a list."
338 (save-mark-and-excursion 338 (save-mark-and-excursion
339 (mark-whole-buffer) 339 (mark-whole-buffer)
340 ;;(org-fill-paragraph nil t) 340 ;;(org-fill-paragraph nil t)
341 (+org-unsmartify)
341 (+org-fix-blank-lines t) 342 (+org-fix-blank-lines t)
342 (org-align-tags t)))) 343 (org-align-tags t))))
343 344
diff --git a/lisp/+setup.el b/lisp/+setup.el index 7c658b6..02d2f09 100644 --- a/lisp/+setup.el +++ b/lisp/+setup.el
@@ -35,7 +35,7 @@ Good for commenting.")
35 35
36(setup-define :face 36(setup-define :face
37 (lambda (face spec) 37 (lambda (face spec)
38 `(custom-set-faces '(,face ,spec 'now "Customized by `setup'."))) 38 `(custom-set-faces (list ,face ,spec 'now "Customized by `setup'.")))
39 :documentation "Customize FACE with SPEC using `custom-set-faces'." 39 :documentation "Customize FACE with SPEC using `custom-set-faces'."
40 :repeatable t) 40 :repeatable t)
41 41
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index 1f4745d..2c39dae 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el
@@ -99,10 +99,10 @@
99 emms-player-playing-p) 99 emms-player-playing-p)
100 (let ((now-playing (+string-truncate (emms-mode-line-playlist-current) 100 (let ((now-playing (+string-truncate (emms-mode-line-playlist-current)
101 (- +tab-bar-emms-max-length 2)))) 101 (- +tab-bar-emms-max-length 2))))
102 `((emms-now-playing menu-item 102 `(emms-now-playing menu-item
103 ,(concat "{" now-playing "}" " ") 103 ,(concat "{" now-playing "}" " ")
104 emms-pause 104 emms-pause
105 :help ,(emms-mode-line-playlist-current)))))) 105 ( :help ,(emms-mode-line-playlist-current))))))
106 106
107(defun +tab-bar-bongo () 107(defun +tab-bar-bongo ()
108 "Display Bongo now playing information." 108 "Display Bongo now playing information."
@@ -218,6 +218,17 @@ name to the left."
218 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell)))) 218 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
219 'help-echo tab-name)))) 219 'help-echo tab-name))))
220 220
221(defun +tab-bar-format-align-right ()
222 "Align the rest of tab bar items to the right, pixel-wise."
223 ;; XXX: ideally, wouldn't require `shr' here
224 (require 'shr) ; `shr-string-pixel-width'
225 (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format)))
226 (rest (tab-bar-format-list rest))
227 (rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
228 (hpos (shr-string-pixel-width rest))
229 (str (propertize " " 'display `(space :align-to (- right (,hpos))))))
230 `((align-right menu-item ,str ignore))))
231
221 232
222;;; Menu bar 233;;; Menu bar
223;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el 234;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el