;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Code:
;; We need macros in dired.el to compile properly.
-(eval-when-compile (require 'dired))
+(require 'dired)
(defvar dired-create-files-failures nil
"Variable where `dired-create-files' records failing file names.
(other :tag "ask" t))
:group 'dired)
+;; This is a fluid var used in dired-handle-overwrite. It should be
+;; let-bound whenever dired-copy-file etc are called. See
+;; dired-create-files for an example.
(defvar dired-overwrite-confirmed)
(defun dired-handle-overwrite (to)
(or (eq recursive 'always)
(yes-or-no-p (format "Recursive copies of %s? " from))))
;; This is a directory.
- (let ((files
+ (let ((mode (file-modes from))
+ (files
(condition-case err
(directory-files from nil dired-re-no-dot)
(file-error
(if (file-exists-p to)
(or top (dired-handle-overwrite to))
(condition-case err
- (make-directory to)
+ ;; We used to call set-file-modes here, but on some
+ ;; Linux kernels, that returns an error on vfat
+ ;; filesystems
+ (let ((default-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes #o700)
+ (make-directory to))
+ (set-default-file-modes default-mode)))
(file-error
(push (dired-make-relative from)
dired-create-files-failures)
(setq files nil)
(dired-log "Copying error for %s:\n%s\n" from err)))))
- (while files
- (dired-copy-file-recursive
- (expand-file-name (car files) from)
- (expand-file-name (car files) to)
- ok-flag preserve-time nil recursive)
- (pop files)))
+ (dolist (file files)
+ (let ((thisfrom (expand-file-name file from))
+ (thisto (expand-file-name file to)))
+ ;; Catch errors copying within a directory,
+ ;; and report them through the dired log mechanism
+ ;; just as our caller will do for the top level files.
+ (condition-case err
+ (dired-copy-file-recursive
+ thisfrom thisto
+ ok-flag preserve-time nil recursive)
+ (file-error
+ (push (dired-make-relative thisfrom)
+ dired-create-files-failures)
+ (dired-log "Copying error for %s:\n%s\n" thisfrom err)))))
+ (when (file-directory-p to)
+ (set-file-modes to mode)))
;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
;; It is a symlink
(make-symbolic-link (car attrs) to ok-flag)
(copy-file from to ok-flag dired-copy-preserve-time))
- (file-date-error
- (push (dired-make-relative from)
- dired-create-files-failures)
- (dired-log "Can't set date on %s:\n%s\n" from err))
- (file-error
+ (file-date-error
(push (dired-make-relative from)
dired-create-files-failures)
- (dired-log "Copying error for %s:\n%s\n" from err))))))
+ (dired-log "Can't set date on %s:\n%s\n" from err))))))
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
and new copies of these files are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see."
+`dired-dwim-target', which see.
+
+This command copies symbolic links by creating new ones,
+like `cp -d'."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
and new symbolic links are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see."
+`dired-dwim-target', which see.
+
+For relative symlinks, use \\[dired-do-relsymlink]."
(interactive "P")
(dired-do-create-files 'symlink (function make-symbolic-link)
"Symlink" arg dired-keep-marker-symlink))
(defun dired-tree-lessp (dir1 dir2)
;; Lexicographic order on file name components, like `ls -lR':
- ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
- ;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
+ ;; DIR1 < DIR2 if DIR1 comes *before* DIR2 in an `ls -lR' listing,
+ ;; i.e., if DIR1 is a (grand)parent dir of DIR2,
;; or DIR1 and DIR2 are in the same parentdir and their last
;; components are string-lessp.
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.