]> code.delx.au - gnu-emacs/blobdiff - lisp/url/url-file.el
* url-cookie.el (url-cookie-retrieve): Handle null localpart.
[gnu-emacs] / lisp / url / url-file.el
index 1ad2e09e976f82ee1a4f137d4744ecdd04b3e033..56fe8b0ee2fa4c69e69ede7e3aea6a6a36719e2c 100644 (file)
@@ -1,26 +1,24 @@
 ;;; url-file.el --- File retrieval code
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes
 
 ;; This file is part of GNU Emacs.
 ;;
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
-;;
+
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -41,7 +39,7 @@
 This tries the common compression extensions, because things like
 ange-ftp and efs are not quite smart enough to realize when a server
 can do automatic decompression for them, and won't find 'foo' if
-'foo.gz' exists, even though the ftp server would happily serve it up
+'foo.gz' exists, even though the FTP server would happily serve it up
 to them."
   (let ((scratch nil)
        (compressed-extensions '("" ".gz" ".z" ".Z" ".bz2"))
@@ -52,7 +50,7 @@ to them."
     found))
 
 (defun url-file-host-is-local-p (host)
-  "Return t iff HOST references our local machine."
+  "Return t if HOST references our local machine."
   (let ((case-fold-search t))
     (or
      (null host)
@@ -86,6 +84,12 @@ to them."
            (error nil)))
       (apply func args))))
 
+(declare-function ange-ftp-set-passwd "ange-ftp" (host user passwd))
+(declare-function ange-ftp-copy-file-internal "ange-ftp"
+                 (filename newname ok-if-already-exists
+                           keep-date &optional msg cont nowait))
+(declare-function url-generate-unique-filename "url-util" (&optional fmt))
+
 (defun url-file-build-filename (url)
   (if (not (vectorp url))
       (setq url (url-generic-parse-url url)))
@@ -113,8 +117,9 @@ to them."
         (cond
          ((featurep 'ange-ftp)
           (ange-ftp-set-passwd host user pass))
-         ((or (featurep 'efs) (featurep 'efs-auto))
-          (efs-set-passwd host user pass))
+         ((when (featurep 'xemacs)
+             (or (featurep 'efs) (featurep 'efs-auto)
+                 (efs-set-passwd host user pass))))
          (t
           nil)))
 
@@ -127,10 +132,11 @@ to them."
     ;; straighten it out for us?
     ;; (if (and (file-directory-p filename)
     ;;          (not (string-match (format "%c$" directory-sep-char) filename)))
-    ;;     (url-set-filename url (format "%s%c" filename directory-sep-char)))
+    ;;     (setf (url-filename url)
+    ;;           (format "%s%c" filename directory-sep-char)))
     (if (and (file-directory-p filename)
             (not (string-match "/\\'" filename)))
-       (url-set-filename url (format "%s/" filename)))
+       (setf (url-filename url) (format "%s/" filename)))
 
 
     ;; If it is a directory, look for an index file first.
@@ -207,14 +213,15 @@ to them."
                                                   new (current-buffer)
                                                   callback cbargs)
                                             t)
-             (autoload 'efs-copy-file-internal "efs")
-             (efs-copy-file-internal filename (efs-ftp-path filename)
-                                     new (efs-ftp-path new)
-                                     t nil 0
-                                     (list 'url-file-asynch-callback
-                                           new (current-buffer)
-                                           callback cbargs)
-                                     0 nil))))))
+              (when (featurep 'xemacs)
+                (autoload 'efs-copy-file-internal "efs")
+                (efs-copy-file-internal filename (efs-ftp-path filename)
+                                        new (efs-ftp-path new)
+                                        t nil 0
+                                        (list 'url-file-asynch-callback
+                                              new (current-buffer)
+                                              callback cbargs)
+                                        0 nil)))))))
     buffer))
 
 (defmacro url-file-create-wrapper (method args)