Fix fast tag selection affecting wrong line
* lisp/org.el (org-fast-tag-selection): Wrap `save-window-excursion' with `save-excursion'. In the case when the tags are changed remotely from the agenda, and the affected buffer is already visible in another window, the tag change was applied to the currently visible line in the target buffer, not the headline in the agenda.
This commit is contained in:
Ingo Lohmar
Nicolas Goaziou
parent
e95ac0bac3
commit
d1ce59571f
317
lisp/org.el
317
lisp/org.el
|
|
@ -14564,168 +14564,169 @@ Returns the new tags string, or nil to not change the current settings."
|
||||||
" "
|
" "
|
||||||
(make-string (- org-tags-column (current-column)) ?\ ))))))
|
(make-string (- org-tags-column (current-column)) ?\ ))))))
|
||||||
(move-overlay org-tags-overlay ov-start ov-end)
|
(move-overlay org-tags-overlay ov-start ov-end)
|
||||||
(save-window-excursion
|
(save-excursion
|
||||||
(if expert
|
(save-window-excursion
|
||||||
(set-buffer (get-buffer-create " *Org tags*"))
|
(if expert
|
||||||
(delete-other-windows)
|
(set-buffer (get-buffer-create " *Org tags*"))
|
||||||
(set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
|
(delete-other-windows)
|
||||||
(org-switch-to-buffer-other-window " *Org tags*"))
|
(set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
|
||||||
(erase-buffer)
|
(org-switch-to-buffer-other-window " *Org tags*"))
|
||||||
(setq-local org-done-keywords done-keywords)
|
(erase-buffer)
|
||||||
(org-fast-tag-insert "Inherited" inherited i-face "\n")
|
(setq-local org-done-keywords done-keywords)
|
||||||
(org-fast-tag-insert "Current" current c-face "\n\n")
|
(org-fast-tag-insert "Inherited" inherited i-face "\n")
|
||||||
(org-fast-tag-show-exit exit-after-next)
|
(org-fast-tag-insert "Current" current c-face "\n\n")
|
||||||
(org-set-current-tags-overlay current ov-prefix)
|
(org-fast-tag-show-exit exit-after-next)
|
||||||
(setq tbl fulltable char ?a cnt 0)
|
(org-set-current-tags-overlay current ov-prefix)
|
||||||
(while (setq e (pop tbl))
|
(setq tbl fulltable char ?a cnt 0)
|
||||||
(cond
|
(while (setq e (pop tbl))
|
||||||
((eq (car e) :startgroup)
|
(cond
|
||||||
(push '() groups) (setq ingroup t)
|
((eq (car e) :startgroup)
|
||||||
(unless (zerop cnt)
|
(push '() groups) (setq ingroup t)
|
||||||
(setq cnt 0)
|
(unless (zerop cnt)
|
||||||
(insert "\n"))
|
(setq cnt 0)
|
||||||
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
|
(insert "\n"))
|
||||||
((eq (car e) :endgroup)
|
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
|
||||||
(setq ingroup nil cnt 0)
|
((eq (car e) :endgroup)
|
||||||
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
|
(setq ingroup nil cnt 0)
|
||||||
((eq (car e) :startgrouptag)
|
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
|
||||||
(setq intaggroup t)
|
((eq (car e) :startgrouptag)
|
||||||
(unless (zerop cnt)
|
(setq intaggroup t)
|
||||||
(setq cnt 0)
|
(unless (zerop cnt)
|
||||||
(insert "\n"))
|
(setq cnt 0)
|
||||||
(insert "[ "))
|
(insert "\n"))
|
||||||
((eq (car e) :endgrouptag)
|
(insert "[ "))
|
||||||
(setq intaggroup nil cnt 0)
|
((eq (car e) :endgrouptag)
|
||||||
(insert "]\n"))
|
(setq intaggroup nil cnt 0)
|
||||||
((equal e '(:newline))
|
(insert "]\n"))
|
||||||
(unless (zerop cnt)
|
((equal e '(:newline))
|
||||||
(setq cnt 0)
|
(unless (zerop cnt)
|
||||||
(insert "\n")
|
(setq cnt 0)
|
||||||
(setq e (car tbl))
|
|
||||||
(while (equal (car tbl) '(:newline))
|
|
||||||
(insert "\n")
|
(insert "\n")
|
||||||
(setq tbl (cdr tbl)))))
|
(setq e (car tbl))
|
||||||
((equal e '(:grouptags)) (insert " : "))
|
(while (equal (car tbl) '(:newline))
|
||||||
(t
|
(insert "\n")
|
||||||
(setq tg (copy-sequence (car e)) c2 nil)
|
(setq tbl (cdr tbl)))))
|
||||||
(if (cdr e)
|
((equal e '(:grouptags)) (insert " : "))
|
||||||
(setq c (cdr e))
|
(t
|
||||||
;; automatically assign a character.
|
(setq tg (copy-sequence (car e)) c2 nil)
|
||||||
(setq c1 (string-to-char
|
(if (cdr e)
|
||||||
(downcase (substring
|
(setq c (cdr e))
|
||||||
tg (if (= (string-to-char tg) ?@) 1 0)))))
|
;; automatically assign a character.
|
||||||
(if (or (rassoc c1 ntable) (rassoc c1 table))
|
(setq c1 (string-to-char
|
||||||
(while (or (rassoc char ntable) (rassoc char table))
|
(downcase (substring
|
||||||
(setq char (1+ char)))
|
tg (if (= (string-to-char tg) ?@) 1 0)))))
|
||||||
(setq c2 c1))
|
(if (or (rassoc c1 ntable) (rassoc c1 table))
|
||||||
(setq c (or c2 char)))
|
(while (or (rassoc char ntable) (rassoc char table))
|
||||||
(when ingroup (push tg (car groups)))
|
(setq char (1+ char)))
|
||||||
(setq tg (org-add-props tg nil 'face
|
(setq c2 c1))
|
||||||
(cond
|
(setq c (or c2 char)))
|
||||||
((not (assoc tg table))
|
(when ingroup (push tg (car groups)))
|
||||||
(org-get-todo-face tg))
|
(setq tg (org-add-props tg nil 'face
|
||||||
((member tg current) c-face)
|
(cond
|
||||||
((member tg inherited) i-face))))
|
((not (assoc tg table))
|
||||||
(when (equal (caar tbl) :grouptags)
|
(org-get-todo-face tg))
|
||||||
(org-add-props tg nil 'face 'org-tag-group))
|
((member tg current) c-face)
|
||||||
(when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
|
((member tg inherited) i-face))))
|
||||||
(insert "[" c "] " tg (make-string
|
(when (equal (caar tbl) :grouptags)
|
||||||
(- fwidth 4 (length tg)) ?\ ))
|
(org-add-props tg nil 'face 'org-tag-group))
|
||||||
(push (cons tg c) ntable)
|
(when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
|
||||||
(when (= (cl-incf cnt) ncol)
|
(insert "[" c "] " tg (make-string
|
||||||
(unless (memq (caar tbl) '(:endgroup :endgrouptag))
|
(- fwidth 4 (length tg)) ?\ ))
|
||||||
(insert "\n")
|
(push (cons tg c) ntable)
|
||||||
(when (or ingroup intaggroup) (insert " ")))
|
(when (= (cl-incf cnt) ncol)
|
||||||
(setq cnt 0)))))
|
(unless (memq (caar tbl) '(:endgroup :endgrouptag))
|
||||||
(setq ntable (nreverse ntable))
|
(insert "\n")
|
||||||
(insert "\n")
|
(when (or ingroup intaggroup) (insert " ")))
|
||||||
(goto-char (point-min))
|
(setq cnt 0)))))
|
||||||
(unless expert (org-fit-window-to-buffer))
|
(setq ntable (nreverse ntable))
|
||||||
(setq rtn
|
(insert "\n")
|
||||||
(catch 'exit
|
(goto-char (point-min))
|
||||||
(while t
|
(unless expert (org-fit-window-to-buffer))
|
||||||
(message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
|
(setq rtn
|
||||||
(if (not groups) "no " "")
|
(catch 'exit
|
||||||
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
(while t
|
||||||
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
(message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
|
||||||
(setq org-last-tag-selection-key c)
|
(if (not groups) "no " "")
|
||||||
(cond
|
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
||||||
((= c ?\r) (throw 'exit t))
|
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
||||||
((= c ?!)
|
(setq org-last-tag-selection-key c)
|
||||||
(setq groups (not groups))
|
(cond
|
||||||
(goto-char (point-min))
|
((= c ?\r) (throw 'exit t))
|
||||||
(while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
((= c ?!)
|
||||||
((= c ?\C-c)
|
(setq groups (not groups))
|
||||||
(if (not expert)
|
(goto-char (point-min))
|
||||||
(org-fast-tag-show-exit
|
(while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
||||||
(setq exit-after-next (not exit-after-next)))
|
((= c ?\C-c)
|
||||||
(setq expert nil)
|
(if (not expert)
|
||||||
(delete-other-windows)
|
(org-fast-tag-show-exit
|
||||||
(set-window-buffer (split-window-vertically) " *Org tags*")
|
(setq exit-after-next (not exit-after-next)))
|
||||||
(org-switch-to-buffer-other-window " *Org tags*")
|
(setq expert nil)
|
||||||
(org-fit-window-to-buffer)))
|
(delete-other-windows)
|
||||||
((or (= c ?\C-g)
|
(set-window-buffer (split-window-vertically) " *Org tags*")
|
||||||
(and (= c ?q) (not (rassoc c ntable))))
|
(org-switch-to-buffer-other-window " *Org tags*")
|
||||||
(delete-overlay org-tags-overlay)
|
(org-fit-window-to-buffer)))
|
||||||
(setq quit-flag t))
|
((or (= c ?\C-g)
|
||||||
((= c ?\ )
|
(and (= c ?q) (not (rassoc c ntable))))
|
||||||
(setq current nil)
|
(delete-overlay org-tags-overlay)
|
||||||
(when exit-after-next (setq exit-after-next 'now)))
|
(setq quit-flag t))
|
||||||
((= c ?\t)
|
((= c ?\ )
|
||||||
(condition-case nil
|
(setq current nil)
|
||||||
(setq tg (completing-read
|
(when exit-after-next (setq exit-after-next 'now)))
|
||||||
"Tag: "
|
((= c ?\t)
|
||||||
(or buffer-tags
|
(condition-case nil
|
||||||
(with-current-buffer buf
|
(setq tg (completing-read
|
||||||
(setq buffer-tags
|
"Tag: "
|
||||||
(org-get-buffer-tags))))))
|
(or buffer-tags
|
||||||
(quit (setq tg "")))
|
(with-current-buffer buf
|
||||||
(when (string-match "\\S-" tg)
|
(setq buffer-tags
|
||||||
(cl-pushnew (list tg) buffer-tags :test #'equal)
|
(org-get-buffer-tags))))))
|
||||||
|
(quit (setq tg "")))
|
||||||
|
(when (string-match "\\S-" tg)
|
||||||
|
(cl-pushnew (list tg) buffer-tags :test #'equal)
|
||||||
|
(if (member tg current)
|
||||||
|
(setq current (delete tg current))
|
||||||
|
(push tg current)))
|
||||||
|
(when exit-after-next (setq exit-after-next 'now)))
|
||||||
|
((setq e (rassoc c todo-table) tg (car e))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(save-excursion (org-todo tg)))
|
||||||
|
(when exit-after-next (setq exit-after-next 'now)))
|
||||||
|
((setq e (rassoc c ntable) tg (car e))
|
||||||
(if (member tg current)
|
(if (member tg current)
|
||||||
(setq current (delete tg current))
|
(setq current (delete tg current))
|
||||||
(push tg current)))
|
(cl-loop for g in groups do
|
||||||
(when exit-after-next (setq exit-after-next 'now)))
|
(when (member tg g)
|
||||||
((setq e (rassoc c todo-table) tg (car e))
|
(dolist (x g) (setq current (delete x current)))))
|
||||||
(with-current-buffer buf
|
(push tg current))
|
||||||
(save-excursion (org-todo tg)))
|
(when exit-after-next (setq exit-after-next 'now))))
|
||||||
(when exit-after-next (setq exit-after-next 'now)))
|
|
||||||
((setq e (rassoc c ntable) tg (car e))
|
|
||||||
(if (member tg current)
|
|
||||||
(setq current (delete tg current))
|
|
||||||
(cl-loop for g in groups do
|
|
||||||
(when (member tg g)
|
|
||||||
(dolist (x g) (setq current (delete x current)))))
|
|
||||||
(push tg current))
|
|
||||||
(when exit-after-next (setq exit-after-next 'now))))
|
|
||||||
|
|
||||||
;; Create a sorted list
|
;; Create a sorted list
|
||||||
(setq current
|
(setq current
|
||||||
(sort current
|
(sort current
|
||||||
(lambda (a b)
|
(lambda (a b)
|
||||||
(assoc b (cdr (memq (assoc a ntable) ntable))))))
|
(assoc b (cdr (memq (assoc a ntable) ntable))))))
|
||||||
(when (eq exit-after-next 'now) (throw 'exit t))
|
(when (eq exit-after-next 'now) (throw 'exit t))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(beginning-of-line 2)
|
(beginning-of-line 2)
|
||||||
(delete-region (point) (point-at-eol))
|
(delete-region (point) (point-at-eol))
|
||||||
(org-fast-tag-insert "Current" current c-face)
|
(org-fast-tag-insert "Current" current c-face)
|
||||||
(org-set-current-tags-overlay current ov-prefix)
|
(org-set-current-tags-overlay current ov-prefix)
|
||||||
(let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)")))
|
(let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)")))
|
||||||
(while (re-search-forward tag-re nil t)
|
(while (re-search-forward tag-re nil t)
|
||||||
(let ((tag (match-string 1)))
|
(let ((tag (match-string 1)))
|
||||||
(add-text-properties
|
(add-text-properties
|
||||||
(match-beginning 1) (match-end 1)
|
(match-beginning 1) (match-end 1)
|
||||||
(list 'face
|
(list 'face
|
||||||
(cond
|
(cond
|
||||||
((member tag current) c-face)
|
((member tag current) c-face)
|
||||||
((member tag inherited) i-face)
|
((member tag inherited) i-face)
|
||||||
(t (get-text-property (match-beginning 1) '
|
(t (get-text-property (match-beginning 1) '
|
||||||
face))))))))
|
face))))))))
|
||||||
(goto-char (point-min)))))
|
(goto-char (point-min)))))
|
||||||
(delete-overlay org-tags-overlay)
|
(delete-overlay org-tags-overlay)
|
||||||
(if rtn
|
(if rtn
|
||||||
(mapconcat 'identity current ":")
|
(mapconcat 'identity current ":")
|
||||||
nil))))
|
nil)))))
|
||||||
|
|
||||||
(defun org-make-tag-string (tags)
|
(defun org-make-tag-string (tags)
|
||||||
"Return string associated to TAGS.
|
"Return string associated to TAGS.
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue