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
parent
7e93b90f88
commit
3af89e696a
21
lisp/ob.el
21
lisp/ob.el
|
|
@ -1121,17 +1121,24 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
|
|||
(flet ((matches (ch spec) (or (and (numberp spec) (= spec ch))
|
||||
(member ch spec)))
|
||||
(matched (ch last)
|
||||
(and (matches ch (cdr alts))
|
||||
(matches last (car alts)))))
|
||||
(let ((balance 0) (partial nil) (lst nil) (last 0))
|
||||
(mapc (lambda (ch) ; split on [] or () balanced instances of [ \t]:
|
||||
(if (consp alts)
|
||||
(and (matches ch (cdr alts))
|
||||
(matches last (car alts)))
|
||||
(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
|
||||
(cond ((or (equal 91 ch) (equal 40 ch)) 1)
|
||||
((or (equal 93 ch) (equal 41 ch)) -1)
|
||||
(t 0))))
|
||||
(when (and (equal 34 ch) (not (equal 92 last)))
|
||||
(setq quote (not quote)))
|
||||
(setq partial (cons ch partial))
|
||||
(when (and (= balance 0) (matched ch last))
|
||||
(setq lst (cons (apply #'string (nreverse (cddr partial)))
|
||||
(when (and (= balance 0) (not quote) (matched ch last))
|
||||
(setq lst (cons (apply #'string (nreverse
|
||||
(if (consp alts)
|
||||
(cddr partial)
|
||||
(cdr partial))))
|
||||
lst))
|
||||
(setq partial nil))
|
||||
(setq last ch))
|
||||
|
|
@ -1166,7 +1173,7 @@ shown below.
|
|||
(mapc (lambda (pair)
|
||||
(if (eq (car pair) :var)
|
||||
(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)))
|
||||
header-arguments)
|
||||
(nreverse results)))
|
||||
|
|
|
|||
47
lisp/org.el
47
lisp/org.el
|
|
@ -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
|
||||
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 ()
|
||||
"Precompute regular expressions for current buffer."
|
||||
(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 " +")))
|
||||
((equal key "PROPERTY")
|
||||
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
|
||||
(push (cons (match-string 1 value) (match-string 2 value))
|
||||
props)))
|
||||
(setq props (org-update-property-plist (match-string 1 value)
|
||||
(match-string 2 value)
|
||||
props))))
|
||||
((equal key "FILETAGS")
|
||||
(when (string-match "\\S-" value)
|
||||
(setq ftags
|
||||
|
|
@ -4552,8 +4562,9 @@ means to push this value onto the list in the variable.")
|
|||
(setq value (replace-regexp-in-string
|
||||
"[\n\r]" " " (match-string 4)))
|
||||
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
|
||||
(push (cons (match-string 1 value) (match-string 2 value))
|
||||
props))))))
|
||||
(setq props (org-update-property-plist (match-string 1 value)
|
||||
(match-string 2 value)
|
||||
props)))))))
|
||||
(org-set-local 'org-use-sub-superscripts scripts)
|
||||
(when 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)))
|
||||
(let ((range (unless (org-before-first-heading-p)
|
||||
(org-get-property-block))))
|
||||
(if (and range
|
||||
(goto-char (car range))
|
||||
(re-search-forward
|
||||
(org-re-property property)
|
||||
(cdr range) t))
|
||||
;; Found the property, return it.
|
||||
(if (match-end 1)
|
||||
(if literal-nil
|
||||
(org-match-string-no-properties 1)
|
||||
(org-not-nil (org-match-string-no-properties 1)))
|
||||
"")))))))
|
||||
(when (and range (goto-char (car range)))
|
||||
((lambda (val) (when val (if literal-nil val (org-not-nil val))))
|
||||
(cond
|
||||
((re-search-forward
|
||||
(org-re-property property) (cdr range) t)
|
||||
(if (match-end 1) (org-match-string-no-properties 1) ""))
|
||||
((re-search-forward
|
||||
(org-re-property (concat property "+")) (cdr range) t)
|
||||
(cdr (assoc
|
||||
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)
|
||||
"Check if there is a property fixing the value of VAR.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue