about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+apheleia.el51
-rw-r--r--lisp/+avy.el40
-rw-r--r--lisp/+circe.el52
-rw-r--r--lisp/+cus-edit.el2
-rw-r--r--lisp/+emacs.el17
-rw-r--r--lisp/+flyspell-correct.el3
-rw-r--r--lisp/+modeline.el22
-rw-r--r--lisp/+nyan-mode.el39
-rw-r--r--lisp/+org-wc.el2
-rw-r--r--lisp/+org.el53
-rw-r--r--lisp/+tab-bar.el314
-rw-r--r--lisp/+window.el130
-rw-r--r--lisp/private.el4
13 files changed, 516 insertions, 213 deletions
diff --git a/lisp/+apheleia.el b/lisp/+apheleia.el index 469232a..df651b8 100644 --- a/lisp/+apheleia.el +++ b/lisp/+apheleia.el
@@ -2,14 +2,61 @@
2 2
3;;; Code: 3;;; Code:
4 4
5(require 'apheleia)
6(require 'cl-lib)
7
5;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623 8;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623
6(defun +apheleia-indent-region (orig scratch callback _error) 9(cl-defun +apheleia-indent-region (&key buffer scratch formatter callback &allow-other-keys)
7 (with-current-buffer scratch 10 (with-current-buffer scratch
8 (setq-local indent-line-function 11 (setq-local indent-line-function
9 (buffer-local-value 'indent-line-function orig)) 12 (buffer-local-value 'indent-line-function buffer))
10 (indent-region (point-min) 13 (indent-region (point-min)
11 (point-max)) 14 (point-max))
12 (funcall callback))) 15 (funcall callback)))
13 16
17
18;;; `setup' integration
19
20(require 'setup)
21
22(setup-define :apheleia
23 (lambda (name formatter &optional mode -pend)
24 (let* ((mode (or mode (setup-get 'mode)))
25 (current-formatters (and -pend
26 (alist-get mode apheleia-formatters))))
27 `(progn
28 (setf (alist-get ',name apheleia-formatters)
29 ,formatter)
30 (setf (alist-get ',mode apheleia-mode-alist)
31 ',(pcase -pend
32 (:append (append (ensure-list current-formatters)
33 (list name)))
34 (:prepend (cons name (ensure-list current-formatters)))
35 ('nil name)
36 (_ (error "Improper `:apheleia' -PEND argument")))))))
37 :documentation
38 "Register a formatter to `apheleia''s lists.
39NAME is the name given to the formatter in `apheleia-formatters'
40and `apheleia-mode-alist'. FORMATTER is the command paired with
41NAME in `apheleia-formatters'. MODE is the mode or modes to add
42NAME to in `apheleia-mode-alist'. If MODE is not given or nil,
43use the setup form's MODE. Optional argument -PEND can be one of
44`:append' or `:prepend', and if given will append or prepend the
45given NAME to the current formatters for the MODE in
46`apheleia-mode-alist', rather than replace them (the default).
47
48Example:
49(setup
50 (:apheleia isort (\"isort\" \"--stdout\" \"-\")
51 python-mode))
52; =>
53(progn
54 (setf (alist-get 'isort apheleia-formatters)
55 '(\"isort\" \"--stdout\" \"-\"))
56 (setf (alist-get 'python-mode apheleia-mode-alist)
57 'isort))
58
59This form cannot be repeated, and it cannot be used as HEAD.")
60
14(provide '+apheleia) 61(provide '+apheleia)
15;;; +apheleia.el ends here 62;;; +apheleia.el ends here
diff --git a/lisp/+avy.el b/lisp/+avy.el index 8056f00..b0837a3 100644 --- a/lisp/+avy.el +++ b/lisp/+avy.el
@@ -50,17 +50,35 @@
50(defvar-local +avy-buffer-face-mode-face nil 50(defvar-local +avy-buffer-face-mode-face nil
51 "The state of `buffer-face-mode' before calling `avy-with'.") 51 "The state of `buffer-face-mode' before calling `avy-with'.")
52 52
53(defun +avy@un-buffer-face (&rest _) 53;;; XXX: Doesn't switch back if avy errors out or quits
54(defun +avy@un-buffer-face (win)
54 "BEFORE advice on `avy-with' to disable `buffer-face-mode'." 55 "BEFORE advice on `avy-with' to disable `buffer-face-mode'."
55 (when buffer-face-mode 56 (with-current-buffer (window-buffer win)
56 (setq +avy-buffer-face-mode-face buffer-face-mode-face) 57 (when buffer-face-mode
57 (buffer-face-mode -1))) 58 (setq +avy-buffer-face-mode-face buffer-face-mode-face)
59 (buffer-face-mode -1))))
58 60
59(defun +avy@re-buffer-face (&rest _) 61(defun +avy@re-buffer-face (win)
60 "AFTER advice on `avy-with' to re-enable `buffer-face-mode'." 62 "AFTER advice on `avy-with' to re-enable `buffer-face-mode'."
61 (when +avy-buffer-face-mode-face 63 (with-current-buffer (window-buffer win)
62 (setq buffer-face-mode-face +avy-buffer-face-mode-face) 64 (when +avy-buffer-face-mode-face
63 (buffer-face-mode +1))) 65 (setq buffer-face-mode-face +avy-buffer-face-mode-face)
66 (buffer-face-mode +1)))
67 (let ((bounds (bounds-of-thing-at-point 'symbol)))
68 (when (and (car bounds)
69 (cdr bounds))
70 (pulse-momentary-highlight-region (car bounds) (cdr bounds)))))
71
72(defun +avy@buffer-face (fn &rest r)
73 "AROUND advice for avy to dis/enable `buffer-face-mode'."
74 (if avy-all-windows
75 (walk-windows #'+avy@un-buffer-face nil (eq avy-all-windows 'all-frames)))
76 (condition-case e
77 (apply fn r)
78 ((quit error) (message "Avy: %S" e) nil)
79 (:sucess e))
80 (if avy-all-windows
81 (walk-windows #'+avy@re-buffer-face nil (eq avy-all-windows 'all-frames))))
64 82
65(define-minor-mode +avy-buffer-face-mode 83(define-minor-mode +avy-buffer-face-mode
66 "Turn off `buffer-face-mode' before doing Avy selections. 84 "Turn off `buffer-face-mode' before doing Avy selections.
@@ -71,11 +89,9 @@ Restore the mode after the selection."
71 (cond 89 (cond
72 (+avy-buffer-face-mode 90 (+avy-buffer-face-mode
73 (dolist (fn +avy-buffer-face-functions) 91 (dolist (fn +avy-buffer-face-functions)
74 (advice-add fn :before #'+avy@un-buffer-face)) 92 (advice-add fn :around #'+avy@buffer-face)))
75 (advice-add 'avy--done :after #'+avy@re-buffer-face))
76 (t (dolist (fn +avy-buffer-face-functions) 93 (t (dolist (fn +avy-buffer-face-functions)
77 (advice-remove fn #'+avy@un-buffer-face)) 94 (advice-remove fn #'+avy@buffer-face)))))
78 (advice-remove 'avy--done #'+avy@re-buffer-face))))
79 95
80(provide '+avy) 96(provide '+avy)
81;;; avy.el ends here 97;;; avy.el ends here
diff --git a/lisp/+circe.el b/lisp/+circe.el index e8c5079..382f0ab 100644 --- a/lisp/+circe.el +++ b/lisp/+circe.el
@@ -45,21 +45,27 @@
45 45
46;;; Channel information 46;;; Channel information
47 47
48(defvar-local +circe-current-topic ""
49 "Cached topic of the buffer's channel.")
50
48(defun +circe-current-topic (&optional message) 51(defun +circe-current-topic (&optional message)
49 "Return the topic of the current channel. 52 "Return the topic of the current channel.
50When called with optional MESSAGE non-nil, or interactively, also 53When called with optional MESSAGE non-nil, or interactively, also
51message the current topic." 54message the current topic."
52 (interactive "p") 55 (interactive "p")
53 (let ((topic 56 (let ((topic
54 (save-excursion 57 (or (save-excursion
55 (goto-char (point-max)) 58 (goto-char (point-max))
56 (or (re-search-backward 59 (and (re-search-backward
57 (rx (group "*** " 60 (rx (group "*** "
58 (or "Topic" "topic" "TOPIC") 61 (or "Topic" "topic" "TOPIC")
59 (* (not ":")) ": ") 62 (* (not ":")) ": ")
60 (group (+ nonl))))) 63 (group (+ nonl)))
61 (buffer-substring-no-properties 64 nil t)
62 (match-beginning 2) (match-end 2))))) 65 (buffer-substring-no-properties
66 (match-beginning 2) (match-end 2))))
67 +circe-current-topic)))
68 (setq +circe-current-topic topic)
63 (when message 69 (when message
64 (message "%s" topic)) 70 (message "%s" topic))
65 topic)) 71 topic))
@@ -86,8 +92,8 @@ replace {nick} in the string with {NO-NICK}."
86 "Make a formatting regex for CHAR delimiters. 92 "Make a formatting regex for CHAR delimiters.
87For entry into `lui-formatting-list'." 93For entry into `lui-formatting-list'."
88 `(rx (or bol whitespace) 94 `(rx (or bol whitespace)
89 (group ,char (+? (not (any whitespace ,char))) ,char) 95 (group ,char (+? (not (any whitespace ,char))) ,char)
90 (or eol whitespace))) 96 (or eol whitespace)))
91 97
92;;; Hooks & Advice 98;;; Hooks & Advice
93 99
@@ -139,7 +145,7 @@ For entry into `lui-formatting-list'."
139 "What to do with `circe-server' buffers when created.") 145 "What to do with `circe-server' buffers when created.")
140 146
141(el-patch-defun circe (network-or-server &rest server-options) 147(el-patch-defun circe (network-or-server &rest server-options)
142 "Connect to IRC. 148 "Connect to IRC.
143 149
144Connect to the given network specified by NETWORK-OR-SERVER. 150Connect to the given network specified by NETWORK-OR-SERVER.
145 151
@@ -157,16 +163,16 @@ All SERVER-OPTIONS are treated as variables by getting the string
157locally in the server buffer. 163locally in the server buffer.
158 164
159See `circe-network-options' for a list of common options." 165See `circe-network-options' for a list of common options."
160 (interactive (circe--read-network-and-options)) 166 (interactive (circe--read-network-and-options))
161 (let* ((options (circe--server-get-network-options network-or-server 167 (let* ((options (circe--server-get-network-options network-or-server
162 server-options)) 168 server-options))
163 (buffer (circe--server-generate-buffer options))) 169 (buffer (circe--server-generate-buffer options)))
164 (with-current-buffer buffer 170 (with-current-buffer buffer
165 (circe-server-mode) 171 (circe-server-mode)
166 (circe--server-set-variables options) 172 (circe--server-set-variables options)
167 (circe-reconnect)) 173 (circe-reconnect))
168 (el-patch-swap (pop-to-buffer-same-window buffer) 174 (el-patch-swap (pop-to-buffer-same-window buffer)
169 (funcall +circe-server-buffer-action buffer)))) 175 (funcall +circe-server-buffer-action buffer))))
170 176
171;;; Chat commands 177;;; Chat commands
172 178
@@ -177,7 +183,7 @@ See `circe-network-options' for a list of common options."
177 nil t nil))) 183 nil t nil)))
178 (circe-command-ME (format "slaps %s about a bit with a large trout" nick))) 184 (circe-command-ME (format "slaps %s about a bit with a large trout" nick)))
179 185
180;;; Filtering functions 186;;; Filtering functions --- XXX: These don't work right.
181;; Set `lui-input-function' to `+lui-filter', then add the filters you want to 187;; Set `lui-input-function' to `+lui-filter', then add the filters you want to
182;; `circe-channel-mode-hook'. 188;; `circe-channel-mode-hook'.
183 189
diff --git a/lisp/+cus-edit.el b/lisp/+cus-edit.el index 7fa46d4..4631811 100644 --- a/lisp/+cus-edit.el +++ b/lisp/+cus-edit.el
@@ -50,7 +50,7 @@ pass t to it."
50 (cl-letf (((symbol-function 'custom-set-faces) 'ignore) 50 (cl-letf (((symbol-function 'custom-set-faces) 'ignore)
51 ((symbol-function 'custom-set-variables) 51 ((symbol-function 'custom-set-variables)
52 (lambda (&rest args) 52 (lambda (&rest args)
53 (apply 'custom-theme-set-variables 'user 53 (apply #'custom-theme-set-variables 'user
54 (seq-filter (lambda (el) 54 (seq-filter (lambda (el)
55 (memq (car el) 55 (memq (car el)
56 +custom-variable-allowlist)) 56 +custom-variable-allowlist))
diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 7c8a1a6..533d438 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el
@@ -326,13 +326,24 @@ ARG is passed to `backward-kill-word'."
326 (setq-default history-length t 326 (setq-default history-length t
327 history-delete-duplicates t 327 history-delete-duplicates t
328 history-autosave-interval 60 328 history-autosave-interval 60
329 savehist-file (.etc "savehist.el")) 329 savehist-file (.etc "savehist.el")
330 ;; Other variables --- don't truncate any of these.
331 ;; `add-to-history' uses the values of these variables unless
332 ;; they're nil, in which case it falls back to `history-length'.
333 kill-ring-max 100
334 mark-ring-max 100
335 global-mark-ring-max 100
336 regexp-search-ring-max 100
337 search-ring-max 100
338 kmacro-ring-max 100
339 eww-history-limit 100)
330 (dolist (var '(extended-command-history 340 (dolist (var '(extended-command-history
331 global-mark-ring 341 global-mark-ring
342 mark-ring
332 kill-ring 343 kill-ring
344 kmacro-ring
333 regexp-search-ring 345 regexp-search-ring
334 search-ring 346 search-ring))
335 mark-ring))
336 (add-to-list 'savehist-additional-variables var)) 347 (add-to-list 'savehist-additional-variables var))
337 (savehist-mode +1)) 348 (savehist-mode +1))
338 349
diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el index b995b7e..22f8c82 100644 --- a/lisp/+flyspell-correct.el +++ b/lisp/+flyspell-correct.el
@@ -2,10 +2,13 @@
2 2
3;;; Code: 3;;; Code:
4 4
5(require 'flyspell-correct)
6
5(defun +flyspell-correct-buffer (&optional prefix) 7(defun +flyspell-correct-buffer (&optional prefix)
6 "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. 8 "Run `flyspell-correct-wrapper' on all misspelled words in the buffer.
7With PREFIX, prompt to change the current dictionary." 9With PREFIX, prompt to change the current dictionary."
8 (interactive "P") 10 (interactive "P")
11 (flyspell-buffer)
9 (when prefix 12 (when prefix
10 (let ((current-prefix-arg nil)) 13 (let ((current-prefix-arg nil))
11 (call-interactively #'ispell-change-dictionary))) 14 (call-interactively #'ispell-change-dictionary)))
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 026302b..11d6a4c 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el
@@ -347,7 +347,7 @@ The order of elements matters: whichever one matches first is applied."
347(defun +modeline-line (&optional spacer) 347(defun +modeline-line (&optional spacer)
348 (when line-number-mode 348 (when line-number-mode
349 (+modeline-spacer nil spacer 349 (+modeline-spacer nil spacer
350 "%l"))) 350 "%3l")))
351 351
352(defun +modeline-column (&optional spacer) 352(defun +modeline-column (&optional spacer)
353 (when column-number-mode 353 (when column-number-mode
@@ -367,8 +367,8 @@ See `line-number-mode', `column-number-mode', and
367`file-percentage-mode'. If `+modeline-position-function' is set 367`file-percentage-mode'. If `+modeline-position-function' is set
368to a function in the current buffer, call that function instead." 368to a function in the current buffer, call that function instead."
369 (cond ((functionp +modeline-position-function) 369 (cond ((functionp +modeline-position-function)
370 (+modeline-spacer nil spacer 370 (when-let* ((str (funcall +modeline-position-function)))
371 (funcall +modeline-position-function))) 371 (+modeline-spacer nil spacer str)))
372 (t (funcall (+modeline-concat '(+modeline-region 372 (t (funcall (+modeline-concat '(+modeline-region
373 +modeline-line 373 +modeline-line
374 +modeline-column 374 +modeline-column
@@ -378,10 +378,9 @@ to a function in the current buffer, call that function instead."
378(defun +modeline-vc (&optional spacer) 378(defun +modeline-vc (&optional spacer)
379 "Display the version control branch of the current buffer in the modeline." 379 "Display the version control branch of the current buffer in the modeline."
380 ;; from https://www.gonsie.com/blorg/modeline.html, from Doom 380 ;; from https://www.gonsie.com/blorg/modeline.html, from Doom
381 (if-let ((backend (vc-backend buffer-file-name))) 381 (when-let ((backend (vc-backend buffer-file-name)))
382 (+modeline-spacer nil spacer 382 (+modeline-spacer nil spacer
383 (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))) 383 (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))))
384 ""))
385 384
386(defun +modeline-track (&optional spacer) 385(defun +modeline-track (&optional spacer)
387 "Display `tracking-mode' information." 386 "Display `tracking-mode' information."
@@ -473,13 +472,16 @@ to a function in the current buffer, call that function instead."
473 (kmacro-end-macro nil))))) 472 (kmacro-end-macro nil)))))
474 'mouse-face 'mode-line-highlight)))) 473 'mouse-face 'mode-line-highlight))))
475 474
475(defface +nyan-mode-line nil
476 "Face for nyan-cat in mode line.")
477
476(defun +modeline-nyan-on-focused (&optional spacer) 478(defun +modeline-nyan-on-focused (&optional spacer)
477 "Display the cat from `nyan-mode', but only on the focused window." 479 "Display the cat from `nyan-mode', but only on the focused window."
478 (require 'nyan-mode) 480 (require 'nyan-mode)
479 (when (actually-selected-window-p) 481 (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode))
480 (concat (or spacer "") (nyan-create) 482 (actually-selected-window-p))
481 (propertize "." 483 (+modeline-spacer nil spacer
482 'face 'font-lock-comment-face)))) 484 (propertize (nyan-create) 'face '+nyan-mode-line))))
483 485
484(provide '+modeline) 486(provide '+modeline)
485;;; +modeline.el ends here 487;;; +modeline.el ends here
diff --git a/lisp/+nyan-mode.el b/lisp/+nyan-mode.el new file mode 100644 index 0000000..fc6775b --- /dev/null +++ b/lisp/+nyan-mode.el
@@ -0,0 +1,39 @@
1;;; +nyan-mode.el --- Extras for nyan-mode -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;;; Update even without line number in the mode line.
8
9(defcustom +nyan-mode-update-functions
10 '( end-of-buffer beginning-of-buffer
11 next-line previous-line
12 org-next-visible-heading org-previous-visible-heading)
13 "Functions after which to force a mode-line update."
14 :type '(repeat function))
15
16(defun +nyan-mode--fmlu (&rest _)
17 "Update the mode-line, advice-style."
18 (force-mode-line-update))
19
20(defun +nyan-mode-advice (&rest _)
21 "Advise line-moving functions when in `nyan-mode'."
22 (dolist (fn +nyan-mode-update-functions)
23 (if nyan-mode
24 (advice-add fn :after #'+nyan-mode--fmlu)
25 (advice-remove fn #'+nyan-mode--fmlu))))
26
27(define-minor-mode +nyan-local-mode
28 "My very own `nyan-mode' that isn't global and doesn't update the mode-line."
29 :global nil
30 :group 'nyan
31 (dolist (fn +nyan-mode-update-functions)
32 (if +nyan-local-mode
33 (advice-add fn :after #'+nyan-mode--fmlu)
34 (advice-remove fn #'+nyan-mode--fmlu))))
35
36(define-globalized-minor-mode +nyan-mode +nyan-local-mode +nyan-local-mode)
37
38(provide '+nyan-mode)
39;;; +nyan-mode.el ends here
diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el index edd88f0..89b2708 100644 --- a/lisp/+org-wc.el +++ b/lisp/+org-wc.el
@@ -87,7 +87,7 @@ code... probably).")
87(defun +org-wc-modeline () 87(defun +org-wc-modeline ()
88 (cond 88 (cond
89 ((eq +org-wc-word-count 'huge) "huge") 89 ((eq +org-wc-word-count 'huge) "huge")
90 (+org-wc-word-count (format " %sw" (max 0 (+ +org-wc-word-count +org-wc-correction)))))) 90 (+org-wc-word-count (format "%sw" (max 0 (+ +org-wc-word-count +org-wc-correction))))))
91 91
92(define-minor-mode +org-wc-mode 92(define-minor-mode +org-wc-mode
93 "Count words in `org-mode' buffers in the mode-line." 93 "Count words in `org-mode' buffers in the mode-line."
diff --git a/lisp/+org.el b/lisp/+org.el index 6b93a7a..0d6e300 100644 --- a/lisp/+org.el +++ b/lisp/+org.el
@@ -2,6 +2,7 @@
2 2
3;;; Code: 3;;; Code:
4 4
5(require 'el-patch)
5(require 'org) 6(require 'org)
6(require 'org-element) 7(require 'org-element)
7(require 'ox) 8(require 'ox)
@@ -96,7 +97,7 @@ appropriate. In tables, insert a new row or end the table."
96 ;; for now, it works well enough. 97 ;; for now, it works well enough.
97 (cond ((and itemp emptyp) 98 (cond ((and itemp emptyp)
98 (delete-region (line-beginning-position) (line-end-position)) 99 (delete-region (line-beginning-position) (line-end-position))
99 (insert "\n\n")) 100 (insert "\n"))
100 ((or first-item-p 101 ((or first-item-p
101 (and itemp (not emptyp)) 102 (and itemp (not emptyp))
102 item-child-p) 103 item-child-p)
@@ -252,11 +253,11 @@ instead of the true count."
252 ((use-region-p) 253 ((use-region-p)
253 (message "%d words in region" 254 (message "%d words in region"
254 (+org-count-words-stupidly (region-beginning) 255 (+org-count-words-stupidly (region-beginning)
255 (region-end)))) 256 (region-end))))
256 (t 257 (t
257 (message "%d words in buffer" 258 (message "%d words in buffer"
258 (+org-count-words-stupidly (point-min) 259 (+org-count-words-stupidly (point-min)
259 (point-max)))))) 260 (point-max))))))
260 261
261;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ 262;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/
262 263
@@ -561,7 +562,7 @@ and POST-PROCESS are passed to `org-export-to-file'."
561 (let ((org-tmp-file "/tmp/org.html")) 562 (let ((org-tmp-file "/tmp/org.html"))
562 (org-export-to-file 'html org-tmp-file 563 (org-export-to-file 'html org-tmp-file
563 async subtreep visible-only body-only ext-plist post-process) 564 async subtreep visible-only body-only ext-plist post-process)
564 (start-process "xclicp" "*xclip*" 565 (start-process "xclip" "*xclip*"
565 "xclip" "-verbose" 566 "xclip" "-verbose"
566 "-i" org-tmp-file 567 "-i" org-tmp-file
567 "-t" "text/html" 568 "-t" "text/html"
@@ -684,5 +685,49 @@ This should only fire when switching to a buffer from `org-agenda'."
684 (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) 685 (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks)
685 (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) 686 (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks))))
686 687
688
689;;; "Fix" `org-align-tags'
690
691(el-patch-defun org-align-tags (&optional all)
692 "Align tags in current entry.
693When optional argument ALL is non-nil, align all tags in the
694visible part of the buffer."
695 (let ((get-indent-column
696 (lambda ()
697 (let ((offset (el-patch-swap
698 (if (bound-and-true-p org-indent-mode)
699 (* (1- org-indent-indentation-per-level)
700 (1- (org-current-level)))
701 0)
702 0)))
703 (+ org-tags-column
704 (if (> org-tags-column 0) (- offset) offset))))))
705 (if (and (not all) (org-at-heading-p))
706 (org--align-tags-here (funcall get-indent-column))
707 (save-excursion
708 (if all
709 (progn
710 (goto-char (point-min))
711 (while (re-search-forward org-tag-line-re nil t)
712 (org--align-tags-here (funcall get-indent-column))))
713 (org-back-to-heading t)
714 (org--align-tags-here (funcall get-indent-column)))))))
715
716;;; Meta-return
717
718(defun +org-meta-return (&optional arg)
719 "Insert a new line, or wrap a region in a table.
720See `org-meta-return', but `+org-return-dwim' does most of the
721stuff I would want out of that function already.
722
723When called with a prefix ARG, will still unconditionally call
724`org-insert-heading'."
725 (interactive "P")
726 (org-fold-check-before-invisible-edit 'insert)
727 (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations
728 (call-interactively (cond (arg #'org-insert-heading)
729 ((org-at-table-p) #'org-table-wrap-region)
730 (t #'org-return)))))
731
687(provide '+org) 732(provide '+org)
688;;; +org.el ends here 733;;; +org.el ends here
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index 3e6968e..7ff991c 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el
@@ -12,8 +12,8 @@
12 12
13(defface +tab-bar-extra 13(defface +tab-bar-extra
14 '((t :inherit (tab-bar font-lock-comment-face))) 14 '((t :inherit (tab-bar font-lock-comment-face)))
15 "Tab bar face for extra information, like the menu-bar and time." 15 "Tab bar face for extra information, like the menu-bar and time."
16 :group 'basic-faces) 16 :group 'basic-faces)
17 17
18 18
19;; Common 19;; Common
@@ -35,97 +35,97 @@
35(defun +tab-bar-tracking-mode () 35(defun +tab-bar-tracking-mode ()
36 "Display `tracking-mode-line-buffers' in the tab-bar." 36 "Display `tracking-mode-line-buffers' in the tab-bar."
37 ;; TODO: write something to convert a mode-line construct to a tab-bar 37 ;; TODO: write something to convert a mode-line construct to a tab-bar
38 ;; construct. 38 ;; construct.
39 (when (and (bound-and-true-p tracking-mode) 39 (when (and (bound-and-true-p tracking-mode)
40 (not (and +tracking-hide-when-org-clocking 40 (not (and +tracking-hide-when-org-clocking
41 (bound-and-true-p org-clock-current-task)))) 41 (bound-and-true-p org-clock-current-task))))
42 (cons (when (> (length tracking-mode-line-buffers) 0) 42 (cons (when (> (length tracking-mode-line-buffers) 0)
43 '(track-mode-line-separator menu-item " " ignore)) 43 '(track-mode-line-separator menu-item " " ignore))
44 (cl-loop for i from 0 below (length tracking-mode-line-buffers) 44 (cl-loop for i from 0 below (length tracking-mode-line-buffers)
45 as item = (nth i tracking-mode-line-buffers) 45 as item = (nth i tracking-mode-line-buffers)
46 collect (append (list (intern (format "tracking-mode-line-%s" i)) 46 collect (append (list (intern (format "tracking-mode-line-%s" i))
47 'menu-item 47 'menu-item
48 (string-trim (format-mode-line item))) 48 (string-trim (format-mode-line item)))
49 (if-let ((keymap (plist-get item 'keymap))) 49 (if-let ((keymap (plist-get item 'keymap)))
50 (list (alist-get 'down-mouse-1 (cdadr keymap))) 50 (list (alist-get 'down-mouse-1 (cdadr keymap)))
51 (list #'ignore)) 51 (list #'ignore))
52 (when-let ((help (plist-get item 'help-echo))) 52 (when-let ((help (plist-get item 'help-echo)))
53 (list :help help))))))) 53 (list :help help)))))))
54 54
55(defun +tab-bar-timer () 55(defun +tab-bar-timer ()
56 "Display `+timer-string' in the tab-bar." 56 "Display `+timer-string' in the tab-bar."
57 (when +timer-string 57 (when (> (length (bound-and-true-p +timer-string)) 0)
58 `((timer-string menu-item 58 `((timer-string menu-item
59 ,(concat " " +timer-string) 59 ,(concat " " +timer-string)
60 (lambda (ev) 60 (lambda (ev)
61 (interactive "e") 61 (interactive "e")
62 (cond ((not +timer-timer) nil) 62 (cond ((not +timer-timer) nil)
63 ((equal +timer-string +timer-running-string) 63 ((equal +timer-string +timer-running-string)
64 (popup-menu 64 (popup-menu
65 '("Running timer" 65 '("Running timer"
66 ["Cancel timer" +timer-cancel t]) 66 ["Cancel timer" +timer-cancel t])
67 ev)) 67 ev))
68 (t (setq +timer-string "")))))))) 68 (t (setq +timer-string ""))))))))
69 69
70(defun +tab-bar-date () 70(defun +tab-bar-date ()
71 "Display `display-time-string' in the tab-bar." 71 "Display `display-time-string' in the tab-bar."
72 (when display-time-mode 72 (when display-time-mode
73 `((date-time-string menu-item 73 `((date-time-string menu-item
74 ,(substring-no-properties (concat " " (string-trim display-time-string))) 74 ,(substring-no-properties (concat " " (string-trim display-time-string)))
75 (lambda (ev) 75 (lambda (ev)
76 (interactive "e") 76 (interactive "e")
77 (popup-menu 77 (popup-menu
78 (append '("Timer") 78 (append '("Timer")
79 (let (r) 79 (let (r)
80 (dolist (time '(3 5 10)) 80 (dolist (time '(3 5 10))
81 (push (vector (format "Timer for %d minutes" time) 81 (push (vector (format "Timer for %d minutes" time)
82 `(lambda () (interactive) 82 `(lambda () (interactive)
83 (+timer ,time)) 83 (+timer ,time))
84 :active t) 84 :active t)
85 r)) 85 r))
86 (nreverse r)) 86 (nreverse r))
87 '(["Timer for ..." +timer t])) 87 '(["Timer for ..." +timer t]))
88 ev)) 88 ev))
89 :help (discord-date-string))))) 89 :help (discord-date-string)))))
90 90
91(defun +tab-bar-notmuch-count () 91(defun +tab-bar-notmuch-count ()
92 "Display a notmuch count in the tab-bar." 92 "Display a notmuch count in the tab-bar."
93 (when (and (executable-find "notmuch") 93 (when (and (executable-find "notmuch")
94 (featurep 'notmuch)) 94 (featurep 'notmuch))
95 (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) 95 (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches)))
96 (next (cl-find "inbox" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) 96 (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal))
97 (next-count (plist-get next :count))) 97 (next-count (plist-get next :count)))
98 (when (and next-count (> next-count 0)) 98 (when (and next-count (> next-count 0))
99 `((notmuch-count menu-item 99 `((notmuch-count menu-item
100 ,(format " |%s|" next-count) 100 ,(format " |%s|" next-count)
101 ignore 101 ignore
102 :help ,(format "%s mails requiring attention." next-count))))))) 102 :help ,(format "%s mails requiring attention." next-count)))))))
103 103
104(defun +tab-bar-org-clock () 104(defun +tab-bar-org-clock ()
105 "Display `org-mode-line-string' in the tab-bar." 105 "Display `org-mode-line-string' in the tab-bar."
106 (when (and (fboundp 'org-clocking-p) 106 (when (and (fboundp 'org-clocking-p)
107 (org-clocking-p)) 107 (org-clocking-p))
108 ;; org-mode-line-string 108 ;; org-mode-line-string
109 `((org-clocking menu-item 109 `((org-clocking menu-item
110 ,org-mode-line-string 110 ,org-mode-line-string
111 (lambda (ev) 111 (lambda (ev)
112 (interactive "e") 112 (interactive "e")
113 (let ((menu (make-sparse-keymap 113 (let ((menu (make-sparse-keymap
114 (or org-clock-current-task "Org-Clock")))) 114 (or org-clock-current-task "Org-Clock"))))
115 (map-keymap (lambda (key binding) 115 (map-keymap (lambda (key binding)
116 (when (consp binding) 116 (when (consp binding)
117 (define-key-after menu (vector key) 117 (define-key-after menu (vector key)
118 (copy-sequence binding)))) 118 (copy-sequence binding))))
119 (org-clock-menu)) 119 (org-clock-menu))
120 (message "%S" ev) 120 (message "%S" ev)
121 (popup-menu menu ev))) 121 (popup-menu menu ev)))
122 :help ,(or (replace-regexp-in-string 122 :help ,(or (replace-regexp-in-string
123 (rx "[[" (group (* (not "]"))) 123 (rx "[[" (group (* (not "]")))
124 "][" (group (* (not "]"))) 124 "][" (group (* (not "]")))
125 "]]") 125 "]]")
126 "\\2" 126 "\\2"
127 org-clock-current-task) 127 org-clock-current-task)
128 "Org-Clock"))))) 128 "Org-Clock")))))
129 129
130(defcustom +tab-bar-emms-max-length 24 130(defcustom +tab-bar-emms-max-length 24
131 "Maximum length of `+tab-bar-emms'." 131 "Maximum length of `+tab-bar-emms'."
@@ -139,8 +139,8 @@
139 (- +tab-bar-emms-max-length 2)))) 139 (- +tab-bar-emms-max-length 2))))
140 `(emms-now-playing menu-item 140 `(emms-now-playing menu-item
141 ,(concat "{" now-playing "}" " ") 141 ,(concat "{" now-playing "}" " ")
142 emms-pause 142 emms-pause
143 ( :help ,(emms-mode-line-playlist-current)))))) 143 ( :help ,(emms-mode-line-playlist-current))))))
144 144
145(defun +tab-bar-bongo () 145(defun +tab-bar-bongo ()
146 "Display Bongo now playing information." 146 "Display Bongo now playing information."
@@ -160,22 +160,22 @@
160 "\\1: \\3" 160 "\\1: \\3"
161 (bongo-formatted-infoset)) 161 (bongo-formatted-infoset))
162 ;; This isn't right 162 ;; This isn't right
163 (- (min 50 (/ (frame-width) 3 )) 2))) 163 (- (min 50 (/ (frame-width) 3 )) 2)))
164 "}") 164 "}")
165 (lambda () (interactive) 165 (lambda () (interactive)
166 (let ((bongo-playlist-buffer 166 (let ((bongo-playlist-buffer
167 ;; XXX: I'm sure this is terribly inefficient 167 ;; XXX: I'm sure this is terribly inefficient
168 (cl-some (lambda (b) 168 (cl-some (lambda (b)
169 (with-current-buffer b 169 (with-current-buffer b
170 (when-let* ((modep (derived-mode-p 170 (when-let* ((modep (derived-mode-p
171 'bongo-playlist-mode)) 171 'bongo-playlist-mode))
172 (bongo-playlist-buffer b) 172 (bongo-playlist-buffer b)
173 (playingp (bongo-playing-p))) 173 (playingp (bongo-playing-p)))
174 b))) 174 b)))
175 (buffer-list)))) 175 (buffer-list))))
176 (with-bongo-playlist-buffer 176 (with-bongo-playlist-buffer
177 (bongo-pause/resume)))) 177 (bongo-pause/resume))))
178 :help ,(funcall bongo-header-line-function))))) 178 :help ,(funcall bongo-header-line-function)))))
179 179
180(defvar +tab-bar-show-original nil 180(defvar +tab-bar-show-original nil
181 "Original value of `tab-bar-show'.") 181 "Original value of `tab-bar-show'.")
@@ -192,49 +192,49 @@
192 192
193;;; FIXME this doesn't work... 193;;; FIXME this doesn't work...
194;; (defvar +tab-bar-tab-min-width 8 194;; (defvar +tab-bar-tab-min-width 8
195;; "Minimum width of a tab on the tab bar.") 195 ;; "Minimum width of a tab on the tab bar.")
196 196
197;; (defvar +tab-bar-tab-max-width 24 197;; (defvar +tab-bar-tab-max-width 24
198;; "Maximum width of a tab on the tab bar.") 198 ;; "Maximum width of a tab on the tab bar.")
199 199
200;; (defun +tab-bar-fluid-calculate-width () 200;; (defun +tab-bar-fluid-calculate-width ()
201;; "Calculate the width of each tab in the tab-bar." 201 ;; "Calculate the width of each tab in the tab-bar."
202;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) 202 ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1)))
203;; (tab-bar-avail-width (frame-width)) 203 ;; (tab-bar-avail-width (frame-width))
204;; (tab-bar-tab-count (length (tab-bar-tabs))) 204 ;; (tab-bar-tab-count (length (tab-bar-tabs)))
205;; (tab-bar-close-button-char-width 1) 205 ;; (tab-bar-close-button-char-width 1)
206;; (tab-bar-add-tab-button-char-width 1) 206 ;; (tab-bar-add-tab-button-char-width 1)
207;; (tab-bar-total-width 207 ;; (tab-bar-total-width
208;; (length (mapconcat 208 ;; (length (mapconcat
209;; (lambda (el) 209 ;; (lambda (el)
210;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) 210 ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el)))))
211;; (substring-no-properties (eval str)))) 211 ;; (substring-no-properties (eval str))))
212;; tab-bar-list))) 212 ;; tab-bar-list)))
213;; (tab-bar-total-tab-width 213 ;; (tab-bar-total-tab-width
214;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) 214 ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width)
215;; tab-bar-add-tab-button-char-width 215 ;; tab-bar-add-tab-button-char-width
216;; (length (mapconcat 216 ;; (length (mapconcat
217;; (lambda (el) 217 ;; (lambda (el)
218;; (substring-no-properties (alist-get 'name el))) 218 ;; (substring-no-properties (alist-get 'name el)))
219;; (tab-bar-tabs))))) 219 ;; (tab-bar-tabs)))))
220;; (tab-bar-total-nontab-width (- tab-bar-total-width 220 ;; (tab-bar-total-nontab-width (- tab-bar-total-width
221;; tab-bar-total-tab-width))) 221 ;; tab-bar-total-tab-width)))
222;; (min +tab-bar-tab-max-width 222 ;; (min +tab-bar-tab-max-width
223;; (max +tab-bar-tab-min-width 223 ;; (max +tab-bar-tab-min-width
224;; (/ (- tab-bar-avail-width 224 ;; (/ (- tab-bar-avail-width
225;; tab-bar-total-tab-width 225 ;; tab-bar-total-tab-width
226;; tab-bar-total-nontab-width) 226 ;; tab-bar-total-nontab-width)
227;; tab-bar-tab-count))))) 227 ;; tab-bar-tab-count)))))
228 228
229;; (defun +tab-bar-fluid-width () 229;; (defun +tab-bar-fluid-width ()
230;; "Generate the tab name to fluidly fit in the given space." 230 ;; "Generate the tab name to fluidly fit in the given space."
231;; (let* ((tab-file-name (buffer-file-name (window-buffer 231 ;; (let* ((tab-file-name (buffer-file-name (window-buffer
232;; (minibuffer-selected-window))))) 232 ;; (minibuffer-selected-window)))))
233;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) 233 ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width))
234;; (if tab-file-name 234 ;; (if tab-file-name
235;; (file-name-nondirectory tab-file-name) 235 ;; (file-name-nondirectory tab-file-name)
236;; (+tab-bar-tab-name-truncated-left)) 236 ;; (+tab-bar-tab-name-truncated-left))
237;; " "))) 237 ;; " ")))
238 238
239(defun +tab-bar-tab-name-truncated-left () 239(defun +tab-bar-tab-name-truncated-left ()
240 "Generate the tab name from the buffer of the selected window. 240 "Generate the tab name from the buffer of the selected window.
@@ -259,13 +259,13 @@ name to the left."
259(defun +tab-bar-format-align-right () 259(defun +tab-bar-format-align-right ()
260 "Align the rest of tab bar items to the right, pixel-wise." 260 "Align the rest of tab bar items to the right, pixel-wise."
261 ;; XXX: ideally, wouldn't require `shr' here 261 ;; XXX: ideally, wouldn't require `shr' here
262 (require 'shr) ; `shr-string-pixel-width' 262 (require 'shr) ; `shr-string-pixel-width'
263 (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) 263 (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format)))
264 (rest (tab-bar-format-list rest)) 264 (rest (tab-bar-format-list rest))
265 (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) 265 (rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
266 (hpos (shr-string-pixel-width rest)) 266 (hpos (shr-string-pixel-width rest))
267 (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) 267 (str (propertize " " 'display `(space :align-to (- right (,hpos))))))
268 `((align-right menu-item ,str ignore)))) 268 `((align-right menu-item ,str ignore))))
269 269
270 270
271;;; Menu bar 271;;; Menu bar
@@ -309,18 +309,18 @@ Used by `tab-bar-format-menu-bar'."
309 `((current-tab 309 `((current-tab
310 menu-item 310 menu-item
311 ,(funcall tab-bar-tab-name-format-function tab i) 311 ,(funcall tab-bar-tab-name-format-function tab i)
312 ignore 312 ignore
313 :help "Current tab"))) 313 :help "Current tab")))
314 (t 314 (t
315 `((,(intern (format "tab-%i" i)) 315 `((,(intern (format "tab-%i" i))
316 menu-item 316 menu-item
317 ,(funcall tab-bar-tab-name-format-function tab i) 317 ,(funcall tab-bar-tab-name-format-function tab i)
318 ,(alist-get 'binding tab) 318 ,(alist-get 'binding tab)
319 :help "Click to visit tab")))) 319 :help "Click to visit tab"))))
320 (when (alist-get 'close-binding tab) 320 (when (alist-get 'close-binding tab)
321 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) 321 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
322 menu-item "" 322 menu-item ""
323 ,(alist-get 'close-binding tab))))))) 323 ,(alist-get 'close-binding tab)))))))
324 324
325 325
326;; Emacs 27 326;; Emacs 27
@@ -334,7 +334,7 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
334 ,reserve))))) 334 ,reserve)))))
335 (prog1 (append output 335 (prog1 (append output
336 `((align-right menu-item ,str nil)) 336 `((align-right menu-item ,str nil))
337 (+tab-bar-misc-info))))) 337 (+tab-bar-misc-info)))))
338 338
339 339
340;; Emacs 28 340;; Emacs 28
@@ -353,27 +353,27 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
353(define-minor-mode +tab-bar-misc-info-mode 353(define-minor-mode +tab-bar-misc-info-mode
354 "Show the `mode-line-misc-info' in the `tab-bar'." 354 "Show the `mode-line-misc-info' in the `tab-bar'."
355 :lighter "" 355 :lighter ""
356 :global t 356 :global t
357 (if +tab-bar-misc-info-mode 357 (if +tab-bar-misc-info-mode
358 (progn ; Enable 358 (progn ; Enable
359 (setq +tab-bar-show-original tab-bar-show) 359 (setq +tab-bar-show-original tab-bar-show)
360 (cond 360 (cond
361 ((boundp 'tab-bar-format) ; Emacs 28 361 ((boundp 'tab-bar-format) ; Emacs 28
362 (setq +tab-bar-format-original tab-bar-format) 362 (setq +tab-bar-format-original tab-bar-format)
363 (unless (memq '+tab-bar-misc-info tab-bar-format) 363 (unless (memq '+tab-bar-misc-info tab-bar-format)
364 (setq tab-bar-format 364 (setq tab-bar-format
365 (append tab-bar-format (+tab-bar-misc-info-28))))) 365 (append tab-bar-format (+tab-bar-misc-info-28)))))
366 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 366 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
367 (advice-add 'tab-bar-make-keymap-1 :filter-return 367 (advice-add 'tab-bar-make-keymap-1 :filter-return
368 '+tab-bar-misc-info-27))) 368 '+tab-bar-misc-info-27)))
369 (setq tab-bar-show t)) 369 (setq tab-bar-show t))
370 (progn ; Disable 370 (progn ; Disable
371 (setq tab-bar-show +tab-bar-show-original) 371 (setq tab-bar-show +tab-bar-show-original)
372 (cond 372 (cond
373 ((boundp 'tab-bar-format) ; Emacs 28 373 ((boundp 'tab-bar-format) ; Emacs 28
374 (setq tab-bar-format +tab-bar-format-original)) 374 (setq tab-bar-format +tab-bar-format-original))
375 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 375 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
376 (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) 376 (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27))))))
377 377
378 378
379 379
diff --git a/lisp/+window.el b/lisp/+window.el new file mode 100644 index 0000000..52b3712 --- /dev/null +++ b/lisp/+window.el
@@ -0,0 +1,130 @@
1;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Do I want to propose this change in the Emacs ML?
6
7;;; Code:
8
9(require 'window)
10
11;;; Split windows based on `window-total-width', not `window-width'
12;; I have to just redefine these functions because the check is really deep in
13;; there.
14
15(defun window-splittable-p (window &optional horizontal)
16 "Return non-nil if `split-window-sensibly' may split WINDOW.
17Optional argument HORIZONTAL nil or omitted means check whether
18`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
19non-nil means check whether WINDOW may be split horizontally.
20
21WINDOW may be split vertically when the following conditions
22hold:
23- `window-size-fixed' is either nil or equals `width' for the
24 buffer of WINDOW.
25- `split-height-threshold' is an integer and WINDOW is at least as
26 high as `split-height-threshold'.
27- When WINDOW is split evenly, the emanating windows are at least
28 `window-min-height' lines tall and can accommodate at least one
29 line plus - if WINDOW has one - a mode line.
30
31WINDOW may be split horizontally when the following conditions
32hold:
33- `window-size-fixed' is either nil or equals `height' for the
34 buffer of WINDOW.
35- `split-width-threshold' is an integer and WINDOW is at least as
36 wide as `split-width-threshold'.
37- When WINDOW is split evenly, the emanating windows are at least
38 `window-min-width' or two (whichever is larger) columns wide."
39 (when (and (window-live-p window)
40 (not (window-parameter window 'window-side)))
41 (with-current-buffer (window-buffer window)
42 (if horizontal
43 ;; A window can be split horizontally when its width is not
44 ;; fixed, it is at least `split-width-threshold' columns wide
45 ;; and at least twice as wide as `window-min-width' and 2 (the
46 ;; latter value is hardcoded).
47 (and (memq window-size-fixed '(nil height))
48 ;; Testing `window-full-width-p' here hardly makes any
49 ;; sense nowadays. This can be done more intuitively by
50 ;; setting up `split-width-threshold' appropriately.
51 (numberp split-width-threshold)
52 (>= (window-total-width window)
53 (max split-width-threshold
54 (* 2 (max window-min-width 2)))))
55 ;; A window can be split vertically when its height is not
56 ;; fixed, it is at least `split-height-threshold' lines high,
57 ;; and it is at least twice as high as `window-min-height' and 2
58 ;; if it has a mode line or 1.
59 (and (memq window-size-fixed '(nil width))
60 (numberp split-height-threshold)
61 (>= (window-height window)
62 (max split-height-threshold
63 (* 2 (max window-min-height
64 (if mode-line-format 2 1))))))))))
65
66(defun split-window-sensibly (&optional window)
67 "Split WINDOW in a way suitable for `display-buffer'.
68WINDOW defaults to the currently selected window.
69If `split-height-threshold' specifies an integer, WINDOW is at
70least `split-height-threshold' lines tall and can be split
71vertically, split WINDOW into two windows one above the other and
72return the lower window. Otherwise, if `split-width-threshold'
73specifies an integer, WINDOW is at least `split-width-threshold'
74columns wide and can be split horizontally, split WINDOW into two
75windows side by side and return the window on the right. If this
76can't be done either and WINDOW is the only window on its frame,
77try to split WINDOW vertically disregarding any value specified
78by `split-height-threshold'. If that succeeds, return the lower
79window. Return nil otherwise.
80
81By default `display-buffer' routines call this function to split
82the largest or least recently used window. To change the default
83customize the option `split-window-preferred-function'.
84
85You can enforce this function to not split WINDOW horizontally,
86by setting (or binding) the variable `split-width-threshold' to
87nil. If, in addition, you set `split-height-threshold' to zero,
88chances increase that this function does split WINDOW vertically.
89
90In order to not split WINDOW vertically, set (or bind) the
91variable `split-height-threshold' to nil. Additionally, you can
92set `split-width-threshold' to zero to make a horizontal split
93more likely to occur.
94
95Have a look at the function `window-splittable-p' if you want to
96know how `split-window-sensibly' determines whether WINDOW can be
97split."
98 (let ((window (or window (selected-window))))
99 (or (and (window-splittable-p window)
100 ;; Split window vertically.
101 (with-selected-window window
102 (split-window-below)))
103 (and (window-splittable-p window t)
104 ;; Split window horizontally.
105 (with-selected-window window
106 (split-window-right)))
107 (and
108 ;; If WINDOW is the only usable window on its frame (it is
109 ;; the only one or, not being the only one, all the other
110 ;; ones are dedicated) and is not the minibuffer window, try
111 ;; to split it vertically disregarding the value of
112 ;; `split-height-threshold'.
113 (let ((frame (window-frame window)))
114 (or
115 (eq window (frame-root-window frame))
116 (catch 'done
117 (walk-window-tree (lambda (w)
118 (unless (or (eq w window)
119 (window-dedicated-p w))
120 (throw 'done nil)))
121 frame nil 'nomini)
122 t)))
123 (not (window-minibuffer-p window))
124 (let ((split-height-threshold 0))
125 (when (window-splittable-p window)
126 (with-selected-window window
127 (split-window-below))))))))
128
129(provide '+window)
130;;; +window.el ends here
diff --git a/lisp/private.el b/lisp/private.el index f9c4753..4f6115e 100644 --- a/lisp/private.el +++ b/lisp/private.el
@@ -15,5 +15,9 @@
15 "Private secretive secrets inside.") 15 "Private secretive secrets inside.")
16(add-to-list 'load-path private/) 16(add-to-list 'load-path private/)
17 17
18;; Load random private stuff
19
20(require '_acdw)
21
18(provide 'private) 22(provide 'private)
19;;; private.el ends here 23;;; private.el ends here
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.