ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Adding :colnames and :noquote parameters

This commit is contained in:
Jonathan Bisson 2011-10-30 14:25:49 +01:00 committed by Eric Schulte
parent b3e1e7320f
commit 7e56bb070f
1 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
contrib/lisp/org-collector.el
View File

@ -1,6 +1,6 @@
;;; org-collector --- collect properties into tables ;;; org-collector --- collect properties into tables
;; Copyright (C) 2008-2011 Free Software Foundation, Inc. ;; Copyright (C) 2008 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp, experimentation, ;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
@ -119,6 +119,8 @@ preceeding the dblock, then update the contents of the dblock."
(conds (plist-get params :conds)) (conds (plist-get params :conds))
(match (plist-get params :match)) (match (plist-get params :match))
(scope (plist-get params :scope)) (scope (plist-get params :scope))
(noquote (plist-get params :noquote))
(colnames (plist-get params :colnames))
(content-lines (org-split-string (plist-get params :content) "\n")) (content-lines (org-split-string (plist-get params :content) "\n"))
id table line pos) id table line pos)
(save-excursion (save-excursion
@ -130,8 +132,10 @@ preceeding the dblock, then update the contents of the dblock."
(goto-char idpos)) (goto-char idpos))
(t (error "Cannot find entry with :ID: %s" id)))) (t (error "Cannot find entry with :ID: %s" id))))
(org-narrow-to-subtree) (org-narrow-to-subtree)
(setq stringformat (if noquote "%s" "%S"))
(setq table (org-propview-to-table (setq table (org-propview-to-table
(org-propview-collect cols conds match scope inherit))) (org-propview-collect cols stringformat conds match scope inherit
(if colnames colnames cols)) stringformat))
(widen)) (widen))
(setq pos (point)) (setq pos (point))
(when content-lines (when content-lines
@ -167,7 +171,7 @@ variables and values specified in props"
(when p (cons n p)))) (when p (cons n p))))
inherit)))) inherit))))
(defun org-propview-collect (cols &optional conds match scope inherit) (defun org-propview-collect (cols stringformat &optional conds match scope inherit colnames)
(interactive) (interactive)
;; collect the properties from every header ;; collect the properties from every header
(let* ((header-props (let* ((header-props
@ -191,8 +195,8 @@ variables and values specified in props"
header-props)))))) header-props))))))
(append (append
(list (list
(mapcar (lambda (el) (format "%S" el)) cols) ;; output headers (if colnames colnames (mapcar (lambda (el) (format stringformat el)) cols))
'hline) ;; ------------------------------------------------ 'hline) ;; ------------------------------------------------
(mapcar ;; calculate the value of the column for each header (mapcar ;; calculate the value of the column for each header
(lambda (props) (mapcar (lambda (col) (lambda (props) (mapcar (lambda (col)
(let ((result (org-propview-eval-w-props props col))) (let ((result (org-propview-eval-w-props props col)))
@ -211,16 +215,15 @@ variables and values specified in props"
header-props)) header-props))
header-props))))) header-props)))))
(defun org-propview-to-table (results) (defun org-propview-to-table (results stringformat)
;; (message (format "cols:%S" cols)) ;; (message (format "cols:%S" cols))
(orgtbl-to-orgtbl (orgtbl-to-orgtbl
(mapcar (mapcar
(lambda (row) (lambda (row)
(if (equal row 'hline) (if (equal row 'hline)
'hline 'hline
(mapcar (lambda (el) (format "%S" el)) row))) (mapcar (lambda (el) (format stringformat el)) row)))
(delq nil results)) '())) (delq nil results)) '()))
(provide 'org-collector) (provide 'org-collector)
;;; org-collector ends here ;;; org-collector ends here