Browse Source

org-clock.el: Various improvements

* org-clock.el (org-clock-display-default-range): New option.
(org-clock-display): Use the new option.
(org-clock-sum-custom): New parameters `range' and `propname'.
(org-clock-special-range): Allow to enter a special range
through the calendar.
Bastien Guerry 11 years ago
parent
commit
63160e9aab
1 changed files with 51 additions and 24 deletions
  1. 51 24
      lisp/org-clock.el

+ 51 - 24
lisp/org-clock.el

@@ -414,6 +414,25 @@ if you are using Debian."
   :package-version '(Org . "8.0")
   :package-version '(Org . "8.0")
   :type 'string)
   :type 'string)
 
 
+(defcustom org-clock-goto-before-context 2
+  "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+  :group 'org-clock
+  :type 'integer)
+
+(defcustom org-clock-display-default-range 'thisyear
+  "Default range when displaying clocks with `org-clock-display'."
+  :group 'org-clock
+  :type '(choice (const today)
+		 (const yesterday)
+		 (const thisweek)
+		 (const lastweek)
+		 (const thismonth)
+		 (const lastmonth)
+		 (const thisyear)
+		 (const lastyear)
+		 (const :tag "Select range interactively" interactive)))
+
 (defvar org-clock-in-prepare-hook nil
 (defvar org-clock-in-prepare-hook nil
   "Hook run when preparing the clock.
   "Hook run when preparing the clock.
 This hook is run before anything happens to the task that
 This hook is run before anything happens to the task that
@@ -1673,12 +1692,6 @@ Optional argument N tells to change by that many units."
   (message "Clock canceled")
   (message "Clock canceled")
   (run-hooks 'org-clock-cancel-hook))
   (run-hooks 'org-clock-cancel-hook))
 
 
-(defcustom org-clock-goto-before-context 2
-  "Number of lines of context to display before currently clocked-in entry.
-This applies when using `org-clock-goto'."
-  :group 'org-clock
-  :type 'integer)
-
 ;;;###autoload
 ;;;###autoload
 (defun org-clock-goto (&optional select)
 (defun org-clock-goto (&optional select)
   "Go to the currently clocked-in entry, or to the most recently clocked one.
   "Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1718,17 +1731,18 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
     (org-clock-sum (car range) (cadr range)
     (org-clock-sum (car range) (cadr range)
 		   headline-filter :org-clock-minutes-today)))
 		   headline-filter :org-clock-minutes-today)))
 
 
-(defun org-clock-sum-custom (&optional headline-filter)
+(defun org-clock-sum-custom (&optional headline-filter range propname)
   "Sum the times for each subtree for today."
   "Sum the times for each subtree for today."
-  (let ((range
-	 (org-clock-special-range
-	  (intern (completing-read
-		   "Range: "
-		   '("today" "yesterday" "thisweek" "lastweek"
-		     "thismonth" "lastmonth" "thisyear" "lastyear")
-		   nil t)))))
-    (org-clock-sum (car range) (cadr range)
-		   headline-filter :org-clock-minutes-custom)))
+  (let ((r (or (and (symbolp range) (org-clock-special-range range))
+	       (org-clock-special-range
+		(intern (completing-read
+			 "Range: "
+			 '("today" "yesterday" "thisweek" "lastweek"
+			   "thismonth" "lastmonth" "thisyear" "lastyear"
+			   "interactive")
+			 nil t))))))
+    (org-clock-sum (car r) (cadr r)
+		   headline-filter (or propname :org-clock-minutes-custom))))
 
 
 ;;;###autoload
 ;;;###autoload
 (defun org-clock-sum (&optional tstart tend headline-filter propname)
 (defun org-clock-sum (&optional tstart tend headline-filter propname)
@@ -1842,13 +1856,19 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
   (interactive "P")
   (interactive "P")
   (org-clock-remove-overlays)
   (org-clock-remove-overlays)
   (let* ((todayp (equal arg '(4)))
   (let* ((todayp (equal arg '(4)))
-	 (customp (equal arg '(16)))
-	 (prop (cond (todayp :org-clock-minutes-today)
+	 (customp (member arg '((16) today yesterday
+			       thisweek lastweek thismonth
+			       lastmonth thisyear lastyear
+			       interactive)))
+	 (prop (cond ((not arg) :org-clock-minutes-default)
+		     (todayp :org-clock-minutes-today)
 		     (customp :org-clock-minutes-custom)
 		     (customp :org-clock-minutes-custom)
 		     (t :org-clock-minutes)))
 		     (t :org-clock-minutes)))
 	 time h m p)
 	 time h m p)
-    (cond (todayp (org-clock-sum-today))
-	  (customp (org-clock-sum-custom))
+    (cond ((not arg) (org-clock-sum-custom
+		      nil org-clock-display-default-range prop))
+	  (todayp (org-clock-sum-today))
+	  (customp (org-clock-sum-custom nil arg))
 	  (t (org-clock-sum)))
 	  (t (org-clock-sum)))
     (unless (eq arg '(64))
     (unless (eq arg '(64))
       (save-excursion
       (save-excursion
@@ -2147,10 +2167,12 @@ If you can combine both, the month starting day will have priority."
        ((> (+ q shift) 0) ; shift is within this year
        ((> (+ q shift) 0) ; shift is within this year
 	(setq shiftedq (+ q shift))
 	(setq shiftedq (+ q shift))
 	(setq shiftedy y)
 	(setq shiftedy y)
-	(setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
+	(setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1)))
+	      month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
      ((memq key '(year thisyear))
      ((memq key '(year thisyear))
       (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
       (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
-     (t (error "No such time block %s" key)))
+     ((eq key 'interactive) nil)
+     (t (user-error "No such time block %s" key)))
     (setq ts (encode-time s m h d month y)
     (setq ts (encode-time s m h d month y)
 	  te (encode-time (or s1 s) (or m1 m) (or h1 h)
 	  te (encode-time (or s1 s) (or m1 m) (or h1 h)
 			  (or d1 d) (or month1 month) (or y1 y)))
 			  (or d1 d) (or month1 month) (or y1 y)))
@@ -2165,10 +2187,15 @@ If you can combine both, the month starting day will have priority."
      ((memq key '(year thisyear))
      ((memq key '(year thisyear))
       (setq txt (format-time-string "the year %Y" ts)))
       (setq txt (format-time-string "the year %Y" ts)))
      ((memq key '(quarter thisq))
      ((memq key '(quarter thisq))
-      (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))))
+      (setq txt (concat (org-count-quarter shiftedq)
+			" quarter of " (number-to-string shiftedy)))))
     (if as-strings
     (if as-strings
 	(list (format-time-string fm ts) (format-time-string fm te) txt)
 	(list (format-time-string fm ts) (format-time-string fm te) txt)
-      (list ts te txt))))
+      (if (eq key 'interactive)
+	  (list (org-read-date nil t nil "Range start? ")
+		(org-read-date nil t nil "Range end? ")
+		"(Range interactively set)")
+	(list ts te txt)))))
 
 
 (defun org-count-quarter (n)
 (defun org-count-quarter (n)
   (cond
   (cond