2000-07-07 Ben Wing <ben(a)xemacs.org&gt; * completer.el: * completer.el (completer-path-separator-string): New. * completer.el (completer-path-separator-regexp): New. * completer.el (completer-path-delimiter-list): New. * completer.el (completer-path-separator-regexp-inside-brackets): New. * completer.el (completer-dot-dot-list): New. * completer.el (completer-message): * completer.el (completer-last-component): * completer.el (completer-cache): * completer.el (completer-file): * completer.el (completer): * completer.el (completer-goto): * completer.el (completer-minibuf-string): * completer.el (completer-new-cmd): My version 3.04. Works under MS Windows / cygwin now. 1 -- Ben In order to save my hands, I am cutting back on my mail. I also write as succinctly as possible -- please don't be offended. If you send me mail, you _will_ get a response, but please be patient, especially for XEmacs-related mail. If you need an immediate response and it is not apparent in your message, please say so. Thanks for your understanding. See also http://www.666.com/ben/chronic-pain/ Index: completer.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-packages/os/ilisp/completer.el,v retrieving revision 1.1.1.1 diff -u -r1.1.1.1 completer.el --- completer.el 1998/01/14 06:42:54 1.1.1.1 +++ completer.el 2000/07/07 07:37:31 ＠＠ -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, ccm(a)cs.cmu.edu. +;;; completer.el --- powerful completion mechanism + +;; Partial completion mechanism for XEmacs. Version 3.04. +;; Copyright (C) 1990, 1991, 1992 Chris McConnell <chrimc(a)microsoft.com&gt; +;; Copyright (C) 2000 Ben Wing. + +;; Author: Chris Mcconnell <chrimc(a)microsoft.com&gt; +;; 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,7 +167,7 ＠＠ (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)))) ＠＠ -314,7 +333,7 ＠＠ (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)) ＠＠ -386,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 ＠＠ -400,23 +420,43 ＠＠ 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 ＠＠ -428,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)) ＠＠ -457,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) ＠＠ -553,8 +598,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 ＠＠ -622,7 +670,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)))) ＠＠ -639,7 +689,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 ＠＠ -674,7 +724,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 ＠＠ -734,7 +784,10 ＠＠ (save-excursion (goto-char (point-max)) (if (and (eq minibuffer-completion-table 'read-file-name-internal) - (re-search-backward "//\\|/~\\|.\\$" nil t)) + (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)))) ＠＠ -752,7 +805,8 ＠＠ (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