From f77444c030038100908e298666f8f84f85e768cb Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sun, 25 Jun 2023 17:06:47 +1000 Subject: Refile clock entries and some basic settings --- emacs/.emacs.d/lisp/my/my-org.el | 143 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 142 insertions(+), 1 deletion(-) (limited to 'emacs/.emacs.d/lisp/my/my-org.el') 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))))) -- cgit v1.2.3