Browse Source

S-M-<up/down> now adjusts previous/next clock when hit on clock timestamps.

* org.el (org-clock-history, org-clock-adjust-closest): New
variables.
(org-timestamp-change): Maybe adjust the next or previous
clock in `org-clock-history'.
(org-shiftmetaup, org-shiftmetadown): On clock logs, update
the timestamp at point and adjust the next or previous clock
in `org-clock-history', when possible.

* org.texi (Clocking commands): Document the use of
S-M-<up/down> on clock timestamps.

Thanks to Joseph Thomas who suggested this.
Bastien Guerry 12 years ago
parent
commit
b86a6f6f34
2 changed files with 49 additions and 7 deletions
  1. 8 2
      doc/org.texi
  2. 41 5
      lisp/org.el

+ 8 - 2
doc/org.texi

@@ -6080,8 +6080,14 @@ Recompute the time interval after changing one of the timestamps.  This
 is only necessary if you edit the timestamps directly.  If you change
 is only necessary if you edit the timestamps directly.  If you change
 them with @kbd{S-@key{cursor}} keys, the update is automatic.
 them with @kbd{S-@key{cursor}} keys, the update is automatic.
 @orgcmd{C-S-@key{up/down},org-clock-timestamps-up/down}
 @orgcmd{C-S-@key{up/down},org-clock-timestamps-up/down}
-On @code{CLOCK} log lines, increase/decrease both timestamps at the same
-time so that duration keeps the same.
+On @code{CLOCK} log lines, increase/decrease both timestamps so that the
+clock duration keeps the same. 
+@orgcmd{S-M-@key{up/down},org-timestamp-up/down}
+On @code{CLOCK} log lines, increase/decrease the timestamp at point and
+the one of the previous (or the next clock) timestamp by the same duration.
+For example, if you hit @kbd{S-M-@key{up}} to increase a clocked-out timestamp
+by five minutes, then the clocked-in timestamp of the next clock will be
+increased by five minutes.
 @orgcmd{C-c C-t,org-todo}
 @orgcmd{C-c C-t,org-todo}
 Changing the TODO state of an item to DONE automatically stops the clock
 Changing the TODO state of an item to DONE automatically stops the clock
 if it is running in this same item.
 if it is running in this same item.

+ 41 - 5
lisp/org.el

@@ -16212,6 +16212,8 @@ With prefix ARG, change that many days."
       (message "Timestamp is now %sactive"
       (message "Timestamp is now %sactive"
 	       (if (equal (char-after beg) ?<) "" "in")))))
 	       (if (equal (char-after beg) ?<) "" "in")))))
 
 
+(defvar org-clock-history)                     ; defined in org-clock.el
+(defvar org-clock-adjust-closest nil)          ; defined in org-clock.el
 (defun org-timestamp-change (n &optional what updown)
 (defun org-timestamp-change (n &optional what updown)
   "Change the date in the time stamp at point.
   "Change the date in the time stamp at point.
 The date will be changed by N times WHAT.  WHAT can be `day', `month',
 The date will be changed by N times WHAT.  WHAT can be `day', `month',
@@ -16222,7 +16224,7 @@ in the timestamp determines what will be changed."
 	(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
 	(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
 	org-ts-what
 	org-ts-what
 	extra rem
 	extra rem
-	ts time time0)
+	ts time time0 fixnext clrgx)
     (if (not (org-at-timestamp-p t))
     (if (not (org-at-timestamp-p t))
 	(error "Not at a timestamp"))
 	(error "Not at a timestamp"))
     (if (and (not what) (eq org-ts-what 'bracket))
     (if (and (not what) (eq org-ts-what 'bracket))
@@ -16304,6 +16306,36 @@ in the timestamp determines what will be changed."
 		    (t origin))))
 		    (t origin))))
       ;; Update clock if on a CLOCK line.
       ;; Update clock if on a CLOCK line.
       (org-clock-update-time-maybe)
       (org-clock-update-time-maybe)
+      ;; Maybe adjust the closest clock in `org-clock-history'
+      (if (not (and org-clock-adjust-closest
+		    (org-at-clock-log-p)
+		    (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m))
+						   org-clock-history))))))
+	  (message "No clock to adjust")
+	(cond ((save-excursion ; fix previous clock?
+		 (re-search-backward org-ts-regexp0 nil t)
+		 (looking-back (concat org-clock-string " \\[")))
+	       (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
+	      ((save-excursion ; fix next clock?
+		 (re-search-backward org-ts-regexp0 nil t)
+		 (looking-at (concat org-ts-regexp0 "\\] =>")))
+	       (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
+	(save-excursion
+	  ;; Find closest clock to point, adjust the previous/next one
+	  (org-back-to-heading t)
+	  (let* ((cl (mapcar (lambda(c) (abs (- (marker-position c) (point))))
+			     org-clock-history))
+		 (clfixnth (+ fixnext (position (apply #'min cl) cl)))
+		 (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history))))
+	    (if (not clfixpos)
+		(message "No clock to adjust")
+	      (goto-char clfixpos)
+	      (org-show-subtree)
+	      (when (re-search-forward clrgx nil t)
+		(goto-char (match-beginning 1))
+		(let (org-clock-adjust-closest)
+		  (org-timestamp-change n org-ts-what updown))
+		(message "Clock adjusted for heading: %s" (org-get-heading t t)))))))
       ;; Try to recenter the calendar window, if any.
       ;; Try to recenter the calendar window, if any.
       (if (and org-calendar-follow-timestamp-change
       (if (and org-calendar-follow-timestamp-change
 	       (get-buffer-window "*Calendar*" t)
 	       (get-buffer-window "*Calendar*" t)
@@ -18344,27 +18376,31 @@ individual commands for more information."
 (defun org-shiftmetaup (&optional arg)
 (defun org-shiftmetaup (&optional arg)
   "Move subtree up or kill table row.
   "Move subtree up or kill table row.
 Calls `org-move-subtree-up' or `org-table-kill-row' or
 Calls `org-move-subtree-up' or `org-table-kill-row' or
-`org-move-item-up' depending on context.  See the individual commands
-for more information."
+`org-move-item-up' or `org-timestamp-up', depending on context.
+See the individual commands for more information."
   (interactive "P")
   (interactive "P")
   (cond
   (cond
    ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
    ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
    ((org-at-table-p) (call-interactively 'org-table-kill-row))
    ((org-at-table-p) (call-interactively 'org-table-kill-row))
    ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
    ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
    ((org-at-item-p) (call-interactively 'org-move-item-up))
    ((org-at-item-p) (call-interactively 'org-move-item-up))
+   ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
+			   (call-interactively 'org-timestamp-up)))
    (t (org-modifier-cursor-error))))
    (t (org-modifier-cursor-error))))
 
 
 (defun org-shiftmetadown (&optional arg)
 (defun org-shiftmetadown (&optional arg)
   "Move subtree down or insert table row.
   "Move subtree down or insert table row.
 Calls `org-move-subtree-down' or `org-table-insert-row' or
 Calls `org-move-subtree-down' or `org-table-insert-row' or
-`org-move-item-down', depending on context.  See the individual
-commands for more information."
+`org-move-item-down' or `org-timestamp-up', depending on context.
+See the individual commands for more information."
   (interactive "P")
   (interactive "P")
   (cond
   (cond
    ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
    ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
    ((org-at-table-p) (call-interactively 'org-table-insert-row))
    ((org-at-table-p) (call-interactively 'org-table-insert-row))
    ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
    ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
    ((org-at-item-p) (call-interactively 'org-move-item-down))
    ((org-at-item-p) (call-interactively 'org-move-item-down))
+   ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
+			   (call-interactively 'org-timestamp-down)))
    (t (org-modifier-cursor-error))))
    (t (org-modifier-cursor-error))))
 
 
 (defsubst org-hidden-tree-error ()
 (defsubst org-hidden-tree-error ()