From mboxrd@z Thu Jan 1 00:00:00 1970 From: "William V. Wishon" Subject: [PATCH 1/2] Fix Property Inheritance Date: Tue, 25 Dec 2012 21:38:23 -0800 Message-ID: <1356500304-4525-1-git-send-email-bill@wishon.org> Return-path: Received: from eggs.gnu.org ([208.118.235.92]:39412) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TnjhJ-0001TV-85 for emacs-orgmode@gnu.org; Wed, 26 Dec 2012 00:38:35 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TnjhH-0006mf-Ip for emacs-orgmode@gnu.org; Wed, 26 Dec 2012 00:38:33 -0500 Received: from mail-pa0-f41.google.com ([209.85.220.41]:42469) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TnjhH-0006mb-9E for emacs-orgmode@gnu.org; Wed, 26 Dec 2012 00:38:31 -0500 Received: by mail-pa0-f41.google.com with SMTP id bj3so4714439pad.14 for ; Tue, 25 Dec 2012 21:38:30 -0800 (PST) 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: emacs-orgmode@gnu.org * 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)