forked from mirrors/org-mode
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.
This commit is contained in:
Nicolas Goaziou
parent
be31a0c459
commit
4d152b994e
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
300
lisp/org.el
300
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."
|
||||
(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-command (&optional arg)
|
||||
"Set the tags for the current visible entry.
|
||||
|
||||
(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)))))
|
||||
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")
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue