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

[Michael Albinus]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Michael Albinus <albinus>       09/10/02 13:20:14

Modified files:
        lisp/net       : ange-ftp.el 

Log message:
        * net/ange-ftp.el (ange-ftp-generate-passwd-key): Check, whether
        HOST and USER are strings.  They are nil, when there are
        incomplete entries in ~/.netrc, for example.
        (ange-ftp-delete-directory): Implement RECURSIVE case.  Change to
        root directory ("device busy" error otherwise).

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/ange-ftp.el?cvsroot=emacs&r1=1.111&r2=1.112

Patches:
Index: ange-ftp.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/ange-ftp.el,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -b -r1.111 -r1.112
--- ange-ftp.el 2 Oct 2009 03:48:45 -0000       1.111
+++ ange-ftp.el 2 Oct 2009 13:20:14 -0000       1.112
@@ -1176,7 +1176,7 @@
 ;;;; ------------------------------------------------------------
 
 (defmacro ange-ftp-generate-passwd-key (host user)
-  `(concat (downcase ,host) "/" ,user))
+  `(and (stringp ,host) (stringp ,user) (concat (downcase ,host) "/" ,user)))
 
 (defmacro ange-ftp-lookup-passwd (host user)
   `(gethash (ange-ftp-generate-passwd-key ,host ,user)
@@ -4067,6 +4067,15 @@
 (defun ange-ftp-delete-directory (dir &optional recursive)
   (if (file-directory-p dir)
       (let ((parsed (ange-ftp-ftp-name dir)))
+       (if recursive
+           (mapc
+            (lambda (file)
+              (if (file-directory-p file)
+                  (ange-ftp-delete-directory file recursive)
+                (delete-file file)))
+            ;; We do not want to delete "." and "..".
+            (directory-files
+             dir 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
        (if parsed
            (let* ((host (nth 0 parsed))
                   (user (nth 1 parsed))
@@ -4083,11 +4092,14 @@
                            (ange-ftp-real-file-name-as-directory
                             (nth 2 parsed)))))
                   (abbr (ange-ftp-abbreviate-filename dir))
-                  ;; TODO: handle RECURSIVE.
-                  (result (ange-ftp-send-cmd host user
+                  (result
+                   (progn
+                     ;; CWD must not in this directory.
+                     (ange-ftp-cd host user "/" 'noerror)
+                     (ange-ftp-send-cmd host user
                                              (list 'rmdir name)
                                              (format "Removing directory %s"
-                                                     abbr))))
+                                                abbr)))))
              (or (car result)
                  (ange-ftp-error host user
                                  (format "Could not remove directory %s: %s"