annotate lisp/dired-aux.el @ 17846:c427501449a1

(display_text_line): Move the code to fill out the line with the newline's face to the end of the newline code. Add changes (commented out) to record ellipsis positions in charstarts.
author Richard M. Stallman <rms@gnu.org>
date Fri, 16 May 1997 07:32:59 +0000
parents 6d8fecd12940
children 727cf56647a4
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
10213
dd2102e33b29 (dired-string-replace-match): Moved to dired.el.
Richard M. Stallman <rms@gnu.org>
parents: 9978
diff changeset
1 ;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
7300
cc7cd83ccf3f Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 7030
diff changeset
3 ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 807
diff changeset
4
794
2598c08c91c2 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 724
diff changeset
5 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 794
diff changeset
6
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 794
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; any later version.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; GNU General Public License for more details.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
22 ;; Boston, MA 02111-1307, USA.
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
794
2598c08c91c2 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 724
diff changeset
24 ;;; Commentary:
2598c08c91c2 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 724
diff changeset
25
2307
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2229
diff changeset
26 ;; The parts of dired mode not normally used. This is a space-saving hack
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2229
diff changeset
27 ;; to avoid having to load a large mode when all that's wanted are a few
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2229
diff changeset
28 ;; functions.
10e417efb12a Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2229
diff changeset
29
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;; Rewritten in 1990/1991 to add tree features, file marking and
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;; Finished up by rms in 1992.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33
794
2598c08c91c2 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 724
diff changeset
34 ;;; Code:
2598c08c91c2 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 724
diff changeset
35
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
36 ;; We need macros in dired.el to compile properly.
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
37 (eval-when-compile (require 'dired))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
38
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;;; 15K
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;;;###begin dired-cmd.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 ;; Diffing and compressing
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 (defun dired-diff (file &optional switches)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 "Compare file at point with file FILE using `diff'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 FILE defaults to the file at the mark.
4478
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
47 The prompted-for file is the first file given to `diff'.
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
48 With prefix arg, prompt for second argument SWITCHES,
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
49 which is options for `diff'."
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 (interactive
3950
6e13c3b03b67 * dired-aux.el (dired-diff): Work even when the mark is inactive.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
51 (let ((default (if (mark t)
6e13c3b03b67 * dired-aux.el (dired-diff): Work even when the mark is inactive.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
52 (save-excursion (goto-char (mark t))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (dired-get-filename t t)))))
5144
9083db1526b4 (dired-diff): Require diff.
Richard M. Stallman <rms@gnu.org>
parents: 4580
diff changeset
54 (require 'diff)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (list (read-file-name (format "Diff %s with: %s"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (dired-get-filename t)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (if default
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (concat "(default " default ") ")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ""))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (dired-current-directory) default t)
4478
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
61 (if current-prefix-arg
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
62 (read-string "Options for diff: "
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
63 (if (stringp diff-switches)
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
64 diff-switches
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
65 (mapconcat 'identity diff-switches " ")))))))
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
66 (diff file (dired-get-filename t) switches))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (defun dired-backup-diff (&optional switches)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 "Diff this file with its backup file or vice versa.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 Uses the latest backup, if there are several numerical backups.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 If this file is a backup, diff it with its original.
4478
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
73 The backup file is the first file given to `diff'.
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
74 With prefix arg, prompt for argument SWITCHES which is options for `diff'."
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
75 (interactive
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
76 (if current-prefix-arg
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
77 (list (read-string "Options for diff: "
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
78 (if (stringp diff-switches)
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
79 diff-switches
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
80 (mapconcat 'identity diff-switches " "))))
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
81 nil))
f25a821aefb0 (dired-diff): Read options right here;
Richard M. Stallman <rms@gnu.org>
parents: 3950
diff changeset
82 (diff-backup (dired-get-filename) switches))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (defun dired-do-chxxx (attribute-name program op-symbol arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 ;; Change file attributes (mode, group, owner) of marked files and
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 ;; refresh their file lines.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 ;; PROGRAM is the program used to change the attribute.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 ;; ARG describes which files to use, as in dired-get-marked-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 (let* ((files (dired-get-marked-files t arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 (new-attribute
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 (dired-mark-read-string
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (concat "Change " attribute-name " of %s to: ")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 nil op-symbol arg files))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (operation (concat program " " new-attribute))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 failures)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (setq failures
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (dired-bunch-files 10000
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (function dired-check-process)
16808
aac35896dd04 (dired-do-chxxx): Use -- only on GNU systems.
Richard M. Stallman <rms@gnu.org>
parents: 16791
diff changeset
101 (append
aac35896dd04 (dired-do-chxxx): Use -- only on GNU systems.
Richard M. Stallman <rms@gnu.org>
parents: 16791
diff changeset
102 (list operation program new-attribute)
aac35896dd04 (dired-do-chxxx): Use -- only on GNU systems.
Richard M. Stallman <rms@gnu.org>
parents: 16791
diff changeset
103 (if (string-match "gnu" system-configuration)
aac35896dd04 (dired-do-chxxx): Use -- only on GNU systems.
Richard M. Stallman <rms@gnu.org>
parents: 16791
diff changeset
104 '("--") nil))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 files))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 (dired-do-redisplay arg);; moves point if ARG is an integer
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (if failures
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 (dired-log-summary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (format "%s: error" operation)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 nil))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (defun dired-do-chmod (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 "Change the mode of the marked (or next ARG) files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 This calls chmod, thus symbolic modes like `g+w' are allowed."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (interactive "P")
11395
a3c6991e86b4 * dired-aux.el (dired-do-chmod): Use dired-chmod-program.
Karl Heuer <kwzh@gnu.org>
parents: 11158
diff changeset
117 (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (defun dired-do-chgrp (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 "Change the group of the marked (or next ARG) files."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (interactive "P")
11395
a3c6991e86b4 * dired-aux.el (dired-do-chmod): Use dired-chmod-program.
Karl Heuer <kwzh@gnu.org>
parents: 11158
diff changeset
123 (if (memq system-type '(ms-dos windows-nt))
a3c6991e86b4 * dired-aux.el (dired-do-chmod): Use dired-chmod-program.
Karl Heuer <kwzh@gnu.org>
parents: 11158
diff changeset
124 (error "chgrp not supported on this system."))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 (defun dired-do-chown (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 "Change the owner of the marked (or next ARG) files."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (interactive "P")
11395
a3c6991e86b4 * dired-aux.el (dired-do-chmod): Use dired-chmod-program.
Karl Heuer <kwzh@gnu.org>
parents: 11158
diff changeset
131 (if (memq system-type '(ms-dos windows-nt))
a3c6991e86b4 * dired-aux.el (dired-do-chmod): Use dired-chmod-program.
Karl Heuer <kwzh@gnu.org>
parents: 11158
diff changeset
132 (error "chown not supported on this system."))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 ;; Process all the files in FILES in batches of a convenient size,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 ;; Batches are chosen to need less than MAX chars for the file names,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 ;; allowing 3 extra characters of separator per file name.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (defun dired-bunch-files (max function args files)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (let (pending
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (pending-length 0)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 failures)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 ;; Accumulate files as long as they fit in MAX chars,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 ;; then process the ones accumulated so far.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 (while files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (let* ((thisfile (car files))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (thislength (+ (length thisfile) 3))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (rest (cdr files)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 ;; If we have at least 1 pending file
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 ;; and this file won't fit in the length limit, process now.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (if (and pending (> (+ thislength pending-length) max))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 (setq failures
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
153 (nconc (apply function (append args pending))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 failures)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 pending nil
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 pending-length 0))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 ;; Do (setq pending (cons thisfile pending))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 ;; but reuse the cons that was in `files'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (setcdr files pending)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 (setq pending files)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 (setq pending-length (+ thislength pending-length))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (setq files rest)))
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
163 (nconc (apply function (append args pending))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 failures)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (defun dired-do-print (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 "Print the marked (or next ARG) files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 Uses the shell command coming from variables `lpr-command' and
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 `lpr-switches' as default."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (let* ((file-list (dired-get-marked-files t arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (command (dired-mark-read-string
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 "Print %s with: "
10982
e5942b624f45 (dired-do-print): Allow lpr-switches to be a string. Clean up.
Richard M. Stallman <rms@gnu.org>
parents: 10213
diff changeset
175 (mapconcat 'identity
e5942b624f45 (dired-do-print): Allow lpr-switches to be a string. Clean up.
Richard M. Stallman <rms@gnu.org>
parents: 10213
diff changeset
176 (cons lpr-command
e5942b624f45 (dired-do-print): Allow lpr-switches to be a string. Clean up.
Richard M. Stallman <rms@gnu.org>
parents: 10213
diff changeset
177 (if (stringp lpr-switches)
e5942b624f45 (dired-do-print): Allow lpr-switches to be a string. Clean up.
Richard M. Stallman <rms@gnu.org>
parents: 10213
diff changeset
178 (list lpr-switches)
e5942b624f45 (dired-do-print): Allow lpr-switches to be a string. Clean up.
Richard M. Stallman <rms@gnu.org>
parents: 10213
diff changeset
179 lpr-switches))
e5942b624f45 (dired-do-print): Allow lpr-switches to be a string. Clean up.
Richard M. Stallman <rms@gnu.org>
parents: 10213
diff changeset
180 " ")
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 'print arg file-list)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 ;; Read arguments for a marked-files command that wants a string
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 ;; that is not a file name,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 ;; perhaps popping up the list of marked files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 ;; ARG is the prefix arg and indicates whether the files came from
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 ;; marks (ARG=nil) or a repeat factor (integerp ARG).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 ;; If the current file was used, the list has but one element and ARG
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (defun dired-mark-read-string (prompt initial op-symbol arg files)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 ;; PROMPT for a string, with INITIAL input.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 ;; Other args are used to give user feedback and pop-up:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 ;; OP-SYMBOL of command, prefix ARG, marked FILES.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (dired-mark-pop-up
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 nil op-symbol files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (function read-string)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (format prompt (dired-mark-prompt arg files)) initial))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200
890
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
201 ;;; Cleaning a directory: flagging some backups for deletion.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
202
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
203 (defvar dired-file-version-alist)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
204
890
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
205 (defun dired-clean-directory (keep)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
206 "Flag numerical backups for deletion.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
207 Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
208 Positive prefix arg KEEP overrides `dired-kept-versions';
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
209 Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
210
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
211 To clear the flags on these files, you can use \\[dired-flag-backup-files]
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
212 with a prefix argument."
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
213 (interactive "P")
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
214 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
215 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
216 (late-retention (if (<= keep 0) dired-kept-versions keep))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
217 (dired-file-version-alist ()))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
218 (message "Cleaning numerical backups (keeping %d late, %d old)..."
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
219 late-retention early-retention)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
220 ;; Look at each file.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
221 ;; If the file has numeric backup versions,
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
222 ;; put on dired-file-version-alist an element of the form
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
223 ;; (FILENAME . VERSION-NUMBER-LIST)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
224 (dired-map-dired-file-lines (function dired-collect-file-versions))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
225 ;; Sort each VERSION-NUMBER-LIST,
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
226 ;; and remove the versions not to be deleted.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
227 (let ((fval dired-file-version-alist))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
228 (while fval
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
229 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
230 (v-count (length sorted-v-list)))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
231 (if (> v-count (+ early-retention late-retention))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
232 (rplacd (nthcdr early-retention sorted-v-list)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
233 (nthcdr (- v-count late-retention)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
234 sorted-v-list)))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
235 (rplacd (car fval)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
236 (cdr sorted-v-list)))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
237 (setq fval (cdr fval))))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
238 ;; Look at each file. If it is a numeric backup file,
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
239 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
240 (dired-map-dired-file-lines (function dired-trample-file-versions))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
241 (message "Cleaning numerical backups...done")))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
242
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
243 ;;; Subroutines of dired-clean-directory.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
244
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
245 (defun dired-map-dired-file-lines (fun)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
246 ;; Perform FUN with point at the end of each non-directory line.
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
247 ;; FUN takes one argument, the filename (complete pathname).
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
248 (save-excursion
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
249 (let (file buffer-read-only)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
250 (goto-char (point-min))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
251 (while (not (eobp))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
252 (save-excursion
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
253 (and (not (looking-at dired-re-dir))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
254 (not (eolp))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
255 (setq file (dired-get-filename nil t)) ; nil on non-file
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
256 (progn (end-of-line)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
257 (funcall fun file))))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
258 (forward-line 1)))))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
259
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
260 (defun dired-collect-file-versions (fn)
9978
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
261 (let ((fn (file-name-sans-versions fn)))
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
262 ;; Only do work if this file is not already in the alist.
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
263 (if (assoc fn dired-file-version-alist)
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
264 nil
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
265 ;; If it looks like file FN has versions, return a list of the versions.
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
266 ;;That is a list of strings which are file names.
10213
dd2102e33b29 (dired-string-replace-match): Moved to dired.el.
Richard M. Stallman <rms@gnu.org>
parents: 9978
diff changeset
267 ;;The caller may want to flag some of these files for deletion.
9978
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
268 (let* ((base-versions
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
269 (concat (file-name-nondirectory fn) ".~"))
17733
6d8fecd12940 (dired-collect-file-versions):
Richard M. Stallman <rms@gnu.org>
parents: 17272
diff changeset
270 (backup-extract-version-start (length base-versions))
9978
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
271 (possibilities (file-name-all-completions
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
272 base-versions
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
273 (file-name-directory fn)))
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
274 (versions (mapcar 'backup-extract-version possibilities)))
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
275 (if versions
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
276 (setq dired-file-version-alist
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
277 (cons (cons fn versions)
5b5406fbd833 (dired-collect-file-versions): Discard version #s from
Richard M. Stallman <rms@gnu.org>
parents: 9660
diff changeset
278 dired-file-version-alist)))))))
890
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
279
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
280 (defun dired-trample-file-versions (fn)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
281 (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
282 base-version-list)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
283 (and start-vn
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
284 (setq base-version-list ; there was a base version to which
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
285 (assoc (substring fn 0 start-vn) ; this looks like a
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
286 dired-file-version-alist)) ; subversion
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
287 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
288 base-version-list)) ; this one doesn't make the cut
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
289 (progn (beginning-of-line)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
290 (delete-char 1)
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
291 (insert dired-del-marker)))))
bad1b9af86a1 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 878
diff changeset
292
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 ;;; Shell commands
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 ;;>>> install (move this function into simple.el)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (defun dired-shell-quote (filename)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 "Quote a file name for inferior shell (see variable `shell-file-name')."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 ;; Quote everything except POSIX filename characters.
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3398
diff changeset
298 ;; This should be safe enough even for really weird shells.
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (let ((result "") (start 0) end)
6309
9217f29851c2 Don't use triple-hyphen in a character class.
Karl Heuer <kwzh@gnu.org>
parents: 5281
diff changeset
300 (while (string-match "[^-0-9a-zA-Z_./]" filename start)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 (setq end (match-beginning 0)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 result (concat result (substring filename start end)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 "\\" (substring filename end (1+ end)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 start (1+ end)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 (concat result (substring filename start))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (defun dired-read-shell-command (prompt arg files)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 ;; "Read a dired shell command prompting with PROMPT (using read-string).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 ;;ARG is the prefix arg and may be used to indicate in the prompt which
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 ;; files are affected.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 ;;This is an extra function so that you can redefine it, e.g., to use gmhist."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (dired-mark-pop-up
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 nil 'shell files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (function read-string)
12733
2b3371d2facb (dired-read-shell-command): Pass `shell-command-history' to read-string.
Richard M. Stallman <rms@gnu.org>
parents: 12338
diff changeset
315 (format prompt (dired-mark-prompt arg files))
2b3371d2facb (dired-read-shell-command): Pass `shell-command-history' to read-string.
Richard M. Stallman <rms@gnu.org>
parents: 12338
diff changeset
316 nil 'shell-command-history))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 ;; The in-background argument is only needed in Emacs 18 where
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 ;; shell-command doesn't understand an appended ampersand `&'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 ;;;###autoload
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
321 (defun dired-do-shell-command (command &optional arg)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
322 "Run a shell command COMMAND on the marked files.
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
323 If no files are marked or a specific numeric prefix arg is given,
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
324 the next ARG files are used. Just \\[universal-argument] means the current file.
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
325 The prompt mentions the file(s) or the marker, as appropriate.
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
326
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 If there is output, it goes to a separate buffer.
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
328
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 Normally the command is run on each file individually.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 However, if there is a `*' in the command then it is run
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 just once with the entire file list substituted there.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
333 No automatic redisplay of dired buffers is attempted, as there's no
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
334 telling what files the command may have changed. Type
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
335 \\[dired-do-redisplay] to redisplay the marked files.
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 The shell command has the top level directory as working directory, so
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 output files usually are created there instead of in a subdir."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 ;;actual work and can be redefined for customization.
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
341 (interactive (list
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
342 ;; Want to give feedback whether this file or marked files are used:
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
343 (dired-read-shell-command (concat "! on "
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
344 "%s: ")
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
345 current-prefix-arg
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
346 (dired-get-marked-files
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
347 t current-prefix-arg))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
348 current-prefix-arg))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (let* ((on-each (not (string-match "\\*" command)))
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
350 (file-list (dired-get-marked-files t arg)))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 (if on-each
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 (dired-bunch-files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 (- 10000 (length command))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (function (lambda (&rest files)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 (dired-run-shell-command
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
356 (dired-shell-stuff-it command files t arg))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 nil
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 file-list)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 ;; execute the shell command
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 (dired-run-shell-command
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
361 (dired-shell-stuff-it command file-list nil arg)))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 ;; Might use {,} for bash or csh:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (defvar dired-mark-prefix ""
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 "Prepended to marked files in dired shell commands.")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 (defvar dired-mark-postfix ""
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 "Appended to marked files in dired shell commands.")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 (defvar dired-mark-separator " "
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 "Separates marked files in dired shell commands.")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372 ;; "Make up a shell command line from COMMAND and FILE-LIST.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 ;; If ON-EACH is t, COMMAND should be applied to each file, else
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 ;; simply concat all files and apply COMMAND to this.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 ;; FILE-LIST's elements will be quoted for the shell."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 ;; Might be redefined for smarter things and could then use RAW-ARG
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 ;; (coming from interactive P and currently ignored) to decide what to do.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 ;; Smart would be a way to access basename or extension of file names.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 ;; See dired-trns.el for an approach to this.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 ;; Bug: There is no way to quote a *
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381 ;; On the other hand, you can never accidentally get a * into your cmd.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (let ((stuff-it
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 (if (string-match "\\*" command)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 (function (lambda (x)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 (dired-replace-in-string "\\*" x command)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (function (lambda (x) (concat command " " x))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 (if on-each
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 (mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389 (let ((fns (mapconcat 'dired-shell-quote
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 file-list dired-mark-separator)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 (if (> (length file-list) 1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (funcall stuff-it fns)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 ;; This is an extra function so that it can be redefined by ange-ftp.
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
396 (defun dired-run-shell-command (command)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
397 (shell-command command)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
398 ;; Return nil for sake of nconc in dired-bunch-files.
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
399 nil)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 ;; In Emacs 19 this will return program's exit status.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 ;; This is a separate function so that ange-ftp can redefine it.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 (defun dired-call-process (program discard &rest arguments)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 ; "Run PROGRAM with output to current buffer unless DISCARD is t.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 ;Remaining arguments are strings passed as command arguments to PROGRAM."
14635
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
406 ;; Look for a handler for default-directory in case it is a remote file name.
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
407 (let ((handler
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
408 (find-file-name-handler (directory-file-name default-directory)
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
409 'dired-call-process)))
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
410 (if handler (apply handler 'dired-call-process
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
411 program discard arguments)
7a7506ffde31 (dired-call-process): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
412 (apply 'call-process program nil (not discard) nil arguments))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 (defun dired-check-process (msg program &rest arguments)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415 ; "Display MSG while running PROGRAM, and check for output.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416 ;Remaining arguments are strings passed as command arguments to PROGRAM.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417 ; On error, insert output
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
418 ; in a log buffer and return the offending ARGUMENTS or PROGRAM.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 ; Caller can cons up a list of failed args.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 ;Else returns nil for success."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421 (let (err-buffer err (dir default-directory))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (message "%s..." msg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 ;; Get a clean buffer for error output:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 (setq err-buffer (get-buffer-create " *dired-check-process output*"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 (set-buffer err-buffer)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 (erase-buffer)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428 (setq default-directory dir ; caller's default-directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 err (/= 0
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430 (apply (function dired-call-process) program nil arguments)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 (if err
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
432 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
433 (dired-log (concat program " " (prin1-to-string arguments) "\n"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
434 (dired-log err-buffer)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
435 (or arguments program t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
436 (kill-buffer err-buffer)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
437 (message "%s...done" msg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
438 nil))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
439
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
440 ;; Commands that delete or redisplay part of the dired buffer.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
441
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
442 (defun dired-kill-line (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
443 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
444 (setq arg (prefix-numeric-value arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
445 (let (buffer-read-only file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
446 (while (/= 0 arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
447 (setq file (dired-get-filename nil t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
448 (if (not file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
449 (error "Can only kill file lines.")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
450 (save-excursion (and file
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
451 (dired-goto-subdir file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
452 (dired-kill-subdir)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
453 (delete-region (progn (beginning-of-line) (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
454 (progn (forward-line 1) (point)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
455 (if (> arg 0)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
456 (setq arg (1- arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
457 (setq arg (1+ arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
458 (forward-line -1))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
459 (dired-move-to-filename)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
460
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
461 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
462 (defun dired-do-kill-lines (&optional arg fmt)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
463 "Kill all marked lines (not the files).
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
464 With a prefix argument, kill that many lines starting with the current line.
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
465 \(A negative argument kills lines before the current line.)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
466 To kill an entire subdirectory, go to its directory header line
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
467 and use this command with a prefix argument (the value does not matter)."
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
468 ;; Returns count of killed lines. FMT="" suppresses message.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
469 (interactive "P")
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
470 (if arg
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
471 (if (dired-get-subdir)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
472 (dired-kill-subdir)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
473 (dired-kill-line arg))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
474 (save-excursion
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
475 (goto-char (point-min))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
476 (let (buffer-read-only (count 0))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
477 (if (not arg) ; kill marked lines
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
478 (let ((regexp (dired-marker-regexp)))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
479 (while (and (not (eobp))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
480 (re-search-forward regexp nil t))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
481 (setq count (1+ count))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
482 (delete-region (progn (beginning-of-line) (point))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
483 (progn (forward-line 1) (point)))))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
484 ;; else kill unmarked lines
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
485 (while (not (eobp))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
486 (if (or (dired-between-files)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
487 (not (looking-at "^ ")))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
488 (forward-line 1)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
489 (setq count (1+ count))
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
490 (delete-region (point) (save-excursion
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
491 (forward-line 1)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
492 (point))))))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
493 (or (equal "" fmt)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
494 (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
495 count))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
496
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
497 ;;;###end dired-cmd.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
498
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
499 ;;; 30K
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
500 ;;;###begin dired-cp.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
501
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
502 (defun dired-compress ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
503 ;; Compress or uncompress the current file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
504 ;; Return nil for success, offending filename else.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
505 (let* (buffer-read-only
1110
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
506 (from-file (dired-get-filename))
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
507 (new-file (dired-compress-file from-file)))
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
508 (if new-file
4481
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
509 (let ((start (point)))
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
510 ;; Remove any preexisting entry for the name NEW-FILE.
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
511 (condition-case nil
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
512 (dired-remove-entry new-file)
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
513 (error nil))
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
514 (goto-char start)
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
515 ;; Now replace the current line with an entry for NEW-FILE.
c40febdb9967 (dired-compress-file): For .z file, run gunzip.
Richard M. Stallman <rms@gnu.org>
parents: 4478
diff changeset
516 (dired-update-file-line new-file) nil)
1110
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
517 (dired-log (concat "Failed to compress" from-file))
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
518 from-file)))
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
519
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
520 (defvar dired-compress-file-suffixes
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
521 '(("\\.gz\\'" "" "gunzip")
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
522 ("\\.tgz\\'" ".tar" "gunzip")
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
523 ("\\.Z\\'" "" "uncompress")
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
524 ;; For .z, try gunzip. It might be an old gzip file,
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
525 ;; or it might be from compact? pack? (which?) but gunzip handles both.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
526 ("\\.z\\'" "" "gunzip")
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
527 ;; This item controls naming for compression.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
528 ("\\.tar\\'" ".tgz" nil))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
529 "Control changes in file name suffixes for compression and uncompression.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
530 Each element specifies one transformation rule, and has the form:
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
531 (REGEXP NEW-SUFFIX PROGRAM)
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
532 The rule applies when the old file name matches REGEXP.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
533 The new file name is computed by deleting the part that matches REGEXP
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
534 (as well as anything after that), then adding NEW-SUFFIX in its place.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
535 If PROGRAM is non-nil, the rule is an uncompression rule,
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
536 and uncompression is done by running PROGRAM.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
537 Otherwise, the rule is a compression rule, and compression is done with gzip.")
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
538
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
539 ;;;###autoload
1110
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
540 (defun dired-compress-file (file)
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
541 ;; Compress or uncompress FILE.
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
542 ;; Return the name of the compressed or uncompressed file.
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3398
diff changeset
543 ;; Return nil if no change in files.
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
544 (let ((handler (find-file-name-handler file 'dired-compress-file))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
545 suffix newname
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
546 (suffixes dired-compress-file-suffixes))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
547 ;; See if any suffix rule matches this file name.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
548 (while suffixes
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
549 (let (case-fold-search)
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
550 (if (string-match (car (car suffixes)) file)
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
551 (setq suffix (car suffixes) suffixes nil))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
552 (setq suffixes (cdr suffixes))))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
553 ;; If so, compute desired new name.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
554 (if suffix
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
555 (setq newname (concat (substring file 0 (match-beginning 0))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
556 (nth 1 suffix))))
1110
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
557 (cond (handler
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
558 (funcall handler 'dired-compress-file file))
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
559 ((file-symlink-p file)
f165d900e06e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 917
diff changeset
560 nil)
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
561 ((and suffix (nth 2 suffix))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
562 ;; We found an uncompression rule.
3398
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
563 (if (not (dired-check-process (concat "Uncompressing " file)
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
564 (nth 2 suffix) file))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
565 newname))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
566 (t
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
567 ;;; We don't recognize the file as compressed, so compress it.
3398
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
568 ;;; Try gzip; if we don't have that, use compress.
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
569 (condition-case nil
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
570 (if (not (dired-check-process (concat "Compressing " file)
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
571 "gzip" "-f" file))
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
572 (let ((out-name
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
573 (if (file-exists-p (concat file ".gz"))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
574 (concat file ".gz")
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
575 (concat file ".z"))))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
576 ;; Rename the compressed file to NEWNAME
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
577 ;; if it hasn't got that name already.
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
578 (if (and newname (not (equal newname out-name)))
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
579 (progn
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
580 (rename-file out-name newname t)
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
581 newname)
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
582 out-name)))
3398
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
583 (file-error
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
584 (if (not (dired-check-process (concat "Compressing " file)
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
585 "compress" "-f" file))
14737
9e847303147a (dired-compress-file-suffixes): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14635
diff changeset
586 ;; Don't use NEWNAME with `compress'.
3398
4fb117e74844 (dired-compress-file): Use gzip when proper/possible.
Richard M. Stallman <rms@gnu.org>
parents: 3089
diff changeset
587 (concat file ".Z"))))))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
588
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
589 (defun dired-mark-confirm (op-symbol arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
590 ;; Request confirmation from the user that the operation described
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
591 ;; by OP-SYMBOL is to be performed on the marked files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
592 ;; Confirmation consists in a y-or-n question with a file list
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
593 ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
594 ;; The files used are determined by ARG (as in dired-get-marked-files).
17199
91cf1da75ccd Allow a dired-no-confirm of t
Simon Marshall <simon@gnu.org>
parents: 16972
diff changeset
595 (or (eq dired-no-confirm t)
91cf1da75ccd Allow a dired-no-confirm of t
Simon Marshall <simon@gnu.org>
parents: 16972
diff changeset
596 (memq op-symbol dired-no-confirm)
1538
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
597 (let ((files (dired-get-marked-files t arg))
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
598 (string (if (eq op-symbol 'compress) "Compress or uncompress"
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
599 (capitalize (symbol-name op-symbol)))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
600 (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
1538
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
601 (concat string " "
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
602 (dired-mark-prompt arg files) "? ")))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
603
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
604 (defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
605 ; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
606 ; and display failures.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
607
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
608 ; FUN takes zero args. It returns non-nil (the offending object, e.g.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
609 ; the short form of the filename) for a failure and probably logs a
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
610 ; detailed error explanation using function `dired-log'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
611
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
612 ; OP-SYMBOL is a symbol describing the operation performed (e.g.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
613 ; `compress'). It is used with `dired-mark-pop-up' to prompt the user
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
614 ; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
615 ; `Failed to compress 1 of 2 files - type W to see why ("foo")')
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
616
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
617 ; SHOW-PROGRESS if non-nil means redisplay dired after each file."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
618 (if (dired-mark-confirm op-symbol arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
619 (let* ((total-list;; all of FUN's return values
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
620 (dired-map-over-marks (funcall fun) arg show-progress))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
621 (total (length total-list))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
622 (failures (delq nil total-list))
1538
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
623 (count (length failures))
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
624 (string (if (eq op-symbol 'compress) "Compress or uncompress"
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
625 (capitalize (symbol-name op-symbol)))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
626 (if (not failures)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
627 (message "%s: %d file%s."
1538
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
628 string total (dired-plural-s total))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
629 ;; end this bunch of errors:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
630 (dired-log-summary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
631 (format "Failed to %s %d of %d file%s"
1538
2d29bf379da3 (dired-mark-confirm): For `compress', say `Compress or uncompress'.
Richard M. Stallman <rms@gnu.org>
parents: 1381
diff changeset
632 (downcase string) count total (dired-plural-s total))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
633 failures)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
634
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
635 (defvar dired-query-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
636 '((?\y . y) (?\040 . y) ; `y' or SPC means accept once
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
637 (?n . n) (?\177 . n) ; `n' or DEL skips once
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
638 (?! . yes) ; `!' accepts rest
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
639 (?q. no) (?\e . no) ; `q' or ESC skips rest
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
640 ;; None of these keys quit - use C-g for that.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
641 ))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
642
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
643 (defun dired-query (qs-var qs-prompt &rest qs-args)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
644 ;; Query user and return nil or t.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
645 ;; Store answer in symbol VAR (which must initially be bound to nil).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
646 ;; Format PROMPT with ARGS.
917
d09aafad0e95 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 910
diff changeset
647 ;; Binding variable help-form will help the user who types the help key.
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
648 (let* ((char (symbol-value qs-var))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
649 (action (cdr (assoc char dired-query-alist))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
650 (cond ((eq 'yes action)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
651 t) ; accept, and don't ask again
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
652 ((eq 'no action)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
653 nil) ; skip, and don't ask again
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
654 (t;; no lasting effects from last time we asked - ask now
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
655 (let ((qprompt (concat qs-prompt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
656 (if help-form
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
657 (format " [Type yn!q or %s] "
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
658 (key-description
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
659 (char-to-string help-char)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
660 " [Type y, n, q or !] ")))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
661 result elt)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
662 ;; Actually it looks nicer without cursor-in-echo-area - you can
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
663 ;; look at the dired buffer instead of at the prompt to decide.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
664 (apply 'message qprompt qs-args)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
665 (setq char (set qs-var (read-char)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
666 (while (not (setq elt (assoc char dired-query-alist)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
667 (message "Invalid char - type %c for help." help-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
668 (ding)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
669 (sit-for 1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
670 (apply 'message qprompt qs-args)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
671 (setq char (set qs-var (read-char))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
672 (memq (cdr elt) '(t y yes)))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
673
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
674 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
675 (defun dired-do-compress (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
676 "Compress or uncompress marked (or next ARG) files."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
677 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
678 (dired-map-over-marks-check (function dired-compress) arg 'compress t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
679
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
680 ;; Commands for Emacs Lisp files - load and byte compile
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
681
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
682 (defun dired-byte-compile ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
683 ;; Return nil for success, offending file name else.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
684 (let* ((filename (dired-get-filename))
8236
444501972687 (dired-byte-compile): Use byte-compile-dest-file
Richard M. Stallman <rms@gnu.org>
parents: 7838
diff changeset
685 elc-file buffer-read-only failure)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
686 (condition-case err
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
687 (save-excursion (byte-compile-file filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
688 (error
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
689 (setq failure err)))
8236
444501972687 (dired-byte-compile): Use byte-compile-dest-file
Richard M. Stallman <rms@gnu.org>
parents: 7838
diff changeset
690 (setq elc-file (byte-compile-dest-file filename))
12972
62682d1146a0 (dired-byte-compile): Report failure if output file is not created.
Richard M. Stallman <rms@gnu.org>
parents: 12905
diff changeset
691 (or (file-exists-p elc-file)
62682d1146a0 (dired-byte-compile): Report failure if output file is not created.
Richard M. Stallman <rms@gnu.org>
parents: 12905
diff changeset
692 (setq failure t))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
693 (if failure
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
694 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
695 (dired-log "Byte compile error for %s:\n%s\n" filename failure)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
696 (dired-make-relative filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
697 (dired-remove-file elc-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
698 (forward-line) ; insert .elc after its .el file
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
699 (dired-add-file elc-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
700 nil)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
701
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
702 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
703 (defun dired-do-byte-compile (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
704 "Byte compile marked (or next ARG) Emacs Lisp files."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
705 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
706 (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
707
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
708 (defun dired-load ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
709 ;; Return nil for success, offending file name else.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
710 (let ((file (dired-get-filename)) failure)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
711 (condition-case err
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
712 (load file nil nil t)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
713 (error (setq failure err)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
714 (if (not failure)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
715 nil
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
716 (dired-log "Load error for %s:\n%s\n" file failure)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
717 (dired-make-relative file))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
718
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
719 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
720 (defun dired-do-load (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
721 "Load the marked (or next ARG) Emacs Lisp files."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
722 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
723 (dired-map-over-marks-check (function dired-load) arg 'load t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
725 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
726 (defun dired-do-redisplay (&optional arg test-for-subdir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
727 "Redisplay all marked (or next ARG) files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
728 If on a subdir line, redisplay that subdirectory. In that case,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
729 a prefix arg lets you edit the `ls' switches used for the new listing."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
730 ;; Moves point if the next ARG files are redisplayed.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
731 (interactive "P\np")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
732 (if (and test-for-subdir (dired-get-subdir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
733 (dired-insert-subdir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
734 (dired-get-subdir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
735 (if arg (read-string "Switches for listing: " dired-actual-switches)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
736 (message "Redisplaying...")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
737 ;; message much faster than making dired-map-over-marks show progress
12338
3e84024ad5d8 (dired-do-redisplay): Call dired-uncache.
Richard M. Stallman <rms@gnu.org>
parents: 11458
diff changeset
738 (dired-uncache
3e84024ad5d8 (dired-do-redisplay): Call dired-uncache.
Richard M. Stallman <rms@gnu.org>
parents: 11458
diff changeset
739 (if (consp dired-directory) (car dired-directory) dired-directory))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
740 (dired-map-over-marks (let ((fname (dired-get-filename)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
741 (message "Redisplaying... %s" fname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
742 (dired-update-file-line fname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
743 arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
744 (dired-move-to-filename)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
745 (message "Redisplaying...done")))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
746
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
747 (defun dired-update-file-line (file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
748 ;; Delete the current line, and insert an entry for FILE.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
749 ;; If FILE is nil, then just delete the current line.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
750 ;; Keeps any marks that may be present in column one (doing this
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
751 ;; here is faster than with dired-add-entry's optional arg).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
752 ;; Does not update other dired buffers. Use dired-relist-entry for that.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
753 (beginning-of-line)
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
754 (let ((char (following-char)) (opoint (point))
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
755 (buffer-read-only))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
756 (delete-region (point) (progn (forward-line 1) (point)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
757 (if file
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
758 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
759 (dired-add-entry file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
760 ;; Replace space by old marker without moving point.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
761 ;; Faster than goto+insdel inside a save-excursion?
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
762 (subst-char-in-region opoint (1+ opoint) ?\040 char))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
763 (dired-move-to-filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
764
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
765 (defun dired-fun-in-all-buffers (directory file fun &rest args)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
766 ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
767 ;; If the buffer has a wildcard pattern, check that it matches FILE.
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
768 ;; (FILE does not include a directory component.)
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
769 ;; FILE may be nil, in which case ignore it.
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
770 ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
771 (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
772 file))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
773 (obuf (current-buffer))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
774 buf success-list)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
775 (while buf-list
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
776 (setq buf (car buf-list)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
777 buf-list (cdr buf-list))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
778 (unwind-protect
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
779 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
780 (set-buffer buf)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
781 (if (apply fun args)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
782 (setq success-list (cons (buffer-name buf) success-list))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
783 (set-buffer obuf)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
784 success-list))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
785
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
786 ;;;###autoload
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
787 (defun dired-add-file (filename &optional marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
788 (dired-fun-in-all-buffers
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
789 (file-name-directory filename) (file-name-nondirectory filename)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
790 (function dired-add-entry) filename marker-char))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
791
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
792 (defun dired-add-entry (filename &optional marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
793 ;; Add a new entry for FILENAME, optionally marking it
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
794 ;; with MARKER-CHAR (a character, else dired-marker-char is used).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
795 ;; Note that this adds the entry `out of order' if files sorted by
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
796 ;; time, etc.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
797 ;; At least this version inserts in the right subdirectory (if present).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
798 ;; And it skips "." or ".." (see `dired-trivial-filenames').
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
799 ;; Hidden subdirs are exposed if a file is added there.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
800 (setq filename (directory-file-name filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
801 ;; Entry is always for files, even if they happen to also be directories
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
802 (let ((opoint (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
803 (cur-dir (dired-current-directory))
11158
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
804 (orig-file-name filename)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
805 (directory (file-name-directory filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
806 reason)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
807 (setq filename (file-name-nondirectory filename)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
808 reason
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
809 (catch 'not-found
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
810 (if (string= directory cur-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
811 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
812 (skip-chars-forward "^\r\n")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
813 (if (eq (following-char) ?\r)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
814 (dired-unhide-subdir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
815 ;; We are already where we should be, except when
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
816 ;; point is before the subdir line or its total line.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
817 (let ((p (dired-after-subdir-garbage cur-dir)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
818 (if (< (point) p)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
819 (goto-char p))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
820 ;; else try to find correct place to insert
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
821 (if (dired-goto-subdir directory)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
822 (progn;; unhide if necessary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
823 (if (looking-at "\r");; point is at end of subdir line
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
824 (dired-unhide-subdir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
825 ;; found - skip subdir and `total' line
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
826 ;; and uninteresting files like . and ..
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
827 ;; This better not moves into the next subdir!
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
828 (dired-goto-next-nontrivial-file))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
829 ;; not found
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
830 (throw 'not-found "Subdir not found")))
6824
ec94aee0bf55 (dired-add-entry): Set opoint at beginning of line.
Richard M. Stallman <rms@gnu.org>
parents: 6633
diff changeset
831 (let (buffer-read-only opoint)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
832 (beginning-of-line)
6824
ec94aee0bf55 (dired-add-entry): Set opoint at beginning of line.
Richard M. Stallman <rms@gnu.org>
parents: 6633
diff changeset
833 (setq opoint (point))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
834 (dired-add-entry-do-indentation marker-char)
6824
ec94aee0bf55 (dired-add-entry): Set opoint at beginning of line.
Richard M. Stallman <rms@gnu.org>
parents: 6633
diff changeset
835 ;; don't expand `.'. Show just the file name within directory.
6633
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
836 (let ((default-directory directory))
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
837 (insert-directory filename
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
838 (concat dired-actual-switches "d")))
11158
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
839 ;; Compensate for a bug in ange-ftp.
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
840 ;; It inserts the file's absolute name, rather than
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
841 ;; the relative one. That may be hard to fix since it
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
842 ;; is probably controlled by something in ftp.
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
843 (goto-char opoint)
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
844 (let ((inserted-name (dired-get-filename 'no-dir)))
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
845 (if (file-name-directory inserted-name)
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
846 (progn
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
847 (end-of-line)
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
848 (delete-char (- (length inserted-name)))
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
849 (insert filename)
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
850 (forward-char 1))
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
851 (forward-line 1)))
b9376f3450bb (dired-add-entry): If ange-ftp inserted the file's absolute name, fix that.
Richard M. Stallman <rms@gnu.org>
parents: 10982
diff changeset
852 ;; Give each line a text property recording info about it.
6633
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
853 (dired-insert-set-properties opoint (point))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
854 (forward-line -1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
855 (if dired-after-readin-hook;; the subdir-alist is not affected...
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
856 (save-excursion;; ...so we can run it right now:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
857 (save-restriction
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
858 (beginning-of-line)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
859 (narrow-to-region (point) (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
860 (forward-line 1) (point)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
861 (run-hooks 'dired-after-readin-hook))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
862 (dired-move-to-filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
863 ;; return nil if all went well
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
864 nil))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
865 (if reason ; don't move away on failure
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
866 (goto-char opoint))
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3398
diff changeset
867 (not reason))) ; return t on success, nil else
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
868
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
869 ;; This is a separate function for the sake of nested dired format.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
870 (defun dired-add-entry-do-indentation (marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
871 ;; two spaces or a marker plus a space:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
872 (insert (if marker-char
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
873 (if (integerp marker-char) marker-char dired-marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
874 ?\040)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
875 ?\040))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
876
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
877 (defun dired-after-subdir-garbage (dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
878 ;; Return pos of first file line of DIR, skipping header and total
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
879 ;; or wildcard lines.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
880 ;; Important: never moves into the next subdir.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
881 ;; DIR is assumed to be unhidden.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
882 ;; Will probably be redefined for VMS etc.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
883 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
884 (or (dired-goto-subdir dir) (error "This cannot happen"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
885 (forward-line 1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
886 (while (and (not (eolp)) ; don't cross subdir boundary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
887 (not (dired-move-to-filename)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
888 (forward-line 1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
889 (point)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
890
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
891 ;;;###autoload
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
892 (defun dired-remove-file (file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
893 (dired-fun-in-all-buffers
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
894 (file-name-directory file) (file-name-nondirectory file)
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
895 (function dired-remove-entry) file))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
896
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
897 (defun dired-remove-entry (file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
898 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
899 (and (dired-goto-file file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
900 (let (buffer-read-only)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
901 (delete-region (progn (beginning-of-line) (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
902 (save-excursion (forward-line 1) (point)))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
903
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
904 ;;;###autoload
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
905 (defun dired-relist-file (file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
906 (dired-fun-in-all-buffers (file-name-directory file)
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
907 (file-name-nondirectory file)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
908 (function dired-relist-entry) file))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
909
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
910 (defun dired-relist-entry (file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
911 ;; Relist the line for FILE, or just add it if it did not exist.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
912 ;; FILE must be an absolute pathname.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
913 (let (buffer-read-only marker)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
914 ;; If cursor is already on FILE's line delete-region will cause
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
915 ;; save-excursion to fail because of floating makers,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
916 ;; moving point to beginning of line. Sigh.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
917 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
918 (and (dired-goto-file file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
919 (delete-region (progn (beginning-of-line)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
920 (setq marker (following-char))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
921 (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
922 (save-excursion (forward-line 1) (point))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
923 (setq file (directory-file-name file))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
924 (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
925
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
926 ;;; Copy, move/rename, making hard and symbolic links
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
927
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
928 (defvar dired-backup-overwrite nil
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
929 "*Non-nil if Dired should ask about making backups before overwriting files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
930 Special value `always' suppresses confirmation.")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
931
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
932 (defvar dired-overwrite-confirmed)
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
933
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
934 (defun dired-handle-overwrite (to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
935 ;; Save old version of a to be overwritten file TO.
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
936 ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
937 ;; from dired-create-files.
15160
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
938 (let (backup)
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
939 (if (and dired-backup-overwrite
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
940 dired-overwrite-confirmed
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
941 (setq backup (car (find-backup-file-name to)))
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
942 (or (eq 'always dired-backup-overwrite)
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
943 (dired-query 'overwrite-backup-query
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
944 (format "Make backup for existing file `%s'? " to))))
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
945 (progn
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
946 (rename-file to backup 0) ; confirm overwrite of old backup
bc35b62c3798 (dired-handle-overwrite): `find-backup-file-name'
Richard M. Stallman <rms@gnu.org>
parents: 14737
diff changeset
947 (dired-relist-entry backup)))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
948
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
949 ;;;###autoload
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
950 (defun dired-copy-file (from to ok-flag)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
951 (dired-handle-overwrite to)
17272
5dd977f51652 (dired-copy-file): Handle file-date-error.
Richard M. Stallman <rms@gnu.org>
parents: 17205
diff changeset
952 (condition-case ()
5dd977f51652 (dired-copy-file): Handle file-date-error.
Richard M. Stallman <rms@gnu.org>
parents: 17205
diff changeset
953 (copy-file from to ok-flag dired-copy-preserve-time)
5dd977f51652 (dired-copy-file): Handle file-date-error.
Richard M. Stallman <rms@gnu.org>
parents: 17205
diff changeset
954 (file-date-error (message "Can't set date")
5dd977f51652 (dired-copy-file): Handle file-date-error.
Richard M. Stallman <rms@gnu.org>
parents: 17205
diff changeset
955 (sit-for 1))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
956
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
957 ;;;###autoload
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
958 (defun dired-rename-file (from to ok-flag)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
959 (dired-handle-overwrite to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
960 (rename-file from to ok-flag) ; error is caught in -create-files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
961 ;; Silently rename the visited file of any buffer visiting this file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
962 (and (get-file-buffer from)
16972
99de1dc68184 (dired-rename-file): Pass new arg to set-visited-file-name.
Richard M. Stallman <rms@gnu.org>
parents: 16808
diff changeset
963 (with-current-buffer (get-file-buffer from)
99de1dc68184 (dired-rename-file): Pass new arg to set-visited-file-name.
Richard M. Stallman <rms@gnu.org>
parents: 16808
diff changeset
964 (set-visited-file-name to nil t)))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
965 (dired-remove-file from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
966 ;; See if it's an inserted subdir, and rename that, too.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
967 (dired-rename-subdir from to))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
968
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
969 (defun dired-rename-subdir (from-dir to-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
970 (setq from-dir (file-name-as-directory from-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
971 to-dir (file-name-as-directory to-dir))
17205
a886f419a946 (dired-fun-in-all-buffers): New arg FILE. Don't operate on buffers
Richard M. Stallman <rms@gnu.org>
parents: 17199
diff changeset
972 (dired-fun-in-all-buffers from-dir nil
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
973 (function dired-rename-subdir-1) from-dir to-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
974 ;; Update visited file name of all affected buffers
8793
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
975 (let ((expanded-from-dir (expand-file-name from-dir))
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
976 (blist (buffer-list)))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
977 (while blist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
978 (save-excursion
8793
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
979 (set-buffer (car blist))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
980 (if (and buffer-file-name
8793
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
981 (dired-in-this-tree buffer-file-name expanded-from-dir))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
982 (let ((modflag (buffer-modified-p))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
983 (to-file (dired-replace-in-string
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
984 (concat "^" (regexp-quote from-dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
985 to-dir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
986 buffer-file-name)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
987 (set-visited-file-name to-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
988 (set-buffer-modified-p modflag))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
989 (setq blist (cdr blist)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
990
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
991 (defun dired-rename-subdir-1 (dir to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
992 ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
993 ;; one of its subdirectories is expanded in this buffer.
8793
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
994 (let ((expanded-dir (expand-file-name dir))
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
995 (alist dired-subdir-alist)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
996 (elt nil))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
997 (while alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
998 (setq elt (car alist)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
999 alist (cdr alist))
8793
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
1000 (if (dired-in-this-tree (car elt) expanded-dir)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1001 ;; ELT's subdir is affected by the rename
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1002 (dired-rename-subdir-2 elt dir to)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1003 (if (equal dir default-directory)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1004 ;; if top level directory was renamed, lots of things have to be
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1005 ;; updated:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1006 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1007 (dired-unadvertise dir) ; we no longer dired DIR...
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1008 (setq default-directory to
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1009 dired-directory (expand-file-name;; this is correct
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1010 ;; with and without wildcards
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1011 (file-name-nondirectory dired-directory)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1012 to))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1013 (let ((new-name (file-name-nondirectory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1014 (directory-file-name dired-directory))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1015 ;; try to rename buffer, but just leave old name if new
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1016 ;; name would already exist (don't try appending "<%d>")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1017 (or (get-buffer new-name)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1018 (rename-buffer new-name)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1019 ;; ... we dired TO now:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1020 (dired-advertise)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1021
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1022 (defun dired-rename-subdir-2 (elt dir to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1023 ;; Update the headerline and dired-subdir-alist element of directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1024 ;; described by alist-element ELT to reflect the moving of DIR to TO.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1025 ;; Thus, ELT describes either DIR itself or a subdir of DIR.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1026 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1027 (let ((regexp (regexp-quote (directory-file-name dir)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1028 (newtext (directory-file-name to))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1029 buffer-read-only)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1030 (goto-char (dired-get-subdir-min elt))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1031 ;; Update subdir headerline in buffer
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1032 (if (not (looking-at dired-subdir-regexp))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1033 (error "%s not found where expected - dired-subdir-alist broken?"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1034 dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1035 (goto-char (match-beginning 1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1036 (if (re-search-forward regexp (match-end 1) t)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1037 (replace-match newtext t t)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1038 (error "Expected to find `%s' in headerline of %s" dir (car elt))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1039 ;; Update buffer-local dired-subdir-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1040 (setcar elt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1041 (dired-normalize-subdir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1042 (dired-replace-in-string regexp newtext (car elt)))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1043
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1044 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1045 (defun dired-create-files (file-creator operation fn-list name-constructor
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1046 &optional marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1047
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1048 ;; Create a new file for each from a list of existing files. The user
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1049 ;; is queried, dired buffers are updated, and at the end a success or
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1050 ;; failure message is displayed
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1051
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1052 ;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1053
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1054 ;; It is called for each file and must create newfile, the entry of
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1055 ;; which will be added. The user will be queried if the file already
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1056 ;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1057 ;; rename), it is FILE-CREATOR's responsibility to update dired
14040
187735b53d52 Comment fixes.
Karl Heuer <kwzh@gnu.org>
parents: 12972
diff changeset
1058 ;; buffers. FILE-CREATOR must abort by signaling a file-error if it
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1059 ;; could not create newfile. The error is caught and logged.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1060
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1061 ;; OPERATION (a capitalized string, e.g. `Copy') describes the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1062 ;; operation performed. It is used for error logging.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1063
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1064 ;; FN-LIST is the list of files to copy (full absolute pathnames).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1065
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1066 ;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1067 ;; skip. If it skips files for other reasons than a direct user
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1068 ;; query, it is supposed to tell why (using dired-log).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1069
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1070 ;; Optional MARKER-CHAR is a character with which to mark every
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1071 ;; newfile's entry, or t to use the current marker character if the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1072 ;; oldfile was marked.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1073
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1074 (let (failures skipped (success-count 0) (total (length fn-list)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1075 (let (to overwrite-query
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1076 overwrite-backup-query) ; for dired-handle-overwrite
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1077 (mapcar
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1078 (function
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1079 (lambda (from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1080 (setq to (funcall name-constructor from))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1081 (if (equal to from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1082 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1083 (setq to nil)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1084 (dired-log "Cannot %s to same file: %s\n"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1085 (downcase operation) from)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1086 (if (not to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1087 (setq skipped (cons (dired-make-relative from) skipped))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1088 (let* ((overwrite (file-exists-p to))
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
1089 (dired-overwrite-confirmed ; for dired-handle-overwrite
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1090 (and overwrite
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1091 (let ((help-form '(format "\
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1092 Type SPC or `y' to overwrite file `%s',
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1093 DEL or `n' to skip to next,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1094 ESC or `q' to not overwrite any of the remaining files,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1095 `!' to overwrite all remaining files with no more questions." to)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1096 (dired-query 'overwrite-query
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1097 "Overwrite `%s'?" to))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1098 ;; must determine if FROM is marked before file-creator
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1099 ;; gets a chance to delete it (in case of a move).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1100 (actual-marker-char
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1101 (cond ((integerp marker-char) marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1102 (marker-char (dired-file-marker from)) ; slow
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1103 (t nil))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1104 (condition-case err
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1105 (progn
910
4fba6d4b6a28 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 890
diff changeset
1106 (funcall file-creator from to dired-overwrite-confirmed)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1107 (if overwrite
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1108 ;; If we get here, file-creator hasn't been aborted
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1109 ;; and the old entry (if any) has to be deleted
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1110 ;; before adding the new entry.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1111 (dired-remove-file to))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1112 (setq success-count (1+ success-count))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1113 (message "%s: %d of %d" operation success-count total)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1114 (dired-add-file to actual-marker-char))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1115 (file-error ; FILE-CREATOR aborted
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1116 (progn
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1117 (setq failures (cons (dired-make-relative from) failures))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1118 (dired-log "%s `%s' to `%s' failed:\n%s\n"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1119 operation from to err))))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1120 fn-list))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1121 (cond
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1122 (failures
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1123 (dired-log-summary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1124 (format "%s failed for %d of %d file%s"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1125 operation (length failures) total
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1126 (dired-plural-s total))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1127 failures))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1128 (skipped
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1129 (dired-log-summary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1130 (format "%s: %d of %d file%s skipped"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1131 operation (length skipped) total
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1132 (dired-plural-s total))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1133 skipped))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1134 (t
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1135 (message "%s: %s file%s"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1136 operation success-count (dired-plural-s success-count)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1137 (dired-move-to-filename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1138
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1139 (defun dired-do-create-files (op-symbol file-creator operation arg
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1140 &optional marker-char op1
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1141 how-to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1142 ;; Create a new file for each marked file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1143 ;; Prompts user for target, which is a directory in which to create
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1144 ;; the new files. Target may be a plain file if only one marked
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1145 ;; file exists.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1146 ;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3398
diff changeset
1147 ;; will determine whether pop-ups are appropriate for this OP-SYMBOL.
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1148 ;; FILE-CREATOR and OPERATION as in dired-create-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1149 ;; ARG as in dired-get-marked-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1150 ;; Optional arg OP1 is an alternate form for OPERATION if there is
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1151 ;; only one file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1152 ;; Optional arg MARKER-CHAR as in dired-create-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1153 ;; Optional arg HOW-TO determines how to treat target:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1154 ;; If HOW-TO is not given (or nil), and target is a directory, the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1155 ;; file(s) are created inside the target directory. If target
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1156 ;; is not a directory, there must be exactly one marked file,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1157 ;; else error.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1158 ;; If HOW-TO is t, then target is not modified. There must be
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1159 ;; exactly one marked file, else error.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1160 ;; Else HOW-TO is assumed to be a function of one argument, target,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1161 ;; that looks at target and returns a value for the into-dir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1162 ;; variable. The function dired-into-dir-with-symlinks is provided
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1163 ;; for the case (common when creating symlinks) that symbolic
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1164 ;; links to directories are not to be considered as directories
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1165 ;; (as file-directory-p would if HOW-TO had been nil).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1166 (or op1 (setq op1 operation))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1167 (let* ((fn-list (dired-get-marked-files nil arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1168 (fn-count (length fn-list))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1169 (target (expand-file-name
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1170 (dired-mark-read-file-name
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1171 (concat (if (= 1 fn-count) op1 operation) " %s to: ")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1172 (dired-dwim-target-directory)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1173 op-symbol arg (mapcar (function dired-make-relative) fn-list))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1174 (into-dir (cond ((null how-to) (file-directory-p target))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1175 ((eq how-to t) nil)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1176 (t (funcall how-to target)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1177 (if (and (> fn-count 1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1178 (not into-dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1179 (error "Marked %s: target must be a directory: %s" operation target))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1180 ;; rename-file bombs when moving directories unless we do this:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1181 (or into-dir (setq target (directory-file-name target)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1182 (dired-create-files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1183 file-creator operation fn-list
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1184 (if into-dir ; target is a directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1185 ;; This function uses fluid vars into-dir and target when called
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1186 ;; inside dired-create-files:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1187 (function (lambda (from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1188 (expand-file-name (file-name-nondirectory from) target)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1189 (function (lambda (from) target)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1190 marker-char)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1191
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1192 ;; Read arguments for a marked-files command that wants a file name,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1193 ;; perhaps popping up the list of marked files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1194 ;; ARG is the prefix arg and indicates whether the files came from
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1195 ;; marks (ARG=nil) or a repeat factor (integerp ARG).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1196 ;; If the current file was used, the list has but one element and ARG
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1197 ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1198
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1199 (defun dired-mark-read-file-name (prompt dir op-symbol arg files)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1200 (dired-mark-pop-up
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1201 nil op-symbol files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1202 (function read-file-name)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1203 (format prompt (dired-mark-prompt arg files)) dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1204
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1205 (defun dired-dwim-target-directory ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1206 ;; Try to guess which target directory the user may want.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1207 ;; If there is a dired buffer displayed in the next window, use
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1208 ;; its current subdir, else use current subdir of this dired buffer.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1209 (let ((this-dir (and (eq major-mode 'dired-mode)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1210 (dired-current-directory))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1211 ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1212 (if dired-dwim-target
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1213 (let* ((other-buf (window-buffer (next-window)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1214 (other-dir (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1215 (set-buffer other-buf)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1216 (and (eq major-mode 'dired-mode)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1217 (dired-current-directory)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1218 (or other-dir this-dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1219 this-dir)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1220
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1221 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1222 (defun dired-create-directory (directory)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1223 "Create a directory called DIRECTORY."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1224 (interactive
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1225 (list (read-file-name "Create directory: " (dired-current-directory))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1226 (let ((expanded (directory-file-name (expand-file-name directory))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1227 (make-directory expanded)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1228 (dired-add-file expanded)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1229 (dired-move-to-filename)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1230
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1231 (defun dired-into-dir-with-symlinks (target)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1232 (and (file-directory-p target)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1233 (not (file-symlink-p target))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1234 ;; This may not always be what you want, especially if target is your
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1235 ;; home directory and it happens to be a symbolic link, as is often the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1236 ;; case with NFS and automounters. Or if you want to make symlinks
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1237 ;; into directories that themselves are only symlinks, also quite
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1238 ;; common.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1239
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1240 ;; So we don't use this function as value for HOW-TO in
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1241 ;; dired-do-symlink, which has the minor disadvantage of
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1242 ;; making links *into* a symlinked-dir, when you really wanted to
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1243 ;; *overwrite* that symlink. In that (rare, I guess) case, you'll
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1244 ;; just have to remove that symlink by hand before making your marked
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1245 ;; symlinks.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1246
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1247 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1248 (defun dired-do-copy (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1249 "Copy all marked (or next ARG) files, or copy the current file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1250 This normally preserves the last-modified date when copying.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1251 When operating on just the current file, you specify the new name.
12757
3af640c2a0fe (dired-do-copy): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12733
diff changeset
1252 When operating on multiple or marked files, you specify a directory,
3af640c2a0fe (dired-do-copy): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12733
diff changeset
1253 and new copies of these files are made in that directory
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1254 with the same names that the files currently have."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1255 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1256 (dired-do-create-files 'copy (function dired-copy-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1257 (if dired-copy-preserve-time "Copy [-p]" "Copy")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1258 arg dired-keep-marker-copy))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1259
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1260 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1261 (defun dired-do-symlink (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1262 "Make symbolic links to current file or all marked (or next ARG) files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1263 When operating on just the current file, you specify the new name.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1264 When operating on multiple or marked files, you specify a directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1265 and new symbolic links are made in that directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1266 with the same names that the files currently have."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1267 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1268 (dired-do-create-files 'symlink (function make-symbolic-link)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1269 "Symlink" arg dired-keep-marker-symlink))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1270
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1271 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1272 (defun dired-do-hardlink (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1273 "Add names (hard links) current file or all marked (or next ARG) files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1274 When operating on just the current file, you specify the new name.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1275 When operating on multiple or marked files, you specify a directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1276 and new hard links are made in that directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1277 with the same names that the files currently have."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1278 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1279 (dired-do-create-files 'hardlink (function add-name-to-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1280 "Hardlink" arg dired-keep-marker-hardlink))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1281
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1282 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1283 (defun dired-do-rename (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1284 "Rename current file or all marked (or next ARG) files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1285 When renaming just the current file, you specify the new name.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1286 When renaming multiple or marked files, you specify a directory."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1287 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1288 (dired-do-create-files 'move (function dired-rename-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1289 "Move" arg dired-keep-marker-rename "Rename"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1290 ;;;###end dired-cp.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1291
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1292 ;;; 5K
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1293 ;;;###begin dired-re.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1294 (defun dired-do-create-files-regexp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1295 (file-creator operation arg regexp newname &optional whole-path marker-char)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1296 ;; Create a new file for each marked file using regexps.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1297 ;; FILE-CREATOR and OPERATION as in dired-create-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1298 ;; ARG as in dired-get-marked-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1299 ;; Matches each marked file against REGEXP and constructs the new
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1300 ;; filename from NEWNAME (like in function replace-match).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1301 ;; Optional arg WHOLE-PATH means match/replace the whole pathname
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1302 ;; instead of only the non-directory part of the file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1303 ;; Optional arg MARKER-CHAR as in dired-create-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1304 (let* ((fn-list (dired-get-marked-files nil arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1305 (fn-count (length fn-list))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1306 (operation-prompt (concat operation " `%s' to `%s'?"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1307 (rename-regexp-help-form (format "\
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1308 Type SPC or `y' to %s one match, DEL or `n' to skip to next,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1309 `!' to %s all remaining matches with no more questions."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1310 (downcase operation)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1311 (downcase operation)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1312 (regexp-name-constructor
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1313 ;; Function to construct new filename using REGEXP and NEWNAME:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1314 (if whole-path ; easy (but rare) case
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1315 (function
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1316 (lambda (from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1317 (let ((to (dired-string-replace-match regexp from newname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1318 ;; must bind help-form directly around call to
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1319 ;; dired-query
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1320 (help-form rename-regexp-help-form))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1321 (if to
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1322 (and (dired-query 'rename-regexp-query
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1323 operation-prompt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1324 from
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1325 to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1326 to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1327 (dired-log "%s: %s did not match regexp %s\n"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1328 operation from regexp)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1329 ;; not whole-path, replace non-directory part only
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1330 (function
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1331 (lambda (from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1332 (let* ((new (dired-string-replace-match
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1333 regexp (file-name-nondirectory from) newname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1334 (to (and new ; nil means there was no match
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1335 (expand-file-name new
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1336 (file-name-directory from))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1337 (help-form rename-regexp-help-form))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1338 (if to
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1339 (and (dired-query 'rename-regexp-query
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1340 operation-prompt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1341 (dired-make-relative from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1342 (dired-make-relative to))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1343 to)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1344 (dired-log "%s: %s did not match regexp %s\n"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1345 operation (file-name-nondirectory from) regexp)))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1346 rename-regexp-query)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1347 (dired-create-files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1348 file-creator operation fn-list regexp-name-constructor marker-char)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1349
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1350 (defun dired-mark-read-regexp (operation)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1351 ;; Prompt user about performing OPERATION.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1352 ;; Read and return list of: regexp newname arg whole-path.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1353 (let* ((whole-path
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1354 (equal 0 (prefix-numeric-value current-prefix-arg)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1355 (arg
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1356 (if whole-path nil current-prefix-arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1357 (regexp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1358 (dired-read-regexp
1756
ffef0718ef6b (dired-mark-read-regexp): Give dired-read-regexp 1 arg.
Richard M. Stallman <rms@gnu.org>
parents: 1672
diff changeset
1359 (concat (if whole-path "Path " "") operation " from (regexp): ")))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1360 (newname
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1361 (read-string
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1362 (concat (if whole-path "Path " "") operation " " regexp " to: "))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1363 (list regexp newname arg whole-path)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1364
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1365 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1366 (defun dired-do-rename-regexp (regexp newname &optional arg whole-path)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1367 "Rename marked files containing REGEXP to NEWNAME.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1368 As each match is found, the user must type a character saying
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1369 what to do with it. For directions, type \\[help-command] at that time.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1370 NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1371 REGEXP defaults to the last regexp used.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1372 With a zero prefix arg, renaming by regexp affects the complete
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1373 pathname - usually only the non-directory part of file names is used
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1374 and changed."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1375 (interactive (dired-mark-read-regexp "Rename"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1376 (dired-do-create-files-regexp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1377 (function dired-rename-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1378 "Rename" arg regexp newname whole-path dired-keep-marker-rename))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1379
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1380 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1381 (defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1382 "Copy all marked files containing REGEXP to NEWNAME.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1383 See function `dired-rename-regexp' for more info."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1384 (interactive (dired-mark-read-regexp "Copy"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1385 (dired-do-create-files-regexp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1386 (function dired-copy-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1387 (if dired-copy-preserve-time "Copy [-p]" "Copy")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1388 arg regexp newname whole-path dired-keep-marker-copy))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1389
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1390 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1391 (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1392 "Hardlink all marked files containing REGEXP to NEWNAME.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1393 See function `dired-rename-regexp' for more info."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1394 (interactive (dired-mark-read-regexp "HardLink"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1395 (dired-do-create-files-regexp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1396 (function add-name-to-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1397 "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1398
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1399 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1400 (defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1401 "Symlink all marked files containing REGEXP to NEWNAME.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1402 See function `dired-rename-regexp' for more info."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1403 (interactive (dired-mark-read-regexp "SymLink"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1404 (dired-do-create-files-regexp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1405 (function make-symbolic-link)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1406 "SymLink" arg regexp newname whole-path dired-keep-marker-symlink))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1407
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1408 (defun dired-create-files-non-directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1409 (file-creator basename-constructor operation arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1410 ;; Perform FILE-CREATOR on the non-directory part of marked files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1411 ;; using function BASENAME-CONSTRUCTOR, with query for each file.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1412 ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1413 (let (rename-non-directory-query)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1414 (dired-create-files
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1415 file-creator
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1416 operation
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1417 (dired-get-marked-files nil arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1418 (function
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1419 (lambda (from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1420 (let ((to (concat (file-name-directory from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1421 (funcall basename-constructor
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1422 (file-name-nondirectory from)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1423 (and (let ((help-form (format "\
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1424 Type SPC or `y' to %s one file, DEL or `n' to skip to next,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1425 `!' to %s all remaining matches with no more questions."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1426 (downcase operation)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1427 (downcase operation))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1428 (dired-query 'rename-non-directory-query
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1429 (concat operation " `%s' to `%s'")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1430 (dired-make-relative from)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1431 (dired-make-relative to)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1432 to))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1433 dired-keep-marker-rename)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1434
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1435 (defun dired-rename-non-directory (basename-constructor operation arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1436 (dired-create-files-non-directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1437 (function dired-rename-file)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1438 basename-constructor operation arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1439
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1440 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1441 (defun dired-upcase (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1442 "Rename all marked (or next ARG) files to upper case."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1443 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1444 (dired-rename-non-directory (function upcase) "Rename upcase" arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1445
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1446 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1447 (defun dired-downcase (&optional arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1448 "Rename all marked (or next ARG) files to lower case."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1449 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1450 (dired-rename-non-directory (function downcase) "Rename downcase" arg))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1451
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1452 ;;;###end dired-re.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1453
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1454 ;;; 13K
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1455 ;;;###begin dired-ins.el
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1456
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1457 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1458 (defun dired-maybe-insert-subdir (dirname &optional
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1459 switches no-error-if-not-dir-p)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1460 "Insert this subdirectory into the same dired buffer.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1461 If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1462 else inserts it at its natural place (as `ls -lR' would have done).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1463 With a prefix arg, you may edit the ls switches used for this listing.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1464 You can add `R' to the switches to expand the whole tree starting at
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1465 this subdirectory.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1466 This function takes some pains to conform to `ls -lR' output."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1467 (interactive
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1468 (list (dired-get-filename)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1469 (if current-prefix-arg
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1470 (read-string "Switches for listing: " dired-actual-switches))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1471 (let ((opoint (point)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1472 ;; We don't need a marker for opoint as the subdir is always
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1473 ;; inserted *after* opoint.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1474 (setq dirname (file-name-as-directory dirname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1475 (or (and (not switches)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1476 (dired-goto-subdir dirname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1477 (dired-insert-subdir dirname switches no-error-if-not-dir-p))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1478 ;; Push mark so that it's easy to find back. Do this after the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1479 ;; insert message so that the user sees the `Mark set' message.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1480 (push-mark opoint)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1481
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1482 (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1483 "Insert this subdirectory into the same dired buffer.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1484 If it is already present, overwrites previous entry,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1485 else inserts it at its natural place (as `ls -lR' would have done).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1486 With a prefix arg, you may edit the `ls' switches used for this listing.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1487 You can add `R' to the switches to expand the whole tree starting at
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1488 this subdirectory.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1489 This function takes some pains to conform to `ls -lR' output."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1490 ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1491 ;; Prospero where dired-ls does the right thing, but
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1492 ;; file-directory-p has not been redefined.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1493 (interactive
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1494 (list (dired-get-filename)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1495 (if current-prefix-arg
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1496 (read-string "Switches for listing: " dired-actual-switches))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1497 (setq dirname (file-name-as-directory (expand-file-name dirname)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1498 (dired-insert-subdir-validate dirname switches)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1499 (or no-error-if-not-dir-p
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1500 (file-directory-p dirname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1501 (error "Attempt to insert a non-directory: %s" dirname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1502 (let ((elt (assoc dirname dired-subdir-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1503 switches-have-R mark-alist case-fold-search buffer-read-only)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1504 ;; case-fold-search is nil now, so we can test for capital `R':
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1505 (if (setq switches-have-R (and switches (string-match "R" switches)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1506 ;; avoid duplicated subdirs
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1507 (setq mark-alist (dired-kill-tree dirname t)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1508 (if elt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1509 ;; If subdir is already present, remove it and remember its marks
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1510 (setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1511 (dired-insert-subdir-newpos dirname)) ; else compute new position
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1512 (dired-insert-subdir-doupdate
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1513 dirname elt (dired-insert-subdir-doinsert dirname switches))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1514 (if switches-have-R (dired-build-subdir-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1515 (dired-initial-position dirname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1516 (save-excursion (dired-mark-remembered mark-alist))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1517
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1518 ;; This is a separate function for dired-vms.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1519 (defun dired-insert-subdir-validate (dirname &optional switches)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1520 ;; Check that it is valid to insert DIRNAME with SWITCHES.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1521 ;; Signal an error if invalid (e.g. user typed `i' on `..').
5281
edd5fb2614b1 Autoload dired-.*-file.
Richard M. Stallman <rms@gnu.org>
parents: 5144
diff changeset
1522 (or (dired-in-this-tree dirname (expand-file-name default-directory))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1523 (error "%s: not in this directory tree" dirname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1524 (if switches
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1525 (let (case-fold-search)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1526 (mapcar
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1527 (function
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1528 (lambda (x)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1529 (or (eq (null (string-match x switches))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1530 (null (string-match x dired-actual-switches)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1531 (error "Can't have dirs with and without -%s switches together"
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1532 x))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1533 ;; all switches that make a difference to dired-get-filename:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1534 '("F" "b")))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1535
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1536 (defun dired-alist-add (dir new-marker)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1537 ;; Add new DIR at NEW-MARKER. Sort alist.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1538 (dired-alist-add-1 dir new-marker)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1539 (dired-alist-sort))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1540
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1541 (defun dired-alist-sort ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1542 ;; Keep the alist sorted on buffer position.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1543 (setq dired-subdir-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1544 (sort dired-subdir-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1545 (function (lambda (elt1 elt2)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1546 (> (dired-get-subdir-min elt1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1547 (dired-get-subdir-min elt2)))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1548
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1549 (defun dired-kill-tree (dirname &optional remember-marks)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1550 ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1551 ;; With optional arg REMEMBER-MARKS, return an alist of marked files."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1552 (interactive "DKill tree below directory: ")
8793
babecf4f73c6 (dired-fun-in-all-buffers): Expand dir at start.
Richard M. Stallman <rms@gnu.org>
parents: 8236
diff changeset
1553 (setq dirname (expand-file-name dirname))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1554 (let ((s-alist dired-subdir-alist) dir m-alist)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1555 (while s-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1556 (setq dir (car (car s-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1557 s-alist (cdr s-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1558 (if (and (not (string-equal dir dirname))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1559 (dired-in-this-tree dir dirname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1560 (dired-goto-subdir dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1561 (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1562 m-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1563
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1564 (defun dired-insert-subdir-newpos (new-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1565 ;; Find pos for new subdir, according to tree order.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1566 ;;(goto-char (point-max))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1567 (let ((alist dired-subdir-alist) elt dir pos new-pos)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1568 (while alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1569 (setq elt (car alist)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1570 alist (cdr alist)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1571 dir (car elt)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1572 pos (dired-get-subdir-min elt))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1573 (if (dired-tree-lessp dir new-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1574 ;; Insert NEW-DIR after DIR
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1575 (setq new-pos (dired-get-subdir-max elt)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1576 alist nil)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1577 (goto-char new-pos))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1578 ;; want a separating newline between subdirs
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1579 (or (eobp)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1580 (forward-line -1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1581 (insert "\n")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1582 (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1583
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1584 (defun dired-insert-subdir-del (element)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1585 ;; Erase an already present subdir (given by ELEMENT) from buffer.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1586 ;; Move to that buffer position. Return a mark-alist.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1587 (let ((begin-marker (dired-get-subdir-min element)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1588 (goto-char begin-marker)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1589 ;; Are at beginning of subdir (and inside it!). Now determine its end:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1590 (goto-char (dired-subdir-max))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1591 (or (eobp);; want a separating newline _between_ subdirs:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1592 (forward-char -1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1593 (prog1
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1594 (dired-remember-marks begin-marker (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1595 (delete-region begin-marker (point)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1596
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1597 (defun dired-insert-subdir-doinsert (dirname switches)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1598 ;; Insert ls output after point and put point on the correct
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1599 ;; position for the subdir alist.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1600 ;; Return the boundary of the inserted text (as list of BEG and END).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1601 (let ((begin (point)) end)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1602 (message "Reading directory %s..." dirname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1603 (let ((dired-actual-switches
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1604 (or switches
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1605 (dired-replace-in-string "R" "" dired-actual-switches))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1606 (if (equal dirname (car (car (reverse dired-subdir-alist))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1607 ;; top level directory may contain wildcards:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1608 (dired-readin-insert dired-directory)
6633
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
1609 (let ((opoint (point)))
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
1610 (insert-directory dirname dired-actual-switches nil t)
451a2973d86b (dired-add-entry, dired-insert-subdir-doinsert):
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
1611 (dired-insert-set-properties opoint (point)))))
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1612 (message "Reading directory %s...done" dirname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1613 (setq end (point-marker))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1614 (indent-rigidly begin end 2)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1615 ;; call dired-insert-headerline afterwards, as under VMS dired-ls
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1616 ;; does insert the headerline itself and the insert function just
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1617 ;; moves point.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1618 ;; Need a marker for END as this inserts text.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1619 (goto-char begin)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1620 (dired-insert-headerline dirname)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1621 ;; point is now like in dired-build-subdir-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1622 (prog1
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1623 (list begin (marker-position end))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1624 (set-marker end nil))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1625
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1626 (defun dired-insert-subdir-doupdate (dirname elt beg-end)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1627 ;; Point is at the correct subdir alist position for ELT,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1628 ;; BEG-END is the subdir-region (as list of begin and end).
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1629 (if elt ; subdir was already present
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1630 ;; update its position (should actually be unchanged)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1631 (set-marker (dired-get-subdir-min elt) (point-marker))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1632 (dired-alist-add dirname (point-marker)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1633 ;; The hook may depend on the subdir-alist containing the just
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1634 ;; inserted subdir, so run it after dired-alist-add:
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1635 (if dired-after-readin-hook
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1636 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1637 (let ((begin (nth 0 beg-end))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1638 (end (nth 1 beg-end)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1639 (goto-char begin)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1640 (save-restriction
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1641 (narrow-to-region begin end)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1642 ;; hook may add or delete lines, but the subdir boundary
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1643 ;; marker floats
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1644 (run-hooks 'dired-after-readin-hook))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1645
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1646 (defun dired-tree-lessp (dir1 dir2)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1647 ;; Lexicographic order on pathname components, like `ls -lR':
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1648 ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1649 ;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1650 ;; or DIR1 and DIR2 are in the same parentdir and their last
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1651 ;; components are string-lessp.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1652 ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1653 ;; string-lessp could arguably be replaced by file-newer-than-file-p
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1654 ;; if dired-actual-switches contained `t'.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1655 (setq dir1 (file-name-as-directory dir1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1656 dir2 (file-name-as-directory dir2))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1657 (let ((components-1 (dired-split "/" dir1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1658 (components-2 (dired-split "/" dir2)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1659 (while (and components-1
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1660 components-2
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1661 (equal (car components-1) (car components-2)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1662 (setq components-1 (cdr components-1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1663 components-2 (cdr components-2)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1664 (let ((c1 (car components-1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1665 (c2 (car components-2)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1666
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1667 (cond ((and c1 c2)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1668 (string-lessp c1 c2))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1669 ((and (null c1) (null c2))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1670 nil) ; they are equal, not lessp
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1671 ((null c1) ; c2 is a subdir of c1: c1<c2
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1672 t)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1673 ((null c2) ; c1 is a subdir of c2: c1>c2
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1674 nil)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1675 (t (error "This can't happen"))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1676
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1677 ;; There should be a builtin split function - inverse to mapconcat.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1678 (defun dired-split (pat str &optional limit)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1679 "Splitting on regexp PAT, turn string STR into a list of substrings.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1680 Optional third arg LIMIT (>= 1) is a limit to the length of the
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1681 resulting list.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1682 Thus, if SEP is a regexp that only matches itself,
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1683
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1684 (mapconcat 'identity (dired-split SEP STRING) SEP)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1685
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1686 is always equal to STRING."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1687 (let* ((start (string-match pat str))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1688 (result (list (substring str 0 start)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1689 (count 1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1690 (end (if start (match-end 0))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1691 (if end ; else nothing left
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1692 (while (and (or (not (integerp limit))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1693 (< count limit))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1694 (string-match pat str end))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1695 (setq start (match-beginning 0)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1696 count (1+ count)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1697 result (cons (substring str end start) result)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1698 end (match-end 0)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1699 start end)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1700 ))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1701 (if (and (or (not (integerp limit))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1702 (< count limit))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1703 end) ; else nothing left
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1704 (setq result
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1705 (cons (substring str end) result)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1706 (nreverse result)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1707
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1708 ;;; moving by subdirectories
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1709
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1710 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1711 (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1712 "Go to previous subdirectory, regardless of level.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1713 When called interactively and not on a subdir line, go to this subdir's line."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1714 ;;(interactive "p")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1715 (interactive
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1716 (list (if current-prefix-arg
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1717 (prefix-numeric-value current-prefix-arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1718 ;; if on subdir start already, don't stay there!
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1719 (if (dired-get-subdir) 1 0))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1720 (dired-next-subdir (- arg) no-error-if-not-found no-skip))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1721
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1722 (defun dired-subdir-min ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1723 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1724 (if (not (dired-prev-subdir 0 t t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1725 (error "Not in a subdir!")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1726 (point))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1727
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1728 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1729 (defun dired-goto-subdir (dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1730 "Go to end of header line of DIR in this dired buffer.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1731 Return value of point on success, otherwise return nil.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1732 The next char is either \\n, or \\r if DIR is hidden."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1733 (interactive
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1734 (prog1 ; let push-mark display its message
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1735 (list (expand-file-name
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1736 (completing-read "Goto in situ directory: " ; prompt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1737 dired-subdir-alist ; table
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1738 nil ; predicate
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1739 t ; require-match
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1740 (dired-current-directory))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1741 (push-mark)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1742 (setq dir (file-name-as-directory dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1743 (let ((elt (assoc dir dired-subdir-alist)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1744 (and elt
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1745 (goto-char (dired-get-subdir-min elt))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1746 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1747 ;; at either \r or \n after this function succeeds.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1748 (progn (skip-chars-forward "^\r\n")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1749 (point)))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1750
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1751 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1752 (defun dired-mark-subdir-files ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1753 "Mark all files except `.' and `..'."
7383
d635aebf8036 (dired-mark-subdir-files): Don't pass any arguments interactively.
Karl Heuer <kwzh@gnu.org>
parents: 7300
diff changeset
1754 (interactive)
724
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1755 (let ((p-min (dired-subdir-min)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1756 (dired-mark-files-in-region p-min (dired-subdir-max))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1757
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1758 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1759 (defun dired-kill-subdir (&optional remember-marks)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1760 "Remove all lines of current subdirectory.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1761 Lower levels are unaffected."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1762 ;; With optional REMEMBER-MARKS, return a mark-alist.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1763 (interactive)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1764 (let ((beg (dired-subdir-min))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1765 (end (dired-subdir-max))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1766 buffer-read-only cur-dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1767 (setq cur-dir (dired-current-directory))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1768 (if (equal cur-dir default-directory)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1769 (error "Attempt to kill top level directory"))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1770 (prog1
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1771 (if remember-marks (dired-remember-marks beg end))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1772 (delete-region beg end)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1773 (if (eobp) ; don't leave final blank line
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1774 (delete-char -1))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1775 (dired-unsubdir cur-dir))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1776
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1777 (defun dired-unsubdir (dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1778 ;; Remove DIR from the alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1779 (setq dired-subdir-alist
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1780 (delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1781
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1782 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1783 (defun dired-tree-up (arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1784 "Go up ARG levels in the dired tree."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1785 (interactive "p")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1786 (let ((dir (dired-current-directory)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1787 (while (>= arg 1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1788 (setq arg (1- arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1789 dir (file-name-directory (directory-file-name dir))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1790 ;;(setq dir (expand-file-name dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1791 (or (dired-goto-subdir dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1792 (error "Cannot go up to %s - not in this tree." dir))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1793
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1794 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1795 (defun dired-tree-down ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1796 "Go down in the dired tree."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1797 (interactive)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1798 (let ((dir (dired-current-directory)) ; has slash
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1799 pos case-fold-search) ; filenames are case sensitive
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1800 (let ((rest (reverse dired-subdir-alist)) elt)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1801 (while rest
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1802 (setq elt (car rest)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1803 rest (cdr rest))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1804 (if (dired-in-this-tree (directory-file-name (car elt)) dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1805 (setq rest nil
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1806 pos (dired-goto-subdir (car elt))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1807 (if pos
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1808 (goto-char pos)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1809 (error "At the bottom"))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1810
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1811 ;;; hiding
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1812
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1813 (defun dired-unhide-subdir ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1814 (let (buffer-read-only)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1815 (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1816
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1817 (defun dired-hide-check ()
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1818 (or selective-display
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1819 (error "selective-display must be t for subdir hiding to work!")))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1820
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1821 (defun dired-subdir-hidden-p (dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1822 (and selective-display
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1823 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1824 (dired-goto-subdir dir)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1825 (looking-at "\r"))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1826
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1827 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1828 (defun dired-hide-subdir (arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1829 "Hide or unhide the current subdirectory and move to next directory.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1830 Optional prefix arg is a repeat factor.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1831 Use \\[dired-hide-all] to (un)hide all directories."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1832 (interactive "p")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1833 (dired-hide-check)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1834 (while (>= (setq arg (1- arg)) 0)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1835 (let* ((cur-dir (dired-current-directory))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1836 (hidden-p (dired-subdir-hidden-p cur-dir))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1837 (elt (assoc cur-dir dired-subdir-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1838 (end-pos (1- (dired-get-subdir-max elt)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1839 buffer-read-only)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1840 ;; keep header line visible, hide rest
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1841 (goto-char (dired-get-subdir-min elt))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1842 (skip-chars-forward "^\n\r")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1843 (if hidden-p
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1844 (subst-char-in-region (point) end-pos ?\r ?\n)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1845 (subst-char-in-region (point) end-pos ?\n ?\r)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1846 (dired-next-subdir 1 t)))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1847
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1848 ;;;###autoload
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1849 (defun dired-hide-all (arg)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1850 "Hide all subdirectories, leaving only their header lines.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1851 If there is already something hidden, make everything visible again.
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1852 Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1853 (interactive "P")
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1854 (dired-hide-check)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1855 (let (buffer-read-only)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1856 (if (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1857 (goto-char (point-min))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1858 (search-forward "\r" nil t))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1859 ;; unhide - bombs on \r in filenames
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1860 (subst-char-in-region (point-min) (point-max) ?\r ?\n)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1861 ;; hide
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1862 (let ((pos (point-max)) ; pos of end of last directory
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1863 (alist dired-subdir-alist))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1864 (while alist ; while there are dirs before pos
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1865 (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1866 (save-excursion
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1867 (goto-char pos) ; current dir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1868 ;; we're somewhere on current dir's line
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1869 (forward-line -1)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1870 (point))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1871 ?\n ?\r)
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1872 (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1873 (setq alist (cdr alist)))))))
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1874
fb86b8eef4e5 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1875 ;;;###end dired-ins.el
794
2598c08c91c2 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 724
diff changeset
1876
9660
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1877
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1878 ;; Functions for searching in tags style among marked files.
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1879
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1880 ;;;###autoload
11458
43ce6ed860a6 (dired-do-search): Renamed from dired-do-tags-search.
Richard M. Stallman <rms@gnu.org>
parents: 11395
diff changeset
1881 (defun dired-do-search (regexp)
9660
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1882 "Search through all marked files for a match for REGEXP.
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1883 Stops when a match is found.
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1884 To continue searching for next match, use command \\[tags-loop-continue]."
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1885 (interactive "sSearch marked files (regexp): ")
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1886 (tags-search regexp '(dired-get-marked-files)))
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1887
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1888 ;;;###autoload
11458
43ce6ed860a6 (dired-do-search): Renamed from dired-do-tags-search.
Richard M. Stallman <rms@gnu.org>
parents: 11395
diff changeset
1889 (defun dired-do-query-replace (from to &optional delimited)
43ce6ed860a6 (dired-do-search): Renamed from dired-do-tags-search.
Richard M. Stallman <rms@gnu.org>
parents: 11395
diff changeset
1890 "Do `query-replace-regexp' of FROM with TO, on all marked files.
9660
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1891 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
11458
43ce6ed860a6 (dired-do-search): Renamed from dired-do-tags-search.
Richard M. Stallman <rms@gnu.org>
parents: 11395
diff changeset
1892 If you exit (\\[keyboard-quit] or ESC), you can resume the query replace
9660
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1893 with the command \\[tags-loop-continue]."
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1894 (interactive
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1895 "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1896 (tags-query-replace from to delimited '(dired-get-marked-files)))
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1897
adcb2e49f6a2 (dired-do-tags-search, dired-do-tags-query-replace): New functions.
Roland McGrath <roland@gnu.org>
parents: 9221
diff changeset
1898
7838
8c3ed9be9bed Add provide call.
Richard M. Stallman <rms@gnu.org>
parents: 7383
diff changeset
1899 (provide 'dired-aux)
8c3ed9be9bed Add provide call.
Richard M. Stallman <rms@gnu.org>
parents: 7383
diff changeset
1900
807
4f28bd14272c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 794
diff changeset
1901 ;;; dired-aux.el ends here