diff --git a/lisp/org.el b/lisp/org.el index 34bf07738..859f3df43 100644 --- a/lisp/org.el +++ b/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." diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 6bea90a54..ecf41e9e3 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -5953,6 +5953,88 @@ Paragraph" "* Test :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 "* 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 "* 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.