Browse Source

Merge commit 'johnw/master'

Conflicts:
	lisp/ChangeLog
	lisp/org-clock.el
Carsten Dominik 15 years ago
parent
commit
dd01f724a6
3 changed files with 190 additions and 2 deletions
  1. 17 0
      lisp/ChangeLog
  2. 170 1
      lisp/org-clock.el
  3. 3 1
      lisp/org.el

+ 17 - 0
lisp/ChangeLog

@@ -1,3 +1,4 @@
+
 2009-10-17  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-agenda.el (org-agenda-sorting-strategy): Fix customization
@@ -8,6 +9,22 @@
 
 2009-10-17  John Wiegley  <johnw@newartisans.com>
 
+	* org-clock.el (org-clock-resolve-clock): New function that
+	resolves a clock to a specific time, closing or resuming as need
+	be, and possibly even starting a new clock.
+	(org-clock-resolve): New function used by `org-resolve-clocks'
+	that sets up for the call to `org-clock-resolve-clock'.  It
+	determines the time to resolve to based on a single-character
+	selection from the user to either keep time, subtract away time or
+	cancel the clock.
+	(org-resolve-clocks): New user command which resolves dangling
+	clocks -- that is, open but not active -- anywhere in the file
+	list returned by `org-files-list'.
+	(org-clock-in): Automatically resolve dangling clocks whenever a
+	user clocks in.
+	(org-clock-cancel): If the user cancels the solely clock in a
+	LOGBOOK, remove the empty drawer.
+
 	* org-clock.el (org-clock-idle-time): New user customizable option
 	for detecting whether the user has left a clock idle.  Note: it is
 	only used in this commit to test whether it's worthwhile to check

+ 170 - 1
lisp/org-clock.el

@@ -575,6 +575,170 @@ If necessary, clock-out of the currently active clock."
 	(org-clock-cancel)))
     (setcar clock temp)))
 
+(defvar org-clock-clocking-in nil)
+
+(defun org-clock-resolve-clock (clock resolve-to &optional close-p
+				      restart-p fail-quietly)
+  "Resolve `CLOCK' given the time `RESOLVE-TO', and the present.
+`CLOCK' is a cons cell of the form (MARKER START-TIME).
+This routine can do one of many things:
+
+  if `RESOLVE-TO' is nil
+    if `CLOSE-P' is non-nil, give an error
+    if this clock is the active clock, cancel it
+    else delete the clock line (as if it never happened)
+    if `RESTART-P' is non-nil, start a new clock
+
+  else if `RESOLVE-TO' is the symbol `now'
+    if `RESTART-P' is non-nil, give an error
+    if `CLOSE-P' is non-nil, clock out the entry and
+       if this clock is the active clock, stop it
+    else if this clock is the active clock, do nothing
+    else if there is no active clock, resume this clock
+    else ask to cancel the active clock, and if so,
+         resume this clock after cancelling it
+
+  else if `RESOLVE-TO' is some date in the future
+    give an error about `RESOLVE-TO' being invalid
+
+  else if `RESOLVE-TO' is some date in the past
+    if `RESTART-P' is non-nil, give an error
+    if `CLOSE-P' is non-nil, enter a closing time and
+       if this clock is the active clock, stop it
+    else if this clock is the active clock, enter a
+       closing time, stop the current clock, then
+       start a new clock for the same item
+    else just enter a closing time for this clock
+       and then start a new clock for the same item"
+  (cond
+   ((null resolve-to)
+    (org-clock-clock-cancel clock)
+    (if (and restart-p (not org-clock-clocking-in))
+	(org-clock-clock-in clock)))
+
+   ((eq resolve-to 'now)
+    (if restart-p
+	(error "RESTART-P is not valid here"))
+    (if (or close-p org-clock-clocking-in)
+	(org-clock-clock-out clock fail-quietly)
+      (unless (org-is-active-clock clock)
+	(org-clock-clock-in clock t))))
+
+   ((not (time-less-p resolve-to (current-time)))
+    (error "RESOLVE-TO must refer to a time in the past"))
+
+   (t
+    (if restart-p
+	(error "RESTART-P is not valid here"))
+    (org-clock-clock-out clock fail-quietly resolve-to)
+    (unless org-clock-clocking-in
+      (if (not close-p)
+	  (org-clock-clock-in clock))))))
+
+(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
+  "Resolve an open org-mode clock.
+An open clock was found, with `dangling' possibly being non-nil.
+If this function was invoked with a prefix argument, non-dangling
+open clocks are ignored.  The given clock requires some sort of
+user intervention to resolve it, either because a clock was left
+dangling or due to an idle timeout.  The clock resolution can
+either be:
+
+  (a) deleted, the user doesn't care about the clock
+  (b) restarted from the current time (if no other clock is open)
+  (c) closed, giving the clock X minutes
+  (d) closed and then restarted
+  (e) resumed, as if the user had never left
+
+The format of clock is (CONS MARKER START-TIME), where MARKER
+identifies the buffer and position the clock is open at (and
+thus, the heading it's under), and START-TIME is when the clock
+was started."
+  (assert clock)
+  (let* ((ch
+	  (save-window-excursion
+	    (save-excursion
+	      (org-with-clock clock
+		(org-clock-goto))
+	      (with-current-buffer (marker-buffer (car clock))
+		(goto-char (car clock))
+		(if org-clock-into-drawer
+		    (ignore-errors
+		      (outline-flag-region (save-excursion
+					     (outline-back-to-heading t)
+					     (search-forward ":LOGBOOK:")
+					     (goto-char (match-beginning 0)))
+					   (save-excursion
+					     (outline-back-to-heading t)
+					     (search-forward ":LOGBOOK:")
+					     (search-forward ":END:")
+					     (goto-char (match-end 0)))
+					   nil))))
+	      (let (char-pressed)
+		(while (null char-pressed)
+		  (setq char-pressed
+			(read-char (concat (funcall prompt-fn clock)
+					   " [(kK)eep (sS)ubtract (C)ancel]? ")
+				   nil 45)))
+		char-pressed))))
+	 (default (floor (/ (time-to-seconds
+			     (time-subtract (current-time) last-valid)) 60)))
+	 (keep (and (memq ch '(?k ?K))
+		    (read-number "Keep how many minutes? " default)))
+	 (subtractp (memq ch '(?s ?S)))
+	 (barely-started-p (< (- (time-to-seconds last-valid)
+				 (time-to-seconds (cdr clock))) 45))
+	 (start-over (and subtractp barely-started-p)))
+    (if (or (null ch)
+	    (not (memq ch '(?k ?K ?s ?S ?C))))
+	(message "")
+      (org-clock-resolve-clock
+       clock (cond
+	      ((or (eq ch ?C)
+		   ;; If the time on the clock was less than a minute before
+		   ;; the user went away, and they've ask to subtract all the
+		   ;; time...
+		   start-over)
+	       nil)
+	      (subtractp
+	       last-valid)
+	      ((= keep default)
+	       'now)
+	      (t
+	       (time-add last-valid (seconds-to-time (* 60 keep)))))
+       (memq ch '(?K ?S))
+       (and start-over
+	    (not (memq ch '(?K ?S ?C))))
+       fail-quietly))))
+
+(defvar org-clock-resolving-clocks nil)
+
+(defun org-resolve-clocks (&optional also-non-dangling-p prompt-fn last-valid)
+  "Resolve all currently open org-mode clocks.
+If `also-non-dangling-p' is non-nil, also ask to resolve
+non-dangling (i.e., currently open and valid) clocks."
+  (interactive "P")
+  (unless org-clock-resolving-clocks
+    (let ((org-clock-resolving-clocks t))
+      (dolist (file (org-files-list))
+	(let ((clocks (org-find-open-clocks file)))
+	  (dolist (clock clocks)
+	    (let ((dangling (or (not (org-clock-is-active))
+				(/= (car clock) org-clock-marker))))
+	      (unless (and (not dangling) (not also-non-dangling-p))
+		(org-clock-resolve
+		 clock
+		 (or prompt-fn
+		     (function
+		      (lambda (clock)
+			(format
+			 "Dangling clock started %d mins ago"
+			 (floor
+			  (/ (- (time-to-seconds (current-time))
+				(time-to-seconds (cdr clock))) 60))))))
+		 (or last-valid
+		     (cdr clock)))))))))))
+
 (defun org-emacs-idle-seconds ()
   "Return the current Emacs idle time in seconds, or nil if not idle."
   (let ((idle-time (current-idle-time)))
@@ -611,6 +775,9 @@ the clocking selection, associated with the letter `d'."
   (catch 'abort
     (let ((interrupting (marker-buffer org-clock-marker))
 	  ts selected-task target-pos (msg-extra ""))
+      (unless org-clock-clocking-in
+	(let ((org-clock-clocking-in t))
+	  (org-resolve-clocks)))	; check if any clocks are dangling
       (when (equal select '(4))
 	(setq selected-task (org-clock-select-task "Clock-in on task: "))
 	(if selected-task
@@ -929,7 +1096,9 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
   (save-excursion
     (set-buffer (marker-buffer org-clock-marker))
     (goto-char org-clock-marker)
-    (delete-region (1- (point-at-bol)) (point-at-eol)))
+    (delete-region (1- (point-at-bol)) (point-at-eol))
+    ;; Just in case, remove any empty LOGBOOK left over
+    (org-remove-empty-drawer-at "LOGBOOK" (point)))
   (move-marker org-clock-marker nil)
   (move-marker org-clock-hd-marker nil)
   (setq global-mode-string

+ 3 - 1
lisp/org.el

@@ -3141,6 +3141,8 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
 (declare-function org-clock-save-markers-for-cut-and-paste "org-clock"
 		  (beg end))
 (declare-function org-clock-update-mode-line "org-clock" ())
+(declare-function org-resolve-clocks "org-clock"
+		  (&optional also-non-dangling-p prompt last-valid))
 (defvar org-clock-start-time)
 (defvar org-clock-marker (make-marker)
   "Marker recording the last clock-in.")
@@ -3158,7 +3160,7 @@ The return value is actually the clock marker."
 		  org-clock-goto org-clock-sum org-clock-display
 		  org-clock-remove-overlays org-clock-report
 		  org-clocktable-shift org-dblock-write:clocktable
-		  org-get-clocktable)))
+		  org-get-clocktable org-resolve-clocks)))
 
 (defun org-clock-update-time-maybe ()
   "If this is a CLOCK line, update it and return t.