Add +org-capture

3 files changed, 173 insertions, 80 deletions

@@ -343,10 +343,93 @@
     ;;            context-menu-dictionary))
     (context-menu-mode +1)))
 
+(setup org
+  ;; Plain org with the `setup' form for sorting, but I install with straight.
+    (:straight (org
+                   :type git :host nil
+                   :repo "https://git.savannah.gnu.org/git/emacs/org-mode.git"
+                   :local-repo "org"
+                   :depth full
+                   :pre-build (straight-recipes-org-elpa--build)
+                   :build (:not autoloads)
+                   :files (:defaults
+                           "lisp/*.el"
+                           ("etc/styles/" "etc/styles/*")))
+                  (org-contrib
+                   :type git :host nil
+                   :repo "https://git.sr.ht/~bzg/org-contrib"))
+  ;; DO NOT load system-installed org !!!
+  (setq load-path (cl-remove-if (lambda (path)
+                                  (string-match-p "lisp/org\\'" path))
+                                load-path))
+  (:also-load +org
+              ox-md)
+  (:option org-adapt-indentation nil
+           org-archive-mark-done t
+           org-catch-invisible-edits 'show-and-error
+           org-clock-clocked-in-display 'mode-line
+           org-clock-frame-title-format (cons
+                                         '(t org-mode-line-string)
+                                         (cons " --- " frame-title-format))
+           org-clock-string-limit 7     ; just the clock bit
+           ;; org-clock-string-limit 25    ; gives enough information
+           org-clock-persist t
+           org-confirm-babel-evaluate nil
+           org-cycle-separator-lines 0
+           org-directory "~/org"
+           org-ellipsis "…"
+           org-export-coding-system 'utf-8-unix
+           org-export-headline-levels 8
+           org-export-with-section-numbers nil
+           org-export-with-smart-quotes t
+           org-export-with-sub-superscripts t
+           org-export-with-toc nil
+           org-fontify-done-headline t
+           org-fontify-quote-and-verse-blocks t
+           org-fontify-whole-heading-line t
+           org-hide-emphasis-markers t
+           org-html-coding-system 'utf-8-unix
+           org-image-actual-width (list (* (window-font-width)
+                                           (- fill-column 8)))
+           org-imenu-depth 3
+           org-list-demote-modify-bullet '(("-" . "+")
+                                           ("+" . "*")
+                                           ("*" . "-"))
+           org-log-done 'time
+           org-log-into-drawer t
+           org-outline-path-complete-in-steps nil
+           org-pretty-entities t
+           org-pretty-entities-include-sub-superscripts nil
+           org-refile-use-outline-path 'file
+           org-special-ctrl-a/e t
+           org-special-ctrl-k t
+           org-src-fontify-natively t
+           org-src-tab-acts-natively t
+           org-src-window-setup 'current-window
+           org-startup-truncated nil
+           org-startup-with-inline-images t
+           org-tags-column (- (- fill-column (length org-ellipsis))))
+  (:bind "RET" #'+org-return-dwim
+         "<S-return>" #'+org-table-copy-down
+         "C-c C-l" #'+org-insert-link-dwim
+         "C-c C-n" #'+org-next-heading-widen
+         "C-c C-p" #'+org-previous-heading-widen)
+  (:local-hook before-save-hook #'+org-before-save@prettify-buffer)
+  (advice-add #'org-delete-backward-char :override #'+org-delete-backward-char)
+  (with-eval-after-load 'org
+    (org-clock-persistence-insinuate)
+    (org-link-set-parameters "tel" :follow #'+org-tel-open)))
+
 (setup org-agenda
   (:option org-agenda-skip-deadline-if-done t)
+  (add-to-list '+custom-variable-allowlist 'org-agenda-file-regexp)
+  (add-to-list '+custom-variable-allowlist 'org-agenda-templates)
   (:+leader "a" #'org-agenda "C-a" #'org-agenda))
 
+(setup org-capture
+  (:require +org-capture)
+  (:+leader "c" #'org-capture "C-c" #'org-capture))
+
 (setup prog
   (:local-set comment-auto-fill-only-comments t)
   (:hook #'prettify-symbols-mode
@@ -848,82 +931,6 @@ See also `crux-reopen-as-root-mode'."
 (setup (:straight orderless)
   (:option completion-styles '(orderless)))
 
-(setup (:straight (org
-                   :type git :host nil
-                   :repo "https://git.savannah.gnu.org/git/emacs/org-mode.git"
-                   :local-repo "org"
-                   :depth full
-                   :pre-build (straight-recipes-org-elpa--build)
-                   :build (:not autoloads)
-                   :files (:defaults
-                           "lisp/*.el"
-                           ("etc/styles/" "etc/styles/*")))
-                  (org-contrib
-                   :type git :host nil
-                   :repo "https://git.sr.ht/~bzg/org-contrib"))
-  ;; DO NOT load system-installed org !!!
-  (setq load-path (cl-remove-if (lambda (path)
-                                  (string-match-p "lisp/org\\'" path))
-                                load-path))
-  (:also-load +org
-              ox-md)
-  (:option org-adapt-indentation nil
-           org-archive-mark-done t
-           org-catch-invisible-edits 'show-and-error
-           org-clock-clocked-in-display 'mode-line
-           org-clock-frame-title-format (cons
-                                         '(t org-mode-line-string)
-                                         (cons " --- " frame-title-format))
-           org-clock-string-limit 7     ; just the clock bit
-           ;; org-clock-string-limit 25    ; gives enough information
-           org-clock-persist t
-           org-confirm-babel-evaluate nil
-           org-cycle-separator-lines 0
-           org-directory "~/org"
-           org-ellipsis "…"
-           org-export-coding-system 'utf-8-unix
-           org-export-headline-levels 8
-           org-export-with-section-numbers nil
-           org-export-with-smart-quotes t
-           org-export-with-sub-superscripts t
-           org-export-with-toc nil
-           org-fontify-done-headline t
-           org-fontify-quote-and-verse-blocks t
-           org-fontify-whole-heading-line t
-           org-hide-emphasis-markers t
-           org-html-coding-system 'utf-8-unix
-           org-image-actual-width (list (* (window-font-width)
-                                           (- fill-column 8)))
-           org-imenu-depth 3
-           org-list-demote-modify-bullet '(("-" . "+")
-                                           ("+" . "*")
-                                           ("*" . "-"))
-           org-log-done 'time
-           org-log-into-drawer t
-           org-outline-path-complete-in-steps nil
-           org-pretty-entities t
-           org-pretty-entities-include-sub-superscripts nil
-           org-refile-use-outline-path 'file
-           org-special-ctrl-a/e t
-           org-special-ctrl-k t
-           org-src-fontify-natively t
-           org-src-tab-acts-natively t
-           org-src-window-setup 'current-window
-           org-startup-truncated nil
-           org-startup-with-inline-images t
-           org-tags-column (- (- fill-column (length org-ellipsis))))
-  (:bind "RET" #'+org-return-dwim
-         "<S-return>" #'+org-table-copy-down
-         "C-c C-l" #'+org-insert-link-dwim
-         "C-c C-n" #'+org-next-heading-widen
-         "C-c C-p" #'+org-previous-heading-widen)
-  (:+leader "c" #'org-capture "C-c" #'org-capture)
-  (:local-hook before-save-hook #'+org-before-save@prettify-buffer)
-  (advice-add #'org-delete-backward-char :override #'+org-delete-backward-char)
-  (with-eval-after-load 'org
-    (org-clock-persistence-insinuate)
-    (org-link-set-parameters "tel" :follow #'+org-tel-open)))
-
 (setup (:straight org-appear)
   (:option org-appear-autoemphasis t
            org-appear-autoentities t
@@ -34,15 +34,19 @@
   "Variables to allow changing while loading the Custom file.")
 
 (defun +custom-load-ignoring-most-customizations (&optional
-                                                     noerror
+                                                     error
                                                      nomessage
                                                      nosuffix
                                                      must-suffix)
   "Load `custom-file', ignoring most customizations.
 Ignore all faces, and only load variables in
 `+customize-variable-allowlist'.  All the optional
-variables---NOERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are
-passed on to `load'."
+variables---ERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are
+passed on to `load'.
+
+NOTE: ERROR is the opposite of its value in `load' -- meaning
+that this function by default does /not/ error, but will if you
+pass t to it."
   (cl-letf (((symbol-function 'custom-set-faces) 'ignore)
             ((symbol-function 'custom-set-variables)
              (lambda (&rest args)
@@ -51,7 +55,7 @@ passed on to `load'."
                                     (memq (car el)
                                           +custom-variable-allowlist))
                                   args)))))
-    (load custom-file noerror nomessage nosuffix must-suffix)))
+    (load custom-file (not error) nomessage nosuffix must-suffix)))
 
 (defun +cus-edit-expand-widgets (&rest _)
   "Expand descriptions in `Custom-mode' buffers."
@@ -0,0 +1,82 @@
+;;; +org-capture.el -*- lexical-binding: t; -*-
+
+;;; Code:
+
+(require 'cl-lib)
+;; We don't require `org-capture' here because I'll have to require this library
+;; to init.el /before/ org-capture is fully needed.
+
+(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))))))
+
+;;;###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))))
+
+(provide '+org-capture)
+;;; +org-capture.el ends here