6

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:

2 Answers 2

4

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))))))
5
  • Extremely thorough answer. Well done.
    – George
    May 10, 2018 at 13:00
  • Is there a way to ensure that my cursor is back at the original headline after execution? This function has a side effect changing the cursor's position to the end of the headline.
    – George
    Jul 10, 2018 at 15:07
  • Answer my own question: wrapping this function in a (save-excursion ...) block the trick.
    – George
    Jul 11, 2018 at 0:46
  • @George (save-excursion ...) maybe does the trick. But the rewrite of the org-file may slightly change buffer positions... That is actually the reason why I not yet answered.
    – Tobias
    Jul 11, 2018 at 0:49
  • What do you mean change buffer positions?
    – George
    Jul 11, 2018 at 13:13
1

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.
)
5
  • This got me started but there are bugs in this function.
    – George
    May 10, 2018 at 13:00
  • 1
    Hi, can't find the function org-logbook-sorter anymore on github. Can you point me out where I can find a copy of the file? I need it because I've a mess between orgzly and org-mode. Jul 3, 2019 at 14:14
  • I moved the repo to gitlab. Concretely gitlab.com/marcowahl/org-logbook-sorter .
    – Marco Wahl
    Jul 4, 2019 at 13:55
  • I also updated the link in the answer. Thanks!
    – Marco Wahl
    Jul 4, 2019 at 14:10
  • Ah, thanks a lot! Jul 4, 2019 at 17:49

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.