emacs/lisp/+org-capture.el

;;; +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)
    (setq 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 (setq ,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'."
  (setq 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 (setq list 'org-capture-templates))
  ;; Ensure VALUE is a list to cons properly
  (unless (listp value) (setq 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 (setq 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