Merge branch 'maint'

lisp/org.el

@@ -3828,14 +3828,14 @@ in this variable)."
 	  (regexp :tag "Properties matched by regexp")))
 
 (defun org-property-inherit-p (property)
-  "Check if PROPERTY is one that should be inherited."
+  "Return a non-nil value if PROPERTY should be inherited."
   (cond
    ((eq org-use-property-inheritance t) t)
    ((not org-use-property-inheritance) nil)
    ((stringp org-use-property-inheritance)
     (string-match org-use-property-inheritance property))
    ((listp org-use-property-inheritance)
-    (member property org-use-property-inheritance))
+    (member-ignore-case property org-use-property-inheritance))
    (t (error "Invalid setting of `org-use-property-inheritance'"))))
 
 (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
@@ -9646,31 +9646,39 @@ DPROP is the drawer property and TPROP is either the
 corresponding text property to set, or an alist with each element
 being a text property (as a symbol) and a function to apply to
 the value of the drawer property."
-  (let ((case-fold-search t)
+  (let* ((case-fold-search t)
-	(inhibit-read-only t))
+	 (inhibit-read-only t)
+	 (inherit? (org-property-inherit-p dprop))
+	 (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t))
+	 (global (and inherit? (org--property-global-value dprop nil))))
     (org-with-silent-modifications
-     (org-with-wide-buffer
+     (org-with-point-at 1
-      (goto-char (point-min))
+       ;; Set global values (e.g., values defined through
-      (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
+       ;; "#+PROPERTY:" keywords) to the whole buffer.
-	(org-refresh-property tprop (match-string-no-properties 1)))))))
+       (when global (put-text-property (point-min) (point-max) tprop global))
+       ;; Set local values.
+       (while (re-search-forward property-re nil t)
+	 (when (org-at-property-p)
+	   (org-refresh-property tprop (org-entry-get (point) dprop) inherit?))
+	 (outline-next-heading))))))
 
-(defun org-refresh-property (tprop p)
+(defun org-refresh-property (tprop p &optional inherit)
   "Refresh the buffer text property TPROP from the drawer property P.
-The refresh happens only for the current tree (not subtree)."
+The refresh happens only for the current headline, or the whole
+sub-tree if optional argument INHERIT is non-nil."
   (unless (org-before-first-heading-p)
     (save-excursion
       (org-back-to-heading t)
-      (if (symbolp tprop)
+      (let ((start (point))
-	  ;; TPROP is a text property symbol
+	    (end (save-excursion
-	  (put-text-property
+		   (if inherit (org-end-of-subtree t t)
-	   (point) (or (outline-next-heading) (point-max)) tprop p)
+		     (or (outline-next-heading) (point-max))))))
-	;; TPROP is an alist with (properties . function) elements
+	(if (symbolp tprop)
-	(dolist (al tprop)
+	    ;; TPROP is a text property symbol.
-	  (save-excursion
+	    (put-text-property start end tprop p)
-	    (put-text-property
+	  ;; TPROP is an alist with (property . function) elements.
-	     (line-beginning-position) (or (outline-next-heading) (point-max))
+	  (pcase-dolist (`(,p . ,f) tprop)
-	     (car al)
+	    (put-text-property start end p (funcall f p))))))))
-	     (funcall (cdr al) p))))))))
 
 (defun org-refresh-category-properties ()
   "Refresh category text properties in the buffer."
@@ -15904,7 +15912,7 @@ strings."
 	  ;; Return value.
 	  props)))))
 
-(defun org-property--local-values (property literal-nil)
+(defun org--property-local-values (property literal-nil)
   "Return value for PROPERTY in current entry.
 Value is a list whose car is the base value for PROPERTY and cdr
 a list of accumulated values.  Return nil if neither is found in
@@ -15929,6 +15937,17 @@ unless LITERAL-NIL is non-nil."
 	;; Return final values.
 	(and (not (equal value '(nil))) (nreverse value))))))
 
+(defun org--property-global-value (property literal-nil)
+  "Return value for PROPERTY in current buffer.
+Return value is a string.  Return nil if property is not set
+globally.  Also return nil when PROPERTY is set to \"nil\",
+unless LITERAL-NIL is non-nil."
+  (let ((global
+	 (cdr (or (assoc-string property org-file-properties t)
+		  (assoc-string property org-global-properties t)
+		  (assoc-string property org-global-properties-fixed t)))))
+    (if literal-nil global (org-not-nil global))))
+
 (defun org-entry-get (pom property &optional inherit literal-nil)
   "Get value of PROPERTY for entry or content at point-or-marker POM.
 
@@ -15956,7 +15975,7 @@ value higher up the hierarchy."
 	   (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
       (org-entry-get-with-inheritance property literal-nil))
      (t
-      (let* ((local (org-property--local-values property literal-nil))
+      (let* ((local (org--property-local-values property literal-nil))
 	     (value (and local (mapconcat #'identity (delq nil local) " "))))
 	(if literal-nil value (org-not-nil value)))))))
 
@@ -16068,7 +16087,7 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead."
    (let (value)
      (catch 'exit
        (while t
-	 (let ((v (org-property--local-values property literal-nil)))
+	 (let ((v (org--property-local-values property literal-nil)))
 	   (when v
 	     (setq value
 		   (concat (mapconcat #'identity (delq nil v) " ")
@@ -16081,10 +16100,7 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead."
 	     (throw 'exit nil))
 	    ((org-up-heading-safe))
 	    (t
-	     (let ((global
+	     (let ((global (org--property-global-value property literal-nil)))
-		    (cdr (or (assoc-string property org-file-properties t)
-			     (assoc-string property org-global-properties t)
-			     (assoc-string property org-global-properties-fixed t)))))
 	       (cond ((not global))
 		     (value (setq value (concat global " " value)))
 		     (t (setq value global))))

testing/lisp/test-org.el

@@ -4831,6 +4831,58 @@ Paragraph<point>"
 		   (org-entry-put (point) "A" "1")
 		   (buffer-string)))))
 
+(ert-deftest test-org/refresh-properties ()
+  "Test `org-refresh-properties' specifications."
+  (should
+   (equal "1"
+	  (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:"
+	    (org-refresh-properties "A" 'org-test)
+	    (get-text-property (point) 'org-test))))
+  (should-not
+   (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:"
+     (org-refresh-properties "B" 'org-test)
+     (get-text-property (point) 'org-test)))
+  ;; Handle properties only defined with extension syntax, i.e.,
+  ;; "PROPERTY+".
+  (should
+   (equal "1"
+	  (org-test-with-temp-text "* H\n:PROPERTIES:\n:A+: 1\n:END:"
+	    (org-refresh-properties "A" 'org-test)
+	    (get-text-property (point) 'org-test))))
+  ;; When property is inherited, add text property to the whole
+  ;; sub-tree.
+  (should
+   (equal "1"
+	  (org-test-with-temp-text
+	      "* H1\n:PROPERTIES:\n:A: 1\n:END:\n<point>** H2"
+	    (let ((org-use-property-inheritance t))
+	      (org-refresh-properties "A" 'org-test))
+	    (get-text-property (point) 'org-test))))
+  ;; When property is inherited, use global value across the whole
+  ;; buffer.  However local values have precedence.
+  (should-not
+   (equal "1"
+	  (org-test-with-temp-text "#+PROPERTY: A 1\n<point>* H1"
+	    (org-mode-restart)
+	    (let ((org-use-property-inheritance nil))
+	      (org-refresh-properties "A" 'org-test))
+	    (get-text-property (point) 'org-test))))
+  (should
+   (equal "1"
+	  (org-test-with-temp-text "#+PROPERTY: A 1\n<point>* H1"
+	    (org-mode-restart)
+	    (let ((org-use-property-inheritance t))
+	      (org-refresh-properties "A" 'org-test))
+	    (get-text-property (point) 'org-test))))
+  (should
+   (equal "2"
+	  (org-test-with-temp-text
+	      "#+PROPERTY: A 1\n<point>* H\n:PROPERTIES:\n:A: 2\n:END:"
+	    (org-mode-restart)
+	    (let ((org-use-property-inheritance t))
+	      (org-refresh-properties "A" 'org-test))
+	    (get-text-property (point) 'org-test)))))
+
 
 ;;; Radio Targets