Adding org-collector.el as a contributed package

4 files changed, 265 insertions, 26 deletions

diff --git a/ORGWEBPAGE/Changes.org b/ORGWEBPAGE/Changes.org
index 5e0df63..418a48e 100644
--- a/ORGWEBPAGE/Changes.org
+++ b/ORGWEBPAGE/Changes.org
@@ -17,6 +17,16 @@
 
 ** Incompatible changes
 
+
+*** Tag searches are now case-sensitive
+
+From this release on, tag searches will be case sensitive.  While
+I still think it would be nice to have them case-insensitive,
+this was both an inconsistency (TODO keyword searches have always
+been case-sensitive), and trouble for coding some efficient
+algorithms.  So please make sure that you give the tags with
+correct casing when prompted for a match expression.
+
 *** New key for creating tags/property sparse trees
 
 The key to produce a sparse tree matching tags and properties is
@@ -27,7 +37,7 @@ in the documentation and may go away at any time in the future.
 
 *** IDs in HTML have "ID-" prefix when generated by uuidgen
 
-=uuidgen= generates IDs that often start with a number, not a
+/uuidgen/ generates IDs that often start with a number, not a
 latter.  However, IDs and names in XHTML must start with a letter.
 Therefore, IDs in HTML files will now get an "ID-" prefix if they
 have been generated by uuidgen.  This means that id links from one
@@ -42,31 +52,8 @@ for this variable is the symbol =cookies=, which means that on
 the cookie is fontified.  Set it to =t= if you want the entire
 task headline to be fontified.
 
-
-*** Tag searches are now case-sensitive
-
-From this release on, tag searches will be case sensitive.  While
-I still think it would be nice to have them case-insensitive,
-this was both an inconsistency (TODO keyword searches have always
-been case-sensitive), and trouble for coding some efficient
-algorithms.  So please make sure that you give the tags with
-correct casing when prompted for a match expression.
-
 ** Details
 
-*** Improved ASCII export of links
-
-ASCII export of links works now much better.  If a link has a
-link and a description part which are different, then the
-description will remain in the text while the link part will be
-moved to the end of the current section, before the next heading,
-as a footnote-like construct.
-
-Configure the variable =org-export-ascii-links-to-notes= if you
-prefer the links to be shown in the text.  In this case, Org will
-make an attempt to wrap the line which may have become
-significantly longer by showing the link.
-
 *** PDF export of agenda views
 
 Agenda views can now be exported to PDF files by writing them to
@@ -101,6 +88,22 @@ for example
  ("agenda-today.pdf"))
 #+end_src
 
+*** Improved ASCII export of links
+
+ASCII export of links works now much better.  If a link has a
+link and a description part which are different, then the
+description will remain in the text while the link part will be
+moved to the end of the current section, before the next heading,
+as a footnote-like construct.
+
+Configure the variable =org-export-ascii-links-to-notes= if you
+prefer the links to be shown in the text.  In this case, Org will
+make an attempt to wrap the line which may have become
+significantly longer by showing the link.
+
+Thanks to Samuel Wales for pointing out the bad state of ASCII
+link export.
+
 *** Custom agenda commands can specify a filter preset
 
 If a custom agenda command specifies a value for
@@ -127,6 +130,18 @@ LaTeX and HTML.  This is implemented in a contributed package by
 Taru Karttunen, /org-exp-bibtex.el/.  Kudos to Taru for this
 really nice addition.
 
+*** org-collector.el is now a contributed package
+
+/org-collector.el/ provides functions to create tables by by
+collecting and processing properties collected from entries in a
+specific scope like the current tree or file, or even from all
+agenda files.  General lisp expressions can be used to manipulate
+the property values before they are inserted into an org-mode
+table, for example as a dynamic block.
+
+Thanks to Eric Schulte for yet another great contribution to
+Org.
+
 *** Update of org2rem.el
 
 /org2rem.el/ has been updated significantly and now does a more
@@ -142,7 +157,7 @@ everything that is inside =<body>=.
 This means that you need to update /org-info.js/ (if you have a
 local copy).  It will be safe todo so, because the new
 org-info.js still handles older pages correctly.  Thanks to
-Sebastian for making these changes so quicky.
+Sebastian Rose for making these changes so quicky.
 
 *** Clustering characters for undo
 
@@ -225,7 +240,7 @@ compiling changes to Org.  The command to reload the compiled
 files (if available) is =C-c C-x r=.  If no compiled files are
 found, uncompiled ones will be loaded.  If you want to force
 loading of uncompiled code (great for producing backtraces), use
-a prefix arg: =C-u C-c C-x o=.  Both commands are available in
+a prefix arg: =C-u C-c C-x r=.  Both commands are available in
 the menu as well.
 
 This new command was inspired by one written earlier by Bernt
diff --git a/contrib/README b/contrib/README
index ac7b1ac..8c1500e 100644
--- a/contrib/README
+++ b/contrib/README
@@ -15,6 +15,7 @@ org-annotation-helper.el --- Call remember directly from Firefox/Opera
 org-bookmark.el          --- Links to bookmarks
 org-browser-url.el       --- Store links to webpages directly from Firefox/Opera
 org-choose.el            --- Use TODO keywords to mark decision states
+org-collector.el         --- Collect properties into tables
 org-depend.el            --- TODO dependencies for Org-mode
 org-elisp-symbol.el      --- Org links to emacs-lisp symbols
 org-eval.el              --- The <lisp> tag, adapted from Muse
diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el
new file mode 100644
index 0000000..72eb8f2
--- /dev/null
+++ b/contrib/lisp/org-collector.el
@@ -0,0 +1,222 @@
+;;; org-collector --- collect properties into tables
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte <schulte dot eric at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
+;;           organization, properties
+;; Homepage: http://orgmode.org
+;; Version: 0.01
+
+;; This file is not yet part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Pass in an alist of columns, each column can be either a single
+;; property or a function which takes column names as arguments.
+;;
+;; For example the following propview block would collect the value of
+;; the 'amount' property from each header in the current buffer
+;;
+;; #+BEGIN: propview :cols (ITEM amount)
+;; | "ITEM"              | "amount" |
+;; |---------------------+----------|
+;; | "December Spending" |        0 |
+;; | "Grocery Store"     |    56.77 |
+;; | "Athletic club"     |     75.0 |
+;; | "Restaurant"        |    30.67 |
+;; | "January Spending"  |        0 |
+;; | "Athletic club"     |     75.0 |
+;; | "Restaurant"        |    50.00 |
+;; |---------------------+----------|
+;; |                     |          |
+;; #+END:
+;;
+;; This slightly more selective propview block will limit those
+;; headers included to those in the subtree with the id 'december'
+;; in which the spendtype property is equal to "food"
+;;
+;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols (ITEM amount)
+;; | "ITEM"          | "amount" |
+;; |-----------------+----------|
+;; | "Grocery Store" |    56.77 |
+;; | "Restaurant"    |    30.67 |
+;; |-----------------+----------|
+;; |                 |          |
+;; #+END:
+;;
+;; Org Collector allows arbitrary processing of the property values
+;; through elisp in the cols: property.  This allows for both simple
+;; computations as in the following example
+;;
+;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f d))
+;; | "ITEM" | "f" | "d" | "list"                  | "(apply (quote +) list)" | "(+ f d)" |
+;; |--------+-----+-----+-------------------------+--------------------------+-----------|
+;; | "run1" |   2 |  33 | (quote (9 2 3 4 5 6 7)) | 36                       |        35 |
+;; | "run2" |   2 |  34 | :na                     | :na                      |        36 |
+;; | "run3" |   2 |  35 | :na                     | :na                      |        37 |
+;; | "run4" |   2 |  36 | :na                     | :na                      |        38 |
+;; |        |     |     |                         |                          |           |
+;; #+END:
+;;
+;; or more complex computations as in the following example taken from
+;; an org file where each header in "results" subtree contained a
+;; property "sorted_hits" which was passed through the
+;; "average-precision" elisp function
+;;
+;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits))
+;; | "ITEM"    | "(average-precision sorted_hits)" |
+;; |-----------+-----------------------------------|
+;; | run (80)  |                          0.105092 |
+;; | run (70)  |                          0.108142 |
+;; | run (10)  |                          0.111348 |
+;; | run (60)  |                          0.113593 |
+;; | run (50)  |                          0.116446 |
+;; | run (100) |                          0.118863 |
+;; #+END:
+;; 
+
+;;; Code:
+(require 'org)
+(require 'org-table)
+
+(defvar org-propview-default-value 0
+  "Default value to insert into the propview table when the no
+value is calculated either through lack of required variables for
+a column, or through the generation of an error.")
+
+(defun and-rest (list)
+  (if (listp list)
+      (if (> (length list) 1)
+	  (and (car list) (and-rest (cdr list)))
+	(car list))
+    list))
+
+(put 'org-collector-error
+     'error-conditions
+     '(error column-prop-error org-collector-error))
+
+(defun org-read-prop (prop)
+  "Convert the string property PROP to a number if appropriate.
+Otherwise if prop looks like a list (meaning it starts with a
+'(') then read it as lisp, otherwise return it unmodified as a
+string."
+  (if (and (stringp prop) (not (equal prop "")))
+      (let ((out (string-to-number prop)))
+	(if (equal out 0)
+	    (if (or (equal "(" (substring prop 0 1)) (equal "'" (substring prop 0 1)))
+		(read prop)
+	      (if (string-match "^\\(+0\\|-0\\|0\\)$" prop)
+		  0
+		(progn (set-text-properties 0 (length prop) nil prop)
+		       prop)))
+	  out))
+    prop))
+
+(defun org-dblock-write:propview (params)
+  "collect the column specification from the #+cols line
+preceeding the dblock, then update the contents of the dblock."
+  (interactive)
+  (condition-case er
+      (let ((cols (plist-get params :cols))
+	    (conds (plist-get params :conds))
+	    (match (plist-get params :match))
+	    (scope (plist-get params :scope))
+	    (content-lines (org-split-string (plist-get params :content) "\n"))
+	    id table line pos)
+	(save-excursion
+	  (when (setq id (plist-get params :id))
+	    (cond ((not id) nil)
+		  ((eq id 'global) (goto-char (point-min)))
+		  ((eq id 'local)  nil)
+		  ((setq idpos (org-find-entry-with-id id))
+		   (goto-char idpos))
+		  (t (error "Cannot find entry with :ID: %s" id))))
+	  (org-narrow-to-subtree)
+	  (setq table (org-propview-to-table (org-propview-collect cols conds match scope)))
+	  (widen))
+	(setq pos (point))
+	(when content-lines
+	  (while (string-match "^#" (car content-lines))
+	    (insert (pop content-lines) "\n")))
+	(insert table) (insert "\n|--") (org-cycle) (move-end-of-line 1)
+	(message (format "point-%d" pos))
+	(while (setq line (pop content-lines))
+	  (when (string-match "^#" line)
+	    (insert "\n" line)))
+	(goto-char pos)
+	(org-table-recalculate 'all))
+    (org-collector-error (widen) (error "%s" er))
+    (error (widen) (error "%s" er))))
+
+(defun org-propview-eval-w-props (props body)
+  "evaluate the BODY-FORMS binding the variables using the
+variables and values specified in props"
+  (condition-case nil ;; catch any errors
+      (eval `(let ,(mapcar
+		    (lambda (pair) (list (intern (car pair)) (cdr pair)))
+		    props)
+	       ,body))
+    (error nil)))
+
+(defun org-propview-collect (cols &optional conds match scope)
+  (interactive)
+  ;; collect the properties from every header
+  (let* ((header-props
+	  (let ((org-trust-scanner-tags t))
+	    (org-map-entries (quote (cons (cons "ITEM" (org-get-heading))
+					  (org-entry-properties)))
+			     match scope)))
+	 ;; read property values
+	 (header-props (mapcar (lambda (props)
+				 (mapcar (lambda (pair) (cons (car pair) (org-read-prop (cdr pair))))
+					 props))
+			       header-props))
+	 ;; collect all property names
+	 (prop-names (mapcar 'intern (delete-dups
+				      (apply 'append (mapcar (lambda (header)
+							       (mapcar 'car header))
+							     header-props))))))
+    (append
+     (list
+      (mapcar (lambda (el) (format "%S" el)) cols) ;; output headers
+      'hline) ;; ------------------------------------------------
+     (mapcar ;; calculate the value of the column for each header
+      (lambda (props) (mapcar (lambda (col) (let ((result (org-propview-eval-w-props props col)))
+					      (if result result org-propview-default-value)))
+			      cols))
+      (if conds
+	  ;; eliminate the headers which don't satisfy the property
+	  (delq nil
+		(mapcar
+		 (lambda (props)
+		   (if (and-rest (mapcar (lambda (col) (org-propview-eval-w-props props col)) conds))
+		       props))
+		 header-props))
+	  header-props)))))
+
+(defun org-propview-to-table (results)
+  ;; (message (format "cols:%S" cols))
+  (orgtbl-to-orgtbl
+   (mapcar
+    (lambda (row)
+      (if (equal row 'hline)
+	  'hline
+	(mapcar (lambda (el) (format "%S" el)) row)))
+    (delq nil results)) '()))
+
+(provide 'org-collector)
+;;; org-collector ends here
\ No newline at end of file
diff --git a/lisp/org.el b/lisp/org.el
index c7b6152..156975a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -182,6 +182,7 @@ to add the symbol `xyz', and the package must have a call to
 	(const :tag "C  bookmark:          Org links to bookmarks" org-bookmark)
 	(const :tag "C  browser-url:       Store link, directly from Browser" org-browser-url)
 	(const :tag "C  choose:            Use TODO keywords to mark decisions states" org-choose)
+	(const :tag "C  collector:         Collect properties into tables" org-collector)
 	(const :tag "C  depend:            TODO dependencies for Org-mode" org-depend)
 	(const :tag "C  elisp-symbol:      Org links to emacs-lisp symbols" org-elisp-symbol)
 	(const :tag "C  eval:              Include command output as text" org-eval)