emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[O] [PATCH 1/2] Fix Property Inheritance


From: William V. Wishon
Subject: [O] [PATCH 1/2] Fix Property Inheritance
Date: Tue, 25 Dec 2012 21:38:23 -0800

 * 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 via email to

[Prev in Thread] Current Thread [Next in Thread]