mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code 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."
(interactive)
(let ((origin (point))) ;; `save-excursion' may not work when deleting.
(save-excursion
(beginning-of-line 1)
(skip-chars-forward " \t")
(when (looking-at org-clock-string)
(let ((re (concat "[ \t]*" org-clock-string
" *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
"\\([ \t]*=>.*\\)?\\)?"))
ts te h m s neg)
(cond
((not (looking-at re))
nil)
((not (match-end 2))
(when (and (equal (marker-buffer org-clock-marker) (current-buffer))
(> org-clock-marker (point))
(<= org-clock-marker (line-end-position)))
;; The clock is running here
(setq org-clock-start-time
(org-time-string-to-time (match-string 1)))
(org-clock-update-mode-line)))
(t
;; Prevent recursive call from `org-timestamp-change'.
(cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
;; Update timestamps.
(save-excursion
(goto-char (match-beginning 1)) ; opening timestamp
(save-match-data (org-timestamp-change 0 'day)))
;; Refresh match data.
(looking-at re)
(save-excursion
(goto-char (match-beginning 3)) ; closing timestamp
(save-match-data (org-timestamp-change 0 'day))))
;; Refresh match data.
(looking-at re)
(and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (org-time-string-to-seconds te)
(org-time-string-to-seconds ts))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
t)))))
;; Move back to initial position, but never beyond updated
;; clock.
(unless (< (point) origin)
(goto-char origin))))
(prog1
(save-excursion
(beginning-of-line 1)
(skip-chars-forward " \t")
(when (looking-at org-clock-string)
(let ((re (concat "[ \t]*" org-clock-string
" *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
"\\([ \t]*=>.*\\)?\\)?"))
ts te h m s neg)
(cond
((not (looking-at re))
nil)
((not (match-end 2))
(when (and (equal (marker-buffer org-clock-marker) (current-buffer))
(> org-clock-marker (point))
(<= org-clock-marker (line-end-position)))
;; The clock is running here
(setq org-clock-start-time
(org-time-string-to-time (match-string 1)))
(org-clock-update-mode-line)))
(t
;; Prevent recursive call from `org-timestamp-change'.
(cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
;; Update timestamps.
(save-excursion
(goto-char (match-beginning 1)) ; opening timestamp
(save-match-data (org-timestamp-change 0 'day)))
;; Refresh match data.
(looking-at re)
(save-excursion
(goto-char (match-beginning 3)) ; closing timestamp
(save-match-data (org-timestamp-change 0 'day))))
;; Refresh match data.
(looking-at re)
(and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (org-time-string-to-seconds te)
(org-time-string-to-seconds ts))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
t)))))
;; Move back to initial position, but never beyond updated
;; clock.
(unless (< (point) origin)
(goto-char origin)))))
(defun org-clock-save ()
"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)
(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