Merging clock logs together in org-mode

Question

Let's say we have

* Task
:LOGBOOK:
CLOCK: [2018-05-08 Tue 00:00]--[2018-05-08 Tue 1:00] =>  1:00
:END:
** Subtask
:LOGBOOK:
CLOCK: [2018-05-08 Tue 01:00]--[2018-05-08 Tue 2:00] =>  1:00
:END:

Is there a way to create a function which takes all of the sub-clocks of Task and merges them at the parent level? I.E.:

* Task
:LOGBOOK:
CLOCK: [2018-05-08 Tue 00:00]--[2018-05-08 Tue 1:00] =>  1:00
CLOCK: [2018-05-08 Tue 01:00]--[2018-05-08 Tue 2:00] =>  1:00
:END:
** Subtask
:LOGBOOK:
:END:

Answer 1

Marco Wahl already posted a solution that bases more or less on regexp-search.

I give here an alternative solution that bases on parsing and re-interpreting the sub-tree.

• It uses org-element-parse-buffer to get an abstract syntax tree of the sub-tree in form of a list,
• moves the clock entries in that tree, and
• prints out the modified tree with org-element-interpret-data.

Usage:

• Put point on the headline of the subtree where you want to merge the logbooks into the current level.
• If you want to keep the empty LOGBOOK drawers in the deeper levels press M-x org-merge-subtree-clocks RET. That is the default because it reproduces your example.
• If you want to remove empty logbook drawers in the deeper levels press C-u M-x org-merge-subtree-clocks RET.

(defun org-collect-clock-entries (drawer &optional remove)
  "Collect all clock entries from DRAWER.
Remove them from DRAWER if REMOVE is non-nil."
  (cl-assert (eq (org-element-type drawer) 'drawer)
             nil
             "Expected a drawer got %s" (org-element-type drawer))
  (when (string-equal (org-element-property :drawer-name drawer)
                      (or (org-log-into-drawer) "LOGBOOK"))
    (let ((ret
           (cl-loop
            for element in-ref (org-element-contents drawer)
            if (eq (org-element-type element) 'clock)
            collect element
            and if remove do (setf element nil))))
      (org-element-set-contents
       (cl-remove nil (org-element-contents drawer)))
      ret)))

(defun org-element-remove (el)
  "Delete org element EL from its parent."
  (let ((parent (org-element-property :parent el)))
    (org-element-set-contents
     parent
     (cl-remove el (org-element-contents parent)))))

(defun org-element-clock-start<= (c1 c2)
  "Compare two clock elements as returned by `org-element-clock-parser'
and return non-nil if the C1 starts not later than c2."
  (setq c1 (org-element-property :value c1)
    c2 (org-element-property :value c2))
  (cl-loop with val1 with val2
       for test in '(:year-start :month-start :day-start :hour-start :minute-start)
       do (setq val1 (org-element-property test c1) val2 (org-element-property test c2))
       if (< val1 val2)
       return t
       if (> val1 val2)
       return nil
       finally return t))

(defun org-merge-subtree-clocks (&optional remove)
  "Merge clocks in subtree of headline starting at POINT.
Remove empty logbooks in the sub-tree if REMOVE is non-nil.

Interactively remove empty logbooks when called with prefix-arg \\[universal-argument]."
  (interactive "P")
  (let* (b e
           (headline (org-element-at-point))
           (type (car headline))
           (props (cadr headline)))
    (cl-assert (eq type 'headline)
               nil
               "Expected headline got %s" type)
    (setq b (plist-get props :begin)
          e (plist-get props :end))
    (save-restriction
      (narrow-to-region b e)
      (let* ((data (org-element-parse-buffer))
             (clocks (apply #'append
                            (org-element-map data 'drawer
                              (lambda (el)
                                "Remove all clocks from all drawers and collect them in CLOCKS."
                                (prog1 (org-collect-clock-entries el t)
                                  (when (and remove
                         (null (org-element-contents el)))
                                    (org-element-remove el)
                                    )))))))
    (setq clocks (sort clocks #'org-element-clock-start<=))
        (setq headline (org-element-map data 'headline 'identity nil t)) ;; get the first headline within data
        (or (org-element-map
                (org-element-contents headline)
                'drawer ;; check for existing drawer
              (lambda (el)
                "Write all clocks to the first LOGBOOK drawer."
                (when (equal (org-element-property :drawer-name el)
                             (or (org-log-into-drawer) "LOGBOOK"))
                  (org-element-set-contents el clocks)
                  t) ;; indicate that we are done
                )
              nil t 'headline) ;; check only first drawer of current headline
            ;; no drawer yet: add a new one
            (org-element-set-contents
             headline
             (cons (list 'drawer '(:drawer-name "LOGBOOK")
                         clocks)
                   (org-element-contents headline))))
        (kill-region (point-min) (point-max))
        (insert (org-element-interpret-data data))))))

Answer 2

Yes. You could use something like this:

(defun mw-org-merge-logbook-drawer-entries-up ()
  "Remove logbook entries of current subtree and merge into parent.
This function is a start.  It's almost untested."
  (interactive)
  (let* ((beg (org-log-beginning))
         (end (save-excursion
                (goto-char beg)
                (save-match-data
                  (re-search-forward ":end:")
                  (beginning-of-line)
                  (point))))
         (log-content (buffer-substring beg end)))
    (delete-region beg end)
    (org-remove-empty-drawer-at beg)
    (outline-up-heading 1)
    (goto-char (org-log-beginning 'create))
    (insert log-content))
  (org-sort-logbook)
  ;; For the function behind the line above see
  ;;
  ;; https://gitlab.com/marcowahl/org-logbook-sorter
  ;;
  ;; Leave out the line if you don't care about sorting the logbook entries.
)