From fbe56f89f75a8979e0ba48001a822518df2c66fe Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 18 Apr 2018 17:28:52 +0200 Subject: [PATCH] Change `org-get-tags' specifications * lisp/org.el (org-tag-line-re): New variable. (org-hide-archived-subtrees): (org-get-buffer-tags): Use new function. (org--get-local-tags): New function. (org-get-tags): Change meaning. Now get all inherited tags. Change signature. * lisp/org-archive.el (org-archive-subtree): * lisp/org-mobile.el (org-mobile-apply): (org-mobile-edit): * lisp/org-mouse.el (org-mouse-tag-menu): * lisp/org-pcomplete.el (pcomplete/org-mode/tag): Apply change * testing/lisp/test-org.el (test-org/get-tags): New test. (test-org/tags-at): Remove test. --- etc/ORG-NEWS | 8 +++++ lisp/org-archive.el | 12 +++++-- lisp/org-mobile.el | 4 +-- lisp/org-mouse.el | 2 +- lisp/org-pcomplete.el | 2 +- lisp/org.el | 59 +++++++++++++++++++++++------- lisp/ox-beamer.el | 2 +- testing/lisp/test-org.el | 77 +++++++++++++++++++++++++++++++++++++--- 8 files changed, 141 insertions(+), 25 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 6a4fe40f0..abebe08fe 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -106,6 +106,14 @@ document, use =shrink= value instead, or in addition to align: ,#+STARTUP: align shrink #+END_EXAMPLE +*** ~org-get-tags~ meaning change + +Function ~org-get-tags~ used to return local tags to the current +headline. It now returns the all the inherited tags in addition to +the local tags. In order to get the old behaviour back, you can use: + +: (org-get-tags nil t) + *** Alphabetic sorting in tables and lists When sorting alphabetically, ~org-table-sort-lines~ and ~org-sort-list~ diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 2fcf0b23f..ca41616bc 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -271,9 +271,15 @@ direct children of this heading." (org-back-to-heading t) ;; Get context information that will be lost by moving the ;; tree. See `org-archive-save-context-info'. - (let* ((all-tags (org-get-tags-at)) - (local-tags (org-get-tags)) - (inherited-tags (org-delete-all local-tags all-tags)) + (let* ((all-tags (org-get-tags)) + (local-tags + (cl-remove-if (lambda (tag) + (get-text-property 0 'inherited tag)) + all-tags)) + (inherited-tags + (cl-remove-if-not (lambda (tag) + (get-text-property 0 'inherited tag)) + all-tags)) (context `((category . ,(org-get-category nil 'force-refresh)) (file . ,file) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index ecfd6f113..28b1157fe 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -874,7 +874,7 @@ If BEG and END are given, only do this in that region." (funcall cmd data old new) (unless (member data '("delete" "archive" "archive-sibling" "addheading")) - (when (member "FLAGGED" (org-get-tags)) + (when (member "FLAGGED" (org-get-tags nil t)) (add-to-list 'org-mobile-last-flagged-files (buffer-file-name))))) (error (setq org-mobile-error msg))) @@ -999,7 +999,7 @@ be returned that indicates what went wrong." old current)))) ((eq what 'tags) - (setq current (org-get-tags) + (setq current (org-get-tags nil t) new1 (and new (org-split-string new ":+")) old1 (and old (org-split-string old ":+"))) (cond diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index a79cd0057..b17a7b58f 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -422,7 +422,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-tag-menu () ;todo "Create the tags menu." (append - (let ((tags (org-get-tags))) + (let ((tags (org-get-tags nil t))) (org-mouse-keyword-menu (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) `(lambda (tag) diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 0f1d1879c..536130d88 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -327,7 +327,7 @@ This needs more work, to handle headings with lots of spaces in them." (mapcar (lambda (x) (org-string-nw-p (car x))) org-current-tag-alist)) (mapcar #'car (org-get-buffer-tags)))))) - (dolist (tag (org-get-tags)) + (dolist (tag (org-get-tags nil t)) (setq lst (delete tag lst))) lst)) (and (string-match ".*:" pcomplete-stub) diff --git a/lisp/org.el b/lisp/org.el index aee053ec4..77c6a1a47 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -520,6 +520,12 @@ but the stars and the body are.") An archived subtree does not open during visibility cycling, and does not contribute to the agenda listings.") +(defconst org-tag-line-re + "^\\*+ \\(?:.*[ \t]\\)?\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$" + "Regexp matching tags in a headline. +Tags are stored in match group 1. Match group 2 stores the tags +without the enclosing colons.") + (eval-and-compile (defconst org-comment-string "COMMENT" "Entries starting with this keyword will never be exported. @@ -4621,7 +4627,7 @@ STATE should be one of the symbols listed in the docstring of ;; Include headline point is currently on. (beginning-of-line) (while (and (< (point) end) (re-search-forward re end t)) - (when (member org-archive-tag (org-get-tags)) + (when (member org-archive-tag (org-get-tags nil t)) (org-flag-subtree t) (org-end-of-subtree t)))))) @@ -14713,21 +14719,48 @@ Returns the new tags string, or nil to not change the current settings." (match-string-no-properties 1) ""))) -(defun org-get-tags () - "Get the list of tags specified in the current headline." - (org-split-string (org-get-tags-string) ":")) +(defun org--get-local-tags () + "Return list of tags for the current headline. +Assume point is at the beginning of the headline." + (and (looking-at org-tag-line-re) + (split-string (match-string-no-properties 2) ":" t))) + +(defun org-get-tags (&optional pos local) + "Get the list of tags specified in the current headline. + +When argument POS is non-nil, retrieve tags for headline at POS. + +Accoring to `org-use-tags-inheritance', tags may be inherited +from parent headlines, and from the whole document, through +`org-file-tags'. However, when optional argument LOCAL is +non-nil, only return tags really specified in the considered +headline. + +Inherited tags have the `inherited' text property." + (if (and org-trust-scanner-tags + (or (not pos) (eq pos (point))) + (not local)) + org-scanner-tags + (org-with-point-at (or pos (point)) + (unless (org-before-first-heading-p) + (org-back-to-heading t) + (let ((tags (org--get-local-tags))) + (if (or local (not org-use-tag-inheritance)) tags + (while (org-up-heading-safe) + (setq tags (append (mapcar #'org-add-prop-inherited + (org--get-local-tags)) + tags))) + (org-remove-uninherited-tags + (delete-dups (append org-file-tags tags))))))))) (defun org-get-buffer-tags () "Get a table of all tags used in the buffer, for completion." - (org-with-wide-buffer - (goto-char (point-min)) - (let ((tag-re (concat org-outline-regexp-bol - "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) - tags) - (while (re-search-forward tag-re nil t) - (dolist (tag (org-split-string (match-string-no-properties 1) ":")) - (push tag tags))) - (mapcar #'list (append org-file-tags (org-uniquify tags)))))) + (org-with-point-at 1 + (let (tags) + (while (re-search-forward org-tag-line-re nil t) + (setq tags (nconc (split-string (match-string-no-properties 2) ":") + tags))) + (mapcar #'list (delete-dups (append org-file-tags tags)))))) ;;;; The mapping API diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index 15b78dcdb..38c353080 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -914,7 +914,7 @@ value." (org-back-to-heading t) ;; Filter out Beamer-related tags and install environment tag. (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x)) - (org-get-tags))) + (org-get-tags nil t))) (env-tag (and (org-string-nw-p value) (concat "B_" value)))) (org-set-tags-to (if env-tag (cons env-tag tags) tags)) (when env-tag (org-toggle-tag env-tag 'on))))) diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index fe2111392..4e47d94a6 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -6033,12 +6033,81 @@ Paragraph" (insert "x") (buffer-string)))))) -(ert-deftest test-org/tags-at () +(ert-deftest test-org/get-tags () + "Test `org-get-tags' specifications." + ;; Standard test. + (should + (equal '("foo") + (org-test-with-temp-text "* Test :foo:" (org-get-tags)))) (should (equal '("foo" "bar") - (org-test-with-temp-text - "* Test :foo:bar:" - (org-get-tags-at))))) + (org-test-with-temp-text "* Test :foo:bar:" (org-get-tags)))) + ;; Return nil when there is no tag. + (should-not + (org-test-with-temp-text "* Test" (org-get-tags))) + ;; Tags are inherited from parent headlines. + (should + (equal '("tag") + (let ((org-use-tag-inheritance t)) + (org-test-with-temp-text "* H0 :foo:\n* H1 :tag:\n** H2" + (org-get-tags))))) + ;; Tags are inherited from `org-file-tags'. + (should + (equal '("tag") + (org-test-with-temp-text "* H1" + (let ((org-file-tags '("tag")) + (org-use-tag-inheritance t)) + (org-get-tags))))) + ;; Only inherited tags have the `inherited' text property. + (should + (get-text-property 0 'inherited + (org-test-with-temp-text "* H1 :foo:\n** H2 :bar:" + (let ((org-use-tag-inheritance t)) + (assoc-string "foo" (org-get-tags)))))) + (should-not + (get-text-property 0 'inherited + (org-test-with-temp-text "* H1 :foo:\n** H2 :bar:" + (let ((org-use-tag-inheritance t)) + (assoc-string "bar" (org-get-tags)))))) + ;; Obey to `org-use-tag-inheritance'. + (should-not + (org-test-with-temp-text "* H1 :foo:\n** H2 :bar:" + (let ((org-use-tag-inheritance nil)) + (assoc-string "foo" (org-get-tags))))) + (should-not + (org-test-with-temp-text "* H1 :foo:\n** H2 :bar:" + (let ((org-use-tag-inheritance nil) + (org-file-tags '("foo"))) + (assoc-string "foo" (org-get-tags))))) + (should-not + (org-test-with-temp-text "* H1 :foo:bar:\n** H2 :baz:" + (let ((org-use-tag-inheritance '("bar"))) + (assoc-string "foo" (org-get-tags))))) + (should + (org-test-with-temp-text "* H1 :foo:bar:\n** H2 :baz:" + (let ((org-use-tag-inheritance '("bar"))) + (assoc-string "bar" (org-get-tags))))) + (should-not + (org-test-with-temp-text "* H1 :foo:bar:\n** H2 :baz:" + (let ((org-use-tag-inheritance "b.*")) + (assoc-string "foo" (org-get-tags))))) + (should + (org-test-with-temp-text "* H1 :foo:bar:\n** H2 :baz:" + (let ((org-use-tag-inheritance "b.*")) + (assoc-string "bar" (org-get-tags))))) + ;; When optional argument LOCAL is non-nil, ignore tag inheritance. + (should + (equal '("baz") + (org-test-with-temp-text "* H1 :foo:bar:\n** H2 :baz:" + (let ((org-use-tag-inheritance t)) + (org-get-tags nil t))))) + ;; When optional argument POS is non-nil, get tags there instead. + (should + (equal '("foo") + (org-test-with-temp-text "* H1 :foo:\n* H2 :bar:" + (org-get-tags 1)))) + ;; Pathological case: tagged headline with an empty body. + (should (org-test-with-temp-text "* :tag:" (org-get-tags)))) (ert-deftest test-org/set-tags () "Test `org-set-tags' specifications."