forked from mirrors/org-mode
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.
This commit is contained in:
parent
6457a9e4e6
commit
fbe56f89f7
|
@ -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~
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
59
lisp/org.el
59
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
|
||||
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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."
|
||||
|
|
Loading…
Reference in New Issue