Browse Source

Merge commit 'james/bugfixes'

Carsten Dominik 15 years ago
parent
commit
a89ecb0916
5 changed files with 127 additions and 52 deletions
  1. 23 0
      lisp/ChangeLog
  2. 44 19
      lisp/org-colview-xemacs.el
  3. 45 21
      lisp/org-colview.el
  4. 10 8
      lisp/org-habit.el
  5. 5 4
      lisp/org.el

+ 23 - 0
lisp/ChangeLog

@@ -1,3 +1,22 @@
+2009-11-12  James TD Smith  <ahktenzero@mohorovi.cc>
+
+	* org-habit.el (org-habit-parse-todo): Indicate which habit is
+	wrongly set up in the error messages.
+
+	* org-colview.el (org-columns-display-here): Don't try to
+	calculate values if the underlying property is not set.
+	(org-columns-string-to-number): Convert age strings back into
+	fractional days.
+	(org-agenda-colview-summarize): Handle extended summary types
+	properly.
+
+	* org-colview-xemacs.el (org-columns-display-here): Don't try to
+	calculate values if the underlying property is not set.
+	(org-columns-string-to-number): Convert age strings back into
+	fractional days.
+	(org-agenda-colview-summarize): Handle extended summary types
+	properly.
+
 2009-11-11  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-exp.el (org-export-format-drawer-function): New variable.
@@ -78,6 +97,10 @@
 	* org-docbook.el (org-export-as-docbook): Protect targets in
 	verbatim emphasis.
 
+2009-11-07  James TD Smith  <ahktenzero@mohorovi.cc>
+
+	* org.el (org-link-display-format): Should be literal replacement.
+
 2009-11-06  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-clock.el (org-show-notification): Handle messages that

+ 44 - 19
lisp/org-colview-xemacs.el

@@ -358,6 +358,7 @@ This is the compiled version of the format.")
 			    (org-agenda-columns-cleanup-item
 			     val pl cphr org-columns-current-fmt-compiled)))
 			 ((and calc (functionp calc)
+			       (not (string= val ""))
 			       (not (get-text-property 0 'org-computed val)))
 			  (org-columns-number-to-string
 			   (funcall calc (org-columns-string-to-number
@@ -1230,9 +1231,16 @@ Don't set this, this is meant for dynamic scoping.")
   (if s
       (cond
        ((memq fmt '(min_age max_age mean_age))
-	(if (string= s "")
-	    org-columns-time
-	  (time-to-number-of-days (apply 'encode-time (org-parse-time-string s t)))))
+	(cond ((string= s "") org-columns-time)
+	      ((string-match
+		"\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
+		s)
+	       (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
+				    (string-to-number (match-string 2 s))))
+			   (string-to-number (match-string 3 s))))
+		  (string-to-number (match-string 4 s))))
+	      (t (time-to-number-of-days (apply 'encode-time
+						(org-parse-time-string s t))))))
        ((string-match ":" s)
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	  (while l
@@ -1577,10 +1585,11 @@ and tailing newline characters."
   "Summarize the summarizable columns in column view in the agenda.
 This will add overlays to the date lines, to show the summary for each day."
   (let* ((fmt (mapcar (lambda (x)
-			(list (car x) (if (equal (car x) "CLOCKSUM")
-					  'add_times (nth 4 x))))
+			(if (equal (car x) "CLOCKSUM")
+			    (list "CLOCKSUM" (nth 2 x) add_times + identity)
+			  (cdr x)))
 		      org-columns-current-fmt-compiled))
-	 line c c1 stype props lsum entries prop v)
+	 line c c1 stype calc sumfunc props lsum entries prop v)
     (catch 'exit
       (when (delq nil (mapcar 'cadr fmt))
 	;; OK, at least one summation column, it makes sense to try this
@@ -1603,24 +1612,40 @@ This will add overlays to the date lines, to show the summary for each day."
 	      (setq props
 		    (mapcar
 		     (lambda (f)
-		       (setq prop (car f) stype (nth 1 f))
+		       (setq prop (car f)
+			     stype (nth 3 f)
+			     sumfunc (nth 5 f)
+			     calc (or (nth 6 f) 'identity))
 		       (cond
 			((equal prop "ITEM")
 			 (cons prop (buffer-substring (point-at-bol)
 						      (point-at-eol))))
 			((not stype) (cons prop ""))
-			(t
-			 ;; do the summary
-			 (setq lsum 0)
-			 (mapc (lambda (x)
-				 (setq v (cdr (assoc prop x)))
-				 (if v (setq lsum (+ lsum
-						     (org-columns-string-to-number
-						      v stype)))))
-			       entries)
-			 (setq lsum (org-columns-number-to-string lsum stype))
-			 (put-text-property
-			  0 (length lsum) 'face 'bold lsum)
+			(t ;; do the summary
+			 (setq lsum nil)
+			 (dolist (x entries)
+			   (setq v (cdr (assoc prop x)))
+			   (if v
+			       (push
+				(funcall
+				 (if (not (get-text-property 0 'org-computed v))
+				     calc
+				   'identity)
+				 (org-columns-string-to-number
+				  v stype))
+				lsum)))
+			 (setq lsum (remove nil lsum))
+			 (setq lsum
+			       (cond ((> (length lsum) 1)
+				      (org-columns-number-to-string
+				       (apply sumfunc lsum) stype))
+				     ((eq (length lsum) 1)
+				      (org-columns-number-to-string
+				       (car lsum) stype))
+				     (t "")))
+			 (put-text-property 0 (length lsum) 'face 'bold lsum)
+			 (if (neq calc 'identity)
+			     (put-text-property 0 (length lsum) 'org-computed t lsum))
 			 (cons prop lsum))))
 		     fmt))
 	      (org-columns-display-here props)

+ 45 - 21
lisp/org-colview.el

@@ -203,6 +203,7 @@ This is the compiled version of the format.")
 			    (org-agenda-columns-cleanup-item
 			     val pl cphr org-columns-current-fmt-compiled)))
 			 ((and calc (functionp calc)
+			       (not (string= val ""))
 			       (not (get-text-property 0 'org-computed val)))
 			  (org-columns-number-to-string
 			   (funcall calc (org-columns-string-to-number
@@ -1044,9 +1045,16 @@ Don't set this, this is meant for dynamic scoping.")
   (if s
       (cond
        ((memq fmt '(min_age max_age mean_age))
-	(if (string= s "")
-	    org-columns-time
-	  (time-to-number-of-days (apply 'encode-time (org-parse-time-string s t)))))
+	(cond ((string= s "") org-columns-time)
+	      ((string-match
+		"\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
+		s)
+	       (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
+				    (string-to-number (match-string 2 s))))
+			   (string-to-number (match-string 3 s))))
+		  (string-to-number (match-string 4 s))))
+	      (t (time-to-number-of-days (apply 'encode-time
+						(org-parse-time-string s t))))))
        ((string-match ":" s)
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	  (while l
@@ -1054,8 +1062,7 @@ Don't set this, this is meant for dynamic scoping.")
 	  sum))
        ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
 	(if (equal s "[X]") 1. 0.000001))
-       (t (string-to-number s)))
-    0))
+       (t (string-to-number s)))))
 
 (defun org-columns-uncompile-format (cfmt)
   "Turn the compiled columns format back into a string representation."
@@ -1364,10 +1371,11 @@ and tailing newline characters."
   "Summarize the summarizable columns in column view in the agenda.
 This will add overlays to the date lines, to show the summary for each day."
   (let* ((fmt (mapcar (lambda (x)
-			(list (car x) (if (equal (car x) "CLOCKSUM")
-					  'add_times (nth 4 x))))
+			(if (equal (car x) "CLOCKSUM")
+			    (list "CLOCKSUM" (nth 2 x) add_times + identity)
+			  (cdr x)))
 		      org-columns-current-fmt-compiled))
-	 line c c1 stype props lsum entries prop v)
+	 line c c1 stype calc sumfunc props lsum entries prop v)
     (catch 'exit
       (when (delq nil (mapcar 'cadr fmt))
 	;; OK, at least one summation column, it makes sense to try this
@@ -1390,24 +1398,40 @@ This will add overlays to the date lines, to show the summary for each day."
 	      (setq props
 		    (mapcar
 		     (lambda (f)
-		       (setq prop (car f) stype (nth 1 f))
+		       (setq prop (car f)
+			     stype (nth 3 f)
+			     sumfunc (nth 5 f)
+			     calc (or (nth 6 f) 'identity))
 		       (cond
 			((equal prop "ITEM")
 			 (cons prop (buffer-substring (point-at-bol)
 						      (point-at-eol))))
 			((not stype) (cons prop ""))
-			(t
-			 ;; do the summary
-			 (setq lsum 0)
-			 (mapc (lambda (x)
-				 (setq v (cdr (assoc prop x)))
-				 (if v (setq lsum (+ lsum
-						     (org-columns-string-to-number
-						      v stype)))))
-			       entries)
-			 (setq lsum (org-columns-number-to-string lsum stype))
-			 (put-text-property
-			  0 (length lsum) 'face 'bold lsum)
+			(t ;; do the summary
+			 (setq lsum nil)
+			 (dolist (x entries)
+			   (setq v (cdr (assoc prop x)))
+			   (if v
+			       (push
+				(funcall
+				 (if (not (get-text-property 0 'org-computed v))
+				     calc
+				   'identity)
+				 (org-columns-string-to-number
+				  v stype))
+				lsum)))
+			 (setq lsum (remove nil lsum))
+			 (setq lsum
+			       (cond ((> (length lsum) 1)
+				      (org-columns-number-to-string
+				       (apply sumfunc lsum) stype))
+				     ((eq (length lsum) 1)
+				      (org-columns-number-to-string
+				       (car lsum) stype))
+				     (t "")))
+			 (put-text-property 0 (length lsum) 'face 'bold lsum)
+			 (if (neq calc 'identity)
+			     (put-text-property 0 (length lsum) 'org-computed t lsum))
 			 (cons prop lsum))))
 		     fmt))
 	      (org-columns-display-here props 'dateline)

+ 10 - 8
lisp/org-habit.el

@@ -148,19 +148,21 @@ This list represents a \"habit\" for the rest of this module."
 	   (scheduled-repeat (org-get-repeat org-scheduled-string))
 	   (sr-days (org-habit-duration-to-days scheduled-repeat))
 	   (end (org-entry-end-position))
+	   (habit-entry (org-no-properties (nth 5 (org-heading-components))))
 	   closed-dates deadline dr-days)
       (if scheduled
 	  (setq scheduled (time-to-days scheduled))
-	(error "Habit has no scheduled date"))
+	(error "Habit %s has no scheduled date" habit-entry))
       (unless scheduled-repeat
-	(error "Habit has no scheduled repeat period"))
+	(error "Habit %s has no scheduled repeat period" habit-entry))
       (unless (> sr-days 0)
-	(error "Habit's scheduled repeat period is less than 1d"))
+	(error "Habit %s scheduled repeat period is less than 1d" habit-entry))
       (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
 	(setq dr-days (org-habit-duration-to-days
 		       (match-string-no-properties 1 scheduled-repeat)))
 	(if (<= dr-days sr-days)
-	    (error "Habit's deadline repeat period is less than or equal to scheduled"))
+	    (error "Habit %s deadline repeat period is less than or equal to scheduled (%s)"
+		   habit-entry scheduled-repeat))
 	(setq deadline (+ scheduled (- dr-days sr-days))))
       (org-back-to-heading t)
       (while (re-search-forward "- State \"DONE\".*\\[\\([^]]+\\)\\]" end t)
@@ -217,13 +219,13 @@ SCHEDULED-DAYS defaults to the habit's actual scheduled days if nil.
 Habits are assigned colors on the following basis:
   Blue      Task is before the scheduled date.
   Green     Task is on or after scheduled date, but before the
-            end of the schedule's repeat period.
+	    end of the schedule's repeat period.
   Yellow    If the task has a deadline, then it is after schedule's
-            repeat period, but before the deadline.
+	    repeat period, but before the deadline.
   Orange    The task has reached the deadline day, or if there is
-            no deadline, the end of the schedule's repeat period.
+	    no deadline, the end of the schedule's repeat period.
   Red       The task has gone beyond the deadline day or the
-            schedule's repeat period."
+	    schedule's repeat period."
   (let* ((scheduled (or scheduled-days (org-habit-scheduled habit)))
 	 (s-repeat (org-habit-scheduled-repeat habit))
 	 (scheduled-end (+ scheduled (1- s-repeat)))

+ 5 - 4
lisp/org.el

@@ -17575,10 +17575,11 @@ Show the heading too, if it is currently invisible."
 if no description is present"
   (save-match-data
     (if (string-match org-bracket-link-analytic-regexp link)
-	(replace-match (or (match-string 5 link)
-			   (concat (match-string 1 link)
-				   (match-string 3 link)))
-		       nil nil link)
+	    (replace-match (if (match-end 5)
+			       (match-string 5 link)
+			     (concat (match-string 1 link)
+				     (match-string 3 link)))
+			   nil t link)
       link)))
 
 ;; Speedbar support