145 |
;; allowing 3 extra characters of separator per file name. |
;; allowing 3 extra characters of separator per file name. |
146 |
(defun dired-bunch-files (max function args files) |
(defun dired-bunch-files (max function args files) |
147 |
(let (pending |
(let (pending |
148 |
|
past |
149 |
(pending-length 0) |
(pending-length 0) |
150 |
failures) |
failures) |
151 |
;; Accumulate files as long as they fit in MAX chars, |
;; Accumulate files as long as they fit in MAX chars, |
157 |
;; If we have at least 1 pending file |
;; If we have at least 1 pending file |
158 |
;; and this file won't fit in the length limit, process now. |
;; and this file won't fit in the length limit, process now. |
159 |
(if (and pending (> (+ thislength pending-length) max)) |
(if (and pending (> (+ thislength pending-length) max)) |
160 |
(setq failures |
(setq pending (nreverse pending) |
161 |
(nconc (apply function (append args (nreverse pending))) |
;; The elements of PENDING are now in forward order. |
162 |
failures) |
;; Do the operation and record failures. |
163 |
|
failures (nconc (apply function (append args pending)) |
164 |
|
failures) |
165 |
|
;; Transfer the elemens of PENDING onto PAST |
166 |
|
;; and clear it out. Now PAST contains the first N files |
167 |
|
;; specified (for some N), and FILES contains the rest. |
168 |
|
past (nconc past pending) |
169 |
pending nil |
pending nil |
170 |
pending-length 0)) |
pending-length 0)) |
171 |
;; Do (setq pending (cons thisfile pending)) |
;; Do (setq pending (cons thisfile pending)) |
174 |
(setq pending files) |
(setq pending files) |
175 |
(setq pending-length (+ thislength pending-length)) |
(setq pending-length (+ thislength pending-length)) |
176 |
(setq files rest))) |
(setq files rest))) |
177 |
(nconc (apply function (append args (nreverse pending))) |
(setq pending (nreverse pending)) |
178 |
failures))) |
(prog1 |
179 |
|
(nconc (apply function (append args pending)) |
180 |
|
failures) |
181 |
|
;; Now the original list FILES has been put back as it was. |
182 |
|
(nconc past pending)))) |
183 |
|
|
184 |
;;;###autoload |
;;;###autoload |
185 |
(defun dired-do-print (&optional arg) |
(defun dired-do-print (&optional arg) |
677 |
'((?\y . y) (?\040 . y) ; `y' or SPC means accept once |
'((?\y . y) (?\040 . y) ; `y' or SPC means accept once |
678 |
(?n . n) (?\177 . n) ; `n' or DEL skips once |
(?n . n) (?\177 . n) ; `n' or DEL skips once |
679 |
(?! . yes) ; `!' accepts rest |
(?! . yes) ; `!' accepts rest |
680 |
(?q. no) (?\e . no) ; `q' or ESC skips rest |
(?q . no) (?\e . no) ; `q' or ESC skips rest |
681 |
;; None of these keys quit - use C-g for that. |
;; None of these keys quit - use C-g for that. |
682 |
)) |
)) |
683 |
|
|
836 |
(if (eq (following-char) ?\r) |
(if (eq (following-char) ?\r) |
837 |
(dired-unhide-subdir)) |
(dired-unhide-subdir)) |
838 |
;; We are already where we should be, except when |
;; We are already where we should be, except when |
839 |
;; point is before the subdir line or its total line. |
;; point is before the subdir line or its total line. |
840 |
(let ((p (dired-after-subdir-garbage cur-dir))) |
(let ((p (dired-after-subdir-garbage cur-dir))) |
841 |
(if (< (point) p) |
(if (< (point) p) |
842 |
(goto-char p)))) |
(goto-char p)))) |
854 |
(let (buffer-read-only opoint) |
(let (buffer-read-only opoint) |
855 |
(beginning-of-line) |
(beginning-of-line) |
856 |
(setq opoint (point)) |
(setq opoint (point)) |
857 |
(dired-add-entry-do-indentation marker-char) |
;; Don't expand `.'. Show just the file name within directory. |
|
;; don't expand `.'. Show just the file name within directory. |
|
858 |
(let ((default-directory directory)) |
(let ((default-directory directory)) |
859 |
(insert-directory filename |
(dired-insert-directory directory |
860 |
(concat dired-actual-switches "d"))) |
(concat dired-actual-switches "d") |
861 |
|
(list filename))) |
862 |
|
(goto-char opoint) |
863 |
|
;; Put in desired marker char. |
864 |
|
(when marker-char |
865 |
|
(let ((dired-marker-char |
866 |
|
(if (integerp marker-char) marker-char dired-marker-char))) |
867 |
|
(dired-mark nil))) |
868 |
;; Compensate for a bug in ange-ftp. |
;; Compensate for a bug in ange-ftp. |
869 |
;; It inserts the file's absolute name, rather than |
;; It inserts the file's absolute name, rather than |
870 |
;; the relative one. That may be hard to fix since it |
;; the relative one. That may be hard to fix since it |
872 |
(goto-char opoint) |
(goto-char opoint) |
873 |
(let ((inserted-name (dired-get-filename 'verbatim))) |
(let ((inserted-name (dired-get-filename 'verbatim))) |
874 |
(if (file-name-directory inserted-name) |
(if (file-name-directory inserted-name) |
875 |
(progn |
(let (props) |
876 |
(end-of-line) |
(end-of-line) |
877 |
(delete-char (- (length inserted-name))) |
(forward-char (- (length inserted-name))) |
878 |
(insert filename) |
(setq props (text-properties-at (point))) |
879 |
|
(delete-char (length inserted-name)) |
880 |
|
(let ((pt (point))) |
881 |
|
(insert filename) |
882 |
|
(set-text-properties pt (point) props)) |
883 |
(forward-char 1)) |
(forward-char 1)) |
884 |
(forward-line 1))) |
(forward-line 1))) |
|
;; Give each line a text property recording info about it. |
|
|
(dired-insert-set-properties opoint (point)) |
|
885 |
(forward-line -1) |
(forward-line -1) |
886 |
(if dired-after-readin-hook ;; the subdir-alist is not affected... |
(if dired-after-readin-hook ;; the subdir-alist is not affected... |
887 |
(save-excursion ;; ...so we can run it right now: |
(save-excursion ;; ...so we can run it right now: |
897 |
(goto-char opoint)) |
(goto-char opoint)) |
898 |
(not reason))) ; return t on success, nil else |
(not reason))) ; return t on success, nil else |
899 |
|
|
|
;; This is a separate function for the sake of nested dired format. |
|
|
(defun dired-add-entry-do-indentation (marker-char) |
|
|
;; two spaces or a marker plus a space: |
|
|
(insert (if marker-char |
|
|
(if (integerp marker-char) marker-char dired-marker-char) |
|
|
?\040) |
|
|
?\040)) |
|
|
|
|
900 |
(defun dired-after-subdir-garbage (dir) |
(defun dired-after-subdir-garbage (dir) |
901 |
;; Return pos of first file line of DIR, skipping header and total |
;; Return pos of first file line of DIR, skipping header and total |
902 |
;; or wildcard lines. |
;; or wildcard lines. |
926 |
|
|
927 |
;;;###autoload |
;;;###autoload |
928 |
(defun dired-relist-file (file) |
(defun dired-relist-file (file) |
929 |
|
"Create or update the line for FILE in all Dired buffers it would belong in." |
930 |
(dired-fun-in-all-buffers (file-name-directory file) |
(dired-fun-in-all-buffers (file-name-directory file) |
931 |
(file-name-nondirectory file) |
(file-name-nondirectory file) |
932 |
(function dired-relist-entry) file)) |
(function dired-relist-entry) file)) |
973 |
(defvar dired-overwrite-confirmed) |
(defvar dired-overwrite-confirmed) |
974 |
|
|
975 |
(defun dired-handle-overwrite (to) |
(defun dired-handle-overwrite (to) |
976 |
;; Save old version of a to be overwritten file TO. |
;; Save old version of file TO that is to be overwritten. |
977 |
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars |
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars |
978 |
;; from dired-create-files. |
;; from dired-create-files. |
979 |
(let (backup) |
(let (backup) |
1018 |
(copy-file from to ok-flag dired-copy-preserve-time))) |
(copy-file from to ok-flag dired-copy-preserve-time))) |
1019 |
|
|
1020 |
;;;###autoload |
;;;###autoload |
1021 |
(defun dired-rename-file (from to ok-flag) |
(defun dired-rename-file (file newname ok-if-already-exists) |
1022 |
(dired-handle-overwrite to) |
(dired-handle-overwrite newname) |
1023 |
(rename-file from to ok-flag) ; error is caught in -create-files |
(rename-file file newname ok-if-already-exists) ; error is caught in -create-files |
1024 |
;; Silently rename the visited file of any buffer visiting this file. |
;; Silently rename the visited file of any buffer visiting this file. |
1025 |
(and (get-file-buffer from) |
(and (get-file-buffer file) |
1026 |
(with-current-buffer (get-file-buffer from) |
(with-current-buffer (get-file-buffer file) |
1027 |
(set-visited-file-name to nil t))) |
(set-visited-file-name newname nil t))) |
1028 |
(dired-remove-file from) |
(dired-remove-file file) |
1029 |
;; See if it's an inserted subdir, and rename that, too. |
;; See if it's an inserted subdir, and rename that, too. |
1030 |
(dired-rename-subdir from to)) |
(dired-rename-subdir file newname)) |
1031 |
|
|
1032 |
(defun dired-rename-subdir (from-dir to-dir) |
(defun dired-rename-subdir (from-dir to-dir) |
1033 |
(setq from-dir (file-name-as-directory from-dir) |
(setq from-dir (file-name-as-directory from-dir) |
1258 |
;; will return t because the filesystem is |
;; will return t because the filesystem is |
1259 |
;; case-insensitive, and Emacs will try to move |
;; case-insensitive, and Emacs will try to move |
1260 |
;; foo -> foo/foo, which fails. |
;; foo -> foo/foo, which fails. |
1261 |
(if (and (memq system-type '(ms-dos windows-nt)) |
(if (and (memq system-type '(ms-dos windows-nt cygwin)) |
1262 |
(eq op-symbol 'move) |
(eq op-symbol 'move) |
1263 |
dired-one-file |
dired-one-file |
1264 |
(string= (downcase |
(string= (downcase |
1391 |
suggested for the target directory depends on the value of |
suggested for the target directory depends on the value of |
1392 |
`dired-dwim-target', which see." |
`dired-dwim-target', which see." |
1393 |
(interactive "P") |
(interactive "P") |
1394 |
(dired-do-create-files 'hardlink (function add-name-to-file) |
(dired-do-create-files 'hardlink (function dired-hardlink) |
1395 |
"Hardlink" arg dired-keep-marker-hardlink)) |
"Hardlink" arg dired-keep-marker-hardlink)) |
1396 |
|
|
1397 |
|
(defun dired-hardlink (file newname &optional ok-if-already-exists) |
1398 |
|
(dired-handle-overwrite newname) |
1399 |
|
;; error is caught in -create-files |
1400 |
|
(add-name-to-file file newname ok-if-already-exists) |
1401 |
|
;; Update the link count |
1402 |
|
(dired-relist-file file)) |
1403 |
|
|
1404 |
;;;###autoload |
;;;###autoload |
1405 |
(defun dired-do-rename (&optional arg) |
(defun dired-do-rename (&optional arg) |
1406 |
"Rename current file or all marked (or next ARG) files. |
"Rename current file or all marked (or next ARG) files. |
1407 |
When renaming just the current file, you specify the new name. |
When renaming just the current file, you specify the new name. |
1408 |
When renaming multiple or marked files, you specify a directory. |
When renaming multiple or marked files, you specify a directory. |
1409 |
|
This command also renames any buffers that are visiting the files. |
1410 |
The default suggested for the target directory depends on the value |
The default suggested for the target directory depends on the value |
1411 |
of `dired-dwim-target', which see." |
of `dired-dwim-target', which see." |
1412 |
(interactive "P") |
(interactive "P") |
1417 |
;;; 5K |
;;; 5K |
1418 |
;;;###begin dired-re.el |
;;;###begin dired-re.el |
1419 |
(defun dired-do-create-files-regexp |
(defun dired-do-create-files-regexp |
1420 |
(file-creator operation arg regexp newname &optional whole-path marker-char) |
(file-creator operation arg regexp newname &optional whole-name marker-char) |
1421 |
;; Create a new file for each marked file using regexps. |
;; Create a new file for each marked file using regexps. |
1422 |
;; FILE-CREATOR and OPERATION as in dired-create-files. |
;; FILE-CREATOR and OPERATION as in dired-create-files. |
1423 |
;; ARG as in dired-get-marked-files. |
;; ARG as in dired-get-marked-files. |
1424 |
;; Matches each marked file against REGEXP and constructs the new |
;; Matches each marked file against REGEXP and constructs the new |
1425 |
;; filename from NEWNAME (like in function replace-match). |
;; filename from NEWNAME (like in function replace-match). |
1426 |
;; Optional arg WHOLE-PATH means match/replace the whole file name |
;; Optional arg WHOLE-NAME means match/replace the whole file name |
1427 |
;; instead of only the non-directory part of the file. |
;; instead of only the non-directory part of the file. |
1428 |
;; Optional arg MARKER-CHAR as in dired-create-files. |
;; Optional arg MARKER-CHAR as in dired-create-files. |
1429 |
(let* ((fn-list (dired-get-marked-files nil arg)) |
(let* ((fn-list (dired-get-marked-files nil arg)) |
1436 |
(downcase operation))) |
(downcase operation))) |
1437 |
(regexp-name-constructor |
(regexp-name-constructor |
1438 |
;; Function to construct new filename using REGEXP and NEWNAME: |
;; Function to construct new filename using REGEXP and NEWNAME: |
1439 |
(if whole-path ; easy (but rare) case |
(if whole-name ; easy (but rare) case |
1440 |
(function |
(function |
1441 |
(lambda (from) |
(lambda (from) |
1442 |
(let ((to (dired-string-replace-match regexp from newname)) |
(let ((to (dired-string-replace-match regexp from newname)) |
1451 |
to) |
to) |
1452 |
(dired-log "%s: %s did not match regexp %s\n" |
(dired-log "%s: %s did not match regexp %s\n" |
1453 |
operation from regexp))))) |
operation from regexp))))) |
1454 |
;; not whole-path, replace non-directory part only |
;; not whole-name, replace non-directory part only |
1455 |
(function |
(function |
1456 |
(lambda (from) |
(lambda (from) |
1457 |
(let* ((new (dired-string-replace-match |
(let* ((new (dired-string-replace-match |
1474 |
|
|
1475 |
(defun dired-mark-read-regexp (operation) |
(defun dired-mark-read-regexp (operation) |
1476 |
;; Prompt user about performing OPERATION. |
;; Prompt user about performing OPERATION. |
1477 |
;; Read and return list of: regexp newname arg whole-path. |
;; Read and return list of: regexp newname arg whole-name. |
1478 |
(let* ((whole-path |
(let* ((whole-name |
1479 |
(equal 0 (prefix-numeric-value current-prefix-arg))) |
(equal 0 (prefix-numeric-value current-prefix-arg))) |
1480 |
(arg |
(arg |
1481 |
(if whole-path nil current-prefix-arg)) |
(if whole-name nil current-prefix-arg)) |
1482 |
(regexp |
(regexp |
1483 |
(dired-read-regexp |
(dired-read-regexp |
1484 |
(concat (if whole-path "Path " "") operation " from (regexp): "))) |
(concat (if whole-name "Abs. " "") operation " from (regexp): "))) |
1485 |
(newname |
(newname |
1486 |
(read-string |
(read-string |
1487 |
(concat (if whole-path "Path " "") operation " " regexp " to: ")))) |
(concat (if whole-name "Abs. " "") operation " " regexp " to: ")))) |
1488 |
(list regexp newname arg whole-path))) |
(list regexp newname arg whole-name))) |
1489 |
|
|
1490 |
;;;###autoload |
;;;###autoload |
1491 |
(defun dired-do-rename-regexp (regexp newname &optional arg whole-path) |
(defun dired-do-rename-regexp (regexp newname &optional arg whole-name) |
1492 |
"Rename selected files whose names match REGEXP to NEWNAME. |
"Rename selected files whose names match REGEXP to NEWNAME. |
1493 |
|
|
1494 |
With non-zero prefix argument ARG, the command operates on the next ARG |
With non-zero prefix argument ARG, the command operates on the next ARG |
1505 |
(interactive (dired-mark-read-regexp "Rename")) |
(interactive (dired-mark-read-regexp "Rename")) |
1506 |
(dired-do-create-files-regexp |
(dired-do-create-files-regexp |
1507 |
(function dired-rename-file) |
(function dired-rename-file) |
1508 |
"Rename" arg regexp newname whole-path dired-keep-marker-rename)) |
"Rename" arg regexp newname whole-name dired-keep-marker-rename)) |
1509 |
|
|
1510 |
;;;###autoload |
;;;###autoload |
1511 |
(defun dired-do-copy-regexp (regexp newname &optional arg whole-path) |
(defun dired-do-copy-regexp (regexp newname &optional arg whole-name) |
1512 |
"Copy selected files whose names match REGEXP to NEWNAME. |
"Copy selected files whose names match REGEXP to NEWNAME. |
1513 |
See function `dired-do-rename-regexp' for more info." |
See function `dired-do-rename-regexp' for more info." |
1514 |
(interactive (dired-mark-read-regexp "Copy")) |
(interactive (dired-mark-read-regexp "Copy")) |
1516 |
(dired-do-create-files-regexp |
(dired-do-create-files-regexp |
1517 |
(function dired-copy-file) |
(function dired-copy-file) |
1518 |
(if dired-copy-preserve-time "Copy [-p]" "Copy") |
(if dired-copy-preserve-time "Copy [-p]" "Copy") |
1519 |
arg regexp newname whole-path dired-keep-marker-copy))) |
arg regexp newname whole-name dired-keep-marker-copy))) |
1520 |
|
|
1521 |
;;;###autoload |
;;;###autoload |
1522 |
(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path) |
(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name) |
1523 |
"Hardlink selected files whose names match REGEXP to NEWNAME. |
"Hardlink selected files whose names match REGEXP to NEWNAME. |
1524 |
See function `dired-do-rename-regexp' for more info." |
See function `dired-do-rename-regexp' for more info." |
1525 |
(interactive (dired-mark-read-regexp "HardLink")) |
(interactive (dired-mark-read-regexp "HardLink")) |
1526 |
(dired-do-create-files-regexp |
(dired-do-create-files-regexp |
1527 |
(function add-name-to-file) |
(function add-name-to-file) |
1528 |
"HardLink" arg regexp newname whole-path dired-keep-marker-hardlink)) |
"HardLink" arg regexp newname whole-name dired-keep-marker-hardlink)) |
1529 |
|
|
1530 |
;;;###autoload |
;;;###autoload |
1531 |
(defun dired-do-symlink-regexp (regexp newname &optional arg whole-path) |
(defun dired-do-symlink-regexp (regexp newname &optional arg whole-name) |
1532 |
"Symlink selected files whose names match REGEXP to NEWNAME. |
"Symlink selected files whose names match REGEXP to NEWNAME. |
1533 |
See function `dired-do-rename-regexp' for more info." |
See function `dired-do-rename-regexp' for more info." |
1534 |
(interactive (dired-mark-read-regexp "SymLink")) |
(interactive (dired-mark-read-regexp "SymLink")) |
1535 |
(dired-do-create-files-regexp |
(dired-do-create-files-regexp |
1536 |
(function make-symbolic-link) |
(function make-symbolic-link) |
1537 |
"SymLink" arg regexp newname whole-path dired-keep-marker-symlink)) |
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) |
1538 |
|
|
1539 |
(defun dired-create-files-non-directory |
(defun dired-create-files-non-directory |
1540 |
(file-creator basename-constructor operation arg) |
(file-creator basename-constructor operation arg) |
1727 |
(delete-region begin-marker (point))))) |
(delete-region begin-marker (point))))) |
1728 |
|
|
1729 |
(defun dired-insert-subdir-doinsert (dirname switches) |
(defun dired-insert-subdir-doinsert (dirname switches) |
1730 |
;; Insert ls output after point and put point on the correct |
;; Insert ls output after point. |
|
;; position for the subdir alist. |
|
1731 |
;; Return the boundary of the inserted text (as list of BEG and END). |
;; Return the boundary of the inserted text (as list of BEG and END). |
1732 |
(let ((begin (point)) end) |
(save-excursion |
1733 |
(message "Reading directory %s..." dirname) |
(let ((begin (point))) |
1734 |
(let ((dired-actual-switches |
(message "Reading directory %s..." dirname) |
1735 |
(or switches |
(let ((dired-actual-switches |
1736 |
(dired-replace-in-string "R" "" dired-actual-switches)))) |
(or switches |
1737 |
(if (equal dirname (car (car (reverse dired-subdir-alist)))) |
(dired-replace-in-string "R" "" dired-actual-switches)))) |
1738 |
;; top level directory may contain wildcards: |
(if (equal dirname (car (car (last dired-subdir-alist)))) |
1739 |
(dired-readin-insert dired-directory) |
;; If doing the top level directory of the buffer, |
1740 |
(let ((opoint (point))) |
;; redo it as specified in dired-directory. |
1741 |
(insert-directory dirname dired-actual-switches nil t) |
(dired-readin-insert) |
1742 |
(dired-insert-set-properties opoint (point))))) |
(dired-insert-directory dirname dired-actual-switches nil nil t))) |
1743 |
(message "Reading directory %s...done" dirname) |
(message "Reading directory %s...done" dirname) |
1744 |
(setq end (point-marker)) |
(list begin (point))))) |
|
(indent-rigidly begin end 2) |
|
|
;; call dired-insert-headerline afterwards, as under VMS dired-ls |
|
|
;; does insert the headerline itself and the insert function just |
|
|
;; moves point. |
|
|
;; Need a marker for END as this inserts text. |
|
|
(goto-char begin) |
|
|
(if (not (looking-at "^ /.*:$")) |
|
|
(dired-insert-headerline dirname)) |
|
|
;; point is now like in dired-build-subdir-alist |
|
|
(prog1 |
|
|
(list begin (marker-position end)) |
|
|
(set-marker end nil)))) |
|
1745 |
|
|
1746 |
(defun dired-insert-subdir-doupdate (dirname elt beg-end) |
(defun dired-insert-subdir-doupdate (dirname elt beg-end) |
1747 |
;; Point is at the correct subdir alist position for ELT, |
;; Point is at the correct subdir alist position for ELT, |
2033 |
(call-process "file" nil t t "--" file)) |
(call-process "file" nil t t "--" file)) |
2034 |
(when (bolp) |
(when (bolp) |
2035 |
(backward-delete-char 1)) |
(backward-delete-char 1)) |
2036 |
(message (buffer-string)))) |
(message "%s" (buffer-string)))) |
2037 |
|
|
2038 |
(provide 'dired-aux) |
(provide 'dired-aux) |
2039 |
|
|