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