summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2011-07-09 17:38:21 +0200
committerBastien Guerry <bzg@altern.org>2011-07-09 17:38:21 +0200
commitdb731a971546aef8a1003df8f73462fc6dfd6a5a (patch)
treeb586a5e7c551a2be881721b0e33a60e9483e3569
parenta4bbc54d159ec3bbb258fb7359892b48091ff7e5 (diff)
downloadorg-mode-db731a971546aef8a1003df8f73462fc6dfd6a5a.tar.gz
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.
-rw-r--r--lisp/org-clock.el54
-rw-r--r--lisp/org.el18
2 files changed, 72 insertions, 0 deletions
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index f1eb673..27975d3 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -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)
diff --git a/lisp/org.el b/lisp/org.el
index 06aa9a4..789685a 100644
--- a/lisp/org.el
+++ b/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)