1
0
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:
Bastien Guerry 2011-07-09 17:38:21 +02:00
parent a4bbc54d15
commit db731a9715
2 changed files with 72 additions and 0 deletions

View File

@ -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)

View File

@ -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)