Mercurial > emacs
comparison lisp/dired.el @ 108851:cb093dac3d58
Merge from mainline.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Fri, 28 May 2010 00:48:45 +0000 |
parents | 511da81b16c5 |
children | 2d68a79d5213 |
comparison
equal
deleted
inserted
replaced
108850:7cd8ffa6f7db | 108851:cb093dac3d58 |
---|---|
2577 (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") | 2577 (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") |
2578 | 2578 |
2579 ;; Delete file, possibly delete a directory and all its files. | 2579 ;; Delete file, possibly delete a directory and all its files. |
2580 ;; This function is usefull outside of dired. One could change it's name | 2580 ;; This function is usefull outside of dired. One could change it's name |
2581 ;; to e.g. recursive-delete-file and put it somewhere else. | 2581 ;; to e.g. recursive-delete-file and put it somewhere else. |
2582 (defun dired-delete-file (file &optional recursive) "\ | 2582 (defun dired-delete-file (file &optional recursive trash) "\ |
2583 Delete FILE or directory (possibly recursively if optional RECURSIVE is true.) | 2583 Delete FILE or directory (possibly recursively if optional RECURSIVE is true.) |
2584 RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is: | 2584 RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is: |
2585 nil, do not delete. | 2585 nil, do not delete. |
2586 `always', delete recursively without asking. | 2586 `always', delete recursively without asking. |
2587 `top', ask for each directory at top level. | 2587 `top', ask for each directory at top level. |
2588 Anything else, ask for each sub-directory." | 2588 Anything else, ask for each sub-directory." |
2589 ;; This test is equivalent to | 2589 ;; This test is equivalent to |
2590 ;; (and (file-directory-p fn) (not (file-symlink-p fn))) | 2590 ;; (and (file-directory-p fn) (not (file-symlink-p fn))) |
2591 ;; but more efficient | 2591 ;; but more efficient |
2592 (if (not (eq t (car (file-attributes file)))) | 2592 (if (not (eq t (car (file-attributes file)))) |
2593 (delete-file file) | 2593 (delete-file file trash) |
2594 (if (and recursive | 2594 (if (and recursive |
2595 (directory-files file t dired-re-no-dot) ; Not empty. | 2595 (directory-files file t dired-re-no-dot) ; Not empty. |
2596 (or (eq recursive 'always) | 2596 (or (eq recursive 'always) |
2597 (yes-or-no-p (format "Recursive delete of %s? " | 2597 (yes-or-no-p (format "Recursively %s %s? " |
2598 (if (and trash | |
2599 delete-by-moving-to-trash) | |
2600 "trash" | |
2601 "delete") | |
2598 (dired-make-relative file))))) | 2602 (dired-make-relative file))))) |
2599 (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. | 2603 (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. |
2600 (setq recursive nil)) | 2604 (setq recursive nil)) |
2601 (delete-directory file recursive))) | 2605 (delete-directory file recursive trash))) |
2602 | 2606 |
2603 (defun dired-do-flagged-delete (&optional nomessage) | 2607 (defun dired-do-flagged-delete (&optional nomessage) |
2604 "In Dired, delete the files flagged for deletion. | 2608 "In Dired, delete the files flagged for deletion. |
2605 If NOMESSAGE is non-nil, we don't display any message | 2609 If NOMESSAGE is non-nil, we don't display any message |
2606 if there are no flagged files. | 2610 if there are no flagged files. |
2614 (re-search-forward regexp nil t)) | 2618 (re-search-forward regexp nil t)) |
2615 (dired-internal-do-deletions | 2619 (dired-internal-do-deletions |
2616 ;; this can't move point since ARG is nil | 2620 ;; this can't move point since ARG is nil |
2617 (dired-map-over-marks (cons (dired-get-filename) (point)) | 2621 (dired-map-over-marks (cons (dired-get-filename) (point)) |
2618 nil) | 2622 nil) |
2619 nil) | 2623 nil t) |
2620 (or nomessage | 2624 (or nomessage |
2621 (message "(No deletions requested)"))))) | 2625 (message "(No deletions requested)"))))) |
2622 | 2626 |
2623 (defun dired-do-delete (&optional arg) | 2627 (defun dired-do-delete (&optional arg) |
2624 "Delete all marked (or next ARG) files. | 2628 "Delete all marked (or next ARG) files. |
2629 (interactive "P") | 2633 (interactive "P") |
2630 (dired-internal-do-deletions | 2634 (dired-internal-do-deletions |
2631 ;; this may move point if ARG is an integer | 2635 ;; this may move point if ARG is an integer |
2632 (dired-map-over-marks (cons (dired-get-filename) (point)) | 2636 (dired-map-over-marks (cons (dired-get-filename) (point)) |
2633 arg) | 2637 arg) |
2634 arg)) | 2638 arg t)) |
2635 | 2639 |
2636 (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? | 2640 (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? |
2637 | 2641 |
2638 (defun dired-internal-do-deletions (l arg) | 2642 (defun dired-internal-do-deletions (l arg &optional trash) |
2639 ;; L is an alist of files to delete, with their buffer positions. | 2643 ;; L is an alist of files to delete, with their buffer positions. |
2640 ;; ARG is the prefix arg. | 2644 ;; ARG is the prefix arg. |
2641 ;; Filenames are absolute. | 2645 ;; Filenames are absolute. |
2642 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer. | 2646 ;; (car L) *must* be the *last* (bottommost) file in the dired buffer. |
2643 ;; That way as changes are made in the buffer they do not shift the | 2647 ;; That way as changes are made in the buffer they do not shift the |
2644 ;; lines still to be changed, so the (point) values in L stay valid. | 2648 ;; lines still to be changed, so the (point) values in L stay valid. |
2645 ;; Also, for subdirs in natural order, a subdir's files are deleted | 2649 ;; Also, for subdirs in natural order, a subdir's files are deleted |
2646 ;; before the subdir itself - the other way around would not work. | 2650 ;; before the subdir itself - the other way around would not work. |
2647 (let ((files (mapcar (function car) l)) | 2651 (let* ((files (mapcar (function car) l)) |
2648 (count (length l)) | 2652 (count (length l)) |
2649 (succ 0)) | 2653 (succ 0) |
2654 (trashing (and trash delete-by-moving-to-trash)) | |
2655 (progress-reporter | |
2656 (make-progress-reporter | |
2657 (if trashing "Trashing..." "Deleting...") | |
2658 succ count))) | |
2650 ;; canonicalize file list for pop up | 2659 ;; canonicalize file list for pop up |
2651 (setq files (nreverse (mapcar (function dired-make-relative) files))) | 2660 (setq files (nreverse (mapcar (function dired-make-relative) files))) |
2652 (if (dired-mark-pop-up | 2661 (if (dired-mark-pop-up |
2653 " *Deletions*" 'delete files dired-deletion-confirmer | 2662 " *Deletions*" 'delete files dired-deletion-confirmer |
2654 (format "Delete %s " (dired-mark-prompt arg files))) | 2663 (format "%s %s " |
2664 (if trashing "Trash" "Delete") | |
2665 (dired-mark-prompt arg files))) | |
2655 (save-excursion | 2666 (save-excursion |
2656 (let (failures);; files better be in reverse order for this loop! | 2667 (let (failures);; files better be in reverse order for this loop! |
2657 (while l | 2668 (while l |
2658 (goto-char (cdr (car l))) | 2669 (goto-char (cdr (car l))) |
2659 (let ((inhibit-read-only t)) | 2670 (let ((inhibit-read-only t)) |
2660 (condition-case err | 2671 (condition-case err |
2661 (let ((fn (car (car l)))) | 2672 (let ((fn (car (car l)))) |
2662 (dired-delete-file fn dired-recursive-deletes) | 2673 (dired-delete-file fn dired-recursive-deletes trash) |
2663 ;; if we get here, removing worked | 2674 ;; if we get here, removing worked |
2664 (setq succ (1+ succ)) | 2675 (setq succ (1+ succ)) |
2665 (message "%s of %s deletions" succ count) | 2676 (progress-reporter-update progress-reporter succ) |
2666 (dired-fun-in-all-buffers | 2677 (dired-fun-in-all-buffers |
2667 (file-name-directory fn) (file-name-nondirectory fn) | 2678 (file-name-directory fn) (file-name-nondirectory fn) |
2668 (function dired-delete-entry) fn)) | 2679 (function dired-delete-entry) fn)) |
2669 (error;; catch errors from failed deletions | 2680 (error;; catch errors from failed deletions |
2670 (dired-log "%s\n" err) | 2681 (dired-log "%s\n" err) |
2671 (setq failures (cons (car (car l)) failures))))) | 2682 (setq failures (cons (car (car l)) failures))))) |
2672 (setq l (cdr l))) | 2683 (setq l (cdr l))) |
2673 (if (not failures) | 2684 (if (not failures) |
2674 (message "%d deletion%s done" count (dired-plural-s count)) | 2685 (progress-reporter-done progress-reporter) |
2675 (dired-log-summary | 2686 (dired-log-summary |
2676 (format "%d of %d deletion%s failed" | 2687 (format "%d of %d deletion%s failed" |
2677 (length failures) count | 2688 (length failures) count |
2678 (dired-plural-s count)) | 2689 (dired-plural-s count)) |
2679 failures)))) | 2690 failures)))) |