comparison lisp/dired.el @ 108851:cb093dac3d58

Merge from mainline.

108850:7cd8ffa6f7db

(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")

;; Delete file, possibly delete a directory and all its files.
;; This function is usefull outside of dired.  One could change it's name
;; to e.g. recursive-delete-file and put it somewhere else.
(defun dired-delete-file (file &optional recursive) "\
Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
RECURSIVE determines what to do with a non-empty directory.  If RECURSIVE is:
nil, do not delete.
`always', delete recursively without asking.
`top', ask for each directory at top level.
Anything else, ask for each sub-directory."
  ;; This test is equivalent to
  ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
  ;; but more efficient
  (if (not (eq t (car (file-attributes file))))
      (delete-file file)
    (if (and recursive
	     (directory-files file t dired-re-no-dot) ; Not empty.
	     (or (eq recursive 'always)
		 (yes-or-no-p (format "Recursive delete of %s? "
				      (dired-make-relative file)))))
	(if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
      (setq recursive nil))
    (delete-directory file recursive)))

(defun dired-do-flagged-delete (&optional nomessage)
  "In Dired, delete the files flagged for deletion.
If NOMESSAGE is non-nil, we don't display any message
if there are no flagged files.

			(re-search-forward regexp nil t))
	(dired-internal-do-deletions
	 ;; this can't move point since ARG is nil
	 (dired-map-over-marks (cons (dired-get-filename) (point))
			       nil)
	 nil)
      (or nomessage
	  (message "(No deletions requested)")))))

(defun dired-do-delete (&optional arg)
  "Delete all marked (or next ARG) files.

  (interactive "P")
  (dired-internal-do-deletions
   ;; this may move point if ARG is an integer
   (dired-map-over-marks (cons (dired-get-filename) (point))
			 arg)
   arg))

(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?

(defun dired-internal-do-deletions (l arg)
  ;; L is an alist of files to delete, with their buffer positions.
  ;; ARG is the prefix arg.
  ;; Filenames are absolute.
  ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
  ;; That way as changes are made in the buffer they do not shift the
  ;; lines still to be changed, so the (point) values in L stay valid.
  ;; Also, for subdirs in natural order, a subdir's files are deleted
  ;; before the subdir itself - the other way around would not work.
  (let ((files (mapcar (function car) l))
	(count (length l))
	(succ 0))
    ;; canonicalize file list for pop up
    (setq files (nreverse (mapcar (function dired-make-relative) files)))
    (if (dired-mark-pop-up
	 " *Deletions*" 'delete files dired-deletion-confirmer
	 (format "Delete %s " (dired-mark-prompt arg files)))
	(save-excursion
	  (let (failures);; files better be in reverse order for this loop!
	    (while l
	      (goto-char (cdr (car l)))
	      (let ((inhibit-read-only t))
		(condition-case err
		    (let ((fn (car (car l))))
		      (dired-delete-file fn dired-recursive-deletes)
		      ;; if we get here, removing worked
		      (setq succ (1+ succ))
		      (message "%s of %s deletions" succ count)
		      (dired-fun-in-all-buffers
		       (file-name-directory fn) (file-name-nondirectory fn)
		       (function dired-delete-entry) fn))
		  (error;; catch errors from failed deletions
		   (dired-log "%s\n" err)
		   (setq failures (cons (car (car l)) failures)))))
	      (setq l (cdr l)))
	    (if (not failures)
		(message "%d deletion%s done" count (dired-plural-s count))
	      (dired-log-summary
	       (format "%d of %d deletion%s failed"
		       (length failures) count
		       (dired-plural-s count))
	       failures))))

108851:cb093dac3d58

(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")

;; Delete file, possibly delete a directory and all its files.
;; This function is usefull outside of dired.  One could change it's name
;; to e.g. recursive-delete-file and put it somewhere else.
(defun dired-delete-file (file &optional recursive trash) "\
Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
RECURSIVE determines what to do with a non-empty directory.  If RECURSIVE is:
nil, do not delete.
`always', delete recursively without asking.
`top', ask for each directory at top level.
Anything else, ask for each sub-directory."
  ;; This test is equivalent to
  ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
  ;; but more efficient
  (if (not (eq t (car (file-attributes file))))
      (delete-file file trash)
    (if (and recursive
	     (directory-files file t dired-re-no-dot) ; Not empty.
	     (or (eq recursive 'always)
		 (yes-or-no-p (format "Recursively %s %s? "
				      (if (and trash
					       delete-by-moving-to-trash)
					  "trash"
					"delete")
				      (dired-make-relative file)))))
	(if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
      (setq recursive nil))
    (delete-directory file recursive trash)))

(defun dired-do-flagged-delete (&optional nomessage)
  "In Dired, delete the files flagged for deletion.
If NOMESSAGE is non-nil, we don't display any message
if there are no flagged files.

			(re-search-forward regexp nil t))
	(dired-internal-do-deletions
	 ;; this can't move point since ARG is nil
	 (dired-map-over-marks (cons (dired-get-filename) (point))
			       nil)
	 nil t)
      (or nomessage
	  (message "(No deletions requested)")))))

(defun dired-do-delete (&optional arg)
  "Delete all marked (or next ARG) files.

  (interactive "P")
  (dired-internal-do-deletions
   ;; this may move point if ARG is an integer
   (dired-map-over-marks (cons (dired-get-filename) (point))
			 arg)
   arg t))

(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?

(defun dired-internal-do-deletions (l arg &optional trash)
  ;; L is an alist of files to delete, with their buffer positions.
  ;; ARG is the prefix arg.
  ;; Filenames are absolute.
  ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
  ;; That way as changes are made in the buffer they do not shift the
  ;; lines still to be changed, so the (point) values in L stay valid.
  ;; Also, for subdirs in natural order, a subdir's files are deleted
  ;; before the subdir itself - the other way around would not work.
  (let* ((files (mapcar (function car) l))
	 (count (length l))
	 (succ 0)
	 (trashing (and trash delete-by-moving-to-trash))
	 (progress-reporter
	  (make-progress-reporter
	   (if trashing "Trashing..." "Deleting...")
	   succ count)))
    ;; canonicalize file list for pop up
    (setq files (nreverse (mapcar (function dired-make-relative) files)))
    (if (dired-mark-pop-up
	 " *Deletions*" 'delete files dired-deletion-confirmer
	 (format "%s %s "
		 (if trashing "Trash" "Delete")
		 (dired-mark-prompt arg files)))
	(save-excursion
	  (let (failures);; files better be in reverse order for this loop!
	    (while l
	      (goto-char (cdr (car l)))
	      (let ((inhibit-read-only t))
		(condition-case err
		    (let ((fn (car (car l))))
		      (dired-delete-file fn dired-recursive-deletes trash)
		      ;; if we get here, removing worked
		      (setq succ (1+ succ))
		      (progress-reporter-update progress-reporter succ)
		      (dired-fun-in-all-buffers
		       (file-name-directory fn) (file-name-nondirectory fn)
		       (function dired-delete-entry) fn))
		  (error;; catch errors from failed deletions
		   (dired-log "%s\n" err)
		   (setq failures (cons (car (car l)) failures)))))
	      (setq l (cdr l)))
	    (if (not failures)
		(progress-reporter-done progress-reporter)
	      (dired-log-summary
	       (format "%d of %d deletion%s failed"
		       (length failures) count
		       (dired-plural-s count))
	       failures))))