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: 192 bytes --]

The attached patch implements this latest "propname+" suggestion.  When
applied it results in the behavior shown below.

I'm inclined to go with this as a solution moving forward.

Thoughts?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: something.org --]
[-- Type: text/x-org, Size: 683 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: 10799 bytes --]

From 1bb2009c419e5ae6c912e863b13cb02a1f1ea720 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.
properties with names ending in "+" accumulate rather than overwrite

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.
properties with names ending in "+" accumulate rather than overwrite

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/org.el                               |   47 +++++++++++++++-------
 testing/examples/property-inheritance.org |   36 +++++++++++++++++
 testing/lisp/test-property-inheritance.el |   62 +++++++++++++++++++++++++++++
 3 files changed, 130 insertions(+), 15 deletions(-)
 create mode 100644 testing/examples/property-inheritance.org
 create mode 100644 testing/lisp/test-property-inheritance.el

diff --git a/lisp/org.el b/lisp/org.el
index 92ced78..8739ee0 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4437,6 +4437,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)
@@ -4498,8 +4507,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
@@ -4551,8 +4561,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))
@@ -14082,17 +14093,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..b19ed6a
--- /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..6bbb0f7
--- /dev/null
+++ b/testing/lisp/test-property-inheritance.el
@@ -0,0 +1,62 @@
+;;; 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/