diff options
| author | Michael Albinus | 2009-10-05 07:44:01 +0000 |
|---|---|---|
| committer | Michael Albinus | 2009-10-05 07:44:01 +0000 |
| commit | 0e1f2ee62a341fc0d1c69930b524c4f8d00d156a (patch) | |
| tree | e5ad4628b6e43e2b734fd30f42c0bace869d7d02 | |
| parent | 4a34f0655d814bd9358a6b0a010dbfa9a3f3e8b8 (diff) | |
| download | emacs-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/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/files.el | 39 |
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 @@ | |||
| 1 | 2009-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 | |||
| 1 | 2009-10-05 Stefan Monnier <monnier@iro.umontreal.ca> | 7 | 2009-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. |
| 4640 | If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well." | 4644 | If 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. |
| 4672 | If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. | 4674 | If 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 | ||
| 4680 | A prefix arg makes KEEP-TIME non-nil. | 4682 | A prefix arg makes KEEP-TIME non-nil. |
| 4681 | 4683 | ||
| 4682 | If PRESERVE-UID-GID is non-nil, we try to transfer the | ||
| 4683 | uid and gid of the input files to the corresponding output file. | ||
| 4684 | |||
| 4685 | Noninteractively, the last argument PARENTS says whether to | 4684 | Noninteractively, the last argument PARENTS says whether to |
| 4686 | create parent directories if they don't exist. Interactively, | 4685 | create parent directories if they don't exist. Interactively, |
| 4687 | this happens by default." | 4686 | this 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 |