Fix multiple tag selection

* lisp/org.el (org--tag-add-to-alist): Preserve order when merging tag
  alists.  Remove duplicates only when they are outside a group.
  Rename from `org-tag-add-to-alist'.
(org-set-regexps-and-options):
(org-global-tags-completion-table):
(org-make-tags-matcher):
(org-set-tags):
(org-change-tag-in-region):
(org-agenda-prepare-buffers): Apply renaming.

Reported-by: Alex Branham <alex.branham@gmail.com>
<http://lists.gnu.org/r/emacs-orgmode/2018-04/msg00311.html>
This commit is contained in:
Nicolas Goaziou 2018-04-23 15:24:23 +02:00
parent e3b1c664e7
commit f1b43fe9e6
1 changed files with 36 additions and 14 deletions

View File

@ -4903,17 +4903,39 @@ Support for group tags is controlled by the option
(message "Groups tags support has been turned %s" (message "Groups tags support has been turned %s"
(if org-group-tags "on" "off"))) (if org-group-tags "on" "off")))
(defun org-tag-add-to-alist (alist1 alist2) (defun org--tag-add-to-alist (alist1 alist2)
"Append ALIST1 elements to ALIST2 if they are not there yet." "Merge tags from ALIST1 into ALIST2.
Duplicates tags outside a group are removed. Keywords and order
are preserved.
The function assumes ALIST1 and ALIST2 are proper tag alists.
See `org-tag-alist' for their structure."
(cond (cond
((null alist2) alist1) ((null alist2) alist1)
((null alist1) alist2) ((null alist1) alist2)
(t (let ((alist2-cars (mapcar (lambda (x) (car-safe x)) alist2)) (t
to-add) (let ((to-add nil)
(dolist (i alist1) (group-flag nil))
(unless (member (car-safe i) alist2-cars) (dolist (tag-pair alist1)
(push i to-add))) (pcase tag-pair
(append to-add alist2))))) (`(,(or :startgrouptag :startgroup))
(setq group-flag t)
(push tag-pair to-add))
(`(,(or :endgrouptag :endgroup))
(setq group-flag nil)
(push tag-pair to-add))
(`(,(or :grouptags :newline))
(push tag-pair to-add))
(`(,tag . ,_)
;; Remove duplicates from ALIST1, unless they are in
;; a group. Indeed, it makes sense to have a tag appear in
;; multiple groups.
(when (or group-flag (not (assoc tag alist2)))
(push tag-pair to-add)))
(_ (error "Invalid association in tag alist: %S" tag-pair))))
;; Preserve order of ALIST1.
(append (nreverse to-add) alist2)))))
(defun org-set-regexps-and-options (&optional tags-only) (defun org-set-regexps-and-options (&optional tags-only)
"Precompute regular expressions used in the current buffer. "Precompute regular expressions used in the current buffer.
@ -4943,7 +4965,7 @@ related expressions."
(mapcar #'org-add-prop-inherited (mapcar #'org-add-prop-inherited
(cdr (assq 'filetags alist)))) (cdr (assq 'filetags alist))))
(setq org-current-tag-alist (setq org-current-tag-alist
(org-tag-add-to-alist (org--tag-add-to-alist
org-tag-persistent-alist org-tag-persistent-alist
(let ((tags (cdr (assq 'tags alist)))) (let ((tags (cdr (assq 'tags alist))))
(if tags (org-tag-string-to-alist tags) (if tags (org-tag-string-to-alist tags)
@ -14340,7 +14362,7 @@ instead of the agenda files."
(mapcar (mapcar
(lambda (file) (lambda (file)
(set-buffer (find-file-noselect file)) (set-buffer (find-file-noselect file))
(org-tag-add-to-alist (org--tag-add-to-alist
(org-get-buffer-tags) (org-get-buffer-tags)
(mapcar (lambda (x) (mapcar (lambda (x)
(and (stringp (car-safe x)) (and (stringp (car-safe x))
@ -14372,7 +14394,7 @@ See also `org-scan-tags'."
;; Get a new match request, with completion against the global ;; Get a new match request, with completion against the global
;; tags table and the local tags in current buffer. ;; tags table and the local tags in current buffer.
(let ((org-last-tags-completion-table (let ((org-last-tags-completion-table
(org-tag-add-to-alist (org--tag-add-to-alist
(org-get-buffer-tags) (org-get-buffer-tags)
(org-global-tags-completion-table)))) (org-global-tags-completion-table))))
(setq match (setq match
@ -14891,7 +14913,7 @@ When JUST-ALIGN is non-nil, only align tags."
(let* ((table (let* ((table
(setq (setq
org-last-tags-completion-table org-last-tags-completion-table
(org-tag-add-to-alist (org--tag-add-to-alist
(and (and
org-complete-tags-always-offer-all-agenda-tags org-complete-tags-always-offer-all-agenda-tags
(org-global-tags-completion-table (org-global-tags-completion-table
@ -14976,7 +14998,7 @@ This works in the agenda, and also in an Org buffer."
(list (region-beginning) (region-end) (list (region-beginning) (region-end)
(let ((org-last-tags-completion-table (let ((org-last-tags-completion-table
(if (derived-mode-p 'org-mode) (if (derived-mode-p 'org-mode)
(org-tag-add-to-alist (org--tag-add-to-alist
(org-get-buffer-tags) (org-get-buffer-tags)
(org-global-tags-completion-table)) (org-global-tags-completion-table))
(org-global-tags-completion-table)))) (org-global-tags-completion-table))))
@ -18565,7 +18587,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(setq org-todo-keyword-alist-for-agenda (setq org-todo-keyword-alist-for-agenda
(append org-todo-keyword-alist-for-agenda org-todo-key-alist)) (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
(setq org-tag-alist-for-agenda (setq org-tag-alist-for-agenda
(org-tag-add-to-alist (org--tag-add-to-alist
org-tag-alist-for-agenda org-tag-alist-for-agenda
org-current-tag-alist)) org-current-tag-alist))
;; Merge current file's tag groups into global ;; Merge current file's tag groups into global