org-collector.el 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169
  1. ;;; org-collector --- collect properties into tables
  2. ;;
  3. ;; Copyright (C) 2008 Eric Schulte
  4. ;;
  5. ;; Emacs Lisp Archive Entry
  6. ;; Filename: org-collector.el
  7. ;; Version: 0.1
  8. ;; Author: Eric Schulte <schulte.eric AT gmail DOT com>
  9. ;; Keywords: org, properties, collection, tables
  10. ;; Description: collect properties into tables
  11. ;;
  12. ;; This program is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 3, or (at your option)
  15. ;; any later version.
  16. ;;
  17. ;; This program is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  20. ;; GNU General Public License for more details.
  21. ;;
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with this program; if not, write to the Free Software
  24. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;;
  26. ;;; Comments:
  27. ;;
  28. ;; Pass in an alist of columns, each column can be either a single
  29. ;; property or a function which takes properties as arguments. A
  30. ;; table will be populated by passing proerty values to each of the
  31. ;; column specifiers. There will be one row in the table for each
  32. ;; headline which satisfies your colum specifiers. An example dblock
  33. ;; specification with results may look like this.
  34. ;;
  35. ;; #+BEGIN: propview :id "data" :cols (ITEM f d list (apply '* list) (+ f d))
  36. ;; | "ITEM" | "f" | "d" | "list" | "(apply (quote *) list)" | "(+ f d)" |
  37. ;; |--------+-----+-----+-------------------------+--------------------------+-----------|
  38. ;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 45360 | 35 |
  39. ;; | "run2" | 4 | 34 | :na | :na | 38 |
  40. ;; | "run3" | 4 | 35 | :na | :na | 39 |
  41. ;; | "run4" | 2 | 36 | :na | :na | 38 |
  42. ;; | | | | | | |
  43. ;; #+END:
  44. ;;
  45. ;;; History:
  46. ;;
  47. ;; Simplified org-propview-to-table and made unquoted headers (removed
  48. ;; extra format %S call). /mfo 2008-12-16
  49. ;;
  50. ;; Added a :no-inherit feature to gain speed together with some
  51. ;; documentation. /mfo 2008-11-25
  52. ;;
  53. ;;; Code:
  54. (require 'org)
  55. (require 'org-table)
  56. (defun and-rest (list)
  57. (if (listp list)
  58. (if (> (length list) 1)
  59. (and (car list) (and-rest (cdr list)))
  60. (car list))
  61. list))
  62. (put 'org-collector-error
  63. 'error-conditions
  64. '(error column-prop-error org-collector-error))
  65. (defun org-read-prop (prop)
  66. "Convert the string property PROP to a number if appropriate.
  67. Otherwise if prop looks like a list (meaning it starts with a
  68. '(') then read it as lisp, otherwise return it unmodified as a
  69. string."
  70. (if (and (stringp prop) (not (equal prop "")))
  71. (let ((out (string-to-number prop)))
  72. (if (equal out 0)
  73. (if (or (equal "(" (substring prop 0 1)) (equal "'" (substring prop 0 1)))
  74. (read prop)
  75. (if (string-match "^\\(+0\\|-0\\|0\\)$" prop)
  76. 0
  77. (progn (set-text-properties 0 (length prop) nil prop)
  78. prop)))
  79. out))
  80. prop))
  81. (defun org-dblock-write:propview (params)
  82. "Generates org-collector propview table.
  83. It collects the column specifications from the :cols parameter
  84. preceeding the dblock, then update the contents of the dblock
  85. with data from headings selected by the :id parameter. It can be:
  86. * global - data from whole document is processed
  87. * local - only current subtree
  88. * <org-id> - only headings with this property :ID:.
  89. If no inheritance is wanted set paramter :no-inherit, to gain
  90. speed."
  91. (interactive)
  92. (condition-case er
  93. (let* ((cols (plist-get params :cols))
  94. (id (plist-get params :id))
  95. (inherit (not (plist-get params :no-inherit)))
  96. (org-use-tag-inheritance inherit)
  97. (org-use-property-inheritance inherit)
  98. table idpos)
  99. (save-excursion
  100. (cond ((not id) nil)
  101. ((eq id 'global)
  102. (goto-char (point-min))
  103. (outline-next-heading))
  104. ((eq id 'local) nil)
  105. ((setq idpos (org-find-entry-with-id id))
  106. (goto-char idpos))
  107. (t (error "Cannot find entry with :ID: %s" id)))
  108. (org-narrow-to-subtree)
  109. (setq table (org-propview-to-table (org-propview-collect cols)))
  110. (widen))
  111. (insert table)
  112. (org-cycle))
  113. (org-collector-error (widen) (error "%s" er))
  114. (error (widen) (error "%s" er))))
  115. (defun org-propview-collect (cols)
  116. (interactive)
  117. ;; collect the properties from every header
  118. (let* ((header-props (org-map-entries (quote (cons (cons "ITEM" (org-get-heading))
  119. (org-entry-properties)))))
  120. ;; collect all property names
  121. (prop-names (mapcar 'intern (delete-dups
  122. (apply 'append (mapcar (lambda (header)
  123. (mapcar 'car header))
  124. header-props))))))
  125. ;; (message (format "header-props=%S" header-props))
  126. ;; (message (format "prop-names=%S" prop-names))
  127. (append
  128. (list
  129. ;; create an output list of the headers for each output col
  130. cols
  131. 'hline)
  132. (mapcar ;; for each header's entries
  133. (lambda (props)
  134. (mapcar ;; for each col
  135. (lambda (col)
  136. (or
  137. ;; if col is a symbol and it's present return it's value
  138. (and (symbolp col)
  139. (let ((val (cdr (assoc (symbol-name col) props))))
  140. (if val (org-read-prop val))))
  141. ;; if col is a list, and everything in it's cdr is present,
  142. ;; then evaluate it as a function
  143. (and (listp col)
  144. (let ((vals (mapcar (lambda (el) (if (memq el prop-names)
  145. (org-read-prop (cdr (assoc (symbol-name el) props)))
  146. el))
  147. (cdr col))))
  148. ;; (message (format "vals-%S" vals))
  149. (condition-case col-er
  150. (and (and-rest vals) (org-read-prop (eval (cons (car col) vals))))
  151. (error (signal 'org-collector-error
  152. (list (format "%S while processing: %S" col-er col)))))))
  153. :na)) ;; else return an appropriate default
  154. cols))
  155. header-props))))
  156. (defun org-propview-to-table (results)
  157. (orgtbl-to-orgtbl results '(:fmt "%S" :remove-nil-lines)))
  158. (provide 'org-collector)
  159. ;;; org-collector ends here