;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989,90,91,92,93,94,95,96,98, 2000, 2001
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998,
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
:prefix "ange-ftp-")
(defcustom ange-ftp-name-format
- '("^/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
+ '("\\`/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
"*Format of a fully expanded remote file name.
This is a list of the form \(REGEXP HOST USER NAME\),
:group 'ange-ftp
:type 'regexp)
+(defcustom ange-ftp-potential-error-msgs
+ ;; On Mac OS X we sometimes get things like:
+ ;;
+ ;; ftp> open ftp.nluug.nl
+ ;; Trying 2001:610:1:80aa:192:87:102:36...
+ ;; ftp: connect to address 2001:610:1:80aa:192:87:102:36: No route to host
+ ;; Trying 192.87.102.36...
+ ;; Connected to ftp.nluug.nl.
+ "^ftp: connect to address .*: No route to host"
+ "*Regular expression matching ftp messages that can indicate serious errors.
+These mean that something went wrong, but they may be followed by more
+messages indicating that the error was somehow corrected."
+ :group 'ange-ftp
+ :type 'regexp)
+
(defcustom ange-ftp-gateway-fatal-msgs
"No route to host\\|Connection closed\\|No such host\\|Login incorrect"
"*Regular expression matching login failure messages from rlogin/telnet."
string))
(defcustom ange-ftp-binary-file-name-regexp
- (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
- "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
- "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|"
- "\\.taz$\\|\\.tgz$")
+ (concat "TAGS\\'\\|\\.\\(?:"
+ (eval-when-compile
+ (regexp-opt '("z" "Z" "lzh" "arc" "zip" "zoo" "tar" "dvi"
+ "ps" "elc" "gif" "gz" "taz" "tgz")))
+ "\\|EXE\\(;[0-9]+\\)?\\|[zZ]-part-..\\)\\'")
"*If a file matches this regexp then it is transferred in binary mode."
:group 'ange-ftp
:type 'regexp)
(const :tag "Allow" 1)))
(defcustom ange-ftp-try-passive-mode nil
- "It t, try to use passive mode in ftp, if the client program supports it."
+ "If t, try to use passive mode in ftp, if the client program supports it."
:group 'ange-ftp
:type 'boolean
:version "21.1")
:type '(repeat (cons regexp (choice (const :tag "On" "on")
(const :tag "Off" "off")
(const :tag "Don't change" nil))))
- :version "21.4")
+ :version "22.1")
\f
;;;; ------------------------------------------------------------
;;;; Hash table support.
(defun ange-ftp-hash-entry-exists-p (key tbl)
"Return whether there is an association for KEY in TABLE."
- (not (eq (gethash key tbl 'unknown) 'unknown)))
+ (and tbl (not (eq (gethash key tbl 'unknown) 'unknown))))
(defun ange-ftp-hash-table-keys (tbl)
"Return a sorted list of all the active keys in TABLE, as strings."
(defvar ange-ftp-xfer-size nil)
(defvar ange-ftp-process-string nil)
(defvar ange-ftp-process-result-line nil)
+(defvar ange-ftp-pending-error-line nil)
(defvar ange-ftp-process-busy nil)
(defvar ange-ftp-process-result nil)
(defvar ange-ftp-process-multi-skip nil)
only return the directory part of FILE."
(save-match-data
(if (and default-directory
- (string-match (concat "^"
+ (string-match (concat "\\`"
(regexp-quote default-directory)
".") file))
(setq file (substring file (1- (match-end 0)))))
(save-match-data
(maphash
(lambda (key value)
- (if (string-match "^[^/]*\\(/\\).*$" key)
+ (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
(let ((host (substring key 0 (match-beginning 1))))
(if (and (string-equal user (substring key (match-end 1)))
value)
(setq file
(if (file-name-absolute-p temp)
temp
+ ;; Wouldn't `expand-file-name' be better than `concat' ?
+ ;; It would fail when `a/b/..' != `a', tho. --Stef
(concat (file-name-directory file) temp)))))
file)
(if (or ange-ftp-disable-netrc-security-check
(and (eq (nth 2 attr) (user-uid)) ; Same uids.
(string-match ".r..------" (nth 8 attr))))
- (save-excursion
+ (with-current-buffer
;; we are cheating a bit here. I'm trying to do the equivalent
;; of find-file on the .netrc file, but then nuke it afterwards.
;; with the bit of logic below we should be able to have
;; encrypted .netrc files.
- (set-buffer (generate-new-buffer "*ftp-.netrc*"))
+ (generate-new-buffer "*ftp-.netrc*")
(ange-ftp-real-insert-file-contents file)
(setq buffer-file-name file)
(setq default-directory (file-name-directory file))
(let (res)
(maphash
(lambda (key value)
- (if (string-match "^[^/]*\\(/\\).*$" key)
+ (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
(let ((host (substring key 0 (match-beginning 1)))
(user (substring key (match-end 1))))
(push (concat user "@" host ":") res))))
(setq buffer (current-buffer))
(setq buffer (get-buffer buffer)))
(let ((file (or (buffer-file-name buffer)
- (save-excursion (set-buffer buffer) default-directory))))
+ (with-current-buffer buffer default-directory))))
(if file
(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
(if parsed
((string-match ange-ftp-good-msgs line)
(setq ange-ftp-process-busy nil
ange-ftp-process-result t
+ ange-ftp-pending-error-line nil
ange-ftp-process-result-line line))
;; Check this before checking for errors.
;; Otherwise the last line of these three seems to be an error:
;; 230-"ftp.stsci.edu: unknown host", the new IP address will be...
((string-match ange-ftp-multi-msgs line)
(setq ange-ftp-process-multi-skip t))
+ ((string-match ange-ftp-potential-error-msgs line)
+ ;; This looks like an error, but we have to keep reading the output
+ ;; to see if it was fixed or not. E.g. it may indicate that IPv6
+ ;; failed, but maybe a subsequent IPv4 fallback succeeded.
+ (set (make-local-variable 'ange-ftp-pending-error-line) line)
+ t)
((string-match ange-ftp-fatal-msgs line)
(delete-process proc)
(setq ange-ftp-process-busy nil
ange-ftp-process-result-line line))
- (ange-ftp-process-multi-skip
+ (ange-ftp-process-multi-skip
t)
(t
(setq ange-ftp-process-busy nil
(if proc
(let ((buf (process-buffer proc)))
(if buf
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(setq ange-ftp-xfer-size
;; For very large files, BYTES can be a float.
(if (integerp bytes)
;; on to ange-ftp-process-handle-line to deal with.
(defun ange-ftp-process-filter (proc str)
- (let ((buffer (process-buffer proc))
- (old-buffer (current-buffer)))
-
- ;; Eliminate nulls.
- (while (string-match "\000+" str)
- (setq str (replace-match "" nil nil str)))
-
- ;; see if the buffer is still around... it could have been deleted.
- (if (buffer-name buffer)
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
-
- ;; handle hash mark printing
- (and ange-ftp-process-busy
- (string-match "^#+$" str)
- (setq str (ange-ftp-process-handle-hash str)))
- (comint-output-filter proc str)
- ;; Replace STR by the result of the comint processing.
- (setq str (buffer-substring comint-last-output-start
- (process-mark proc)))
- (if ange-ftp-process-busy
- (progn
- (setq ange-ftp-process-string (concat ange-ftp-process-string
- str))
-
- ;; if we gave an empty password to the USER command earlier
- ;; then we should send a null password now.
- (if (string-match "Password: *$" ange-ftp-process-string)
- (send-string proc "\n"))))
- (while (and ange-ftp-process-busy
- (string-match "\n" ange-ftp-process-string))
- (let ((line (substring ange-ftp-process-string
- 0
- (match-beginning 0))))
- (setq ange-ftp-process-string (substring ange-ftp-process-string
- (match-end 0)))
- (while (string-match "^ftp> *" line)
- (setq line (substring line (match-end 0))))
- (ange-ftp-process-handle-line line proc)))
-
- ;; has the ftp client finished? if so then do some clean-up
- ;; actions.
- (if (not ange-ftp-process-busy)
- (progn
- ;; reset the xfer size
- (setq ange-ftp-xfer-size 0)
-
- ;; issue the "done" message since we've finished.
- (if (and ange-ftp-process-msg
- ange-ftp-process-verbose
- ange-ftp-process-result)
- (progn
- (ange-ftp-message "%s...done" ange-ftp-process-msg)
- (ange-ftp-repaint-minibuffer)
- (setq ange-ftp-process-msg nil)))
-
- ;; is there a continuation we should be calling? if so,
- ;; we'd better call it, making sure we only call it once.
- (if ange-ftp-process-continue
- (let ((cont ange-ftp-process-continue))
- (setq ange-ftp-process-continue nil)
- (ange-ftp-call-cont cont
- ange-ftp-process-result
- ange-ftp-process-result-line))))))
- (set-buffer old-buffer)))))
+ ;; Eliminate nulls.
+ (while (string-match "\000+" str)
+ (setq str (replace-match "" nil nil str)))
+
+ ;; see if the buffer is still around... it could have been deleted.
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+
+ ;; handle hash mark printing
+ (and ange-ftp-process-busy
+ (string-match "^#+$" str)
+ (setq str (ange-ftp-process-handle-hash str)))
+ (comint-output-filter proc str)
+ ;; Replace STR by the result of the comint processing.
+ (setq str (buffer-substring comint-last-output-start
+ (process-mark proc)))
+ (if ange-ftp-process-busy
+ (progn
+ (setq ange-ftp-process-string (concat ange-ftp-process-string
+ str))
+
+ ;; if we gave an empty password to the USER command earlier
+ ;; then we should send a null password now.
+ (if (string-match "Password: *$" ange-ftp-process-string)
+ (process-send-string proc "\n"))))
+ (while (and ange-ftp-process-busy
+ (string-match "\n" ange-ftp-process-string))
+ (let ((line (substring ange-ftp-process-string
+ 0
+ (match-beginning 0)))
+ (seen-prompt nil))
+ (setq ange-ftp-process-string (substring ange-ftp-process-string
+ (match-end 0)))
+ (while (string-match "\\`ftp> *" line)
+ (setq seen-prompt t)
+ (setq line (substring line (match-end 0))))
+ (if (not (and seen-prompt ange-ftp-pending-error-line))
+ (ange-ftp-process-handle-line line proc)
+ ;; If we've seen a potential error message and it
+ ;; hasn't been cancelled by a good message before
+ ;; seeing a propt, then the error was real.
+ (delete-process proc)
+ (setq ange-ftp-process-busy nil
+ ange-ftp-process-result-line ange-ftp-pending-error-line))))
+
+ ;; has the ftp client finished? if so then do some clean-up
+ ;; actions.
+ (if (not ange-ftp-process-busy)
+ (progn
+ ;; reset the xfer size
+ (setq ange-ftp-xfer-size 0)
+
+ ;; issue the "done" message since we've finished.
+ (if (and ange-ftp-process-msg
+ ange-ftp-process-verbose
+ ange-ftp-process-result)
+ (progn
+ (ange-ftp-message "%s...done" ange-ftp-process-msg)
+ (ange-ftp-repaint-minibuffer)
+ (setq ange-ftp-process-msg nil)))
+
+ ;; is there a continuation we should be calling? if so,
+ ;; we'd better call it, making sure we only call it once.
+ (if ange-ftp-process-continue
+ (let ((cont ange-ftp-process-continue))
+ (setq ange-ftp-process-continue nil)
+ (ange-ftp-call-cont cont
+ ange-ftp-process-result
+ ange-ftp-process-result-line))))))))
(defun ange-ftp-process-sentinel (proc str)
"When ftp process changes state, nuke all file-entries in cache."
(defun ange-ftp-gwp-filter (proc str)
(comint-output-filter proc str)
- (save-excursion
- (set-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
;; Replace STR by the result of the comint processing.
(setq str (buffer-substring comint-last-output-start (process-mark proc))))
(cond ((string-match "login: *$" str)
- (send-string proc
- (concat
- (let ((ange-ftp-default-user t))
- (ange-ftp-get-user ange-ftp-gateway-host))
- "\n")))
+ (process-send-string proc
+ (concat
+ (let ((ange-ftp-default-user t))
+ (ange-ftp-get-user ange-ftp-gateway-host))
+ "\n")))
((string-match "Password: *$" str)
- (send-string proc
- (concat
- (ange-ftp-get-passwd ange-ftp-gateway-host
- (ange-ftp-get-user
- ange-ftp-gateway-host))
- "\n")))
+ (process-send-string proc
+ (concat
+ (ange-ftp-get-passwd ange-ftp-gateway-host
+ (ange-ftp-get-user
+ ange-ftp-gateway-host))
+ "\n")))
((string-match ange-ftp-gateway-fatal-msgs str)
(delete-process proc)
(setq ange-ftp-gwp-running nil))
(defun ange-ftp-gwp-start (host user name args)
"Login to the gateway machine and fire up an ftp process."
- (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
- ;; It would be nice to make process-connection-type nil,
+ (let* (;; It would be nice to make process-connection-type nil,
;; but that doesn't work: ftp never responds.
;; Can anyone find a fix for that?
(proc (let ((process-connection-type t))
ange-ftp-gateway-program
ange-ftp-gateway-host)))
(ftp (mapconcat 'identity args " ")))
- (process-kill-without-query proc)
+ (set-process-query-on-exit-flag proc nil)
(set-process-sentinel proc 'ange-ftp-gwp-sentinel)
(set-process-filter proc 'ange-ftp-gwp-filter)
- (save-excursion
- (set-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
(goto-char (point-max))
(set-marker (process-mark proc) (point)))
(setq ange-ftp-gwp-running t
(move-marker comint-last-input-start (point))
;; don't insert the password into the buffer on the USER command.
(save-match-data
- (if (string-match "^user \"[^\"]*\"" cmd)
+ (if (string-match "\\`user \"[^\"]*\"" cmd)
(insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
(insert cmd)))
(move-marker comint-last-input-end (point))
- (send-string proc cmd)
+ (process-send-string proc cmd)
(set-marker (process-mark proc) (point))
(if nowait
nil
(start-process " *nslookup*" " *nslookup*"
ange-ftp-nslookup-program host)))
(res host))
- (process-kill-without-query proc)
- (save-excursion
- (set-buffer (process-buffer proc))
+ (set-process-query-on-exit-flag proc nil)
+ (with-current-buffer (process-buffer proc)
(while (memq (process-status proc) '(run open))
(accept-process-output proc))
(goto-char (point-min))
;; Copy this so we don't alter it permanently.
(process-environment (copy-tree process-environment))
(buffer (get-buffer-create name)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(internal-ange-ftp-mode))
;; This tells GNU ftp not to output any fancy escape sequences.
(setenv "TERM" "dumb")
ange-ftp-gateway-host)
args))))
(setq proc (apply 'start-process name name args))))
- (save-excursion
- (set-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
(goto-char (point-max))
(set-marker (process-mark proc) (point)))
- (process-kill-without-query proc)
+ (set-process-query-on-exit-flag proc nil)
(set-process-sentinel proc 'ange-ftp-process-sentinel)
(set-process-filter proc 'ange-ftp-process-filter)
;; On Windows, the standard ftp client buffers its output (because
\\{comint-mode-map}"
(interactive)
- (comint-mode)
+ (delay-mode-hooks (comint-mode))
(setq major-mode 'internal-ange-ftp-mode)
(setq mode-name "Internal Ange-ftp")
- (let ((proc (get-buffer-process (current-buffer))))
- (make-local-variable 'ange-ftp-process-string)
- (setq ange-ftp-process-string "")
- (make-local-variable 'ange-ftp-process-busy)
- (make-local-variable 'ange-ftp-process-result)
- (make-local-variable 'ange-ftp-process-msg)
- (make-local-variable 'ange-ftp-process-multi-skip)
- (make-local-variable 'ange-ftp-process-result-line)
- (make-local-variable 'ange-ftp-process-continue)
- (make-local-variable 'ange-ftp-hash-mark-count)
- (make-local-variable 'ange-ftp-binary-hash-mark-size)
- (make-local-variable 'ange-ftp-ascii-hash-mark-size)
- (make-local-variable 'ange-ftp-hash-mark-unit)
- (make-local-variable 'ange-ftp-xfer-size)
- (make-local-variable 'ange-ftp-last-percent)
- (setq ange-ftp-hash-mark-count 0)
- (setq ange-ftp-xfer-size 0)
- (setq ange-ftp-process-result-line "")
-
- (setq comint-prompt-regexp "^ftp> ")
- (make-local-variable 'comint-password-prompt-regexp)
- ;; This is a regexp that can't match anything.
- ;; ange-ftp has its own ways of handling passwords.
- (setq comint-password-prompt-regexp "^a\\'z")
- (make-local-variable 'paragraph-start)
- (setq paragraph-start comint-prompt-regexp)))
+ (make-local-variable 'ange-ftp-process-string)
+ (setq ange-ftp-process-string "")
+ (make-local-variable 'ange-ftp-process-busy)
+ (make-local-variable 'ange-ftp-process-result)
+ (make-local-variable 'ange-ftp-process-msg)
+ (make-local-variable 'ange-ftp-process-multi-skip)
+ (make-local-variable 'ange-ftp-process-result-line)
+ (make-local-variable 'ange-ftp-process-continue)
+ (make-local-variable 'ange-ftp-hash-mark-count)
+ (make-local-variable 'ange-ftp-binary-hash-mark-size)
+ (make-local-variable 'ange-ftp-ascii-hash-mark-size)
+ (make-local-variable 'ange-ftp-hash-mark-unit)
+ (make-local-variable 'ange-ftp-xfer-size)
+ (make-local-variable 'ange-ftp-last-percent)
+ (setq ange-ftp-hash-mark-count 0)
+ (setq ange-ftp-xfer-size 0)
+ (setq ange-ftp-process-result-line "")
+ (setq comint-prompt-regexp "^ftp> ")
+ (make-local-variable 'comint-password-prompt-regexp)
+ ;; This is a regexp that can't match anything.
+ ;; ange-ftp has its own ways of handling passwords.
+ (setq comint-password-prompt-regexp "\\`a\\`")
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start comint-prompt-regexp)
+ (run-mode-hooks 'internal-ange-ftp-mode-hook))
(defcustom ange-ftp-raw-login nil
"*Use raw ftp commands for login, if account password is not nil.
PROC is the process to the FTP-client. HOST may have an optional
suffix of the form #PORT to specify a non-default port"
(save-match-data
- (string-match "^\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host)
+ (string-match "\\`\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host)
(let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
(port (match-string 3 host))
(result (ange-ftp-raw-send-cmd
(defun ange-ftp-guess-hash-mark-size (proc)
(if ange-ftp-send-hash
- (save-excursion
- (set-buffer (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
- (result (car status))
(line (cdr status)))
(save-match-data
(if (string-match ange-ftp-hash-mark-msgs line)
- (let ((size (string-to-int (match-string 1 line))))
+ (let ((size (string-to-number (match-string 1 line))))
(setq ange-ftp-ascii-hash-mark-size size
ange-ftp-hash-mark-unit (ash size -4))
(or ange-ftp-binary-hash-mark-size
(setq ange-ftp-binary-hash-mark-size size)))))))))
+(defvar ange-ftp-process-startup-hook nil)
+
(defun ange-ftp-get-process (host user)
"Return an FTP subprocess connected to HOST and logged in as USER.
Create a new process if needed."
;; resolve symlinks to directories on SysV machines. (Sebastian will
;; be happy.)
(and (eq host-type 'unix)
- (string-match "/$" cmd1)
+ (string-match "/\\'" cmd1)
(not (string-match "R" cmd3))
(setq cmd1 (concat cmd1 ".")))
+ ;; Using "ls -flags foo" has several problems:
+ ;; - if foo is a symlink, we may get a single line showing the symlink
+ ;; rather than the listing of the directory it points to.
+ ;; - if "foo" has spaces, the parsing of the command may be done wrong.
+ ;; - some version of netbsd's ftpd only accept a single argument after
+ ;; `ls', which can either be the directory or the flags.
+ ;; So to work around those problems, we use "cd foo; ls -flags".
+
;; If the dir name contains a space, some ftp servers will
;; refuse to list it. We instead change directory to the
;; directory in question and ls ".".
(unless (memq host-type ange-ftp-dumb-host-types)
(setq cmd0 'ls)
;; 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.
+ ;; 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 ever 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). So we've changed
+ ;; `ange-ftp-insert-directory' such that in this case it gets
+ ;; a full listing of the directory and extracting the line
+ ;; corresponding to the requested file.
(unless (equal cmd1 ".")
(setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
(setq cmd1 cmd3)))
(if wildcard
(progn
(ange-ftp-cd host user (file-name-directory name))
- (setq lscmd (list 'dir file temp lsargs)))
+ (setq lscmd (list 'ls file temp lsargs)))
(setq lscmd (list 'dir name temp lsargs)))
(unwind-protect
(if (car (setq result (ange-ftp-send-cmd
(format "Listing %s"
(ange-ftp-abbreviate-filename
ange-ftp-this-file)))))
- (save-excursion
- (set-buffer (get-buffer-create
- ange-ftp-data-buffer-name))
+ (with-current-buffer (get-buffer-create
+ ange-ftp-data-buffer-name)
(erase-buffer)
(if (ange-ftp-real-file-readable-p temp)
(ange-ftp-real-insert-file-contents temp)
;;;; Directory information caching support.
;;;; ------------------------------------------------------------
-(defconst ange-ftp-date-regexp
- (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
- ;; In some locales, month abbreviations are as short as 2 letters,
- ;; and they can be padded on the right with spaces.
- ;; weiand: changed: month ends with . or , or .,
-;;old (month (concat l l "+ *"))
- (month (concat l l "+[.]?,? *"))
- ;; Recognize any non-ASCII character.
- ;; The purpose is to match a Kanji character.
- (k "[^\0-\177]")
- (s " ")
- (mm "[ 0-1][0-9]")
- ;; weiand: changed: day ends with .
-;;old (dd "[ 0-3][0-9]")
- (dd "[ 0-3][0-9][.]?")
- (western (concat "\\(" month s dd "\\|" dd s month "\\)"))
- (japanese (concat mm k s dd k)))
- ;; Require the previous column to end in a digit.
- ;; This avoids recognizing `1 may 1997' as a date in the line:
- ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
- (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s))
- "Regular expression to match up to the column before the file name in a
-directory listing. This regular expression is designed to recognize dates
-regardless of the language.")
-
(defvar ange-ftp-add-file-entry-alist nil
"Alist saying how to add file entries on certain OS types.
Association list of pairs \( TYPE \. FUNC \), where FUNC
;;Extract the filename from the current line of a dired-like listing.
`(let ((eol (progn (end-of-line) (point))))
(beginning-of-line)
- (if (re-search-forward ange-ftp-date-regexp eol t)
- (progn
- (skip-chars-forward " ")
- (skip-chars-forward "^ " eol)
- (skip-chars-forward " " eol)
- ;; We bomb on filenames starting with a space.
- (buffer-substring (point) eol)))))
+ (if (re-search-forward directory-listing-before-filename-regexp eol t)
+ (buffer-substring (point) eol))))
;; This deals with the F switch. Should also do something about
;; unquoting names obtained with the SysV b switch and the GNU Q
;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
;; and others don't. (sigh...) Beware, that some Unix's don't
;; seem to believe in the F-switch
- (if (or (and symlink (string-match "@$" file))
- (and directory (string-match "/$" file))
- (and executable (string-match "*$" file))
- (and socket (string-match "=$" file)))
+ (if (or (and symlink (string-match "@\\'" file))
+ (and directory (string-match "/\\'" file))
+ (and executable (string-match "*\\'" file))
+ (and socket (string-match "=\\'" file)))
(setq file (substring file 0 -1)))))
(puthash file (or symlink directory) tbl)
(forward-line 1))
;; (3) The twilight zone.
;; We'll assume (1) for now.
nil)
- ((re-search-forward ange-ftp-date-regexp nil t)
+ ((re-search-forward directory-listing-before-filename-regexp nil t)
(beginning-of-line)
(ange-ftp-ls-parser switches))
((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
;; error message.
(gethash "." ent))
;; Child lookup failed, so try the parent.
- (let ((table (ange-ftp-get-files dir 'no-error)))
- ;; If the dir doesn't exist, don't use it as a hash table.
- (and table
- (ange-ftp-hash-entry-exists-p file
- table)))))))
+ (ange-ftp-hash-entry-exists-p
+ file (ange-ftp-get-files dir 'no-error))))))
(defun ange-ftp-get-file-entry (name)
"Given NAME, return the given file entry.
(let ((result (ange-ftp-send-cmd host user '(type "binary"))))
(if (not (car result))
(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
- (save-excursion
- (set-buffer (process-buffer (ange-ftp-get-process host user)))
+ (with-current-buffer (process-buffer (ange-ftp-get-process host user))
(and ange-ftp-binary-hash-mark-size
(setq ange-ftp-hash-mark-unit
(ash ange-ftp-binary-hash-mark-size -4)))))))
(let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
(if (not (car result))
(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
- (save-excursion
- (set-buffer (process-buffer (ange-ftp-get-process host user)))
+ (with-current-buffer (process-buffer (ange-ftp-get-process host user))
(and ange-ftp-ascii-hash-mark-size
(setq ange-ftp-hash-mark-unit
(ash ange-ftp-ascii-hash-mark-size -4)))))))
;; See if remote name is absolute. If so then just expand it and
;; replace the name component of the overall name.
- (cond ((string-match "^/" name)
+ (cond ((string-match "\\`/" name)
name)
;; Name starts with ~ or ~user. Resolve that part of the name
;; making it absolute then re-expand it.
- ((string-match "^~[^/]*" name)
+ ((string-match "\\`~[^/]*" name)
(let* ((tilda (match-string 0 name))
(rest (substring name (match-end 0)))
(dir (ange-ftp-expand-dir host user tilda)))
(if dir
- (setq name (if (string-equal dir "/")
- rest (concat dir rest)))
+ ;; C-x d /ftp:anonymous@ftp.gnu.org:~/ RET
+ ;; seems to cause `rest' to sometimes be empty.
+ ;; Maybe it's an error for `rest' to be empty here,
+ ;; but until we figure this out, this quick fix
+ ;; seems to do the trick.
+ (setq name (cond ((string-equal rest "") dir)
+ ((string-equal dir "/") rest)
+ (t (concat dir rest))))
(error "User \"%s\" is not known"
(substring tilda 1)))))
(error "Unable to obtain CWD")))))
;; If name starts with //, preserve that, for apollo system.
- (if (not (string-match "^//" name))
- (progn
- (if (not (eq system-type 'windows-nt))
- (setq name (ange-ftp-real-expand-file-name name))
- ;; Windows UNC default dirs do not make sense for ftp.
- (if (string-match "^//" default-directory)
- (setq name (ange-ftp-real-expand-file-name name "c:/"))
- (setq name (ange-ftp-real-expand-file-name name)))
- ;; Strip off possible drive specifier.
- (if (string-match "^[a-zA-Z]:" name)
- (setq name (substring name 2))))
- (if (string-match "^//" name)
- (setq name (substring name 1)))))
+ (unless (string-match "\\`//" name)
+ (if (not (eq system-type 'windows-nt))
+ (setq name (ange-ftp-real-expand-file-name name))
+ ;; Windows UNC default dirs do not make sense for ftp.
+ (setq name (if (string-match "\\`//" default-directory)
+ (ange-ftp-real-expand-file-name name "c:/")
+ (ange-ftp-real-expand-file-name name)))
+ ;; Strip off possible drive specifier.
+ (if (string-match "\\`[a-zA-Z]:" name)
+ (setq name (substring name 2))))
+ (if (string-match "\\`//" name)
+ (setq name (substring name 1))))
;; Now substitute the expanded name back into the overall filename.
(ange-ftp-replace-name-component n name))
(ange-ftp-real-file-name-directory n))))))
(defun ange-ftp-expand-file-name (name &optional default)
- "Documented as original."
+ "Documented as `expand-file-name'."
(save-match-data
(setq default (or default default-directory))
(cond ((eq (string-to-char name) ?~)
(eq (string-to-char name) ?\\))
(ange-ftp-canonize-filename name))
((and (eq system-type 'windows-nt)
- (or (string-match "^[a-zA-Z]:" name)
- (string-match "^[a-zA-Z]:" default)))
+ (or (string-match "\\`[a-zA-Z]:" name)
+ (string-match "\\`[a-zA-Z]:" default)))
(ange-ftp-real-expand-file-name name default))
((zerop (length name))
(ange-ftp-canonize-filename default))
(if parsed
(let ((filename (nth 2 parsed)))
(if (save-match-data
- (string-match "^~[^/]*$" filename))
+ (string-match "\\`~[^/]*\\'" filename))
name
(ange-ftp-replace-name-component
name
(if parsed
(let ((filename (nth 2 parsed)))
(if (save-match-data
- (string-match "^~[^/]*$" filename))
+ (string-match "\\`~[^/]*\\'" filename))
""
(ange-ftp-real-file-name-nondirectory filename)))
(ange-ftp-real-file-name-nondirectory name))))
;; cleanup forms
(setq coding-system-used last-coding-system-used)
(setq buffer-file-name filename)
- (set-buffer-modified-p mod-p)))
+ (restore-buffer-modified-p mod-p)))
(if binary
(ange-ftp-set-binary-mode host user))
(setq file (ange-ftp-expand-file-name file))
(if (ange-ftp-ftp-name file)
(condition-case nil
- (let ((file-ent
- (gethash
- (ange-ftp-get-file-part file)
- (ange-ftp-get-files (file-name-directory file)))))
- (and (stringp file-ent) file-ent))
+ (let ((ent (ange-ftp-get-files (file-name-directory file))))
+ (and ent
+ (stringp (setq ent
+ (gethash (ange-ftp-get-file-part file) ent)))
+ ent))
;; If we can't read the parent directory, just assume
;; this file is not a symlink.
;; This makes it possible to access a directory that
(let ((file-ent (ange-ftp-get-file-entry
(ange-ftp-file-name-as-directory name))))
(if (stringp file-ent)
- (file-directory-p
+ ;; Calling file-directory-p doesn't work because ange-ftp
+ ;; is temporarily disabled for this operation.
+ (ange-ftp-file-directory-p
(ange-ftp-expand-symlink file-ent
(file-name-directory
(directory-file-name name))))
;; (set (make-local-variable 'copy-cont) cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
-;; (save-excursion
-;; (set-buffer (process-buffer proc))
+;; (with-current-buffer (process-buffer proc)
;; (let ((cont copy-cont)
;; (result (buffer-string)))
;; (unwind-protect
;; Maybe we should use something more like
;; (equal dir (file-name-directory (directory-file-name dir))) -stef
(or (and (eq system-type 'windows-nt)
- (string-match "^[a-zA-Z]:[/\\]$" dir))
+ (string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
(string-equal "/" dir)))
(defun ange-ftp-file-name-all-completions (file dir)
ange-ftp-this-dir))
(ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)))))
-(defun ange-ftp-file-name-completion (file dir)
+(defun ange-ftp-file-name-completion (file dir &optional predicate)
(let ((ange-ftp-this-dir (expand-file-name dir)))
(if (ange-ftp-ftp-name ange-ftp-this-dir)
(progn
(let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
(ange-ftp-completion-ignored-pattern
(mapconcat (lambda (s) (if (stringp s)
- (concat (regexp-quote s) "$")
- "/")) ; / never in filename
+ (concat (regexp-quote s) "$")
+ "/")) ; / never in filename
completion-ignored-extensions
"\\|")))
(save-match-data
file
(nconc (ange-ftp-generate-root-prefixes)
(ange-ftp-real-file-name-all-completions
- file ange-ftp-this-dir)))
- (ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
+ file ange-ftp-this-dir))
+ predicate)
+ (if predicate
+ (ange-ftp-real-file-name-completion
+ file ange-ftp-this-dir predicate)
+ (ange-ftp-real-file-name-completion
+ file ange-ftp-this-dir))))))
(defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate)
(format "Getting %s" fn1))
tmp1))))
-(defun ange-ftp-file-remote-p (file)
- (ange-ftp-replace-name-component file ""))
+(defun ange-ftp-file-remote-p (file &optional connected)
+ (and (or (not connected)
+ (let* ((parsed (ange-ftp-ftp-name file))
+ (host (nth 0 parsed))
+ (user (nth 1 parsed))
+ (proc (get-process (ange-ftp-ftp-process-buffer host user))))
+ (and proc (processp proc)
+ (memq (process-status proc) '(run open)))))
+ (ange-ftp-replace-name-component file "")))
(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
(if (ange-ftp-ftp-name file)
;; This returns nil for any file name as argument.
(put 'vc-registered 'ange-ftp 'null)
-(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
+;; We can handle process-file in a restricted way (just for chown).
+;; Nothing possible for start-file-process.
+(put 'process-file 'ange-ftp 'ange-ftp-process-file)
+(put 'start-file-process 'ange-ftp 'ignore)
(put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
\f
;;; Define ways of getting at unmodified Emacs primitives,
;; `ange-ftp-ls' handles this.
(defun ange-ftp-insert-directory (file switches &optional wildcard full)
- (let ((short (ange-ftp-abbreviate-filename file))
- (parsed (ange-ftp-ftp-name (expand-file-name file)))
- tem)
- (if parsed
- (if (and (not wildcard)
- (setq tem (file-symlink-p (directory-file-name file))))
- (ange-ftp-insert-directory
- (ange-ftp-expand-symlink
- tem (file-name-directory (directory-file-name file)))
- switches wildcard full)
- (insert
- (if wildcard
- (let ((default-directory (file-name-directory file)))
- (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))
- (ange-ftp-ls file switches full))))
- (ange-ftp-real-insert-directory file switches wildcard full))))
+ (if (not (ange-ftp-ftp-name (expand-file-name file)))
+ (ange-ftp-real-insert-directory file switches wildcard full)
+ ;; We used to follow symlinks on `file' here. Apparently it was done
+ ;; because some FTP servers react to "ls foo" by listing the symlink foo
+ ;; rather than the directory it points to. Now that ange-ftp-ls uses
+ ;; "cd foo; ls" instead, this is not necesssary any more.
+ (insert
+ (cond
+ (wildcard
+ (let ((default-directory (file-name-directory file)))
+ (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
+ (full
+ (ange-ftp-ls file switches 'parse))
+ (t
+ ;; If `full' is nil we're going to do `ls' for a single file.
+ ;; Problem is that for various reasons, ange-ftp-ls needs to cd and
+ ;; then do an ls of current dir, which obviously won't work if we
+ ;; want to ls a file. So instead, we get a full listing of the
+ ;; parent directory and extract the line corresponding to `file'.
+ (when (string-match "d\\'" switches)
+ ;; Remove "d" which dired added to `switches'.
+ (setq switches (substring switches 0 (match-beginning 0))))
+ (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
+ switches nil))
+ (filename (file-name-nondirectory (directory-file-name file)))
+ (case-fold-search nil))
+ ;; FIXME: This presumes a particular output format, which is
+ ;; basically Unix.
+ (if (string-match (concat "^.+[^ ] " (regexp-quote filename)
+ "\\( -> .*\\)?[@/*=]?\n") dirlist)
+ (match-string 0 dirlist)
+ "")))))))
(defun ange-ftp-dired-uncache (dir)
(if (ange-ftp-ftp-name (expand-file-name dir))
(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
(let* ((short (ange-ftp-abbreviate-filename file))
(parsed (ange-ftp-ftp-name short))
- host-type func)
- (if parsed
- (setq host-type (ange-ftp-host-type (car parsed))
- func (cdr (assq (ange-ftp-host-type (car parsed))
- ange-ftp-sans-version-alist))))
+ (func (if parsed (cdr (assq (ange-ftp-host-type (car parsed))
+ ange-ftp-sans-version-alist)))))
(if func (funcall func file keep-backup-version)
(ange-ftp-real-file-name-sans-versions file keep-backup-version))))
;; default-directory is in ange-ftp syntax for remote file names.
(ange-ftp-real-shell-command command output-buffer error-buffer))))
-;;; This is the handler for call-process.
-(defun ange-ftp-dired-call-process (program discard &rest arguments)
+;;; This is the handler for process-file.
+(defun ange-ftp-process-file (program infile buffer display &rest arguments)
;; PROGRAM is always one of those below in the cond in dired.el.
;; The ARGUMENTS are (nearly) always files.
(if (ange-ftp-ftp-name default-directory)
1)
(error (insert (format "%s\n" (nth 1 oops)))
1))
- (apply 'call-process program nil (not discard) nil arguments)))
-
-(defvar ange-ftp-remote-shell "rsh"
- "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
+ (apply 'call-process program infile buffer display arguments)))
;; Handle an attempt to run chmod on a remote file
;; by using the ftp chmod command.
abbr))))
(or (car result)
(call-process
- ange-ftp-remote-shell
+ remote-shell-program
nil t nil host dired-chmod-program mode name))))))
rest))
(setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
0)
\f
-;;; This is turned off because it has nothing properly to do
-;;; with dired. It could be reasonable to adapt this to
-;;; replace ange-ftp-copy-file.
+;; This is turned off because it has nothing properly to do
+;; with dired. It could be reasonable to adapt this to
+;; replace ange-ftp-copy-file.
;;;;; ------------------------------------------------------------
;;;;; Noddy support for async copy-file within dired.
;; target marker-char buffer overwrite-query
;; overwrite-backup-query failures skipped
;; success-count total)
-;; (let ((old-buf (current-buffer)))
-;; (unwind-protect
-;; (progn
-;; (set-buffer buffer)
+;; (with-current-buffer buffer
;; (if (null fn-list)
;; (ange-ftp-dcf-3 failures operation total skipped
;; success-count buffer)
;; overwrite-query
;; overwrite-backup-query
;; failures skipped success-count
-;; total))))))))
-;; (set-buffer old-buf))))
+;; total)))))))))
;;(defun ange-ftp-dcf-2 (result line err
;; file-creator operation fn-list
;; overwrite-backup-query
;; failures skipped success-count
;; total)
-;; (let ((old-buf (current-buffer)))
-;; (unwind-protect
-;; (progn
-;; (set-buffer buffer)
+;; (with-current-buffer buffer
;; (if (or err (not result))
;; (progn
;; (setq failures (cons (dired-make-relative from) failures))
;; overwrite-query
;; overwrite-backup-query
;; failures skipped success-count
-;; total))
-;; (set-buffer old-buf))))
+;; total)))
;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
;; buffer)
-;; (let ((old-buf (current-buffer)))
-;; (unwind-protect
-;; (progn
-;; (set-buffer buffer)
+;; (with-current-buffer buffer
;; (cond
;; (failures
;; (dired-log-summary
;; (t
;; (message "%s: %s file%s."
;; operation success-count (dired-plural-s success-count))))
-;; (dired-move-to-filename))
-;; (set-buffer old-buf))))
+;; (dired-move-to-filename)))
\f
;;;; -----------------------------------------------
;;;; Unix Descriptive Listing (dl) Support
(defun ange-ftp-fix-name-for-vms (name &optional reverse)
(save-match-data
(if reverse
- (if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
+ (if (string-match "\\`\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)\\'" name)
(let (drive dir file)
(setq drive (match-string 1 name))
(setq dir (match-string 2 name))
file))
(error "name %s didn't match" name))
(let (drive dir file tmp)
- (if (string-match "^/[^:]+:/" name)
+ (if (string-match "\\`/[^:]+:/" name)
(setq drive (substring name 1
(1- (match-end 0)))
name (substring name (match-end 0))))
;; them.
(cond ((string-equal dir-name "/")
(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"))
((ange-ftp-fix-name-for-vms dir-name))))
;; deal with directories
(puthash (substring file 0 (match-beginning 0)) t 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
(puthash (substring file 0 (match-beginning 0)) nil tbl)))
(forward-line 1))
(ange-ftp-internal-delete-file-entry name t)
(save-match-data
(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
;; version number, or wild-card (e.g. FOO;*)
;; For now, we give up on wildcards.
(if files
(let ((file (ange-ftp-get-file-part name)))
(save-match-data
- (if (string-match ";[0-9]+$" file)
+ (if (string-match ";[0-9]+\\'" file)
(puthash (substring file 0 (match-beginning 0)) nil files)
;; Need to figure out what version of the file
;; is being added.
(and (string-match regexp name)
(setq version
(max version
- (string-to-int (match-string 1 name))))))
+ (string-to-number (match-string 1 name))))))
files)
(setq version (1+ version))
(puthash
(defun ange-ftp-vms-file-name-as-directory (name)
(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))))
(ange-ftp-real-file-name-as-directory name)))
(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
(cond
- ((string-match "-Z;[0-9]+$" name)
+ ((string-match "-Z;[0-9]+\\'" name)
(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))))
- ((string-match "-Z$" name)
+ ((string-match "-Z\\'" name)
(list nil (substring name 0 -2)))
(t
(list t
- (if (string-match ";[0-9]+$" name)
+ (if (string-match ";[0-9]+\\'" name)
(concat (substring name 0 (match-beginning 0))
"-Z")
(concat name "-Z"))))))
(defun ange-ftp-vms-sans-version (name &rest args)
(save-match-data
- (if (string-match ";[0-9]+$" name)
+ (if (string-match ";[0-9]+\\'" name)
(substring name 0 (match-beginning 0))
name)))
(defun ange-ftp-fix-name-for-mts (name &optional reverse)
(save-match-data
(if reverse
- (if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name)
+ (if (string-match "\\`\\([^:]+:\\)?\\(.*\\)\\'" name)
(let (acct file)
(setq acct (match-string 1 name))
(setq file (match-string 2 name))
(concat (and acct (concat "/" acct "/"))
file))
(error "name %s didn't match" name))
- (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name)
+ (if (string-match "\\`/\\([^:]+:\\)/\\(.*\\)\\'" name)
(concat (match-string 1 name) (match-string 2 name))
;; Let's hope that mts will recognize it anyway.
name))))
(cond
((string-equal dir-name "")
"?")
- ((string-match ":$" dir-name)
+ ((string-match ":\\'" dir-name)
(concat dir-name "?"))
(dir-name))))) ; It's just a single file.
(let ((tbl (make-hash-table :test 'equal)))
(goto-char (point-min))
(save-match-data
- (while (re-search-forward ange-ftp-date-regexp nil t)
+ (while (re-search-forward directory-listing-before-filename-regexp nil t)
(end-of-line)
(skip-chars-backward " ")
(let ((end (point)))
;; stores directories without the trailing /. Is this
;; consistent?
(concat "/" name)
- (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
+ (if (string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'"
name)
(let ((minidisk (match-string 1 name)))
(if (match-beginning 2)
(cond
((string-equal "/" dir-name)
(error "Cannot get listing for fictitious \"/\" directory"))
- ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name)
+ ((string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'" dir-name)
(let* ((minidisk (match-string 1 dir-name))
;; host and user are bound in the call to ange-ftp-send-cmd
(proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
;; ange-ftp-dired-move-to-end-of-filename-alist)))
(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
- (if (string-match "-Z$" name)
+ (if (string-match "-Z\\'" name)
(list nil (substring name 0 -2))
(list t (concat name "-Z"))))
(provide 'ange-ftp)
-;;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
+;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
;;; ange-ftp.el ends here
HCoop / bpt / emacs.git / blobdiff