Package: emacs;
Reported by: Keith David Bershatsky <esq <at> lawlist.com>
Date: Mon, 25 Jan 2021 02:47:02 UTC
Severity: wishlist
Tags: moreinfo
Fixed in version 29.1
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Keith David Bershatsky <esq <at> lawlist.com> To: 46091 <at> debbugs.gnu.org Subject: bug#46091: ido: Add support for tab completion using an alist collection. Date: Sun, 24 Jan 2021 18:46:33 -0800
Currently, ido does not support tab completion using an alist collection.
(require 'ido)
(let* ((alist '(("pine" . "cones")
("oak" . "acorns")
("maple" . "seeds")))
(choice (ido-completing-read "CHOOSE: " alist nil 'confirm)))
(cdr (assoc choice alist)))
;;; Debugger entered--Lisp error: (wrong-type-argument listp "seeds")
;;; ido-no-final-slash(("maple" . "seeds"))
;;; ido-file-lessp(("maple" . "seeds") ("oak" . "acorns"))
;;; sort((("pine" . "cones")) ido-file-lessp)
;;; ido-completion-help()
;;; funcall-interactively(ido-completion-help)
;;; call-interactively(ido-completion-help)
;;; ido-complete()
;;; funcall-interactively(ido-complete)
;;; call-interactively(ido-complete nil nil)
;;; command-execute(ido-complete)
;;; read-from-minibuffer("CHOOSE: " nil (keymap keymap (4 . ido-magic-delete-char) (6 . ido-magic-forward-char) (2 . ido-magic-backward-char) (63 . ido-completion-help) (left . ido-prev-match) (right . ido-next-match) (0 . ido-restrict-to-matches) (27 keymap (32 . ido-take-first-match)) (67108896 . ido-restrict-to-matches) (26 . ido-undo-merge-work-directory) (20 . ido-toggle-regexp) (67108908 . ido-prev-match) (67108910 . ido-next-match) (19 . ido-next-match) (18 . ido-prev-match) (16 . ido-toggle-prefix) (13 . ido-exit-minibuffer) (10 . ido-select-text) (32 . ido-complete-space) (9 . ido-complete) (5 . ido-edit-input) (3 . ido-toggle-case) (1 . ido-toggle-ignore) keymap (menu-bar keymap (minibuf "Minibuf" keymap (previous menu-item "Previous History Item" previous-history-element :help "Put previous minibuffer history element in the min...") (next menu-item "Next History Item" next-history-element :help "Put next minibuffer history element in the minibuf...") (isearch-backward m
enu-item "Isearch History Backward" isearch-backward :help "Incrementally search minibuffer history backward") (isearch-forward menu-item "Isearch History Forward" isearch-forward :help "Incrementally search minibuffer history forward") (return menu-item "Enter" exit-minibuffer :key-sequence "\15" :help "Terminate input and exit minibuffer") (quit menu-item "Quit" abort-recursive-edit :help "Abort input and exit minibuffer") "Minibuf")) (10 . exit-minibuffer) (13 . exit-minibuffer) (7 . abort-recursive-edit) (C-tab . file-cache-minibuffer-complete) (9 . self-insert-command) (XF86Back . previous-history-element) (up . previous-line-or-history-element) (prior . previous-history-element) (XF86Forward . next-history-element) (down . next-line-or-history-element) (next . next-history-element) (27 keymap (60 . minibuffer-beginning-of-buffer) (114 . previous-matching-history-element) (115 . next-matching-history-element) (112 . previous-history-element) (110 . next-history-element))) nil n
il)
;;; ido-read-internal(list "CHOOSE: " nil nil confirm nil)
;;; ido-completing-read("CHOOSE: " (("pine" . "cones") ("oak" . "acorns") ("maple" . "seeds")) nil confirm)
;;; (let* ((alist '(("pine" . "cones") ("oak" . "acorns") ("maple" . "seeds"))) (choice (ido-completing-read "CHOOSE: " alist nil 'confirm))) (cdr (assoc choice alist)))
;;; (progn (let* ((alist '(("pine" . "cones") ("oak" . "acorns") ("maple" . "seeds"))) (choice (ido-completing-read "CHOOSE: " alist nil 'confirm))) (cdr (assoc choice alist))))
;;; eval((progn (let* ((alist '(("pine" . "cones") ("oak" . "acorns") ("maple" . "seeds"))) (choice (ido-completing-read "CHOOSE: " alist nil 'confirm))) (cdr (assoc choice alist)))) t)
;;; elisp--eval-last-sexp(nil)
;;; eval-last-sexp(nil)
;;; funcall-interactively(eval-last-sexp nil)
;;; call-interactively(eval-last-sexp nil nil)
;;; command-execute(eval-last-sexp)
Here is a draft proof concept that adds limited support for an alist collection using ido. This is not intended to be a plug-in solution, but is rather intended to give the Emacs team some ideas regarding possible solutions.
(setq completions-format nil)
(defun ido-file-lessp (a b)
;; Simple compare two file names.
(string-lessp (ido-no-final-slash (if (listp a) (car a) a))
(ido-no-final-slash (if (listp b) (car b) b))))
(defun completion--insert-strings (strings)
"Insert a list of STRINGS into the current buffer.
Uses columns to keep the listing readable but compact.
It also eliminates runs of equal strings."
(when (consp strings)
(let* ((length (apply 'max (mapcar (lambda (s)
(if (consp s)
(+ (string-width (car s))
(if (listp (cdr s))
;;; Add 3: " " "[" "]"
(+ 3 (string-width (cadr s)))
;;; Add 3: " " "[" "]"
(+ 3 (string-width (replace-regexp-in-string "\n" "\\\\n" (cdr s))))))
(string-width s)))
strings)))
(window (get-buffer-window (current-buffer) 0))
(wwidth (if window (1- (window-width window)) 79))
(columns (min
;; At least 2 columns; at least 2 spaces between columns.
(max 2 (/ wwidth (+ 2 length)))
;; Don't allocate more columns than we can fill.
;; Windows can't show less than 3 lines anyway.
(max 1 (/ (length strings) 2))))
(colwidth (/ wwidth columns))
(column 0)
(rows (/ (length strings) columns))
(row 0)
(first t)
(laststring nil))
;; The insertion should be "sensible" no matter what choices were made
;; for the parameters above.
(dolist (str strings)
(unless (equal laststring str) ; Remove (consecutive) duplicates.
(setq laststring str)
;; FIXME: `string-width' doesn't pay attention to `display' properties.
(let ((length (if (consp str)
(+ (string-width (car str))
(if (listp (cdr str))
;;; Add 3: " " "[" "]"
(+ 3 (string-width (cadr str)))
;;; Add 3: " ", "[", "]"
(+ 3 (string-width (replace-regexp-in-string "\n" "\\\\n" (cdr str))))))
(string-width str))))
(cond ((eq completions-format 'vertical)
;; Vertical format
(when (> row rows)
(forward-line (- -1 rows))
(setq row 0 column (+ column colwidth)))
(when (> column 0)
(end-of-line)
(while (> (current-column) column)
(if (eobp)
(insert "\n")
(forward-line 1)
(end-of-line)))
(insert " \t")
(set-text-properties (1- (point)) (point) `(display (space :align-to ,column)))))
((eq completions-format 'horizontal)
;; Horizontal format
(unless first
(if (< wwidth (+ (max colwidth length) column))
;; No space for `str' at point, move to next line.
(progn (insert "\n")
(setq column 0))
(insert " \t")
;; Leave the space unpropertized so that in the case we're
;; already past the goal column, there is still a space displayed.
;; We can't just set tab-width, because completion-setup-function will kill all local variables :-(
(set-text-properties (1- (point)) (point) `(display (space :align-to ,column))))))
(t
(when (> row 0)
(insert "\n"))))
(setq first nil)
(if (not (consp str))
(add-text-properties (point) (progn (insert str)
(point))
(list 'mouse-face 'highlight
'the-completion-text-property str
'face 'completions-choices-face))
(add-text-properties (point) (progn (insert (car str)) (point))
(list 'mouse-face 'highlight
'the-completion-text-property (car str)
'face 'completions-choices-face))
(let ((beg (point))
(end (progn (if (listp (cdr str))
(insert " [" (replace-regexp-in-string "\n" "\\\\n" (cadr str)) "]")
(insert " [" (replace-regexp-in-string "\n" "\\\\n" (cdr str)) "]"))
(point))))
(add-text-properties beg end (list 'mouse-face nil
'the-completion-text-property (if (listp str)
(car str)
str)))
(font-lock-prepend-text-property beg end 'face 'completions-annotations-face)))
(cond
((eq completions-format 'vertical)
;; Vertical format
;; (if (> column 0)
;; (forward-line)
;; (insert "\n"))
(insert-char ?\n 2)
(setq row (1+ row)))
((eq completions-format 'horizontal)
;; Horizontal format
;; Next column to align to.
;; Round up to a whole number of columns.
(setq column (+ column (* colwidth (ceiling length colwidth)))))
(t
(setq row (1+ row))))))))))
(defun choose-completion (&optional event)
"Choose the completion at point.
If EVENT, use EVENT's position to determine the starting position."
(interactive (list last-nonmenu-event))
;; In case this is run via the mouse, give temporary modes such as
;; isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(let ((buffer completion-reference-buffer)
(base-size completion-base-size)
(base-position completion-base-position)
(insert-function completion-list-insert-choice-function)
(choice
(save-excursion
(goto-char (posn-point (event-start event)))
(get-text-property (point) 'the-completion-text-property))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
(when (null choice)
(let ((debug-on-quit nil))
(signal 'quit '("choose-completion: Please try again!"))))
(quit-window nil (posn-window (event-start event)))
(with-current-buffer buffer
(choose-completion-string
choice buffer
(or base-position
(when base-size
;; Someone's using old completion code that doesn't know
;; about base-position yet.
(list (+ base-size (field-beginning))))
;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice)))
insert-function)))))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.