diff options
Diffstat (limited to 'lisp/+org.el')
-rw-r--r-- | lisp/+org.el | 309 |
1 files changed, 0 insertions, 309 deletions
diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index a148bd8..0000000 --- a/lisp/+org.el +++ /dev/null | |||
@@ -1,309 +0,0 @@ | |||
1 | ;;; +org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'seq) | ||
7 | |||
8 | ;;; Org-return DWIM | ||
9 | ;; 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'. | ||
23 | With PREFIX, call `org-return'." | ||
24 | (interactive "P") | ||
25 | ;; Auto-fill if enabled | ||
26 | (when auto-fill-function | ||
27 | (dolist (func (ensure-list auto-fill-function)) | ||
28 | (funcall func))) | ||
29 | (cond | ||
30 | (prefix ; Handle prefix | ||
31 | (pcase prefix | ||
32 | ('(4) (newline)) | ||
33 | ('(16) (newline 2)) | ||
34 | (_ (newline prefix)))) | ||
35 | ((and org-return-follows-link ; Open link | ||
36 | (eq 'link (car (org-element-context)))) | ||
37 | (org-open-at-point-global)) | ||
38 | ((org-at-heading-p) ; Open a line after a heading | ||
39 | (let ((heading-start (org-entry-beginning-position))) | ||
40 | (goto-char (org-entry-end-position)) | ||
41 | (cond ((and (org-at-heading-p) | ||
42 | (= heading-start (org-entry-beginning-position))) | ||
43 | ;; Entry ends on its heading, so add 2 newlines | ||
44 | (end-of-line) | ||
45 | (newline 2)) | ||
46 | (t | ||
47 | ;; Entry ends after its heading, so back up | ||
48 | (forward-line -1) | ||
49 | (end-of-line) | ||
50 | (when (org-at-heading-p) | ||
51 | (forward-line) | ||
52 | (newline) | ||
53 | (forward-line -1)) | ||
54 | (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) | ||
55 | nil)) | ||
56 | (newline)) | ||
57 | (forward-line -1))))) | ||
58 | ((org-at-item-checkbox-p) ; Insert a new checkbox item | ||
59 | (end-of-line) | ||
60 | (org-insert-todo-heading nil)) | ||
61 | ((org-in-item-p) ; Insert a new list item | ||
62 | (let* ((context (org-element-context)) | ||
63 | (first-item-p (eq 'plain-list (car context))) | ||
64 | (itemp (eq 'item (car context))) | ||
65 | (emptyp (or | ||
66 | ;; This (regular) list item is empty | ||
67 | (eq (org-element-property :contents-begin context) | ||
68 | (org-element-property :contents-end context)) | ||
69 | ;; This (definition) list item is empty | ||
70 | (looking-at " *::"))) | ||
71 | (item-child-p (+org-element-descendant-of 'item context))) | ||
72 | (cond ((and itemp emptyp) | ||
73 | (delete-region (line-beginning-position) (line-end-position)) | ||
74 | (newline)) | ||
75 | ((or first-item-p | ||
76 | (and itemp (not emptyp)) | ||
77 | item-child-p) | ||
78 | (org-end-of-item) | ||
79 | (org-insert-item)) | ||
80 | (t | ||
81 | (delete-region (line-beginning-position) (line-end-position)) | ||
82 | (newline))))) | ||
83 | ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with | ||
84 | (org-inlinetask-in-task-p)) ; inline tasks | ||
85 | (org-return)) | ||
86 | ((org-at-table-p) ; Insert a new org-table row | ||
87 | (cond ((save-excursion | ||
88 | (beginning-of-line) | ||
89 | (cl-loop with end = (line-end-position) | ||
90 | for cell = (org-element-table-cell-parser) | ||
91 | always (equal (org-element-property :contents-begin cell) | ||
92 | (org-element-property :contents-end cell)) | ||
93 | while (re-search-forward "|" end t))) | ||
94 | ;; Empty row: end the table | ||
95 | (delete-region (line-beginning-position) (line-end-position)) | ||
96 | (org-return)) | ||
97 | (t | ||
98 | ;; Non-empty row | ||
99 | (org-return)))) | ||
100 | (t ; Otherwise---just call `org-return'. | ||
101 | (org-return)))) | ||
102 | |||
103 | (defun +org-table-copy-down|+org-return-dwim (&optional n) | ||
104 | "Call `org-table-copy-down' or `+org-return' depending on context." | ||
105 | (interactive "P") | ||
106 | (if (org-table-check-inside-data-field 'noerror) | ||
107 | (org-table-copy-down (or n 1)) | ||
108 | (+org-return-dwim n))) | ||
109 | |||
110 | |||
111 | ;;; A ... different ... `org-open-at-point-dwim' | ||
112 | ;; I honestly don't remember what the difference is between this and the | ||
113 | ;; O.G. one is.. hopefully this one fixes annoying stupid problems. | ||
114 | |||
115 | (defun +org-open-at-point-dwim (&optional arg) | ||
116 | "Open thing at point, or if there isn't something, list things." | ||
117 | (interactive "P") | ||
118 | (save-excursion | ||
119 | (let* ((this-char-type (org-element-type (org-element-context))) | ||
120 | (prev-char-type (ignore-errors | ||
121 | (save-excursion | ||
122 | (backward-char) | ||
123 | (org-element-type (org-element-context))))) | ||
124 | (types '(citation citation-reference clock comment comment-block | ||
125 | footnote-definition footnote-reference headline | ||
126 | inline-src-block inlinetask keyword link | ||
127 | node-property planning src-block timestamp)) | ||
128 | (type this-char-type)) | ||
129 | (when (and (memq this-char-type types) (memq prev-char-type types)) | ||
130 | (backward-char) | ||
131 | (setq type prev-char-type)) ; what the fuckckckckck | ||
132 | ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, | ||
133 | ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since | ||
134 | ;; I really just want to open the list of URLs /most of the time/, I'm | ||
135 | ;; fixing it like this instead. | ||
136 | (unless (and (memq type types) | ||
137 | (ignore-errors (org-open-at-point arg) | ||
138 | t)) | ||
139 | (while (not | ||
140 | (progn | ||
141 | (org-back-to-heading) | ||
142 | (car (org-offer-links-in-entry (current-buffer) (point) 1)))) | ||
143 | (org-up-heading-all 1)) | ||
144 | (org-open-at-point arg))))) | ||
145 | |||
146 | ;;; Faces | ||
147 | ;; see `org-emphasis-alist' | ||
148 | |||
149 | (defface org-bold '((t (:weight bold))) | ||
150 | "Bold face in `org-mode' documents.") | ||
151 | |||
152 | (defface org-italic '((t (:slant italic))) | ||
153 | "Italic face in `org-mode' documents.") | ||
154 | |||
155 | (defface org-underline '((t (:underline t))) | ||
156 | "Underline face in `org-mode' documents.") | ||
157 | |||
158 | (defface org-strikethrough '((t (:strike-through t))) | ||
159 | "Strike-through face for `org-mode' documents.") | ||
160 | |||
161 | ;;; Unsmartify | ||
162 | |||
163 | (defun +org-unsmartify () | ||
164 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." | ||
165 | (interactive) | ||
166 | (save-excursion | ||
167 | (goto-char (point-min)) | ||
168 | (while (re-search-forward "[“”‘’–—]" nil t) | ||
169 | (let ((replace (pcase (match-string 0) | ||
170 | ((or "“" "”") "\"") | ||
171 | ((or "‘" "’") "'") | ||
172 | ("–" "--") | ||
173 | ("—" "---")))) | ||
174 | (replace-match replace nil nil))))) | ||
175 | |||
176 | ;;; Copy org trees as HTML | ||
177 | ;; Thanks to Oleh Krehel: | ||
178 | ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard | ||
179 | |||
180 | (defun +org-export-clip-to-html | ||
181 | (&optional async subtreep visible-only body-only ext-plist post-process) | ||
182 | "Export region to HTML, and copy it to the clipboard. | ||
183 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, | ||
184 | and POST-PROCESS are passed to `org-export-to-file'." | ||
185 | (interactive) ; XXX: hould this be interactive? | ||
186 | (message "Exporting Org to HTML...") | ||
187 | (let ((org-tmp-file "/tmp/org.html")) | ||
188 | (org-export-to-file 'html org-tmp-file | ||
189 | async subtreep visible-only body-only ext-plist post-process) | ||
190 | ;; XXX: figure out which clipboard to use, or use something in Emacs | ||
191 | (start-process "xclip" "*xclip*" | ||
192 | "xclip" "-verbose" | ||
193 | "-i" org-tmp-file | ||
194 | "-t" "text/html" | ||
195 | "-selection" "clipboard")) | ||
196 | (message "Exporting Org to HTML...done.")) | ||
197 | |||
198 | ;; Specialized functions | ||
199 | (defun +org-export-clip-subtree-to-html () | ||
200 | "Export current subtree to HTML." | ||
201 | (interactive) | ||
202 | (+org-export-clip-to-html nil :subtree)) | ||
203 | |||
204 | ;;; Hide drawers on save, except the currently-expanded one | ||
205 | |||
206 | (defun +org-hide-drawers-except-point () | ||
207 | "Hide all drawers except for the one point is in." | ||
208 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | ||
209 | (let ((pt (point)) | ||
210 | (begin (point-min)) | ||
211 | (end (point-max))) | ||
212 | (save-excursion | ||
213 | (goto-char begin) | ||
214 | (while (and (< (point) end) | ||
215 | (re-search-forward org-drawer-regexp end t)) | ||
216 | (if (org-fold-folded-p nil 'drawer) | ||
217 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | ||
218 | (let* ((drawer (org-element-at-point)) | ||
219 | (type (org-element-type drawer)) | ||
220 | (el-begin (org-element-property :begin drawer)) | ||
221 | (el-end (org-element-property :end drawer))) | ||
222 | (when (memq type '(drawer property-drawer)) | ||
223 | (org-fold-hide-drawer-toggle | ||
224 | (if (< el-begin pt el-end) 'off 'on) | ||
225 | nil drawer) | ||
226 | (goto-char el-end)))))))) | ||
227 | |||
228 | ;;; Define `ol' link types | ||
229 | |||
230 | (defmacro +org-link-define-type (type args &rest body) | ||
231 | "Define an org link TYPE. | ||
232 | A function named `+org-link-TYPE-open' will be created, with ARGS | ||
233 | as its arguments and BODY as its body. BODY can be blank, in | ||
234 | which case the user will be messaged (This is a good do-nothing | ||
235 | effect for exporting link types)." | ||
236 | (declare (indent 2) | ||
237 | (doc-string 3) | ||
238 | (debug (sexp sexp def-body))) | ||
239 | (let ((fn (intern (format "+org-link-%s-open" type))) | ||
240 | (body (or body `((message ,(format "%S: %%S" type) | ||
241 | ,(car args))))) | ||
242 | (type-string (format "%S" type))) | ||
243 | `(prog1 | ||
244 | (defun ,fn ,args ,@body) | ||
245 | (org-link-set-parameters ,type-string :follow #',fn)))) | ||
246 | |||
247 | ;;; Skip some files in `org-agenda' | ||
248 | |||
249 | (defcustom org-agenda-file-skip-regexp nil | ||
250 | "Files matching this regexp are removed from `org-agenda-files'." | ||
251 | :group 'org-agenda) | ||
252 | |||
253 | (defun org-agenda-files@skip-regexp (files) | ||
254 | "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'." | ||
255 | (when org-agenda-file-skip-regexp | ||
256 | (setq files | ||
257 | (seq-remove (lambda (file) | ||
258 | (string-match-p | ||
259 | org-agenda-file-skip-regexp file)) | ||
260 | files))) | ||
261 | files) | ||
262 | |||
263 | ;;; Prompt for stuff | ||
264 | |||
265 | (defun +org-prompt-for-property (property &optional clipboardp insert list) | ||
266 | "Prompt for PROPERTY and return a properly-formatted string. | ||
267 | Pre-fill the input with clipboard contents if they match CLIPBOARDP. If | ||
268 | CLIPBOARDP is nil or missing, don't pre-fill. | ||
269 | |||
270 | If INSERT is non-nil, insert the property into the property | ||
271 | drawer of the current org tree. | ||
272 | |||
273 | If LIST is non-nil, return the result as a list instead of a string." | ||
274 | (let* ((kill (current-kill 0)) | ||
275 | (value (read-string (concat property ": ") | ||
276 | (when (and clipboardp | ||
277 | (or (eq clipboardp t) | ||
278 | (funcall clipboardp kill))) | ||
279 | kill)))) | ||
280 | (when insert | ||
281 | (org-set-property property value)) | ||
282 | (if list | ||
283 | (list property value) | ||
284 | (format ":%s: %s" property value)))) | ||
285 | |||
286 | (defun +org-prompt-tags (&optional prompt global) | ||
287 | (let* ((buffer (org-capture-get :buffer)) | ||
288 | (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) | ||
289 | (org-last-tags-completion-table | ||
290 | (org-global-tags-completion-table | ||
291 | (if global (org-agenda-files) (list file)))) | ||
292 | (org-add-colon-after-tag-completion t) | ||
293 | (ins (mapconcat | ||
294 | #'identity | ||
295 | (let ((crm-separator "[ \t]*:[ \t]*")) | ||
296 | (completing-read-multiple | ||
297 | (or prompt "Tags: ") | ||
298 | org-last-tags-completion-table nil nil nil | ||
299 | 'org-tags-history)) | ||
300 | ":"))) | ||
301 | (when (org-string-nw-p ins) | ||
302 | (prog1 (concat | ||
303 | (unless (eq (char-before) ?:) ":") | ||
304 | ins | ||
305 | (unless (eq (char-after) ?:) ":")) | ||
306 | (when (org-at-heading-p) (org-align-tags)))))) | ||
307 | |||
308 | (provide '+org) | ||
309 | ;;; +org.el ends here | ||