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>
 2009-11-11  Carsten Dominik  <carsten.dominik@gmail.com>
 
 
 	* org-exp.el (org-export-format-drawer-function): New variable.
 	* org-exp.el (org-export-format-drawer-function): New variable.
@@ -78,6 +97,10 @@
 	* org-docbook.el (org-export-as-docbook): Protect targets in
 	* org-docbook.el (org-export-as-docbook): Protect targets in
 	verbatim emphasis.
 	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>
 2009-11-06  Carsten Dominik  <carsten.dominik@gmail.com>
 
 
 	* org-clock.el (org-show-notification): Handle messages that
 	* 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
 			    (org-agenda-columns-cleanup-item
 			     val pl cphr org-columns-current-fmt-compiled)))
 			     val pl cphr org-columns-current-fmt-compiled)))
 			 ((and calc (functionp calc)
 			 ((and calc (functionp calc)
+			       (not (string= val ""))
 			       (not (get-text-property 0 'org-computed val)))
 			       (not (get-text-property 0 'org-computed val)))
 			  (org-columns-number-to-string
 			  (org-columns-number-to-string
 			   (funcall calc (org-columns-string-to-number
 			   (funcall calc (org-columns-string-to-number
@@ -1230,9 +1231,16 @@ Don't set this, this is meant for dynamic scoping.")
   (if s
   (if s
       (cond
       (cond
        ((memq fmt '(min_age max_age mean_age))
        ((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)
        ((string-match ":" s)
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	  (while l
 	  (while l
@@ -1577,10 +1585,11 @@ and tailing newline characters."
   "Summarize the summarizable columns in column view in the agenda.
   "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."
 This will add overlays to the date lines, to show the summary for each day."
   (let* ((fmt (mapcar (lambda (x)
   (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))
 		      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
     (catch 'exit
       (when (delq nil (mapcar 'cadr fmt))
       (when (delq nil (mapcar 'cadr fmt))
 	;; OK, at least one summation column, it makes sense to try this
 	;; 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
 	      (setq props
 		    (mapcar
 		    (mapcar
 		     (lambda (f)
 		     (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
 		       (cond
 			((equal prop "ITEM")
 			((equal prop "ITEM")
 			 (cons prop (buffer-substring (point-at-bol)
 			 (cons prop (buffer-substring (point-at-bol)
 						      (point-at-eol))))
 						      (point-at-eol))))
 			((not stype) (cons prop ""))
 			((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))))
 			 (cons prop lsum))))
 		     fmt))
 		     fmt))
 	      (org-columns-display-here props)
 	      (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
 			    (org-agenda-columns-cleanup-item
 			     val pl cphr org-columns-current-fmt-compiled)))
 			     val pl cphr org-columns-current-fmt-compiled)))
 			 ((and calc (functionp calc)
 			 ((and calc (functionp calc)
+			       (not (string= val ""))
 			       (not (get-text-property 0 'org-computed val)))
 			       (not (get-text-property 0 'org-computed val)))
 			  (org-columns-number-to-string
 			  (org-columns-number-to-string
 			   (funcall calc (org-columns-string-to-number
 			   (funcall calc (org-columns-string-to-number
@@ -1044,9 +1045,16 @@ Don't set this, this is meant for dynamic scoping.")
   (if s
   (if s
       (cond
       (cond
        ((memq fmt '(min_age max_age mean_age))
        ((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)
        ((string-match ":" s)
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	  (while l
 	  (while l
@@ -1054,8 +1062,7 @@ Don't set this, this is meant for dynamic scoping.")
 	  sum))
 	  sum))
        ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
        ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
 	(if (equal s "[X]") 1. 0.000001))
 	(if (equal s "[X]") 1. 0.000001))
-       (t (string-to-number s)))
-    0))
+       (t (string-to-number s)))))
 
 
 (defun org-columns-uncompile-format (cfmt)
 (defun org-columns-uncompile-format (cfmt)
   "Turn the compiled columns format back into a string representation."
   "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.
   "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."
 This will add overlays to the date lines, to show the summary for each day."
   (let* ((fmt (mapcar (lambda (x)
   (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))
 		      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
     (catch 'exit
       (when (delq nil (mapcar 'cadr fmt))
       (when (delq nil (mapcar 'cadr fmt))
 	;; OK, at least one summation column, it makes sense to try this
 	;; 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
 	      (setq props
 		    (mapcar
 		    (mapcar
 		     (lambda (f)
 		     (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
 		       (cond
 			((equal prop "ITEM")
 			((equal prop "ITEM")
 			 (cons prop (buffer-substring (point-at-bol)
 			 (cons prop (buffer-substring (point-at-bol)
 						      (point-at-eol))))
 						      (point-at-eol))))
 			((not stype) (cons prop ""))
 			((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))))
 			 (cons prop lsum))))
 		     fmt))
 		     fmt))
 	      (org-columns-display-here props 'dateline)
 	      (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))
 	   (scheduled-repeat (org-get-repeat org-scheduled-string))
 	   (sr-days (org-habit-duration-to-days scheduled-repeat))
 	   (sr-days (org-habit-duration-to-days scheduled-repeat))
 	   (end (org-entry-end-position))
 	   (end (org-entry-end-position))
+	   (habit-entry (org-no-properties (nth 5 (org-heading-components))))
 	   closed-dates deadline dr-days)
 	   closed-dates deadline dr-days)
       (if scheduled
       (if scheduled
 	  (setq scheduled (time-to-days 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
       (unless scheduled-repeat
-	(error "Habit has no scheduled repeat period"))
+	(error "Habit %s has no scheduled repeat period" habit-entry))
       (unless (> sr-days 0)
       (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)
       (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
 	(setq dr-days (org-habit-duration-to-days
 	(setq dr-days (org-habit-duration-to-days
 		       (match-string-no-properties 1 scheduled-repeat)))
 		       (match-string-no-properties 1 scheduled-repeat)))
 	(if (<= dr-days sr-days)
 	(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))))
 	(setq deadline (+ scheduled (- dr-days sr-days))))
       (org-back-to-heading t)
       (org-back-to-heading t)
       (while (re-search-forward "- State \"DONE\".*\\[\\([^]]+\\)\\]" end 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:
 Habits are assigned colors on the following basis:
   Blue      Task is before the scheduled date.
   Blue      Task is before the scheduled date.
   Green     Task is on or after scheduled date, but before the
   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
   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
   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
   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)))
   (let* ((scheduled (or scheduled-days (org-habit-scheduled habit)))
 	 (s-repeat (org-habit-scheduled-repeat habit))
 	 (s-repeat (org-habit-scheduled-repeat habit))
 	 (scheduled-end (+ scheduled (1- s-repeat)))
 	 (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"
 if no description is present"
   (save-match-data
   (save-match-data
     (if (string-match org-bracket-link-analytic-regexp link)
     (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)))
       link)))
 
 
 ;; Speedbar support
 ;; Speedbar support