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

Remove ID and CUSTOM_ID properties when inserting checklist template 

When the template associated with the item at point contains sub-items itself,
those may have been assigned ID or CUSTOM_ID properties.  Copying the template
would thus duplicate these properties, violating their implicit uniqueness
constraint, so we now remove those properties from the inserted checklist
template.
This commit is contained in:
Daniel - 2023-05-06 16:54:38 +02:00
parent fa56dfdd4d
commit 925cf115be
Signed by: dbo
GPG Key ID: 784AA8DF0CCDF625
1 changed files with 84 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1090,69 +1090,89 @@ inserting the checklist."
(t ;; Default action: insert complete checklist. (t ;; Default action: insert complete checklist.
;; Let's remember where we are, so that latter on CHECKLIST_INSERTED_P (let (point-before-template
;; will be inserted at the original heading (where we are now) and not point-after-template)
;; at possible new subtrees coming from the template.
(save-mark-and-excursion
;; Checklists are inserted directly before first child, if existent, or ;; Let's remember where we are, so that latter on CHECKLIST_INSERTED_P
;; at end of subtree ;; will be inserted at the original heading (where we are now) and not
(org-show-entry) ;; at possible new subtrees coming from the template.
(or (org-goto-first-child) (save-mark-and-excursion
(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))
;; Insert relevant backlinks, when available. ;; Checklists are inserted directly before first child, if existent, or
(let ((parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil) ;; at end of subtree
(string-to-number it))) (org-show-entry)
number-of-backlinks (or (org-goto-first-child)
point-before-backlinks) (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))
;; Insert blank line, but only if the previous line is not blank ;; Insert relevant backlinks, when available.
;; already. (let ((parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
(unless (save-mark-and-excursion (string-to-number it)))
(forward-line -1) number-of-backlinks
(looking-at (rx bol (* space) eol))) point-before-backlinks)
(insert "\n"))
(insert (format "Relevant backlinks (%s):\n\n" ;; Insert blank line, but only if the previous line is not blank
(if parent-depth ;; already.
(format "parent-depth %d" parent-depth) (unless (save-mark-and-excursion
"all parents"))) (forward-line -1)
(looking-at (rx bol (* space) eol)))
(insert "\n"))
;; Store where we are (minus the two newlines) so we can delete the (insert (format "Relevant backlinks (%s):\n\n"
;; checklist in case it's empty. (if parent-depth
(setq point-before-backlinks (- (point) 2)) (format "parent-depth %d" parent-depth)
"all parents")))
(setq number-of-backlinks ;; Store where we are (minus the two newlines) so we can delete the
(org-dblock-write:db/org-backlinks (list ;; checklist in case it's empty.
:org-ql-match '(and (setq point-before-backlinks (- (point) 2))
(not (done))
(not (ltags "TEMPLATE"))
(not (scheduled :from 1))
(not (property "CHECKLIST_NO_BACKLINK" "t" :inherit nil)))
:parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
(string-to-number it))
:archive nil)))
;; When no backlinks have been found, remove the empty table head and just (setq number-of-backlinks
;; print "none". (org-dblock-write:db/org-backlinks (list
(when (zerop number-of-backlinks) :org-ql-match '(and
(delete-region point-before-backlinks (point)) (not (done))
(insert " none."))) (not (ltags "TEMPLATE"))
(not (scheduled :from 1))
(not (property "CHECKLIST_NO_BACKLINK" "t" :inherit nil)))
:parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
(string-to-number it))
:archive nil)))
;; Insert template, when avilable. ;; When no backlinks have been found, remove the empty table head and just
(let ((template-marker (db/org--find-template))) ;; print "none".
(insert "\n\nTemplate:") (when (zerop number-of-backlinks)
(if (not template-marker) (delete-region point-before-backlinks (point))
(insert " none.\n") (insert " none.")))
(db/org-copy-body-from-item-to-point template-marker))))
(org-entry-put (point) "CHECKLIST_INSERTED_P" "t") ;; Insert template, when avilable.
(db/org-goto-first-open-checkbox-in-subtree)))) (let ((template-marker (db/org--find-template)))
(insert "\n\nTemplate:")
(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")
(org-update-statistics-cookies nil)
;; Remove any existing ID properties, as they would be duplicates
;; now. Only do this in the part inserted with template, though, and
;; leave previously existing child items and the item itself as they
;; are.
(save-mark-and-excursion
(set-mark point-before-template)
(goto-char point-after-template)
(org-map-entries #'(lambda ()
(org-entry-delete (point) "ID")
(org-entry-delete (point) "CUSTOM_ID"))
nil
'region))
(db/org-goto-first-open-checkbox-in-subtree)))))
(define-obsolete-function-alias 'db/org-copy-template (define-obsolete-function-alias 'db/org-copy-template
'db/org-insert-checklist 'db/org-insert-checklist
@ -1183,6 +1203,7 @@ inserted template."
(unless (number-or-marker-p pom) (unless (number-or-marker-p pom)
(user-error "Argument is neither point nor mark: %s" pom)) (user-error "Argument is neither point nor mark: %s" pom))
(let ((body (save-restriction (let ((body (save-restriction
(widen)
(save-mark-and-excursion (save-mark-and-excursion
(let ((template-element (org-with-point-at pom (let ((template-element (org-with-point-at pom
(org-element-at-point)))) (org-element-at-point))))
@ -1208,15 +1229,15 @@ inserted template."
(buffer-substring-no-properties content-begin content-end))))))))) (buffer-substring-no-properties content-begin content-end)))))))))
(cond (cond
;; Open next line if the current line is not blank ;; Open next line if the current line is not blank
((not (looking-at (rx bol eol))) ((not (looking-at (rx bol eol)))
(insert "\n\n")) (insert "\n\n"))
;; Add newline, but only if the previous line is not blank already. ;; Add newline, but only if the previous line is not blank already.
((not (save-mark-and-excursion ((not (save-mark-and-excursion
(forward-line -1) (forward-line -1)
(looking-at (rx bol (* space) eol)))) (looking-at (rx bol (* space) eol))))
(insert "\n"))) (insert "\n")))
(insert body) (insert body)
@ -1224,9 +1245,7 @@ inserted template."
(unless (save-mark-and-excursion (unless (save-mark-and-excursion
(forward-line 1) (forward-line 1)
(looking-at (rx bol (* space) eol))) (looking-at (rx bol (* space) eol)))
(insert "\n")) (insert "\n"))))
(org-update-statistics-cookies nil)))
(defun db/org-goto-first-open-checkbox-in-subtree (&optional silent) (defun db/org-goto-first-open-checkbox-in-subtree (&optional silent)
"Jump to first open checkbox in the current subtree. "Jump to first open checkbox in the current subtree.