From ff3330193da27a6b0dcf4be92ed54424040ddaec Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Tue, 1 Nov 2011 10:56:36 -0600 Subject: [PATCH] Allow some properties to accumulate (see `org-accumulated-properties-alist'). The default value of this new variable is '(("var" . ", ")) resulting in the following behavior #+property: var foo=1 #+property: var bar=2 #+begin_src emacs-lisp (+ foo bar) #+end_src #+results: : 3 #+begin_src emacs-lisp (org-entry-get (point) "var" t) #+end_src #+results: : foo=1, bar=2 * heading :PROPERTIES: :var: foo=7 :END: #+begin_src emacs-lisp foo #+end_src #+results: : 7 #+begin_src emacs-lisp (org-entry-get (point) "var" t) #+end_src #+results: : foo=1, bar=2, foo=7 * lisp/org.el (org-accumulated-properties-alist): Adding an alist which specifies which properties may be accumulated and how. (org-set-regexps-and-options): Make use of accumulating properties when collecting said. (org-property-from-plists): Return the (possibly accumulated) value of property from plists. (org-entry-get-with-inheritance): Inherit accumulated properties appropriately. --- lisp/org.el | 52 ++++++++++++++++++++++++++++++++++++++++++++++------ 1 files changed, 46 insertions(+), 6 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 318ccfd..2fe8d92 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4431,6 +4431,22 @@ in the #+STARTUP line, the corresponding variable, and the value to set this variable to if the option is found. An optional forth element PUSH means to push this value onto the list in the variable.") +(defcustom org-accumulated-properties-alist + '(("var" . ", ")) + "Alist of properties whose values should accumulate rather than overwrite. +Each element of this alist should include both a string property +name as well as the string connector used to join multiple values +for this property. So for example using the default value of +this list which associates \"var\" with \", \", the following +Org-mode text, + + #+PROPERTY: var foo=1 + #+PROPERTY: var bar=2 + +will result in the following being added to `org-file-properties'. + + '(\"var\" . \"foo=1, bar=2\")") + (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." (when (eq major-mode 'org-mode) @@ -4492,8 +4508,13 @@ means to push this value onto the list in the variable.") (setq prio (org-split-string value " +"))) ((equal key "PROPERTY") (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (push (cons (match-string 1 value) (match-string 2 value)) - props))) + (let* ((prp (match-string 1 value)) + (val (match-string 2 value)) + (new (org-property-from-plists + prp `((,prp . ,val)) props))) + (setq props (cons (cons prp new) + (org-remove-if (lambda (p) (string= (car p) prp)) + props)))))) ((equal key "FILETAGS") (when (string-match "\\S-" value) (setq ftags @@ -14170,6 +14191,24 @@ no match, the marker will point nowhere. Note that also `org-entry-get' calls this function, if the INHERIT flag is set.") +(defun org-property-from-plists (property &rest plists) + "Return PROPERTY from PLISTS respecting `org-accumulated-properties-alist'." + (flet ((until (fn lst) (when (not (null lst)) + (or (funcall fn (car lst)) + (funcall fn (cdr lst)))))) + (let ((str (cdr (assoc property org-accumulated-properties-alist)))) + (if str + (let (result) + (mapc (lambda (plist) + (let ((value (cdr (assoc property plist)))) + (when value + (setq result (if result + (concat value str result) + value))))) + plists) + result) + (until (lambda (plist) (cdr (assoc property plist))) plists))))) + (defun org-entry-get-with-inheritance (property &optional literal-nil) "Get entry property, and search higher levels if not present. The search will stop at the first ancestor which has the property defined. @@ -14189,10 +14228,11 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from (point)) (throw 'ex tmp)) (or (org-up-heading-safe) (throw 'ex nil))))))) - (setq tmp (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))) + (setq tmp (org-property-from-plists property + `((,property . ,tmp)) + org-file-properties + org-global-properties + org-global-properties-fixed)) (if literal-nil tmp (org-not-nil tmp)))) (defvar org-property-changed-functions nil -- 1.7.4.1