X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/32ccc8a5747ec380a9375251e1285264356b8866..2333c84afd9263abd5c71b4503435c5db1292f94:/lisp/icomplete.el diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 6599c1442b..645981539d 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -1,7 +1,7 @@ ;;; icomplete.el --- minibuffer completion incremental feedback ;; Copyright (C) 1992, 1993, 1994, 1997, 1999, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Ken Manheimer ;; Maintainer: Ken Manheimer @@ -11,10 +11,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -22,9 +22,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -69,37 +67,45 @@ :prefix "icomplete-" :group 'minibuffer) +(defvar icomplete-prospects-length 80) +(make-obsolete-variable + 'icomplete-prospects-length 'icomplete-prospects-height "23.1") + ;;;_* User Customization variables -(defcustom icomplete-prospects-length 80 - "*Length of string displaying the prospects." +(defcustom icomplete-prospects-height + ;; 20 is an estimated common size for the prompt + minibuffer content, to + ;; try to guess the number of lines used up by icomplete-prospects-length. + (+ 1 (/ (+ icomplete-prospects-length 20) (window-width))) + "Maximum number of lines to use in the minibuffer." :type 'integer - :group 'icomplete) + :group 'icomplete + :version "23.1") (defcustom icomplete-compute-delay .3 - "*Completions-computation stall, used only with large-number -completions - see `icomplete-delay-completions-threshold'." + "Completions-computation stall, used only with large-number completions. +See `icomplete-delay-completions-threshold'." :type 'number :group 'icomplete) (defcustom icomplete-delay-completions-threshold 400 - "*Pending-completions number over which to apply icomplete-compute-delay." + "Pending-completions number over which to apply `icomplete-compute-delay'." :type 'integer :group 'icomplete) (defcustom icomplete-max-delay-chars 3 - "*Maximum number of initial chars to apply icomplete compute delay." + "Maximum number of initial chars to apply icomplete compute delay." :type 'integer :group 'icomplete) (defcustom icomplete-show-key-bindings t - "*If non-nil, show key bindings as well as completion for sole matches." + "If non-nil, show key bindings as well as completion for sole matches." :type 'boolean :group 'icomplete) (defcustom icomplete-minibuffer-setup-hook nil - "*Icomplete-specific customization of minibuffer setup. + "Icomplete-specific customization of minibuffer setup. -This hook is run during minibuffer setup iff icomplete will be active. +This hook is run during minibuffer setup if icomplete is active. It is intended for use in customizing icomplete for interoperation with other features and packages. For instance: @@ -119,9 +125,9 @@ icompletion is occurring." ;;;_ + Internal Variables ;;;_ = icomplete-eoinput nil -(defvar icomplete-eoinput nil - "Point where minibuffer input ends and completion info begins.") -(make-variable-buffer-local 'icomplete-eoinput) +(defvar icomplete-overlay (make-overlay (point-min) (point-min) nil t t) + "Overlay used to display the list of completions.") + ;;;_ = icomplete-pre-command-hook (defvar icomplete-pre-command-hook nil "Incremental-minibuffer-completion pre-command-hook. @@ -140,23 +146,22 @@ minibuffer completion.") (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) (defun icomplete-get-keys (func-name) - "Return strings naming keys bound to `func-name', or nil if none. + "Return strings naming keys bound to FUNC-NAME, or nil if none. Examines the prior, not current, buffer, presuming that current buffer is minibuffer." - (if (commandp func-name) + (when (commandp func-name) (save-excursion (let* ((sym (intern func-name)) (buf (other-buffer nil t)) - (map (save-excursion (set-buffer buf) (current-local-map))) - (keys (where-is-internal sym map))) - (if keys - (concat "<" - (mapconcat 'key-description - (sort keys - #'(lambda (x y) - (< (length x) (length y)))) - ", ") - ">")))))) + (keys (with-current-buffer buf (where-is-internal sym)))) + (when keys + (concat "<" + (mapconcat 'key-description + (sort keys + #'(lambda (x y) + (< (length x) (length y)))) + ", ") + ">")))))) ;;;_ = icomplete-with-completion-tables (defvar icomplete-with-completion-tables '(internal-complete-buffer) "Specialized completion tables with which icomplete should operate. @@ -168,7 +173,8 @@ except those on this list.") ;;;###autoload (define-minor-mode icomplete-mode "Toggle incremental minibuffer completion for this Emacs session. -With a numeric argument, turn Icomplete mode on iff ARG is positive." +With a numeric argument, turn Icomplete mode on if ARG is positive, +otherwise turn it off." :global t :group 'icomplete (if icomplete-mode ;; The following is not really necessary after first time - @@ -191,6 +197,7 @@ Conditions are: (not executing-kbd-macro) minibuffer-completion-table (or (not (functionp minibuffer-completion-table)) + (eq icomplete-with-completion-tables t) (member minibuffer-completion-table icomplete-with-completion-tables)))) @@ -216,15 +223,7 @@ Usually run by inclusion in `minibuffer-setup-hook'." "Remove completions display \(if any) prior to new user input. Should be run in on the minibuffer `pre-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." - (when (and icomplete-mode icomplete-eoinput) - - (unless (>= icomplete-eoinput (point-max)) - (let ((buffer-undo-list t) ; prevent entry - deactivate-mark) - (delete-region icomplete-eoinput (point-max)))) - - ;; Reestablish the safe value. - (setq icomplete-eoinput nil))) + (delete-overlay icomplete-overlay)) ;;;_ > icomplete-exhibit () (defun icomplete-exhibit () @@ -234,9 +233,6 @@ and `minibuffer-setup-hook'." (when (and icomplete-mode (icomplete-simple-completing-p)) (save-excursion (goto-char (point-max)) - ;; Register the end of input, so we know where the extra stuff - ;; (match-status info) begins: - (setq icomplete-eoinput (point)) ; Insert the match-status information: (if (and (> (point-max) (minibuffer-prompt-end)) buffer-undo-list ; Wait for some user input. @@ -251,16 +247,21 @@ and `minibuffer-setup-hook'." ;; embarking on computing completions: (sit-for icomplete-compute-delay))) (let ((text (while-no-input - (list (icomplete-completions (field-string) minibuffer-completion-table minibuffer-completion-predicate - (not minibuffer-completion-confirm))))) + (not minibuffer-completion-confirm)))) (buffer-undo-list t) deactivate-mark) ;; Do nothing if while-no-input was aborted. - (if (consp text) (insert (car text)))))))) + (when (stringp text) + (move-overlay icomplete-overlay (point) (point) (current-buffer)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor t text) + (overlay-put icomplete-overlay 'after-string text))))))) ;;;_ > icomplete-completions (name candidates predicate require-match) (defun icomplete-completions (name candidates predicate require-match) @@ -282,47 +283,85 @@ The displays for unambiguous matches have ` [Matched]' appended matches exist. \(Keybindings for uniquely matched commands are exhibited within the square braces.)" - ;; 'all-completions' doesn't like empty - ;; minibuffer-completion-table's (ie: (nil)) - (if (and (listp candidates) (null (car candidates))) - (setq candidates nil)) - - (let ((comps (all-completions name candidates predicate)) - ; "-determined" - only one candidate - (open-bracket-determined (if require-match "(" "[")) - (close-bracket-determined (if require-match ")" "]"))) - ;; `concat'/`mapconcat' is the slow part. With the introduction of - ;; `icomplete-prospects-length', there is no need for `catch'/`throw'. - (if (null comps) (format " %sNo matches%s" - open-bracket-determined - close-bracket-determined) - (let* ((most-try (try-completion name (mapcar (function list) comps))) - (most (if (stringp most-try) most-try (car comps))) - (most-len (length most)) - (determ (and (> most-len (length name)) - (concat open-bracket-determined - (substring most (length name)) - close-bracket-determined))) + (let* ((non-essential t) + (comps (completion-all-sorted-completions)) + (last (if (consp comps) (last comps))) + (base-size (cdr last)) + (open-bracket (if require-match "(" "[")) + (close-bracket (if require-match ")" "]"))) + ;; `concat'/`mapconcat' is the slow part. + (if (not (consp comps)) + (format " %sNo matches%s" open-bracket close-bracket) + (if last (setcdr last nil)) + (let* ((most-try + (if (and base-size (> base-size 0)) + (completion-try-completion + name candidates predicate (length name)) + ;; If the `comps' are 0-based, the result should be + ;; the same with `comps'. + (completion-try-completion + name comps nil (length name)))) + (most (if (consp most-try) (car most-try) + (if most-try (car comps) ""))) + ;; Compare name and most, so we can determine if name is + ;; a prefix of most, or something else. + (compare (compare-strings name nil nil + most nil nil completion-ignore-case)) + (determ (unless (or (eq t compare) (eq t most-try) + (= (setq compare (1- (abs compare))) + (length most))) + (concat open-bracket + (cond + ((= compare (length name)) + ;; Typical case: name is a prefix. + (substring most compare)) + ((< compare 5) most) + (t (concat "..." (substring most compare)))) + close-bracket))) ;;"-prospects" - more than one candidate - (prospects-len 0) - prospects most-is-exact comp) - (if (eq most-try t) + (prospects-len (+ (length determ) 6 ;; take {,...} into account + (string-width (buffer-string)))) + (prospects-max + ;; Max total length to use, including the minibuffer content. + (* (+ icomplete-prospects-height + ;; If the minibuffer content already uses up more than + ;; one line, increase the allowable space accordingly. + (/ prospects-len (window-width))) + (window-width))) + (prefix-len + ;; Find the common prefix among `comps'. + (if (eq t (compare-strings (car comps) nil (length most) + most nil nil completion-ignore-case)) + ;; Common case. + (length most) + ;; Else, use try-completion. + (let ((comps-prefix (try-completion "" comps))) + (and (stringp comps-prefix) + (length comps-prefix))))) + + prospects most-is-exact comp limit) + (if (eq most-try t) ;; (or (null (cdr comps)) (setq prospects nil) - (while (and comps (< prospects-len icomplete-prospects-length)) - (setq comp (substring (car comps) most-len) + (while (and comps (not limit)) + (setq comp + (if prefix-len (substring (car comps) prefix-len) (car comps)) comps (cdr comps)) (cond ((string-equal comp "") (setq most-is-exact t)) ((member comp prospects)) - (t (setq prospects (cons comp prospects) - prospects-len (+ (length comp) 1 prospects-len)))))) + (t (setq prospects-len + (+ (string-width comp) 1 prospects-len)) + (if (< prospects-len prospects-max) + (push comp prospects) + (setq limit t)))))) + ;; Restore the base-size info, since completion-all-sorted-completions + ;; is cached. + (if last (setcdr last base-size)) (if prospects (concat determ "{" (and most-is-exact ",") - (mapconcat 'identity - (sort prospects (function string-lessp)) - ",") - (and comps ",...") + (mapconcat 'identity (nreverse prospects) ",") + (and limit ",...") "}") (concat determ " [Matched" @@ -332,10 +371,10 @@ are exhibited within the square braces.)" (if keys (concat "; " keys) "")) "]")))))) -;;;_* Local emacs vars. -;;;Local variables: -;;;allout-layout: (-2 :) -;;;End: +;;_* Local emacs vars. +;;Local variables: +;;allout-layout: (-2 :) +;;End: ;; arch-tag: 339ec25a-0741-4eb6-be63-997532e89b0f ;;; icomplete.el ends here