Refill some long/short copyright headers.
[bpt/emacs.git] / lisp / icomplete.el
index 44c854f..490b2b2 100644 (file)
@@ -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.
+;; Copyright (C) 1992-1994, 1997, 1999, 2001-2011
+;;   Free Software Foundation, Inc.
 
 ;; Author: Ken Manheimer <klm@i.am>
 ;; Maintainer: Ken Manheimer <klm@i.am>
 
 ;; 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 3, 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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
   :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 if icomplete is active.
 It is intended for use in customizing icomplete for interoperation
@@ -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.
@@ -192,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))))
 
@@ -217,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 ()
@@ -235,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.
@@ -252,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)
@@ -283,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"
@@ -333,10 +371,9 @@ 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