From mboxrd@z Thu Jan 1 00:00:00 1970 From: Eric Schulte Subject: Re: About commit named "Allow multi-line properties to be specified in property blocks" Date: Mon, 07 Nov 2011 15:09:37 -0700 Message-ID: <87ty6ffuu6.fsf@gmail.com> References: <87vcr5c76e.fsf@gmail.com> <87vcr5j5a5.fsf@gmail.com> <4EAF118C.8050806@christianmoe.com> <87hb2mo7ek.fsf@altern.org> <87obwuh19t.fsf@gmail.com> <87hb2mdmi9.fsf@gnu.org> <87obwtgip9.fsf@gmail.com> <87sjm5ez0f.fsf@gmail.com> <4eb42564.059dec0a.5ffc.7ff5@mx.google.com> <877h3felm2.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([140.186.70.92]:56589) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RNWRu-0005kj-Ra for emacs-orgmode@gnu.org; Mon, 07 Nov 2011 16:09:48 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RNWRs-0002zh-Q0 for emacs-orgmode@gnu.org; Mon, 07 Nov 2011 16:09:46 -0500 Received: from mail-qy0-f169.google.com ([209.85.216.169]:37441) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RNWRs-0002zV-Md for emacs-orgmode@gnu.org; Mon, 07 Nov 2011 16:09:44 -0500 Received: by qyk31 with SMTP id 31so3181600qyk.0 for ; Mon, 07 Nov 2011 13:09:44 -0800 (PST) In-Reply-To: <877h3felm2.fsf@gmail.com> (Eric Schulte's message of "Fri, 04 Nov 2011 13:25:09 -0600") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Eric Schulte Cc: mail@christianmoe.com, Nicolas Goaziou , Org Mode List , Bastien --=-=-= Content-Type: text/plain 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? --=-=-= Content-Type: text/x-org Content-Disposition: inline; filename=something.org #+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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-property-names-ending-in-plus-accumulate.patch >From 1bb2009c419e5ae6c912e863b13cb02a1f1ea720 Mon Sep 17 00:00:00 2001 From: Eric Schulte 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 --=-=-= Content-Type: text/plain -- Eric Schulte http://cs.unm.edu/~eschulte/ --=-=-=--