Commit aa6f7b96 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Use \\` and \\' instead of ^ and $ in regexps.

(ange-ftp-send-cmd): Revert last change, and expand
the comment explaining the problem.
parent 0ef3cc90
2005-08-11 Stefan Monnier <monnier@iro.umontreal.ca>
* net/ange-ftp.el: Use \\` and \\' instead of ^ and $ in regexps.
(ange-ftp-send-cmd): Revert last change, and expand
the comment explaining the problem.
2005-08-10 Luc Teirlinck <teirllm@auburn.edu> 2005-08-10 Luc Teirlinck <teirllm@auburn.edu>
   
* ldefs-boot.el: Update. * ldefs-boot.el: Update.
...@@ -9,13 +15,14 @@ ...@@ -9,13 +15,14 @@
(display-time-string-forms): Shorten first line of docstrings. (display-time-string-forms): Shorten first line of docstrings.
   
2005-08-10 Lars Hansen <larsh@soem.dk> 2005-08-10 Lars Hansen <larsh@soem.dk>
* desktop.el (desktop-buffer-mode-handlers): Make
non-customizable. Add autoload cookie. Change initial value to * desktop.el (desktop-buffer-mode-handlers):
Make non-customizable. Add autoload cookie. Change initial value to
nil; add elements in respective modules instead. Fix doc string. nil; add elements in respective modules instead. Fix doc string.
(desktop-load-file): New function. (desktop-load-file): New function.
(desktop-minor-mode-handlers): New autoloaded variable. (desktop-minor-mode-handlers): New autoloaded variable.
(desktop-create-buffer): Call minor mode handlers. Use (desktop-create-buffer): Call minor mode handlers.
desktop-load-file to load major and minor mode modules prior to Use desktop-load-file to load major and minor mode modules prior to
checking for a handler. checking for a handler.
(desktop-save): Don't add nil to desktop-minor-modes for minor (desktop-save): Don't add nil to desktop-minor-modes for minor
modes with nil function in desktop-minor-mode-table. Don't delete modes with nil function in desktop-minor-mode-table. Don't delete
...@@ -28,8 +35,7 @@ ...@@ -28,8 +35,7 @@
(desktop-clear): Allow desktop-clear-preserve-buffers to contain (desktop-clear): Allow desktop-clear-preserve-buffers to contain
regexps. Don't use desktop-clear-preserve-buffers-regexp. regexps. Don't use desktop-clear-preserve-buffers-regexp.
(desktop-clear-preserve-buffers-regexp): Delete. (desktop-clear-preserve-buffers-regexp): Delete.
(desktop-clear-preserve-buffers): Update initial value and (desktop-clear-preserve-buffers): Update initial value and docstring.
docstring.
(desktop-save-buffer): Fix doc string. (desktop-save-buffer): Fix doc string.
   
* hilit-chg.el: Add handler to desktop-minor-mode-handlers. * hilit-chg.el: Add handler to desktop-minor-mode-handlers.
...@@ -81,8 +87,7 @@ ...@@ -81,8 +87,7 @@
(compilation-info-text-face): Delete face variables. (compilation-info-text-face): Delete face variables.
(compilation-text-face): Delete function. (compilation-text-face): Delete function.
   
* progmodes/grep.el (grep-regexp-alist): Use `.+?' instead of * progmodes/grep.el (grep-regexp-alist): Use `.+?' instead of `[^:\n]+'.
`[^:\n]+'.
(grep-mode-font-lock-keywords): Use `.+?' instead of `[^\n-]+'. (grep-mode-font-lock-keywords): Use `.+?' instead of `[^\n-]+'.
(grep-error-face): Set to `compilation-error' instead of (grep-error-face): Set to `compilation-error' instead of
`compilation-error-face' (which is redefined to `grep-hit-face' in `compilation-error-face' (which is redefined to `grep-hit-face' in
...@@ -228,7 +233,7 @@ ...@@ -228,7 +233,7 @@
   
* mail/reporter.el (reporter-dump-state): Use insert-buffer-substring. * mail/reporter.el (reporter-dump-state): Use insert-buffer-substring.
   
* net/net-utils.el (run-dig): Renamed from `dig'. * net/net-utils.el (run-dig): Rename from `dig'.
   
* play/gametree.el (gametree-mode): Use make-local-variable, * play/gametree.el (gametree-mode): Use make-local-variable,
not make-variable-buffer-local. not make-variable-buffer-local.
...@@ -308,23 +313,21 @@ ...@@ -308,23 +313,21 @@
(tramp-completion-handle-expand-file-name): Discard call of (tramp-completion-handle-expand-file-name): Discard call of
`tramp-drop-volume-letter'. It is not necessary, and there have `tramp-drop-volume-letter'. It is not necessary, and there have
been problems with (expand-file-name "~/.netrc" "/") in ange-ftp. been problems with (expand-file-name "~/.netrc" "/") in ange-ftp.
Reported by Richard G. Bielawski Reported by Richard G. Bielawski <Richard.G.Bielawski@wellsfargo.com>.
<Richard.G.Bielawski@wellsfargo.com>.
(tramp-do-copy-or-rename-file-out-of-band): Transfer message (tramp-do-copy-or-rename-file-out-of-band): Transfer message
should always be visible. should always be visible.
(tramp-handle-insert-directory, tramp-setup-complete) (tramp-handle-insert-directory, tramp-setup-complete)
(tramp-set-process-query-on-exit-flag) (tramp-set-process-query-on-exit-flag)
(tramp-append-tramp-buffers): Pacify byte-compiler. (tramp-append-tramp-buffers): Pacify byte-compiler.
(tramp-bug): Delete non-existing variables from list. Apply (tramp-bug): Delete non-existing variables from list.
`tramp-load-report-modules' as pre-hook. Mask Apply `tramp-load-report-modules' as pre-hook.
`tramp-password-prompt-regexp', `tramp-shell-prompt-pattern' and Mask `tramp-password-prompt-regexp', `tramp-shell-prompt-pattern' and
`shell-prompt-pattern' because of non-7bit characters. Reported `shell-prompt-pattern' because of non-7bit characters.
by Sebastian Luque <sluque@mun.ca>. Reported by Sebastian Luque <sluque@mun.ca>.
(tramp-reporter-dump-variable, tramp-load-report-modules): New (tramp-reporter-dump-variable, tramp-load-report-modules): New defuns.
defuns.
(tramp-match-string-list): Remove function. (tramp-match-string-list): Remove function.
(tramp-wait-for-regexp): Remove call of that function. Suggested (tramp-wait-for-regexp): Remove call of that function.
by Kim F. Storm <storm@cua.dk>. Suggested by Kim F. Storm <storm@cua.dk>.
(tramp-set-auto-save-file-modes): Use octal integer code #o600 (tramp-set-auto-save-file-modes): Use octal integer code #o600
instead of octal character code ?\600. The latter resulted in a instead of octal character code ?\600. The latter resulted in a
syntax error with XEmacs. syntax error with XEmacs.
...@@ -399,8 +402,8 @@ ...@@ -399,8 +402,8 @@
(scheme-get-process): New function, extracted from `scheme-proc'. (scheme-get-process): New function, extracted from `scheme-proc'.
(run-scheme): Call `scheme-start-file' to get start file, and pass (run-scheme): Call `scheme-start-file' to get start file, and pass
it to `make-comint'. it to `make-comint'.
(switch-to-scheme, scheme-proc): Call (switch-to-scheme, scheme-proc):
`scheme-interactively-start-process' if no Scheme buffer/process Call `scheme-interactively-start-process' if no Scheme buffer/process
is available. is available.
   
2005-08-06 Juri Linkov <juri@jurta.org> 2005-08-06 Juri Linkov <juri@jurta.org>
...@@ -463,8 +466,7 @@ ...@@ -463,8 +466,7 @@
(thumbs-image-num): Make automatically buffer local. (thumbs-image-num): Make automatically buffer local.
(thumbs-show-thumbs-list): Use `make-local-variable', not (thumbs-show-thumbs-list): Use `make-local-variable', not
`make-variable-buffer-local'. `make-variable-buffer-local'.
(thumbs-insert-image): Make `thumbs-current-image-size' (thumbs-insert-image): Make `thumbs-current-image-size' buffer-local.
buffer-local.
   
* play/doctor.el (doctor-type-symbol): "?\ " -> "?\s". * play/doctor.el (doctor-type-symbol): "?\ " -> "?\s".
(**mad**, *debug*, *print-space*, *print-upcase*, abuselst) (**mad**, *debug*, *print-space*, *print-upcase*, abuselst)
...@@ -506,12 +508,12 @@ ...@@ -506,12 +508,12 @@
2005-08-01 Nick Roberts <nickrob@snap.net.nz> 2005-08-01 Nick Roberts <nickrob@snap.net.nz>
   
Update copyright notices of files in progmodes directory for Update copyright notices of files in progmodes directory for
release of Emacs 22.1. release of Emacs 22.1.
   
* progmodes/gdb-ui.el (gdb-enable-debug-log): Add autoload cookie. * progmodes/gdb-ui.el (gdb-enable-debug-log): Add autoload cookie.
   
* progmodes/gud.el (gud-tooltip-mode): Add autoload cookie. Don't * progmodes/gud.el (gud-tooltip-mode): Add autoload cookie.
barf if the GUD buffer has been killed. Don't barf if the GUD buffer has been killed.
   
2005-08-01 Kim F. Storm <storm@cua.dk> 2005-08-01 Kim F. Storm <storm@cua.dk>
   
......
...@@ -686,7 +686,7 @@ ...@@ -686,7 +686,7 @@
:prefix "ange-ftp-") :prefix "ange-ftp-")
(defcustom ange-ftp-name-format (defcustom ange-ftp-name-format
'("^/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4)) '("\\`/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
"*Format of a fully expanded remote file name. "*Format of a fully expanded remote file name.
This is a list of the form \(REGEXP HOST USER NAME\), This is a list of the form \(REGEXP HOST USER NAME\),
...@@ -863,10 +863,11 @@ If nil, prompt the user for a password." ...@@ -863,10 +863,11 @@ If nil, prompt the user for a password."
string)) string))
(defcustom ange-ftp-binary-file-name-regexp (defcustom ange-ftp-binary-file-name-regexp
(concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|" (concat "TAGS\\'\\|\\.\\(?:"
"\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|" (eval-when-compile
"\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|" (regexp-opt '("z" "Z" "lzh" "arc" "zip" "zoo" "tar" "dvi"
"\\.taz$\\|\\.tgz$") "ps" "elc" "gif" "gz" "taz" "tgz")))
"\\|EXE\\(;[0-9]+\\)?\\|[zZ]-part-..\\)\\'")
"*If a file matches this regexp then it is transferred in binary mode." "*If a file matches this regexp then it is transferred in binary mode."
:group 'ange-ftp :group 'ange-ftp
:type 'regexp) :type 'regexp)
...@@ -1130,7 +1131,7 @@ If the optional parameter NEW is given and the non-directory parts match, ...@@ -1130,7 +1131,7 @@ If the optional parameter NEW is given and the non-directory parts match,
only return the directory part of FILE." only return the directory part of FILE."
(save-match-data (save-match-data
(if (and default-directory (if (and default-directory
(string-match (concat "^" (string-match (concat "\\`"
(regexp-quote default-directory) (regexp-quote default-directory)
".") file)) ".") file))
(setq file (substring file (1- (match-end 0))))) (setq file (substring file (1- (match-end 0)))))
...@@ -1200,7 +1201,7 @@ only return the directory part of FILE." ...@@ -1200,7 +1201,7 @@ only return the directory part of FILE."
(save-match-data (save-match-data
(maphash (maphash
(lambda (key value) (lambda (key value)
(if (string-match "^[^/]*\\(/\\).*$" key) (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
(let ((host (substring key 0 (match-beginning 1)))) (let ((host (substring key 0 (match-beginning 1))))
(if (and (string-equal user (substring key (match-end 1))) (if (and (string-equal user (substring key (match-end 1)))
value) value)
...@@ -1415,7 +1416,7 @@ only return the directory part of FILE." ...@@ -1415,7 +1416,7 @@ only return the directory part of FILE."
(let (res) (let (res)
(maphash (maphash
(lambda (key value) (lambda (key value)
(if (string-match "^[^/]*\\(/\\).*$" key) (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
(let ((host (substring key 0 (match-beginning 1))) (let ((host (substring key 0 (match-beginning 1)))
(user (substring key (match-end 1)))) (user (substring key (match-end 1))))
(push (concat user "@" host ":") res)))) (push (concat user "@" host ":") res))))
...@@ -1655,7 +1656,7 @@ good, skip, fatal, or unknown." ...@@ -1655,7 +1656,7 @@ good, skip, fatal, or unknown."
;; handle hash mark printing ;; handle hash mark printing
(and ange-ftp-process-busy (and ange-ftp-process-busy
(string-match "^#+$" str) (string-match "\\`#+\\'" str)
(setq str (ange-ftp-process-handle-hash str))) (setq str (ange-ftp-process-handle-hash str)))
(comint-output-filter proc str) (comint-output-filter proc str)
;; Replace STR by the result of the comint processing. ;; Replace STR by the result of the comint processing.
...@@ -1678,7 +1679,7 @@ good, skip, fatal, or unknown." ...@@ -1678,7 +1679,7 @@ good, skip, fatal, or unknown."
(seen-prompt nil)) (seen-prompt nil))
(setq ange-ftp-process-string (substring ange-ftp-process-string (setq ange-ftp-process-string (substring ange-ftp-process-string
(match-end 0))) (match-end 0)))
(while (string-match "^ftp> *" line) (while (string-match "\\`ftp> *" line)
(setq seen-prompt t) (setq seen-prompt t)
(setq line (substring line (match-end 0)))) (setq line (substring line (match-end 0))))
(if (not (and seen-prompt ange-ftp-pending-error-line)) (if (not (and seen-prompt ange-ftp-pending-error-line))
...@@ -1863,7 +1864,7 @@ been queued with no result. CONT will still be called, however." ...@@ -1863,7 +1864,7 @@ been queued with no result. CONT will still be called, however."
(move-marker comint-last-input-start (point)) (move-marker comint-last-input-start (point))
;; don't insert the password into the buffer on the USER command. ;; don't insert the password into the buffer on the USER command.
(save-match-data (save-match-data
(if (string-match "^user \"[^\"]*\"" cmd) (if (string-match "\\`user \"[^\"]*\"" cmd)
(insert (substring cmd 0 (match-end 0)) " Turtle Power!\n") (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
(insert cmd))) (insert cmd)))
(move-marker comint-last-input-end (point)) (move-marker comint-last-input-end (point))
...@@ -2069,7 +2070,7 @@ host specified in `ange-ftp-gateway-host'." ...@@ -2069,7 +2070,7 @@ host specified in `ange-ftp-gateway-host'."
PROC is the process to the FTP-client. HOST may have an optional PROC is the process to the FTP-client. HOST may have an optional
suffix of the form #PORT to specify a non-default port" suffix of the form #PORT to specify a non-default port"
(save-match-data (save-match-data
(string-match "^\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host) (string-match "\\`\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host)
(let* ((nshost (ange-ftp-nslookup-host (match-string 1 host))) (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
(port (match-string 3 host)) (port (match-string 3 host))
(result (ange-ftp-raw-send-cmd (result (ange-ftp-raw-send-cmd
...@@ -2148,6 +2149,8 @@ suffix of the form #PORT to specify a non-default port" ...@@ -2148,6 +2149,8 @@ suffix of the form #PORT to specify a non-default port"
(or ange-ftp-binary-hash-mark-size (or ange-ftp-binary-hash-mark-size
(setq ange-ftp-binary-hash-mark-size size))))))))) (setq ange-ftp-binary-hash-mark-size size)))))))))
(defvar ange-ftp-process-startup-hook nil)
(defun ange-ftp-get-process (host user) (defun ange-ftp-get-process (host user)
"Return an FTP subprocess connected to HOST and logged in as USER. "Return an FTP subprocess connected to HOST and logged in as USER.
Create a new process if needed." Create a new process if needed."
...@@ -2309,7 +2312,7 @@ and NOWAIT." ...@@ -2309,7 +2312,7 @@ and NOWAIT."
;; resolve symlinks to directories on SysV machines. (Sebastian will ;; resolve symlinks to directories on SysV machines. (Sebastian will
;; be happy.) ;; be happy.)
(and (eq host-type 'unix) (and (eq host-type 'unix)
(string-match "/$" cmd1) (string-match "/\\'" cmd1)
(not (string-match "R" cmd3)) (not (string-match "R" cmd3))
(setq cmd1 (concat cmd1 "."))) (setq cmd1 (concat cmd1 ".")))
...@@ -2326,15 +2329,22 @@ and NOWAIT." ...@@ -2326,15 +2329,22 @@ and NOWAIT."
(unless (memq host-type ange-ftp-dumb-host-types) (unless (memq host-type ange-ftp-dumb-host-types)
(setq cmd0 'ls) (setq cmd0 'ls)
;; We cd and then use `ls' with no directory argument. ;; We cd and then use `ls' with no directory argument.
;; This works around a misfeature of some versions of netbsd ftpd. ;; This works around a misfeature of some versions of netbsd ftpd
;; where `ls' can only take one argument: either one set of flags
;; or a file/directory name.
;; FIXME: if we're trying to `ls' a single file, this fails since we
;; can't cd to a file. We can't fix this problem here, tho, because
;; at this point we don't know whether the argument is a file or
;; a directory. Such an `ls' is only every used (apparently) from
;; `insert-directory' when the `full-directory-p' argument is nil
;; (which seems to only be used by dired when updating its display
;; after operating on a set of files). We should change
;; ange-ftp-insert-directory so that this case is handled by getting
;; a full listing of the directory and extracting the line
;; corresponding to the requested file.
(unless (equal cmd1 ".") (unless (equal cmd1 ".")
(setq result (ange-ftp-cd host user (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
;; Make sure the target to which (setq cmd1 cmd3)))
;; `cd' is performed is a directory.
(file-name-directory (nth 1 cmd))
'noerror)))
;; Concatenate the switches and the target to be used with `ls'.
(setq cmd1 (concat "\"" cmd3 " " cmd1 "\""))))
;; First argument is the remote name ;; First argument is the remote name
((progn ((progn
...@@ -2770,10 +2780,10 @@ The main reason for this alist is to deal with file versions in VMS.") ...@@ -2770,10 +2780,10 @@ The main reason for this alist is to deal with file versions in VMS.")
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
;; and others don't. (sigh...) Beware, that some Unix's don't ;; and others don't. (sigh...) Beware, that some Unix's don't
;; seem to believe in the F-switch ;; seem to believe in the F-switch
(if (or (and symlink (string-match "@$" file)) (if (or (and symlink (string-match "@\\'" file))
(and directory (string-match "/$" file)) (and directory (string-match "/\\'" file))
(and executable (string-match "*$" file)) (and executable (string-match "*\\'" file))
(and socket (string-match "=$" file))) (and socket (string-match "=\\'" file)))
(setq file (substring file 0 -1))))) (setq file (substring file 0 -1)))))
(puthash file (or symlink directory) tbl) (puthash file (or symlink directory) tbl)
(forward-line 1)) (forward-line 1))
...@@ -3117,22 +3127,24 @@ logged in as user USER and cd'd to directory DIR." ...@@ -3117,22 +3127,24 @@ logged in as user USER and cd'd to directory DIR."
;; See if remote name is absolute. If so then just expand it and ;; See if remote name is absolute. If so then just expand it and
;; replace the name component of the overall name. ;; replace the name component of the overall name.
(cond ((string-match "^/" name) (cond ((string-match "\\`/" name)
name) name)
;; Name starts with ~ or ~user. Resolve that part of the name ;; Name starts with ~ or ~user. Resolve that part of the name
;; making it absolute then re-expand it. ;; making it absolute then re-expand it.
((string-match "^~[^/]*" name) ((string-match "\\`~[^/]*" name)
(let* ((tilda (match-string 0 name)) (let* ((tilda (match-string 0 name))
(rest (substring name (match-end 0))) (rest (substring name (match-end 0)))
(dir (ange-ftp-expand-dir host user tilda))) (dir (ange-ftp-expand-dir host user tilda)))
(if dir (if dir
(setq name (cond ((string-equal rest "") ;; C-x d /ftp:anonymous@ftp.gnu.org:~/ RET
dir) ;; seems to cause `rest' to sometimes be empty.
((string-equal dir "/") ;; Maybe it's an error for `rest' to be empty here,
rest) ;; but until we figure this out, this quick fix
(t ;; seems to do the trick.
(concat dir rest)))) (setq name (cond ((string-equal rest "") dir)
((string-equal dir "/") rest)
(t (concat dir rest))))
(error "User \"%s\" is not known" (error "User \"%s\" is not known"
(substring tilda 1))))) (substring tilda 1)))))
...@@ -3146,19 +3158,18 @@ logged in as user USER and cd'd to directory DIR." ...@@ -3146,19 +3158,18 @@ logged in as user USER and cd'd to directory DIR."
(error "Unable to obtain CWD"))))) (error "Unable to obtain CWD")))))
;; If name starts with //, preserve that, for apollo system. ;; If name starts with //, preserve that, for apollo system.
(if (not (string-match "^//" name)) (unless (string-match "\\`//" name)
(progn (if (not (eq system-type 'windows-nt))
(if (not (eq system-type 'windows-nt)) (setq name (ange-ftp-real-expand-file-name name))
(setq name (ange-ftp-real-expand-file-name name)) ;; Windows UNC default dirs do not make sense for ftp.
;; Windows UNC default dirs do not make sense for ftp. (setq name (if (string-match "\\`//" default-directory)
(if (string-match "^//" default-directory) (ange-ftp-real-expand-file-name name "c:/")
(setq name (ange-ftp-real-expand-file-name name "c:/")) (ange-ftp-real-expand-file-name name)))
(setq name (ange-ftp-real-expand-file-name name))) ;; Strip off possible drive specifier.
;; Strip off possible drive specifier. (if (string-match "\\`[a-zA-Z]:" name)
(if (string-match "^[a-zA-Z]:" name) (setq name (substring name 2))))
(setq name (substring name 2)))) (if (string-match "\\`//" name)
(if (string-match "^//" name) (setq name (substring name 1))))
(setq name (substring name 1)))))
;; Now substitute the expanded name back into the overall filename. ;; Now substitute the expanded name back into the overall filename.
(ange-ftp-replace-name-component n name)) (ange-ftp-replace-name-component n name))
...@@ -3182,8 +3193,8 @@ logged in as user USER and cd'd to directory DIR." ...@@ -3182,8 +3193,8 @@ logged in as user USER and cd'd to directory DIR."
(eq (string-to-char name) ?\\)) (eq (string-to-char name) ?\\))
(ange-ftp-canonize-filename name)) (ange-ftp-canonize-filename name))
((and (eq system-type 'windows-nt) ((and (eq system-type 'windows-nt)
(or (string-match "^[a-zA-Z]:" name) (or (string-match "\\`[a-zA-Z]:" name)
(string-match "^[a-zA-Z]:" default))) (string-match "\\`[a-zA-Z]:" default)))
(ange-ftp-real-expand-file-name name default)) (ange-ftp-real-expand-file-name name default))
((zerop (length name)) ((zerop (length name))
(ange-ftp-canonize-filename default)) (ange-ftp-canonize-filename default))
...@@ -3216,7 +3227,7 @@ system TYPE.") ...@@ -3216,7 +3227,7 @@ system TYPE.")
(if parsed (if parsed
(let ((filename (nth 2 parsed))) (let ((filename (nth 2 parsed)))
(if (save-match-data (if (save-match-data
(string-match "^~[^/]*$" filename)) (string-match "\\`~[^/]*\\'" filename))
name name
(ange-ftp-replace-name-component (ange-ftp-replace-name-component
name name
...@@ -3229,7 +3240,7 @@ system TYPE.") ...@@ -3229,7 +3240,7 @@ system TYPE.")
(if parsed (if parsed
(let ((filename (nth 2 parsed))) (let ((filename (nth 2 parsed)))
(if (save-match-data (if (save-match-data
(string-match "^~[^/]*$" filename)) (string-match "\\`~[^/]*\\'" filename))
"" ""
(ange-ftp-real-file-name-nondirectory filename))) (ange-ftp-real-file-name-nondirectory filename)))
(ange-ftp-real-file-name-nondirectory name)))) (ange-ftp-real-file-name-nondirectory name))))
...@@ -3971,7 +3982,7 @@ E.g., ...@@ -3971,7 +3982,7 @@ E.g.,
;; Maybe we should use something more like ;; Maybe we should use something more like
;; (equal dir (file-name-directory (directory-file-name dir))) -stef ;; (equal dir (file-name-directory (directory-file-name dir))) -stef
(or (and (eq system-type 'windows-nt) (or (and (eq system-type 'windows-nt)
(string-match "^[a-zA-Z]:[/\\]$" dir)) (string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
(string-equal "/" dir))) (string-equal "/" dir)))
(defun ange-ftp-file-name-all-completions (file dir) (defun ange-ftp-file-name-all-completions (file dir)
...@@ -4015,8 +4026,8 @@ E.g., ...@@ -4015,8 +4026,8 @@ E.g.,
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
(ange-ftp-completion-ignored-pattern (ange-ftp-completion-ignored-pattern
(mapconcat (lambda (s) (if (stringp s) (mapconcat (lambda (s) (if (stringp s)
(concat (regexp-quote s) "$") (concat (regexp-quote s) "$")
"/")) ; / never in filename "/")) ; / never in filename
completion-ignored-extensions completion-ignored-extensions
"\\|"))) "\\|")))
(save-match-data (save-match-data
...@@ -4939,7 +4950,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ...@@ -4939,7 +4950,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(defun ange-ftp-fix-name-for-vms (name &optional reverse) (defun ange-ftp-fix-name-for-vms (name &optional reverse)
(save-match-data (save-match-data
(if reverse (if reverse
(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) (if (string-match "\\`\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)\\'" name)
(let (drive dir file) (let (drive dir file)
(setq drive (match-string 1 name)) (setq drive (match-string 1 name))
(setq dir (match-string 2 name)) (setq dir (match-string 2 name))
...@@ -4953,7 +4964,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ...@@ -4953,7 +4964,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
file)) file))
(error "name %s didn't match" name)) (error "name %s didn't match" name))
(let (drive dir file tmp) (let (drive dir file tmp)
(if (string-match "^/[^:]+:/" name) (if (string-match "\\`/[^:]+:/" name)
(setq drive (substring name 1 (setq drive (substring name 1
(1- (match-end 0))) (1- (match-end 0)))
name (substring name (match-end 0)))) name (substring name (match-end 0))))
...@@ -4991,7 +5002,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ...@@ -4991,7 +5002,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;; them. ;; them.
(cond ((string-equal dir-name "/") (cond ((string-equal dir-name "/")
(error "Cannot get listing for fictitious \"/\" directory")) (error "Cannot get listing for fictitious \"/\" directory"))
((string-match "^/[-A-Z0-9_$]+:/$" dir-name) ((string-match "\\`/[-A-Z0-9_$]+:/\\'" dir-name)
(error "Cannot get listing for device")) (error "Cannot get listing for device"))
((ange-ftp-fix-name-for-vms dir-name)))) ((ange-ftp-fix-name-for-vms dir-name))))
...@@ -5045,7 +5056,7 @@ Other orders of $ and _ seem to all work just fine.") ...@@ -5045,7 +5056,7 @@ Other orders of $ and _ seem to all work just fine.")
;; deal with directories ;; deal with directories
(puthash (substring file 0 (match-beginning 0)) t tbl) (puthash (substring file 0 (match-beginning 0)) t tbl)
(puthash file nil tbl) (puthash file nil tbl)
(if (string-match ";[0-9]+$" file) ; deal with extension (if (string-match ";[0-9]+\\'" file) ; deal with extension
;; sans extension ;; sans extension
(puthash (substring file 0 (match-beginning 0)) nil tbl))) (puthash (substring file 0 (match-beginning 0)) nil tbl)))
(forward-line 1)) (forward-line 1))
...@@ -5071,7 +5082,7 @@ Other orders of $ and _ seem to all work just fine.") ...@@ -5071,7 +5082,7 @@ Other orders of $ and _ seem to all work just fine.")
(ange-ftp-internal-delete-file-entry name t) (ange-ftp-internal-delete-file-entry name t)
(save-match-data (save-match-data
(let ((file (ange-ftp-get-file-part name))) (let ((file (ange-ftp-get-file-part name)))
(if (string-match ";[0-9]+$" file) (if (string-match ";[0-9]+\\'" file)
;; In VMS you can't delete a file without an explicit ;; In VMS you can't delete a file without an explicit
;; version number, or wild-card (e.g. FOO;*) ;; version number, or wild-card (e.g. FOO;*)
;; For now, we give up on wildcards. ;; For now, we give up on wildcards.
...@@ -5109,7 +5120,7 @@ Other orders of $ and _ seem to all work just fine.") ...@@ -5109,7 +5120,7 @@ Other orders of $ and _ seem to all work just fine.")
(if files (if files
(let ((file (ange-ftp-get-file-part name))) (let ((file (ange-ftp-get-file-part name)))
(save-match-data (save-match-data
(if (string-match ";[0-9]+$" file) (if (string-match ";[0-9]+\\'" file)
(puthash (substring file 0 (match-beginning 0)) nil files) (puthash (substring file 0 (match-beginning 0)) nil files)
;; Need to figure out what version of the file ;; Need to figure out what version of the file
;; is being added. ;; is being added.
...@@ -5152,7 +5163,7 @@ Other orders of $ and _ seem to all work just fine.") ...@@ -5152,7 +5163,7 @@ Other orders of $ and _ seem to all work just fine.")
(defun ange-ftp-vms-file-name-as-directory (name) (defun ange-ftp-vms-file-name-as-directory (name)
(save-match-data (save-match-data
(if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name) (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?\\'" name)
(setq name (substring name 0 (match-beginning 0)))) (setq name (substring name 0 (match-beginning 0))))
(ange-ftp-real-file-name-as-directory name))) (ange-ftp-real-file-name-as-directory name)))
...@@ -5273,15 +5284,15 @@ Other orders of $ and _ seem to all work just fine.") ...@@ -5273,15 +5284,15 @@ Other orders of $ and _ seem to all work just fine.")
(defun ange-ftp-vms-make-compressed-filename (name &optional reverse) (defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
(cond (cond
((string-match "-Z;[0-9]+$" name) ((string-match "-Z;[0-9]+\\'" name)
(list nil (substring name 0 (match-beginning 0)))) (list nil (substring name 0 (match-beginning 0))))
((string-match ";[0-9]+$" name) ((string-match ";[0-9]+\\'" name)
(list nil (substring name 0 (match-beginning 0)))) (list nil (substring name 0 (match-beginning 0))))
((string-match "-Z$" name) ((string-match "-Z\\'" name)