emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "William V. Wishon" <bill@wishon.org>
To: emacs-orgmode@gnu.org
Subject: [PATCH 1/2] Fix Property Inheritance
Date: Tue, 25 Dec 2012 21:38:23 -0800	[thread overview]
Message-ID: <1356500304-4525-1-git-send-email-bill@wishon.org> (raw)

 * org.el (org-update-property-plist): Added logic to replace the existing property value if the new value is nil or if the old value is nil.  This is to support the usage of nil as a reset in a chain of PROP+ statements.  Eg: :prop+: foo -> :prop+: nil -> :prop+: bar would result in a property value of bar.
 (org-re-property): Added an optional parameter to allow for this re to match PROP+ style properties with a new match to determine if it did have a + or not.
 (org-entry-get): Refactored the logic combining property values into a separate function org-combine-property-entries in order to re-use it in org-entry-get-with-inheritance-helper.
 (org-combine-property-entries): Refactored code from org-entry-get plus new logic to use nil as a resetting value in a chain of PROP+ declarations.  See function documentation for more info.
 (org-entry-get-with-inheritance-helper): A recursion helper function for org-entry-get-with-inheritance.  It walks up the org structure until it gets to the top, they combines properties using org-combine-property-entries as it comes back down.
 (org-entry-get-with-inheritance): Calls org-entry-get-with-inheritance helper and returns the property resulting property value.
 * property-inheritance.org: added a test for property inheritance through levels of headings in addition to the test to inherit from file wide properties.  Also added a test to reset the heirarchy value by setting a property's value to nil.

The problem here was that org-entry-get wasn't working when properties of the form PROP+ were used in multiple sub headings.  It only worked to add to file level properties.  Plus I added a way to reset the value in along the way by using :PROP+: nil.
---
 lisp/org.el                               |  118 +++++++++++++++++------------
 testing/examples/property-inheritance.org |   39 +++++++++-
 2 files changed, 109 insertions(+), 48 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 3f4c319..4684988 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4511,13 +4511,15 @@ 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."
+  "Update PROPS with KEY and VAL.
+If val is \"nil\" replace the value with nil.
+If the existing value of a property is \"nil\" then replace it with val."
   (let* ((appending (string= "+" (substring key (- (length key) 1))))
 	 (key (if appending (substring key 0 (- (length key) 1)) key))
 	 (remainder (org-remove-if (lambda (p) (string= (car p) key)) props))
 	 (previous (cdr (assoc key props))))
-    (if appending
-	(cons (cons key (if previous (concat previous " " val) val)) remainder)
+    (if (and appending (not (or (string= val "") (string= val "nil")))) ; no sense in appending an empty string, and if the value is "nil" then replace what was there.
+	(cons (cons key (if (and previous (not (string= previous "nil"))) (concat previous " " val) val)) remainder)
       (cons (cons key val) remainder))))
 
 (defconst org-block-regexp
@@ -14393,10 +14395,13 @@ Being in this list makes sure that they are offered for completion.")
 	  org-property-end-re "\\)\n?")
   "Matches an entire clock drawer.")
 
-(defsubst org-re-property (property)
+(defsubst org-re-property (property &optional include-additions)
   "Return a regexp matching a PROPERTY line.
-Match group 1 will be set to the value."
-  (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
+Match group 1 will be set to the value.
+include-additions will allow the regex to match the :PROPERTY_NAME+: form
+which adds values to defined in parent headings. If set Match group 1 will be
+the + and the value will be match group 2."
+  (concat "^[ \t]*:" (regexp-quote property) (if include-additions "\\(\\+?\\)" "") ":[ \t]*\\(\\S-.*\\)"))
 
 (defsubst org-re-property-keyword (property)
   "Return a regexp matching a PROPERTY line, possibly with no
@@ -14647,26 +14652,7 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
 	  ;; We need a special property.  Use `org-entry-properties' to
 	  ;; retrieve it, but specify the wanted property
 	  (cdr (assoc property (org-entry-properties nil 'special property)))
-	(let* ((range (org-get-property-block))
-	       (props (list (or (assoc property org-file-properties)
-				(assoc property org-global-properties)
-				(assoc property org-global-properties-fixed))))
-	       (ap (lambda (key)
-		     (when (re-search-forward
-			    (org-re-property key) (cdr range) t)
-		       (setq props
-			     (org-update-property-plist
-			      key
-			      (if (match-end 1)
-				  (org-match-string-no-properties 1) "")
-			      props)))))
-	       val)
-	  (when (and range (goto-char (car range)))
-	    (funcall ap property)
-	    (goto-char (car range))
-	    (while (funcall ap (concat property "+")))
-	    (setq val (cdr (assoc property props)))
-	    (when val (if literal-nil val (org-not-nil val)))))))))
+		(org-combine-property-entries property literal-nil)))))
 
 (defun org-property-or-variable-value (var &optional inherit)
   "Check if there is a property fixing the value of VAR.
@@ -14760,31 +14746,69 @@ no match, the marker will point nowhere.
 Note that also `org-entry-get' calls this function, if the INHERIT flag
 is set.")
 
+(defun org-combine-property-entries (property &optional literal-nil parent-props)
+  "If there are multiple definitions of the same property in a single drawer
+combine them according to the PROP and PROP+ rules and return the result.
+Eg: \":PROP:\" set properties and overwrite previous values.
+    \":PROP+:\" adds to previous values.
+parent-props is primarily for use by org-entry-get-with-inheritance when present
+it represents the properties of the parent.  If the first property in this level
+is a \":PROP+:\" type then it adds to the parent property value.
+A nil value clears the list."
+  (let ((range (unless (org-before-first-heading-p)
+		 (org-get-property-block)))
+	(props parent-props)
+	val)
+    (unless props
+      (setq props (list (or (assoc property org-file-properties)
+			    (assoc property org-global-properties)
+			    (assoc property org-global-properties-fixed)))))
+    (when range
+      (goto-char (car range))
+      (while (re-search-forward (org-re-property property t) (cdr range) t)
+	(setq props (org-update-property-plist
+		     (if (string= (org-match-string-no-properties 1) "+")
+			 (concat property "+")
+		       property)
+		     (if (match-end 2)
+			 (org-match-string-no-properties 2) "")
+		     props))))
+    (setq val (cdr (assoc property props)))
+    (when val (if literal-nil val (org-not-nil val)))))
+
+
+(defun org-entry-get-with-inheritance-helper (property &optional literal-nil)
+  (let ((current-level (org-current-level))
+	parent-props)
+    (if (or (not current-level)
+	    (equal current-level 1))
+	(list (cons property (org-combine-property-entries
+			      property
+			      literal-nil
+			      (list (or (assoc property org-file-properties)
+					(assoc property org-global-properties)
+					(assoc property org-global-properties-fixed))))))
+      (save-excursion
+	(org-up-heading-safe)
+	(setq parent-props (org-entry-get-with-inheritance-helper property literal-nil)))
+      (list (cons property (org-combine-property-entries
+			    property
+			    literal-nil
+			    parent-props))))))
+
 (defun org-entry-get-with-inheritance (property &optional literal-nil)
   "Get PROPERTY of entry or content at point, search higher levels if needed.
-The search will stop at the first ancestor which has the property defined.
+The search will stop at the first ancestor which has the property defined,
+unless that ancestor has the property defined as PROP+, in which case the search
+continues.
 If the value found is \"nil\", return nil to show that the property
 should be considered as undefined (this is the meaning of nil here).
-However, if LITERAL-NIL is set, return the string value \"nil\" instead."
-  (move-marker org-entry-property-inherited-from nil)
-  (let (tmp)
-    (save-excursion
-      (save-restriction
-	(widen)
-	(catch 'ex
-	  (while t
-	    (when (setq tmp (org-entry-get nil property nil 'literal-nil))
-	      (or (ignore-errors (org-back-to-heading t))
-		  (goto-char (point-min)))
-	      (move-marker org-entry-property-inherited-from (point))
-	      (throw 'ex tmp))
-	    (or (ignore-errors (org-up-heading-safe))
-		(throw 'ex nil))))))
-    (setq tmp (or tmp
-		  (cdr (assoc property org-file-properties))
-		  (cdr (assoc property org-global-properties))
-		  (cdr (assoc property org-global-properties-fixed))))
-    (if literal-nil tmp (org-not-nil tmp))))
+However, if LITERAL-NIL is set, return the string value \"nil\" instead.
+If the value found is \"nil\" in a chain of PROP+ additive property definitions
+then nil stops the search up the heirarchy and returns what's been found so far.
+In a chain of PROP+ statements saying \":PROP+: nil\" is as a way to reset the
+value list."
+  (cdr (assoc property (org-entry-get-with-inheritance-helper property literal-nil))))
 
 (defvar org-property-changed-functions nil
   "Hook called when the value of a property has changed.
diff --git a/testing/examples/property-inheritance.org b/testing/examples/property-inheritance.org
index de5b539..477e25f 100644
--- a/testing/examples/property-inheritance.org
+++ b/testing/examples/property-inheritance.org
@@ -21,7 +21,6 @@
 #+begin_src emacs-lisp
   (org-entry-get (point) "var" t)
 #+end_src
-
 * appending to a file-wide property
   :PROPERTIES:
   :var+:      baz=3
@@ -34,3 +33,41 @@
 #+begin_src emacs-lisp
   (org-entry-get (point) "var" t)
 #+end_src
+* hierarchy test
+:PROPERTIES:
+:var+: boo=2
+:END:
+** appending to a parent property
+  :PROPERTIES:
+  :var+:      baz=3
+  :END:
+
+#+begin_src emacs-lisp
+  (+ foo bar boo baz)
+#+end_src
+
+#+begin_src emacs-lisp
+  (org-entry-get (point) "var" t)
+#+end_src
+** resetting a parent property
+  :PROPERTIES:
+  :var+:       nil
+  :END:
+#+begin_src emacs-lisp
+  (+ foo bar baz)
+#+end_src
+
+#+begin_src emacs-lisp
+  (org-entry-get (point) "var" t t)
+#+end_src
+*** setting a new property value
+:PROPERTIES:
+:var+: bat=5
+:END:
+#+begin_src emacs-lisp
+  (+ foo bar baz)
+#+end_src
+
+#+begin_src emacs-lisp
+  (org-entry-get (point) "var" t)
+#+end_src
-- 
1.7.10.2 (Apple Git-33)

             reply	other threads:[~2012-12-26  5:38 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2012-12-26  5:38 William V. Wishon [this message]
2012-12-26  5:38 ` [PATCH 2/2] Updates to test cases William V. Wishon

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1356500304-4525-1-git-send-email-bill@wishon.org \
    --to=bill@wishon.org \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).