Bastien
I can verify that this has fixed the problem with tag completion not prompting for all tags. I see that commit 647396464d563634b980127673cf61769663407e has added a wrapper (append that combines buffer-tags with (mapcar 'car table).
This has, however, exposed a new bug and conflict with org-completion-use-ido that I can minimally reproduce below.
1 Steps to Reproduce:
1.1 Start Emacs clean
/Applications/Emacs.app/Contents/MacOS/Emacs -Q
1.1.1 Note: Emacs Version
M-x emacs-version <RET> GNU Emacs 24.0.94.1 (x86_64-apple-darwin, NS apple-appkit-1038.36) of 2012-03-27 on bob.porkrind.org
1.2 Clone Git HEAD Org-Mode (to get the new commit)
$ git clone git://orgmode.org/org-mode.git
1.3 Load Cloned version of org-mode
Evaluate the following Lisp in *scratch*
(require 'ido) (ido-mode t) (setq load-path (cons "~/tmp/new-new-new/org-mode/lisp" load-path)) (setq load-path (cons "~/tmp/new-new-new/org-mode/contrib/lisp" load-path)) (require 'org-install) (setq org-completion-use-ido t) (setq org-tag-alist (quote ( ("tag_a" . ?a) ("tag_b" . ?b) )))
1.4 Open the following org-mode file
* Header 1 ** Header 1.1 * Header 2 :Personal:
1.4.1 Note: Org-Version
M-x org-version <RET> release_7.8.06-180-g22bfd Org-mode version 7.8.06 (release_7.8.06.180.g22bfd)
1.5 Point should be on the first asterisk for “Header 1”
1.6 Type C-c C-q to bring up Tag selection
The expected result is the fast tag selection window-split; this works
1.7 Type <TAB> to enter free tag selection
The expected result is that the Minibuffer prompts with Tag:; the result is an error:
mapcar: Wrong type argument: listp, "tag_a"
1.8 Execute M-x toggle-debug-on-error
1.9 Point should be on the first asterisk for “Header 1”
1.10 Type C-c C-q to bring up Tag selection
The expected result is the fast tag selection window-split; this works
1.11 Type <TAB> to enter free tag selection
The expected result is that the Minibuffer prompts with Tag:; the result is an error:
Debugger entered--Lisp error: (wrong-type-argument listp "tag_a")
car("tag_a")
mapcar(car (("Personal") "tag_a" "tag_b" "Personal"))
(if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args))
(apply (quote ido-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args))
(let ((ido-enter-matching-directory nil)) (apply (quote ido-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args)))
(if (and org-completion-use-ido (fboundp (quote ido-completing-read)) (boundp (quote ido-mode)) ido-mode (listp (second args))) (let ((ido-enter-matching-directory nil)) (apply (quote ido-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args))) (if (and org-completion-use-iswitchb (boundp (quote iswitchb-mode)) iswitchb-mode (listp (second args))) (apply (quote org-iswitchb-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args)) (apply (quote completing-read) args)))
(if (and (boundp (quote partial-completion-mode)) partial-completion-mode (fboundp (quote partial-completion-mode))) (unwind-protect (progn (partial-completion-mode -1) (if (and org-completion-use-ido (fboundp (quote ido-completing-read)) (boundp (quote ido-mode)) ido-mode (listp (second args))) (let ((ido-enter-matching-directory nil)) (apply (quote ido-completing-read) (concat (car args)) (if (consp ...) (mapcar ... ...) (nth 1 args)) (cddr args))) (if (and org-completion-use-iswitchb (boundp (quote iswitchb-mode)) iswitchb-mode (listp (second args))) (apply (quote org-iswitchb-completing-read) (concat (car args)) (if (consp ...) (mapcar ... ...) (nth 1 args)) (cddr args)) (apply (quote completing-read) args)))) (partial-completion-mode 1)) (if (and org-completion-use-ido (fboundp (quote ido-completing-read)) (boundp (quote ido-mode)) ido-mode (listp (second args))) (let ((ido-enter-matching-directory nil)) (apply (quote ido-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args))) (if (and org-completion-use-iswitchb (boundp (quote iswitchb-mode)) iswitchb-mode (listp (second args))) (apply (quote org-iswitchb-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args)) (apply (quote completing-read) args))))
(org-without-partial-completion (if (and org-completion-use-ido (fboundp (quote ido-completing-read)) (boundp (quote ido-mode)) ido-mode (listp (second args))) (let ((ido-enter-matching-directory nil)) (apply (quote ido-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args))) (if (and org-completion-use-iswitchb (boundp (quote iswitchb-mode)) iswitchb-mode (listp (second args))) (apply (quote org-iswitchb-completing-read) (concat (car args)) (if (consp (car (nth 1 args))) (mapcar (quote car) (nth 1 args)) (nth 1 args)) (cddr args)) (apply (quote completing-read) args))))
org-icompleting-read("Tag: " (("Personal") "tag_a" "tag_b" "Personal"))
(setq tg (org-icompleting-read "Tag: " (append (or buffer-tags (with-current-buffer buf (org-get-buffer-tags))) (mapcar (quote car) table))))
(condition-case nil (setq tg (org-icompleting-read "Tag: " (append (or buffer-tags (with-current-buffer buf (org-get-buffer-tags))) (mapcar (quote car) table)))) (quit (setq tg "")))
(cond ((= c 13) (throw (quote exit) t)) ((= c 33) (setq groups (not groups)) (goto-char (point-min)) (while (re-search-forward "[{}]" nil t) (replace-match " "))) ((= c 3) (if (not expert) (org-fast-tag-show-exit (setq exit-after-next (not exit-after-next))) (setq expert nil) (delete-other-windows) (set-window-buffer (split-window-vertically) " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c 7) (and (= c 113) (not (rassoc c ntable)))) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next (setq exit-after-next (quote now)))) ((= c 9) (condition-case nil (setq tg (org-icompleting-read "Tag: " (append (or buffer-tags (with-current-buffer buf ...)) (mapcar (quote car) table)))) (quit (setq tg ""))) (when (string-match "\\S-" tg) (add-to-list (quote buffer-tags) (list tg)) (if (member tg current) (setq current (delete tg current)) (push tg current))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion (org-todo tg))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) (loop for g in groups do (if (member tg g) (mapc (lambda (x) (setq current ...)) g))) (push tg current)) (if exit-after-next (setq exit-after-next (quote now)))))
(while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw (quote exit) t)) ((= c 33) (setq groups (not groups)) (goto-char (point-min)) (while (re-search-forward "[{}]" nil t) (replace-match " "))) ((= c 3) (if (not expert) (org-fast-tag-show-exit (setq exit-after-next (not exit-after-next))) (setq expert nil) (delete-other-windows) (set-window-buffer (split-window-vertically) " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c 7) (and (= c 113) (not (rassoc c ntable)))) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next (setq exit-after-next (quote now)))) ((= c 9) (condition-case nil (setq tg (org-icompleting-read "Tag: " (append (or buffer-tags ...) (mapcar ... table)))) (quit (setq tg ""))) (when (string-match "\\S-" tg) (add-to-list (quote buffer-tags) (list tg)) (if (member tg current) (setq current (delete tg current)) (push tg current))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion (org-todo tg))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) (loop for g in groups do (if (member tg g) (mapc (lambda ... ...) g))) (push tg current)) (if exit-after-next (setq exit-after-next (quote now))))) (setq current (sort current (lambda (a b) (assoc b (cdr (memq (assoc a ntable) ntable)))))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list (quote face) (cond ((member tg current) c-face) ((member tg inherited) i-face) (t (get-text-property (match-beginning 1) (quote face))))))) (goto-char (point-min)))
(catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw (quote exit) t)) ((= c 33) (setq groups (not groups)) (goto-char (point-min)) (while (re-search-forward "[{}]" nil t) (replace-match " "))) ((= c 3) (if (not expert) (org-fast-tag-show-exit (setq exit-after-next (not exit-after-next))) (setq expert nil) (delete-other-windows) (set-window-buffer (split-window-vertically) " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c 7) (and (= c 113) (not (rassoc c ntable)))) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next (setq exit-after-next (quote now)))) ((= c 9) (condition-case nil (setq tg (org-icompleting-read "Tag: " (append ... ...))) (quit (setq tg ""))) (when (string-match "\\S-" tg) (add-to-list (quote buffer-tags) (list tg)) (if (member tg current) (setq current (delete tg current)) (push tg current))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion (org-todo tg))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) (loop for g in groups do (if (member tg g) (mapc ... g))) (push tg current)) (if exit-after-next (setq exit-after-next (quote now))))) (setq current (sort current (lambda (a b) (assoc b (cdr (memq ... ntable)))))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list (quote face) (cond ((member tg current) c-face) ((member tg inherited) i-face) (t (get-text-property ... ...)))))) (goto-char (point-min))))
(setq rtn (catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw (quote exit) t)) ((= c 33) (setq groups (not groups)) (goto-char (point-min)) (while (re-search-forward "[{}]" nil t) (replace-match " "))) ((= c 3) (if (not expert) (org-fast-tag-show-exit (setq exit-after-next ...)) (setq expert nil) (delete-other-windows) (set-window-buffer (split-window-vertically) " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c 7) (and (= c 113) (not ...))) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next (setq exit-after-next (quote now)))) ((= c 9) (condition-case nil (setq tg (org-icompleting-read "Tag: " ...)) (quit (setq tg ""))) (when (string-match "\\S-" tg) (add-to-list (quote buffer-tags) (list tg)) (if (member tg current) (setq current ...) (push tg current))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion (org-todo tg))) (if exit-after-next (setq exit-after-next (quote now)))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) (loop for g in groups do (if ... ...)) (push tg current)) (if exit-after-next (setq exit-after-next (quote now))))) (setq current (sort current (lambda (a b) (assoc b (cdr ...))))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list (quote face) (cond (... c-face) (... i-face) (t ...))))) (goto-char (point-min)))))
(progn (if expert (set-buffer (get-buffer-create " *Org tags*")) (delete-other-windows) (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) (org-set-local (quote org-done-keywords) done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char 97 cnt 0) (while (setq e (pop tbl)) (cond ((equal (car e) :startgroup) (push (quote nil) groups) (setq ingroup t) (when (not (= cnt 0)) (setq cnt 0) (insert "\n")) (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) ((equal (car e) :endgroup) (setq ingroup nil cnt 0) (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) ((equal e (quote (:newline))) (when (not (= cnt 0)) (setq cnt 0) (insert "\n") (setq e (car tbl)) (while (equal (car tbl) (quote ...)) (insert "\n") (setq tbl (cdr tbl))))) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) (setq c (cdr e)) (setq c1 (string-to-char (downcase ...))) (if (or (rassoc c1 ntable) (rassoc c1 table)) (while (or ... ...) (setq char ...)) (setq c2 c1)) (setq c (or c2 char))) (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil (quote face) (cond (... ...) (... c-face) (... i-face) (t nil)))) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) 32)) (push (cons tg c) ntable) (when (= (setq cnt (1+ cnt)) ncol) (insert "\n") (if ingroup (insert " ")) (setq cnt 0))))) (setq ntable (nreverse ntable)) (insert "\n") (goto-char (point-min)) (if (not expert) (org-fit-window-to-buffer)) (setq rtn (catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw (quote exit) t)) ((= c 33) (setq groups (not groups)) (goto-char (point-min)) (while (re-search-forward "[{}]" nil t) (replace-match " "))) ((= c 3) (if (not expert) (org-fast-tag-show-exit ...) (setq expert nil) (delete-other-windows) (set-window-buffer ... " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c 7) (and ... ...)) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next (setq exit-after-next ...))) ((= c 9) (condition-case nil (setq tg ...) (quit ...)) (when (string-match "\\S-" tg) (add-to-list ... ...) (if ... ... ...)) (if exit-after-next (setq exit-after-next ...))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion ...)) (if exit-after-next (setq exit-after-next ...))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current ...) (loop for g in groups do ...) (push tg current)) (if exit-after-next (setq exit-after-next ...)))) (setq current (sort current (lambda (a b) (assoc b ...)))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list (quote face) (cond ... ... ...)))) (goto-char (point-min))))) (org-detach-overlay org-tags-overlay) (if rtn (mapconcat (quote identity) current ":") nil))
(unwind-protect (progn (if expert (set-buffer (get-buffer-create " *Org tags*")) (delete-other-windows) (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) (org-set-local (quote org-done-keywords) done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char 97 cnt 0) (while (setq e (pop tbl)) (cond ((equal (car e) :startgroup) (push (quote nil) groups) (setq ingroup t) (when (not (= cnt 0)) (setq cnt 0) (insert "\n")) (insert (if (cdr e) (format "%s: " ...) "") "{ ")) ((equal (car e) :endgroup) (setq ingroup nil cnt 0) (insert "}" (if (cdr e) (format " (%s) " ...) "") "\n")) ((equal e (quote (:newline))) (when (not (= cnt 0)) (setq cnt 0) (insert "\n") (setq e (car tbl)) (while (equal ... ...) (insert "\n") (setq tbl ...)))) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) (setq c (cdr e)) (setq c1 (string-to-char ...)) (if (or ... ...) (while ... ...) (setq c2 c1)) (setq c (or c2 char))) (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil (quote face) (cond ... ... ... ...))) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 ...) 32)) (push (cons tg c) ntable) (when (= (setq cnt ...) ncol) (insert "\n") (if ingroup (insert " ")) (setq cnt 0))))) (setq ntable (nreverse ntable)) (insert "\n") (goto-char (point-min)) (if (not expert) (org-fit-window-to-buffer)) (setq rtn (catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let (...) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw ... t)) ((= c 33) (setq groups ...) (goto-char ...) (while ... ...)) ((= c 3) (if ... ... ... ... ... ... ...)) ((or ... ...) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next ...)) ((= c 9) (condition-case nil ... ...) (when ... ... ...) (if exit-after-next ...)) ((setq e ... tg ...) (with-current-buffer buf ...) (if exit-after-next ...)) ((setq e ... tg ...) (if ... ... ... ...) (if exit-after-next ...))) (setq current (sort current (lambda ... ...))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list ... ...))) (goto-char (point-min))))) (org-detach-overlay org-tags-overlay) (if rtn (mapconcat (quote identity) current ":") nil)) (set-window-configuration wconfig))
(let ((wconfig (current-window-configuration))) (unwind-protect (progn (if expert (set-buffer (get-buffer-create " *Org tags*")) (delete-other-windows) (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) (org-set-local (quote org-done-keywords) done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char 97 cnt 0) (while (setq e (pop tbl)) (cond ((equal (car e) :startgroup) (push (quote nil) groups) (setq ingroup t) (when (not ...) (setq cnt 0) (insert "\n")) (insert (if ... ... "") "{ ")) ((equal (car e) :endgroup) (setq ingroup nil cnt 0) (insert "}" (if ... ... "") "\n")) ((equal e (quote ...)) (when (not ...) (setq cnt 0) (insert "\n") (setq e ...) (while ... ... ...))) (t (setq tg (copy-sequence ...) c2 nil) (if (cdr e) (setq c ...) (setq c1 ...) (if ... ... ...) (setq c ...)) (if ingroup (push tg ...)) (setq tg (org-add-props tg nil ... ...)) (if (and ... ...) (insert " ")) (insert "[" c "] " tg (make-string ... 32)) (push (cons tg c) ntable) (when (= ... ncol) (insert "\n") (if ingroup ...) (setq cnt 0))))) (setq ntable (nreverse ntable)) (insert "\n") (goto-char (point-min)) (if (not expert) (org-fit-window-to-buffer)) (setq rtn (catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if ... "no " "") (if expert " [C-c]:window" ...)) (setq c (let ... ...)) (setq org-last-tag-selection-key c) (cond (... ...) (... ... ... ...) (... ...) (... ... ...) (... ... ...) (... ... ... ...) (... ... ...) (... ... ...)) (setq current (sort current ...)) (if (eq exit-after-next ...) (throw ... t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward ... nil t) (setq tg ...) (add-text-properties ... ... ...)) (goto-char (point-min))))) (org-detach-overlay org-tags-overlay) (if rtn (mapconcat (quote identity) current ":") nil)) (set-window-configuration wconfig)))
(save-window-excursion (if expert (set-buffer (get-buffer-create " *Org tags*")) (delete-other-windows) (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) (org-set-local (quote org-done-keywords) done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char 97 cnt 0) (while (setq e (pop tbl)) (cond ((equal (car e) :startgroup) (push (quote nil) groups) (setq ingroup t) (when (not (= cnt 0)) (setq cnt 0) (insert "\n")) (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) ((equal (car e) :endgroup) (setq ingroup nil cnt 0) (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) ((equal e (quote (:newline))) (when (not (= cnt 0)) (setq cnt 0) (insert "\n") (setq e (car tbl)) (while (equal (car tbl) (quote ...)) (insert "\n") (setq tbl (cdr tbl))))) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) (setq c (cdr e)) (setq c1 (string-to-char (downcase ...))) (if (or (rassoc c1 ntable) (rassoc c1 table)) (while (or ... ...) (setq char ...)) (setq c2 c1)) (setq c (or c2 char))) (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil (quote face) (cond (... ...) (... c-face) (... i-face) (t nil)))) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) 32)) (push (cons tg c) ntable) (when (= (setq cnt (1+ cnt)) ncol) (insert "\n") (if ingroup (insert " ")) (setq cnt 0))))) (setq ntable (nreverse ntable)) (insert "\n") (goto-char (point-min)) (if (not expert) (org-fit-window-to-buffer)) (setq rtn (catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw (quote exit) t)) ((= c 33) (setq groups (not groups)) (goto-char (point-min)) (while (re-search-forward "[{}]" nil t) (replace-match " "))) ((= c 3) (if (not expert) (org-fast-tag-show-exit ...) (setq expert nil) (delete-other-windows) (set-window-buffer ... " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c 7) (and ... ...)) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next (setq exit-after-next ...))) ((= c 9) (condition-case nil (setq tg ...) (quit ...)) (when (string-match "\\S-" tg) (add-to-list ... ...) (if ... ... ...)) (if exit-after-next (setq exit-after-next ...))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion ...)) (if exit-after-next (setq exit-after-next ...))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current ...) (loop for g in groups do ...) (push tg current)) (if exit-after-next (setq exit-after-next ...)))) (setq current (sort current (lambda (a b) (assoc b ...)))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list (quote face) (cond ... ... ...)))) (goto-char (point-min))))) (org-detach-overlay org-tags-overlay) (if rtn (mapconcat (quote identity) current ":") nil))
(let* ((fulltable (append table todo-table)) (maxlen (apply (quote max) (mapcar (lambda (x) (if (stringp ...) (string-width ...) 0)) fulltable))) (buf (current-buffer)) (expert (eq org-fast-tag-selection-single-key (quote expert))) (buffer-tags nil) (fwidth (+ maxlen 3 1 3)) (ncol (/ (- (window-width) 4) fwidth)) (i-face (quote org-done)) (c-face (quote org-todo)) tg cnt e c char c1 c2 ntable tbl rtn ov-start ov-end ov-prefix (exit-after-next org-fast-tag-selection-single-key) (done-keywords org-done-keywords) groups ingroup) (save-excursion (beginning-of-line 1) (if (looking-at (org-re ".*[ ]\\(:[[:alnum:]_@#%:]+:\\)[ ]*$")) (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") (setq ov-start (1- (point-at-eol)) ov-end (1+ ov-start)) (skip-chars-forward "^\n
") (setq ov-prefix (concat (buffer-substring (1- (point)) (point)) (if (> (current-column) org-tags-column) " " (make-string (- org-tags-column ...) 32)))))) (move-overlay org-tags-overlay ov-start ov-end) (save-window-excursion (if expert (set-buffer (get-buffer-create " *Org tags*")) (delete-other-windows) (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) (org-set-local (quote org-done-keywords) done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char 97 cnt 0) (while (setq e (pop tbl)) (cond ((equal (car e) :startgroup) (push (quote nil) groups) (setq ingroup t) (when (not (= cnt 0)) (setq cnt 0) (insert "\n")) (insert (if (cdr e) (format "%s: " ...) "") "{ ")) ((equal (car e) :endgroup) (setq ingroup nil cnt 0) (insert "}" (if (cdr e) (format " (%s) " ...) "") "\n")) ((equal e (quote (:newline))) (when (not (= cnt 0)) (setq cnt 0) (insert "\n") (setq e (car tbl)) (while (equal ... ...) (insert "\n") (setq tbl ...)))) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) (setq c (cdr e)) (setq c1 (string-to-char ...)) (if (or ... ...) (while ... ...) (setq c2 c1)) (setq c (or c2 char))) (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil (quote face) (cond ... ... ... ...))) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 ...) 32)) (push (cons tg c) ntable) (when (= (setq cnt ...) ncol) (insert "\n") (if ingroup (insert " ")) (setq cnt 0))))) (setq ntable (nreverse ntable)) (insert "\n") (goto-char (point-min)) (if (not expert) (org-fit-window-to-buffer)) (setq rtn (catch (quote exit) (while t (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let (...) (read-char-exclusive))) (setq org-last-tag-selection-key c) (cond ((= c 13) (throw ... t)) ((= c 33) (setq groups ...) (goto-char ...) (while ... ...)) ((= c 3) (if ... ... ... ... ... ... ...)) ((or ... ...) (org-detach-overlay org-tags-overlay) (setq quit-flag t)) ((= c 32) (setq current nil) (if exit-after-next ...)) ((= c 9) (condition-case nil ... ...) (when ... ... ...) (if exit-after-next ...)) ((setq e ... tg ...) (with-current-buffer buf ...) (if exit-after-next ...)) ((setq e ... tg ...) (if ... ... ... ...) (if exit-after-next ...))) (setq current (sort current (lambda ... ...))) (if (eq exit-after-next (quote now)) (throw (quote exit) t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list ... ...))) (goto-char (point-min))))) (org-detach-overlay org-tags-overlay) (if rtn (mapconcat (quote identity) current ":") nil)))
org-fast-tag-selection(nil nil (("tag_a" . 97) ("tag_b" . 98) ("Personal")) nil)
(if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil (mapcar (quote cdr) table)))) (org-fast-tag-selection current-tags inherited-tags table (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let ((org-add-colon-after-tag-completion (< 1 (length table)))) (org-trim (org-icompleting-read "Tags: " (quote org-tags-completion-function) nil nil current (quote org-tags-history)))))
(setq table (append org-tag-persistent-alist org-tag-alist (org-get-buffer-tags) (and org-complete-tags-always-offer-all-agenda-tags (org-global-tags-completion-table (org-agenda-files)))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse (nthcdr (length current-tags) (nreverse (org-get-tags-at)))) tags (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil (mapcar (quote cdr) table)))) (org-fast-tag-selection current-tags inherited-tags table (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let ((org-add-colon-after-tag-completion (< 1 (length table)))) (org-trim (org-icompleting-read "Tags: " (quote org-tags-completion-function) nil nil current (quote org-tags-history))))))
(save-excursion (setq table (append org-tag-persistent-alist org-tag-alist (org-get-buffer-tags) (and org-complete-tags-always-offer-all-agenda-tags (org-global-tags-completion-table (org-agenda-files)))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse (nthcdr (length current-tags) (nreverse (org-get-tags-at)))) tags (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil (mapcar (quote cdr) table)))) (org-fast-tag-selection current-tags inherited-tags table (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let ((org-add-colon-after-tag-completion (< 1 (length table)))) (org-trim (org-icompleting-read "Tags: " (quote org-tags-completion-function) nil nil current (quote org-tags-history)))))))
(if just-align (setq tags current) (save-excursion (setq table (append org-tag-persistent-alist org-tag-alist (org-get-buffer-tags) (and org-complete-tags-always-offer-all-agenda-tags (org-global-tags-completion-table (org-agenda-files)))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse (nthcdr (length current-tags) (nreverse (org-get-tags-at)))) tags (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil (mapcar ... table)))) (org-fast-tag-selection current-tags inherited-tags table (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let ((org-add-colon-after-tag-completion (< 1 ...))) (org-trim (org-icompleting-read "Tags: " (quote org-tags-completion-function) nil nil current (quote org-tags-history))))))) (while (string-match "[-+&]+" tags) (setq tags (replace-match ":" t t tags))))
(if arg (save-excursion (goto-char (point-min)) (let ((buffer-invisibility-spec (org-inhibit-invisibility))) (while (re-search-forward re nil t) (org-set-tags nil t) (end-of-line 1))) (message "All tags realigned to column %d" org-tags-column)) (if just-align (setq tags current) (save-excursion (setq table (append org-tag-persistent-alist org-tag-alist (org-get-buffer-tags) (and org-complete-tags-always-offer-all-agenda-tags (org-global-tags-completion-table (org-agenda-files)))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse (nthcdr (length current-tags) (nreverse (org-get-tags-at)))) tags (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil ...))) (org-fast-tag-selection current-tags inherited-tags table (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let ((org-add-colon-after-tag-completion ...)) (org-trim (org-icompleting-read "Tags: " ... nil nil current ...)))))) (while (string-match "[-+&]+" tags) (setq tags (replace-match ":" t t tags)))) (setq tags (replace-regexp-in-string "[,]" ":" tags)) (if org-tags-sort-function (setq tags (mapconcat (quote identity) (sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+")) org-tags-sort-function) ":"))) (if (string-match "\\`[ ]*\\'" tags) (setq tags "") (unless (string-match ":$" tags) (setq tags (concat tags ":"))) (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) (beginning-of-line 1) (setq level (or (and (looking-at org-outline-regexp) (- (match-end 0) (point) 1)) 1)) (cond ((and (equal current "") (equal tags ""))) ((re-search-forward (concat "\\([ ]*" (regexp-quote current) "\\)[ ]*$") (point-at-eol) t) (if (equal tags "") (setq rpl "") (goto-char (match-beginning 0)) (setq c0 (current-column) di (if org-indent-mode (* (1- org-indent-indentation-per-level) (1- level)) 0) p0 (if (equal (char-before) 42) (1+ (point)) (point)) tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) c1 (max (1+ c0) (if (> tc 0) tc (- ... ...))) rpl (concat (make-string (max 0 ...) 32) tags))) (replace-match rpl t t) (and (not (featurep (quote xemacs))) c0 indent-tabs-mode (tabify p0 (point))) tags) (t (error "Tags alignment failed"))) (org-move-to-column col) (unless just-align (run-hooks (quote org-after-tags-change-hook))))
(let* ((re org-outline-regexp-bol) (current (unless arg (org-get-tags-string))) (col (current-column)) (org-setting-tags t) table current-tags inherited-tags tags p0 c0 c1 rpl di tc level) (if arg (save-excursion (goto-char (point-min)) (let ((buffer-invisibility-spec (org-inhibit-invisibility))) (while (re-search-forward re nil t) (org-set-tags nil t) (end-of-line 1))) (message "All tags realigned to column %d" org-tags-column)) (if just-align (setq tags current) (save-excursion (setq table (append org-tag-persistent-alist org-tag-alist (org-get-buffer-tags) (and org-complete-tags-always-offer-all-agenda-tags (org-global-tags-completion-table ...))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse (nthcdr (length current-tags) (nreverse ...))) tags (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection ...)) (org-fast-tag-selection current-tags inherited-tags table (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let (...) (org-trim ...))))) (while (string-match "[-+&]+" tags) (setq tags (replace-match ":" t t tags)))) (setq tags (replace-regexp-in-string "[,]" ":" tags)) (if org-tags-sort-function (setq tags (mapconcat (quote identity) (sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+")) org-tags-sort-function) ":"))) (if (string-match "\\`[ ]*\\'" tags) (setq tags "") (unless (string-match ":$" tags) (setq tags (concat tags ":"))) (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) (beginning-of-line 1) (setq level (or (and (looking-at org-outline-regexp) (- (match-end 0) (point) 1)) 1)) (cond ((and (equal current "") (equal tags ""))) ((re-search-forward (concat "\\([ ]*" (regexp-quote current) "\\)[ ]*$") (point-at-eol) t) (if (equal tags "") (setq rpl "") (goto-char (match-beginning 0)) (setq c0 (current-column) di (if org-indent-mode (* ... ...) 0) p0 (if (equal ... 42) (1+ ...) (point)) tc (+ org-tags-column (if ... ... di)) c1 (max (1+ c0) (if ... tc ...)) rpl (concat (make-string ... 32) tags))) (replace-match rpl t t) (and (not (featurep (quote xemacs))) c0 indent-tabs-mode (tabify p0 (point))) tags) (t (error "Tags alignment failed"))) (org-move-to-column col) (unless just-align (run-hooks (quote org-after-tags-change-hook)))))
org-set-tags(nil nil)
(if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) (org-set-tags arg just-align) (save-excursion (org-back-to-heading t) (org-set-tags arg just-align)))
org-set-tags-command(nil)
call-interactively(org-set-tags-command nil nil)