diff --git a/lisp/org.el b/lisp/org.el index ff11c0388..c9ee2abdc 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -9735,31 +9735,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) - (inhibit-read-only t)) + (let* ((case-fold-search 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 - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) - (org-refresh-property tprop (match-string-no-properties 1))))))) + (org-with-point-at 1 + ;; Set global values (e.g., values defined through + ;; "#+PROPERTY:" keywords) to the whole buffer. + (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) - ;; TPROP is a text property symbol - (put-text-property - (point) (or (outline-next-heading) (point-max)) tprop p) - ;; TPROP is an alist with (properties . function) elements - (dolist (al tprop) - (save-excursion - (put-text-property - (line-beginning-position) (or (outline-next-heading) (point-max)) - (car al) - (funcall (cdr al) p)))))))) + (let ((start (point)) + (end (save-excursion + (if inherit (org-end-of-subtree t t) + (or (outline-next-heading) (point-max)))))) + (if (symbolp tprop) + ;; TPROP is a text property symbol. + (put-text-property start end tprop p) + ;; TPROP is an alist with (property . function) elements. + (pcase-dolist (`(,p . ,f) tprop) + (put-text-property start end p (funcall f p)))))))) (defun org-refresh-category-properties () "Refresh category text properties in the buffer." diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index b4bcaae24..45d30a65d 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -4754,6 +4754,58 @@ Paragraph" (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** 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* 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* 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* 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