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-capture.el | |
parent | bleh (diff) | |
download | emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.tar.gz emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.zip |
Switch to use-package
Diffstat (limited to 'lisp/+org-capture.el')
-rw-r--r-- | lisp/+org-capture.el | 197 |
1 files changed, 41 insertions, 156 deletions
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el index 06dfcfd..2f7bf6a 100644 --- a/lisp/+org-capture.el +++ b/lisp/+org-capture.el | |||
@@ -1,164 +1,49 @@ | |||
1 | ;;; +org-capture.el -*- lexical-binding: t; -*- | 1 | ;;; +org-capture.el -*- lexical-binding: t; -*- |
2 | 2 | ||
3 | ;;; Code: | 3 | ;;; Code: |
4 | 4 | ||
5 | (require 'cl-lib) | 5 | (require 'cl-lib) |
6 | (require 'acdw) | 6 | ;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll |
7 | ;; We don't require `org-capture' here because I'll have to require this library | 7 | ;; take a minute. Just let the compiler know that this variable exists. |
8 | ;; to init.el /before/ org-capture is fully needed. But I do need to declare | ||
9 | ;; `org-capture-templates'. | ||
10 | (defvar org-capture-templates nil) | 8 | (defvar org-capture-templates nil) |
11 | 9 | ||
12 | (defun +org-capture--get (key &optional list) | 10 | ;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 |
13 | "Find KEY in LIST, or return nil. | 11 | (defun +org-capture-template-define (description &rest args) |
14 | LIST defaults to `org-capture-templates'." | 12 | "Define a capture template. |
15 | (alist-get key (or list org-capture-templates) nil nil #'equal)) | 13 | Creates a list and adds it to `org-capture-templates', if it's |
16 | 14 | not already there. ARGS is a plist, which in addition to the | |
17 | ;; Set it up as a generic value. Based on the one for `alist-get'. | 15 | additional options `org-capture-templates' accepts (which see), |
18 | (gv-define-expander +org-capture--get | 16 | takes the following and puts them in the right spot: `:keys', |
19 | (lambda (do key &optional alist) | 17 | `:description', `:type', `:target', and `:template'." |
20 | (setf alist (or alist org-capture-templates)) | 18 | (declare (indent 1)) |
21 | (macroexp-let2 macroexp-copyable-p k key | 19 | (let* ((keys (plist-get args :keys)) |
22 | (gv-letplace (getter setter) alist | 20 | (type (plist-get args :type)) |
23 | (macroexp-let2 nil p `(assoc ,k ,getter 'equal) | 21 | (target (plist-get args :target)) |
24 | (funcall do `(cdr ,p) | 22 | (template (plist-get args :template)) |
25 | (lambda (v) | 23 | (template-value (append |
26 | (macroexp-let2 nil v v | 24 | (list description) |
27 | (let ((set-exp | 25 | (when (or type target template) |
28 | `(if ,p (setcdr ,p ,v) | 26 | (list (or type 'entry) target template)) |
29 | ,(funcall setter | 27 | (cl-loop for i from 0 below (length args) by 2 |
30 | `(cons (setf ,p (cons ,k ,v)) | 28 | unless (member (nth i args) |
31 | ,getter))))) | 29 | '(:keys :description :type |
32 | `(progn | 30 | :target :template)) |
33 | ,set-exp | 31 | append (list (nth i args) |
34 | ,v)))))))))) | 32 | (plist-get args (nth i |
35 | 33 | args))))))) | |
36 | (defun +org-capture-sort (&optional list) | 34 | ;; The only way I know how to do this properly (add a value to the end of |
37 | "Sort LIST by string keys. | 35 | ;; the list, if it exists; otherwise update it) is to do this weird if-setf |
38 | LIST is a symbol and defaults to `org-capture-templates'." | 36 | ;; dance. |
39 | (setf list (or list 'org-capture-templates)) | 37 | (if (seq-find (lambda (el) (equal (car el) keys)) |
40 | (set list (sort (symbol-value list) (lambda (a b) | 38 | org-capture-templates) |
41 | (string< (car a) (car b)))))) | 39 | (setf (alist-get keys org-capture-templates nil nil #'equal) |
42 | 40 | template-value) | |
43 | (defun +org-capture-sort-after-init (&optional list) | 41 | (setf org-capture-templates |
44 | "Sort LIST with `+org-capture-sort' after Emacs init." | 42 | (append org-capture-templates |
45 | (+ensure-after-init #'+org-capture-sort)) | 43 | (list (cons keys template-value))))) |
46 | 44 | ;; Regardless of what we do, return the new value of | |
47 | ;;;###autoload | 45 | ;; `org-capture-templates'. |
48 | (defun +org-capture-templates-setf (key value &optional list sort-after) | 46 | org-capture-templates)) |
49 | "Add KEY to LIST, using `setf'. | ||
50 | LIST is a symbol and defaults to `org-capture-templates' -- so | ||
51 | this function sets values on a list that's structured as such. | ||
52 | |||
53 | Thus, KEY is a string key. If it's longer than one character, | ||
54 | this function will search LIST for each successive run of | ||
55 | characters before the final, ensuring sub-lists exist of the | ||
56 | form (CHARS DESCRIPTION). | ||
57 | |||
58 | For example, if KEY is \"abc\", first a LIST item of the form (a | ||
59 | DESCRIPTION), if non-existant, will be added to the list (with a | ||
60 | default description), then an item of the | ||
61 | form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. | ||
62 | |||
63 | VALUE is the template or group header required for | ||
64 | `org-capture-templates', which see. | ||
65 | |||
66 | SORT-AFTER, when set to t, will call | ||
67 | `+org-capture-templates-sort' after setting, to ensure org can | ||
68 | properly process the variable." | ||
69 | ;; LIST defaults to `org-capture-templates' | ||
70 | (declare (indent 2)) | ||
71 | (unless list (setf list 'org-capture-templates)) | ||
72 | ;; Ensure VALUE is a list to cons properly | ||
73 | (unless (listp value) (setf value (list value))) | ||
74 | (when (> (length key) 1) | ||
75 | ;; Check for existence of groups. | ||
76 | (let ((expected (cl-loop for i from 1 to (1- (length key)) | ||
77 | collect (substring key 0 i) into keys | ||
78 | finally return keys))) | ||
79 | (cl-loop for ek in expected | ||
80 | if (not (+org-capture--get ek (symbol-value list))) do | ||
81 | (setf (+org-capture--get ek (symbol-value list)) | ||
82 | (list (format "(Group %s)" ek)))))) | ||
83 | (prog1 ;; Set KEY to VALUE | ||
84 | (setf (+org-capture--get key (symbol-value list)) value) | ||
85 | ;; Sort after, maybe | ||
86 | (when sort-after (+org-capture-sort list)))) | ||
87 | |||
88 | (defun +org-template--ensure-path (keys &optional list) | ||
89 | "Ensure path of keys exists in `org-capture-templates'." | ||
90 | (unless list (setf list 'org-capture-templates)) | ||
91 | (when (> (length key) 1) | ||
92 | ;; Check for existence of groups. | ||
93 | (let ((expected (cl-loop for i from 1 to (1- (length key)) | ||
94 | collect (substring key 0 i) into keys | ||
95 | finally return keys))) | ||
96 | (cl-loop for ek in expected | ||
97 | if (not (+org-capture--get ek (symbol-value list))) do | ||
98 | (setf (+org-capture--get ek (symbol-value list)) | ||
99 | (list (format "(Group %s)" ek))))))) | ||
100 | |||
101 | (defcustom +org-capture-default-type 'entry | ||
102 | "Default template for `org-capture-templates'." | ||
103 | :type '(choice (const :tag "Entry" entry) | ||
104 | (const :tag "Item" item) | ||
105 | (const :tag "Check Item" checkitem) | ||
106 | (const :tag "Table Line" table-line) | ||
107 | (const :tag "Plain Text" plain))) | ||
108 | |||
109 | (defcustom +org-capture-default-target "" | ||
110 | "Default target for `org-capture-templates'." | ||
111 | ;; TODO: type | ||
112 | ) | ||
113 | |||
114 | (defcustom +org-capture-default-template nil | ||
115 | "Default template for `org-capture-templates'." | ||
116 | ;; TODO: type | ||
117 | ) | ||
118 | |||
119 | (defun +org-define-capture-templates-group (keys description) | ||
120 | "Add a group title to `org-capture-templates'." | ||
121 | (setf (+org-capture--get keys org-capture-templates) | ||
122 | (list description))) | ||
123 | |||
124 | ;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] | ||
125 | (defun +org-define-capture-template (keys description &rest args) | ||
126 | "Define a capture template and necessary antecedents. | ||
127 | ARGS is a plist, which in addition to the additional options | ||
128 | `org-capture-templates' accepts, takes the following and places | ||
129 | them accordingly: :type, :target, and :template. Each of these | ||
130 | corresponds to the same field in `org-capture-templates's | ||
131 | docstring, which see. Likewise with KEYS and DESCRIPTION, which | ||
132 | are passed separately to the function. | ||
133 | |||
134 | This function will also create all the necessary intermediate | ||
135 | capture keys needed for `org-capture'; that is, if KEYS is | ||
136 | \"wcp\", entries for \"w\" and \"wc\" will both be ensured in | ||
137 | `org-capture-templates'." | ||
138 | (declare (indent 2)) | ||
139 | ;; Check for existence of parent groups | ||
140 | (when (> (length keys) 1) | ||
141 | (let ((expected (cl-loop for i from 1 to (1- (length keys)) | ||
142 | collect (substring 0 i) into keys | ||
143 | finally return keys))) | ||
144 | (cl-loop | ||
145 | for ek in expected | ||
146 | if (not (+org-capture--get ek org-capture-templates)) | ||
147 | do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) | ||
148 | (if (null args) | ||
149 | ;; Add the title | ||
150 | (+org-define-capture-templates-group keys description) | ||
151 | ;; Add the capture template. | ||
152 | (setf (+org-capture--get keys org-capture-templates) | ||
153 | (append (list (or (plist-get args :type) | ||
154 | +org-capture-default-type) | ||
155 | (or ( plist-get args :target) | ||
156 | +org-capture-default-target) | ||
157 | (or (plist-get args :template) | ||
158 | +org-capture-default-template)) | ||
159 | (cl-loop for (key val) on args by #'cddr | ||
160 | unless (member key '(:type :target :template)) | ||
161 | append (list key val)))))) | ||
162 | 47 | ||
163 | (provide '+org-capture) | 48 | (provide '+org-capture) |
164 | ;;; +org-capture.el ends here | 49 | ;;; +org-capture.el |