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:
parent
f2e861e0be
commit
126a1cd7c1
46
lisp/org.el
46
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."
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue