]> code.delx.au - gnu-emacs/blobdiff - lisp/complete.el
(recover-session): Add leading space on added text lines.
[gnu-emacs] / lisp / complete.el
index 65d2fe07ce375cdfcbd8c6ac99df39c1a6289580..4aaffa76b0ca152a84d6ce038f52c0ab406fb371 100644 (file)
@@ -1,10 +1,10 @@
-;;; complete.el -- partial completion mechanism plus other goodies
+;;; complete.el --- partial completion mechanism plus other goodies
 
 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Keywords: abbrev
-;; Version: 2.02
+;; Keywords: abbrev convenience
+;; Version: 2.03
 ;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
 
 ;; This file is part of GNU Emacs.
@@ -47,7 +47,7 @@
 ;; and the partial completer will use the Meta versions of the keys.
 
 
-;; Usage:  Load this file.  Now, during completable minibuffer entry,
+;; Usage:  M-x partial-completion-mode.  During completable minibuffer entry,
 ;;
 ;;     TAB    means to do a partial completion;
 ;;     SPC    means to do a partial complete-word;
@@ -62,7 +62,7 @@
 ;;
 ;; in your .emacs file.  To load partial completion automatically, put
 ;;
-;;       (load "complete")
+;;       (partial-completion-mode t)
 ;;
 ;; in your .emacs file, too.  Things will be faster if you byte-compile
 ;; this file when you install it.
 
 ;;; Code:
 
-(defvar PC-meta-flag t
-  "*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion.
-If t, TAB does Partial Completion and M-TAB does normal completion.")
-
-
-(defvar PC-word-delimiters "-_. "
-  "*A string of characters which are to be treated as word delimiters
-by the Partial Completion system.
-
-Some arcane rules:  If `]' is in this string it must come first.
-If `^' is in this string it must NOT come first.  If `-' is in this
-string, it must come first or right after `]'.  In other words, if
-S is this string, then `[S]' must be a legal Emacs regular expression
-\(not containing character ranges like `a-z').")
-
-
-(defvar PC-first-char 'x
-  "*If t, first character of a string to be completed is always taken literally.
-If nil, word delimiters are handled even if they appear as first character.
-This controls whether \".e\" matches \".e*\" (t) or \"*.e*\" (nil).
-If neither nil nor t, first char is literal only for filename completion.")
-
-
-(defvar PC-include-file-path '("/usr/include")
-  "*List of directories in which to look for include files.
-If this is nil, uses the colon-separated path in $INCPATH instead.")
-
-
-(defvar PC-disable-wildcards nil
-  "Set this to non-nil to disable wildcard support in \\[find-file].")
-
-(defvar PC-disable-includes nil
-  "Set this to non-nil to disable include-file support in \\[find-file].")
-
+(defgroup partial-completion nil
+  "Partial Completion of items."
+  :prefix "pc-"
+  :group 'minibuffer
+  :group 'convenience)
+
+(defcustom partial-completion-mode nil
+  "Toggle Partial Completion mode.
+When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is
+nil) is enhanced so that if some string is divided into words and each word is
+delimited by a character in `PC-word-delimiters', partial words are completed
+as much as possible and `*' characters are treated likewise in file names.
+You must modify via \\[customize] for this variable to have an effect."
+  :set (lambda (symbol value)
+        (partial-completion-mode (or value 0)))
+  :initialize 'custom-initialize-default
+  :type 'boolean
+  :group 'partial-completion
+  :require 'complete)
+
+(defcustom PC-first-char 'find-file
+  "*Control how the first character of a string is to be interpreted.
+If nil, the first character of a string is not taken literally if it is a word
+delimiter, so that \".e\" matches \"*.e*\".
+If t, the first character of a string is always taken literally even if it is a
+word delimiter, so that \".e\" matches \".e*\".
+If non-nil and non-t, the first character is taken literally only for file name
+completion."
+  :type '(choice (const :tag "delimiter" nil)
+                (const :tag "literal" t)
+                (other :tag "find-file" find-file))
+  :group 'partial-completion)
+
+(defcustom PC-meta-flag t
+  "*If non-nil, TAB means PC completion and M-TAB means normal completion.
+Otherwise, TAB means normal completion and M-TAB means Partial Completion."
+  :type 'boolean
+  :group 'partial-completion)
+
+(defcustom PC-word-delimiters "-_. "
+  "*A string of characters treated as word delimiters for completion.
+Some arcane rules:
+If `]' is in this string, it must come first.
+If `^' is in this string, it must not come first.
+If `-' is in this string, it must come first or right after `]'.
+In other words, if S is this string, then `[S]' must be a legal Emacs regular
+expression (not containing character ranges like `a-z')."
+  :type 'string
+  :group 'partial-completion)
+
+(defcustom PC-include-file-path '("/usr/include" "/usr/local/include")
+  "*A list of directories in which to look for include files.
+If nil, means use the colon-separated path in the variable $INCPATH instead."
+  :type '(repeat directory)
+  :group 'partial-completion)
+
+(defcustom PC-disable-wildcards nil
+  "*If non-nil, wildcard support in \\[find-file] is disabled."
+  :type 'boolean
+  :group 'partial-completion)
+
+(defcustom PC-disable-includes nil
+  "*If non-nil, include-file support in \\[find-file] is disabled."
+  :type 'boolean
+  :group 'partial-completion)
 
 (defvar PC-default-bindings t
-  "Set this to nil to suppress the default partial completion key bindings.")
-
-(if PC-default-bindings (progn
-(define-key minibuffer-local-completion-map "\t" 'PC-complete)
-(define-key minibuffer-local-completion-map " "  'PC-complete-word)
-(define-key minibuffer-local-completion-map "?"  'PC-completion-help)
-
-(define-key minibuffer-local-completion-map "\e\t" 'PC-complete)
-(define-key minibuffer-local-completion-map "\e "  'PC-complete-word)
-(define-key minibuffer-local-completion-map "\e\r" 'PC-force-complete-and-exit)
-(define-key minibuffer-local-completion-map "\e\n" 'PC-force-complete-and-exit)
-(define-key minibuffer-local-completion-map "\e?"  'PC-completion-help)
-
-(define-key minibuffer-local-must-match-map "\t" 'PC-complete)
-(define-key minibuffer-local-must-match-map " "  'PC-complete-word)
-(define-key minibuffer-local-must-match-map "\r" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "\n" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "?"  'PC-completion-help)
-
-(define-key minibuffer-local-must-match-map "\e\t" 'PC-complete)
-(define-key minibuffer-local-must-match-map "\e "  'PC-complete-word)
-(define-key minibuffer-local-must-match-map "\e\r" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "\e\n" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "\e?"  'PC-completion-help)
-
-(define-key global-map "\e\t" 'PC-lisp-complete-symbol)
-))
-
+  "If non-nil, default partial completion key bindings are suppressed.")
+\f
+(defvar PC-old-read-file-name-internal nil)
 
+;;;###autoload
+(defun partial-completion-mode (&optional arg)
+  "Toggle Partial Completion mode.
+With prefix ARG, turn Partial Completion mode on if ARG is positive.
+
+When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is
+nil) is enhanced so that if some string is divided into words and each word is
+delimited by a character in `PC-word-delimiters', partial words are completed
+as much as possible.
+
+For example, M-x p-c-b expands to M-x partial-completion-mode since no other
+command begins with that sequence of characters, and
+\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no
+other file in that directory begin with that sequence of characters.
+
+Unless `PC-disable-wildcards' is non-nil, the \"*\" wildcard is interpreted
+specially when entering file or directory names.  For example,
+\\[find-file] *.c RET finds each C file in the currenty directory, and
+\\[find-file] */foo_bar.c TAB completes the directory name as far as possible.
+
+Unless `PC-disable-includes' is non-nil, the \"<...>\" sequence is interpreted
+specially in \\[find-file].  For example,
+\\[find-file] <sys/time.h> RET finds the file /usr/include/sys/time.h.
+See also the variable `PC-include-file-path'."
+  (interactive "P")
+  (let ((on-p (if arg
+                 (> (prefix-numeric-value arg) 0)
+               (not partial-completion-mode))))
+    ;; Deal with key bindings...
+    (PC-bindings on-p)
+    ;; Deal with wildcard file feature...
+    (cond ((not on-p)
+          (remove-hook 'find-file-not-found-hooks 'PC-try-load-many-files))
+         ((not PC-disable-wildcards)
+          (add-hook 'find-file-not-found-hooks 'PC-try-load-many-files)))
+    ;; Deal with include file feature...
+    (cond ((not on-p)
+          (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file))
+         ((not PC-disable-includes)
+          (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file)))
+    ;; ... with some underhand redefining.
+    (cond ((and (not on-p) (functionp PC-old-read-file-name-internal))
+          (fset 'read-file-name-internal PC-old-read-file-name-internal))
+         ((and (not PC-disable-includes) (not PC-old-read-file-name-internal))
+          (setq PC-old-read-file-name-internal
+                (symbol-function 'read-file-name-internal))
+          (fset 'read-file-name-internal
+                'PC-read-include-file-name-internal)))
+    ;; Finally set the mode variable.
+    (setq partial-completion-mode on-p)))
+
+(defun PC-bindings (bind)
+  (let ((completion-map minibuffer-local-completion-map)
+       (must-match-map minibuffer-local-must-match-map))
+    (cond ((not bind)
+          ;; These bindings are the default bindings.  It would be better to
+          ;; restore the previous bindings.
+          (define-key completion-map "\t"      'minibuffer-complete)
+          (define-key completion-map " "       'minibuffer-complete-word)
+          (define-key completion-map "?"       'minibuffer-completion-help)
+
+          (define-key must-match-map "\t"      'minibuffer-complete)
+          (define-key must-match-map " "       'minibuffer-complete-word)
+          (define-key must-match-map "\r"      'minibuffer-complete-and-exit)
+          (define-key must-match-map "\n"      'minibuffer-complete-and-exit)
+          (define-key must-match-map "?"       'minibuffer-completion-help)
+
+          (define-key global-map "\e\t"        'complete-symbol))
+         (PC-default-bindings
+          (define-key completion-map "\t"      'PC-complete)
+          (define-key completion-map " "       'PC-complete-word)
+          (define-key completion-map "?"       'PC-completion-help)
+
+          (define-key completion-map "\e\t"    'PC-complete)
+          (define-key completion-map "\e "     'PC-complete-word)
+          (define-key completion-map "\e\r"    'PC-force-complete-and-exit)
+          (define-key completion-map "\e\n"    'PC-force-complete-and-exit)
+          (define-key completion-map "\e?"     'PC-completion-help)
+
+          (define-key must-match-map "\t"      'PC-complete)
+          (define-key must-match-map " "       'PC-complete-word)
+          (define-key must-match-map "\r"      'PC-complete-and-exit)
+          (define-key must-match-map "\n"      'PC-complete-and-exit)
+          (define-key must-match-map "?"       'PC-completion-help)
+
+          (define-key must-match-map "\e\t"    'PC-complete)
+          (define-key must-match-map "\e "     'PC-complete-word)
+          (define-key must-match-map "\e\r"    'PC-complete-and-exit)
+          (define-key must-match-map "\e\n"    'PC-complete-and-exit)
+          (define-key must-match-map "\e?"     'PC-completion-help)
+
+          (define-key global-map "\e\t"        'PC-lisp-complete-symbol)))))
+
+;; Because the `partial-completion-mode' option is defined before the
+;; `partial-completion-mode' command and its callee, we give the former a
+;; default `:initialize' keyword value.  Otherwise, the `:set' keyword value
+;; would be called to initialise the variable value, and that would call the
+;; as-yet undefined `partial-completion-mode' function.
+;; Since the default `:initialize' keyword value (obviously) does not turn on
+;; Partial Completion Mode, we do that here, once the `partial-completion-mode'
+;; function and its callee are defined.
+(when partial-completion-mode
+  (partial-completion-mode t))
+\f
 (defun PC-complete ()
   "Like minibuffer-complete, but allows \"b--di\"-style abbreviations.
 For example, \"M-x b--di\" would match `byte-recompile-directory', or any
@@ -178,7 +288,21 @@ Word-delimiters for the purposes of Partial Completion are \"-\", \"_\",
   (interactive)
   (if (PC-was-meta-key)
       (minibuffer-complete)
-    (PC-do-completion nil)))
+    ;; If the previous command was not this one,
+    ;; never scroll, always retry completion.
+    (or (eq last-command this-command)
+       (setq minibuffer-scroll-window nil))
+    (let ((window minibuffer-scroll-window))
+      ;; If there's a fresh completion window with a live buffer,
+      ;; and this command is repeated, scroll that window.
+      (if (and window (window-buffer window)
+              (buffer-name (window-buffer window)))
+         (save-excursion
+           (set-buffer (window-buffer window))
+           (if (pos-visible-in-window-p (point-max) window)
+               (set-window-start window (point-min) nil)
+             (scroll-other-window)))
+       (PC-do-completion nil)))))
 
 
 (defun PC-complete-word ()
@@ -395,7 +519,9 @@ of `minibuffer-completion-table' and the minibuffer contents.")
          (setq p compl)
          (while p
            (and (string-match regex (car p))
-                (setq poss (cons (car p) poss)))
+                (progn
+                  (set-text-properties 0 (length (car p)) '() (car p))
+                  (setq poss (cons (car p) poss))))
            (setq p (cdr p)))))
 
       ;; Now we have a list of possible completions
@@ -449,7 +575,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
        ;; Is the actual string one of the possible completions?
        (setq p (and (not (eq mode 'help)) poss))
        (while (and p
-                   (not (equal (car p) basestr)))
+                   (not (string-equal (car p) basestr)))
          (setq p (cdr p)))
        (and p (null mode)
             (PC-temp-minibuffer-message " [Complete, but not unique]"))
@@ -493,8 +619,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
                                             (delete-char 1)
                                             (setq end (1- end))))
                                      (setq improved t))
-                                   ;; Use format to discard text properties.
-                                   (insert (format "%s" (substring prefix i (1+ i))))
+                                   (insert (substring prefix i (1+ i)))
                                    (setq end (1+ end)))
                                  (setq i (1+ i)))
                                (or pt (equal (point) beg)
@@ -591,25 +716,25 @@ of `minibuffer-completion-table' and the minibuffer contents.")
 
 (defvar PC-not-minibuffer nil)
 
-(defun PC-temp-minibuffer-message (m)
+(defun PC-temp-minibuffer-message (message)
   "A Lisp version of `temp_minibuffer_message' from minibuf.c."
-  (if PC-not-minibuffer
-      (progn
-       (message m)
-       (sit-for 2)
-       (message ""))
-    (if (fboundp 'temp-minibuffer-message)
-       (temp-minibuffer-message m)
-      (let ((savemax (point-max)))
-       (save-excursion
-         (goto-char (point-max))
-         (insert m))
-       (let ((inhibit-quit t))
-         (sit-for 2)
-         (delete-region savemax (point-max))
-         (if quit-flag
-             (setq quit-flag nil
-                   unread-command-char 7)))))))
+  (cond (PC-not-minibuffer
+        (message message)
+        (sit-for 2)
+        (message ""))
+       ((fboundp 'temp-minibuffer-message)
+        (temp-minibuffer-message message))
+       (t
+        (let ((point-max (point-max)))
+          (save-excursion
+            (goto-char point-max)
+            (insert message))
+          (let ((inhibit-quit t))
+            (sit-for 2)
+            (delete-region point-max (point-max))
+            (when quit-flag
+              (setq quit-flag nil
+                    unread-command-events '(7))))))))
 
 
 (defun PC-lisp-complete-symbol ()
@@ -657,20 +782,25 @@ or properties are considered."
       (let* ((pat buffer-file-name)
             (files (PC-expand-many-files pat))
             (first (car files))
-            (next files))
+            (next (reverse (cdr files))))
        (kill-buffer (current-buffer))
        (or files
            (error "No matching files"))
+       ;; Bring the other files (not the first) into buffers.
        (save-window-excursion
-         (while (setq next (cdr next))
+         (while next
            (let ((buf (find-file-noselect (car next))))
-             (switch-to-buffer buf))))
-       ;; This modifies the "buf" variable inside find-file-noselect.
+             ;; Put this buffer at the front of the buffer list.
+             (switch-to-buffer buf))
+           (setq next (cdr next))))
+       ;; This modifies the `buf' variable inside find-file-noselect.
        (setq buf (get-file-buffer first))
        (if buf
            nil   ; should do verify-visited-file-modtime stuff.
          (setq filename first)
          (setq buf (create-file-buffer filename))
+         ;; This modified `truename' inside find-file-noselect.
+         (setq truename (abbreviate-file-name (file-truename filename)))
          (set-buffer buf)
          (erase-buffer)
          (insert-file-contents filename t))
@@ -707,16 +837,23 @@ or properties are considered."
       (delete-backward-char 1)
       (insert "\")")
       (goto-char (point-min))
-      (let ((files (read (current-buffer))))
+      (let ((files (read (current-buffer))) (p nil))
        (kill-buffer (current-buffer))
-       files))))
-
-(or PC-disable-wildcards
-    (memq 'PC-try-load-many-files find-file-not-found-hooks)
-    (setq find-file-not-found-hooks (cons 'PC-try-load-many-files
-                                         find-file-not-found-hooks)))
-
-
+       (or (equal completion-ignored-extensions PC-ignored-extensions)
+           (setq PC-ignored-regexp
+                 (concat "\\("
+                         (mapconcat
+                          'regexp-quote
+                          (setq PC-ignored-extensions
+                                completion-ignored-extensions)
+                          "\\|")
+                         "\\)\\'")))
+       (setq p nil)
+       (while files
+         (or (string-match PC-ignored-regexp (car files))
+             (setq p (cons (car files) p)))
+         (setq files (cdr files)))
+       p))))
 
 ;;; Facilities for loading C header files.  This is independent from the
 ;;; main completion code.  See also the variable `PC-include-file-path'
@@ -847,8 +984,6 @@ absolute rather than relative to some directory on the SEARCH-PATH."
          (setq sorted (cdr sorted)))
        compressed))))
 
-(defvar PC-old-read-file-name-internal nil)
-
 (defun PC-read-include-file-name-internal (string dir action)
   (if (string-match "<\\([^\"<>]*\\)>?$" string)
       (let* ((name (substring string (match-beginning 1) (match-end 1)))
@@ -864,20 +999,8 @@ absolute rather than relative to some directory on the SEARCH-PATH."
         ((eq action 'lambda)
          (eq (try-completion str2 completion-table nil) t))))
     (funcall PC-old-read-file-name-internal string dir action)))
-
-(or PC-disable-includes
-    (memq 'PC-look-for-include-file find-file-not-found-hooks)
-    (setq find-file-not-found-hooks (cons 'PC-look-for-include-file
-                                         find-file-not-found-hooks)))
-
-(or PC-disable-includes
-    PC-old-read-file-name-internal
-    (progn
-      (setq PC-old-read-file-name-internal
-           (symbol-function 'read-file-name-internal))
-      (fset 'read-file-name-internal 'PC-read-include-file-name-internal)))
-
 \f
+
 (provide 'complete)
 
 ;;; End.