diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-01-27 00:29:14 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-01-27 00:29:14 +0100 |
commit | 0ba5e3508264ea59329d4cd31d3ee6eb3ba7bacf (patch) | |
tree | 8edd949106c10702667929fac7b19223d6c7d8b6 | |
parent | d2b93613ad4619d496a2bc1b8c5fe73fe710f297 (diff) | |
parent | 919e864968c14d167c512f04fd4f06f3dcf08a00 (diff) | |
download | org-mode-0ba5e3508264ea59329d4cd31d3ee6eb3ba7bacf.tar.gz |
Merge branch 'maint'
-rw-r--r-- | lisp/org.el | 74 | ||||
-rw-r--r-- | testing/lisp/test-org.el | 52 |
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 |