mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2025-01-07 15:22:06 +00:00
Allow synchronous update of timestamps in CLOCK log.
* org.el (org-shiftcontrolup, org-shiftcontroldown): New commands to use `org-clock-timestamps-change'. * org-clock.el (org-clock-timestamps-change) (org-clock-timestamps-down, org-clock-timestamps-up) (org-at-clock-log-p): New functions to let the user update clock log timestamps while keeping the same clock duration. Thanks to Rainer Stengele for this idea.
This commit is contained in:
parent
a4bbc54d15
commit
db731a9715
@ -1405,6 +1405,60 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
|
||||
(org-remove-empty-drawer-at clock-drawer (point))
|
||||
(forward-line 1))))))
|
||||
|
||||
(defun org-at-clock-log-p nil
|
||||
"Is the cursor on the clock log line?"
|
||||
(save-excursion
|
||||
(move-beginning-of-line 1)
|
||||
(looking-at "^[ \t]*CLOCK:")))
|
||||
|
||||
(defun org-clock-timestamps-up nil
|
||||
"Increase CLOCK timestamps at cursor."
|
||||
(interactive)
|
||||
(org-clock-timestamps-change 'up))
|
||||
|
||||
(defun org-clock-timestamps-down nil
|
||||
"Increase CLOCK timestamps at cursor."
|
||||
(interactive)
|
||||
(org-clock-timestamps-change 'down))
|
||||
|
||||
(defun org-clock-timestamps-change (updown)
|
||||
"Change CLOCK timestamps synchronuously at cursor.
|
||||
UPDOWN tells whether to change 'up or 'down."
|
||||
(setq org-ts-what nil)
|
||||
(when (org-at-timestamp-p t)
|
||||
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
|
||||
'org-timestamp-down))
|
||||
ts1 begts1 ts2 begts2 updatets1 tdiff)
|
||||
(save-excursion
|
||||
(move-beginning-of-line 1)
|
||||
(re-search-forward org-ts-regexp3 nil t)
|
||||
(setq ts1 (match-string 0) begts1 (match-beginning 0))
|
||||
(when (re-search-forward org-ts-regexp3 nil t)
|
||||
(setq ts2 (match-string 0) begts2 (match-beginning 0))))
|
||||
; Are we on the second timestamp?
|
||||
(if (<= begts2 (point)) (setq updatets1 t))
|
||||
(if (not ts2)
|
||||
;; fall back on org-timestamp-up if there is only one
|
||||
(funcall tschange)
|
||||
;; setq this so that (boundp 'org-ts-what is non-nil)
|
||||
(funcall tschange)
|
||||
(let ((ts (if updatets1 ts2 ts1))
|
||||
(begts (if updatets1 begts1 begts2)))
|
||||
(setq tdiff
|
||||
(subtract-time
|
||||
(org-time-string-to-time org-last-changed-timestamp)
|
||||
(org-time-string-to-time ts)))
|
||||
(save-excursion
|
||||
(goto-char begts)
|
||||
(org-timestamp-change
|
||||
(round (/ (org-float-time tdiff)
|
||||
(cond ((eq org-ts-what 'minute) 60)
|
||||
((eq org-ts-what 'hour) 3600)
|
||||
((eq org-ts-what 'day) (* 24 3600))
|
||||
((eq org-ts-what 'month) (* 24 3600 31))
|
||||
((eq org-ts-what 'year) (* 24 3600 365.2)))))
|
||||
org-ts-what 'updown)))))))
|
||||
|
||||
(defun org-clock-cancel ()
|
||||
"Cancel the running clock by removing the start timestamp."
|
||||
(interactive)
|
||||
|
18
lisp/org.el
18
lisp/org.el
@ -16656,6 +16656,8 @@ BEG and END default to the buffer boundaries."
|
||||
|
||||
(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
|
||||
(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
|
||||
(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup)
|
||||
(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown)
|
||||
|
||||
;; Babel keys
|
||||
(define-key org-mode-map org-babel-key-prefix org-babel-map)
|
||||
@ -17541,6 +17543,22 @@ Depending on context, this does one of the following:
|
||||
(org-call-for-shift-select 'backward-word))
|
||||
(t (org-shiftselect-error))))
|
||||
|
||||
(defun org-shiftcontrolup ()
|
||||
"Change timestamps synchronuously up in CLOCK log lines."
|
||||
(interactive)
|
||||
(cond ((and (not org-support-shift-select)
|
||||
(org-at-clock-log-p))
|
||||
(org-clock-timestamps-up))
|
||||
(t (org-shiftselect-error))))
|
||||
|
||||
(defun org-shiftcontroldown ()
|
||||
"Change timestamps synchronuously down in CLOCK log lines."
|
||||
(interactive)
|
||||
(cond ((and (not org-support-shift-select)
|
||||
(org-at-clock-log-p))
|
||||
(org-clock-timestamps-down))
|
||||
(t (org-shiftselect-error))))
|
||||
|
||||
(defun org-ctrl-c-ret ()
|
||||
"Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
|
||||
(interactive)
|
||||
|
Loading…
Reference in New Issue
Block a user