bug#46091: ido: Add support for tab completion using an alist collection.

bug#46091: ido: Add support for tab completion using an alist collection.

[Keith David Bershatsky]

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 :hel
 p "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)))))

bug#46091: ido: Add support for tab completion using an alist collection.

[Lars Ingebrigtsen]

Keith David Bershatsky <esq@lawlist.com> writes:

> 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"))

(I'm going through old bug reports that unfortunately weren't resolved
at the time.)

You say "currently", but not what Emacs version this was about.

I tried evaling the form above in Emacs 25.1 and Emacs 29, and it didn't
fail in either of those cases, but perhaps there's something missing in
the recipe?  Or has this gone away since whateve version you say this in?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#46091: ido: Add support for tab completion using an alist collection.

[Keith David Bershatsky]

Thanks for having a look at this particular issue.

After evaluating the snippet, press the TAB key.  An error will occur in all recent versions of Emacs.

Keith

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

> Date: [06-13-2022 12:04:31] <13 Jun 2022 21:04:31 +0200>
> From: Lars Ingebrigtsen <larsi@gnus.org>
> To: Keith David Bershatsky <esq@lawlist.com>
> Cc: 46091@debbugs.gnu.org
> Subject: Re: bug#46091: ido:  Add support for tab completion using an alist collection.
> 
> Keith David Bershatsky <esq@lawlist.com> writes:
> 
> > 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"))
> 
> (I'm going through old bug reports that unfortunately weren't resolved
> at the time.)
> 
> You say "currently", but not what Emacs version this was about.
> 
> I tried evaling the form above in Emacs 25.1 and Emacs 29, and it didn't
> fail in either of those cases, but perhaps there's something missing in
> the recipe?  Or has this gone away since whateve version you say this in?

bug#46091: ido: Add support for tab completion using an alist collection.

[Lars Ingebrigtsen]

Keith David Bershatsky <esq@lawlist.com> writes:

> Thanks for having a look at this particular issue.
>
> After evaluating the snippet, press the TAB key.  An error will occur
> in all recent versions of Emacs.

Thanks; with that I'm able to reproduce the problem, and I've now fixed
it in Emacs 29 (by just adjusting ido-completion-help, and not touching
the central completion functions, which didn't seem necessary).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no