/[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.35.2.1 by miles, Fri Apr 4 06:20:30 2003 UTC revision 1.35.2.2 by miles, Tue Oct 14 23:39:26 2003 UTC
# Line 1469  only return the directory part of FILE." Line 1469  only return the directory part of FILE."
1469  ;; Display the last chunk of output from the ftp process for the given HOST  ;; Display the last chunk of output from the ftp process for the given HOST
1470  ;; USER pair, and signal an error including MSG in the text.  ;; USER pair, and signal an error including MSG in the text.
1471  (defun ange-ftp-error (host user msg)  (defun ange-ftp-error (host user msg)
1472    (let ((cur (selected-window))    (save-excursion  ;; Prevent pop-to-buffer from changing current buffer.
1473          (pop-up-windows t))      (let ((cur (selected-window))
1474      (pop-to-buffer            (pop-up-windows t))
1475       (get-buffer-create        (pop-to-buffer
1476        (ange-ftp-ftp-process-buffer host user)))         (get-buffer-create
1477      (goto-char (point-max))          (ange-ftp-ftp-process-buffer host user)))
1478      (select-window cur))        (goto-char (point-max))
1479    (signal 'ftp-error (list (format "FTP Error: %s" msg))))        (select-window cur))
1480        (signal 'ftp-error (list (format "FTP Error: %s" msg)))))
1481    
1482  (defun ange-ftp-set-buffer-mode ()  (defun ange-ftp-set-buffer-mode ()
1483    "Set correct modes for the current buffer if visiting a remote file."    "Set correct modes for the current buffer if visiting a remote file."
# Line 3356  system TYPE.") Line 3357  system TYPE.")
3357        (ange-ftp-real-insert-file-contents filename visit beg end replace))))        (ange-ftp-real-insert-file-contents filename visit beg end replace))))
3358    
3359  (defun ange-ftp-expand-symlink (file dir)  (defun ange-ftp-expand-symlink (file dir)
3360    (if (file-name-absolute-p file)    (let ((res (if (file-name-absolute-p file)
3361        (ange-ftp-replace-name-component dir file)                   (ange-ftp-replace-name-component dir file)
3362      (expand-file-name file dir)))                 (expand-file-name file dir))))
3363        (if (file-symlink-p res)
3364            (ange-ftp-expand-symlink
3365             (ange-ftp-get-file-entry res)
3366             (file-name-directory (directory-file-name res)))
3367          res)))
3368    
3369  (defun ange-ftp-file-symlink-p (file)  (defun ange-ftp-file-symlink-p (file)
3370    ;; call ange-ftp-expand-file-name rather than the normal    ;; call ange-ftp-expand-file-name rather than the normal
# Line 3366  system TYPE.") Line 3372  system TYPE.")
3372    ;; redefines both file-symlink-p and expand-file-name.    ;; redefines both file-symlink-p and expand-file-name.
3373    (setq file (ange-ftp-expand-file-name file))    (setq file (ange-ftp-expand-file-name file))
3374    (if (ange-ftp-ftp-name file)    (if (ange-ftp-ftp-name file)
3375        (let ((file-ent        (condition-case nil
3376               (gethash            (let ((file-ent
3377                (ange-ftp-get-file-part file)                   (gethash
3378                (ange-ftp-get-files (file-name-directory file)))))                    (ange-ftp-get-file-part file)
3379          (if (stringp file-ent)                    (ange-ftp-get-files (file-name-directory file)))))
3380              (if (file-name-absolute-p file-ent)              (and (stringp file-ent) file-ent))
3381                  (ange-ftp-replace-name-component          ;; If we can't read the parent directory, just assume
3382                   (file-name-directory file) file-ent)          ;; this file is not a symlink.
3383                file-ent)))          ;; This makes it possible to access a directory that
3384            ;; whose parent is not readable.
3385            (file-error nil))
3386      (ange-ftp-real-file-symlink-p file)))      (ange-ftp-real-file-symlink-p file)))
3387    
3388  (defun ange-ftp-file-exists-p (name)  (defun ange-ftp-file-exists-p (name)
# Line 6041  be recognized automatically (they are al Line 6049  be recognized automatically (they are al
6049    
6050  (provide 'ange-ftp)  (provide 'ange-ftp)
6051    
6052    ;;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
6053  ;;; ange-ftp.el ends here  ;;; ange-ftp.el ends here

Legend:
Removed from v.1.35.2.1  
changed lines
  Added in v.1.35.2.2

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