diff options
-rw-r--r-- | init.el | 5 | ||||
-rw-r--r-- | lisp/acdw-org.el | 125 |
2 files changed, 82 insertions, 48 deletions
diff --git a/init.el b/init.el index e7999cd..bee4ca9 100644 --- a/init.el +++ b/init.el | |||
@@ -735,6 +735,11 @@ if ripgrep is installed, otherwise `consult-grep'." | |||
735 | (setup (:straight company) | 735 | (setup (:straight company) |
736 | (:hook-into prog-mode) | 736 | (:hook-into prog-mode) |
737 | (:hook company-tng-mode) | 737 | (:hook company-tng-mode) |
738 | |||
739 | (if (eq acdw/system :home) | ||
740 | (setq company-idle-delay 0.25) | ||
741 | (setq company-idle-delay nil)) | ||
742 | |||
738 | (:global "M-/" company-complete) | 743 | (:global "M-/" company-complete) |
739 | (:with-map company-active-map | 744 | (:with-map company-active-map |
740 | (:bind "C-d" company-show-doc-buffer | 745 | (:bind "C-d" company-show-doc-buffer |
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 47e8eb2..06803d3 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el | |||
@@ -17,49 +17,42 @@ | |||
17 | 17 | ||
18 | ;;; Code: | 18 | ;;; Code: |
19 | 19 | ||
20 | |||
20 | ;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el | 21 | ;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el |
21 | 22 | ||
22 | ;;; ORG-RETURN-DWIM | ||
23 | |||
24 | (defun unpackaged/org-element-descendant-of (type element) | 23 | (defun unpackaged/org-element-descendant-of (type element) |
25 | "Return non-nil if ELEMENT is a descendant of TYPE. | 24 | "Return non-nil if ELEMENT is a descendant of TYPE. |
26 | TYPE should be an element type, like `item' or `paragraph'. | 25 | TYPE should be an element type, like `item' or `paragraph'. |
27 | ELEMENT should be a list like that returned by | 26 | ELEMENT should be a list like that returned by `org-element-context'." |
28 | `org-element-context'." | ||
29 | ;; MAYBE: Use `org-element-lineage'. | 27 | ;; MAYBE: Use `org-element-lineage'. |
30 | (when-let* ((parent (org-element-property :parent element))) | 28 | (when-let* ((parent (org-element-property :parent element))) |
31 | (or (eq type (car parent)) | 29 | (or (eq type (car parent)) |
32 | (unpackaged/org-element-descendant-of type parent)))) | 30 | (unpackaged/org-element-descendant-of type parent)))) |
33 | 31 | ||
32 | ;;;###autoload | ||
34 | (defun unpackaged/org-return-dwim (&optional default) | 33 | (defun unpackaged/org-return-dwim (&optional default) |
35 | "A helpful replacement for `org-return'. With prefix, | 34 | "A helpful replacement for `org-return'. With prefix, call `org-return'. |
36 | call `org-return'. | ||
37 | 35 | ||
38 | On headings, move point to position after entry content. In | 36 | On headings, move point to position after entry content. In |
39 | lists, insert a new item or end the list, with checkbox if | 37 | lists, insert a new item or end the list, with checkbox if |
40 | appropriate. In tables, insert a new row or end the table." | 38 | appropriate. In tables, insert a new row or end the table." |
41 | ;; Inspired by John Kitchin: | 39 | ;; Inspired by John Kitchin: http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ |
42 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
43 | (interactive "P") | 40 | (interactive "P") |
44 | (if default | 41 | (if default |
45 | (org-return) | 42 | (org-return) |
46 | (cond | 43 | (cond |
47 | ;; Act depending on context around point. | 44 | ;; Act depending on context around point. |
48 | 45 | ||
49 | ;; NOTE: I prefer RET to not follow links, but by uncommenting | 46 | ;; NOTE: I prefer RET to not follow links, but by uncommenting this block, links will be |
50 | ;; this block, links will be followed. | 47 | ;; followed. |
51 | ;; FURTHER NOTE: Ideally, I would follow links unless point | ||
52 | ;; /appeared/ to be at the end of the line (even if it's still | ||
53 | ;; inside the link) -- when it would do `org-return'. That | ||
54 | ;; would take some /doing/, however. | ||
55 | 48 | ||
56 | ;; ((eq 'link (car (org-element-context))) | 49 | ;; ((eq 'link (car (org-element-context))) |
57 | ;; ;; Link: Open it. | 50 | ;; ;; Link: Open it. |
58 | ;; (org-open-at-point-global)) | 51 | ;; (org-open-at-point-global)) |
59 | 52 | ||
60 | ((org-at-heading-p) | 53 | ((org-at-heading-p) |
61 | ;; Heading: Move to position after entry content. NOTE: This is | 54 | ;; Heading: Move to position after entry content. |
62 | ;; probably the most interesting feature of this function. | 55 | ;; NOTE: This is probably the most interesting feature of this function. |
63 | (let ((heading-start (org-entry-beginning-position))) | 56 | (let ((heading-start (org-entry-beginning-position))) |
64 | (goto-char (org-entry-end-position)) | 57 | (goto-char (org-entry-end-position)) |
65 | (cond ((and (org-at-heading-p) | 58 | (cond ((and (org-at-heading-p) |
@@ -76,13 +69,8 @@ appropriate. In tables, insert a new row or end the table." | |||
76 | (forward-line) | 69 | (forward-line) |
77 | (insert "\n") | 70 | (insert "\n") |
78 | (forward-line -1)) | 71 | (forward-line -1)) |
79 | ;; FIXME: looking-back is supposed to be called with | 72 | ;; FIXME: looking-back is supposed to be called with more arguments. |
80 | ;; more arguments. | 73 | (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))))) |
81 | (while (not (looking-back (rx | ||
82 | (repeat 3 | ||
83 | (seq (optional blank) | ||
84 | "\n"))) | ||
85 | nil)) | ||
86 | (insert "\n")) | 74 | (insert "\n")) |
87 | (forward-line -1))))) | 75 | (forward-line -1))))) |
88 | 76 | ||
@@ -91,23 +79,33 @@ appropriate. In tables, insert a new row or end the table." | |||
91 | (org-insert-todo-heading nil)) | 79 | (org-insert-todo-heading nil)) |
92 | 80 | ||
93 | ((org-in-item-p) | 81 | ((org-in-item-p) |
94 | ;; Plain list. Yes, this gets a little complicated... | 82 | ;; Plain list |
95 | (let ((context (org-element-context))) | 83 | (let* ((context (org-element-context)) |
96 | (if (or (eq 'plain-list (car context)) ; First item in list | 84 | (first-item-p (eq 'plain-list (car context))) |
97 | (and (eq 'item (car context)) | 85 | (itemp (eq 'item (car context))) |
98 | (not (eq (org-element-property | 86 | (emptyp (eq (org-element-property :contents-begin context) |
99 | :contents-begin context) | 87 | (org-element-property :contents-end context))) |
100 | (org-element-property | 88 | (item-child-p |
101 | :contents-end context)))) | 89 | (unpackaged/org-element-descendant-of 'item context))) |
102 | ;; Element in list item, e.g. a link | 90 | (message "(or %S (and %S %S) %S)" |
103 | (unpackaged/org-element-descendant-of 'item context)) | 91 | first-item-p |
104 | ;; Non-empty item: Add new item. | 92 | itemp (not emptyp) |
105 | (org-insert-item) | 93 | item-child-p) |
106 | ;; Empty item: Close the list. | 94 | ;; The original function from unpackaged just tested the (or ...) test |
107 | ;; TODO: Do this with org functions rather than operating | 95 | ;; in this cond, in an if. However, that doesn't auto-end nested |
108 | ;; on the text. Can't seem to find the right function. | 96 | ;; lists. So I made this form a cond and added the (and...) test in |
109 | (delete-region (line-beginning-position) (line-end-position)) | 97 | ;; the first position, which is clunky (the delete-region... stuff |
110 | (insert "\n")))) | 98 | ;; comes twice) and might not be needed. More testing, obviously, but |
99 | ;; for now, it works well enough. | ||
100 | (cond ((and itemp emptyp) | ||
101 | (delete-region (line-beginning-position) (line-end-position)) | ||
102 | (newline 2)) | ||
103 | ((or first-item-p | ||
104 | (and itemp (not emptyp)) | ||
105 | item-child-p) | ||
106 | (org-insert-item)) | ||
107 | (t (delete-region (line-beginning-position) (line-end-position)) | ||
108 | (newline))))) | ||
111 | 109 | ||
112 | ((when (fboundp 'org-inlinetask-in-task-p) | 110 | ((when (fboundp 'org-inlinetask-in-task-p) |
113 | (org-inlinetask-in-task-p)) | 111 | (org-inlinetask-in-task-p)) |
@@ -120,14 +118,11 @@ appropriate. In tables, insert a new row or end the table." | |||
120 | ;; See `org-table-next-field'. | 118 | ;; See `org-table-next-field'. |
121 | (cl-loop with end = (line-end-position) | 119 | (cl-loop with end = (line-end-position) |
122 | for cell = (org-element-table-cell-parser) | 120 | for cell = (org-element-table-cell-parser) |
123 | always (equal (org-element-property | 121 | always (equal (org-element-property :contents-begin cell) |
124 | :contents-begin cell) | 122 | (org-element-property :contents-end cell)) |
125 | (org-element-property | ||
126 | :contents-end cell)) | ||
127 | while (re-search-forward "|" end t))) | 123 | while (re-search-forward "|" end t))) |
128 | ;; Empty row: end the table. | 124 | ;; Empty row: end the table. |
129 | (delete-region (line-beginning-position) | 125 | (delete-region (line-beginning-position) (line-end-position)) |
130 | (line-end-position)) | ||
131 | (org-return)) | 126 | (org-return)) |
132 | (t | 127 | (t |
133 | ;; Non-empty row: call `org-return'. | 128 | ;; Non-empty row: call `org-return'. |
@@ -136,8 +131,6 @@ appropriate. In tables, insert a new row or end the table." | |||
136 | ;; All other cases: call `org-return'. | 131 | ;; All other cases: call `org-return'. |
137 | (org-return))))) | 132 | (org-return))))) |
138 | 133 | ||
139 | ;;; ORG-FIX-BLANK-LINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
140 | |||
141 | (defun unpackaged/org-fix-blank-lines (&optional prefix) | 134 | (defun unpackaged/org-fix-blank-lines (&optional prefix) |
142 | "Ensure that blank lines exist between headings and | 135 | "Ensure that blank lines exist between headings and |
143 | between headings and their contents. With prefix, operate on | 136 | between headings and their contents. With prefix, operate on |
@@ -181,6 +174,42 @@ appropriate. In tables, insert a new row or end the table." | |||
181 | (let ((current-prefix-arg 4)) | 174 | (let ((current-prefix-arg 4)) |
182 | (call-interactively #'unpackaged/org-fix-blank-lines)))) | 175 | (call-interactively #'unpackaged/org-fix-blank-lines)))) |
183 | 176 | ||
177 | |||
178 | ;;; Generate custom IDs: | ||
179 | ;; https://amitp.blogspot.com/2021/04/automatically-generate-ids-for-emacs.html | ||
180 | |||
181 | (defun acdw-org/generate-custom-ids () | ||
182 | "Generate CUSTOM_ID for any headings that are missing one." | ||
183 | (let ((existing-ids (org-map-entries (lambda () | ||
184 | (org-entry-get nil "CUSTOM_ID"))))) | ||
185 | (org-map-entries | ||
186 | (lambda () | ||
187 | (let* ((custom-id (org-entry-get nil "CUSTOM_ID")) | ||
188 | (heading (org-heading-components)) | ||
189 | (level (nth 0 heading)) | ||
190 | (todo (nth 2 heading)) | ||
191 | (headline (nth 4 heading)) | ||
192 | (slug (acdw-org/title-to-filename headline)) | ||
193 | (duplicate-id (member slug existing-ids))) | ||
194 | (when (and (not custom-id) | ||
195 | (< level 4) | ||
196 | (not todo) | ||
197 | (not duplicate-id)) | ||
198 | (message "Adding entry '%s' to '%s'" slug headline) | ||
199 | (org-entry-put nil "CUSTOM_ID" slug))))))) | ||
200 | |||
201 | (defun acdw-org/title-to-filename (title) | ||
202 | "Convert TITLE to a reasonable filename." | ||
203 | ;; Based on the slug logic in `org-roam', but `org-roam' also uses a | ||
204 | ;; timestamp, and I only use the slug. | ||
205 | (setq title (s-downcase title)) | ||
206 | (setq title (s-replace-regexp "[^a-zA-Z0-9]+" "-" title)) | ||
207 | (setq title (s-replace-regexp "-+" "-" title)) | ||
208 | (setq title (s-replace-regexp "^-" "" title)) | ||
209 | (setq title (s-replace-regexp "-$" "" title)) | ||
210 | title) | ||
211 | |||
212 | |||
184 | ;;; ADVICE | 213 | ;;; ADVICE |
185 | 214 | ||
186 | ;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify' | 215 | ;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify' |