소스 검색

Rewrite tags setting functions

* lisp/org.el (org-setting-tags): Remove variable.
(org-set-tags-command): Change signature.  For interactive use only.
(org-set-tags-to): Remove function.
(org-align-all-tags): Remove function.
(org-align-tags): New function.
(org-set-tags): Change signature.  For non-interactive use only.
(org-promote):
(org-demote):
(org-refile):
(org-todo):
(org-priority):
(org-toggle-tag):
(org-entry-put):
(org-fix-tags-on-the-fly):
(org-ctrl-c-ctrl-c):
(org-delete-indentation):
(org-return):
(org-kill-line): Apply signature change.  Use new functions.
* lisp/ox-beamer.el (org-beamer-property-changed):
(org-beamer-select-environment): Apply signature change.  Use new
functions.
* testing/lisp/test-org-archive.el (test-org-archive/to-archive-sibling):
  Update test.
* testing/lisp/test-org.el (test-org/set-tags): Add tests.
(test-org/set-tags-command): New test.
(test-org/set-tags-to): Remove test.
Nicolas Goaziou 6 년 전
부모
커밋
4d152b994e
12개의 변경된 파일267개의 추가작업 그리고 232개의 파일을 삭제
  1. 1 1
      lisp/org-agenda.el
  2. 1 1
      lisp/org-archive.el
  3. 1 3
      lisp/org-capture.el
  4. 1 1
      lisp/org-colview.el
  5. 7 0
      lisp/org-compat.el
  6. 1 1
      lisp/org-list.el
  7. 2 2
      lisp/org-mobile.el
  8. 4 14
      lisp/org-mouse.el
  9. 124 176
      lisp/org.el
  10. 2 2
      lisp/ox-beamer.el
  11. 4 2
      testing/lisp/test-org-archive.el
  12. 119 29
      testing/lisp/test-org.el

+ 1 - 1
lisp/org-agenda.el

@@ -9077,7 +9077,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
 	  (org-show-context 'agenda)
 	  (org-show-context 'agenda)
 	  (if tag
 	  (if tag
 	      (org-toggle-tag tag onoff)
 	      (org-toggle-tag tag onoff)
-	    (call-interactively 'org-set-tags))
+	    (call-interactively #'org-set-tags-command))
 	  (end-of-line 1)
 	  (end-of-line 1)
 	  (setq newhead (org-get-heading)))
 	  (setq newhead (org-get-heading)))
 	(org-agenda-change-all-lines newhead hdmarker)
 	(org-agenda-change-all-lines newhead hdmarker)

+ 1 - 1
lisp/org-archive.el

@@ -366,7 +366,7 @@ direct children of this heading."
 		   (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
 		   (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
 			    infile-p)
 			    infile-p)
 		       (eq org-archive-subtree-add-inherited-tags t))
 		       (eq org-archive-subtree-add-inherited-tags t))
-		   (org-set-tags-to all-tags))
+		   (org-set-tags all-tags))
 	      ;; Mark the entry as done
 	      ;; Mark the entry as done
 	      (when (and org-archive-mark-done
 	      (when (and org-archive-mark-done
 			 (let ((case-fold-search nil))
 			 (let ((case-fold-search nil))

+ 1 - 3
lisp/org-capture.el

@@ -1695,9 +1695,7 @@ The template may still contain \"%?\" for cursor positioning."
 			 (unless (eq (char-before) ?:) (insert ":"))
 			 (unless (eq (char-before) ?:) (insert ":"))
 			 (insert ins)
 			 (insert ins)
 			 (unless (eq (char-after) ?:) (insert ":"))
 			 (unless (eq (char-after) ?:) (insert ":"))
-			 (and (org-at-heading-p)
-			      (let ((org-ignore-region t))
-				(org-set-tags nil 'align))))))
+			 (when (org-at-heading-p) (org-align-tags)))))
 		    ((or "C" "L")
 		    ((or "C" "L")
 		     (let ((insert-fun (if (equal key "C") #'insert
 		     (let ((insert-fun (if (equal key "C") #'insert
 					 (lambda (s) (org-insert-link 0 s)))))
 					 (lambda (s) (org-insert-link 0 s)))))

+ 1 - 1
lisp/org-colview.el

@@ -585,7 +585,7 @@ Where possible, use the standard interface for changing this line."
 			(if (eq org-fast-tag-selection-single-key 'expert)
 			(if (eq org-fast-tag-selection-single-key 'expert)
 			    t
 			    t
 			  org-fast-tag-selection-single-key)))
 			  org-fast-tag-selection-single-key)))
-		   (call-interactively #'org-set-tags)))))
+		   (call-interactively #'org-set-tags-command)))))
 	    ("DEADLINE"
 	    ("DEADLINE"
 	     (lambda ()
 	     (lambda ()
 	       (org-with-point-at pom (call-interactively #'org-deadline))))
 	       (org-with-point-at pom (call-interactively #'org-deadline))))

+ 7 - 0
lisp/org-compat.el

@@ -400,6 +400,13 @@ use of this function is for the stuck project list."
   (declare (obsolete "use `org-make-tag-string' instead." "Org 9.2"))
   (declare (obsolete "use `org-make-tag-string' instead." "Org 9.2"))
   (org-make-tag-string (org-get-tags nil t)))
   (org-make-tag-string (org-get-tags nil t)))
 
 
+(define-obsolete-function-alias 'org-set-tags-to 'org-set-tags "Org 9.2")
+
+(defun org-align-all-tags ()
+  "Align the tags in all headings."
+  (declare (obsolete "use `org-align-tags' instead." "Org 9.2"))
+  (org-align-tags t))
+
 ;;;; Obsolete link types
 ;;;; Obsolete link types
 
 
 (eval-after-load 'org
 (eval-after-load 'org

+ 1 - 1
lisp/org-list.el

@@ -830,7 +830,7 @@ This function modifies STRUCT."
 Metadata are tags, planning information and properties drawers."
 Metadata are tags, planning information and properties drawers."
   (save-match-data
   (save-match-data
     (org-with-wide-buffer
     (org-with-wide-buffer
-     (org-set-tags-to nil)
+     (org-set-tags nil)
      (delete-region (line-beginning-position 2)
      (delete-region (line-beginning-position 2)
 		    (save-excursion
 		    (save-excursion
 		      (org-end-of-meta-data)
 		      (org-end-of-meta-data)

+ 2 - 2
lisp/org-mobile.el

@@ -1007,7 +1007,7 @@ be returned that indicates what went wrong."
        ((or (org-mobile-tags-same-p current old1)
        ((or (org-mobile-tags-same-p current old1)
 	    (eq org-mobile-force-mobile-change t)
 	    (eq org-mobile-force-mobile-change t)
 	    (memq 'tags org-mobile-force-mobile-change))
 	    (memq 'tags org-mobile-force-mobile-change))
-	(org-set-tags-to new1) t)
+	(org-set-tags new1) t)
        (t (error "Tags before change were expected as \"%s\", but are \"%s\""
        (t (error "Tags before change were expected as \"%s\", but are \"%s\""
 		 (or old "") (or current "")))))
 		 (or old "") (or current "")))))
 
 
@@ -1036,7 +1036,7 @@ be returned that indicates what went wrong."
 	      (goto-char (match-beginning 4))
 	      (goto-char (match-beginning 4))
 	      (insert new)
 	      (insert new)
 	      (delete-region (point) (+ (point) (length current)))
 	      (delete-region (point) (+ (point) (length current)))
-	      (org-set-tags nil 'align))
+	      (org-align-tags))
 	     (t (error "Heading changed in MobileOrg and on the computer")))))))
 	     (t (error "Heading changed in MobileOrg and on the computer")))))))
 
 
      ((eq what 'addheading)
      ((eq what 'addheading)

+ 4 - 14
lisp/org-mouse.el

@@ -434,22 +434,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
       `(lambda (tag) (member tag (quote ,tags)))
       `(lambda (tag) (member tag (quote ,tags)))
       ))
       ))
    '("--"
    '("--"
-     ["Align Tags Here" (org-set-tags nil t) t]
-     ["Align Tags in Buffer" (org-set-tags t t) t]
-     ["Set Tags ..." (org-set-tags) t])))
+     ["Align Tags Here" (org-align-tags) t]
+     ["Align Tags in Buffer" (org-align-tags t) t]
+     ["Set Tags ..." (org-set-tags-command) t])))
 
 
 (defun org-mouse-set-tags (tags)
 (defun org-mouse-set-tags (tags)
-  (save-excursion
-    ;; remove existing tags first
-    (beginning-of-line)
-    (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
-      (replace-match ""))
-
-    ;; set new tags if any
-    (when tags
-      (end-of-line)
-      (insert " " (org-make-tag-string tags))
-      (org-set-tags nil t))))
+  (org-set-tags tags))
 
 
 (defun org-mouse-insert-checkbox ()
 (defun org-mouse-insert-checkbox ()
   (interactive)
   (interactive)

+ 124 - 176
lisp/org.el

@@ -184,6 +184,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
 
 
 (defvar ffap-url-regexp)
 (defvar ffap-url-regexp)
 (defvar org-element-paragraph-separate)
 (defvar org-element-paragraph-separate)
+(defvar org-indent-indentation-per-level)
 
 
 ;; load languages based on value of `org-babel-load-languages'
 ;; load languages based on value of `org-babel-load-languages'
 (defvar org-babel-load-languages)
 (defvar org-babel-load-languages)
@@ -7573,7 +7574,7 @@ unconditionally."
 	       (org-end-of-subtree t t))
 	       (org-end-of-subtree t t))
 	      (t
 	      (t
 	       (org-end-of-subtree t t))))
 	       (org-end-of-subtree t t))))
-      (unless (bolp) (insert "\n"))   ;ensure final newline
+      (unless (bolp) (insert "\n"))	;ensure final newline
       (unless (and blank? (org-previous-line-empty-p))
       (unless (and blank? (org-previous-line-empty-p))
 	(org-N-empty-lines-before-current (if blank? 1 0)))
 	(org-N-empty-lines-before-current (if blank? 1 0)))
       (insert stars " \n")
       (insert stars " \n")
@@ -7593,7 +7594,7 @@ unconditionally."
 	     ;; Preserve tags.
 	     ;; Preserve tags.
 	     (let ((split (delete-and-extract-region (point) (match-end 4))))
 	     (let ((split (delete-and-extract-region (point) (match-end 4))))
 	       (if (looking-at "[ \t]*$") (replace-match "")
 	       (if (looking-at "[ \t]*$") (replace-match "")
-		 (org-set-tags nil t))
+		 (org-align-tags))
 	       (end-of-line)
 	       (end-of-line)
 	       (when blank? (insert "\n"))
 	       (when blank? (insert "\n"))
 	       (insert "\n" stars " ")
 	       (insert "\n" stars " ")
@@ -7696,7 +7697,7 @@ Set it to HEADING when provided."
 	   (if old (replace-match new t t nil 4)
 	   (if old (replace-match new t t nil 4)
 	     (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
 	     (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
 	     (insert " " new))
 	     (insert " " new))
-	   (org-set-tags nil t)
+	   (org-align-tags)
 	   (when (looking-at "[ \t]*$") (replace-match ""))))))))
 	   (when (looking-at "[ \t]*$") (replace-match ""))))))))
 
 
 (defun org-insert-heading-after-current ()
 (defun org-insert-heading-after-current ()
@@ -7892,7 +7893,7 @@ odd number.  Returns values greater than 0."
        (user-error "Cannot promote to level 0.  UNDO to recover if necessary"))
        (user-error "Cannot promote to level 0.  UNDO to recover if necessary"))
       (t (replace-match up-head nil t)))
       (t (replace-match up-head nil t)))
      (unless (= level 1)
      (unless (= level 1)
-       (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+       (when org-auto-align-tags (org-align-tags))
        (when org-adapt-indentation (org-fixup-indentation (- diff))))
        (when org-adapt-indentation (org-fixup-indentation (- diff))))
      (run-hooks 'org-after-promote-entry-hook))))
      (run-hooks 'org-after-promote-entry-hook))))
 
 
@@ -7906,7 +7907,7 @@ odd number.  Returns values greater than 0."
 	  (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
 	  (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
 	  (diff (abs (- level (length down-head) -1))))
 	  (diff (abs (- level (length down-head) -1))))
      (replace-match down-head nil t)
      (replace-match down-head nil t)
-     (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+     (when org-auto-align-tags (org-align-tags))
      (when org-adapt-indentation (org-fixup-indentation diff))
      (when org-adapt-indentation (org-fixup-indentation diff))
      (run-hooks 'org-after-demote-entry-hook))))
      (run-hooks 'org-after-demote-entry-hook))))
 
 
@@ -11315,7 +11316,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
 		   (save-excursion (org-add-log-note))))
 		   (save-excursion (org-add-log-note))))
 	       (and org-auto-align-tags
 	       (and org-auto-align-tags
 		    (let ((org-loop-over-headlines-in-active-region nil))
 		    (let ((org-loop-over-headlines-in-active-region nil))
-		      (org-set-tags nil t)))
+		      (org-align-tags)))
 	       (let ((bookmark-name (plist-get org-bookmark-names-plist
 	       (let ((bookmark-name (plist-get org-bookmark-names-plist
 					       :last-refile)))
 					       :last-refile)))
 		 (when bookmark-name
 		 (when bookmark-name
@@ -11856,8 +11857,6 @@ insert an empty block."
 If the last change removed the TODO tag or switched to DONE, then
 If the last change removed the TODO tag or switched to DONE, then
 this is nil.")
 this is nil.")
 
 
-(defvar org-setting-tags nil) ; dynamically scoped
-
 (defvar org-todo-setup-filter-hook nil
 (defvar org-todo-setup-filter-hook nil
   "Hook for functions that pre-filter todo specs.
   "Hook for functions that pre-filter todo specs.
 Each function takes a todo spec and returns either nil or the spec
 Each function takes a todo spec and returns either nil or the spec
@@ -12129,7 +12128,7 @@ When called through ELisp, arg is also interpreted in the following way:
 		(org-add-log-setup 'state org-state this dolog)))
 		(org-add-log-setup 'state org-state this dolog)))
 	    ;; Fixup tag positioning.
 	    ;; Fixup tag positioning.
 	    (org-todo-trigger-tag-changes org-state)
 	    (org-todo-trigger-tag-changes org-state)
-	    (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+	    (when org-auto-align-tags (org-align-tags))
 	    (when org-provide-todo-statistics
 	    (when org-provide-todo-statistics
 	      (org-update-parent-todo-statistics))
 	      (org-update-parent-todo-statistics))
 	    (run-hooks 'org-after-todo-state-change-hook)
 	    (run-hooks 'org-after-todo-state-change-hook)
@@ -13557,7 +13556,7 @@ ACTION can be `set', `up', `down', or a character."
 		  (insert " [#" news "]"))
 		  (insert " [#" news "]"))
 	      (goto-char (match-beginning 3))
 	      (goto-char (match-beginning 3))
 	      (insert "[#" news "] "))))
 	      (insert "[#" news "] "))))
-	(org-set-tags nil 'align))
+	(org-align-tags))
       (if remove
       (if remove
 	  (message "Priority removed")
 	  (message "Priority removed")
 	(message "Priority of current item set to %s" news)))))
 	(message "Priority of current item set to %s" news)))))
@@ -14181,8 +14180,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
 	 (setq res t)
 	 (setq res t)
 	 (cl-pushnew tag current :test #'equal))
 	 (cl-pushnew tag current :test #'equal))
 	(_ (setq current (delete tag current))))
 	(_ (setq current (delete tag current))))
-      (org-set-tags-to (nreverse current))
-      (run-hooks 'org-after-tags-change-hook)
+      (org-set-tags (nreverse current))
       res)))
       res)))
 
 
 (defun org--align-tags-here (to-col)
 (defun org--align-tags-here (to-col)
@@ -14203,163 +14201,114 @@ Assume point is on a headline."
       ;; before tags.
       ;; before tags.
       (when (< pos (point)) (goto-char pos)))))
       (when (< pos (point)) (goto-char pos)))))
 
 
-(defun org-set-tags-command (&optional arg just-align)
-  "Call the set-tags command for the current entry."
+(defun org-set-tags-command (&optional arg)
+  "Set the tags for the current visible entry.
+
+When called with `\\[universal-argument]' prefix argument ARG,
+realign all tags in headings in the current buffer.  If a region
+is active, set tags for all headlines in the region.
+
+This function is for interactive use only;
+in Lisp code use `org-set-tags' instead."
   (interactive "P")
   (interactive "P")
-  (if (or (org-at-heading-p) (and arg (org-before-first-heading-p)))
-      (org-set-tags arg just-align)
-    (save-excursion
-      (unless (and (org-region-active-p)
-		   org-loop-over-headlines-in-active-region)
-	(org-back-to-heading t))
-      (org-set-tags arg just-align))))
-
-(defun org-set-tags-to (data)
-  "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: ")
-  (let ((data
-	 (pcase (if (stringp data) (org-trim data) data)
-	   ((or `nil "") nil)
-	   ((pred listp) (org-make-tag-string data))
-	   ((pred stringp)
-	    (org-make-tag-string (org-split-string data ":+")))
-	   (_ (error "Invalid tag specification: %S" data)))))
+  (cond
+   (arg (org-align-tags t))
+   ((and (org-region-active-p) org-loop-over-headlines-in-active-region)
+    ;; Disable `org-loop-over-headlines-in-active-region' for
+    ;; successive calls.
+    (let (org-loop-over-headlines-in-active-region)
+      (org-map-entries
+       #'org-set-tags-command
+       nil
+       (if (eq org-loop-over-headlines-in-active-region 'start-level)
+	   'region-start-level
+	 'region)
+       (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))))
+   (t
+    (org-back-to-heading)
+    (let* ((all-tags (org-get-tags))
+	   (table (setq org-last-tags-completion-table
+			(org-tag-add-to-alist
+			 (and org-complete-tags-always-offer-all-agenda-tags
+			      (org-global-tags-completion-table
+			       (org-agenda-files)))
+			 (or org-current-tag-alist (org-get-buffer-tags)))))
+	   (current-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))
+	   (tags
+	    (replace-regexp-in-string
+	     ;; Ignore all forbidden characters in tags.
+	     "[^[:alnum:]_@#%]+" ":"
+	     (if (or (eq t org-use-fast-tag-selection)
+		     (and org-use-fast-tag-selection
+			  (delq nil (mapcar #'cdr table))))
+		 (org-fast-tag-selection
+		  current-tags
+		  inherited-tags
+		  table
+		  (and org-fast-tag-selection-include-todo org-todo-key-alist))
+	       (let ((org-add-colon-after-tag-completion (< 1 (length table))))
+		 (org-trim (completing-read
+			    "Tags: "
+			    #'org-tags-completion-function
+			    nil nil current-tags 'org-tags-history)))))))
+      (org-set-tags tags)))))
+
+(defun org-align-tags (&optional all)
+  "Align tags in current entry.
+When optional argument ALL is non-nil, align all tags in the
+visible part of the buffer."
+  (save-excursion
+    (if all (goto-char (point-min)) (org-back-to-heading t))
+    (catch :single
+      (while (re-search-forward org-tag-line-re nil t)
+	(let* ((offset (if (bound-and-true-p org-indent-mode)
+			   (* (1- org-indent-indentation-per-level)
+			      (1- (org-current-level)))
+			 0))
+	       (tags-column (+ org-tags-column
+			       (if (> org-tags-column 0) (- offset) offset))))
+	  (beginning-of-line)
+	  (org--align-tags-here tags-column)
+	  (if all (forward-line) (throw :single nil)))))))
+
+(defun org-set-tags (tags)
+  "Set the tags of the current entry to TAGS, replacing current tags.
+
+TAGS may be a tags string like \":aa:bb:cc:\", or a list of tags.
+If TAGS is nil or the empty string, all tags are removed.
+
+This function assumes point is on a headline."
+  (let ((tags (pcase tags
+		((pred listp) tags)
+		((pred stringp) (split-string (org-trim tags) ":" t))
+		(_ (error "Invalid tag specification: %S" tags))))
+	(change-flag nil))
+    (when (functionp org-tags-sort-function)
+      (setq tags (sort tags org-tags-sort-function)))
     (org-with-wide-buffer
     (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)))
+     (unless (equal tags (org-get-tags nil t))
+       (setq change-flag t)
+       ;; Delete previous tags and any trailing white space.
+       (goto-char (if (looking-at org-tag-line-re) (match-beginning 1)
+		    (line-end-position)))
        (skip-chars-backward " \t")
        (skip-chars-backward " \t")
        (delete-region (point) (line-end-position))
        (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."
-  (interactive)
-  (save-excursion
-    (or (ignore-errors (org-back-to-heading t))
-	(outline-next-heading))
-    (if (org-at-heading-p)
-	(org-set-tags t)
-      (message "No headings"))))
-
-(defvar org-indent-indentation-per-level)
-(defun org-set-tags (&optional arg just-align)
-  "Set the tags for the current headline.
-With prefix ARG, realign all tags in headings in the current buffer.
-When JUST-ALIGN is non-nil, only align tags."
-  (interactive "P")
-  (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
-      (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
-                    'region-start-level
-		  'region))
-            org-loop-over-headlines-in-active-region)
-        (org-map-entries
-         ;; We don't use ARG and JUST-ALIGN here because these args
-         ;; are not useful when looping over headlines.
-         #'org-set-tags
-         org-loop-over-headlines-in-active-region
-         cl
-	 '(when (org-invisible-p) (org-end-of-subtree nil t))))
-    (let ((org-setting-tags t))
-      (if arg
-          (save-excursion
-            (goto-char (point-min))
-            (while (re-search-forward org-outline-regexp-bol nil t)
-	      (org-set-tags nil t)
-	      (end-of-line))
-            (message "All tags realigned to column %d" org-tags-column))
-	(let* ((current (org-make-tag-string (org-get-tags nil t)))
-	       (tags
-		(if just-align current
-		  ;; Get a new set of tags from the user.
-		  (save-excursion
-		    (let* ((table
-			    (setq
-			     org-last-tags-completion-table
-			     (org-tag-add-to-alist
-			      (and
-			       org-complete-tags-always-offer-all-agenda-tags
-			       (org-global-tags-completion-table
-				(org-agenda-files)))
-			      (or org-current-tag-alist
-				  (org-get-buffer-tags)))))
-			   (current-tags (org-split-string current ":"))
-			   (inherited-tags
-			    (nreverse (nthcdr (length current-tags)
-					      (nreverse (org-get-tags))))))
-		      (replace-regexp-in-string
-		       "\\([-+&]+\\|,\\)"
-		       ":"
-		       (if (or (eq t org-use-fast-tag-selection)
-			       (and org-use-fast-tag-selection
-				    (delq nil (mapcar #'cdr table))))
-			   (org-fast-tag-selection
-			    current-tags inherited-tags table
-			    (and org-fast-tag-selection-include-todo
-				 org-todo-key-alist))
-			 (let ((org-add-colon-after-tag-completion
-				(< 1 (length table))))
-			   (org-trim
-			    (completing-read
-			     "Tags: "
-			     #'org-tags-completion-function
-			     nil nil current 'org-tags-history))))))))))
-
-	  (when org-tags-sort-function
-	    (setq tags
-		  (mapconcat
-		   #'identity
-		   (sort (org-split-string tags "[^[:alnum:]_@#%]+")
-			 org-tags-sort-function)
-		   ":")))
-
-	  (if (or (string= ":" tags)
-		  (string= "::" tags))
-	      (setq tags ""))
-	  (if (not (org-string-nw-p tags)) (setq tags "")
-	    (unless (string-suffix-p ":" tags) (setq tags (concat tags ":")))
-	    (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags))))
-
-	  ;; Insert new tags at the correct column.
-	  (unless (equal current tags)
-	    (save-excursion
-	      (beginning-of-line)
-	      (let ((case-fold-search nil))
-		(looking-at org-complex-heading-regexp))
-	      ;; Remove current tags, if any.
-	      (when (match-end 5) (replace-match "" nil nil nil 5))
-	      ;; Insert new tags, if any.  Otherwise, remove trailing
-	      ;; white spaces.
-	      (end-of-line)
-	      (if (not (equal tags ""))
-		  ;; When text is being inserted on an invisible
-		  ;; region boundary, it can be inadvertently sucked
-		  ;; into invisibility.
-		  (org-flag-region (point) (progn (insert " " tags) (point))
-				   nil
-				   'outline)
-		(skip-chars-backward " \t")
-		(delete-region (point) (line-end-position)))))
-	  ;; Align tags, if any.  Fix tags column if `org-indent-mode'
-	  ;; is on.
-	  (unless (equal tags "")
-	    (let* ((level (save-excursion
-			    (beginning-of-line)
-			    (skip-chars-forward "\\*")))
-		   (offset (if (bound-and-true-p org-indent-mode)
-			       (* (1- org-indent-indentation-per-level)
-				  (1- level))
-			     0))
-		   (tags-column
-		    (+ org-tags-column
-		       (if (> org-tags-column 0) (- offset) offset))))
-	      (org--align-tags-here tags-column))))
-        (unless just-align (run-hooks 'org-after-tags-change-hook))))))
+       (when tags
+	 (save-excursion (insert " " (org-make-tag-string tags)))
+	 ;; When text is being inserted on an invisible region
+	 ;; boundary, it can be inadvertently sucked into
+	 ;; invisibility.
+	 (unless (org-invisible-p (line-beginning-position))
+	   (org-flag-region (point) (line-end-position) nil 'outline))))
+     ;; Align tags, if any.  Fix tags column if `org-indent-mode' is
+     ;; on.
+     (when tags (org-align-tags))
+     (when change-flag (run-hooks 'org-after-tags-change-hook)))))
 
 
 (defun org-change-tag-in-region (beg end tag off)
 (defun org-change-tag-in-region (beg end tag off)
   "Add or remove TAG for each entry in the region.
   "Add or remove TAG for each entry in the region.
@@ -15398,10 +15347,10 @@ decreases scheduled or deadline date by one day."
 	      ((not (member value org-todo-keywords-1))
 	      ((not (member value org-todo-keywords-1))
 	       (user-error "\"%s\" is not a valid TODO state" value)))
 	       (user-error "\"%s\" is not a valid TODO state" value)))
 	(org-todo value)
 	(org-todo value)
-	(org-set-tags nil 'align))
+	(org-align-tags))
        ((equal property "PRIORITY")
        ((equal property "PRIORITY")
 	(org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
 	(org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
-	(org-set-tags nil 'align))
+	(org-align-tags))
        ((equal property "SCHEDULED")
        ((equal property "SCHEDULED")
 	(forward-line)
 	(forward-line)
 	(if (and (looking-at-p org-planning-line-re)
 	(if (and (looking-at-p org-planning-line-re)
@@ -19384,12 +19333,11 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
 
 
 (defun org-fix-tags-on-the-fly ()
 (defun org-fix-tags-on-the-fly ()
   "Align tags in headline at point.
   "Align tags in headline at point.
-Unlike to `org-set-tags', it ignores region and sorting."
+Unlike to `org-align-tags', this function does nothing if point
+is not currently on a headline."
   (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit
   (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit
 	     (org-at-heading-p))
 	     (org-at-heading-p))
-    (let ((org-ignore-region t)
-	  (org-tags-sort-function nil))
-      (org-set-tags nil t))))
+    (org-align-tags)))
 
 
 (defun org-delete-backward-char (N)
 (defun org-delete-backward-char (N)
   "Like `delete-backward-char', insert whitespace at field end in tables.
   "Like `delete-backward-char', insert whitespace at field end in tables.
@@ -20243,7 +20191,7 @@ This command does many different things, depending on context:
 	(`footnote-reference (call-interactively #'org-footnote-action))
 	(`footnote-reference (call-interactively #'org-footnote-action))
 	((or `headline `inlinetask)
 	((or `headline `inlinetask)
 	 (save-excursion (goto-char (org-element-property :begin context))
 	 (save-excursion (goto-char (org-element-property :begin context))
-			 (call-interactively #'org-set-tags)))
+			 (call-interactively #'org-set-tags-command)))
 	(`item
 	(`item
 	 ;; At an item: `C-u C-u' sets checkbox to "[-]"
 	 ;; At an item: `C-u C-u' sets checkbox to "[-]"
 	 ;; unconditionally, whereas `C-u' will toggle its presence.
 	 ;; unconditionally, whereas `C-u' will toggle its presence.
@@ -20355,7 +20303,7 @@ Use `\\[org-edit-special]' to edit table.el tables"))
 	((and `nil (guard (org-at-heading-p)))
 	((and `nil (guard (org-at-heading-p)))
 	 ;; When point is on an unsupported object type, we can miss
 	 ;; When point is on an unsupported object type, we can miss
 	 ;; the fact that it also is at a heading.  Handle it here.
 	 ;; the fact that it also is at a heading.  Handle it here.
-	 (call-interactively #'org-set-tags))
+	 (call-interactively #'org-set-tags-command))
 	((guard
 	((guard
 	  (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
 	  (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
 	(_
 	(_
@@ -20415,7 +20363,7 @@ With a non-nil optional argument, join it to the following one."
 	;; Adjust alignment of tags.
 	;; Adjust alignment of tags.
 	(cond
 	(cond
 	 ((not tags-column))		;no tags
 	 ((not tags-column))		;no tags
-	 (org-auto-align-tags (org-set-tags nil t))
+	 (org-auto-align-tags (org-align-tags))
 	 (t (org--align-tags-here tags-column)))) ;preserve tags column
 	 (t (org--align-tags-here tags-column)))) ;preserve tags column
     (delete-indentation arg)))
     (delete-indentation arg)))
 
 
@@ -20489,7 +20437,7 @@ object (e.g., within a comment).  In these case, you need to use
 	;; Adjust tag alignment.
 	;; Adjust tag alignment.
 	(cond
 	(cond
 	 ((not (and tags-column string)))
 	 ((not (and tags-column string)))
-	 (org-auto-align-tags (org-set-tags nil t))
+	 (org-auto-align-tags (org-align-tags))
 	 (t (org--align-tags-here tags-column))) ;preserve tags column
 	 (t (org--align-tags-here tags-column))) ;preserve tags column
 	(end-of-line)
 	(end-of-line)
 	(org-show-entry)
 	(org-show-entry)
@@ -22827,7 +22775,7 @@ depending on context."
       (if (<= end (point))		;on tags part
       (if (<= end (point))		;on tags part
 	  (kill-region (point) (line-end-position))
 	  (kill-region (point) (line-end-position))
 	(kill-region (point) end)))
 	(kill-region (point) end)))
-    (org-set-tags nil t))
+    (org-align-tags))
    (t (kill-region (point) (line-end-position)))))
    (t (kill-region (point) (line-end-position)))))
 
 
 (defun org-yank (&optional arg)
 (defun org-yank (&optional arg)

+ 2 - 2
lisp/ox-beamer.el

@@ -916,7 +916,7 @@ value."
       (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x))
       (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x))
 				(org-get-tags nil t)))
 				(org-get-tags nil t)))
 	    (env-tag (and (org-string-nw-p value) (concat "B_" value))))
 	    (env-tag (and (org-string-nw-p value) (concat "B_" value))))
-	(org-set-tags-to (if env-tag (cons env-tag tags) tags))
+	(org-set-tags (if env-tag (cons env-tag tags) tags))
 	(when env-tag (org-toggle-tag env-tag 'on)))))
 	(when env-tag (org-toggle-tag env-tag 'on)))))
    ((equal property "BEAMER_col")
    ((equal property "BEAMER_col")
     (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off)))))
     (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off)))))
@@ -1075,7 +1075,7 @@ aid, but the tag does not have any semantic meaning."
 	 (org-tag-persistent-alist nil)
 	 (org-tag-persistent-alist nil)
 	 (org-use-fast-tag-selection t)
 	 (org-use-fast-tag-selection t)
 	 (org-fast-tag-selection-single-key t))
 	 (org-fast-tag-selection-single-key t))
-    (org-set-tags)
+    (org-set-tags-command)
     (let ((tags (org-get-tags nil t)))
     (let ((tags (org-get-tags nil t)))
       (cond
       (cond
        ;; For a column, automatically ask for its width.
        ;; For a column, automatically ask for its width.

+ 4 - 2
testing/lisp/test-org-archive.el

@@ -83,7 +83,8 @@
    (equal "* Archive :ARCHIVE:\n** H\n"
    (equal "* Archive :ARCHIVE:\n** H\n"
 	  (org-test-with-temp-text "* H\n"
 	  (org-test-with-temp-text "* H\n"
 	    (let ((org-archive-sibling-heading "Archive")
 	    (let ((org-archive-sibling-heading "Archive")
-		  (org-archive-tag "ARCHIVE"))
+		  (org-archive-tag "ARCHIVE")
+		  (org-tags-column 1))
 	      (org-archive-to-archive-sibling)
 	      (org-archive-to-archive-sibling)
 	      (goto-char (point-min))
 	      (goto-char (point-min))
 	      (buffer-substring-no-properties
 	      (buffer-substring-no-properties
@@ -93,7 +94,8 @@
    (equal "* Archive :ARCHIVE:\n* Top\n** Archive :ARCHIVE:\n*** H\n"
    (equal "* Archive :ARCHIVE:\n* Top\n** Archive :ARCHIVE:\n*** H\n"
 	  (org-test-with-temp-text "* Archive :ARCHIVE:\n* Top\n<point>** H\n"
 	  (org-test-with-temp-text "* Archive :ARCHIVE:\n* Top\n<point>** H\n"
 	    (let ((org-archive-sibling-heading "Archive")
 	    (let ((org-archive-sibling-heading "Archive")
-		  (org-archive-tag "ARCHIVE"))
+		  (org-archive-tag "ARCHIVE")
+		  (org-tags-column 0))
 	      (org-archive-to-archive-sibling)
 	      (org-archive-to-archive-sibling)
 	      (goto-char (point-min))
 	      (goto-char (point-min))
 	      (buffer-substring-no-properties
 	      (buffer-substring-no-properties

+ 119 - 29
testing/lisp/test-org.el

@@ -6111,86 +6111,176 @@ Paragraph<point>"
 
 
 (ert-deftest test-org/set-tags ()
 (ert-deftest test-org/set-tags ()
   "Test `org-set-tags' specifications."
   "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.
   ;; Throw an error on invalid data.
   (should-error
   (should-error
    (org-test-with-temp-text "* H"
    (org-test-with-temp-text "* H"
-     (org-set-tags-to 'foo)))
+     (org-set-tags 'foo)))
   ;; `nil', an empty, and a blank string remove all tags.
   ;; `nil', an empty, and a blank string remove all tags.
   (should
   (should
    (equal "* H"
    (equal "* H"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
-	    (org-set-tags-to nil)
+	    (org-set-tags nil)
 	    (buffer-string))))
 	    (buffer-string))))
   (should
   (should
    (equal "* H"
    (equal "* H"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
-	    (org-set-tags-to "")
+	    (org-set-tags "")
 	    (buffer-string))))
 	    (buffer-string))))
   (should
   (should
    (equal "* H"
    (equal "* H"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
-	    (org-set-tags-to " ")
+	    (org-set-tags " ")
 	    (buffer-string))))
 	    (buffer-string))))
   ;; If there's nothing to remove, just bail out.
   ;; If there's nothing to remove, just bail out.
   (should
   (should
    (equal "* H"
    (equal "* H"
 	  (org-test-with-temp-text "* H"
 	  (org-test-with-temp-text "* H"
-	    (org-set-tags-to nil)
+	    (org-set-tags nil)
 	    (buffer-string))))
 	    (buffer-string))))
   (should
   (should
    (equal "* "
    (equal "* "
 	  (org-test-with-temp-text "* "
 	  (org-test-with-temp-text "* "
-	    (org-set-tags-to nil)
+	    (org-set-tags nil)
 	    (buffer-string))))
 	    (buffer-string))))
   ;; If DATA is a tag string, set current tags to it, even if it means
   ;; If DATA is a tag string, set current tags to it, even if it means
   ;; replacing old tags.
   ;; replacing old tags.
   (should
   (should
    (equal "* H :tag0:"
    (equal "* H :tag0:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
-	    (org-set-tags-to ":tag0:")
+	    (let ((org-tags-column 1)) (org-set-tags ":tag0:"))
 	    (buffer-string))))
 	    (buffer-string))))
   (should
   (should
    (equal "* H :tag0:"
    (equal "* H :tag0:"
 	  (org-test-with-temp-text "* H"
 	  (org-test-with-temp-text "* H"
-	    (org-set-tags-to ":tag0:")
+	    (let ((org-tags-column 1)) (org-set-tags ":tag0:"))
 	    (buffer-string))))
 	    (buffer-string))))
   ;; If DATA is a list, set tags to this list, even if it means
   ;; If DATA is a list, set tags to this list, even if it means
   ;; replacing old tags.
   ;; replacing old tags.
   (should
   (should
    (equal "* H :tag0:"
    (equal "* H :tag0:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
 	  (org-test-with-temp-text "* H :tag1:tag2:"
-	    (org-set-tags-to '("tag0"))
+	    (let ((org-tags-column 1)) (org-set-tags '("tag0")))
 	    (buffer-string))))
 	    (buffer-string))))
   (should
   (should
    (equal "* H :tag0:"
    (equal "* H :tag0:"
 	  (org-test-with-temp-text "* H"
 	  (org-test-with-temp-text "* H"
-	    (org-set-tags-to '("tag0"))
+	    (let ((org-tags-column 1)) (org-set-tags '("tag0")))
 	    (buffer-string))))
 	    (buffer-string))))
+  ;; When set, apply `org-tags-sort-function'.
+  (should
+   (equal "* H :a:b:"
+	  (org-test-with-temp-text "* H"
+	    (let ((org-tags-column 1)
+		  (org-tags-sort-function #'string<))
+	      (org-set-tags '("b" "a"))
+	      (buffer-string)))))
+  ;; When new tags are identical to the previous ones, still align.
+  (should
+   (equal "* H :foo:"
+	  (org-test-with-temp-text "* H     :foo:"
+	    (let ((org-tags-column 1))
+	      (org-set-tags '("foo"))
+	      (buffer-string)))))
+  ;; When tags have been changed, run `org-after-tags-change-hook'.
+  (should
+   (catch :return
+     (org-test-with-temp-text "* H :foo:"
+       (let ((org-after-tags-change-hook (lambda () (throw :return t))))
+	 (org-set-tags '("bar"))
+	 nil))))
+  (should-not
+   (catch :return
+     (org-test-with-temp-text "* H      :foo:"
+       (let ((org-after-tags-change-hook (lambda () (throw :return t))))
+	 (org-set-tags '("foo"))
+	 nil))))
   ;; Special case: handle empty headlines.
   ;; Special case: handle empty headlines.
   (should
   (should
    (equal "* :tag0:"
    (equal "* :tag0:"
 	  (org-test-with-temp-text "* "
 	  (org-test-with-temp-text "* "
-	    (org-set-tags-to '("tag0"))
+	    (let ((org-tags-column 1)) (org-set-tags '("tag0")))
+	    (buffer-string))))
+  ;; Pathological case: when setting tags of a folded headline, do not
+  ;; let new tags being sucked into invisibility.
+  (should-not
+   (org-test-with-temp-text "* H1\nContent\n* H2\n\n Other Content"
+     ;; Show only headlines
+     (org-content)
+     ;; Set NEXT tag on current entry
+     (org-set-tags ":NEXT:")
+     ;; Move point to that NEXT tag
+     (search-forward "NEXT") (backward-word)
+     ;; And it should be visible (i.e. no overlays)
+     (overlays-at (point)))))
+
+(ert-deftest test-org/set-tags-command ()
+  "Test `org-set-tags-command' specifications"
+  ;; Set tags at current headline.
+  (should
+   (equal "* H1 :foo:"
+	  (org-test-with-temp-text "* H1"
+	    (cl-letf (((symbol-function 'completing-read)
+		       (lambda (&rest args) ":foo:")))
+	      (let ((org-use-fast-tag-selection nil)
+		    (org-tags-column 1))
+		(org-set-tags-command)))
+	    (buffer-string))))
+  (should
+   (equal "* H1 :foo:\nContents"
+	  (org-test-with-temp-text "* H1\n<point>Contents"
+	    (cl-letf (((symbol-function 'completing-read)
+		       (lambda (&rest args) ":foo:")))
+	      (let ((org-use-fast-tag-selection nil)
+		    (org-tags-column 1))
+		(org-set-tags-command)))
+	    (buffer-string))))
+  ;; Strip all forbidden characters from user-entered tags.
+  (should
+   (equal "* H1 :foo:"
+	  (org-test-with-temp-text "* H1"
+	    (cl-letf (((symbol-function 'completing-read)
+		       (lambda (&rest args) ": foo *:")))
+	      (let ((org-use-fast-tag-selection nil)
+		    (org-tags-column 1))
+		(org-set-tags-command)))
+	    (buffer-string))))
+  ;; When a region is active and
+  ;; `org-loop-over-headlines-in-active-region' is non-nil, insert the
+  ;; same value in all headlines in region.
+  (should
+   (equal "* H1 :foo:\nContents\n* H2 :foo:"
+	  (org-test-with-temp-text "* H1\nContents\n* H2"
+	    (cl-letf (((symbol-function 'completing-read)
+		       (lambda (&rest args) ":foo:")))
+	      (let ((org-use-fast-tag-selection nil)
+		    (org-loop-over-headlines-in-active-region t)
+		    (org-tags-column 1))
+		(transient-mark-mode 1)
+		(push-mark (point) t t)
+		(goto-char (point-max))
+		(org-set-tags-command)))
+	    (buffer-string))))
+  (should
+   (equal "* H1\nContents\n* H2 :foo:"
+	  (org-test-with-temp-text "* H1\nContents\n* H2"
+	    (cl-letf (((symbol-function 'completing-read)
+		       (lambda (&rest args) ":foo:")))
+	      (let ((org-use-fast-tag-selection nil)
+		    (org-loop-over-headlines-in-active-region nil)
+		    (org-tags-column 1))
+		(transient-mark-mode 1)
+		(push-mark (point) t t)
+		(goto-char (point-max))
+		(org-set-tags-command)))
+	    (buffer-string))))
+  ;; With a non-nil prefix argument, align all tags in the buffer.
+  (should
+   (equal "* H1 :foo:\n* H2 :bar:"
+	  (org-test-with-temp-text "* H1    :foo:\n* H2    :bar:"
+	    (let ((org-tags-column 1)) (org-set-tags-command t))
 	    (buffer-string)))))
 	    (buffer-string)))))
 
 
+
 
 
 ;;; TODO keywords
 ;;; TODO keywords