]> git.eshelyaron.com Git - emacs.git/commitdiff
* files.el (delete-directory): New defun. The original function
authorMichael Albinus <michael.albinus@gmx.de>
Thu, 1 Oct 2009 15:04:22 +0000 (15:04 +0000)
committerMichael Albinus <michael.albinus@gmx.de>
Thu, 1 Oct 2009 15:04:22 +0000 (15:04 +0000)
in fileio.c has been renamed to `delete-directory-internal'.

lisp/files.el

index a7eac5fb63e5e9c1f3c661b5c48fc9e562ccac3e..61de4cb1704e5c89460ace7fffd28c0e4bc166c2 100644 (file)
@@ -4631,6 +4631,38 @@ this happens by default."
          (while create-list
            (make-directory-internal (car create-list))
            (setq create-list (cdr create-list))))))))
+
+(defun delete-directory (directory &optional recursive)
+  "Delete the directory named DIRECTORY.  Does not follow symlinks.
+If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
+  (interactive
+   (let ((dir (expand-file-name
+              (read-file-name
+               "Delete directory: "
+               default-directory default-directory nil nil))))
+     (list dir
+          (if (directory-files
+               dir nil "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
+              (y-or-n-p
+               (format "Directory `%s' is not empty, really delete? " dir))
+            nil))))
+  ;; If default-directory is a remote directory,
+  ;; make sure we find its delete-directory handler.
+  (setq directory (directory-file-name (expand-file-name directory)))
+  (let ((handler (find-file-name-handler directory 'delete-directory)))
+    (if handler
+       (funcall handler 'delete-directory directory recursive)
+      (if (and recursive (not (file-symlink-p directory)))
+         (mapc
+          (lambda (file)
+            (if (file-directory-p file)
+                (delete-directory file recursive)
+              (delete-file file)))
+          ;; We do not want to delete "." and "..".
+          (directory-files
+           directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
+      (delete-directory-internal directory))))
+
 \f
 (put 'revert-buffer-function 'permanent-local t)
 (defvar revert-buffer-function nil