patcher for completer: please incorporate

Index: completer.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/ilisp/completer.el,v
retrieving revision 1.7
retrieving revision 1.6
diff -u -r1.7 -r1.6
--- xemacs-packages/ilisp/completer.el	2001/07/02 09:40:44	1.7
+++ xemacs-packages/ilisp/completer.el	2001/02/25 06:15:02	1.6
@@ -1,25 +1,29 @@
-;;; -*-Emacs-Lisp-*-
-;;;%Header
-;;;
-;;; Rcs_Info: completer.el,v 3.23 1993/09/03 02:05:07 ivan Rel $
-;;;
-;;; Partial completion mechanism for GNU Emacs.  Version 3.03
-;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, [email protected].
+;;; completer.el --- powerful completion mechanism
+
+;; Partial completion mechanism for XEmacs.  Version 3.04.
+;; Copyright (C) 1990, 1991, 1992 Chris McConnell <[email protected]>
+;; Copyright (C) 2000 Ben Wing.
+
+;; Author: Chris Mcconnell <[email protected]>
+;; Latest XEmacs Author: Ben Wing
+;; Maintainer: Ben Wing
+;; Keywords: minibuffer, completion
+
 ;;; Thanks to Bjorn Victor for suggestions, testing, and patches for
 ;;; file completion. 
 
-;;; This file is part of GNU Emacs.
+;;; This file is part of XEmacs.
 
-;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; XEmacs is distributed in the hope that it will be useful,
 ;;; but WITHOUT ANY WARRANTY.  No author or distributor
 ;;; accepts responsibility to anyone for the consequences of using it
 ;;; or for whether it serves any particular purpose or works at all,
 ;;; unless he says so in writing.  Refer to the GNU Emacs General Public
 ;;; License for full details.
 ;;; Everyone is granted permission to copy, modify and redistribute
-;;; GNU Emacs, but only under the conditions described in the
+;;; XEmacs, but only under the conditions described in the
 ;;; GNU Emacs General Public License.   A copy of this license is
-;;; supposed to have been given to you along with GNU Emacs so you
+;;; supposed to have been given to you along with XEmacs so you
 ;;; can know your rights and responsibilities.  It should be in a
 ;;; file named COPYING.  Among other things, the copyright notice
 ;;; and this notice must be preserved on all copies.
@@ -121,6 +125,21 @@
 (defvar completer-path-cache nil
   "Cache of (path . choices) for completer.")
 
+(defvar completer-path-separator-string
+  (if (eq system-type 'windows-nt) "\\" "/"))
+
+(defvar completer-path-separator-regexp
+  (if (eq system-type 'windows-nt) "[/\\]" "/"))
+
+(defvar completer-path-delimiter-list
+  (if (eq system-type 'windows-nt) '(?\\ ?/) '(?/)))
+
+(defvar completer-path-separator-regexp-inside-brackets
+  (if (eq system-type 'windows-nt) "/\\" "/"))
+
+(defvar completer-dot-dot-list
+  (if (eq system-type 'windows-nt) '("../" "..\\") '("../")))
+
 (defvar completer-string nil "Last completer string.")
 (defvar completer-table nil "Last completer table.")
 (defvar completer-pred nil "Last completer pred.")
@@ -148,15 +167,15 @@
     (delete-region point end)
     (if (and quit-flag 
 	     ;;(not (eq 'lucid-19 ilisp-emacs-version-id))
-	     (not (string-match "Lucid" emacs-version))
+	     (not (string-match "XEmacs" emacs-version))
 	     )
 	(setq quit-flag nil
 	      unread-command-char 7))))
 
 ;;;
 (defun completer-deleter (regexp choices &optional keep)
-  "Destructively remove strings that match REGEXP in CHOICES.
-Return the modified list.  If optional KEEP, then keep entries that
+  "Destructively remove strings that match REGEXP in CHOICES and
+return the modified list.  If optional KEEP, then keep entries that
 match regexp."
   (let* ((choiceb choices)
 	 choicep)
@@ -180,8 +199,9 @@
 
 ;;;%%Regexp
 (defun completer-regexp (string delimiters any)
-  "Convert STRING into a regexp with words delimited by chars in DELIMITERS.
-Any delimiter in STRING that is the same as ANY will match any delimiter."
+  "Convert STRING into a regexp with words delimited by characters in
+DELIMITERS.  Any delimiter in STRING that is the same as ANY will
+match any delimiter."
   (let* ((delimiter-reg (concat "[" delimiters "]"))
 	 (limit (length string))
 	 (pos 0)
@@ -215,8 +235,8 @@
 
 ;;;%Matcher
 (defun completer-matches (string choices delimiters any)
-    "Return STRING's matches in CHOICES.
-DELIMITERS and the wildcard ANY are used  to segment the strings."
+    "Return STRING's matches in CHOICES using DELIMITERS and wildcard
+ANY to segment the strings."
     (let* ((regexp (concat "[" delimiters "]"))
 	   (from nil)
 	   (to 0)
@@ -264,8 +284,8 @@
 
 ;;;
 (defun completer-choice (string choices delimiters use-words)
-  "Return a list with best match of STRING in CHOICES and T if it is unique.
-DELIMITERS are used to separate words.  A match is unique if it is the only
+  "Return the best match of STRING in CHOICES with DELIMITERS between
+words and T if it is unique.  A match is unique if it is the only
 possibility or when USE-WORDS the only possibility with the same
 number of words.  The shortest string of multiple possibilities will be
 the best match."
@@ -302,8 +322,8 @@
 ;;;%Completer
 ;;;%%Utilities
 (defun completer-region (delimiters)
-  "Return the completion region bounded by characters in DELIMITERS.
-The search is for the current buffer assuming that point is in it."
+  "Return the completion region bounded by characters in DELIMITERS
+for the current buffer assuming that point is in it."
   (cons (save-excursion (skip-chars-backward delimiters) (point))
 	(save-excursion (skip-chars-forward delimiters) (point))))
 	 
@@ -313,13 +333,13 @@
   (let ((last (1- (length string)) )
 	(match 0)
 	(end 0))
-    (while (and (setq match (string-match "/" string end)) (< match last))
+    (while (and (setq match (string-match completer-path-separator-regexp string end)) (< match last))
       (setq end (1+ match)))
     end))
 
 ;;;
 (defun completer-match-record (string matches delimiters any dir mode)
-  "Return (match lcs choices unique) for STRING in MATCHES.
+  "Return (match lcs choices unique) for STRING in MATCHES with
 DELIMITERS or ANY wildcards and DIR if a filename when in MODE."
   (let ((pattern (if dir
 		     (substring string (completer-last-component string))
@@ -347,7 +367,7 @@
 
 ;;;%%Complete file
 (defun completer-extension-regexp (extensions)
-  "Return a regexp that matches a string ending with any string in EXTENSIONS."
+  "Return a regexp that matches to a string that ends with any string from EXTENSIONS list."
   (concat "\\(" (mapconcat 'regexp-quote extensions "\\|") "\\)\\'"))
 
 ;;;
@@ -358,7 +378,8 @@
 
 ;;;
 (defun completer-cache (path pred words any mode)
-  "Check to see if PATH is in path cache with PRED, WORDS, ANY and MODE."
+  "Check to see if PATH is in path cache with PRED, WORDS, ANY and
+MODE."
   (let* ((last nil)
 	 (ptr completer-path-cache)
 	 (size 0) 
@@ -384,7 +405,8 @@
 			   mode t)))
 	  (if (and (or (car (cdr (cdr (cdr choices))))
 		       (string= path (car choices)))
-		   (eq (elt (car choices) (1- (length (car choices)))) ?/))
+		   (memq (elt (car choices) (1- (length (car choices))))
+			 completer-path-delimiter-list))
 	      (progn 
 		(if (>= size completer-cache-size) (rplacd last nil))
 		(setq completer-path-cache 
@@ -393,28 +415,48 @@
 
 ;;;
 (defun completer-file (string pred words any mode)
-  "Return (match common-substring matches unique-p) for STRING.
-It uses 'READ-FILE-NAME-INTERNAL' for choices that pass PRED using WORDS to
+  "Return (match common-substring matches unique-p) for STRING using
+read-file-name-internal for choices that pass PRED using WORDS to
 delimit words.  Optional ANY is a delimiter that matches any of the
 delimiters in WORD.  If optional MODE is nil or 'help then possible
 matches will always be returned."
+  ;; canonicalize slashes under windows-nt for proper completion
+  (if (eq system-type 'windows-nt)
+      (setq string (replace-in-string string "/" "\\\\")))
   (let* ((case-fold-search completion-ignore-case)
 	 (last (and (eq mode 'exit-ok) (completer-last-component string)))
 	 (position
-	  ;; Special hack for CMU RFS filenames
-	  (if (string-match "^/\\.\\./[^/]*/" string)
-	      (match-end 0)
-	      (string-match "[^~/]" string)))
+	  ;; find beginning of first directory component.
+	  (cond
+	   ;; CMU RFS filenames like /../computername/foo/bar.c
+	   ((string-match "^/\\.\\./[^/]*/" string)
+	    (match-end 0))
+	   ;; windows-nt filenames like \\computername\foo\bar.c, or
+	   ;; cygwin filenames like //d/foo/bar.c
+	   ((and (memq system-type '(windows-nt cygwin32))
+		 (string-match "[/\\][/\\][^/\\]*[/\\]" string))
+	    (match-end 0))
+	   ;; windows-nt filenames like c:\foo\bar.c or c:bar.c
+	   ((and (eq system-type 'windows-nt)
+		 (string-match "[A-Za-z]:[/\\]?" string))
+	    (match-end 0))
+	   (t
+	    ;; normal absolute or relative names, or names beginning
+	    ;; with ~/
+	    (string-match
+	     (concat "[^~" completer-path-separator-regexp-inside-brackets
+		     "]") string))))
 	 (new (substring string 0 position))
 	 (user (if (string= new "~")
 		   (setq new (file-name-directory (expand-file-name new)))))
-	 (words (concat words "/"))
+	 (words (concat words completer-path-separator-regexp-inside-brackets))
 	 (len (length string))
 	 (choices nil)
 	 end
 	 (old-choices (list nil nil nil nil)))
     (while position
-      (let* ((begin (string-match "/" string position))
+      (let* ((begin (string-match completer-path-separator-regexp string
+				  position))
 	     (exact-p nil))
 	(setq end (if begin (match-end 0))
 	      choices
@@ -426,10 +468,11 @@
 		   (let* ((choices
 			   (all-completions new 'read-file-name-internal))
 			  (choicep choices))
-		     (if (string= (car choicep) "../")
+		     (if (member (car choicep) completer-dot-dot-list)
 			 (cdr (cdr choicep))
 			 (while (cdr choicep)
-			   (if (string= (car (cdr choicep)) "../")
+			   (if (member (car (cdr choicep))
+				       completer-dot-dot-list)
 			       (rplacd choicep nil))
 			   (setq choicep (cdr choicep)))
 			 choices))
@@ -455,7 +498,11 @@
 	    (setq old-choices
 		  (let* ((lcs (car (cdr choices)))
 			 (matches (car (cdr (cdr choices))))
-			 (slash (and lcs (string-match "/$" lcs))))
+			 (slash
+			  (and lcs
+			       (string-match
+				(concat completer-path-separator-regexp "$")
+				lcs))))
 		    (list nil
 			  (if slash (substring lcs 0 slash) lcs)
 			  (if (and (cdr matches) 
@@ -514,13 +561,13 @@
 ;;;%%Completer
 (defun completer (string table pred words
 			 &optional any mode file-p)
-  "Return (match common-substring matches unique-p) for STRING in TABLE.
-The choices must also pass PRED using WORDS to delimit words.  If the
-flag 'COMPLETER-COMPLETE-FILENAMES' is T and the table is
-'READ-FILE-NAME-INTERNAL', then filename components will be individually
-expanded.  Optional ANY is a delimiter that can match any delimiter in
-WORDS.  Optional MODE is nil for complete, 'help for help and 'exit
-for exit."
+  "Return (match common-substring matches unique-p) for STRING in
+TABLE for choices that pass PRED using WORDS to delimit words.  If the
+flag completer-complete-filenames is T and the table is
+read-file-name-internal or read-directory-name-internal, then filename
+components will be individually expanded.  Optional ANY is a delimiter
+that can match any delimiter in WORDS.  Optional MODE is nil for
+complete, 'help for help and 'exit for exit."
   (if (and (stringp completer-string) 
 	   (string= string completer-string)
 	   (eq table completer-table)
@@ -537,9 +584,12 @@
        completer-mode mode
        completer-result
        (if (and completer-complete-filenames
-		(not file-p) (eq table 'read-file-name-internal))
+		(not file-p) (memq table '(read-file-name-internal
+					   read-directory-name-internal)))
 	   (completer-file string pred words any mode)
-	   (let* ((file-p (or file-p (eq table 'read-file-name-internal)))
+	   (let* ((file-p (or file-p 
+			      (memq table '(read-file-name-internal
+					    read-directory-name-internal))))
 		  (case-fold-search completion-ignore-case)
 		  (pattern (concat "[" words "]"))
 		  (component (if file-p (completer-last-component string)))
@@ -551,8 +601,11 @@
 		 ;; Handle environment variables
 		 (let ((match
 			(getenv (substring string 1 
-					   (string-match "/" string)))))
-		   (if match (setq match (concat match "/")))
+					   (string-match completer-path-separator-regexp string)))))
+		   (if match
+		       (setq match
+			     (concat match
+				     completer-path-separator-string)))
 		   (list match match (list match) match))
 		 (let* ((choices
 			 (all-completions 
@@ -571,13 +624,11 @@
 ;;;%%Display choices
 (defun completer-display-choices (choices &optional match message end
 					  display)
-  "Display the list of possible CHOICES.
-MATCH, MESSAGE, END and DISPLAY are used optionally.  If MATCH is
-non-nil, it will be flagged as the best guess.  If there are no
-choices, display MESSAGE.  END is where to put temporary messages.  If
-DISPLAY is present then it will be called on each possible completion
-and should return a string."
-
+  "Display the list of possible CHOICES with optional MATCH, MESSAGE,
+END and DISPLAY.  If MATCH is non-nil, it will be flagged as the best
+guess.  If there are no choices, display MESSAGE.  END is where to put
+temporary messages.  If DISPLAY is present then it will be called on
+each possible completion and should return a string."
   (if choices
       (with-output-to-temp-buffer "*Completions*"
 	(if (cdr choices) 
@@ -606,15 +657,14 @@
 ;;;%%Goto
 (defun completer-goto (match lcs choices unique delimiters words 
 			     &optional mode display)
-  "Go to the part of the string that disambiguates CHOICES.
-MATCH is the best match, LCS is the longest common substring of all
+  "MATCH is the best match, LCS is the longest common substring of all
 of the matches.  CHOICES is a list of the possibilities, UNIQUE
 indicates if MATCH is unique.  DELIMITERS are possible bounding
 characters for the completion region.  WORDS are the characters that
 delimit the words for partial matches.  Replace the region bounded by
 delimiters with the match if unique and the lcs otherwise unless
 optional MODE is 'help.  Then go to the part of the string that
-disambiguates CHOICES using WORDS to separate words and display the
+disambiguates choices using WORDS to separate words and display the
 possibilities if the string was not extended.  If optional DISPLAY is
 present then it will be called on each possible completion and should
 return a string."
@@ -623,7 +673,9 @@
 	 (start (car region))
 	 (end (cdr region))
 	 (string (buffer-substring start end))
-	 (file-p (string-match "[^ ]*\\(~\\|/\\|$\\)" string))
+	 (file-p (string-match (if (eq system-type 'windows-nt)
+				   "[^ ]*\\(~\\|/\\|\\\\\\|\\|$\\)"
+				 "[^ ]*\\(~\\|/\\|$\\)") string))
 	 (no-insert (eq mode 'help))
 	 (message t)
 	 (new (not (string= (buffer-substring start (point)) lcs))))
@@ -640,7 +692,7 @@
 	;;Not unique
 	(if lcs
 	    (let* ((regexp 
-		    (concat "[" words (if file-p "/") "]"))
+		    (concat "[" words (if file-p completer-path-separator-regexp-inside-brackets) "]"))
 		   (words (completer-words regexp lcs))
 		   point)
 	      ;; Go to where its ambiguous
@@ -675,7 +727,7 @@
 	    (if file-p 
 		(progn 
 		  (if (not (= (point) end)) (forward-char 1))
-		  (if (not (save-excursion (re-search-forward "/" end t)))
+		  (if (not (save-excursion (re-search-forward completer-path-separator-regexp end t)))
 		      (goto-char end))))
 	    (if message
 		(progn
@@ -703,8 +755,8 @@
 
 ;;;%%Undo
 (defun completer-insert (match delimiters &optional buffer undo)
-  "Replace the region bounded with characters in DELIMITERS by MATCH.
-Then save it so that it can be restored by completer-undo."
+  "Replace the region bounded with characters in DELIMITERS by MATCH
+and save it so that it can be restored by completer-undo."
   (let* ((region (completer-region delimiters))
 	 (start (car region))
 	 (end (cdr region)))
@@ -730,13 +782,17 @@
 ;;;%Minibuffer specific code
 ;;;%%Utilities
 (defun completer-minibuf-string ()
-  "Remove dead filename specs from the minibuffer.
-Dead filename should be delimited by // or ~ or $ and return the
-resulting string."
+  "Remove dead filename specs from the minibuffer as delimited by //
+or ~ or $ and return the resulting string."
   (save-excursion
     (goto-char (point-max))
-    (if (and (eq minibuffer-completion-table 'read-file-name-internal)
-	     (re-search-backward "//\\|/~\\|.\\$" nil t))
+    (if (and (memq minibuffer-completion-table
+		   '(read-file-name-internal
+		     read-directory-name-internal))
+	     (re-search-backward
+	      (if (memq system-type '(windows-nt cygwin32))
+		  ; // is meaningful
+		  "/~\\|.\\$" "//\\|/~\\|.\\$") nil t))
 	(delete-region (point-min) (1+ (point))))
     (buffer-substring (point-min) (point-max))))
 
@@ -754,15 +810,17 @@
 	  (let ((string (completer-minibuf-string)))
 	    (or
 	     (not (string-match
-		   (concat "[" completer-words "/~]")
+		   (concat "[" completer-words
+			   completer-path-separator-regexp-inside-brackets "~]")
 		   string))
 	      (condition-case ()
 		  (let ((completion
 			 (try-completion string
 					 minibuffer-completion-table
 					 minibuffer-completion-predicate)))
-		    (if (eq minibuffer-completion-table
-			    'read-file-name-internal)
+		    (if (memq minibuffer-completion-table
+			      '(read-file-name-internal
+				read-directory-name-internal))
 			;; Directories complete as themselves
 			(and completion
 			     (or (not (string= string completion))
@@ -776,8 +834,8 @@
 
 ;;;
 (defun completer-minibuf (&optional mode)
-  "Partial completion of minibuffer expressions.
-Optional MODE is (quote help) for help and (quote exit) for exit.
+  "Partial completion of minibuffer expressions.  Optional MODE is
+'help for help and 'exit for exit.
 
 If what has been typed so far matches any possibility normal
 completion will be done.  Otherwise, the string is considered to be a
@@ -790,7 +848,7 @@
 Examples:
 a-f     auto-fill-mode
 r-e     rmail-expunge
-b--d    *begining-of-defun or byte-recompile-directory
+b--d    *beginning-of-defun or byte-recompile-directory
 by  d   *byte-recompile-directory if completer-any-delimiter is \" \"
 ~/i.e   *~/ilisp.el or ~/il-el.el or ~/ilisp.elc
 /u/mi/  /usr/misc/"
@@ -830,7 +888,6 @@
 (defvar completer-old-completer
   (lookup-key minibuffer-local-must-match-map "\t")
   "Old binding of TAB in minibuffer completion map.")
-
 (defun completer-complete ()
   "Partial completion minibuffer-complete.
 See completer-minibuf for more information."
@@ -966,8 +1023,8 @@
 
 ;;;%lisp-complete-symbol
 (defun lisp-complete-symbol (&optional mode)
-  "Perform partial completion on Lisp symbol preceding point.
-That symbol is compared against the symbols that exist and any additional
+  "Perform partial completion on Lisp symbol preceding point.  That
+symbol is compared against the symbols that exist and any additional
 characters determined by what is there are inserted.  If the symbol
 starts just after an open-parenthesis, only symbols with function
 definitions are considered.  Otherwise, all symbols with function
@@ -1027,5 +1084,3 @@
 ;;;%Hooks
 (provide 'completer)
 (run-hooks 'completer-load-hook)
-
-;;; end of file -- completer.el --