Lines Matching +refs:dired +refs:current +refs:directory
0 ;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
29 ;; The parts of dired mode not normally used. This is a space-saving hack
39 ;; We need macros in dired.el to compile properly.
40 (eval-when-compile (require 'dired))
42 (defvar dired-create-files-failures nil
43 "Variable where `dired-create-files' records failing file names.
45 into this list; they also should call `dired-log' to log the errors.")
48 ;;;###begin dired-cmd.el
51 (defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
52 (defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
55 (defun dired-diff (file &optional switches)
58 \\[set-mark-command], not by Dired's \\[dired-mark] command.)
63 (let ((current (dired-get-filename t))
66 (dired-get-filename t t)))))
67 (if (or (equal default current)
68 (and (not (equal (dired-dwim-target-directory)
69 (dired-current-directory)))
74 current
79 (dired-current-directory)
80 (dired-dwim-target-directory))
82 (if current-prefix-arg
87 (diff file (dired-get-filename t) switches))
90 (defun dired-backup-diff (&optional switches)
97 (if current-prefix-arg
103 (diff-backup (dired-get-filename) switches))
106 (defun dired-compare-directories (dir2 predicate)
107 "Mark files with different file attributes in two dired buffers.
108 Compare file attributes of files in the current directory
109 with file attributes in directory DIR2 using PREDICATE on pairs of files
121 where 1 refers to attribute of file in the current dired buffer
122 and 2 to attribute of file in second dired buffer.
132 (list (read-directory-name (format "Compare %s with: "
133 (dired-current-directory))
134 (dired-dwim-target-directory)
135 (dired-dwim-target-directory))
137 (let* ((dir1 (dired-current-directory))
138 (file-alist1 (dired-files-attributes dir1))
139 (file-alist2 (dired-files-attributes dir2))
147 (dired-file-set-difference
152 (dired-file-set-difference
155 (dired-fun-in-all-buffers
158 (dired-mark-if
159 (member (dired-get-filename nil t) file-list1) nil)))
160 (dired-fun-in-all-buffers
163 (dired-mark-if
164 (member (dired-get-filename nil t) file-list2) nil)))
169 (defun dired-file-set-difference (list1 list2 predicate)
174 PREDICATE (see `dired-compare-directories') is an additional match
198 (defun dired-files-attributes (dir)
207 (directory-files dir)))
211 (defun dired-touch-initial (files)
215 (let ((current (nth 5 (file-attributes (car files)))))
216 (if (and initial (not (equal initial current)))
217 (setq initial (current-time) files nil)
218 (setq initial current))
222 (defun dired-do-chxxx (attribute-name program op-symbol arg)
227 ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
228 ;; ARG describes which files to use, as in dired-get-marked-files.
229 (let* ((files (dired-get-marked-files t arg))
231 (dired-mark-read-string
233 (if (eq op-symbol 'touch) (dired-touch-initial files))
238 (dired-bunch-files 10000
239 (function dired-check-process)
248 (dired-do-redisplay arg);; moves point if ARG is an integer
250 (dired-log-summary
255 (defun dired-do-chmod (&optional arg)
259 (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
262 (defun dired-do-chgrp (&optional arg)
267 (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
270 (defun dired-do-chown (&optional arg)
275 (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
278 (defun dired-do-touch (&optional arg)
282 (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
288 (defun dired-bunch-files (max function args files)
327 (defun dired-do-print (&optional arg)
332 (let* ((file-list (dired-get-marked-files t arg))
333 (command (dired-mark-read-string
342 (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
349 ;; If the current file was used, the list has but one element and ARG
352 (defun dired-mark-read-string (prompt initial op-symbol arg files)
356 (dired-mark-pop-up
359 (format prompt (dired-mark-prompt arg files)) initial))
362 ;;; Cleaning a directory: flagging some backups for deletion.
364 (defvar dired-file-version-alist)
367 (defun dired-clean-directory (keep)
369 Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
370 Positive prefix arg KEEP overrides `dired-kept-versions';
373 To clear the flags on these files, you can use \\[dired-flag-backup-files]
376 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
378 (late-retention (if (<= keep 0) dired-kept-versions keep))
379 (dired-file-version-alist ()))
384 ;; put on dired-file-version-alist an element of the form
386 (dired-map-dired-file-lines (function dired-collect-file-versions))
389 (let ((fval dired-file-version-alist))
402 (dired-map-dired-file-lines (function dired-trample-file-versions))
405 ;;; Subroutines of dired-clean-directory.
407 (defun dired-map-dired-file-lines (fun)
408 ;; Perform FUN with point at the end of each non-directory line.
415 (and (not (looking-at dired-re-dir))
417 (setq file (dired-get-filename nil t)) ; nil on non-file
422 (defun dired-collect-file-versions (fn)
425 (if (assoc fn dired-file-version-alist)
435 (file-name-directory fn)))
438 (setq dired-file-version-alist
440 dired-file-version-alist)))))))
442 (defun dired-trample-file-versions (fn)
448 dired-file-version-alist)) ; subversion
453 (insert dired-del-marker)))))
458 (defun dired-read-shell-command (prompt arg files)
459 ;; "Read a dired shell command prompting with PROMPT (using read-string).
463 (dired-mark-pop-up
466 (format prompt (dired-mark-prompt arg files))
472 (defun dired-do-shell-command (command &optional arg file-list)
475 the next ARG files are used. Just \\[universal-argument] means the current file.
489 significance for `dired-do-shell-command', and are passed through
497 Type \\[dired-do-redisplay] to redisplay the marked files.
499 When COMMAND runs, its working directory is the top-level directory of
505 can be produced by `dired-get-marked-files', for example."
506 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
509 (let ((files (dired-get-marked-files t current-prefix-arg)))
512 (dired-read-shell-command (concat "! on "
514 current-prefix-arg
516 current-prefix-arg
518 (let* ((on-each (not (string-match dired-star-subst-regexp command)))
519 (subst (not (string-match dired-quark-subst-regexp command)))
532 (dired-bunch-files
535 (dired-run-shell-command
536 (dired-shell-stuff-it command files t arg))))
540 (dired-run-shell-command
541 (dired-shell-stuff-it command file-list nil arg))))))
544 (defvar dired-mark-prefix ""
545 "Prepended to marked files in dired shell commands.")
546 (defvar dired-mark-postfix ""
547 "Appended to marked files in dired shell commands.")
548 (defvar dired-mark-separator " "
549 "Separates marked files in dired shell commands.")
551 (defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
560 (if (or (string-match dired-star-subst-regexp command)
561 (string-match dired-quark-subst-regexp command))
568 (lambda (x) (concat command dired-mark-separator x)))))
572 file-list dired-mark-separator)))
574 (setq files (concat dired-mark-prefix files dired-mark-postfix)))
579 (defun dired-run-shell-command (command)
581 (find-file-name-handler (directory-file-name default-directory)
585 ;; Return nil for sake of nconc in dired-bunch-files.
591 (defun dired-call-process (program discard &rest arguments)
592 ; "Run PROGRAM with output to current buffer unless DISCARD is t.
594 ;; Look for a handler for default-directory in case it is a remote file name.
596 (find-file-name-handler (directory-file-name default-directory)
597 'dired-call-process)))
598 (if handler (apply handler 'dired-call-process
602 (defun dired-check-process (msg program &rest arguments)
609 (let (err-buffer err (dir default-directory))
613 (setq err-buffer (get-buffer-create " *dired-check-process output*"))
616 (setq default-directory dir ; caller's default-directory
618 (apply (function dired-call-process) program nil arguments))))
621 (dired-log (concat program " " (prin1-to-string arguments) "\n"))
622 (dired-log err-buffer)
629 ;; Commands that delete or redisplay part of the dired buffer.
631 (defun dired-kill-line (&optional arg)
636 (setq file (dired-get-filename nil t))
640 (dired-goto-subdir file)
641 (dired-kill-subdir)))
648 (dired-move-to-filename)))
651 (defun dired-do-kill-lines (&optional arg fmt)
653 With a prefix argument, kill that many lines starting with the current line.
656 for a file that is a directory, which you have inserted in the
660 parent directory), go to its directory header line and use this
665 (if (dired-get-subdir)
666 (dired-kill-subdir)
667 (dired-kill-line arg))
672 (regexp (dired-marker-regexp)))
679 (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
682 ;;;###end dired-cmd.el
686 ;;;###begin dired-cp.el
688 (defun dired-compress ()
689 ;; Compress or uncompress the current file.
692 (from-file (dired-get-filename))
693 (new-file (dired-compress-file from-file)))
698 (dired-remove-entry new-file)
701 ;; Now replace the current line with an entry for NEW-FILE.
702 (dired-update-file-line new-file) nil)
703 (dired-log (concat "Failed to compress" from-file))
706 (defvar dired-compress-file-suffixes
729 (defun dired-compress-file (file)
733 (let ((handler (find-file-name-handler file 'dired-compress-file))
735 (suffixes dired-compress-file-suffixes))
747 (funcall handler 'dired-compress-file file))
752 (if (not (dired-check-process (concat "Uncompressing " file)
764 (not (dired-check-process (concat "Compressing " file)
776 (if (not (dired-check-process (concat "Compressing " file)
782 (defun dired-mark-confirm (op-symbol arg)
786 ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
787 ;; The files used are determined by ARG (as in dired-get-marked-files).
788 (or (eq dired-no-confirm t)
789 (memq op-symbol dired-no-confirm)
792 ;; it isn't the current line file.
793 (let ((files (dired-get-marked-files t arg nil t))
796 (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
798 (dired-mark-prompt arg files) "? ")))))
800 (defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
801 ; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
806 ; detailed error explanation using function `dired-log'.
809 ; `compress'). It is used with `dired-mark-pop-up' to prompt the user
813 ; SHOW-PROGRESS if non-nil means redisplay dired after each file."
814 (if (dired-mark-confirm op-symbol arg)
816 (dired-map-over-marks (funcall fun) arg show-progress))
824 string total (dired-plural-s total))
826 (dired-log-summary
828 (downcase string) count total (dired-plural-s total))
831 (defvar dired-query-alist
840 (defun dired-query (qs-var qs-prompt &rest qs-args)
846 (action (cdr (assoc char dired-query-alist))))
860 ;; look at the dired buffer instead of at the prompt to decide.
863 (while (not (setq elt (assoc char dired-query-alist)))
876 (defun dired-do-compress (&optional arg)
879 (dired-map-over-marks-check (function dired-compress) arg 'compress t))
883 (defun dired-byte-compile ()
885 (let* ((filename (dired-get-filename))
896 (dired-log "Byte compile error for %s:\n%s\n" filename failure)
897 (dired-make-relative filename))
898 (dired-remove-file elc-file)
900 (dired-add-file elc-file)
904 (defun dired-do-byte-compile (&optional arg)
907 (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t))
909 (defun dired-load ()
911 (let ((file (dired-get-filename)) failure)
917 (dired-log "Load error for %s:\n%s\n" file failure)
918 (dired-make-relative file))))
921 (defun dired-do-load (&optional arg)
924 (dired-map-over-marks-check (function dired-load) arg 'load t))
927 (defun dired-do-redisplay (&optional arg test-for-subdir)
933 the buffer will not reset them. However, using `dired-undo' to re-insert
935 may have to reset some subdirectory switches after a `dired-undo'.
937 \\<dired-mode-map>\\[dired-reset-subdir-switches].
941 (if (and test-for-subdir (dired-get-subdir))
942 (let* ((dir (dired-get-subdir))
943 (switches (cdr (assoc-string dir dired-switches-alist))))
944 (dired-insert-subdir
949 dired-subdir-switches
950 dired-actual-switches)))))
952 ;; message much faster than making dired-map-over-marks show progress
953 (dired-uncache
954 (if (consp dired-directory) (car dired-directory) dired-directory))
955 (dired-map-over-marks (let ((fname (dired-get-filename)))
957 (dired-update-file-line fname))
959 (dired-move-to-filename)
962 (defun dired-reset-subdir-switches ()
963 "Set `dired-switches-alist' to nil and revert dired buffer."
965 (setq dired-switches-alist nil)
969 (defun dired-update-file-line (file)
970 ;; Delete the current line, and insert an entry for FILE.
971 ;; If FILE is nil, then just delete the current line.
973 ;; here is faster than with dired-add-entry's optional arg).
974 ;; Does not update other dired buffers. Use dired-relist-entry for that.
981 (dired-add-entry file nil t)
985 (dired-move-to-filename))
988 (defun dired-add-file (filename &optional marker-char)
989 (dired-fun-in-all-buffers
990 (file-name-directory filename) (file-name-nondirectory filename)
991 (function dired-add-entry) filename marker-char))
993 (defun dired-add-entry (filename &optional marker-char relative)
995 ;; with MARKER-CHAR (a character, else dired-marker-char is used).
999 ;; And it skips "." or ".." (see `dired-trivial-filenames').
1001 (setq filename (directory-file-name filename))
1004 (cur-dir (dired-current-directory))
1006 (directory (if relative cur-dir (file-name-directory filename)))
1010 (file-relative-name filename directory)
1014 (if (string= directory cur-dir)
1018 (dired-unhide-subdir))
1021 (let ((p (dired-after-subdir-garbage cur-dir)))
1025 (if (dired-goto-subdir directory)
1028 (dired-unhide-subdir))
1032 (dired-goto-next-nontrivial-file))
1038 ;; Don't expand `.'. Show just the file name within directory.
1039 (let ((default-directory directory))
1040 (dired-insert-directory directory
1041 (concat dired-actual-switches "d")
1046 (let ((dired-marker-char
1047 (if (integerp marker-char) marker-char dired-marker-char)))
1048 (dired-mark nil)))
1054 (let ((inserted-name (dired-get-filename 'verbatim)))
1055 (if (file-name-directory inserted-name)
1067 (if dired-after-readin-hook ;; the subdir-alist is not affected...
1073 (run-hooks 'dired-after-readin-hook))))
1074 (dired-move-to-filename))
1081 (defun dired-after-subdir-garbage (dir)
1088 (or (dired-goto-subdir dir) (error "This cannot happen"))
1091 (not (dired-move-to-filename)))
1096 (defun dired-remove-file (file)
1097 (dired-fun-in-all-buffers
1098 (file-name-directory file) (file-name-nondirectory file)
1099 (function dired-remove-entry) file))
1101 (defun dired-remove-entry (file)
1103 (and (dired-goto-file file)
1109 (defun dired-relist-file (file)
1111 (dired-fun-in-all-buffers (file-name-directory file)
1113 (function dired-relist-entry) file))
1115 (defun dired-relist-entry (file)
1123 (and (dired-goto-file file)
1128 (setq file (directory-file-name file))
1129 (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
1134 (defcustom dired-backup-overwrite nil
1140 :group 'dired)
1142 (defvar dired-overwrite-confirmed)
1144 (defun dired-handle-overwrite (to)
1146 ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
1147 ;; from dired-create-files.
1149 (if (and dired-backup-overwrite
1150 dired-overwrite-confirmed
1152 (or (eq 'always dired-backup-overwrite)
1153 (dired-query 'overwrite-backup-query
1158 (dired-relist-entry backup)))))
1161 (defun dired-copy-file (from to ok-flag)
1162 (dired-handle-overwrite to)
1163 (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
1164 dired-recursive-copies))
1166 (defun dired-copy-file-recursive (from to ok-flag &optional
1174 ;; This is a directory.
1177 (directory-files from nil dired-re-no-dot)
1179 (push (dired-make-relative from)
1180 dired-create-files-failures)
1181 (dired-log "Copying error for %s:\n%s\n" from err)
1187 (or top (dired-handle-overwrite to))
1189 (make-directory to)
1191 (push (dired-make-relative from)
1192 dired-create-files-failures)
1194 (dired-log "Copying error for %s:\n%s\n" from err)))))
1198 ;; Catch errors copying within a directory,
1199 ;; and report them through the dired log mechanism
1202 (dired-copy-file-recursive
1206 (push (dired-make-relative thisfrom)
1207 dired-create-files-failures)
1208 (dired-log "Copying error for %s:\n%s\n" thisfrom err))))))
1209 ;; Not a directory.
1210 (or top (dired-handle-overwrite to))
1215 (copy-file from to ok-flag dired-copy-preserve-time))
1217 (push (dired-make-relative from)
1218 dired-create-files-failures)
1219 (dired-log "Can't set date on %s:\n%s\n" from err))))))
1222 (defun dired-rename-file (file newname ok-if-already-exists)
1223 (dired-handle-overwrite newname)
1227 (with-current-buffer (get-file-buffer file)
1229 (dired-remove-file file)
1231 (dired-rename-subdir file newname))
1233 (defun dired-rename-subdir (from-dir to-dir)
1234 (setq from-dir (file-name-as-directory from-dir)
1235 to-dir (file-name-as-directory to-dir))
1236 (dired-fun-in-all-buffers from-dir nil
1237 (function dired-rename-subdir-1) from-dir to-dir)
1245 (dired-in-this-tree buffer-file-name expanded-from-dir))
1247 (to-file (dired-replace-in-string
1255 (defun dired-rename-subdir-1 (dir to)
1256 ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
1259 (alist dired-subdir-alist)
1264 (if (dired-in-this-tree (car elt) expanded-dir)
1266 (dired-rename-subdir-2 elt dir to)))
1267 (if (equal dir default-directory)
1268 ;; if top level directory was renamed, lots of things have to be
1271 (dired-unadvertise dir) ; we no longer dired DIR...
1272 (setq default-directory to
1273 dired-directory (expand-file-name;; this is correct
1275 (file-name-nondirectory dired-directory)
1278 (directory-file-name dired-directory))))
1283 ;; ... we dired TO now:
1284 (dired-advertise)))))
1286 (defun dired-rename-subdir-2 (elt dir to)
1287 ;; Update the headerline and dired-subdir-alist element, as well as
1288 ;; dired-switches-alist element, of directory described by
1292 (let ((regexp (regexp-quote (directory-file-name dir)))
1293 (newtext (directory-file-name to))
1295 (goto-char (dired-get-subdir-min elt))
1297 (if (not (looking-at dired-subdir-regexp))
1298 (error "%s not found where expected - dired-subdir-alist broken?"
1304 ;; Update buffer-local dired-subdir-alist and dired-switches-alist
1305 (let ((cons (assoc-string (car elt) dired-switches-alist))
1306 (cur-dir (dired-normalize-subdir
1307 (dired-replace-in-string regexp newtext (car elt)))))
1313 (defun dired-create-files (file-creator operation fn-list name-constructor
1317 ;; is queried, dired buffers are updated, and at the end a success or
1325 ;; rename), it is FILE-CREATOR's responsibility to update dired
1336 ;; query, it is supposed to tell why (using dired-log).
1339 ;; newfile's entry, or t to use the current marker character if the
1342 (let (dired-create-files-failures failures
1345 overwrite-backup-query) ; for dired-handle-overwrite
1353 (dired-log "Cannot %s to same file: %s\n"
1356 (setq skipped (cons (dired-make-relative from) skipped))
1358 (dired-overwrite-confirmed ; for dired-handle-overwrite
1365 (dired-query 'overwrite-query
1371 (marker-char (dired-file-marker from)) ; slow
1375 (funcall file-creator from to dired-overwrite-confirmed)
1380 (dired-remove-file to))
1383 (dired-add-file to actual-marker-char))
1386 (push (dired-make-relative from)
1388 (dired-log "%s `%s' to `%s' failed:\n%s\n"
1392 (dired-create-files-failures
1393 (setq failures (nconc failures dired-create-files-failures))
1394 (dired-log-summary
1397 (dired-plural-s (length failures))
1401 (dired-log-summary
1404 total (dired-plural-s total))
1407 (dired-log-summary
1410 (dired-plural-s total))
1414 operation success-count (dired-plural-s success-count)))))
1415 (dired-move-to-filename))
1418 (defun dired-do-create-files (op-symbol file-creator operation arg
1422 Prompts user for target, which is a directory in which to create
1424 file exists. The way the default for the target directory is
1425 computed depends on the value of `dired-dwim-target-directory'.
1426 OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
1428 FILE-CREATOR and OPERATION as in `dired-create-files'.
1429 ARG as in `dired-get-marked-files'.
1430 Optional arg MARKER-CHAR as in `dired-create-files'.
1435 If into-dir is set to nil then target is not regarded as a directory,
1438 directory (e.g. some sort of archive). The first element of into-dir
1445 Else into-dir is not a list. Target is a directory.
1446 The marked file(s) are created inside the target directory.
1449 target is a directory and otherwise to nil.
1453 variable. The function `dired-into-dir-with-symlinks' is provided
1456 (as `file-directory-p' would if HOW-TO had been nil)."
1458 (let* ((fn-list (dired-get-marked-files nil arg))
1459 (rfn-list (mapcar (function dired-make-relative) fn-list))
1460 (dired-one-file ; fluid variable inside dired-create-files
1462 (target-dir (dired-dwim-target-directory))
1463 (default (and dired-one-file
1466 (target (expand-file-name ; fluid variable inside dired-create-files
1467 (dired-mark-read-file-name
1468 (concat (if dired-one-file op1 operation) " %s to: ")
1472 ;; case of a directory. If we don't test these
1473 ;; conditions up front, file-directory-p below
1479 dired-one-file
1488 (file-directory-p target)))
1493 (if (not (or dired-one-file into-dir))
1494 (error "Marked %s: target must be a directory: %s" operation target))
1496 (or into-dir (setq target (directory-file-name target)))
1497 (dired-create-files
1499 (if into-dir ; target is a directory
1501 ;; inside dired-create-files:
1512 ;; If the current file was used, the list has but one element and ARG
1515 ;; if it is omitted or nil, then the name of the directory is used.
1517 (defun dired-mark-read-file-name (prompt dir op-symbol arg files
1519 (dired-mark-pop-up
1522 (format prompt (dired-mark-prompt arg files)) dir default))
1524 (defun dired-dwim-target-directory ()
1525 ;; Try to guess which target directory the user may want.
1526 ;; If there is a dired buffer displayed in the next window, use
1527 ;; its current subdir, else use current subdir of this dired buffer.
1528 (let ((this-dir (and (eq major-mode 'dired-mode)
1529 (dired-current-directory))))
1530 ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
1531 (if dired-dwim-target
1535 (and (eq major-mode 'dired-mode)
1536 (dired-current-directory)))))
1542 (defun dired-create-directory (directory)
1543 "Create a directory called DIRECTORY."
1545 (list (read-file-name "Create directory: " (dired-current-directory))))
1546 (let ((expanded (directory-file-name (expand-file-name directory))))
1547 (make-directory expanded)
1548 (dired-add-file expanded)
1549 (dired-move-to-filename)))
1551 (defun dired-into-dir-with-symlinks (target)
1552 (and (file-directory-p target)
1555 ;; home directory and it happens to be a symbolic link, as is often the
1561 ;; dired-do-symlink, which has the minor disadvantage of
1567 (defvar dired-copy-how-to-fn nil
1568 "nil or a function used by `dired-do-copy' to determine target.
1569 See HOW-TO argument for `dired-do-create-files'.")
1572 (defun dired-do-copy (&optional arg)
1573 "Copy all marked (or next ARG) files, or copy the current file.
1575 When operating on just the current file, you specify the new name.
1576 When operating on multiple or marked files, you specify a directory,
1577 and new copies of these files are made in that directory
1579 suggested for the target directory depends on the value of
1580 `dired-dwim-target', which see.
1585 (let ((dired-recursive-copies dired-recursive-copies))
1586 (dired-do-create-files 'copy (function dired-copy-file)
1588 arg dired-keep-marker-copy
1589 nil dired-copy-how-to-fn)))
1592 (defun dired-do-symlink (&optional arg)
1593 "Make symbolic links to current file or all marked (or next ARG) files.
1594 When operating on just the current file, you specify the new name.
1595 When operating on multiple or marked files, you specify a directory
1596 and new symbolic links are made in that directory
1598 suggested for the target directory depends on the value of
1599 `dired-dwim-target', which see.
1601 For relative symlinks, use \\[dired-do-relsymlink]."
1603 (dired-do-create-files 'symlink (function make-symbolic-link)
1604 "Symlink" arg dired-keep-marker-symlink))
1607 (defun dired-do-hardlink (&optional arg)
1608 "Add names (hard links) current file or all marked (or next ARG) files.
1609 When operating on just the current file, you specify the new name.
1610 When operating on multiple or marked files, you specify a directory
1611 and new hard links are made in that directory
1613 suggested for the target directory depends on the value of
1614 `dired-dwim-target', which see."
1616 (dired-do-create-files 'hardlink (function dired-hardlink)
1617 "Hardlink" arg dired-keep-marker-hardlink))
1619 (defun dired-hardlink (file newname &optional ok-if-already-exists)
1620 (dired-handle-overwrite newname)
1624 (dired-relist-file file))
1627 (defun dired-do-rename (&optional arg)
1628 "Rename current file or all marked (or next ARG) files.
1629 When renaming just the current file, you specify the new name.
1630 When renaming multiple or marked files, you specify a directory.
1632 The default suggested for the target directory depends on the value
1633 of `dired-dwim-target', which see."
1635 (dired-do-create-files 'move (function dired-rename-file)
1636 "Move" arg dired-keep-marker-rename "Rename"))
1637 ;;;###end dired-cp.el
1641 ;;;###begin dired-re.el
1642 (defun dired-do-create-files-regexp
1645 ;; FILE-CREATOR and OPERATION as in dired-create-files.
1646 ;; ARG as in dired-get-marked-files.
1650 ;; instead of only the non-directory part of the file.
1651 ;; Optional arg MARKER-CHAR as in dired-create-files.
1652 (let* ((fn-list (dired-get-marked-files nil arg))
1665 (let ((to (dired-string-replace-match regexp from newname))
1667 ;; dired-query
1670 (and (dired-query 'rename-regexp-query
1675 (dired-log "%s: %s did not match regexp %s\n"
1677 ;; not whole-name, replace non-directory part only
1680 (let* ((new (dired-string-replace-match
1684 (file-name-directory from))))
1687 (and (dired-query 'rename-regexp-query
1689 (dired-make-relative from)
1690 (dired-make-relative to))
1692 (dired-log "%s: %s did not match regexp %s\n"
1695 (dired-create-files
1698 (defun dired-mark-read-regexp (operation)
1702 (equal 0 (prefix-numeric-value current-prefix-arg)))
1704 (if whole-name nil current-prefix-arg))
1706 (dired-read-regexp
1714 (defun dired-do-rename-regexp (regexp newname &optional arg whole-name)
1718 files. Otherwise, it operates on all the marked files, or the current
1727 Normally, only the non-directory part of the file name is used and changed."
1728 (interactive (dired-mark-read-regexp "Rename"))
1729 (dired-do-create-files-regexp
1730 (function dired-rename-file)
1731 "Rename" arg regexp newname whole-name dired-keep-marker-rename))
1734 (defun dired-do-copy-regexp (regexp newname &optional arg whole-name)
1736 See function `dired-do-rename-regexp' for more info."
1737 (interactive (dired-mark-read-regexp "Copy"))
1738 (let ((dired-recursive-copies nil)) ; No recursive copies.
1739 (dired-do-create-files-regexp
1740 (function dired-copy-file)
1741 (if dired-copy-preserve-time "Copy [-p]" "Copy")
1742 arg regexp newname whole-name dired-keep-marker-copy)))
1745 (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name)
1747 See function `dired-do-rename-regexp' for more info."
1748 (interactive (dired-mark-read-regexp "HardLink"))
1749 (dired-do-create-files-regexp
1751 "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
1754 (defun dired-do-symlink-regexp (regexp newname &optional arg whole-name)
1756 See function `dired-do-rename-regexp' for more info."
1757 (interactive (dired-mark-read-regexp "SymLink"))
1758 (dired-do-create-files-regexp
1760 "SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
1762 (defun dired-create-files-non-directory
1764 ;; Perform FILE-CREATOR on the non-directory part of marked files
1766 ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
1767 (let (rename-non-directory-query)
1768 (dired-create-files
1771 (dired-get-marked-files nil arg)
1774 (let ((to (concat (file-name-directory from)
1782 (dired-query 'rename-non-directory-query
1784 (dired-make-relative from)
1785 (dired-make-relative to)))
1787 dired-keep-marker-rename)))
1789 (defun dired-rename-non-directory (basename-constructor operation arg)
1790 (dired-create-files-non-directory
1791 (function dired-rename-file)
1795 (defun dired-upcase (&optional arg)
1798 (dired-rename-non-directory (function upcase) "Rename upcase" arg))
1801 (defun dired-downcase (&optional arg)
1804 (dired-rename-non-directory (function downcase) "Rename downcase" arg))
1806 ;;;###end dired-re.el
1810 ;;;###begin dired-ins.el
1813 (defun dired-maybe-insert-subdir (dirname &optional
1815 "Insert this subdirectory into the same dired buffer.
1816 If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
1824 the buffer will not reset them. However, using `dired-undo' to re-insert
1826 may have to reset some subdirectory switches after a `dired-undo'.
1828 \\<dired-mode-map>\\[dired-reset-subdir-switches].
1831 (list (dired-get-filename)
1832 (if current-prefix-arg
1834 (or dired-subdir-switches dired-actual-switches)))))
1838 (setq dirname (file-name-as-directory dirname))
1840 (dired-goto-subdir dirname))
1841 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
1847 (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
1848 "Insert this subdirectory into the same dired buffer.
1856 ;; Prospero where dired-ls does the right thing, but
1857 ;; file-directory-p has not been redefined.
1859 (list (dired-get-filename)
1860 (if current-prefix-arg
1862 (or dired-subdir-switches dired-actual-switches)))))
1863 (setq dirname (file-name-as-directory (expand-file-name dirname)))
1865 (file-directory-p dirname)
1866 (error "Attempt to insert a non-directory: %s" dirname))
1867 (let ((elt (assoc dirname dired-subdir-alist))
1868 (cons (assoc-string dirname dired-switches-alist))
1873 (dired-insert-subdir-validate dirname switches)
1877 (setq mark-alist (dired-kill-tree dirname t)))
1880 (setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
1881 (dired-insert-subdir-newpos dirname)) ; else compute new position
1882 (dired-insert-subdir-doupdate
1883 dirname elt (dired-insert-subdir-doinsert dirname switches))
1887 (push (cons dirname switches) dired-switches-alist)))
1889 (dired-build-subdir-alist switches)
1890 (setq switches (dired-replace-in-string "R" "" switches))
1891 (dolist (cur-ass dired-subdir-alist)
1893 (and (dired-in-this-tree cur-dir dirname)
1894 (let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
1897 (push (cons cur-dir switches) dired-switches-alist)))))))
1898 (dired-initial-position dirname)
1899 (save-excursion (dired-mark-remembered mark-alist))
1902 ;; This is a separate function for dired-vms.
1903 (defun dired-insert-subdir-validate (dirname &optional switches)
1906 (or (dired-in-this-tree dirname (expand-file-name default-directory))
1907 (error "%s: not in this directory tree" dirname))
1908 (let ((real-switches (or switches dired-subdir-switches)))
1915 (null (string-match x dired-actual-switches)))
1918 ;; all switches that make a difference to dired-get-filename:
1921 (defun dired-alist-add (dir new-marker)
1923 (dired-alist-add-1 dir new-marker)
1924 (dired-alist-sort))
1926 (defun dired-alist-sort ()
1928 (setq dired-subdir-alist
1929 (sort dired-subdir-alist
1931 (> (dired-get-subdir-min elt1)
1932 (dired-get-subdir-min elt2)))))))
1934 (defun dired-kill-tree (dirname &optional remember-marks kill-root)
1941 (interactive "DKill tree below directory: \ni\nP")
1942 (setq dirname (file-name-as-directory (expand-file-name dirname)))
1943 (let ((s-alist dired-subdir-alist) dir m-alist)
1948 (dired-in-this-tree dir dirname)
1949 (dired-goto-subdir dir)
1950 (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
1953 (defun dired-insert-subdir-newpos (new-dir)
1956 (let ((alist dired-subdir-alist) elt dir pos new-pos)
1961 pos (dired-get-subdir-min elt))
1962 (if (dired-tree-lessp dir new-dir)
1964 (setq new-pos (dired-get-subdir-max elt)
1973 (defun dired-insert-subdir-del (element)
1976 (let ((begin-marker (dired-get-subdir-min element)))
1979 (goto-char (dired-subdir-max))
1983 (dired-remember-marks begin-marker (point))
1986 (defun dired-insert-subdir-doinsert (dirname switches)
1991 (let ((dired-actual-switches
1993 dired-subdir-switches
1994 (dired-replace-in-string "R" "" dired-actual-switches))))
1995 (if (equal dirname (car (car (last dired-subdir-alist))))
1996 ;; If doing the top level directory of the buffer,
1997 ;; redo it as specified in dired-directory.
1998 (dired-readin-insert)
1999 (dired-insert-directory dirname dired-actual-switches nil nil t)))
2002 (defun dired-insert-subdir-doupdate (dirname elt beg-end)
2007 (set-marker (dired-get-subdir-min elt) (point-marker))
2008 (dired-alist-add dirname (point-marker)))
2010 ;; inserted subdir, so run it after dired-alist-add:
2011 (if dired-after-readin-hook
2020 (run-hooks 'dired-after-readin-hook))))))
2022 (defun dired-tree-lessp (dir1 dir2)
2030 ;; if dired-actual-switches contained `t'.
2031 (setq dir1 (file-name-as-directory dir1)
2032 dir2 (file-name-as-directory dir2))
2033 (let ((components-1 (dired-split "/" dir1))
2034 (components-2 (dired-split "/" dir2)))
2054 (defun dired-split (pat str &optional limit)
2060 (mapconcat 'identity (dired-split SEP STRING) SEP)
2088 (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
2093 (list (if current-prefix-arg
2094 (prefix-numeric-value current-prefix-arg)
2096 (if (dired-get-subdir) 1 0))))
2097 (dired-next-subdir (- arg) no-error-if-not-found no-skip))
2099 (defun dired-subdir-min ()
2101 (if (not (dired-prev-subdir 0 t t))
2106 (defun dired-goto-subdir (dir)
2107 "Go to end of header line of DIR in this dired buffer.
2113 (completing-read "Goto in situ directory: " ; prompt
2114 dired-subdir-alist ; table
2117 (dired-current-directory))))
2119 (setq dir (file-name-as-directory dir))
2120 (let ((elt (assoc dir dired-subdir-alist)))
2122 (goto-char (dired-get-subdir-min elt))
2123 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
2130 (defun dired-mark-subdir-files ()
2131 "Mark all files except `.' and `..' in current subdirectory.
2135 (let ((p-min (dired-subdir-min)))
2136 (dired-mark-files-in-region p-min (dired-subdir-max))))
2139 (defun dired-kill-subdir (&optional remember-marks)
2140 "Remove all lines of current subdirectory.
2144 (let* ((beg (dired-subdir-min))
2145 (end (dired-subdir-max))
2147 (cur-dir (dired-current-directory))
2148 (cons (assoc-string cur-dir dired-switches-alist))
2150 (if (equal cur-dir default-directory)
2151 (error "Attempt to kill top level directory"))
2153 (if remember-marks (dired-remember-marks beg end))
2157 (dired-unsubdir cur-dir)
2159 (setq dired-switches-alist (delete cons dired-switches-alist)))
2162 (defun dired-unsubdir (dir)
2164 (setq dired-subdir-alist
2165 (delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
2168 (defun dired-tree-up (arg)
2169 "Go up ARG levels in the dired tree."
2171 (let ((dir (dired-current-directory)))
2174 dir (file-name-directory (directory-file-name dir))))
2176 (or (dired-goto-subdir dir)
2180 (defun dired-tree-down ()
2181 "Go down in the dired tree."
2183 (let ((dir (dired-current-directory)) ; has slash
2185 (let ((rest (reverse dired-subdir-alist)) elt)
2189 (if (dired-in-this-tree (directory-file-name (car elt)) dir)
2191 pos (dired-goto-subdir (car elt))))))
2199 (defun dired-unhide-subdir ()
2201 (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
2203 (defun dired-hide-check ()
2207 (defun dired-subdir-hidden-p (dir)
2210 (dired-goto-subdir dir)
2214 (defun dired-hide-subdir (arg)
2215 "Hide or unhide the current subdirectory and move to next directory.
2217 Use \\[dired-hide-all] to (un)hide all directories."
2219 (dired-hide-check)
2222 (let* ((cur-dir (dired-current-directory))
2223 (hidden-p (dired-subdir-hidden-p cur-dir))
2224 (elt (assoc cur-dir dired-subdir-alist))
2225 (end-pos (1- (dired-get-subdir-max elt)))
2228 (goto-char (dired-get-subdir-min elt))
2233 (dired-next-subdir 1 t))
2237 (defun dired-hide-all (arg)
2240 Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
2242 (dired-hide-check)
2251 (let ((pos (point-max)) ; pos of end of last directory
2252 (alist dired-subdir-alist))
2254 (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
2256 (goto-char pos) ; current dir
2257 ;; we're somewhere on current dir's line
2261 (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
2265 ;;;###end dired-ins.el
2272 (defun dired-do-search (regexp)
2277 (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
2280 (defun dired-do-query-replace-regexp (from to &optional delimited)
2290 (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
2292 (if (and buffer (with-current-buffer buffer
2296 '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
2298 (defun dired-nondirectory-p (file)
2299 (not (file-directory-p file)))
2303 (defun dired-show-file-type (file &optional deref-symlinks)
2307 (interactive (list (dired-get-filename t) current-prefix-arg))
2316 (provide 'dired-aux)
2319 ;;; dired-aux.el ends here