Fix `org-set-tags-to'.
* lisp/org.el (org-set-tags-to): Do not throw an error on empty headlines. * testing/lisp/test-org.el (test-org/set-tags): Move test. (test-org/set-tags-to): New test. Reported-by: Adrian Bradd <a.bradd@columbia.edu> <http://lists.gnu.org/r/emacs-orgmode/2018-03/msg00210.html>
This commit is contained in:
Nicolas Goaziou
parent
2f587d496f
commit
ea4cb14883
50
lisp/org.el
50
lisp/org.el
|
|
@ -14806,36 +14806,28 @@ Assume point is on a headline."
|
|||
(org-set-tags arg just-align))))
|
||||
|
||||
(defun org-set-tags-to (data)
|
||||
"Set the tags of the current entry to DATA, replacing the current tags.
|
||||
DATA may be a tags string like :aa:bb:cc:, or a list of tags.
|
||||
If DATA is nil or the empty string, any tags will be removed."
|
||||
"Set the tags of the current entry to DATA, replacing current tags.
|
||||
DATA may be a tags string like \":aa:bb:cc:\", or a list of tags.
|
||||
If DATA is nil or the empty string, all tags are removed."
|
||||
(interactive "sTags: ")
|
||||
(setq data
|
||||
(cond
|
||||
((eq data nil) "")
|
||||
((equal data "") "")
|
||||
((stringp data)
|
||||
(concat ":" (mapconcat 'identity (org-split-string data ":+") ":")
|
||||
":"))
|
||||
((listp data)
|
||||
(concat ":" (mapconcat 'identity data ":") ":"))))
|
||||
(when data
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(when (let ((case-fold-search nil))
|
||||
(looking-at org-complex-heading-regexp))
|
||||
(if (match-end 5)
|
||||
(progn
|
||||
(goto-char (match-beginning 5))
|
||||
(insert data)
|
||||
(delete-region (point) (point-at-eol))
|
||||
(org-set-tags nil 'align))
|
||||
(goto-char (point-at-eol))
|
||||
(insert " " data)
|
||||
(org-set-tags nil 'align)))
|
||||
(beginning-of-line 1)
|
||||
(when (looking-at ".*?\\([ \t]+\\)$")
|
||||
(delete-region (match-beginning 1) (match-end 1))))))
|
||||
(let ((data
|
||||
(pcase (if (stringp data) (org-trim data) data)
|
||||
((or `nil "") nil)
|
||||
((pred listp) (format ":%s:" (mapconcat #'identity data ":")))
|
||||
((pred stringp)
|
||||
(format ":%s:"
|
||||
(mapconcat #'identity (org-split-string data ":+") ":")))
|
||||
(_ (error "Invalid tag specification: %S" data)))))
|
||||
(org-with-wide-buffer
|
||||
(org-back-to-heading t)
|
||||
(let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
|
||||
(when (or (match-end 5) data)
|
||||
(goto-char (or (match-beginning 5) (line-end-position)))
|
||||
(skip-chars-backward " \t")
|
||||
(delete-region (point) (line-end-position))
|
||||
(when data
|
||||
(insert " " data)
|
||||
(org-set-tags nil 'align))))))
|
||||
|
||||
(defun org-align-all-tags ()
|
||||
"Align the tags in all headings."
|
||||
|
|
|
|||
|
|
@ -5953,6 +5953,88 @@ Paragraph<point>"
|
|||
"* T<point>est :foo:bar:"
|
||||
(org-get-tags-at)))))
|
||||
|
||||
(ert-deftest test-org/set-tags ()
|
||||
"Test `org-set-tags' specifications."
|
||||
;; Tags set via fast-tag-selection should be visible afterwards
|
||||
(should
|
||||
(let ((org-tag-alist '(("NEXT" . ?n)))
|
||||
(org-fast-tag-selection-single-key t))
|
||||
(cl-letf (((symbol-function 'read-char-exclusive) (lambda () ?n))
|
||||
((symbol-function 'window-width) (lambda (&rest args) 100)))
|
||||
(org-test-with-temp-text "<point>* Headline\nAnd its content\n* And another headline\n\nWith some content"
|
||||
;; Show only headlines
|
||||
(org-content)
|
||||
;; Set NEXT tag on current entry
|
||||
(org-set-tags nil nil)
|
||||
;; Move point to that NEXT tag
|
||||
(search-forward "NEXT") (backward-word)
|
||||
;; And it should be visible (i.e. no overlays)
|
||||
(not (overlays-at (point))))))))
|
||||
|
||||
(ert-deftest test-org/set-tags-to ()
|
||||
"Test `org-set-tags-to' specifications."
|
||||
;; Throw an error on invalid data.
|
||||
(should-error
|
||||
(org-test-with-temp-text "* H"
|
||||
(org-set-tags-to 'foo)))
|
||||
;; `nil', an empty, and a blank string remove all tags.
|
||||
(should
|
||||
(equal "* H"
|
||||
(org-test-with-temp-text "* H :tag1:tag2:"
|
||||
(org-set-tags-to nil)
|
||||
(buffer-string))))
|
||||
(should
|
||||
(equal "* H"
|
||||
(org-test-with-temp-text "* H :tag1:tag2:"
|
||||
(org-set-tags-to "")
|
||||
(buffer-string))))
|
||||
(should
|
||||
(equal "* H"
|
||||
(org-test-with-temp-text "* H :tag1:tag2:"
|
||||
(org-set-tags-to " ")
|
||||
(buffer-string))))
|
||||
;; If there's nothing to remove, just bail out.
|
||||
(should
|
||||
(equal "* H"
|
||||
(org-test-with-temp-text "* H"
|
||||
(org-set-tags-to nil)
|
||||
(buffer-string))))
|
||||
(should
|
||||
(equal "* "
|
||||
(org-test-with-temp-text "* "
|
||||
(org-set-tags-to nil)
|
||||
(buffer-string))))
|
||||
;; If DATA is a tag string, set current tags to it, even if it means
|
||||
;; replacing old tags.
|
||||
(should
|
||||
(equal "* H :tag0:"
|
||||
(org-test-with-temp-text "* H :tag1:tag2:"
|
||||
(org-set-tags-to ":tag0:")
|
||||
(buffer-string))))
|
||||
(should
|
||||
(equal "* H :tag0:"
|
||||
(org-test-with-temp-text "* H"
|
||||
(org-set-tags-to ":tag0:")
|
||||
(buffer-string))))
|
||||
;; If DATA is a list, set tags to this list, even if it means
|
||||
;; replacing old tags.
|
||||
(should
|
||||
(equal "* H :tag0:"
|
||||
(org-test-with-temp-text "* H :tag1:tag2:"
|
||||
(org-set-tags-to '("tag0"))
|
||||
(buffer-string))))
|
||||
(should
|
||||
(equal "* H :tag0:"
|
||||
(org-test-with-temp-text "* H"
|
||||
(org-set-tags-to '("tag0"))
|
||||
(buffer-string))))
|
||||
;; Special case: handle empty headlines.
|
||||
(should
|
||||
(equal "* :tag0:"
|
||||
(org-test-with-temp-text "* "
|
||||
(org-set-tags-to '("tag0"))
|
||||
(buffer-string)))))
|
||||
|
||||
|
||||
;;; TODO keywords
|
||||
|
||||
|
|
@ -6573,24 +6655,6 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40"
|
|||
(should-not
|
||||
(org-test-with-temp-text "Paragraph" (org-hide-block-toggle-maybe))))
|
||||
|
||||
(ert-deftest test-org/set-tags ()
|
||||
"Test `org-set-tags' specifications."
|
||||
;; Tags set via fast-tag-selection should be visible afterwards
|
||||
(should
|
||||
(let ((org-tag-alist '(("NEXT" . ?n)))
|
||||
(org-fast-tag-selection-single-key t))
|
||||
(cl-letf (((symbol-function 'read-char-exclusive) (lambda () ?n))
|
||||
((symbol-function 'window-width) (lambda (&rest args) 100)))
|
||||
(org-test-with-temp-text "<point>* Headline\nAnd its content\n* And another headline\n\nWith some content"
|
||||
;; Show only headlines
|
||||
(org-content)
|
||||
;; Set NEXT tag on current entry
|
||||
(org-set-tags nil nil)
|
||||
;; Move point to that NEXT tag
|
||||
(search-forward "NEXT") (backward-word)
|
||||
;; And it should be visible (i.e. no overlays)
|
||||
(not (overlays-at (point))))))))
|
||||
|
||||
(ert-deftest test-org/show-set-visibility ()
|
||||
"Test `org-show-set-visibility' specifications."
|
||||
;; Do not throw an error before first heading.
|
||||
|
|
|
|||
Loading…
Reference in New Issue