property names ending in plus accumulate

This results 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

  * overwriting a file-wide property
    :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=7

  * appending to a file-wide property
    :PROPERTIES:
    :var+:      baz=3
    :END:

  #+begin_src emacs-lisp
    (+ foo bar baz)
  #+end_src

  #+results:
  : 6

  #+begin_src emacs-lisp
    (org-entry-get (point) "var" t)
  #+end_src

  #+results:
  : foo=1 bar=2 baz=3

* lisp/org.el (org-update-property-plist): Updates a given property
  list with a property name and a property value.
  (org-set-regexps-and-options): Use org-update-property-plist.
  (org-entry-get): Use org-update-property-plist.
* testing/examples/property-inheritance.org: Example file for testing
  appending property behavior.
* testing/lisp/test-property-inheritance.el: Tests of appending
  property behavior.
* lisp/ob.el (org-babel-balanced-split): Allow splitting on single
  characters as well as groups of two characters.
  (org-babel-parse-multiple-vars): Split variables on single spaces.
This commit is contained in:
Eric Schulte 2011-11-07 14:49:42 -07:00
parent 7e93b90f88
commit 3af89e696a
4 changed files with 143 additions and 22 deletions

View File

@ -1121,17 +1121,24 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
(flet ((matches (ch spec) (or (and (numberp spec) (= spec ch)) (flet ((matches (ch spec) (or (and (numberp spec) (= spec ch))
(member ch spec))) (member ch spec)))
(matched (ch last) (matched (ch last)
(and (matches ch (cdr alts)) (if (consp alts)
(matches last (car alts))))) (and (matches ch (cdr alts))
(let ((balance 0) (partial nil) (lst nil) (last 0)) (matches last (car alts)))
(mapc (lambda (ch) ; split on [] or () balanced instances of [ \t]: (matches ch alts))))
(let ((balance 0) (quote nil) (partial nil) (lst nil) (last 0))
(mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
(setq balance (+ balance (setq balance (+ balance
(cond ((or (equal 91 ch) (equal 40 ch)) 1) (cond ((or (equal 91 ch) (equal 40 ch)) 1)
((or (equal 93 ch) (equal 41 ch)) -1) ((or (equal 93 ch) (equal 41 ch)) -1)
(t 0)))) (t 0))))
(when (and (equal 34 ch) (not (equal 92 last)))
(setq quote (not quote)))
(setq partial (cons ch partial)) (setq partial (cons ch partial))
(when (and (= balance 0) (matched ch last)) (when (and (= balance 0) (not quote) (matched ch last))
(setq lst (cons (apply #'string (nreverse (cddr partial))) (setq lst (cons (apply #'string (nreverse
(if (consp alts)
(cddr partial)
(cdr partial))))
lst)) lst))
(setq partial nil)) (setq partial nil))
(setq last ch)) (setq last ch))
@ -1166,7 +1173,7 @@ shown below.
(mapc (lambda (pair) (mapc (lambda (pair)
(if (eq (car pair) :var) (if (eq (car pair) :var)
(mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
(org-babel-balanced-split (cdr pair) '(44 . (32 9)))) (org-babel-balanced-split (cdr pair) 32))
(push pair results))) (push pair results)))
header-arguments) header-arguments)
(nreverse results))) (nreverse results)))

View File

@ -4438,6 +4438,15 @@ 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 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.") means to push this value onto the list in the variable.")
(defun org-update-property-plist (key val props)
"Update PROPS with KEY and VAL."
(if (string= "+" (substring key (- (length key) 1)))
(let* ((key (substring key 0 (- (length key) 1)))
(previous (cdr (assoc key props))))
(cons (cons key (concat previous " " val))
(org-remove-if (lambda (p) (string= (car p) key)) props)))
(cons (cons key val) props)))
(defun org-set-regexps-and-options () (defun org-set-regexps-and-options ()
"Precompute regular expressions for current buffer." "Precompute regular expressions for current buffer."
(when (eq major-mode 'org-mode) (when (eq major-mode 'org-mode)
@ -4499,8 +4508,9 @@ means to push this value onto the list in the variable.")
(setq prio (org-split-string value " +"))) (setq prio (org-split-string value " +")))
((equal key "PROPERTY") ((equal key "PROPERTY")
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
(push (cons (match-string 1 value) (match-string 2 value)) (setq props (org-update-property-plist (match-string 1 value)
props))) (match-string 2 value)
props))))
((equal key "FILETAGS") ((equal key "FILETAGS")
(when (string-match "\\S-" value) (when (string-match "\\S-" value)
(setq ftags (setq ftags
@ -4552,8 +4562,9 @@ means to push this value onto the list in the variable.")
(setq value (replace-regexp-in-string (setq value (replace-regexp-in-string
"[\n\r]" " " (match-string 4))) "[\n\r]" " " (match-string 4)))
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
(push (cons (match-string 1 value) (match-string 2 value)) (setq props (org-update-property-plist (match-string 1 value)
props)))))) (match-string 2 value)
props)))))))
(org-set-local 'org-use-sub-superscripts scripts) (org-set-local 'org-use-sub-superscripts scripts)
(when cat (when cat
(org-set-local 'org-category (intern cat)) (org-set-local 'org-category (intern cat))
@ -14080,17 +14091,23 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
(cdr (assoc property (org-entry-properties nil 'special property))) (cdr (assoc property (org-entry-properties nil 'special property)))
(let ((range (unless (org-before-first-heading-p) (let ((range (unless (org-before-first-heading-p)
(org-get-property-block)))) (org-get-property-block))))
(if (and range (when (and range (goto-char (car range)))
(goto-char (car range)) ((lambda (val) (when val (if literal-nil val (org-not-nil val))))
(re-search-forward (cond
(org-re-property property) ((re-search-forward
(cdr range) t)) (org-re-property property) (cdr range) t)
;; Found the property, return it. (if (match-end 1) (org-match-string-no-properties 1) ""))
(if (match-end 1) ((re-search-forward
(if literal-nil (org-re-property (concat property "+")) (cdr range) t)
(org-match-string-no-properties 1) (cdr (assoc
(org-not-nil (org-match-string-no-properties 1))) property
""))))))) (org-update-property-plist
(concat property "+")
(if (match-end 1) (org-match-string-no-properties 1) "")
(list (or (assoc property org-file-properties)
(assoc property org-global-properties)
(assoc property org-global-properties-fixed)
))))))))))))))
(defun org-property-or-variable-value (var &optional inherit) (defun org-property-or-variable-value (var &optional inherit)
"Check if there is a property fixing the value of VAR. "Check if there is a property fixing the value of VAR.

View File

@ -0,0 +1,36 @@
#+property: var foo=1
#+property: var+ bar=2
#+begin_src emacs-lisp
(+ foo bar)
#+end_src
#+begin_src emacs-lisp
(org-entry-get (point) "var" t)
#+end_src
* overwriting a file-wide property
:PROPERTIES:
:var: foo=7
:END:
#+begin_src emacs-lisp
foo
#+end_src
#+begin_src emacs-lisp
(org-entry-get (point) "var" t)
#+end_src
* appending to a file-wide property
:PROPERTIES:
:var+: baz=3
:END:
#+begin_src emacs-lisp
(+ foo bar baz)
#+end_src
#+begin_src emacs-lisp
(org-entry-get (point) "var" t)
#+end_src

View File

@ -0,0 +1,61 @@
;;; test-ob-R.el --- tests for ob-R.el
;; Copyright (c) 2011 Eric Schulte
;; Authors: Eric Schulte
;; Released under the GNU General Public License version 3
;; see: http://www.gnu.org/licenses/gpl-3.0.html
(let ((load-path (cons (expand-file-name
".." (file-name-directory
(or load-file-name buffer-file-name)))
load-path)))
(require 'org-test)
(require 'org-test-ob-consts))
(defmacro test-org-in-property-buffer (&rest body)
`(with-temp-buffer
(insert-file-contents (expand-file-name "property-inheritance.org"
org-test-example-dir))
(org-mode)
,@body))
(ert-deftest test-org-property-accumulation-top-use ()
(test-org-in-property-buffer
(goto-char (point-min))
(org-babel-next-src-block 1)
(should (equal 3 (org-babel-execute-src-block)))))
(ert-deftest test-org-property-accumulation-top-val ()
(test-org-in-property-buffer
(goto-char (point-min))
(org-babel-next-src-block 2)
(should (string= "foo=1 bar=2" (org-babel-execute-src-block)))))
(ert-deftest test-org-property-accumulation-overwrite-use ()
(test-org-in-property-buffer
(goto-char (point-min))
(org-babel-next-src-block 3)
(should (= 7 (org-babel-execute-src-block)))))
(ert-deftest test-org-property-accumulation-overwrite-val ()
(test-org-in-property-buffer
(goto-char (point-min))
(org-babel-next-src-block 4)
(should (string= "foo=7" (org-babel-execute-src-block)))))
(ert-deftest test-org-property-accumulation-append-use ()
(test-org-in-property-buffer
(goto-char (point-min))
(org-babel-next-src-block 5)
(should (= 6 (org-babel-execute-src-block)))))
(ert-deftest test-org-property-accumulation-append-val ()
(test-org-in-property-buffer
(goto-char (point-min))
(org-babel-next-src-block 6)
(should (string= "foo=1 bar=2 baz=3" (org-babel-execute-src-block)))))
(provide 'test-ob-R)
;;; test-ob-R.el ends here