summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-04-20 10:45:19 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-04-20 10:51:21 +0200
commit4d152b994e889d09143b68fe3da9731d69087f2c (patch)
tree12a73ffa85d3da0122a491831ecc69d91e165849
parentbe31a0c4595a6d68b03b5cfbcbcdbf2cd76d2b7f (diff)
downloadorg-mode-4d152b994e889d09143b68fe3da9731d69087f2c.tar.gz
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.
-rw-r--r--lisp/org-agenda.el2
-rw-r--r--lisp/org-archive.el2
-rw-r--r--lisp/org-capture.el4
-rw-r--r--lisp/org-colview.el2
-rw-r--r--lisp/org-compat.el7
-rw-r--r--lisp/org-list.el2
-rw-r--r--lisp/org-mobile.el4
-rw-r--r--lisp/org-mouse.el18
-rw-r--r--lisp/org.el300
-rw-r--r--lisp/ox-beamer.el4
-rw-r--r--testing/lisp/test-org-archive.el6
-rw-r--r--testing/lisp/test-org.el148
12 files changed, 267 insertions, 232 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 7c74b9d..3aac9d8 100644
--- a/lisp/org-agenda.el
+++ b/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)
(if tag
(org-toggle-tag tag onoff)
- (call-interactively 'org-set-tags))
+ (call-interactively #'org-set-tags-command))
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 385a1bf..00b3db7 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -366,7 +366,7 @@ direct children of this heading."
(or (and (eq org-archive-subtree-add-inherited-tags 'infile)
infile-p)
(eq org-archive-subtree-add-inherited-tags t))
- (org-set-tags-to all-tags))
+ (org-set-tags all-tags))
;; Mark the entry as done
(when (and org-archive-mark-done
(let ((case-fold-search nil))
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 02f9e3d..0d6665d 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1695,9 +1695,7 @@ The template may still contain \"%?\" for cursor positioning."
(unless (eq (char-before) ?:) (insert ":"))
(insert ins)
(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")
(let ((insert-fun (if (equal key "C") #'insert
(lambda (s) (org-insert-link 0 s)))))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 139cea2..d7011f0 100644
--- a/lisp/org-colview.el
+++ b/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)
t
org-fast-tag-selection-single-key)))
- (call-interactively #'org-set-tags)))))
+ (call-interactively #'org-set-tags-command)))))
("DEADLINE"
(lambda ()
(org-with-point-at pom (call-interactively #'org-deadline))))
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 2a617d3..f6dd128 100644
--- a/lisp/org-compat.el
+++ b/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"))
(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
(eval-after-load 'org
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 100e06a..5ca7da7 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -830,7 +830,7 @@ This function modifies STRUCT."
Metadata are tags, planning information and properties drawers."
(save-match-data
(org-with-wide-buffer
- (org-set-tags-to nil)
+ (org-set-tags nil)
(delete-region (line-beginning-position 2)
(save-excursion
(org-end-of-meta-data)
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 28b1157..95851e1 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -1007,7 +1007,7 @@ be returned that indicates what went wrong."
((or (org-mobile-tags-same-p current old1)
(eq org-mobile-force-mobile-change t)
(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\""
(or old "") (or current "")))))
@@ -1036,7 +1036,7 @@ be returned that indicates what went wrong."
(goto-char (match-beginning 4))
(insert new)
(delete-region (point) (+ (point) (length current)))
- (org-set-tags nil 'align))
+ (org-align-tags))
(t (error "Heading changed in MobileOrg and on the computer")))))))
((eq what 'addheading)
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 426e218..45b4d56 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -434,22 +434,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
`(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)
- (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 ()
(interactive)
diff --git a/lisp/org.el b/lisp/org.el
index cde3f19..cabd5cb 100644
--- a/lisp/org.el
+++ b/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 org-element-paragraph-separate)
+(defvar org-indent-indentation-per-level)
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -7573,7 +7574,7 @@ unconditionally."
(org-end-of-subtree t 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))
(org-N-empty-lines-before-current (if blank? 1 0)))
(insert stars " \n")
@@ -7593,7 +7594,7 @@ unconditionally."
;; Preserve tags.
(let ((split (delete-and-extract-region (point) (match-end 4))))
(if (looking-at "[ \t]*$") (replace-match "")
- (org-set-tags nil t))
+ (org-align-tags))
(end-of-line)
(when blank? (insert "\n"))
(insert "\n" stars " ")
@@ -7696,7 +7697,7 @@ Set it to HEADING when provided."
(if old (replace-match new t t nil 4)
(goto-char (or (match-end 3) (match-end 2) (match-end 1)))
(insert " " new))
- (org-set-tags nil t)
+ (org-align-tags)
(when (looking-at "[ \t]*$") (replace-match ""))))))))
(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"))
(t (replace-match up-head nil t)))
(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))))
(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) ?*) " "))
(diff (abs (- level (length down-head) -1))))
(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))
(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))))
(and org-auto-align-tags
(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
:last-refile)))
(when bookmark-name
@@ -11856,8 +11857,6 @@ insert an empty block."
If the last change removed the TODO tag or switched to DONE, then
this is nil.")
-(defvar org-setting-tags nil) ; dynamically scoped
-
(defvar org-todo-setup-filter-hook nil
"Hook for functions that pre-filter todo specs.
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)))
;; Fixup tag positioning.
(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
(org-update-parent-todo-statistics))
(run-hooks 'org-after-todo-state-change-hook)
@@ -13557,7 +13556,7 @@ ACTION can be `set', `up', `down', or a character."
(insert " [#" news "]"))
(goto-char (match-beginning 3))
(insert "[#" news "] "))))
- (org-set-tags nil 'align))
+ (org-align-tags))
(if remove
(message "Priority removed")
(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)
(cl-pushnew tag current :test #'equal))
(_ (setq current (delete tag current))))
- (org-set-tags-to (nreverse current))
- (run-hooks 'org-after-tags-change-hook)
+ (org-set-tags (nreverse current))
res)))
(defun org--align-tags-here (to-col)
@@ -14203,163 +14201,114 @@ Assume point is on a headline."
;; before tags.
(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")
- (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-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")
(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)
"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))
(user-error "\"%s\" is not a valid TODO state" value)))
(org-todo value)
- (org-set-tags nil 'align))
+ (org-align-tags))
((equal property "PRIORITY")
(org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
- (org-set-tags nil 'align))
+ (org-align-tags))
((equal property "SCHEDULED")
(forward-line)
(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 ()
"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
(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)
"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))
((or `headline `inlinetask)
(save-excursion (goto-char (org-element-property :begin context))
- (call-interactively #'org-set-tags)))
+ (call-interactively #'org-set-tags-command)))
(`item
;; At an item: `C-u C-u' sets checkbox to "[-]"
;; 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)))
;; When point is on an unsupported object type, we can miss
;; the fact that it also is at a heading. Handle it here.
- (call-interactively #'org-set-tags))
+ (call-interactively #'org-set-tags-command))
((guard
(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.
(cond
((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
(delete-indentation arg)))
@@ -20489,7 +20437,7 @@ object (e.g., within a comment). In these case, you need to use
;; Adjust tag alignment.
(cond
((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
(end-of-line)
(org-show-entry)
@@ -22827,7 +22775,7 @@ depending on context."
(if (<= end (point)) ;on tags part
(kill-region (point) (line-end-position))
(kill-region (point) end)))
- (org-set-tags nil t))
+ (org-align-tags))
(t (kill-region (point) (line-end-position)))))
(defun org-yank (&optional arg)
diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el
index 01cf0c9..1d2e338 100644
--- a/lisp/ox-beamer.el
+++ b/lisp/ox-beamer.el
@@ -916,7 +916,7 @@ value."
(let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x))
(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))
+ (org-set-tags (if env-tag (cons env-tag tags) tags))
(when env-tag (org-toggle-tag env-tag 'on)))))
((equal property "BEAMER_col")
(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-use-fast-tag-selection t)
(org-fast-tag-selection-single-key t))
- (org-set-tags)
+ (org-set-tags-command)
(let ((tags (org-get-tags nil t)))
(cond
;; For a column, automatically ask for its width.
diff --git a/testing/lisp/test-org-archive.el b/testing/lisp/test-org-archive.el
index f66fa4b..c654703 100644
--- a/testing/lisp/test-org-archive.el
+++ b/testing/lisp/test-org-archive.el
@@ -83,7 +83,8 @@
(equal "* Archive :ARCHIVE:\n** H\n"
(org-test-with-temp-text "* H\n"
(let ((org-archive-sibling-heading "Archive")
- (org-archive-tag "ARCHIVE"))
+ (org-archive-tag "ARCHIVE")
+ (org-tags-column 1))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
@@ -93,7 +94,8 @@
(equal "* Archive :ARCHIVE:\n* Top\n** Archive :ARCHIVE:\n*** H\n"
(org-test-with-temp-text "* Archive :ARCHIVE:\n* Top\n<point>** H\n"
(let ((org-archive-sibling-heading "Archive")
- (org-archive-tag "ARCHIVE"))
+ (org-archive-tag "ARCHIVE")
+ (org-tags-column 0))
(org-archive-to-archive-sibling)
(goto-char (point-min))
(buffer-substring-no-properties
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 4e47d94..dee6508 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -6111,86 +6111,176 @@ Paragraph<point>"
(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)))
+ (org-set-tags '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)
+ (org-set-tags nil)
(buffer-string))))
(should
(equal "* H"
(org-test-with-temp-text "* H :tag1:tag2:"
- (org-set-tags-to "")
+ (org-set-tags "")
(buffer-string))))
(should
(equal "* H"
(org-test-with-temp-text "* H :tag1:tag2:"
- (org-set-tags-to " ")
+ (org-set-tags " ")
(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)
+ (org-set-tags nil)
(buffer-string))))
(should
(equal "* "
(org-test-with-temp-text "* "
- (org-set-tags-to nil)
+ (org-set-tags 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:")
+ (let ((org-tags-column 1)) (org-set-tags ":tag0:"))
(buffer-string))))
(should
(equal "* H :tag0:"
(org-test-with-temp-text "* H"
- (org-set-tags-to ":tag0:")
+ (let ((org-tags-column 1)) (org-set-tags ":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"))
+ (let ((org-tags-column 1)) (org-set-tags '("tag0")))
(buffer-string))))
(should
(equal "* H :tag0:"
(org-test-with-temp-text "* H"
- (org-set-tags-to '("tag0"))
+ (let ((org-tags-column 1)) (org-set-tags '("tag0")))
(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.
(should
(equal "* :tag0:"
(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)))))
+
;;; TODO keywords