• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.9.5/emacs-92/emacs/lisp/

Lines Matching +defs:dired +defs:do +defs:compress

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)))))
68 (and (not (equal (dired-dwim-target-directory)
69 (dired-current-directory)))
79 (dired-current-directory)
80 (dired-dwim-target-directory))
87 (diff file (dired-get-filename t) switches))
90 (defun dired-backup-diff (&optional switches)
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.
121 where 1 refers to attribute of file in the current dired buffer
122 and 2 to attribute of file in second dired buffer.
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)
211 (defun dired-touch-initial (files)
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))))
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))
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)
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)
424 ;; Only do work if this file is not already in the alist.
425 (if (assoc fn dired-file-version-alist)
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)
489 significance for `dired-do-shell-command', and are passed through
497 Type \\[dired-do-redisplay] to redisplay the marked files.
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 "
518 (let* ((on-each (not (string-match dired-star-subst-regexp command)))
519 (subst (not (string-match dired-quark-subst-regexp command)))
527 (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
529 (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
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)
557 ;; (coming from interactive P and currently ignored) to decide what to do.
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)
585 ;; Return nil for sake of nconc in dired-bunch-files.
591 (defun dired-call-process (program discard &rest arguments)
597 'dired-call-process)))
598 (if handler (apply handler 'dired-call-process
602 (defun dired-check-process (msg program &rest arguments)
613 (setq err-buffer (get-buffer-create " *dired-check-process output*"))
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)
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 ()
692 (from-file (dired-get-filename))
693 (new-file (dired-compress-file from-file)))
698 (dired-remove-entry 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)
756 ;;; We don't recognize the file as compressed, so compress it.
757 ;;; Try gzip; if we don't have that, use compress.
762 (format "File %s already exists. Really compress? "
764 (not (dired-check-process (concat "Compressing " file)
776 (if (not (dired-check-process (concat "Compressing " file)
777 "compress" "-f" file))
778 ;; Don't use NEWNAME with `compress'.
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)
793 (let ((files (dired-get-marked-files t arg nil t))
794 (string (if (eq op-symbol 'compress) "Compress or uncompress"
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
811 ; `Failed to compress 1 of 2 files - type W to see why ("foo")')
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))
820 (string (if (eq op-symbol 'compress) "Compress or uncompress"
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)
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
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').
1004 (cur-dir (dired-current-directory))
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))
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)))
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
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)
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
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))
1191 (push (dired-make-relative from)
1192 dired-create-files-failures)
1194 (dired-log "Copying error for %s:\n%s\n" from err)))))
1199 ;; and report them through the dired log mechanism
1200 ;; just as our caller will do for the top level files.
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))))))
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)
1229 (dired-remove-file file)
1231 (dired-rename-subdir file newname))
1233 (defun dired-rename-subdir (from-dir 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)))
1271 (dired-unadvertise dir) ; we no longer dired DIR...
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
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).
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
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'.
1453 variable. The function `dired-into-dir-with-symlinks' is provided
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: ")
1479 dired-one-file
1493 (if (not (or dired-one-file into-dir))
1495 ;; rename-file bombs when moving directories unless we do this:
1497 (dired-create-files
1501 ;; inside dired-create-files:
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 ()
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)
1545 (list (read-file-name "Create directory: " (dired-current-directory))))
1548 (dired-add-file expanded)
1549 (dired-move-to-filename)))
1551 (defun dired-into-dir-with-symlinks (target)
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)
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)
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)
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)
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.
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"
1680 (let* ((new (dired-string-replace-match
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)
1706 (dired-read-regexp
1714 (defun dired-do-rename-regexp (regexp newname &optional arg whole-name)
1722 what to do with it. For directions, type \\[help-command] at that time.
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
1766 ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
1768 (dired-create-files
1771 (dired-get-marked-files nil arg)
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)
1834 (or dired-subdir-switches dired-actual-switches)))))
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
1859 (list (dired-get-filename)
1862 (or dired-subdir-switches dired-actual-switches)))))
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))
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)
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))))
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'.
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)
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.
2114 dired-subdir-alist ; table
2117 (dired-current-directory))))
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 ()
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)
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))
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)))
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)
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)
2252 (alist dired-subdir-alist))
2254 (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
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))
2296 '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
2298 (defun dired-nondirectory-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