From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Keith David Bershatsky Newsgroups: gmane.emacs.bugs Subject: bug#46091: ido: Add support for tab completion using an alist collection. Date: Sun, 24 Jan 2021 18:46:33 -0800 Message-ID: Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="37445"; mail-complaints-to="usenet@ciao.gmane.io" To: 46091@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Jan 25 03:47:20 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1l3ruR-0009Zy-Dt for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 25 Jan 2021 03:47:19 +0100 Original-Received: from localhost ([::1]:36298 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l3ruQ-0005io-Fl for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 24 Jan 2021 21:47:18 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:33638) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l3ruA-0005iY-Oi for bug-gnu-emacs@gnu.org; Sun, 24 Jan 2021 21:47:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:54280) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l3ruA-0004NO-Hm for bug-gnu-emacs@gnu.org; Sun, 24 Jan 2021 21:47:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1l3ruA-00079P-GY for bug-gnu-emacs@gnu.org; Sun, 24 Jan 2021 21:47:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Keith David Bershatsky Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 25 Jan 2021 02:47:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 46091 X-GNU-PR-Package: emacs X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.161154281527470 (code B ref -1); Mon, 25 Jan 2021 02:47:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 25 Jan 2021 02:46:55 +0000 Original-Received: from localhost ([127.0.0.1]:37593 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l3ru3-000790-0U for submit@debbugs.gnu.org; Sun, 24 Jan 2021 21:46:55 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:58676) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l3ru1-00078s-JJ for submit@debbugs.gnu.org; Sun, 24 Jan 2021 21:46:54 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:33636) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l3ru1-0005gq-Ba for bug-gnu-emacs@gnu.org; Sun, 24 Jan 2021 21:46:53 -0500 Original-Received: from gateway21.websitewelcome.com ([192.185.45.147]:16925) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l3rty-0004Hh-JY for bug-gnu-emacs@gnu.org; Sun, 24 Jan 2021 21:46:52 -0500 Original-Received: from cm17.websitewelcome.com (cm17.websitewelcome.com [100.42.49.20]) by gateway21.websitewelcome.com (Postfix) with ESMTP id B531D400CE93B for ; Sun, 24 Jan 2021 20:46:34 -0600 (CST) Original-Received: from gator3053.hostgator.com ([50.87.144.69]) by cmsmtp with SMTP id 3rtilHQXiDT643rtilEaLl; Sun, 24 Jan 2021 20:46:34 -0600 X-Authority-Reason: nr=8 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=lawlist.com ; s=default; h=Content-Type:MIME-Version:Subject:To:From:Message-ID:Date: Sender:Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=wiBej64Dux7NVNcBi63yqkAfkJ2ci3fg4Hq9klwDYgc=; b=caQVgrv1p2bUMR+5BrkXyN5nwq lvJwCCpFBbU48Muup5D7Wo+7ejdOU/L75HuWSH0grbfiUXv/TBwl/KQPAwqnY10DYAXLiUFofN9oL hiaHBNwYgOenk8aa13qOVTNC4EqwNIQwE7VVDNeFNPW4MfhUX/DVReVfiDlM3odm3P0clTxR9Eecv BwyIj2FqOfidTVAgHZYLyj08Mr7ayVMl/Sp8ENMmHRn11+qg9NGkrDSUoi28acpCFQuMclEP21AbH 1xMniPho6q5sSrCJrcWtuQC9jX2v/ehpt9E609q+25VePJv6m/G+klLCn4Pav2jC4jvwYwX1Z6ZKt hdn9zrDg==; Original-Received: from cpe-45-48-245-70.socal.res.rr.com ([45.48.245.70]:51090 helo=server.local) by gator3053.hostgator.com with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.93) (envelope-from ) id 1l3rth-002Bpi-Ti for bug-gnu-emacs@gnu.org; Sun, 24 Jan 2021 20:46:34 -0600 X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - gator3053.hostgator.com X-AntiAbuse: Original Domain - gnu.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - lawlist.com X-BWhitelist: no X-Source-IP: 45.48.245.70 X-Source-L: No X-Exim-ID: 1l3rth-002Bpi-Ti X-Source-Sender: cpe-45-48-245-70.socal.res.rr.com (server.local) [45.48.245.70]:51090 X-Source-Auth: lawlist X-Email-Count: 1 X-Source-Cap: bGF3bGlzdDtsYXdsaXN0O2dhdG9yMzA1My5ob3N0Z2F0b3IuY29t X-Local-Domain: yes Received-SPF: pass client-ip=192.185.45.147; envelope-from=esq@lawlist.com; helo=gateway21.websitewelcome.com X-Spam_score_int: -16 X-Spam_score: -1.7 X-Spam_bar: - X-Spam_report: (-1.7 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:198543 Archived-At: 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)))))