Index: complete.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/complete.el,v
retrieving revision 1.72
diff -u -r1.72 complete.el
--- complete.el	14 Apr 2007 20:23:31 -0000	1.72
+++ complete.el	4 Jun 2007 22:09:54 -0000
@@ -454,6 +454,7 @@
 	 env-on
 	 regex
 	 p offset
+         abbreviated
 	 (poss nil)
 	 helpposs
 	 (case-fold-search completion-ignore-case))
@@ -468,346 +469,361 @@
 	    (setq str (PC-try-completion str table pred))
 	    (delete-region beg end)
 	    (insert str))
-	  'complete)
+          'complete)
 
-      ;; Do substitutions in directory names
-      (and filename
-           (setq basestr (or (file-name-directory str) ""))
-           (setq dirlength (length basestr))
-	   ;; Do substitutions in directory names
-           (setq p (substitute-in-file-name basestr))
-           (not (string-equal basestr p))
-           (setq str (concat p (file-name-nondirectory str)))
-           (progn
-	     (delete-region beg end)
-	     (insert str)
-	     (setq end (+ beg (length str)))))
-
-      ;; Prepare various delimiter strings
-      (or (equal PC-word-delimiters PC-delims)
-	  (setq PC-delims PC-word-delimiters
-		PC-delim-regex (concat "[" PC-delims "]")
-		PC-ndelims-regex (concat "[^" PC-delims "]*")
-		PC-delims-list (append PC-delims nil)))
-
-      ;; Add wildcards if necessary
-      (and filename
-           (let ((dir (file-name-directory str))
-                 (file (file-name-nondirectory str))
-		 ;; The base dir for file-completion is passed in `predicate'.
-		 (default-directory (expand-file-name pred)))
-             (while (and (stringp dir) (not (file-directory-p dir)))
-               (setq dir (directory-file-name dir))
-               (setq file (concat (replace-regexp-in-string
-                                   PC-delim-regex "*\\&"
-                                   (file-name-nondirectory dir))
-                                  "*/" file))
-               (setq dir (file-name-directory dir)))
-             (setq origstr str str (concat dir file))))
-
-      ;; Look for wildcard expansions in directory name
-      (and filename
-	   (string-match "\\*.*/" str)
-	   (let ((pat str)
-		 ;; The base dir for file-completion is passed in `predicate'.
-		 (default-directory (expand-file-name pred))
-		 files)
-	     (setq p (1+ (string-match "/[^/]*\\'" pat)))
-	     (while (setq p (string-match PC-delim-regex pat p))
-	       (setq pat (concat (substring pat 0 p)
-				 "*"
-				 (substring pat p))
-		     p (+ p 2)))
-	     (setq files (PC-expand-many-files (concat pat "*")))
-	     (if files
-		 (let ((dir (file-name-directory (car files)))
-		       (p files))
-		   (while (and (setq p (cdr p))
-			       (equal dir (file-name-directory (car p)))))
-		   (if p
-		       (setq filename nil table nil pred nil
-			     ambig t)
-		     (delete-region beg end)
-		     (setq str (concat dir (file-name-nondirectory str)))
-		     (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.
-                   (setq str origstr)
-		 (setq filename nil table nil pred nil)))))
-
-      ;; Strip directory name if appropriate
-      (if filename
-	  (if incname
-	      (setq basestr (substring str incname)
-		    dirname (substring str 0 incname))
-	    (setq basestr (file-name-nondirectory str)
-		  dirname (file-name-directory str))
-	    ;; Make sure str is consistent with its directory and basename
-	    ;; parts.  This is important on DOZe'NT systems when str only
-	    ;; includes a drive letter, like in "d:".
-	    (setq str (concat dirname basestr)))
-	(setq basestr str))
-
-      ;; Convert search pattern to a standard regular expression
-      (setq regex (regexp-quote basestr)
-	    offset (if (and (> (length regex) 0)
-			    (not (eq (aref basestr 0) ?\*))
-			    (or (eq PC-first-char t)
-				(and PC-first-char filename))) 1 0)
-	    p offset)
-      (while (setq p (string-match PC-delim-regex regex p))
-	(if (eq (aref regex p) ? )
-	    (setq regex (concat (substring regex 0 p)
-				PC-ndelims-regex
-				PC-delim-regex
-				(substring regex (1+ p)))
-		  p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
-	  (let ((bump (if (memq (aref regex p)
-				'(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\))
-			  -1 0)))
-	    (setq regex (concat (substring regex 0 (+ p bump))
-				PC-ndelims-regex
-				(substring regex (+ p bump)))
-		  p (+ p (length PC-ndelims-regex) 1)))))
-      (setq p 0)
-      (if filename
-	  (while (setq p (string-match "\\\\\\*" regex p))
-	    (setq regex (concat (substring regex 0 p)
-				"[^/]*"
-				(substring regex (+ p 2))))))
-      ;;(setq the-regex regex)
-      (setq regex (concat "\\`" regex))
-
-      (and (> (length basestr) 0)
-           (= (aref basestr 0) ?$)
-           (setq env-on t
-                 table PC-env-vars-alist
-                 pred nil))
-
-      ;; Find an initial list of possible completions
-      (if (not (setq p (string-match (concat PC-delim-regex
-					     (if filename "\\|\\*" ""))
-				     str
-				     (+ (length dirname) offset))))
-
-	  ;; Minibuffer contains no hyphens -- simple case!
-	  (setq poss (all-completions (if env-on
-					  basestr str)
-				      table
-				      pred))
-
-	;; 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
-					  (file-name-nondirectory (substring str 0 p))
-					(substring str 0 p))
+        ;; Do substitutions in directory names
+        (and filename
+             (setq basestr (or (file-name-directory str) ""))
+             (setq dirlength (length basestr))
+             ;; Do substitutions in directory names
+             (setq p (substitute-in-file-name basestr))
+             (not (string-equal basestr p))
+             (setq str (concat p (file-name-nondirectory str)))
+             (progn
+               (delete-region beg end)
+               (insert str)
+               (setq end (+ beg (length str)))))
+
+        ;; Prepare various delimiter strings
+        (or (equal PC-word-delimiters PC-delims)
+            (setq PC-delims PC-word-delimiters
+                  PC-delim-regex (concat "[" PC-delims "]")
+                  PC-ndelims-regex (concat "[^" PC-delims "]*")
+                  PC-delims-list (append PC-delims nil)))
+
+        ;; Add wildcards if necessary
+        (and filename
+             (let ((dir (file-name-directory str))
+                   (file (file-name-nondirectory str))
+                   ;; The base dir for file-completion is passed in `predicate'.
+                   (default-directory (expand-file-name pred)))
+               (while (and (stringp dir) (not (file-directory-p dir)))
+                 (setq dir (directory-file-name dir))
+                 (setq file (concat (replace-regexp-in-string
+                                     PC-delim-regex "*\\&"
+                                     (file-name-nondirectory dir))
+                                    "*/" file))
+                 (setq dir (file-name-directory dir)))
+               (setq origstr str str (concat dir file))))
+
+        ;; Look for wildcard expansions in directory name
+        (and filename
+             (string-match "\\*.*/" str)
+             (let ((pat str)
+                   ;; The base dir for file-completion is passed in `predicate'.
+                   (default-directory (expand-file-name pred))
+                   files)
+               (setq p (1+ (string-match "/[^/]*\\'" pat)))
+               (while (setq p (string-match PC-delim-regex pat p))
+                 (setq pat (concat (substring pat 0 p)
+                                   "*"
+                                   (substring pat p))
+                       p (+ p 2)))
+               (setq files (PC-expand-many-files (concat pat "*")))
+               (if files
+                   (let ((dir (file-name-directory (car files)))
+                         (p files))
+                     (while (and (setq p (cdr p))
+                                 (equal dir (file-name-directory (car p)))))
+                     (if p
+                         (setq filename nil table nil pred nil
+                               ambig t)
+                         (delete-region beg end)
+                         (setq str (concat dir (file-name-nondirectory str)))
+                         (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.
+                       (setq str origstr)
+                       (setq filename nil table nil pred nil)))))
+
+        ;; Strip directory name if appropriate
+        (if filename
+            (if incname
+                (setq basestr (substring str incname)
+                      dirname (substring str 0 incname))
+                (setq basestr (file-name-nondirectory str)
+                      dirname (file-name-directory str))
+                ;; Make sure str is consistent with its directory and basename
+                ;; parts.  This is important on DOZe'NT systems when str only
+                ;; includes a drive letter, like in "d:".
+                (setq str (concat dirname basestr)))
+            (setq basestr str))
+
+        ;; Convert search pattern to a standard regular expression
+        (setq regex (regexp-quote basestr)
+              offset (if (and (> (length regex) 0)
+                              (not (eq (aref basestr 0) ?\*))
+                              (or (eq PC-first-char t)
+                                  (and PC-first-char filename))) 1 0)
+              p offset)
+        (while (setq p (string-match PC-delim-regex regex p))
+          (if (eq (aref regex p) ? )
+              (setq regex (concat (substring regex 0 p)
+                                  PC-ndelims-regex
+                                  PC-delim-regex
+                                  (substring regex (1+ p)))
+                    p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
+              (let ((bump (if (memq (aref regex p)
+                                    '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\))
+                              -1 0)))
+                (setq regex (concat (substring regex 0 (+ p bump))
+                                    PC-ndelims-regex
+                                    (substring regex (+ p bump)))
+                      p (+ p (length PC-ndelims-regex) 1)))))
+        (setq p 0)
+        (if filename
+            (while (setq p (string-match "\\\\\\*" regex p))
+              (setq regex (concat (substring regex 0 p)
+                                  "[^/]*"
+                                  (substring regex (+ p 2))))))
+        ;;(setq the-regex regex)
+        (setq regex (concat "\\`" regex))
+
+        (and (> (length basestr) 0)
+             (= (aref basestr 0) ?$)
+             (setq env-on t
+                   table PC-env-vars-alist
+                   pred nil))
+
+        ;; Find an initial list of possible completions
+        (unless (setq p (string-match (concat PC-delim-regex
+                                              (if filename "\\|\\*" ""))
+                                      str
+                                      (+ (length dirname) offset)))
+
+          ;; Minibuffer contains no hyphens -- simple case!
+          (setq poss (all-completions (if env-on basestr str)
                                       table
-                                      pred)))
-	  (setq p compl)
-	  (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)))))
-
-      ;; If table had duplicates, they can be here.
-      (delete-dups poss)
-
-      ;; Handle completion-ignored-extensions
-      (and filename
-           (not (eq mode 'help))
-           (let ((p2 poss))
-
-             ;; Build a regular expression representing the extensions list
-             (or (equal completion-ignored-extensions PC-ignored-extensions)
-                 (setq PC-ignored-regexp
-                       (concat "\\("
-                               (mapconcat
-                                'regexp-quote
-                                (setq PC-ignored-extensions
-                                      completion-ignored-extensions)
-                                "\\|")
-                               "\\)\\'")))
-
-             ;; Check if there are any without an ignored extension.
-             ;; Also ignore `.' and `..'.
-             (setq p nil)
-             (while p2
-               (or (string-match PC-ignored-regexp (car p2))
-                   (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
-                   (setq p (cons (car p2) p)))
-               (setq p2 (cdr p2)))
-
-             ;; If there are "good" names, use them
-             (and p (setq poss p))))
-
-      ;; Now we have a list of possible completions
-      (cond
-
-       ;; No valid completions found
-       ((null poss)
-	(if (and (eq mode 'word)
-		 (not PC-word-failed-flag))
-	    (let ((PC-word-failed-flag t))
-	      (delete-backward-char 1)
-	      (PC-do-completion 'word))
-	  (beep)
-	  (PC-temp-minibuffer-message (if ambig
-					  " [Ambiguous dir name]"
-					(if (eq mode 'help)
-					    " [No completions]"
-					  " [No match]")))
-	  nil))
-
-       ;; More than one valid completion found
-       ((or (cdr (setq helpposs poss))
-	    (memq mode '(help word)))
-
-	;; Is the actual string one of the possible completions?
-	(setq p (and (not (eq mode 'help)) poss))
-	(while (and p
-		    (not (string-equal (car p) basestr)))
-	  (setq p (cdr p)))
-	(and p (null mode)
-	     (PC-temp-minibuffer-message " [Complete, but not unique]"))
-	(if (and p
-		 (not (and (null mode)
-			   (eq this-command last-command))))
-	    t
-
-	  ;; If ambiguous, try for a partial completion
-	  (let ((improved nil)
-		prefix
-		(pt nil)
-		(skip "\\`"))
-
-	    ;; Check if next few letters are the same in all cases
-	    (if (and (not (eq mode 'help))
-		     (setq prefix (PC-try-completion
-				   (PC-chunk-after basestr skip) poss)))
-		(let ((first t) i)
-		  ;; Retain capitalization of user input even if
-		  ;; completion-ignore-case is set.
-		  (if (eq mode 'word)
-		      (setq prefix (PC-chop-word prefix basestr)))
-		  (goto-char (+ beg (length dirname)))
-		  (while (and (progn
-				(setq i 0) ; index into prefix string
-				(while (< i (length prefix))
-				  (if (and (< (point) end)
-					   (eq (downcase (aref prefix i))
-					       (downcase (following-char))))
-				      ;; same char (modulo case); no action
-				      (forward-char 1)
-				    (if (and (< (point) end)
-					     (and (looking-at " ")
-                                                  (memq (aref prefix i)
-							PC-delims-list)))
-					;; replace " " by the actual delimiter
-					(progn
-					  (delete-char 1)
-					  (insert (substring prefix i (1+ i))))
-				      ;; insert a new character
-				      (progn
-                                        (and filename (looking-at "\\*")
-                                             (progn
-                                               (delete-char 1)
-                                               (setq end (1- end))))
-					(setq improved t)
-                                        (insert (substring prefix i (1+ i)))
-					(setq end (1+ end)))))
-				  (setq i (1+ i)))
-				(or pt (setq pt (point)))
-				(looking-at PC-delim-regex))
-			      (setq skip (concat skip
-						 (regexp-quote prefix)
-						 PC-ndelims-regex)
-				    prefix (PC-try-completion
-					    (PC-chunk-after
-					     ;; not basestr, because that does
-					     ;; not reflect insertions
-					     (buffer-substring
-					      (+ beg (length dirname)) end)
-					     skip)
-					    (mapcar
-                                             (lambda (x)
-                                               (when (string-match skip x)
-                                                 (substring x (match-end 0))))
-					     poss)))
-			      (or (> i 0) (> (length prefix) 0))
-			      (or (not (eq mode 'word))
-				  (and first (> (length prefix) 0)
-				       (setq first nil
-					     prefix (substring prefix 0 1))))))
-		  (goto-char (if (eq mode 'word) end
-			       (or pt beg)))))
-
-	    (if (and (eq mode 'word)
-		     (not PC-word-failed-flag))
-
-		(if improved
-
-		    ;; We changed it... would it be complete without the space?
-		    (if (test-completion (buffer-substring 1 (1- end))
-                                         table pred)
-			(delete-region (1- end) end)))
-
-	      (if improved
-
-		  ;; We changed it... enough to be complete?
-		  (and (eq mode 'exit)
-		       (test-completion-ignore-case (field-string) table pred))
-
-		;; If totally ambiguous, display a list of completions
-		(if (or (eq completion-auto-help t)
-			(and completion-auto-help
-			     (eq last-command this-command))
-			(eq mode 'help))
-                    (let ((prompt-end (minibuffer-prompt-end)))
-                      (with-output-to-temp-buffer "*Completions*"
-                        (display-completion-list (sort helpposs 'string-lessp))
-                        (setq PC-do-completion-end end
-                              PC-goto-end goto-end)
-                        (with-current-buffer standard-output
-                          ;; Record which part of the buffer we are completing
-                          ;; so that choosing a completion from the list
-                          ;; knows how much old text to replace.
-                          ;; This was briefly nil in the non-dirname case.
-                          ;; However, if one calls PC-lisp-complete-symbol
-                          ;; on "(ne-f" with point on the hyphen, PC offers
-                          ;; all completions starting with "(ne", some of
-                          ;; which do not match the "-f" part (maybe it
-                          ;; should not, but it does). In such cases,
-                          ;; completion gets confused trying to figure out
-                          ;; how much to replace, so we tell it explicitly
-                          ;; (ie, the number of chars in the buffer before beg).
-                          ;;
-                          ;; Note that choose-completion-string-functions
-                          ;; plays around with point.
-                          (setq completion-base-size (if dirname
-                                                         dirlength
-                                                       (- beg prompt-end))))))
-		  (PC-temp-minibuffer-message " [Next char not unique]"))
-		nil)))))
-
-       ;; Only one possible completion
-       (t
-	(if (and (equal basestr (car poss))
-		 (not (and env-on filename)))
-	    (if (null mode)
-		(PC-temp-minibuffer-message " [Sole completion]"))
-	  (delete-region beg end)
-	  (insert (format "%s"
-			  (if filename
-			      (substitute-in-file-name (concat dirname (car poss)))
-			    (car poss)))))
-	t)))))
+                                      pred))
+          (unless (or filename poss)
+            ;; Try completion as an abbreviation, e.g. "mvb" -> "m-v-b"
+            ;; -> "multiple-value-bind"
+            (setq regex (concat "\\`" (mapconcat #'list str "[^-]*-"))
+                  origstr str
+                  p 1
+                  abbreviated t)))
+        (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
+                                            (file-name-nondirectory (substring str 0 p))
+                                            (substring str 0 p))
+                                        table
+                                        pred)))
+            (setq p compl)
+            (when (and compl abbreviated)
+              (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))))
+            (setq p (cdr p))))
+
+        ;; If table had duplicates, they can be here.
+        (delete-dups poss)
+
+        ;; Handle completion-ignored-extensions
+        (and filename
+             (not (eq mode 'help))
+             (let ((p2 poss))
+
+               ;; Build a regular expression representing the extensions list
+               (or (equal completion-ignored-extensions PC-ignored-extensions)
+                   (setq PC-ignored-regexp
+                         (concat "\\("
+                                 (mapconcat
+                                  'regexp-quote
+                                  (setq PC-ignored-extensions
+                                        completion-ignored-extensions)
+                                  "\\|")
+                                 "\\)\\'")))
+
+               ;; Check if there are any without an ignored extension.
+               ;; Also ignore `.' and `..'.
+               (setq p nil)
+               (while p2
+                 (or (string-match PC-ignored-regexp (car p2))
+                     (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
+                     (setq p (cons (car p2) p)))
+                 (setq p2 (cdr p2)))
+
+               ;; If there are "good" names, use them
+               (and p (setq poss p))))
+
+        ;; Now we have a list of possible completions
+
+        (cond
+
+          ;; No valid completions found
+          ((null poss)
+           (if (and (eq mode 'word)
+                    (not PC-word-failed-flag))
+               (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]"
+                                               (if (eq mode 'help)
+                                                   " [No completions]"
+                                                   " [No match]")))
+               nil))
+
+          ;; More than one valid completion found
+          ((or (cdr (setq helpposs poss))
+               (memq mode '(help word)))
+
+           ;; Is the actual string one of the possible completions?
+           (setq p (and (not (eq mode 'help)) poss))
+           (while (and p
+                       (not (string-equal (car p) basestr)))
+             (setq p (cdr p)))
+           (and p (null mode)
+                (PC-temp-minibuffer-message " [Complete, but not unique]"))
+           (if (and p
+                    (not (and (null mode)
+                              (eq this-command last-command))))
+               t
+
+               ;; If ambiguous, try for a partial completion
+               (let ((improved nil)
+                     prefix
+                     (pt nil)
+                     (skip "\\`"))
+
+                 ;; Check if next few letters are the same in all cases
+                 (if (and (not (eq mode 'help))
+                          (setq prefix (PC-try-completion
+                                        (PC-chunk-after basestr skip) poss)))
+                     (let ((first t) i)
+                       ;; Retain capitalization of user input even if
+                       ;; completion-ignore-case is set.
+                       (if (eq mode 'word)
+                           (setq prefix (PC-chop-word prefix basestr)))
+                       (goto-char (+ beg (length dirname)))
+                       (while (and (progn
+                                     (setq i 0) ; index into prefix string
+                                     (while (< i (length prefix))
+                                       (if (and (< (point) end)
+                                                (eq (downcase (aref prefix i))
+                                                    (downcase (following-char))))
+                                           ;; same char (modulo case); no action
+                                           (forward-char 1)
+                                           (if (and (< (point) end)
+                                                    (and (looking-at " ")
+                                                         (memq (aref prefix i)
+                                                               PC-delims-list)))
+                                               ;; replace " " by the actual delimiter
+                                               (progn
+                                                 (delete-char 1)
+                                                 (insert (substring prefix i (1+ i))))
+                                               ;; insert a new character
+                                               (progn
+                                                 (and filename (looking-at "\\*")
+                                                      (progn
+                                                        (delete-char 1)
+                                                        (setq end (1- end))))
+                                                 (setq improved t)
+                                                 (insert (substring prefix i (1+ i)))
+                                                 (setq end (1+ end)))))
+                                       (setq i (1+ i)))
+                                     (or pt (setq pt (point)))
+                                     (looking-at PC-delim-regex))
+                                   (setq skip (concat skip
+                                                      (regexp-quote prefix)
+                                                      PC-ndelims-regex)
+                                         prefix (PC-try-completion
+                                                 (PC-chunk-after
+                                                  ;; not basestr, because that does
+                                                  ;; not reflect insertions
+                                                  (buffer-substring
+                                                   (+ beg (length dirname)) end)
+                                                  skip)
+                                                 (mapcar
+                                                  (lambda (x)
+                                                    (when (string-match skip x)
+                                                      (substring x (match-end 0))))
+                                                  poss)))
+                                   (or (> i 0) (> (length prefix) 0))
+                                   (or (not (eq mode 'word))
+                                       (and first (> (length prefix) 0)
+                                            (setq first nil
+                                                  prefix (substring prefix 0 1))))))
+                       (goto-char (if (eq mode 'word) end
+                                      (or pt beg)))))
+
+                 (if (and (eq mode 'word)
+                          (not PC-word-failed-flag))
+
+                     (if improved
+
+                         ;; We changed it... would it be complete without the space?
+                         (if (test-completion (buffer-substring 1 (1- end))
+                                              table pred)
+                             (delete-region (1- end) end)))
+
+                     (if improved
+
+                         ;; We changed it... enough to be complete?
+                         (and (eq mode 'exit)
+                              (test-completion-ignore-case (field-string) table pred))
+
+                         ;; If totally ambiguous, display a list of completions
+                         (if (or (eq completion-auto-help t)
+                                 (and completion-auto-help
+                                      (eq last-command this-command))
+                                 (eq mode 'help))
+                             (let ((prompt-end (minibuffer-prompt-end)))
+                               (with-output-to-temp-buffer "*Completions*"
+                                 (display-completion-list (sort helpposs 'string-lessp))
+                                 (setq PC-do-completion-end end
+                                       PC-goto-end goto-end)
+                                 (with-current-buffer standard-output
+                                   ;; Record which part of the buffer we are completing
+                                   ;; so that choosing a completion from the list
+                                   ;; knows how much old text to replace.
+                                   ;; This was briefly nil in the non-dirname case.
+                                   ;; However, if one calls PC-lisp-complete-symbol
+                                   ;; on "(ne-f" with point on the hyphen, PC offers
+                                   ;; all completions starting with "(ne", some of
+                                   ;; which do not match the "-f" part (maybe it
+                                   ;; should not, but it does). In such cases,
+                                   ;; completion gets confused trying to figure out
+                                   ;; how much to replace, so we tell it explicitly
+                                   ;; (ie, the number of chars in the buffer before beg).
+                                   ;;
+                                   ;; Note that choose-completion-string-functions
+                                   ;; plays around with point.
+                                   (setq completion-base-size (if dirname
+                                                                  dirlength
+                                                                  (- beg prompt-end))))))
+                             (PC-temp-minibuffer-message " [Next char not unique]"))
+                         nil)))))
+
+          ;; Only one possible completion
+          (t
+           (if (and (equal basestr (car poss))
+                    (not (and env-on filename)))
+               (if (null mode)
+                   (PC-temp-minibuffer-message " [Sole completion]"))
+               (delete-region beg end)
+               (insert (format "%s"
+                               (if filename
+                                   (substitute-in-file-name (concat dirname (car poss)))
+                                   (car poss)))))
+           t)))))
 
 (defun PC-chop-word (new old)
   (let ((i -1)
@@ -857,13 +873,11 @@
 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
+              (forward-sexp 1)
+              (point))))
 	 (beg (save-excursion
                 (with-syntax-table lisp-mode-syntax-table
                   (backward-sexp 1)