Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
8e692050
Commit
8e692050
authored
Oct 04, 2009
by
Michael Albinus
Browse files
* files.el (copy-directory): New defun.
parent
b4744254
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
69 additions
and
2 deletions
+69
-2
lisp/files.el
lisp/files.el
+69
-2
No files found.
lisp/files.el
View file @
8e692050
...
...
@@ -4649,8 +4649,8 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
(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.
;; 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
...
...
@@ -4666,6 +4666,73 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
directory 'full "^\\([^.]\\|\\.\\
(
[^.]\\|\\..\\)\\).*")))
(delete-directory-internal directory))))
(defun copy-directory
(directory newname &optional keep-time preserve-uid-gid parents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.
This function always sets the file modes of the output files to match
the corresponding input file.
The third arg KEEP-TIME non-nil means give the output files the same
last-modified time as the old ones. (This works on only some systems.)
A prefix arg makes KEEP-TIME non-nil.
If PRESERVE-UID-GID is non-nil, we try to transfer the
uid and gid of the input files to the corresponding output file.
Noninteractively, the last argument PARENTS says whether to
create parent directories if they don't exist. Interactively,
this happens by default."
(interactive
(let ((dir (read-directory-name
"Copy directory: " default-directory default-directory t nil)))
(list dir
(read-file-name
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg nil t)))
;; If default-directory is a remote directory, make sure we find its
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
(find-file-name-handler newname 'copy-directory))))
(if handler
(funcall
handler
'copy-directory directory newname keep-time preserve-uid-gid parents)
;; Compute target name.
(setq directory (directory-file-name (expand-file-name directory))
newname (directory-file-name (expand-file-name newname)))
(if (and (file-directory-p newname)
(not (string-equal (file-name-nondirectory directory)
(file-name-nondirectory newname))))
(setq newname
(expand-file-name (file-name-nondirectory directory) newname)))
(if (not (file-directory-p newname)) (make-directory newname parents))
;; Copy recursively.
(mapc
(lambda (file)
(if (file-directory-p file)
(copy-directory file newname keep-time preserve-uid-gid parents)
(copy-file file newname t keep-time preserve-uid-gid)))
;; We do not want to delete "." and "..".
(directory-files
directory 'full "^\\([^.]\\|\\.\\
(
[^.]\\|\\..\\)\\).*"))
;; Set directory attributes.
(set-file-modes newname (file-modes directory))
(if keep-time
(set-file-times newname (nth 5 (file-attributes directory))))
(if preserve-uid-gid
(ignore-errors
(call-process
"chown" nil nil nil
(format "%s:%s"
(nth 2 (file-attributes directory))
(nth 3 (file-attributes directory)))
directory))))))
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment