Browse Source

Adding org-collector.el as a contributed package

Carsten Dominik 16 years ago
parent
commit
f41f942e53
4 changed files with 265 additions and 26 deletions
  1. 41 26
      ORGWEBPAGE/Changes.org
  2. 1 0
      contrib/README
  3. 222 0
      contrib/lisp/org-collector.el
  4. 1 0
      lisp/org.el

+ 41 - 26
ORGWEBPAGE/Changes.org

@@ -17,6 +17,16 @@
 
 
 ** Incompatible changes
 ** 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
 *** New key for creating tags/property sparse trees
 
 
 The key to produce a sparse tree matching tags and properties is
 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
 *** 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.
 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
 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
 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
 the cookie is fontified.  Set it to =t= if you want the entire
 task headline to be fontified.
 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
 ** 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
 *** PDF export of agenda views
 
 
 Agenda views can now be exported to PDF files by writing them to
 Agenda views can now be exported to PDF files by writing them to
@@ -101,6 +88,22 @@ for example
  ("agenda-today.pdf"))
  ("agenda-today.pdf"))
 #+end_src
 #+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
 *** Custom agenda commands can specify a filter preset
 
 
 If a custom agenda command specifies a value for
 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
 Taru Karttunen, /org-exp-bibtex.el/.  Kudos to Taru for this
 really nice addition.
 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
 *** Update of org2rem.el
 
 
 /org2rem.el/ has been updated significantly and now does a more
 /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
 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
 local copy).  It will be safe todo so, because the new
 org-info.js still handles older pages correctly.  Thanks to
 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
 *** 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
 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
 found, uncompiled ones will be loaded.  If you want to force
 loading of uncompiled code (great for producing backtraces), use
 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.
 the menu as well.
 
 
 This new command was inspired by one written earlier by Bernt
 This new command was inspired by one written earlier by Bernt

+ 1 - 0
contrib/README

@@ -15,6 +15,7 @@ org-annotation-helper.el --- Call remember directly from Firefox/Opera
 org-bookmark.el          --- Links to bookmarks
 org-bookmark.el          --- Links to bookmarks
 org-browser-url.el       --- Store links to webpages directly from Firefox/Opera
 org-browser-url.el       --- Store links to webpages directly from Firefox/Opera
 org-choose.el            --- Use TODO keywords to mark decision states
 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-depend.el            --- TODO dependencies for Org-mode
 org-elisp-symbol.el      --- Org links to emacs-lisp symbols
 org-elisp-symbol.el      --- Org links to emacs-lisp symbols
 org-eval.el              --- The <lisp> tag, adapted from Muse
 org-eval.el              --- The <lisp> tag, adapted from Muse

+ 222 - 0
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

+ 1 - 0
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  bookmark:          Org links to bookmarks" org-bookmark)
 	(const :tag "C  browser-url:       Store link, directly from Browser" org-browser-url)
 	(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  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  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  elisp-symbol:      Org links to emacs-lisp symbols" org-elisp-symbol)
 	(const :tag "C  eval:              Include command output as text" org-eval)
 	(const :tag "C  eval:              Include command output as text" org-eval)