exot/.emacs.d
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Do not print “Template” in checklist when no other items exist

Browse Source 
I tend to remove “Template” anyway when it's the only block inserted as
checklist, so let's do this automatically.

This commit also includes a minor refactoring of moving around variable
declarations to be closer to the code that actually uses them.
This commit is contained in:
Daniel Borchmann 2024-12-20 10:50:41 +01:00
parent 3a397139f2
commit 60463a01e3
No known key found for this signature in database
GPG Key ID: 784AA8DF0CCDF625
1 changed files with 63 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
site-lisp/db-org.el
View File

@ -1438,54 +1438,52 @@ inserting the checklist."
(t ;; Default action: insert complete checklist. (t ;; Default action: insert complete checklist.
(let (point-before-template (save-mark-and-excursion
point-after-template)
;; Let's remember where we are, so that latter on CHECKLIST_INSERTED_P ;; Checklists are inserted directly before first child, if existent, or
;; will be inserted at the original heading (where we are now) and not ;; at end of subtree
;; at possible new subtrees coming from the template. (org-fold-show-entry)
(save-mark-and-excursion (or (org-goto-first-child)
(org-end-of-subtree 'invisible-ok 'to-heading))
;; Move back from heading, unless we are at the end of the buffer
(when (org-at-heading-p)
;; Go to end of line before heading
(forward-char -1))
;; Checklists are inserted directly before first child, if existent, or ;; Insert blank line, but only if the previous line is not blank already.
;; at end of subtree (unless (save-mark-and-excursion
(org-fold-show-entry) (forward-line -1)
(or (org-goto-first-child) (looking-at (rx bol (* space) eol)))
(org-end-of-subtree 'invisible-ok 'to-heading)) (insert "\n"))
;; Move back from heading, unless we are at the end of the buffer
(when (org-at-heading-p)
;; Go to end of line before heading
(forward-char -1))
;; Insert blank line, but only if the previous line is not blank already. ;; Insert actual checklist consisting of concurrent dates, relevant backlinks, and a template
(unless (save-mark-and-excursion (let (concurrent-dates
(forward-line -1) number-of-backlinks)
(looking-at (rx bol (* space) eol)))
(insert "\n"))
;; Insert links to concurrent DATEs, if any ;; Insert links to concurrent DATEs, if any
(when-let ((concurrent-dates (org-ql-query :from (org-agenda-files)
:select '(cons (setq concurrent-dates (org-ql-query :from (org-agenda-files)
(org-entry-get (point) "ITEM") :select '(cons
(org-id-get-create)) (org-entry-get (point) "ITEM")
:where `(and ; XXX: this is not quite right yet (org-id-get-create))
(tags "DATE") :where `(and ; XXX: this is not quite right yet
(not (done)) (tags "DATE")
;; XXX: calling `ts-now' twice might be stupid (not (done))
(ts-active :from ,(ts-now)) ;; XXX: calling `ts-now' twice might be stupid
(ts-active :to ,(ts-now)))))) (ts-active :from ,(ts-now))
(ts-active :to ,(ts-now)))))
(when concurrent-dates
(insert "Concurrent DATEs:\n") (insert "Concurrent DATEs:\n")
(dolist (date concurrent-dates) (dolist (date concurrent-dates)
(insert "- " (org-link-make-string (format "id:%s" (cdr date)) (car date)) "\n")) (insert "- " (org-link-make-string (format "id:%s" (cdr date)) (car date)) "\n"))
(insert "\n")) (insert "\n"))
;; Insert relevant backlinks, when available. ;; Insert relevant backlinks
(let ((parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
(string-to-number it)))
number-of-backlinks
point-before-backlinks)
;; Store where we are so we can delete the checklist in case it's empty. (let ((point-before-backlinks (point))
(setq point-before-backlinks (point)) (parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
(string-to-number it))))
(insert (format "Relevant backlinks (%s):\n\n" (insert (format "Relevant backlinks (%s):\n\n"
(if parent-depth (if parent-depth
@ -1510,32 +1508,37 @@ inserting the checklist."
(delete-region point-before-backlinks (point)) (delete-region point-before-backlinks (point))
(insert "\n\n"))) (insert "\n\n")))
;; Insert template, when avilable. ;; And finally insert a template
(let ((template-marker (db/org--find-template)))
(insert "Template:")
(setq point-before-template (point))
(if (not template-marker)
(insert " none.\n")
(db/org-copy-body-from-item-to-point template-marker))
(setq point-after-template (point))))
(org-entry-put (point) "CHECKLIST_INSERTED_P" "t") (when-let ((template-marker (db/org--find-template)))
(org-update-statistics-cookies nil) (let (point-before-template
point-after-template)
(setq point-before-template (point))
(unless (and (zerop number-of-backlinks)
(null concurrent-dates))
;; When there are no backlinks, there is no need to print “Template” as a
;; separator
(insert "Template:"))
(db/org-copy-body-from-item-to-point template-marker)
(setq point-after-template (point))
;; Remove any existing ID properties, as they would be duplicates ;; Remove any existing ID properties, as they would be duplicates
;; now. Only do this in the part inserted with template, though, and ;; now. Only do this in the part inserted with template, though, and
;; leave previously existing child items and the item itself as they ;; leave previously existing child items and the item itself as they
;; are. ;; are.
(save-mark-and-excursion (save-mark-and-excursion
(set-mark point-before-template) (set-mark point-before-template)
(goto-char point-after-template) (goto-char point-after-template)
(org-map-entries #'(lambda () (org-map-entries #'(lambda ()
(org-entry-delete (point) "ID") (org-entry-delete (point) "ID")
(org-entry-delete (point) "CUSTOM_ID")) (org-entry-delete (point) "CUSTOM_ID"))
nil nil
'region)) 'region))))))
(db/org-goto-first-open-checkbox-in-headline))))) (org-entry-put (point) "CHECKLIST_INSERTED_P" "t")
(org-update-statistics-cookies nil)
(db/org-goto-first-open-checkbox-in-headline))))
(define-obsolete-function-alias 'db/org-copy-template (define-obsolete-function-alias 'db/org-copy-template
'db/org-insert-checklist 'db/org-insert-checklist