Fix "APPT_WARNTIME" inheritance

* lisp/org.el (org-refresh-properties): Handle inheritance from global
  values (e.g., from "#+PROPERTY:" keyword).
(org-refresh-property): Handle property inheritance with a new
optional argument.

* testing/lisp/test-org.el (test-org/refresh-properties): New test.
This commit is contained in:
Nicolas Goaziou 2017-01-27 00:21:42 +01:00
parent f2e861e0be
commit 126a1cd7c1
2 changed files with 79 additions and 19 deletions

View File

@ -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."

View File

@ -4754,6 +4754,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