emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/net/ange-ftp.el


From: Stefan Monnier
Subject: [Emacs-diffs] Changes to emacs/lisp/net/ange-ftp.el
Date: Thu, 11 Aug 2005 06:24:49 -0400

Index: emacs/lisp/net/ange-ftp.el
diff -c emacs/lisp/net/ange-ftp.el:1.70 emacs/lisp/net/ange-ftp.el:1.71
*** emacs/lisp/net/ange-ftp.el:1.70     Tue Aug  9 21:00:39 2005
--- emacs/lisp/net/ange-ftp.el  Thu Aug 11 10:24:48 2005
***************
*** 686,692 ****
    :prefix "ange-ftp-")
  
  (defcustom ange-ftp-name-format
!   '("^/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
    "*Format of a fully expanded remote file name.
  
  This is a list of the form \(REGEXP HOST USER NAME\),
--- 686,692 ----
    :prefix "ange-ftp-")
  
  (defcustom ange-ftp-name-format
!   '("\\`/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
    "*Format of a fully expanded remote file name.
  
  This is a list of the form \(REGEXP HOST USER NAME\),
***************
*** 863,872 ****
                 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$")
    "*If a file matches this regexp then it is transferred in binary mode."
    :group 'ange-ftp
    :type 'regexp)
--- 863,873 ----
                 string))
  
  (defcustom ange-ftp-binary-file-name-regexp
!   (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)
***************
*** 1130,1136 ****
  only return the directory part of FILE."
    (save-match-data
      (if (and default-directory
!            (string-match (concat "^"
                                   (regexp-quote default-directory)
                                   ".") file))
        (setq file (substring file (1- (match-end 0)))))
--- 1131,1137 ----
  only return the directory part of FILE."
    (save-match-data
      (if (and default-directory
!            (string-match (concat "\\`"
                                   (regexp-quote default-directory)
                                   ".") file))
        (setq file (substring file (1- (match-end 0)))))
***************
*** 1200,1206 ****
      (save-match-data
        (maphash
         (lambda (key value)
!        (if (string-match "^[^/]*\\(/\\).*$" key)
             (let ((host (substring key 0 (match-beginning 1))))
               (if (and (string-equal user (substring key (match-end 1)))
                        value)
--- 1201,1207 ----
      (save-match-data
        (maphash
         (lambda (key value)
!        (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
             (let ((host (substring key 0 (match-beginning 1))))
               (if (and (string-equal user (substring key (match-end 1)))
                        value)
***************
*** 1415,1421 ****
      (let (res)
        (maphash
         (lambda (key value)
!        (if (string-match "^[^/]*\\(/\\).*$" key)
             (let ((host (substring key 0 (match-beginning 1)))
                   (user (substring key (match-end 1))))
               (push (concat user "@" host ":") res))))
--- 1416,1422 ----
      (let (res)
        (maphash
         (lambda (key value)
!        (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
             (let ((host (substring key 0 (match-beginning 1)))
                   (user (substring key (match-end 1))))
               (push (concat user "@" host ":") res))))
***************
*** 1655,1661 ****
  
              ;; 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.
--- 1656,1662 ----
  
              ;; 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.
***************
*** 1678,1684 ****
                        (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))
--- 1679,1685 ----
                        (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))
***************
*** 1863,1869 ****
        (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)
              (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
            (insert cmd)))
        (move-marker comint-last-input-end (point))
--- 1864,1870 ----
        (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)
              (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
            (insert cmd)))
        (move-marker comint-last-input-end (point))
***************
*** 2069,2075 ****
  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)
      (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
           (port (match-string 3 host))
           (result (ange-ftp-raw-send-cmd
--- 2070,2076 ----
  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)
      (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
           (port (match-string 3 host))
           (result (ange-ftp-raw-send-cmd
***************
*** 2148,2153 ****
--- 2149,2156 ----
                  (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."
***************
*** 2309,2315 ****
        ;; resolve symlinks to directories on SysV machines. (Sebastian will
        ;; be happy.)
        (and (eq host-type 'unix)
!          (string-match "/$" cmd1)
           (not (string-match "R" cmd3))
           (setq cmd1 (concat cmd1 ".")))
  
--- 2312,2318 ----
        ;; resolve symlinks to directories on SysV machines. (Sebastian will
        ;; be happy.)
        (and (eq host-type 'unix)
!          (string-match "/\\'" cmd1)
           (not (string-match "R" cmd3))
           (setq cmd1 (concat cmd1 ".")))
  
***************
*** 2326,2340 ****
        (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.
        (unless (equal cmd1 ".")
!         (setq result (ange-ftp-cd host user
!                                   ;; Make sure the target to which
!                                   ;; `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
       ((progn
--- 2329,2350 ----
        (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
!       ;; 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 ".")
!         (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
!       (setq cmd1 cmd3)))
  
       ;; First argument is the remote name
       ((progn
***************
*** 2770,2779 ****
            ;; 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)))
                (setq file (substring file 0 -1)))))
        (puthash file (or symlink directory) tbl)
        (forward-line 1))
--- 2780,2789 ----
            ;; 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)))
                (setq file (substring file 0 -1)))))
        (puthash file (or symlink directory) tbl)
        (forward-line 1))
***************
*** 3117,3138 ****
  
          ;; 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)
                 name)
  
                ;; Name starts with ~ or ~user.  Resolve that part of the name
                ;; making it absolute then re-expand it.
!               ((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 (cond ((string-equal rest "")
!                                        dir)
!                                       ((string-equal dir "/")
!                                        rest)
!                                       (t
!                                        (concat dir rest))))
                     (error "User \"%s\" is not known"
                            (substring tilda 1)))))
  
--- 3127,3150 ----
  
          ;; 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)
                 name)
  
                ;; Name starts with ~ or ~user.  Resolve that part of the name
                ;; making it absolute then re-expand it.
!               ((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
!                        ;; C-x d /ftp:address@hidden:~/ 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)))))
  
***************
*** 3146,3164 ****
                     (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)))))
  
          ;; Now substitute the expanded name back into the overall filename.
          (ange-ftp-replace-name-component n name))
--- 3158,3175 ----
                     (error "Unable to obtain CWD")))))
  
          ;; If name starts with //, preserve that, for apollo system.
!         (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))
***************
*** 3182,3189 ****
                (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)))
           (ange-ftp-real-expand-file-name name default))
          ((zerop (length name))
           (ange-ftp-canonize-filename default))
--- 3193,3200 ----
                (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)))
           (ange-ftp-real-expand-file-name name default))
          ((zerop (length name))
           (ange-ftp-canonize-filename default))
***************
*** 3216,3222 ****
      (if parsed
        (let ((filename (nth 2 parsed)))
          (if (save-match-data
!               (string-match "^~[^/]*$" filename))
              name
            (ange-ftp-replace-name-component
             name
--- 3227,3233 ----
      (if parsed
        (let ((filename (nth 2 parsed)))
          (if (save-match-data
!               (string-match "\\`~[^/]*\\'" filename))
              name
            (ange-ftp-replace-name-component
             name
***************
*** 3229,3235 ****
      (if parsed
        (let ((filename (nth 2 parsed)))
          (if (save-match-data
!               (string-match "^~[^/]*$" filename))
              ""
            (ange-ftp-real-file-name-nondirectory filename)))
        (ange-ftp-real-file-name-nondirectory name))))
--- 3240,3246 ----
      (if parsed
        (let ((filename (nth 2 parsed)))
          (if (save-match-data
!               (string-match "\\`~[^/]*\\'" filename))
              ""
            (ange-ftp-real-file-name-nondirectory filename)))
        (ange-ftp-real-file-name-nondirectory name))))
***************
*** 3971,3977 ****
    ;; 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-equal "/" dir)))
  
  (defun ange-ftp-file-name-all-completions (file dir)
--- 3982,3988 ----
    ;; 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-equal "/" dir)))
  
  (defun ange-ftp-file-name-all-completions (file dir)
***************
*** 4015,4022 ****
            (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
                               completion-ignored-extensions
                               "\\|")))
              (save-match-data
--- 4026,4033 ----
            (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
                               completion-ignored-extensions
                               "\\|")))
              (save-match-data
***************
*** 4939,4945 ****
  (defun ange-ftp-fix-name-for-vms (name &optional reverse)
    (save-match-data
      (if reverse
!       (if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
            (let (drive dir file)
              (setq drive (match-string 1 name))
              (setq dir (match-string 2 name))
--- 4950,4956 ----
  (defun ange-ftp-fix-name-for-vms (name &optional reverse)
    (save-match-data
      (if reverse
!       (if (string-match "\\`\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)\\'" name)
            (let (drive dir file)
              (setq drive (match-string 1 name))
              (setq dir (match-string 2 name))
***************
*** 4953,4959 ****
                      file))
          (error "name %s didn't match" name))
        (let (drive dir file tmp)
!       (if (string-match "^/[^:]+:/" name)
            (setq drive (substring name 1
                                   (1- (match-end 0)))
                  name (substring name (match-end 0))))
--- 4964,4970 ----
                      file))
          (error "name %s didn't match" name))
        (let (drive dir file tmp)
!       (if (string-match "\\`/[^:]+:/" name)
            (setq drive (substring name 1
                                   (1- (match-end 0)))
                  name (substring name (match-end 0))))
***************
*** 4991,4997 ****
    ;; them.
    (cond ((string-equal dir-name "/")
         (error "Cannot get listing for fictitious \"/\" directory"))
!       ((string-match "^/[-A-Z0-9_$]+:/$" dir-name)
         (error "Cannot get listing for device"))
        ((ange-ftp-fix-name-for-vms dir-name))))
  
--- 5002,5008 ----
    ;; them.
    (cond ((string-equal dir-name "/")
         (error "Cannot get listing for fictitious \"/\" directory"))
!       ((string-match "\\`/[-A-Z0-9_$]+:/\\'" dir-name)
         (error "Cannot get listing for device"))
        ((ange-ftp-fix-name-for-vms dir-name))))
  
***************
*** 5045,5051 ****
            ;; 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
              ;; sans extension
              (puthash (substring file 0 (match-beginning 0)) nil tbl)))
        (forward-line 1))
--- 5056,5062 ----
            ;; 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
              ;; sans extension
              (puthash (substring file 0 (match-beginning 0)) nil tbl)))
        (forward-line 1))
***************
*** 5071,5077 ****
        (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)
            ;; 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.
--- 5082,5088 ----
        (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)
            ;; 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.
***************
*** 5109,5115 ****
        (if files
          (let ((file (ange-ftp-get-file-part name)))
            (save-match-data
!             (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.
--- 5120,5126 ----
        (if files
          (let ((file (ange-ftp-get-file-part name)))
            (save-match-data
!             (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.
***************
*** 5152,5158 ****
  
  (defun ange-ftp-vms-file-name-as-directory (name)
    (save-match-data
!     (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name)
        (setq name (substring name 0 (match-beginning 0))))
      (ange-ftp-real-file-name-as-directory name)))
  
--- 5163,5169 ----
  
  (defun ange-ftp-vms-file-name-as-directory (name)
    (save-match-data
!     (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?\\'" name)
        (setq name (substring name 0 (match-beginning 0))))
      (ange-ftp-real-file-name-as-directory name)))
  
***************
*** 5273,5287 ****
  
  (defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
    (cond
!    ((string-match "-Z;[0-9]+$" name)
      (list nil (substring name 0 (match-beginning 0))))
!    ((string-match ";[0-9]+$" name)
      (list nil (substring name 0 (match-beginning 0))))
!    ((string-match "-Z$" name)
      (list nil (substring name 0 -2)))
     (t
      (list t
!         (if (string-match ";[0-9]+$" name)
              (concat (substring name 0 (match-beginning 0))
                      "-Z")
            (concat name "-Z"))))))
--- 5284,5298 ----
  
  (defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
    (cond
!    ((string-match "-Z;[0-9]+\\'" name)
      (list nil (substring name 0 (match-beginning 0))))
!    ((string-match ";[0-9]+\\'" name)
      (list nil (substring name 0 (match-beginning 0))))
!    ((string-match "-Z\\'" name)
      (list nil (substring name 0 -2)))
     (t
      (list t
!         (if (string-match ";[0-9]+\\'" name)
              (concat (substring name 0 (match-beginning 0))
                      "-Z")
            (concat name "-Z"))))))
***************
*** 5314,5320 ****
  
  (defun ange-ftp-vms-sans-version (name &rest args)
    (save-match-data
!     (if (string-match ";[0-9]+$" name)
        (substring name 0 (match-beginning 0))
        name)))
  
--- 5325,5331 ----
  
  (defun ange-ftp-vms-sans-version (name &rest args)
    (save-match-data
!     (if (string-match ";[0-9]+\\'" name)
        (substring name 0 (match-beginning 0))
        name)))
  
***************
*** 5470,5483 ****
  (defun ange-ftp-fix-name-for-mts (name &optional reverse)
    (save-match-data
      (if reverse
!       (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)
          (concat (match-string 1 name) (match-string 2 name))
        ;; Let's hope that mts will recognize it anyway.
        name))))
--- 5481,5494 ----
  (defun ange-ftp-fix-name-for-mts (name &optional reverse)
    (save-match-data
      (if reverse
!       (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)
          (concat (match-string 1 name) (match-string 2 name))
        ;; Let's hope that mts will recognize it anyway.
        name))))
***************
*** 5496,5502 ****
        (cond
         ((string-equal dir-name "")
        "?")
!        ((string-match ":$" dir-name)
        (concat dir-name "?"))
         (dir-name))))) ; It's just a single file.
  
--- 5507,5513 ----
        (cond
         ((string-equal dir-name "")
        "?")
!        ((string-match ":\\'" dir-name)
        (concat dir-name "?"))
         (dir-name))))) ; It's just a single file.
  
***************
*** 5633,5639 ****
        ;; stores directories without the trailing /. Is this
        ;; consistent?
        (concat "/" name)
!       (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
                        name)
          (let ((minidisk (match-string 1 name)))
            (if (match-beginning 2)
--- 5644,5650 ----
        ;; stores directories without the trailing /. Is this
        ;; consistent?
        (concat "/" name)
!       (if (string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'"
                        name)
          (let ((minidisk (match-string 1 name)))
            (if (match-beginning 2)
***************
*** 5678,5684 ****
    (cond
     ((string-equal "/" dir-name)
      (error "Cannot get listing for fictitious \"/\" directory"))
!    ((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))
--- 5689,5695 ----
    (cond
     ((string-equal "/" dir-name)
      (error "Cannot get listing for fictitious \"/\" directory"))
!    ((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))
***************
*** 5836,5842 ****
  ;;            ange-ftp-dired-move-to-end-of-filename-alist)))
  
  (defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
!   (if (string-match "-Z$" name)
        (list nil (substring name 0 -2))
      (list t (concat name "-Z"))))
  
--- 5847,5853 ----
  ;;            ange-ftp-dired-move-to-end-of-filename-alist)))
  
  (defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
!   (if (string-match "-Z\\'" name)
        (list nil (substring name 0 -2))
      (list t (concat name "-Z"))))
  
***************
*** 6087,6091 ****
  
  (provide 'ange-ftp)
  
! ;;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
  ;;; ange-ftp.el ends here
--- 6098,6102 ----
  
  (provide 'ange-ftp)
  
! ;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
  ;;; ange-ftp.el ends here




reply via email to

[Prev in Thread] Current Thread [Next in Thread]