Refile clock entries and some basic settings

1 files changed, 142 insertions, 1 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el
index 9411f72..4c69484 100644
--- a/emacs/.emacs.d/lisp/my/my-org.el
+++ b/emacs/.emacs.d/lisp/my/my-org.el
@@ -449,6 +449,146 @@ END."
   (when (equal major-mode 'org-mode)
     (org-clock-save)))
 
+(defun my-org-clock-kill-entries ()
+  "Kill all clock entries at the org node at point.
+
+Assuming they are in the logbook drawer"
+  (interactive)
+  (let ((end)
+        (kill-whole-line t))
+    (save-restriction
+      (org-narrow-to-subtree)
+      (goto-char (point-min))
+      (when (re-search-forward "^\\ *:LOGBOOK:\\ *$" nil t)
+        (kill-new "")
+        (setq end (save-excursion
+                    (re-search-forward "^\\ *:END:\\ *$")
+                    (point)))
+        (while (re-search-forward "^\\ *CLOCK: .*--.*$" end t)
+          (beginning-of-line)
+          (append-next-kill)
+          (kill-line))))))
+
+(defun my-org-clock-yank ()
+  "Yank whatever is in the kill ring into the logbook drawer."
+  (interactive)
+  (let ((end))
+    (save-restriction
+      (org-narrow-to-subtree)
+      (goto-char (point-min))
+      (if (re-search-forward "^\\ *:LOGBOOK:\\ *$" nil t)
+          ;; If there's already a logbook, move to where the clock
+          ;; entries should be inserted
+          (progn
+            (setq end (save-excursion
+                        (re-search-forward "^\\ *:END:\\ *$")
+                        (beginning-of-line)
+                        (point)))
+            ;; Insert after active clock (if any)
+            (if (re-search-forward "^\\ *CLOCK: .*--.*$" end t)
+                (beginning-of-line)
+              (goto-char end)))
+        (beginning-of-line 2)
+        (org-insert-drawer nil "LOGBOOK")
+        (delete-char 1))
+      (yank))))
+
+(defun my-org-clock-refile-clocking ()
+  (interactive)
+  (my-org-clock-kill-entries)
+  (save-excursion
+    (call-interactively 'org-goto)
+    (my-org-clock-yank)))
+
+;;; to remove
+(defun my-org-clock-collect-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))))))
+
 (defun my-org-refile-cache-rebuild ()
   (org-refile-cache-clear)
   (org-refile-get-targets))
@@ -868,7 +1008,8 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
 
 (defun my-org-update-updated ()
   (interactive)
-  (when (derived-mode-p 'org-mode)
+  (when (and (derived-mode-p 'org-mode)
+             (not (org-before-first-heading-p)))
     (org-entry-put
      (point) "UPDATED"
      (format-time-string "[%Y-%m-%d %a %H:%M]" (current-time)))))