diff options
Diffstat (limited to 'lisp/acdw-org.el')
-rw-r--r-- | lisp/acdw-org.el | 377 |
1 files changed, 377 insertions, 0 deletions
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el new file mode 100644 index 0000000..8a63d04 --- /dev/null +++ b/lisp/acdw-org.el | |||
@@ -0,0 +1,377 @@ | |||
1 | ;;; acdw-org.el --- My org customizations -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | |||
7 | ;;; Variables | ||
8 | |||
9 | (defcustom org-agenda-skip-file-regexp nil | ||
10 | "Files matching this regexp are removed from `org-agenda-files'." | ||
11 | :group 'org-agenda | ||
12 | :type 'regexp) | ||
13 | |||
14 | ;;; Functions | ||
15 | |||
16 | |||
17 | ;;; DWIM | ||
18 | |||
19 | ;; https://github.com/alphapapa/unpackaged.el, | ||
20 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
21 | (defun +org-return-dwim (&optional arg) | ||
22 | "A helpful replacement for `org-return'. | ||
23 | When called interactively with \\[universal-argument], call `org-return' | ||
24 | itself. Other values of ARG will call `newline' with that ARG." | ||
25 | (interactive "P") | ||
26 | ;; Auto-fill if enabled | ||
27 | (when auto-fill-function | ||
28 | (dolist (func (ensure-list auto-fill-function)) | ||
29 | (funcall func))) | ||
30 | (cl-letf* ((el (org-element-at-point)) | ||
31 | ((symbol-function 'el-child-of) | ||
32 | (lambda (&rest types) | ||
33 | (org-element-lineage el types t)))) | ||
34 | (cond ; Figure out what we're going to do | ||
35 | (arg ; Handle prefix ARG | ||
36 | (pcase arg | ||
37 | ('(4) (org-return t nil t)) | ||
38 | (_ (newline arg t)))) | ||
39 | ((and org-return-follows-link ; Open a link | ||
40 | (el-child-of 'link)) | ||
41 | (org-open-at-point-global)) | ||
42 | ((org-at-heading-p) ; Open a paragraph after a heading | ||
43 | (let ((heading-start (org-entry-beginning-position))) | ||
44 | (goto-char (org-entry-end-position)) | ||
45 | (cond ((and (org-at-heading-p) ; Entry is only a heading | ||
46 | (= heading-start (org-entry-beginning-position))) | ||
47 | (end-of-line) | ||
48 | (newline 2)) | ||
49 | (:else ; Entry is more than a heading | ||
50 | (forward-line -1) | ||
51 | (end-of-line) | ||
52 | (when (org-at-heading-p) | ||
53 | ;; Open a paragraph | ||
54 | (forward-line) | ||
55 | (newline) | ||
56 | (forward-line -1)) | ||
57 | (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil)) | ||
58 | (newline)) | ||
59 | (forward-line -1))))) | ||
60 | ((org-at-item-checkbox-p) ; Insert a new checkbox item | ||
61 | (end-of-line) | ||
62 | (org-insert-todo-heading nil)) | ||
63 | ((org-in-item-p) ; Insert a new list item | ||
64 | (let* ((context (org-element-context el)) | ||
65 | (first-item-p (eq 'plain-list (car context))) | ||
66 | (itemp (eq 'item (car context))) | ||
67 | (emptyp (or | ||
68 | ;; This (regular) list item is empty | ||
69 | (eq (org-element-property :contents-begin context) | ||
70 | (org-element-property :contents-end context)) | ||
71 | ;; This (definition) list item is empty | ||
72 | (looking-at " *::"))) | ||
73 | (item-child-p (el-child-of 'item))) | ||
74 | (cond ((and itemp emptyp) | ||
75 | ;; This test has to be here even though it's the same as the | ||
76 | ;; :else clause, because an item that's empty will also satisfy | ||
77 | ;; the next clause. | ||
78 | (delete-region (line-beginning-position) (line-end-position)) | ||
79 | (newline)) | ||
80 | ((or first-item-p | ||
81 | (and itemp (not emptyp)) | ||
82 | item-child-p) | ||
83 | (org-end-of-item) | ||
84 | (org-insert-item)) | ||
85 | (:else | ||
86 | (delete-region (line-beginning-position) (line-end-position)) | ||
87 | (newline))))) | ||
88 | ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks | ||
89 | (org-inlinetask-in-task-p)) | ||
90 | (org-return)) | ||
91 | ((org-at-table-p) ; Insert a new table row | ||
92 | (cond ((save-excursion ; Empty row: end the table | ||
93 | (beginning-of-line) | ||
94 | (cl-loop with end = (line-end-position) | ||
95 | for cell = (org-element-table-cell-parser) | ||
96 | always (eq (org-element-property :contents-begin cell) | ||
97 | (org-element-property :contents-end cell)) | ||
98 | while (re-search-forward "|" end t))) | ||
99 | (delete-region (line-beginning-position) (line-end-position)) | ||
100 | (org-return)) | ||
101 | (:else ; Non-empty row | ||
102 | (org-return)))) | ||
103 | (:else ; Something else | ||
104 | (org-return))))) | ||
105 | |||
106 | (defun +org-table-copy-down|+org-return-dwim (&optional n) | ||
107 | "Call `org-table-copy-down' or `+org-return' depending on context." | ||
108 | (interactive "P") | ||
109 | (if (org-table-check-inside-data-field 'noerror) | ||
110 | (org-table-copy-down (or n 1)) | ||
111 | (+org-return-dwim n))) | ||
112 | |||
113 | |||
114 | ;;; Buffer view cleanup | ||
115 | |||
116 | (defun +org-hide-drawers-except-point () | ||
117 | "Hide all drawers except for the one point is in." | ||
118 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | ||
119 | (let ((pt (point)) | ||
120 | (begin (point-min)) | ||
121 | (end (point-max))) | ||
122 | (save-excursion | ||
123 | (goto-char begin) | ||
124 | (while (and (< (point) end) | ||
125 | (re-search-forward org-drawer-regexp end t)) | ||
126 | (if (org-fold-folded-p nil 'drawer) | ||
127 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | ||
128 | (let* ((drawer (org-element-at-point)) | ||
129 | (type (org-element-type drawer)) | ||
130 | (el-begin (org-element-property :begin drawer)) | ||
131 | (el-end (org-element-property :end drawer))) | ||
132 | (when (memq type '(drawer property-drawer)) | ||
133 | (org-fold-hide-drawer-toggle | ||
134 | (if (< el-begin pt el-end) 'off 'on) | ||
135 | nil drawer) | ||
136 | (goto-char el-end)))))))) | ||
137 | |||
138 | |||
139 | ;;; Copy rich text to the keyboard | ||
140 | ;; Thanks to Oleh Krehel: | ||
141 | ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard | ||
142 | ;; So. Emacs can't do this itself because it doesn't support sending clipboard | ||
143 | ;; or selection contents as text/html. We have to use xclip instead. | ||
144 | (defun org-to-html-to-clipboard (&rest org-export-args) | ||
145 | "Export current org buffer to HTML, then copy it to the clipboard. | ||
146 | ORG-EXPORT-ARGS are passed to `org-export-to-file'." | ||
147 | (let ((f (make-temp-file "org-html-export"))) | ||
148 | (apply #'org-export-to-file 'html f org-export-args) | ||
149 | (start-process "xclip" " *xclip*" | ||
150 | "xclip" "-verbose" "-i" f | ||
151 | "-t" "text/html" "-selection" "clipboard") | ||
152 | (message "HTML pasted to clipboard."))) | ||
153 | |||
154 | (defun org-subtree-to-html-to-clipboard () | ||
155 | "Export current subtree to HTML." | ||
156 | (interactive) | ||
157 | (org-to-html-to-clipboard nil :subtree)) | ||
158 | |||
159 | |||
160 | ;;; Prompting | ||
161 | |||
162 | (defun +org-prompt-for-property (property &optional clipboardp insert list) | ||
163 | "Prompt for PROPERTY and return a properly-formatted string. | ||
164 | Pre-fill the input with clipboard contents if they match CLIPBOARDP. If | ||
165 | CLIPBOARDP is nil or missing, don't pre-fill. | ||
166 | |||
167 | If INSERT is non-nil, insert the property into the property | ||
168 | drawer of the current org tree. | ||
169 | |||
170 | If LIST is non-nil, return the result as a list instead of a string." | ||
171 | (let* ((kill (current-kill 0)) | ||
172 | (value (read-string (concat property ": ") | ||
173 | (when (and clipboardp | ||
174 | (or (eq clipboardp t) | ||
175 | (funcall clipboardp kill))) | ||
176 | kill)))) | ||
177 | (when insert | ||
178 | (org-set-property property value)) | ||
179 | (if list | ||
180 | (list property value) | ||
181 | (format ":%s: %s" property value)))) | ||
182 | |||
183 | (defun +org-prompt-tags (&optional prompt global) | ||
184 | (let* ((buffer (org-capture-get :buffer)) | ||
185 | (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) | ||
186 | (org-last-tags-completion-table | ||
187 | (org-global-tags-completion-table | ||
188 | (if global (org-agenda-files) (list file)))) | ||
189 | (org-add-colon-after-tag-completion t) | ||
190 | (ins (mapconcat | ||
191 | #'identity | ||
192 | (let ((crm-separator "[ \t]*:[ \t]*")) | ||
193 | (completing-read-multiple | ||
194 | (or prompt "Tags: ") | ||
195 | org-last-tags-completion-table nil nil nil | ||
196 | 'org-tags-history)) | ||
197 | ":"))) | ||
198 | (when (org-string-nw-p ins) | ||
199 | (prog1 (concat | ||
200 | (unless (eq (char-before) ?:) ":") | ||
201 | ins | ||
202 | (unless (eq (char-after) ?:) ":")) | ||
203 | (when (org-at-heading-p) (org-align-tags)))))) | ||
204 | |||
205 | |||
206 | ;;; Faces | ||
207 | |||
208 | (defface org-bold '((t (:weight bold))) | ||
209 | "Bold face in `org-mode' documents.") | ||
210 | |||
211 | (defface org-italic '((t (:slant italic))) | ||
212 | "Italic face in `org-mode' documents.") | ||
213 | |||
214 | (defface org-underline '((t (:underline t))) | ||
215 | "Underline face in `org-mode' documents.") | ||
216 | |||
217 | (defface org-strikethrough '((t (:strike-through t))) | ||
218 | "Strike-through face for `org-mode' documents.") | ||
219 | |||
220 | |||
221 | ;;; Packages | ||
222 | |||
223 | (use-package org | ||
224 | :defer t | ||
225 | :config | ||
226 | ;; Options | ||
227 | (setopt org-adapt-indentation nil | ||
228 | org-auto-align-tags t | ||
229 | org-archive-mark-done t | ||
230 | org-fold-catch-invisible-edits 'show-and-error | ||
231 | org-clock-clocked-in-display 'mode-line | ||
232 | org-clock-string-limit 7 ; just the clock bit | ||
233 | org-clock-persist nil | ||
234 | org-confirm-babel-evaluate nil | ||
235 | org-cycle-separator-lines 0 | ||
236 | org-deadline-warning-days 0 | ||
237 | org-directory (sync/ "org/" t) | ||
238 | org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…") | ||
239 | org-emphasis-alist '(("*" org-bold) | ||
240 | ("/" org-italic) | ||
241 | ("_" org-underline) | ||
242 | ("=" org-verbatim) | ||
243 | ("~" org-code) | ||
244 | ("+" org-strikethrough)) | ||
245 | org-fontify-done-headline t | ||
246 | org-fontify-quote-and-verse-blocks t | ||
247 | org-fontify-whole-heading-line t | ||
248 | org-hide-emphasis-markers t | ||
249 | org-html-coding-system 'utf-8-unix | ||
250 | org-image-actual-width (list (* (window-font-width) | ||
251 | (- fill-column 8))) | ||
252 | org-imenu-depth 3 | ||
253 | org-indent-indentation-per-level 0 | ||
254 | org-indent-mode-turns-on-hiding-stars nil | ||
255 | org-insert-heading-respect-content t | ||
256 | org-list-demote-modify-bullet '(("-" . "+") | ||
257 | ("+" . "-")) | ||
258 | org-log-done 'time | ||
259 | org-log-into-drawer t | ||
260 | org-num-skip-commented t | ||
261 | org-num-skip-unnumbered t | ||
262 | org-num-skip-footnotes t | ||
263 | org-outline-path-complete-in-steps nil | ||
264 | org-pretty-entities t | ||
265 | org-pretty-entities-include-sub-superscripts nil | ||
266 | org-refile-targets '((nil . (:maxlevel . 2)) | ||
267 | (org-agenda-files . (:maxlevel . 1))) | ||
268 | org-refile-use-outline-path 'file | ||
269 | org-special-ctrl-a/e t | ||
270 | org-special-ctrl-k t | ||
271 | org-src-fontify-natively t | ||
272 | org-src-tab-acts-natively t | ||
273 | org-src-window-setup 'current-window | ||
274 | org-startup-truncated nil | ||
275 | org-startup-with-inline-images t | ||
276 | org-tags-column 0 | ||
277 | org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" | ||
278 | "|" "DONE(d!)" "ASSIGNED(a@/!)") | ||
279 | (sequence "|" "CANCELED(k@)") | ||
280 | (sequence "MEETING(m)")) | ||
281 | org-use-fast-todo-selection 'auto | ||
282 | org-use-speed-commands t) | ||
283 | ;; Keys | ||
284 | (keymap-set org-mode-map "C-M-k" #'kill-paragraph) | ||
285 | (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs) | ||
286 | (keymap-set org-mode-map "RET" #'+org-return-dwim) | ||
287 | (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim) | ||
288 | ;; Hooks | ||
289 | (add-hook 'org-mode-hook #'variable-pitch-mode) | ||
290 | (autoload 'visual-fill-column-mode "visual-fill-column" nil t) | ||
291 | (add-hook 'org-mode-hook #'visual-fill-column-mode) | ||
292 | (add-hook 'org-mode-hook #'turn-off-auto-fill) | ||
293 | (add-hook 'org-mode-hook #'org-indent-mode) | ||
294 | (add-hook 'org-mode-hook #'abbrev-mode) | ||
295 | (add-hook 'org-mode-hook (defun before-save@org-mode () | ||
296 | (org-align-tags 'all) | ||
297 | (+org-hide-drawers-except-point)))) | ||
298 | |||
299 | (use-package org-agenda | ||
300 | :bind (("C-c a" . org-agenda)) | ||
301 | :config | ||
302 | (setopt org-agenda-skip-deadline-if-done t | ||
303 | org-agenda-skip-scheduled-if-done t | ||
304 | org-agenda-span 10 | ||
305 | org-agenda-block-separator ?─ | ||
306 | org-agenda-time-grid | ||
307 | '((daily today require-timed) | ||
308 | (800 1000 1200 1400 1600 1800 2000) | ||
309 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") | ||
310 | org-agenda-current-time-string | ||
311 | "← now ─────────────────────────────────────────────────" | ||
312 | org-agenda-include-diary nil ; I use the org-diary features | ||
313 | org-agenda-todo-ignore-deadlines 'near | ||
314 | org-agenda-todo-ignore-scheduled 'future | ||
315 | org-agenda-include-deadlines t | ||
316 | org-deadline-warning-days 0 | ||
317 | org-agenda-show-future-repeats 'next | ||
318 | org-agenda-window-setup 'current-window | ||
319 | org-agenda-skip-file-regexp "sync-conflict") | ||
320 | ;; Hooks and advice | ||
321 | (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) | ||
322 | (add-hook 'org-agenda-mode-hook #'hl-line-mode) | ||
323 | (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) | ||
324 | (define-advice org-agenda-files (:filter-return (files) skip-regexp) | ||
325 | "Filter some files from `org-agenda'." | ||
326 | (when org-agenda-skip-file-regexp | ||
327 | (setq files | ||
328 | (cl-remove-if (lambda (file) | ||
329 | (string-match-p org-agenda-skip-file-regexp | ||
330 | file)) | ||
331 | files))) | ||
332 | files)) | ||
333 | |||
334 | (use-package org-capture | ||
335 | :bind (("C-c c" . org-capture))) | ||
336 | |||
337 | (use-package ol ; org-link | ||
338 | :after org | ||
339 | :preface | ||
340 | (defmacro +org-link-define-type (type args &rest body) | ||
341 | "Define an org link TYPE. | ||
342 | A function named `+org-link-TYPE-open' will be created, with ARGS | ||
343 | as its arguments and BODY as its body. BODY can be blank, in | ||
344 | which case the user will be messaged (This is a good do-nothing | ||
345 | effect for exporting link types)." | ||
346 | (declare (indent 2) | ||
347 | (doc-string 3) | ||
348 | (debug (sexp sexp def-body))) | ||
349 | (let ((fn (intern (format "+org-link-%s-open" type))) | ||
350 | (body (or body `((message ,(format "%S: %%S" type) | ||
351 | ,(car args))))) | ||
352 | (type-string (format "%S" type))) | ||
353 | `(prog1 | ||
354 | (defun ,fn ,args ,@body) | ||
355 | (org-link-set-parameters ,type-string :follow #',fn)))) | ||
356 | :config | ||
357 | (+org-link-define-type sms (number _)) | ||
358 | (+org-link-define-type tel (number _))) | ||
359 | |||
360 | (use-package ox ; org-export | ||
361 | :after org | ||
362 | :config | ||
363 | (require 'ox-md) | ||
364 | (setopt org-export-coding-system 'utf-8-unix | ||
365 | org-export-headline-levels 8 | ||
366 | org-export-with-drawers nil | ||
367 | org-export-with-section-numbers nil | ||
368 | org-export-with-smart-quotes t | ||
369 | org-export-with-sub-superscripts t | ||
370 | org-export-with-toc nil)) | ||
371 | |||
372 | (use-package org-word-count | ||
373 | :load-path "~/src/emacs/org-word-count/" | ||
374 | :hook org-mode-hook) | ||
375 | |||
376 | (provide 'acdw-org) | ||
377 | ;;; acdw-org.el ends here | ||