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:
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))))))
| improve this answer | |
  • Extremely thorough answer. Well done. – George May 10 '18 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 '18 at 15:07
  • Answer my own question: wrapping this function in a (save-excursion ...) block the trick. – George Jul 11 '18 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 '18 at 0:49
  • What do you mean change buffer positions? – George Jul 11 '18 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.
)
| improve this answer | |
  • This got me started but there are bugs in this function. – George May 10 '18 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. – Nicola Leoni Jul 3 '19 at 14:14
  • I moved the repo to gitlab. Concretely gitlab.com/marcowahl/org-logbook-sorter . – Marco Wahl Jul 4 '19 at 13:55
  • I also updated the link in the answer. Thanks! – Marco Wahl Jul 4 '19 at 14:10
  • Ah, thanks a lot! – Nicola Leoni Jul 4 '19 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.