diff options
author | Bastien Guerry <bzg@altern.org> | 2011-07-09 17:38:21 +0200 |
---|---|---|
committer | Bastien Guerry <bzg@altern.org> | 2011-07-09 17:38:21 +0200 |
commit | db731a971546aef8a1003df8f73462fc6dfd6a5a (patch) | |
tree | b586a5e7c551a2be881721b0e33a60e9483e3569 | |
parent | a4bbc54d159ec3bbb258fb7359892b48091ff7e5 (diff) | |
download | org-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.el | 54 | ||||
-rw-r--r-- | lisp/org.el | 18 |
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) |