* [PATCH 1/2] Fix Property Inheritance
@ 2012-12-26 5:38 William V. Wishon
2012-12-26 5:38 ` [PATCH 2/2] Updates to test cases William V. Wishon
0 siblings, 1 reply; 2+ messages in thread
From: William V. Wishon @ 2012-12-26 5:38 UTC (permalink / raw)
To: emacs-orgmode
* 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)
^ permalink raw reply related [flat|nested] 2+ messages in thread
* [PATCH 2/2] Updates to test cases
2012-12-26 5:38 [PATCH 1/2] Fix Property Inheritance William V. Wishon
@ 2012-12-26 5:38 ` William V. Wishon
0 siblings, 0 replies; 2+ messages in thread
From: William V. Wishon @ 2012-12-26 5:38 UTC (permalink / raw)
To: emacs-orgmode
* property-inheritance.org: Updated test cases to include expected outcomes. Adjusted the numeric values to be in order. Removed irrelevant addition tests.
---
testing/examples/property-inheritance.org | 16 ++++++----------
1 file changed, 6 insertions(+), 10 deletions(-)
diff --git a/testing/examples/property-inheritance.org b/testing/examples/property-inheritance.org
index 477e25f..f2c68e2 100644
--- a/testing/examples/property-inheritance.org
+++ b/testing/examples/property-inheritance.org
@@ -35,17 +35,19 @@
#+end_src
* hierarchy test
:PROPERTIES:
-:var+: boo=2
+:var+: boo=2.5
:END:
** appending to a parent property
:PROPERTIES:
:var+: baz=3
:END:
+The result should be 8.5
#+begin_src emacs-lisp
(+ foo bar boo baz)
#+end_src
+The result should be "foo=1 bar=2 boo=2.5 baz=3"
#+begin_src emacs-lisp
(org-entry-get (point) "var" t)
#+end_src
@@ -53,21 +55,15 @@
:PROPERTIES:
:var+: nil
:END:
-#+begin_src emacs-lisp
- (+ foo bar baz)
-#+end_src
-
+The result should be "nil"
#+begin_src emacs-lisp
(org-entry-get (point) "var" t t)
#+end_src
*** setting a new property value
:PROPERTIES:
-:var+: bat=5
+:var+: bat=4
:END:
-#+begin_src emacs-lisp
- (+ foo bar baz)
-#+end_src
-
+The result should be "bat=4"
#+begin_src emacs-lisp
(org-entry-get (point) "var" t)
#+end_src
--
1.7.10.2 (Apple Git-33)
^ permalink raw reply related [flat|nested] 2+ messages in thread
end of thread, other threads:[~2012-12-26 5:38 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-12-26 5:38 [PATCH 1/2] Fix Property Inheritance William V. Wishon
2012-12-26 5:38 ` [PATCH 2/2] Updates to test cases William V. Wishon
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).