8:40 a.m.
2000-07-07 Ben Wing <ben(a)xemacs.org>
* 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>
+;; Copyright (C) 2000 Ben Wing.
+
+;; Author: Chris Mcconnell <chrimc(a)microsoft.com>
+;; 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