* pop.c (pop_stat, pop_last): Check validity of string-to-integer

[bpt/emacs.git] / lisp / complete.el

diff --git a/lisp/complete.el b/lisp/complete.el
index 7d9bd98..cbc678d 100644 (file)
--- a/lisp/complete.el
+++ b/lisp/complete.el
@@ -1,7 +1,7 @@
 ;;; complete.el --- partial completion mechanism plus other goodies
 
 ;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003,
 ;;; complete.el --- partial completion mechanism plus other goodies
 
 ;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003,

-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Keywords: abbrev convenience
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Keywords: abbrev convenience


@@ -11,7 +11,7 @@
 
 ;; 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
 
 ;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)

 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,


@@ -222,13 +222,6 @@ second TAB brings up the `*Completions*' buffer."
         (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file))
        ((not PC-disable-includes)
         (add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))
         (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file))
        ((not PC-disable-includes)
         (add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))

-  ;; ... with some underhand redefining.
-  (cond ((not partial-completion-mode)
-         (ad-disable-advice 'read-file-name-internal 'around 'PC-include-file)
-         (ad-activate 'read-file-name-internal))
-       ((not PC-disable-includes)
-         (ad-enable-advice 'read-file-name-internal 'around 'PC-include-file)
-         (ad-activate 'read-file-name-internal)))

   ;; Adjust the completion selection in *Completion* buffers to the way
   ;; we work.  The default minibuffer completion code only completes the
   ;; text before point and leaves the text after point alone (new in
   ;; Adjust the completion selection in *Completion* buffers to the way
   ;; we work.  The default minibuffer completion code only completes the
   ;; text before point and leaves the text after point alone (new in


@@ -335,14 +328,24 @@ See `PC-complete' for details."
     (PC-do-complete-and-exit)))
 
 (defun PC-do-complete-and-exit ()
     (PC-do-complete-and-exit)))
 
 (defun PC-do-complete-and-exit ()

-  (if (= (point-max) (minibuffer-prompt-end))  ; Duplicate the "bug" that Info-menu relies on...
-      (exit-minibuffer)
+  (cond
+   ((= (point-max) (minibuffer-prompt-end))
+    ;; Duplicate the "bug" that Info-menu relies on...
+    (exit-minibuffer))
+   ((eq minibuffer-completion-confirm 'confirm-only)
+    (if (or (eq last-command this-command)
+            (test-completion (field-string)
+                             minibuffer-completion-table
+                             minibuffer-completion-predicate))
+        (exit-minibuffer)
+      (PC-temp-minibuffer-message " [Confirm]")))
+   (t

     (let ((flag (PC-do-completion 'exit)))
       (and flag
           (if (or (eq flag 'complete)
                   (not minibuffer-completion-confirm))
               (exit-minibuffer)
     (let ((flag (PC-do-completion 'exit)))
       (and flag
           (if (or (eq flag 'complete)
                   (not minibuffer-completion-confirm))
               (exit-minibuffer)

-            (PC-temp-minibuffer-message " [Confirm]"))))))
+            (PC-temp-minibuffer-message " [Confirm]")))))))

 
 
 (defun PC-completion-help ()
 
 
 (defun PC-completion-help ()


@@ -378,9 +381,9 @@ of `minibuffer-completion-table' and the minibuffer contents.")
 ;; Returns the sequence of non-delimiter characters that follow regexp in string.
 (defun PC-chunk-after (string regexp)
   (if (not (string-match regexp string))
 ;; Returns the sequence of non-delimiter characters that follow regexp in string.
 (defun PC-chunk-after (string regexp)
   (if (not (string-match regexp string))

-      (let ((message (format "String %s didn't match regexp %s" string regexp)))
-       (message message)
-       (error message)))
+      (let ((message "String %s didn't match regexp %s"))
+       (message message string regexp)
+       (error message string regexp)))

   (let ((result (substring string (match-end 0))))
     ;; result may contain multiple chunks
     (if (string-match PC-delim-regex result)
   (let ((result (substring string (match-end 0))))
     ;; result may contain multiple chunks
     (if (string-match PC-delim-regex result)


@@ -430,7 +433,9 @@ point-max (as is appropriate for completing a file name).  If
 GOTO-END is non-nil, however, it instead replaces up to END."
   (or beg (setq beg (minibuffer-prompt-end)))
   (or end (setq end (point-max)))
 GOTO-END is non-nil, however, it instead replaces up to END."
   (or beg (setq beg (minibuffer-prompt-end)))
   (or end (setq end (point-max)))

-  (let* ((table minibuffer-completion-table)
+  (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal)
+                    'PC-read-file-name-internal
+                    minibuffer-completion-table))

         (pred minibuffer-completion-predicate)
         (filename (funcall PC-completion-as-file-name-predicate))
         (dirname nil) ; non-nil only if a filename is being completed
         (pred minibuffer-completion-predicate)
         (filename (funcall PC-completion-as-file-name-predicate))
         (dirname nil) ; non-nil only if a filename is being completed


@@ -445,6 +450,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
         env-on
         regex
         p offset
         env-on
         regex
         p offset

+         abbreviated

         (poss nil)
         helpposs
         (case-fold-search completion-ignore-case))
         (poss nil)
         helpposs
         (case-fold-search completion-ignore-case))


@@ -509,7 +515,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
                                 "*"
                                 (substring pat p))
                     p (+ p 2)))
                                 "*"
                                 (substring pat p))
                     p (+ p 2)))

-            (setq files (PC-expand-many-files (concat pat "*")))
+            (setq files (file-expand-wildcards (concat pat "*")))

             (if files
                 (let ((dir (file-name-directory (car files)))
                       (p files))
             (if files
                 (let ((dir (file-name-directory (car files)))
                       (p files))


@@ -523,11 +529,11 @@ GOTO-END is non-nil, however, it instead replaces up to END."
                     (insert str)
                     (setq end (+ beg (length str)))))
               (if origstr
                     (insert str)
                     (setq end (+ beg (length str)))))
               (if origstr

-                   ;; If the wildcards were introduced by us, it's possible
-                   ;; that read-file-name-internal (especially our
-                   ;; PC-include-file advice) can still find matches for the
-                   ;; original string even if we couldn't, so remove the
-                   ;; added wildcards.
+                       ;; If the wildcards were introduced by us, it's
+                       ;; possible that PC-read-file-name-internal can
+                       ;; still find matches for the original string
+                       ;; even if we couldn't, so remove the added
+                       ;; wildcards.

                    (setq str origstr)
                 (setq filename nil table nil pred nil)))))
 
                    (setq str origstr)
                 (setq filename nil table nil pred nil)))))
 


@@ -581,17 +587,43 @@ GOTO-END is non-nil, however, it instead replaces up to END."
                  pred nil))
 
       ;; Find an initial list of possible completions
                  pred nil))
 
       ;; Find an initial list of possible completions

-      (if (not (setq p (string-match (concat PC-delim-regex
+        (unless (setq p (string-match (concat PC-delim-regex

                                             (if filename "\\|\\*" ""))
                                     str
                                             (if filename "\\|\\*" ""))
                                     str

-                                    (+ (length dirname) offset))))
+                                      (+ (length dirname) offset)))

 
          ;; Minibuffer contains no hyphens -- simple case!
 
          ;; Minibuffer contains no hyphens -- simple case!

-         (setq poss (all-completions (if env-on
-                                         basestr str)
+          (setq poss (all-completions (if env-on basestr str)

                                      table
                                      pred))
                                      table
                                      pred))

-
+          (unless (or poss (string-equal str ""))
+            ;; Try completion as an abbreviation, e.g. "mvb" ->
+            ;; "m-v-b" -> "multiple-value-bind", but only for
+            ;; non-empty strings.
+            (setq origstr str
+                  abbreviated t)
+            (if filename
+                (cond
+                  ;; "alpha" or "/alpha" -> expand whole path.
+                  ((string-match "^/?\\([A-Za-z0-9]+\\)$" str)
+                   (setq
+                    basestr ""
+                    p nil
+                   poss (file-expand-wildcards
+                          (concat "/"
+                                  (mapconcat #'list (match-string 1 str) "*/")
+                                  "*"))
+                    beg (1- beg)))
+                  ;; Alphanumeric trailer -> expand trailing file
+                  ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str)
+                   (setq regex (concat "\\`"
+                                        (mapconcat #'list
+                                                   (match-string 2 str)
+                                                   "[A-Za-z0-9]*[^A-Za-z0-9]"))
+                          p (1+ (length (match-string 1 str))))))
+                (setq regex (concat "\\`" (mapconcat #'list str "[^-]*-"))
+                      p 1))))
+        (when p

        ;; Use all-completions to do an initial cull.  This is a big win,
        ;; since all-completions is written in C!
        (let ((compl (all-completions (if env-on
        ;; Use all-completions to do an initial cull.  This is a big win,
        ;; since all-completions is written in C!
        (let ((compl (all-completions (if env-on


@@ -600,12 +632,24 @@ GOTO-END is non-nil, however, it instead replaces up to END."
                                       table
                                       pred)))
          (setq p compl)
                                       table
                                       pred)))
          (setq p compl)

+            (when (and compl abbreviated)
+              (if filename
+                  (progn
+                    (setq p nil)
+                    (dolist (x compl)
+                      (when (string-match regex x)
+                        (push x p)))
+                    (setq basestr (try-completion "" p)))
+                  (setq basestr (mapconcat 'list str "-"))
+                  (delete-region beg end)
+                  (setq end (+ beg (length basestr)))
+                  (insert basestr))))

          (while p
            (and (string-match regex (car p))
                 (progn
                   (set-text-properties 0 (length (car p)) '() (car p))
                   (setq poss (cons (car p) poss))))
          (while p
            (and (string-match regex (car p))
                 (progn
                   (set-text-properties 0 (length (car p)) '() (car p))
                   (setq poss (cons (car p) poss))))

-           (setq p (cdr p)))))
+            (setq p (cdr p))))

 
       ;; If table had duplicates, they can be here.
       (delete-dups poss)
 
       ;; If table had duplicates, they can be here.
       (delete-dups poss)


@@ -639,6 +683,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
              (and p (setq poss p))))
 
       ;; Now we have a list of possible completions
              (and p (setq poss p))))
 
       ;; Now we have a list of possible completions

+

       (cond
 
        ;; No valid completions found
       (cond
 
        ;; No valid completions found


@@ -648,6 +693,9 @@ GOTO-END is non-nil, however, it instead replaces up to END."
            (let ((PC-word-failed-flag t))
              (delete-backward-char 1)
              (PC-do-completion 'word))
            (let ((PC-word-failed-flag t))
              (delete-backward-char 1)
              (PC-do-completion 'word))

+               (when abbreviated
+                 (delete-region beg end)
+                 (insert origstr))

          (beep)
          (PC-temp-minibuffer-message (if ambig
                                          " [Ambiguous dir name]"
          (beep)
          (PC-temp-minibuffer-message (if ambig
                                          " [Ambiguous dir name]"


@@ -784,13 +832,18 @@ GOTO-END is non-nil, however, it instead replaces up to END."
                           (setq completion-base-size (if dirname
                                                          dirlength
                                                        (- beg prompt-end))))))
                           (setq completion-base-size (if dirname
                                                          dirlength
                                                        (- beg prompt-end))))))

-                 (PC-temp-minibuffer-message " [Next char not unique]"))
-               nil)))))
+                             (PC-temp-minibuffer-message " [Next char not unique]"))
+                         ;; Expansion of filenames is not reversible,
+                         ;; so just keep the prefix.
+           (when (and abbreviated filename)
+             (delete-region (point) end))
+                         nil)))))

 
        ;; Only one possible completion
        (t
        (if (and (equal basestr (car poss))
 
        ;; Only one possible completion
        (t
        (if (and (equal basestr (car poss))

-                (not (and env-on filename)))
+                 (not (and env-on filename))
+                 (not abbreviated))

            (if (null mode)
                (PC-temp-minibuffer-message " [Sole completion]"))
          (delete-region beg end)
            (if (null mode)
                (PC-temp-minibuffer-message " [Sole completion]"))
          (delete-region beg end)


@@ -816,7 +869,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
 (defun PC-temp-minibuffer-message (message)
   "A Lisp version of `temp_minibuffer_message' from minibuf.c."
   (cond (PC-not-minibuffer
 (defun PC-temp-minibuffer-message (message)
   "A Lisp version of `temp_minibuffer_message' from minibuf.c."
   (cond (PC-not-minibuffer

-        (message message)
+        (message "%s" message)

         (sit-for 2)
         (message ""))
        ((fboundp 'temp-minibuffer-message)
         (sit-for 2)
         (message ""))
        ((fboundp 'temp-minibuffer-message)


@@ -848,13 +901,11 @@ only symbols with function definitions are considered.
 Otherwise, all symbols with function definitions, values
 or properties are considered."
   (interactive)
 Otherwise, all symbols with function definitions, values
 or properties are considered."
   (interactive)

-  (let* ((end (point))
-         ;; To complete the word under point, rather than just the portion
-         ;; before point, use this:
-;;;           (save-excursion
-;;;             (with-syntax-table lisp-mode-syntax-table
-;;;               (forward-sexp 1)
-;;;               (point))))
+  (let* ((end
+          (save-excursion
+            (with-syntax-table lisp-mode-syntax-table
+              (skip-syntax-forward "_w")
+              (point))))

         (beg (save-excursion
                 (with-syntax-table lisp-mode-syntax-table
                   (backward-sexp 1)
         (beg (save-excursion
                 (with-syntax-table lisp-mode-syntax-table
                   (backward-sexp 1)


@@ -912,67 +963,12 @@ or properties are considered."
                                       (point-min) t)
                    (+ (point) 2)
                    (point-min)))
                                       (point-min) t)
                    (+ (point) 2)
                    (point-min)))

-          (minibuffer-completion-table 'read-file-name-internal)
+          (minibuffer-completion-table 'PC-read-file-name-internal)

           (minibuffer-completion-predicate "")
           (PC-not-minibuffer t))
      (goto-char end)
      (PC-do-completion nil beg end)))
 
           (minibuffer-completion-predicate "")
           (PC-not-minibuffer t))
      (goto-char end)
      (PC-do-completion nil beg end)))
 

-;; Use the shell to do globbing.
-;; This could now use file-expand-wildcards instead.
-
-(defun PC-expand-many-files (name)
-  (with-current-buffer (generate-new-buffer " *Glob Output*")
-    (erase-buffer)
-    (when (and (file-name-absolute-p name)
-               (not (file-directory-p default-directory)))
-      ;; If the current working directory doesn't exist `shell-command'
-      ;; signals an error.  So if the file names we're looking for don't
-      ;; depend on the working directory, switch to a valid directory first.
-      (setq default-directory "/"))
-    (shell-command (concat "echo " name) t)
-    (goto-char (point-min))
-    ;; CSH-style shells were known to output "No match", whereas
-    ;; SH-style shells tend to simply output `name' when no match is found.
-    (if (looking-at (concat ".*No match\\|\\(^\\| \\)\\("
-                           (regexp-quote name)
-                           "\\|"
-                           (regexp-quote (expand-file-name name))
-                           "\\)\\( \\|$\\)"))
-       nil
-      (insert "(\"")
-      (while (search-forward " " nil t)
-       (delete-backward-char 1)
-       (insert "\" \""))
-      (goto-char (point-max))
-      (delete-backward-char 1)
-      (insert "\")")
-      (goto-char (point-min))
-      (let ((files (read (current-buffer))) (p nil))
-       (kill-buffer (current-buffer))
-       (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
-          ;; This whole process of going through to shell, to echo, and
-          ;; finally parsing the output is a hack.  It breaks as soon as
-          ;; there are spaces in the file names or when the no-match
-          ;; message changes.  To make up for it, we check that what we read
-          ;; indeed exists, so we may miss some files, but we at least won't
-          ;; list non-existent ones.
-         (or (not (file-exists-p (car files)))
-             (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'
 ;; at top of this file.
 ;; Facilities for loading C header files.  This is independent from the
 ;; main completion code.  See also the variable `PC-include-file-path'
 ;; at top of this file.


@@ -1098,24 +1094,23 @@ absolute rather than relative to some directory on the SEARCH-PATH."
          (setq sorted (cdr sorted)))
        compressed))))
 
          (setq sorted (cdr sorted)))
        compressed))))
 

-(defadvice read-file-name-internal (around PC-include-file disable)
-  (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0))
-      (let* ((string (ad-get-arg 0))
-             (action (ad-get-arg 2))
-             (name (match-string 1 string))
+(defun PC-read-file-name-internal (string dir action)
+  "Extend `read-file-name-internal' to handle include files.
+This is only used by "
+  (if (string-match "<\\([^\"<>]*\\)>?\\'" string)
+      (let* ((name (match-string 1 string))

             (str2 (substring string (match-beginning 0)))
             (completion-table
              (mapcar (lambda (x)
                         (format (if (string-match "/\\'" x) "<%s" "<%s>") x))
                      (PC-include-file-all-completions
                       name (PC-include-file-path)))))
             (str2 (substring string (match-beginning 0)))
             (completion-table
              (mapcar (lambda (x)
                         (format (if (string-match "/\\'" x) "<%s" "<%s>") x))
                      (PC-include-file-all-completions
                       name (PC-include-file-path)))))

-        (setq ad-return-value

               (cond
                ((not completion-table) nil)
                ((eq action 'lambda) (test-completion str2 completion-table nil))
                ((eq action nil) (PC-try-completion str2 completion-table nil))
               (cond
                ((not completion-table) nil)
                ((eq action 'lambda) (test-completion str2 completion-table nil))
                ((eq action nil) (PC-try-completion str2 completion-table nil))

-               ((eq action t) (all-completions str2 completion-table nil)))))
-    ad-do-it))
+          ((eq action t) (all-completions str2 completion-table nil))))
+    (read-file-name-internal string dir action)))

 \f
 
 (provide 'complete)
 \f
 
 (provide 'complete)