Function: dired-internal-do-deletions

dired-internal-do-deletions is a byte-compiled function defined in dired.el.gz.

Signature

(dired-internal-do-deletions L ARG &optional TRASH)

Source Code

;; Defined in /usr/src/emacs/lisp/dired.el.gz
(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.
  (let* ((files (mapcar #'car l))
	 (count (length l))
	 (succ 0)
	 ;; Bind `dired-recursive-deletes' so that we can change it
	 ;; locally according with the user answer within `dired-delete-file'.
	 (dired-recursive-deletes dired-recursive-deletes)
	 (trashing (and trash delete-by-moving-to-trash)))
    ;; canonicalize file list for pop up
    (setq files (mapcar #'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
          (catch '--delete-cancel
	  (let ((progress-reporter
		 (make-progress-reporter
		  (if trashing "Trashing..." "Deleting...")
		  succ count))
		failures)
	    (while l
	      (goto-char (marker-position (cdr (car l))))
              (dired-move-to-filename)
              ;; Temporarily prevent auto-revert while deleting entry in
              ;; the dired buffer (bug#71264).
              (inhibit-auto-revert
                (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)
                         #'dired-delete-entry fn)
                        ;; For when FN's directory name is different
                        ;; from the current buffer's dired-directory.
                        (dired-delete-entry fn))
                    (quit (throw '--delete-cancel (message "OK, canceled")))
		    (error ;; catch errors from failed deletions
		     (dired-log "%s: %s\n" (car err) (error-message-string err))
		     (setq failures (cons (car (car l)) failures))))))
	      (setq l (cdr l)))
	    (if (not failures)
		(progress-reporter-done progress-reporter)
	      (dired-log-summary
	       (format (ngettext "%d of %d deletion failed"
                                 "%d of %d deletions failed"
                                 count)
		       (length failures) count)
	       failures)))))
      (message "(No deletions performed)")))
  (dired-move-to-filename))