Refactory template copy function into function to copy item bodies

This allows the same copy behavior as before (apart from newly introduced bugs,
that is), but in addition gives the possibility to copy bodies of arbitraty
items that can be choosen interactively.  This might come in handy when copying
general checklists from anywhere in the main Org mode file to the current task.
This commit is contained in:
Daniel - 2021-08-08 13:49:07 +02:00
parent b4621122cc
commit ca679b2274
No known key found for this signature in database
GPG Key ID: 1C7071A75BB72D64
1 changed files with 54 additions and 28 deletions

View File

@ -560,37 +560,63 @@ Work task and home task are determined by the current values of
(org-clock-mark-default-task))))
(defun db/org-copy-template-for-periodic-task ()
"Copy template of the enclosing periodic task to item at point.
The template must be placed into an item titled 'Template',
called the template item. The template item must be the first
"Copy body of the enclosing periodic task to item at point.
The body must be placed into an item titled 'Template',
called the body item. The body item must be the first
headline of the periodic task, i.e., of the parent of the current
item at point. The body of the template item, without any
item at point. The body of the body item, without any
drawers, will be copied to point."
(interactive)
(let ((template (save-restriction
(save-mark-and-excursion
(let ((template-element (progn
(outline-up-heading 1 'invisible-ok)
(outline-next-heading)
(org-element-at-point))))
(unless (string-equal (org-element-property :title template-element)
"Template")
(user-error "Template must be first headline in periodic task"))
;; Starting from the end of the last element in the
;; subtree, we go up until we find a drawer or a
;; headline; everything in between is considered to be the template
(let ((content-end (org-element-property :contents-end template-element))
content-begin current-element)
(goto-char content-end)
(while (progn
(setq current-element (org-element-at-point))
(not (memq (org-element-type current-element)
'(drawer property-drawer headline))))
(setq content-begin (org-element-property :begin current-element))
(goto-char (1- content-begin)))
(string-trim-right
(buffer-substring-no-properties content-begin content-end))))))))
(insert template)
(let ((template-pom (save-restriction
(save-mark-and-excursion
;; Navigate to the body, which is supposed to be
;; the first item of the periodic task. One could
;; think about putting the body also directly
;; below the periodic task, but this is not supported
;; yet.
(outline-up-heading 1 'invisible-ok)
(outline-next-heading)
(point)))))
(unless (string-equal (org-element-property
:title
(org-with-point-at template-pom
(org-element-at-point)))
"Template")
(user-error "Template must be first headline in periodic task"))
(db/org-copy-body-from-item-to-point template-pom)))
(defun db/org-copy-body-from-item-to-point (pom)
"Copy body from item given by POM to point.
This can be used to copy checklists from templates to the current
item, which might be an instance of a periodic task.
If POM is not given, use `db/org--get-location' to interactively
query for it."
(interactive (list (db/org--get-location)))
(unless (number-or-marker-p pom)
(user-error "Argument is neither point nor mark: %s" pom))
(let ((body (save-restriction
(save-mark-and-excursion
(let ((template-element (org-with-point-at pom
(org-element-at-point))))
;; Starting from the end of the last element in the subtree,
;; we go up until we find a drawer or a headline; everything
;; in between is considered to be the body.
(let ((content-end (org-element-property :contents-end template-element))
content-begin current-element)
(goto-char content-end)
(while (progn
(setq current-element (org-element-at-point))
(not (memq (org-element-type current-element)
'(drawer property-drawer headline))))
(setq content-begin (org-element-property :begin current-element))
(goto-char (1- content-begin)))
(string-trim-right
(buffer-substring-no-properties content-begin content-end))))))))
(insert body)
(org-update-statistics-cookies nil)))