diff options
author | Case Duckworth | 2023-01-03 23:03:03 -0600 |
---|---|---|
committer | Case Duckworth | 2023-01-03 23:03:03 -0600 |
commit | 59a1f58695d09ab29ddf992b2c0711c94a4039ea (patch) | |
tree | 1de8114d3b60d11b9a3b92422d178f17e1841ea0 /lisp/+org.el | |
parent | bleh (diff) | |
download | emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.tar.gz emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.zip |
Switch to use-package
Diffstat (limited to 'lisp/+org.el')
-rw-r--r-- | lisp/+org.el | 268 |
1 files changed, 155 insertions, 113 deletions
diff --git a/lisp/+org.el b/lisp/+org.el index 7698ec9..a148bd8 100644 --- a/lisp/+org.el +++ b/lisp/+org.el | |||
@@ -1,7 +1,13 @@ | |||
1 | ;;; +org.el --- -*- lexical-binding: t -*- | 1 | ;;; +org.el -*- lexical-binding: t; -*- |
2 | 2 | ||
3 | ;;; Org Return DWIM | 3 | ;;; Code: |
4 | ;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] | 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/ | ||
5 | 11 | ||
6 | (defun +org-element-descendant-of (type element) | 12 | (defun +org-element-descendant-of (type element) |
7 | "Return non-nil if ELEMENT is a descendant of TYPE. | 13 | "Return non-nil if ELEMENT is a descendant of TYPE. |
@@ -94,53 +100,13 @@ With PREFIX, call `org-return'." | |||
94 | (t ; Otherwise---just call `org-return'. | 100 | (t ; Otherwise---just call `org-return'. |
95 | (org-return)))) | 101 | (org-return)))) |
96 | 102 | ||
97 | (defun +org-table-copy-down|+org-return (&optional n) | 103 | (defun +org-table-copy-down|+org-return-dwim (&optional n) |
98 | "Call `org-table-copy-down' or `+org-return' depending on context." | 104 | "Call `org-table-copy-down' or `+org-return' depending on context." |
99 | (interactive "P") | 105 | (interactive "P") |
100 | (if (org-table-check-inside-data-field 'noerror) | 106 | (if (org-table-check-inside-data-field 'noerror) |
101 | (org-table-copy-down (or n 1)) | 107 | (org-table-copy-down (or n 1)) |
102 | (+org-return-dwim n))) | 108 | (+org-return-dwim n))) |
103 | 109 | ||
104 | ;;; Copy org trees as HTML | ||
105 | |||
106 | ;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. | ||
107 | (defun +org-export-clip-to-html | ||
108 | (&optional async subtreep visible-only body-only ext-plist post-process) | ||
109 | "Export region to HTML, and copy it to the clipboard. | ||
110 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, | ||
111 | and POST-PROCESS are passed to `org-export-to-file'." | ||
112 | (interactive) ; XXX: hould this be interactive? | ||
113 | (message "Exporting Org to HTML...") | ||
114 | (let ((org-tmp-file "/tmp/org.html")) | ||
115 | (org-export-to-file 'html org-tmp-file | ||
116 | async subtreep visible-only body-only ext-plist post-process) | ||
117 | (start-process "xclip" "*xclip*" | ||
118 | "xclip" "-verbose" | ||
119 | "-i" org-tmp-file | ||
120 | "-t" "text/html" | ||
121 | "-selection" "clipboard")) | ||
122 | (message "Exporting Org to HTML...done.")) | ||
123 | |||
124 | ;; Specialized functions | ||
125 | (defun +org-export-clip-subtree-to-html () | ||
126 | "Export current subtree to HTML." | ||
127 | (interactive) | ||
128 | (+org-export-clip-to-html nil :subtree)) | ||
129 | |||
130 | ;;; Unsmartify quotes and dashes and stuff. | ||
131 | |||
132 | (defun +org-unsmartify () | ||
133 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." | ||
134 | (interactive) | ||
135 | (save-excursion | ||
136 | (goto-char (point-min)) | ||
137 | (while (re-search-forward "[“”‘’–—]" nil t) | ||
138 | (let ((replace (pcase (match-string 0) | ||
139 | ((or "“" "”") "\"") | ||
140 | ((or "‘" "’") "'") | ||
141 | ("–" "--") | ||
142 | ("—" "---")))) | ||
143 | (replace-match replace nil nil))))) | ||
144 | 110 | ||
145 | ;;; A ... different ... `org-open-at-point-dwim' | 111 | ;;; A ... different ... `org-open-at-point-dwim' |
146 | ;; I honestly don't remember what the difference is between this and the | 112 | ;; I honestly don't remember what the difference is between this and the |
@@ -177,20 +143,7 @@ and POST-PROCESS are passed to `org-export-to-file'." | |||
177 | (org-up-heading-all 1)) | 143 | (org-up-heading-all 1)) |
178 | (org-open-at-point arg))))) | 144 | (org-open-at-point arg))))) |
179 | 145 | ||
180 | ;;; Skip invisible shit when moving around | ||
181 | (defun +org-ignore-invisible (fn &rest r) | ||
182 | ":around ADVICE to ignore invisible text in `org-mode' buffers." | ||
183 | ;; TODO: generalize to all modes | ||
184 | (cond ((and (derived-mode-p #'org-mode) | ||
185 | (org-invisible-p)) | ||
186 | (while (org-invisible-p) | ||
187 | (forward-char)) | ||
188 | (apply fn r)) | ||
189 | (t (apply fn r)))) | ||
190 | |||
191 | ;;; Faces | 146 | ;;; Faces |
192 | |||
193 | ;;; Better org faces | ||
194 | ;; see `org-emphasis-alist' | 147 | ;; see `org-emphasis-alist' |
195 | 148 | ||
196 | (defface org-bold '((t (:weight bold))) | 149 | (defface org-bold '((t (:weight bold))) |
@@ -205,63 +158,152 @@ and POST-PROCESS are passed to `org-export-to-file'." | |||
205 | (defface org-strikethrough '((t (:strike-through t))) | 158 | (defface org-strikethrough '((t (:strike-through t))) |
206 | "Strike-through face for `org-mode' documents.") | 159 | "Strike-through face for `org-mode' documents.") |
207 | 160 | ||
208 | ;; `org-verbatim' and `org-code' are apparently already things, so we skip them | 161 | ;;; Unsmartify |
209 | ;; here. | 162 | |
210 | 163 | (defun +org-unsmartify () | |
211 | ;;; Inhibit hooks on `org-agenda' | 164 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." |
212 | ;; It's really annoying when I call `org-agenda' and five hundred Ispell | 165 | (interactive) |
213 | ;; processes are created because I have `flyspell-mode' in the hook. This mode | 166 | (save-excursion |
214 | ;; inhibits those hooks when entering the agenda, but runs them when opening the | 167 | (goto-char (point-min)) |
215 | ;; actual buffer. | 168 | (while (re-search-forward "[“”‘’–—]" nil t) |
216 | 169 | (let ((replace (pcase (match-string 0) | |
217 | (defun +org-agenda-inhibit-hooks (fn &rest r) | 170 | ((or "“" "”") "\"") |
218 | "Advice to inhibit hooks when entering `org-agenda'." | 171 | ((or "‘" "’") "'") |
219 | (let ((org-mode-hook nil)) | 172 | ("–" "--") |
220 | (apply fn r))) | 173 | ("—" "---")))) |
221 | 174 | (replace-match replace nil nil))))) | |
222 | (defvar-local +org-hook-has-run-p nil | 175 | |
223 | "Whether `org-mode-hook' has run in the current buffer.") | 176 | ;;; Copy org trees as HTML |
224 | 177 | ;; Thanks to Oleh Krehel: | |
225 | (defun +org-agenda-switch-run-hooks (&rest _) | 178 | ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard |
226 | "Advice to run `org-mode-hook' when entering org-mode. | 179 | |
227 | This should only fire when switching to a buffer from `org-agenda'." | 180 | (defun +org-export-clip-to-html |
228 | (unless +org-hook-has-run-p | 181 | (&optional async subtreep visible-only body-only ext-plist post-process) |
229 | (run-hooks 'org-mode-hook) | 182 | "Export region to HTML, and copy it to the clipboard. |
230 | (setq +org-hook-has-run-p t))) | 183 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, |
231 | 184 | and POST-PROCESS are passed to `org-export-to-file'." | |
232 | (define-minor-mode +org-agenda-inhibit-hooks-mode | 185 | (interactive) ; XXX: hould this be interactive? |
233 | "Inhibit `org-mode-hook' when opening `org-agenda'." | 186 | (message "Exporting Org to HTML...") |
234 | :lighter " A/h" | 187 | (let ((org-tmp-file "/tmp/org.html")) |
235 | :global t | 188 | (org-export-to-file 'html org-tmp-file |
236 | (cond (+org-agenda-inhibit-hooks-mode | 189 | async subtreep visible-only body-only ext-plist post-process) |
237 | (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) | 190 | ;; XXX: figure out which clipboard to use, or use something in Emacs |
238 | (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) | 191 | (start-process "xclip" "*xclip*" |
239 | (:else | 192 | "xclip" "-verbose" |
240 | (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) | 193 | "-i" org-tmp-file |
241 | (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) | 194 | "-t" "text/html" |
242 | 195 | "-selection" "clipboard")) | |
243 | ;;; Drawers | 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 | |||
244 | (defun +org-hide-drawers-except-point () | 206 | (defun +org-hide-drawers-except-point () |
245 | "Hide all drawers except for the one point is in." | 207 | "Hide all drawers except for the one point is in." |
246 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | 208 | ;; Most of this bit is taken from `org-fold--hide-drawers'. |
247 | (let ((pt (point)) | 209 | (let ((pt (point)) |
248 | (begin (point-min)) | 210 | (begin (point-min)) |
249 | (end (point-max))) | 211 | (end (point-max))) |
250 | (save-excursion | 212 | (save-excursion |
251 | (goto-char begin) | 213 | (goto-char begin) |
252 | (while (and (< (point) end) | 214 | (while (and (< (point) end) |
253 | (re-search-forward org-drawer-regexp end t)) | 215 | (re-search-forward org-drawer-regexp end t)) |
254 | (if (org-fold-folded-p nil 'drawer) | 216 | (if (org-fold-folded-p nil 'drawer) |
255 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | 217 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) |
256 | (let* ((drawer (org-element-at-point)) | 218 | (let* ((drawer (org-element-at-point)) |
257 | (type (org-element-type drawer)) | 219 | (type (org-element-type drawer)) |
258 | (el-begin (org-element-property :begin drawer)) | 220 | (el-begin (org-element-property :begin drawer)) |
259 | (el-end (org-element-property :end drawer))) | 221 | (el-end (org-element-property :end drawer))) |
260 | (when (memq type '(drawer property-drawer)) | 222 | (when (memq type '(drawer property-drawer)) |
261 | (org-fold-hide-drawer-toggle | 223 | (org-fold-hide-drawer-toggle |
262 | (if (< el-begin pt el-end) 'off 'on) | 224 | (if (< el-begin pt el-end) 'off 'on) |
263 | nil drawer) | 225 | nil drawer) |
264 | (goto-char el-end)))))))) | 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)))) | ||
265 | 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)))))) | ||
266 | 307 | ||
267 | (provide '+org) | 308 | (provide '+org) |
309 | ;;; +org.el ends here | ||