summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-04-18 17:28:52 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-04-19 11:51:54 +0200
commitfbe56f89f75a8979e0ba48001a822518df2c66fe (patch)
tree7d24af382743cbbde8547d2c4c8f0659d9e51d26
parent6457a9e4e60402e548f95ec33f9ee2181e1c96b3 (diff)
downloadorg-mode-fbe56f89f75a8979e0ba48001a822518df2c66fe.tar.gz
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.
-rw-r--r--etc/ORG-NEWS8
-rw-r--r--lisp/org-archive.el12
-rw-r--r--lisp/org-mobile.el4
-rw-r--r--lisp/org-mouse.el2
-rw-r--r--lisp/org-pcomplete.el2
-rw-r--r--lisp/org.el59
-rw-r--r--lisp/ox-beamer.el2
-rw-r--r--testing/lisp/test-org.el77
8 files changed, 141 insertions, 25 deletions
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 6a4fe40..abebe08 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 2fcf0b2..ca41616 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 ecfd6f1..28b1157 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 a79cd00..b17a7b5 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 0f1d187..536130d 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 aee053e..77c6a1a 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 15b78dc..38c3530 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 fe21113..4e47d94 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -6033,12 +6033,81 @@ Paragraph<point>"
(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
- "* T<point>est :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<point>** 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** <point>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** <point>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** <point>H2 :bar:"
+ (let ((org-use-tag-inheritance nil))
+ (assoc-string "foo" (org-get-tags)))))
+ (should-not
+ (org-test-with-temp-text "* H1 :foo:\n** <point>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** <point>H2 :baz:"
+ (let ((org-use-tag-inheritance '("bar")))
+ (assoc-string "foo" (org-get-tags)))))
+ (should
+ (org-test-with-temp-text "* H1 :foo:bar:\n** <point>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** <point>H2 :baz:"
+ (let ((org-use-tag-inheritance "b.*"))
+ (assoc-string "foo" (org-get-tags)))))
+ (should
+ (org-test-with-temp-text "* H1 :foo:bar:\n** <point>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** <point>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* <point>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."