Merge branch 'maint'

lisp/org.el

@@ -14197,36 +14197,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."

testing/lisp/test-org.el

@@ -5977,6 +5977,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
 
@@ -6701,24 +6783,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.