summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-01-27 00:29:14 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-01-27 00:29:14 +0100
commit0ba5e3508264ea59329d4cd31d3ee6eb3ba7bacf (patch)
tree8edd949106c10702667929fac7b19223d6c7d8b6
parentd2b93613ad4619d496a2bc1b8c5fe73fe710f297 (diff)
parent919e864968c14d167c512f04fd4f06f3dcf08a00 (diff)
downloadorg-mode-0ba5e3508264ea59329d4cd31d3ee6eb3ba7bacf.tar.gz
Merge branch 'maint'
-rw-r--r--lisp/org.el74
-rw-r--r--testing/lisp/test-org.el52
2 files changed, 97 insertions, 29 deletions
diff --git a/lisp/org.el b/lisp/org.el
index f2434fb..3ef8378 100644
--- a/lisp/org.el
+++ b/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)
- (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)))))))
-
-(defun org-refresh-property (tprop p)
+ (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 &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."
@@ -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
- (cdr (or (assoc-string property org-file-properties t)
- (assoc-string property org-global-properties t)
- (assoc-string property org-global-properties-fixed t)))))
+ (let ((global (org--property-global-value property literal-nil)))
(cond ((not global))
(value (setq value (concat global " " value)))
(t (setq value global))))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index f1dddd4..7949710 100644
--- a/testing/lisp/test-org.el
+++ b/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