Re: About commit named "Allow multi-line properties to be specified in property blocks"

[Eric Schulte <schulte.eric@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 482 bytes --]

> Perhaps inserting an assumed space separator would be more intuitive?
> If we were to go that way it may be possible to allow variable
> specifications such as
>
> #+PROPERTY: var foo=1 bar=2
>
> in which case properties could be easily specified on multiple lines
> using a default space separator.
>
> If this seems like a good way to go I can try to update my previous
> patch.
>

I've updated the patch, the newest version is attached.  It results in
the following behavior.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: something.org --]
[-- Type: text/x-org, Size: 674 bytes --]

#+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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-property-names-ending-in-plus-accumulate.patch --]
[-- Type: text/x-diff, Size: 9865 bytes --]

From 2a4bc429a38470b71baabf73d160359f8f87c9de Mon Sep 17 00:00:00 2001
From: Eric Schulte <schulte.eric@gmail.com>
Date: Mon, 7 Nov 2011 14:49:42 -0700
Subject: [PATCH] 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.
---
 lisp/ob.el                                |   13 ++++--
 lisp/org.el                               |   47 +++++++++++++++-------
 testing/examples/property-inheritance.org |   36 +++++++++++++++++
 testing/lisp/test-property-inheritance.el |   61 +++++++++++++++++++++++++++++
 4 files changed, 138 insertions(+), 19 deletions(-)
 create mode 100644 testing/examples/property-inheritance.org
 create mode 100644 testing/lisp/test-property-inheritance.el

diff --git a/lisp/ob.el b/lisp/ob.el
index d94b4b6..a1526bc 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -1118,8 +1118,10 @@ 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)))))
+		  (if (consp alts)
+		      (and (matches ch (cdr alts))
+			   (matches last (car alts)))
+		    (matches ch alts))))
     (let ((balance 0) (partial nil) (lst nil) (last 0))
       (mapc (lambda (ch)  ; split on [] or () balanced instances of [ \t]:
 	      (setq balance (+ balance
@@ -1128,7 +1130,10 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
 				     (t 0))))
 	      (setq partial (cons ch partial))
 	      (when (and (= balance 0) (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))
 		(setq partial nil))
 	      (setq last ch))
@@ -1163,7 +1168,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)))
diff --git a/lisp/org.el b/lisp/org.el
index 5c4ea33..d74e994 100644
--- a/lisp/org.el
+++ b/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))
@@ -14083,17 +14094,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.
diff --git a/testing/examples/property-inheritance.org b/testing/examples/property-inheritance.org
new file mode 100644
index 0000000..de5b539
--- /dev/null
+++ b/testing/examples/property-inheritance.org
@@ -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
diff --git a/testing/lisp/test-property-inheritance.el b/testing/lisp/test-property-inheritance.el
new file mode 100644
index 0000000..60e955d
--- /dev/null
+++ b/testing/lisp/test-property-inheritance.el
@@ -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
-- 
1.7.4.1


[-- Attachment #4: Type: text/plain, Size: 47 bytes --]


-- 
Eric Schulte
http://cs.unm.edu/~eschulte/