1

Suppose we have two entries: Header One and Header Two:

* Header One
:PROPERTIES:
:ID_LOG: TARGET
:END:
:LOGBOOK:
CLOCK: [2018-07-04 Wed 00:00]--[2018-07-04 Wed 0:30] =>  0:30
:END:

* Header Two
:PROPERTIES:
:ID: TARGET
:END:
:PROPERTIES:
CLOCK: [2018-07-04 Wed 00:00]--[2018-07-04 Wed 0:15] =>  0:15
:PROPERTIES:

Question: How can we copy all CLOCK entries from the former to the latter (via a command), so that the above example becomes the following:

* Header One
:PROPERTIES:
:ID_LOG: TARGET
:END:
:LOGBOOK:
CLOCK: [2018-07-04 Wed 00:00]--[2018-07-04 Wed 0:30] =>  0:30
:END:

* Header Two
:PROPERTIES:
:ID: TARGET
:END:
:LOGBOOK:
CLOCK: [2018-07-04 Wed 00:00]--[2018-07-04 Wed 0:30] =>  0:30
CLOCK: [2018-07-04 Wed 00:00]--[2018-07-04 Wed 0:15] =>  0:15
:END:

Notice that Header One has :ID_LOG: TARGET, and that Header Two has :ID: TARGET. This is meant to indicate the flow of how the time log data should be moved.

EDIT: The interactive function should be able to work across agenda files. That means it should search for ID_LOG headers in all agenda files and insert the found clocks at the corresponding ID headers in all agenda files.

It would be nice if it is additionally possible to search only the current headline for ID_LOG entries and to insert the found clocks at the corresponding ID headers in all agenda files.

1
+50

You can test whether the command org+-copy-id_log-clock defined within the following code fits your purposes.

Function org+-agenda-copy-id_log-clock copies clocks of ID_LOG headers to clocks of ID-headers across all agenda files.

You need to test that because your specification leaves some details to the programmer.

For an instance: What should happen when ID_LOG appears multiple times with the same id? The code below accumulates all clocks with the same id in ID_LOG. There are several other variations of that kind.

(defun org+-element-container (el &optional type)
  "Return the element of TYPE where element EL is contained.
TYPE defaults to 'headline.
Returns nil if El has no container with type TYPE."
  (unless type (setq type 'headline))
  (while (and el
              (null (eq (org-element-type el) type)))
    (setq el (org-element-property :parent el)))
  el)

(defsubst org+-element-set-property (el prop val)
  "Set property PROP of element EL to VAL."
  (setf (nth 1 el) (plist-put (nth 1 el) prop val)))

(defsubst org+-element-set-parent (el parent)
  "Set parent of element EL to PARENT."
  (org+-element-set-property el :parent parent))

(defun org+-element-add-contents (el item &optional append afterp)
  "Add ITEM to org element EL.
Thereby the :parent property of ITEM is set to EL.
You should create ITEM by `org-element-copy',
`org-element-create', or `org-element-extract'.
Those functions either create a new element or unlink
the element from the parse tree.
That way there is no parent when this function is called.

AFTERP is nil or a predicate with an org element
as its only argument.
ITEM is inserted after the first element of EL
for which AFTERP returns non-nil.
The new ITEM is appended to the existing content
if AFTERP is undecisive and APPEND is non-nil
and prepend otherwise."
  (org+-element-set-parent item el)
  (let* ((contents (org-element-contents el))
         (ptr contents)
         found)
    (when afterp
      (while ptr
        (if (funcall afterp (car ptr))
            (progn
              (setcdr ptr (cons item (cdr ptr)))
              (org-element-set-contents el contents) ;; pro forma
              (setq found t
                    ptr nil))
          (setq ptr (cdr ptr)))))
    (unless found
      (org-element-set-contents
       el
       (if append
           (setcdr (last contents) (cons item nil))
         (cons item contents))))))

(defcustom org+-copy-id_log-clock-allow-duplicates nil
  "Allow duplicated clock entries in logbooks when copying
clock entries from id_log to id."
  :group 'org
  :type 'boolean)

(defsubst org+-element-clocks=-p (clock1 clock2)
  "Test whether clock elements CLOCK1 and CLOCK2 are equivalent."
  (string-equal (org-element-interpret-data clock1)
                (org-element-interpret-data clock2)))

(require 'subr-x)

(defmacro with-current-file (filename &rest body)
  "Temporarily visit FILENAME to execute BODY.
If a buffer is already visiting FILENAME re-use that buffer.
Otherwise create a new buffer for visiting FILENAME
and kill that buffer if it is unmodified after executing BODY."
  (declare (indent 1) (debug (form body)))
  (let ((file-buffer (make-symbol "file-buffer"))
    (file-name (make-symbol "file-name"))
    (old-file-buffer (make-symbol "old-file-buffer")))
    `(let* ((,file-name ,filename)
        (,old-file-buffer (find-buffer-visiting ,file-name))
        (,file-buffer (or ,old-file-buffer
                                (find-file-noselect ,file-name))))
       (with-current-buffer ,file-buffer
         (unwind-protect
         (progn
           ,@body)
       (unless (or ,old-file-buffer
               (buffer-modified-p))
         (kill-buffer)))))))

(defun multivalued-alist-insert (alist key val &optional dup key-plist val-keylist)
  "Extend the multivalued alist by the mapping from KEY to VAL.
Allow duplicated values for one KEY if DUP is non-nil.
KEY-PLIST is a keyword-value plist passed to `cl-assert' for testing KEY.
VAL-PLIST is a keyword-vlaue plist passed to `cl-member' for testing membership of VAL."
  (let ((slot (apply #'cl-assoc key alist key-plist)))
    (if slot
        (when (or dup
                  (null (apply #'cl-member val (cdr slot) val-keylist)))
          (setcdr slot (cons val (cdr slot))))
      (setq alist (cons (list key val) alist))))
  alist)
;; test:
;; (setq l '((1 a) (2 b c) (3 d e f)))
;; (multivalued-alist-insert l 2 'b t) ;; duplicated
;; (multivalued-alist-insert l 2 'b) ;; not duplicated
;; (multivalued-alist-insert l 4 'g) ;; new key

(defun org+-copy-id_log-clock-collect (&optional clock-map hap)
  "Return an alist mapping targets to clock entries.
The clock entries are collected from headers with appropriate ID_LOG properties.
The new clocks are inserted into the alist CLOCK-MAP.
If HAP is non-nil only search current top level header for ID_LOG entries."
  (save-excursion
    (save-restriction
      (when hap
        (org-up-heading-safe)
        (let* ((el (org-element-at-point))
               (b (progn
                    (cl-assert (eq (org-element-type el) 'headline)
                               nil
                               "No headline found.")
                    (org-element-property :begin el)))
               (e (org-element-property :end el)))
          (narrow-to-region b e)))
      (let ((tree (org-element-parse-buffer)))
        (org-element-map
            tree
            'clock
          (lambda (clock)
            (when-let ((headline (org+-element-container clock))
                       (id (org-element-property :ID_LOG headline)))
              (setq clock-map (multivalued-alist-insert
                               clock-map id clock nil
                               '(:test string-equal)
                               '(:test org+-element-clocks=-p))))))
        clock-map))))

(defun org+-add-clock-to-log-in-headline (headline clock)
  "Extend org element HEADLINE by CLOCK.
Also creates a logbook if it does not exist yet in HEADLINE.
Return non-nil if HEADLINE has changed."
  (let ((logbook (car
                  (org-element-map
                      headline
                      'drawer
                    (lambda (logbook)
                      (let ((drawer-name (org-element-property :drawer-name logbook)))
                        (when (and (stringp drawer-name)
                                   (string-equal drawer-name "LOGBOOK"))
                          logbook)))
                    nil nil 'no-recursion))))
    (if logbook ;; logbook already existing -- just add CLOCK to it.
        (when (or org+-copy-id_log-clock-allow-duplicates
                  (null (org-element-map logbook
                            'clock
                          (lambda (log-clock)
                            (when (org+-element-clocks=-p log-clock clock)
                              log-clock)))))
          (org+-element-add-contents logbook (org-element-copy clock))
          t)
      ;; logbook missing -- create one with CLOCK as entry
      (let ((section (org-element-map headline 'section #'identity nil t t)))
        (unless section
          (setq section (org-element-create 'section))
          (org+-element-add-contents headline section))
        (setq logbook (org-element-create 'drawer (list :parent clock
                                                        :drawer-name "LOGBOOK")))
        (org+-element-add-contents logbook clock)
        (org+-element-add-contents section logbook nil
                                   (lambda (el)
                                     (eq (org-element-type el) 'property-drawer))))
      t)))

(defun org+-copy-id_log-clock (&optional clock-map)
  "Copy all clock entries from ID_LOG headlines to ID headlines.
See option `org+-copy-id_log-clock-allow-duplicates'.
Return non-nil if the buffer has been rewritten."
  (interactive)
  (unless clock-map (setq clock-map (org+-copy-id_log-clock-collect)))
  (let ((tree (org-element-parse-buffer))
        rewrite)
    ;; modify tree and print it out
    (org-element-map
        tree
        'headline
      (lambda (headline)
        (when-let ((id (org-element-property :ID headline))
                   (clocks (cdr (assoc-string id clock-map))))
          (cl-loop for clock in clocks do
                   (setq rewrite (or
                                  (org+-add-clock-to-log-in-headline headline clock)
                                  rewrite))
                   ))))
    (when rewrite
      (delete-region (point-min) (point-max))
      (insert (org-element-interpret-data tree))
      t)))

(defun org+-agenda-copy-id_log-clock (&optional hap)
  "Copy all clock entries from ID_LOG headlines to ID headlines in agenda files.
If HAP is non-nil only search the header at point for ID_LOG.
Interactively HAP is the prefix argument."
  (interactive "P")
  (let ((agenda-files (org-agenda-files t))
        clock-map)
    (if hap
        (setq clock-map (org+-copy-id_log-clock-collect clock-map t))
      (dolist (file agenda-files)
        (with-current-file file
          (setq clock-map (org+-copy-id_log-clock-collect clock-map)))))
    (dolist (file agenda-files)
      (with-current-file file
          (org+-copy-id_log-clock clock-map)))))
  • The script works beautifully. I just incorrectly pasted it. Last request (if it's easy): is there a way to move only the ID_LOG at point to its proper ID? By this I mean if the point is contained in a header with ID_LOG, then it only moves that ID_LOG to its proper ID (where the ID might be in another agenda file). Is there an easy way to scaffold such a function? – George Jul 10 '18 at 15:36
  • @George Its implemented in the edit saved at 2018-07-10 18:30. Call org+-agenda-copy-id_log-clock with prefix arg, i.e., C-u M-x org+-agenda-copy-id_log-clock <RET> with point within the headline. It searches the current header for ID_LOG and puts the clocks at the corresponding ID headers. Please delete all irrelevant comments (for an instance comments with DONE state).Thanks. – Tobias Jul 10 '18 at 16:32
  • I get the error "No links" when calling C-u M-x org+-agenda-copy-id_log-clock <RET>. When I execute (org+-agenda-copy-id_log-clock t) within a header, it works, but populates all ID_LOG matches as if I had called (org+-agenda-copy-id_log-clock). – George Jul 11 '18 at 17:58
  • @George I sucessfully tested it. So to reproduce the error we need your specific test conditions. We shouldn't discuss that here. I've opened an issue on github for the problem. Can we continue there? – Tobias Jul 11 '18 at 23:19
  • I'm not sure what is going on with my org-mode setup, but you're right: your function works as promised. I also discovered it doesn't allow duplicate time entries out of the box? That's great. Amazing answer with incredible detail. Thanks. – George Jul 12 '18 at 16:15

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.