diff options
Diffstat (limited to 'lisp/+org.el')
-rw-r--r-- | lisp/+org.el | 341 |
1 files changed, 341 insertions, 0 deletions
diff --git a/lisp/+org.el b/lisp/+org.el new file mode 100644 index 0000000..a4ce230 --- /dev/null +++ b/lisp/+org.el | |||
@@ -0,0 +1,341 @@ | |||
1 | ;;; +org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'org) | ||
6 | (require 'org-element) | ||
7 | (require 'ox) | ||
8 | |||
9 | ;;; org-return-dwim - https://github.com/alphapapa/unpackaged.el | ||
10 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
11 | |||
12 | (defun +org-element-descendant-of (type element) | ||
13 | "Return non-nil if ELEMENT is a descendant of TYPE. | ||
14 | TYPE should be an element type, like `item' or `paragraph'. | ||
15 | ELEMENT should be a list like that returned by `org-element-context'." | ||
16 | ;; MAYBE: Use `org-element-lineage'. | ||
17 | (when-let* ((parent (org-element-property :parent element))) | ||
18 | (or (eq type (car parent)) | ||
19 | (+org-element-descendant-of type parent)))) | ||
20 | |||
21 | (defun +org-return-dwim (&optional prefix) | ||
22 | "A helpful replacement for `org-return'. With PREFIX, call `org-return'. | ||
23 | |||
24 | On headings, move point to position after entry content. In | ||
25 | lists, insert a new item or end the list, with checkbox if | ||
26 | appropriate. In tables, insert a new row or end the table." | ||
27 | (interactive "P") | ||
28 | ;; Auto-fill if enabled | ||
29 | (when auto-fill-function | ||
30 | (if (listp auto-fill-function) | ||
31 | (dolist (func auto-fill-function) | ||
32 | (funcall func)) | ||
33 | (funcall auto-fill-function))) | ||
34 | (if prefix | ||
35 | ;; Handle prefix args | ||
36 | (pcase prefix | ||
37 | ('(4) (newline)) | ||
38 | ('(16) (newline 2)) | ||
39 | ;; this is ... not ideal. but whatever. | ||
40 | (_ (newline prefix))) | ||
41 | (cond | ||
42 | ;; Act depending on context around point. | ||
43 | ((and org-return-follows-link | ||
44 | (eq 'link (car (org-element-context)))) | ||
45 | ;; Link: Open it. | ||
46 | (org-open-at-point-global)) | ||
47 | |||
48 | ((org-at-heading-p) | ||
49 | ;; Heading: Move to position after entry content. | ||
50 | ;; NOTE: This is probably the most interesting feature of this function. | ||
51 | (let ((heading-start (org-entry-beginning-position))) | ||
52 | (goto-char (org-entry-end-position)) | ||
53 | (cond ((and (org-at-heading-p) | ||
54 | (= heading-start (org-entry-beginning-position))) | ||
55 | ;; Entry ends on its heading; add newline after | ||
56 | (end-of-line) | ||
57 | (insert "\n\n")) | ||
58 | (t | ||
59 | ;; Entry ends after its heading; back up | ||
60 | (forward-line -1) | ||
61 | (end-of-line) | ||
62 | (when (org-at-heading-p) | ||
63 | ;; At the same heading | ||
64 | (forward-line) | ||
65 | (insert "\n") | ||
66 | (forward-line -1)) | ||
67 | (while (not | ||
68 | (looking-back | ||
69 | (rx (repeat 3 (seq (optional blank) "\n"))) | ||
70 | nil)) | ||
71 | (insert "\n")) | ||
72 | (forward-line -1))))) | ||
73 | |||
74 | ((org-at-item-checkbox-p) | ||
75 | ;; Checkbox: Insert new item with checkbox. | ||
76 | (org-insert-todo-heading nil)) | ||
77 | |||
78 | ((org-in-item-p) | ||
79 | ;; Plain list | ||
80 | (let* ((context (org-element-context)) | ||
81 | (first-item-p (eq 'plain-list (car context))) | ||
82 | (itemp (eq 'item (car context))) | ||
83 | (emptyp (eq (org-element-property :contents-begin context) | ||
84 | (org-element-property :contents-end context))) | ||
85 | (item-child-p | ||
86 | (+org-element-descendant-of 'item context))) | ||
87 | ;; The original function from unpackaged just tested the (or ...) test | ||
88 | ;; in this cond, in an if. However, that doesn't auto-end nested | ||
89 | ;; lists. So I made this form a cond and added the (and...) test in | ||
90 | ;; the first position, which is clunky (the delete-region... stuff | ||
91 | ;; comes twice) and might not be needed. More testing, obviously, but | ||
92 | ;; for now, it works well enough. | ||
93 | (cond ((and itemp emptyp) | ||
94 | (delete-region (line-beginning-position) (line-end-position)) | ||
95 | (insert "\n\n")) | ||
96 | ((or first-item-p | ||
97 | (and itemp (not emptyp)) | ||
98 | item-child-p) | ||
99 | (org-insert-item)) | ||
100 | (t (delete-region (line-beginning-position) (line-end-position)) | ||
101 | (insert "\n"))))) | ||
102 | |||
103 | ((when (fboundp 'org-inlinetask-in-task-p) | ||
104 | (org-inlinetask-in-task-p)) | ||
105 | ;; Inline task: Don't insert a new heading. | ||
106 | (org-return)) | ||
107 | |||
108 | ((org-at-table-p) | ||
109 | (cond ((save-excursion | ||
110 | (beginning-of-line) | ||
111 | ;; See `org-table-next-field'. | ||
112 | (cl-loop with end = (line-end-position) | ||
113 | for cell = (org-element-table-cell-parser) | ||
114 | always (equal (org-element-property :contents-begin cell) | ||
115 | (org-element-property :contents-end cell)) | ||
116 | while (re-search-forward "|" end t))) | ||
117 | ;; Empty row: end the table. | ||
118 | (delete-region (line-beginning-position) (line-end-position)) | ||
119 | (org-return)) | ||
120 | (t | ||
121 | ;; Non-empty row: call `org-return'. | ||
122 | (org-return)))) | ||
123 | (t | ||
124 | ;; All other cases: call `org-return'. | ||
125 | (org-return))))) | ||
126 | |||
127 | (defun +org-table-copy-down (n) | ||
128 | "Call `org-table-copy-down', or `org-return' outside of a table. | ||
129 | N is passed to the functions." | ||
130 | (interactive "p") | ||
131 | (if (org-table-check-inside-data-field 'noerror) | ||
132 | (org-table-copy-down n) | ||
133 | (+org-return-dwim n))) | ||
134 | |||
135 | ;;; org-fix-blank-lines - unpackaged.el | ||
136 | |||
137 | (defun +org-fix-blank-lines (&optional prefix) | ||
138 | "Ensure blank lines around headings. | ||
139 | Optional PREFIX argument operates on the entire buffer. | ||
140 | Drawers are included with their headings." | ||
141 | (interactive "P") | ||
142 | (org-map-entries (lambda () | ||
143 | (org-with-wide-buffer | ||
144 | ;; `org-map-entries' narrows the buffer, which | ||
145 | ;; prevents us from seeing newlines before the | ||
146 | ;; current heading, so we do this part widened. | ||
147 | (while (not (looking-back "\n\n" nil)) | ||
148 | ;; Insert blank lines before heading. | ||
149 | (insert "\n"))) | ||
150 | (let ((end (org-entry-end-position))) | ||
151 | ;; Insert blank lines before entry content | ||
152 | (forward-line) | ||
153 | (while (and (org-at-planning-p) | ||
154 | (< (point) (point-max))) | ||
155 | ;; Skip planning lines | ||
156 | (forward-line)) | ||
157 | (while (re-search-forward | ||
158 | org-drawer-regexp end t) | ||
159 | ;; Skip drawers. You might think that | ||
160 | ;; `org-at-drawer-p' would suffice, but for | ||
161 | ;; some reason it doesn't work correctly when | ||
162 | ;; operating on hidden text. This works, taken | ||
163 | ;; from `org-agenda-get-some-entry-text'. | ||
164 | (re-search-forward "^[ \t]*:END:.*\n?" end t) | ||
165 | (goto-char (match-end 0))) | ||
166 | (unless (or (= (point) (point-max)) | ||
167 | (org-at-heading-p) | ||
168 | (looking-at-p "\n")) | ||
169 | (insert "\n")))) | ||
170 | t | ||
171 | (if prefix | ||
172 | nil | ||
173 | 'tree))) | ||
174 | |||
175 | ;;; org-count-words | ||
176 | |||
177 | (defun +org-count-words-stupidly (start end &optional limit) | ||
178 | "Count words between START and END, ignoring a lot. | ||
179 | |||
180 | Since this function is, for some reason, pricy, the optional | ||
181 | parameter LIMIT sets a word limit at which to stop counting. | ||
182 | Once the function hits that number, it'll return -LIMIT | ||
183 | instead of the true count." | ||
184 | (interactive (list nil nil)) | ||
185 | (cond ((not (called-interactively-p 'any)) | ||
186 | (let ((words 0) | ||
187 | (continue t)) | ||
188 | (save-excursion | ||
189 | (save-restriction | ||
190 | (narrow-to-region start end) | ||
191 | (goto-char (point-min)) | ||
192 | (while (and continue | ||
193 | (< (point) (point-max))) | ||
194 | (cond | ||
195 | ;; Ignore comments | ||
196 | ((or (org-at-comment-p) | ||
197 | (org-in-commented-heading-p)) | ||
198 | (forward-line)) | ||
199 | ;; Ignore headings | ||
200 | ((or (org-at-heading-p)) | ||
201 | (forward-line)) | ||
202 | ;; Ignore property and log drawers | ||
203 | ((or (looking-at org-drawer-regexp) | ||
204 | (looking-at org-clock-drawer-re)) | ||
205 | (search-forward ":END:" nil :noerror) | ||
206 | (forward-line)) | ||
207 | ;; Ignore DEADLINE and SCHEDULED keywords | ||
208 | ((or (looking-at org-deadline-regexp) | ||
209 | (looking-at org-scheduled-regexp) | ||
210 | (looking-at org-closed-time-regexp)) | ||
211 | (forward-line)) | ||
212 | ;; Ignore tables | ||
213 | ((org-at-table-p) (forward-line)) | ||
214 | ;; Ignore hyperlinks, but count the descriptions | ||
215 | ((looking-at org-link-bracket-re) | ||
216 | (when-let ((desc (match-string-no-properties 5))) | ||
217 | (save-match-data | ||
218 | (setq words (+ words | ||
219 | (length (remove "" | ||
220 | (org-split-string | ||
221 | desc "\\W"))))))) | ||
222 | (goto-char (match-end 0))) | ||
223 | ;; Ignore source blocks | ||
224 | ((org-in-src-block-p) (forward-line)) | ||
225 | ;; Ignore blank lines | ||
226 | ((looking-at "^$") | ||
227 | (forward-line)) | ||
228 | ;; Count everything else | ||
229 | (t | ||
230 | ;; ... unless it's in a few weird contexts | ||
231 | (let ((contexts (org-context))) | ||
232 | (cond ((or (assoc :todo-keyword contexts) | ||
233 | (assoc :priority contexts) | ||
234 | (assoc :keyword contexts) | ||
235 | (assoc :checkbox contexts)) | ||
236 | (forward-word-strictly)) | ||
237 | |||
238 | (t (setq words (1+ words)) | ||
239 | (if (and limit | ||
240 | (> words limit)) | ||
241 | (setq words (- limit) | ||
242 | continue nil)) | ||
243 | (forward-word-strictly))))))))) | ||
244 | words)) | ||
245 | ((use-region-p) | ||
246 | (message "%d words in region" | ||
247 | (+org-count-words-stupidly (region-beginning) | ||
248 | (region-end)))) | ||
249 | (t | ||
250 | (message "%d words in buffer" | ||
251 | (+org-count-words-stupidly (point-min) | ||
252 | (point-max)))))) | ||
253 | |||
254 | ;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ | ||
255 | |||
256 | (defun +org-insert-link-dwim () | ||
257 | "Like `org-insert-link' but with personal dwim preferences." | ||
258 | (interactive) | ||
259 | (let* ((point-in-link (org-in-regexp org-link-any-re 1)) | ||
260 | (clipboard-url (when (string-match-p | ||
261 | (rx (sequence bos | ||
262 | (or "http" | ||
263 | "gemini" | ||
264 | "gopher"))) | ||
265 | (current-kill 0)) | ||
266 | (current-kill 0))) | ||
267 | (region-content (when (region-active-p) | ||
268 | (buffer-substring-no-properties (region-beginning) | ||
269 | (region-end))))) | ||
270 | (cond ((and region-content clipboard-url (not point-in-link)) | ||
271 | (delete-region (region-beginning) (region-end)) | ||
272 | (insert (org-link-make-string clipboard-url region-content))) | ||
273 | ((and clipboard-url (not point-in-link)) | ||
274 | (insert (org-link-make-string | ||
275 | clipboard-url | ||
276 | (read-string "title: " | ||
277 | (with-current-buffer | ||
278 | (url-retrieve-synchronously | ||
279 | clipboard-url) | ||
280 | (dom-text | ||
281 | (car | ||
282 | (dom-by-tag (libxml-parse-html-region | ||
283 | (point-min) | ||
284 | (point-max)) | ||
285 | 'title)))))))) | ||
286 | (t | ||
287 | (call-interactively 'org-insert-link))))) | ||
288 | |||
289 | ;;; Navigate headings with widening | ||
290 | |||
291 | (defun +org-next-heading-widen (arg) | ||
292 | "Find the ARGth next org heading, widening if necessary." | ||
293 | (interactive "p") | ||
294 | (let ((current-point (point)) | ||
295 | (point-target (if (> arg 0) (point-max) (point-min)))) | ||
296 | (org-next-visible-heading arg) | ||
297 | (when (and (buffer-narrowed-p) | ||
298 | (= (point) point-target) | ||
299 | (or (and (> arg 0)) | ||
300 | (and (< arg 0) | ||
301 | (= (point) current-point)))) | ||
302 | (widen) | ||
303 | (org-next-visible-heading arg)))) | ||
304 | |||
305 | (defun +org-previous-heading-widen (arg) | ||
306 | "Find the ARGth previous org heading, widening if necessary." | ||
307 | (interactive "p") | ||
308 | (+org-next-heading-widen (- arg))) | ||
309 | |||
310 | ;;; Hooks & Advice | ||
311 | |||
312 | (defun +org-before-save@prettify-buffer () | ||
313 | (save-mark-and-excursion | ||
314 | (mark-whole-buffer) | ||
315 | ;;(org-fill-paragraph nil t) | ||
316 | (+org-fix-blank-lines t) | ||
317 | (org-align-tags t))) | ||
318 | |||
319 | (defun +org-delete-backward-char (N) | ||
320 | "Keep tables aligned while deleting N characters backward. | ||
321 | When deleting backwards, in tables this function will insert | ||
322 | whitespace in front of the next \"|\" separator, to keep the | ||
323 | table aligned. The table will still be marked for re-alignment | ||
324 | if the field did fill the entire column, because, in this case | ||
325 | the deletion might narrow the column." | ||
326 | (interactive "p") | ||
327 | (save-match-data | ||
328 | (org-check-before-invisible-edit 'delete-backward) | ||
329 | (if (and (= N 1) | ||
330 | (not overwrite-mode) | ||
331 | (not (org-region-active-p)) | ||
332 | (not (eq (char-before) ?|)) | ||
333 | (save-excursion (skip-chars-backward " \t") (not (bolp))) | ||
334 | (looking-at-p ".*?|") | ||
335 | (org-at-table-p)) | ||
336 | (progn (forward-char -1) (org-delete-char 1)) | ||
337 | (backward-delete-char-untabify N) | ||
338 | (org-fix-tags-on-the-fly)))) | ||
339 | |||
340 | (provide '+org) | ||
341 | ;;; +org.el ends here | ||