aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2009-10-05 07:44:01 +0000
committerMichael Albinus2009-10-05 07:44:01 +0000
commit0e1f2ee62a341fc0d1c69930b524c4f8d00d156a (patch)
treee5ad4628b6e43e2b734fd30f42c0bace869d7d02
parent4a34f0655d814bd9358a6b0a010dbfa9a3f3e8b8 (diff)
downloademacs-0e1f2ee62a341fc0d1c69930b524c4f8d00d156a.tar.gz
emacs-0e1f2ee62a341fc0d1c69930b524c4f8d00d156a.zip
* files.el (directory-files-no-dot-files-regexp): New defconst.
(delete-directory): Use it. (copy-directory): Use it. Remove parameter PRESERVE-UID-GID.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/files.el39
2 files changed, 20 insertions, 25 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f5b6633bf08..e4a94b55c92 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
12009-10-05 Michael Albinus <michael.albinus@gmx.de>
2
3 * files.el (directory-files-no-dot-files-regexp): New defconst.
4 (delete-directory): Use it.
5 (copy-directory): Use it. Remove parameter PRESERVE-UID-GID.
6
12009-10-05 Stefan Monnier <monnier@iro.umontreal.ca> 72009-10-05 Stefan Monnier <monnier@iro.umontreal.ca>
2 8
3 * calendar/diary-lib.el (diary-show-all-entries): Re-fit the calendar 9 * calendar/diary-lib.el (diary-show-all-entries): Re-fit the calendar
diff --git a/lisp/files.el b/lisp/files.el
index b088fa4dc1a..9bb4d757dfe 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4635,6 +4635,10 @@ this happens by default."
4635 (make-directory-internal (car create-list)) 4635 (make-directory-internal (car create-list))
4636 (setq create-list (cdr create-list)))))))) 4636 (setq create-list (cdr create-list))))))))
4637 4637
4638(defconst directory-files-no-dot-files-regexp
4639 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
4640 "Regexp of file names excluging \".\" an \"..\".")
4641
4638(defun delete-directory (directory &optional recursive) 4642(defun delete-directory (directory &optional recursive)
4639 "Delete the directory named DIRECTORY. Does not follow symlinks. 4643 "Delete the directory named DIRECTORY. Does not follow symlinks.
4640If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." 4644If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
@@ -4644,8 +4648,7 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
4644 "Delete directory: " 4648 "Delete directory: "
4645 default-directory default-directory nil nil)))) 4649 default-directory default-directory nil nil))))
4646 (list dir 4650 (list dir
4647 (if (directory-files 4651 (if (directory-files dir nil directory-files-no-dot-files-regexp)
4648 dir nil "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
4649 (y-or-n-p 4652 (y-or-n-p
4650 (format "Directory `%s' is not empty, really delete? " dir)) 4653 (format "Directory `%s' is not empty, really delete? " dir))
4651 nil)))) 4654 nil))))
@@ -4663,11 +4666,10 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
4663 (delete-file file))) 4666 (delete-file file)))
4664 ;; We do not want to delete "." and "..". 4667 ;; We do not want to delete "." and "..".
4665 (directory-files 4668 (directory-files
4666 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) 4669 directory 'full directory-files-no-dot-files-regexp)))
4667 (delete-directory-internal directory)))) 4670 (delete-directory-internal directory))))
4668 4671
4669(defun copy-directory 4672(defun copy-directory (directory newname &optional keep-time parents)
4670 (directory newname &optional keep-time preserve-uid-gid parents)
4671 "Copy DIRECTORY to NEWNAME. Both args must be strings. 4673 "Copy DIRECTORY to NEWNAME. Both args must be strings.
4672If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. 4674If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.
4673 4675
@@ -4679,9 +4681,6 @@ last-modified time as the old ones. (This works on only some systems.)
4679 4681
4680A prefix arg makes KEEP-TIME non-nil. 4682A prefix arg makes KEEP-TIME non-nil.
4681 4683
4682If PRESERVE-UID-GID is non-nil, we try to transfer the
4683uid and gid of the input files to the corresponding output file.
4684
4685Noninteractively, the last argument PARENTS says whether to 4684Noninteractively, the last argument PARENTS says whether to
4686create parent directories if they don't exist. Interactively, 4685create parent directories if they don't exist. Interactively,
4687this happens by default." 4686this happens by default."
@@ -4692,15 +4691,13 @@ this happens by default."
4692 (read-file-name 4691 (read-file-name
4693 (format "Copy directory %s to: " dir) 4692 (format "Copy directory %s to: " dir)
4694 default-directory default-directory nil nil) 4693 default-directory default-directory nil nil)
4695 current-prefix-arg nil t))) 4694 current-prefix-arg t)))
4696 ;; If default-directory is a remote directory, make sure we find its 4695 ;; If default-directory is a remote directory, make sure we find its
4697 ;; copy-directory handler. 4696 ;; copy-directory handler.
4698 (let ((handler (or (find-file-name-handler directory 'copy-directory) 4697 (let ((handler (or (find-file-name-handler directory 'copy-directory)
4699 (find-file-name-handler newname 'copy-directory)))) 4698 (find-file-name-handler newname 'copy-directory))))
4700 (if handler 4699 (if handler
4701 (funcall 4700 (funcall handler 'copy-directory directory newname keep-time parents)
4702 handler
4703 'copy-directory directory newname keep-time preserve-uid-gid parents)
4704 4701
4705 ;; Compute target name. 4702 ;; Compute target name.
4706 (setq directory (directory-file-name (expand-file-name directory)) 4703 (setq directory (directory-file-name (expand-file-name directory))
@@ -4711,28 +4708,20 @@ this happens by default."
4711 (setq newname 4708 (setq newname
4712 (expand-file-name (file-name-nondirectory directory) newname))) 4709 (expand-file-name (file-name-nondirectory directory) newname)))
4713 (if (not (file-directory-p newname)) (make-directory newname parents)) 4710 (if (not (file-directory-p newname)) (make-directory newname parents))
4711
4714 ;; Copy recursively. 4712 ;; Copy recursively.
4715 (mapc 4713 (mapc
4716 (lambda (file) 4714 (lambda (file)
4717 (if (file-directory-p file) 4715 (if (file-directory-p file)
4718 (copy-directory file newname keep-time preserve-uid-gid parents) 4716 (copy-directory file newname keep-time parents)
4719 (copy-file file newname t keep-time preserve-uid-gid))) 4717 (copy-file file newname t keep-time)))
4720 ;; We do not want to delete "." and "..". 4718 ;; We do not want to delete "." and "..".
4721 (directory-files 4719 (directory-files directory 'full directory-files-no-dot-files-regexp))
4722 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
4723 4720
4724 ;; Set directory attributes. 4721 ;; Set directory attributes.
4725 (set-file-modes newname (file-modes directory)) 4722 (set-file-modes newname (file-modes directory))
4726 (if keep-time 4723 (if keep-time
4727 (set-file-times newname (nth 5 (file-attributes directory)))) 4724 (set-file-times newname (nth 5 (file-attributes directory)))))))
4728 (if preserve-uid-gid
4729 (ignore-errors
4730 (call-process
4731 "chown" nil nil nil
4732 (format "%s:%s"
4733 (nth 2 (file-attributes directory))
4734 (nth 3 (file-attributes directory)))
4735 directory))))))
4736 4725
4737(put 'revert-buffer-function 'permanent-local t) 4726(put 'revert-buffer-function 'permanent-local t)
4738(defvar revert-buffer-function nil 4727(defvar revert-buffer-function nil