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:
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))
|
(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)))
|
||||||
|
|
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
|
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.
|
||||||
|
|
|
@ -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