/[emacs]/emacs/lisp/net/ange-ftp.el
ViewVC logotype

Diff of /emacs/lisp/net/ange-ftp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.71 by monnier, Thu Aug 11 10:24:48 2005 UTC revision 1.72 by monnier, Wed Sep 14 21:03:56 2005 UTC
# Line 1641  good, skip, fatal, or unknown." Line 1641  good, skip, fatal, or unknown."
1641  ;; on to ange-ftp-process-handle-line to deal with.  ;; on to ange-ftp-process-handle-line to deal with.
1642    
1643  (defun ange-ftp-process-filter (proc str)  (defun ange-ftp-process-filter (proc str)
1644    (let ((buffer (process-buffer proc))    ;; Eliminate nulls.
1645          (old-buffer (current-buffer)))    (while (string-match "\000+" str)
1646        (setq str (replace-match "" nil nil str)))
1647      ;; Eliminate nulls.  
1648      (while (string-match "\000+" str)    ;; see if the buffer is still around... it could have been deleted.
1649        (setq str (replace-match "" nil nil str)))    (when (buffer-live-p (process-buffer proc))
1650        (with-current-buffer (process-buffer proc)
1651      ;; see if the buffer is still around... it could have been deleted.  
1652      (if (buffer-name buffer)        ;; handle hash mark printing
1653          (unwind-protect        (and ange-ftp-process-busy
1654              (progn             (string-match "^#+$" str)
1655                (set-buffer (process-buffer proc))             (setq str (ange-ftp-process-handle-hash str)))
1656          (comint-output-filter proc str)
1657                ;; handle hash mark printing        ;; Replace STR by the result of the comint processing.
1658                (and ange-ftp-process-busy        (setq str (buffer-substring comint-last-output-start
1659                     (string-match "\\`#+\\'" str)                                    (process-mark proc)))
1660                     (setq str (ange-ftp-process-handle-hash str)))        (if ange-ftp-process-busy
1661                (comint-output-filter proc str)            (progn
1662                ;; Replace STR by the result of the comint processing.              (setq ange-ftp-process-string (concat ange-ftp-process-string
1663                (setq str (buffer-substring comint-last-output-start                                                    str))
1664                                            (process-mark proc)))  
1665                (if ange-ftp-process-busy              ;; if we gave an empty password to the USER command earlier
1666                    (progn              ;; then we should send a null password now.
1667                      (setq ange-ftp-process-string (concat ange-ftp-process-string              (if (string-match "Password: *$" ange-ftp-process-string)
1668                                                            str))                  (process-send-string proc "\n"))))
1669          (while (and ange-ftp-process-busy
1670                      ;; if we gave an empty password to the USER command earlier                    (string-match "\n" ange-ftp-process-string))
1671                      ;; then we should send a null password now.          (let ((line (substring ange-ftp-process-string
1672                      (if (string-match "Password: *$" ange-ftp-process-string)                                 0
1673                          (process-send-string proc "\n"))))                                 (match-beginning 0)))
1674                (while (and ange-ftp-process-busy                (seen-prompt nil))
1675                            (string-match "\n" ange-ftp-process-string))            (setq ange-ftp-process-string (substring ange-ftp-process-string
1676                  (let ((line (substring ange-ftp-process-string                                                     (match-end 0)))
1677                                         0            (while (string-match "\\`ftp> *" line)
1678                                         (match-beginning 0)))              (setq seen-prompt t)
1679                        (seen-prompt nil))              (setq line (substring line (match-end 0))))
1680                    (setq ange-ftp-process-string (substring ange-ftp-process-string            (if (not (and seen-prompt ange-ftp-pending-error-line))
1681                                                             (match-end 0)))                (ange-ftp-process-handle-line line proc)
1682                    (while (string-match "\\`ftp> *" line)              ;; If we've seen a potential error message and it
1683                      (setq seen-prompt t)              ;; hasn't been cancelled by a good message before
1684                      (setq line (substring line (match-end 0))))              ;; seeing a propt, then the error was real.
1685                    (if (not (and seen-prompt ange-ftp-pending-error-line))              (delete-process proc)
1686                        (ange-ftp-process-handle-line line proc)              (setq ange-ftp-process-busy nil
1687                      ;; If we've seen a potential error message and it                    ange-ftp-process-result-line ange-ftp-pending-error-line))))
1688                      ;; hasn't been cancelled by a good message before  
1689                      ;; seeing a propt, then the error was real.        ;; has the ftp client finished?  if so then do some clean-up
1690                      (delete-process proc)        ;; actions.
1691                      (setq ange-ftp-process-busy nil        (if (not ange-ftp-process-busy)
1692                            ange-ftp-process-result-line ange-ftp-pending-error-line))))            (progn
1693                ;; reset the xfer size
1694                ;; has the ftp client finished?  if so then do some clean-up              (setq ange-ftp-xfer-size 0)
1695                ;; actions.  
1696                (if (not ange-ftp-process-busy)              ;; issue the "done" message since we've finished.
1697                    (progn              (if (and ange-ftp-process-msg
1698                      ;; reset the xfer size                       ange-ftp-process-verbose
1699                      (setq ange-ftp-xfer-size 0)                       ange-ftp-process-result)
1700                    (progn
1701                      ;; issue the "done" message since we've finished.                    (ange-ftp-message "%s...done" ange-ftp-process-msg)
1702                      (if (and ange-ftp-process-msg                    (ange-ftp-repaint-minibuffer)
1703                               ange-ftp-process-verbose                    (setq ange-ftp-process-msg nil)))
1704                               ange-ftp-process-result)  
1705                          (progn              ;; is there a continuation we should be calling?  if so,
1706                            (ange-ftp-message "%s...done" ange-ftp-process-msg)              ;; we'd better call it, making sure we only call it once.
1707                            (ange-ftp-repaint-minibuffer)              (if ange-ftp-process-continue
1708                            (setq ange-ftp-process-msg nil)))                  (let ((cont ange-ftp-process-continue))
1709                      (setq ange-ftp-process-continue nil)
1710                      ;; is there a continuation we should be calling?  if so,                    (ange-ftp-call-cont cont
1711                      ;; we'd better call it, making sure we only call it once.                                        ange-ftp-process-result
1712                      (if ange-ftp-process-continue                                        ange-ftp-process-result-line))))))))
                         (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)))))  
1713    
1714  (defun ange-ftp-process-sentinel (proc str)  (defun ange-ftp-process-sentinel (proc str)
1715    "When ftp process changes state, nuke all file-entries in cache."    "When ftp process changes state, nuke all file-entries in cache."
# Line 1795  good, skip, fatal, or unknown." Line 1789  good, skip, fatal, or unknown."
1789    
1790  (defun ange-ftp-gwp-start (host user name args)  (defun ange-ftp-gwp-start (host user name args)
1791    "Login to the gateway machine and fire up an ftp process."    "Login to the gateway machine and fire up an ftp process."
1792    (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))    (let* (;; It would be nice to make process-connection-type nil,
          ;; It would be nice to make process-connection-type nil,  
1793           ;; but that doesn't work: ftp never responds.           ;; but that doesn't work: ftp never responds.
1794           ;; Can anyone find a fix for that?           ;; Can anyone find a fix for that?
1795           (proc (let ((process-connection-type t))           (proc (let ((process-connection-type t))
# Line 2137  suffix of the form #PORT to specify a no Line 2130  suffix of the form #PORT to specify a no
2130        (save-excursion        (save-excursion
2131          (set-buffer (process-buffer proc))          (set-buffer (process-buffer proc))
2132          (let* ((status (ange-ftp-raw-send-cmd proc "hash"))          (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
                (result (car status))  
2133                 (line (cdr status)))                 (line (cdr status)))
2134            (save-match-data            (save-match-data
2135              (if (string-match ange-ftp-hash-mark-msgs line)              (if (string-match ange-ftp-hash-mark-msgs line)
# Line 4484  NEWNAME should be the name to give the n Line 4476  NEWNAME should be the name to give the n
4476  ;; `ange-ftp-ls' handles this.  ;; `ange-ftp-ls' handles this.
4477    
4478  (defun ange-ftp-insert-directory (file switches &optional wildcard full)  (defun ange-ftp-insert-directory (file switches &optional wildcard full)
4479    (let ((short (ange-ftp-abbreviate-filename file))    (let ((parsed (ange-ftp-ftp-name (expand-file-name file)))
         (parsed (ange-ftp-ftp-name (expand-file-name file)))  
4480          tem)          tem)
4481      (if parsed      (if parsed
4482          (if (and (not wildcard)          (if (and (not wildcard)
# Line 4511  NEWNAME should be the name to give the n Line 4502  NEWNAME should be the name to give the n
4502  (defun ange-ftp-file-name-sans-versions (file keep-backup-version)  (defun ange-ftp-file-name-sans-versions (file keep-backup-version)
4503    (let* ((short (ange-ftp-abbreviate-filename file))    (let* ((short (ange-ftp-abbreviate-filename file))
4504           (parsed (ange-ftp-ftp-name short))           (parsed (ange-ftp-ftp-name short))
4505           host-type func)           func)
4506      (if parsed      (if parsed
4507          (setq host-type (ange-ftp-host-type (car parsed))          (setq func (cdr (assq (ange-ftp-host-type (car parsed))
               func (cdr (assq (ange-ftp-host-type (car parsed))  
4508                                ange-ftp-sans-version-alist))))                                ange-ftp-sans-version-alist))))
4509      (if func (funcall func file keep-backup-version)      (if func (funcall func file keep-backup-version)
4510        (ange-ftp-real-file-name-sans-versions file keep-backup-version))))        (ange-ftp-real-file-name-sans-versions file keep-backup-version))))

Legend:
Removed from v.1.71  
changed lines
  Added in v.1.72

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26