tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

org-clock-update-time-maybe: Fix return value 

* lisp/org-clock.el: Ensure that we return expected value.
* testing/lisp/test-org-clock.el
(test-org-clok/org-clock-update-time-maybe): Add new test.
This commit is contained in:
Ihor Radchenko 2023-05-01 12:11:26 +02:00
parent 2993f482c1
commit 08077812ef
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 66 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
lisp/org-clock.el
View File

@ -3062,57 +3062,58 @@ PROPERTIES: The list properties specified in the `:properties' parameter
Otherwise, return nil." Otherwise, return nil."
(interactive) (interactive)
(let ((origin (point))) ;; `save-excursion' may not work when deleting. (let ((origin (point))) ;; `save-excursion' may not work when deleting.
(save-excursion (prog1
(beginning-of-line 1) (save-excursion
(skip-chars-forward " \t") (beginning-of-line 1)
(when (looking-at org-clock-string) (skip-chars-forward " \t")
(let ((re (concat "[ \t]*" org-clock-string (when (looking-at org-clock-string)
" *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]" (let ((re (concat "[ \t]*" org-clock-string
"\\([ \t]*=>.*\\)?\\)?")) " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
ts te h m s neg) "\\([ \t]*=>.*\\)?\\)?"))
(cond ts te h m s neg)
((not (looking-at re)) (cond
nil) ((not (looking-at re))
((not (match-end 2)) nil)
(when (and (equal (marker-buffer org-clock-marker) (current-buffer)) ((not (match-end 2))
(> org-clock-marker (point)) (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
(<= org-clock-marker (line-end-position))) (> org-clock-marker (point))
;; The clock is running here (<= org-clock-marker (line-end-position)))
(setq org-clock-start-time ;; The clock is running here
(org-time-string-to-time (match-string 1))) (setq org-clock-start-time
(org-clock-update-mode-line))) (org-time-string-to-time (match-string 1)))
(t (org-clock-update-mode-line)))
;; Prevent recursive call from `org-timestamp-change'. (t
(cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore)) ;; Prevent recursive call from `org-timestamp-change'.
;; Update timestamps. (cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
(save-excursion ;; Update timestamps.
(goto-char (match-beginning 1)) ; opening timestamp (save-excursion
(save-match-data (org-timestamp-change 0 'day))) (goto-char (match-beginning 1)) ; opening timestamp
;; Refresh match data. (save-match-data (org-timestamp-change 0 'day)))
(looking-at re) ;; Refresh match data.
(save-excursion (looking-at re)
(goto-char (match-beginning 3)) ; closing timestamp (save-excursion
(save-match-data (org-timestamp-change 0 'day)))) (goto-char (match-beginning 3)) ; closing timestamp
;; Refresh match data. (save-match-data (org-timestamp-change 0 'day))))
(looking-at re) ;; Refresh match data.
(and (match-end 4) (delete-region (match-beginning 4) (match-end 4))) (looking-at re)
(end-of-line 1) (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
(setq ts (match-string 1) (end-of-line 1)
te (match-string 3)) (setq ts (match-string 1)
(setq s (- (org-time-string-to-seconds te) te (match-string 3))
(org-time-string-to-seconds ts)) (setq s (- (org-time-string-to-seconds te)
neg (< s 0) (org-time-string-to-seconds ts))
s (abs s) neg (< s 0)
h (floor (/ s 3600)) s (abs s)
s (- s (* 3600 h)) h (floor (/ s 3600))
m (floor (/ s 60)) s (- s (* 3600 h))
s (- s (* 60 s))) m (floor (/ s 60))
(insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m)) s (- s (* 60 s)))
t))))) (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
;; Move back to initial position, but never beyond updated t)))))
;; clock. ;; Move back to initial position, but never beyond updated
(unless (< (point) origin) ;; clock.
(goto-char origin)))) (unless (< (point) origin)
(goto-char origin)))))
(defun org-clock-save () (defun org-clock-save ()
"Persist various clock-related data to disk. "Persist various clock-related data to disk.

14
testing/lisp/test-org-clock.el
View File

@ -113,6 +113,20 @@ the buffer."
(org-clock-timestamps-change 'up 1) (org-clock-timestamps-change 'up 1)
(buffer-string))))) (buffer-string)))))
(ert-deftest test-org-clok/org-clock-update-time-maybe ()
"Test `org-clock-update-time-maybe' specifications."
(should
(equal
"CLOCK: [2023-04-29 Sat 00:00]--[2023-05-04 Thu 01:00] => 121:00"
(org-test-with-temp-text
"CLOCK: [2023-04-29 Sat 00:00]--[2023-05-04 Thu 01:00]"
(should (org-clock-update-time-maybe))
(buffer-string))))
(should-not
(org-test-with-temp-text
"[2023-04-29 Sat 00:00]--[2023-05-04 Thu 01:00]"
(org-clock-update-time-maybe))))
;;; Clock drawer ;;; Clock drawer