|
22
|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
2 ;;
|
|
|
3 ;; File: dired-rgxp.el
|
|
42
|
4 ;; Dired Version: #Revision: 7.9 $
|
|
22
|
5 ;; RCS:
|
|
|
6 ;; Description: Commands for running commands on files whose names
|
|
|
7 ;; match a regular expression.
|
|
|
8 ;;
|
|
|
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
10
|
|
|
11 ;;; Requirements and provisions
|
|
|
12 (provide 'dired-rgxp)
|
|
|
13 (require 'dired)
|
|
|
14
|
|
|
15 ;;; Variables
|
|
|
16
|
|
|
17 (defvar dired-flagging-regexp nil)
|
|
|
18 ;; Last regexp used to flag files.
|
|
|
19
|
|
|
20 ;;; Utility functions
|
|
|
21
|
|
|
22 (defun dired-do-create-files-regexp
|
|
|
23 (file-creator operation arg regexp newname &optional whole-path marker-char)
|
|
|
24 ;; Create a new file for each marked file using regexps.
|
|
|
25 ;; FILE-CREATOR and OPERATION as in dired-create-files.
|
|
|
26 ;; ARG as in dired-get-marked-files.
|
|
|
27 ;; Matches each marked file against REGEXP and constructs the new
|
|
|
28 ;; filename from NEWNAME (like in function replace-match).
|
|
|
29 ;; Optional arg WHOLE-PATH means match/replace the whole pathname
|
|
|
30 ;; instead of only the non-directory part of the file.
|
|
|
31 ;; Optional arg MARKER-CHAR as in dired-create-files.
|
|
|
32 (let* ((fn-list (dired-get-marked-files nil arg))
|
|
|
33 (name-constructor
|
|
|
34 (if whole-path
|
|
|
35 (list 'lambda '(from)
|
|
|
36 (list 'let
|
|
|
37 (list (list 'to
|
|
|
38 (list 'dired-string-replace-match
|
|
|
39 regexp 'from newname)))
|
|
|
40 (list 'or 'to
|
|
|
41 (list 'dired-log
|
|
|
42 '(buffer-name (current-buffer))
|
|
|
43 "%s: %s did not match regexp %s\n"
|
|
|
44 operation 'from regexp))
|
|
|
45 'to))
|
|
|
46 (list 'lambda '(from)
|
|
|
47 (list 'let
|
|
|
48 (list (list 'to
|
|
|
49 (list 'dired-string-replace-match regexp
|
|
|
50 '(file-name-nondirectory from)
|
|
|
51 newname)))
|
|
|
52 (list 'or 'to
|
|
|
53 (list 'dired-log '(buffer-name (current-buffer))
|
|
|
54 "%s: %s did not match regexp %s\n"
|
|
|
55 operation '(file-name-nondirectory from)
|
|
|
56 regexp))
|
|
|
57 '(and to
|
|
|
58 (expand-file-name
|
|
|
59 to (file-name-directory from)))))))
|
|
|
60 (operation-prompt (concat operation " `%s' to `%s'?"))
|
|
|
61 (rename-regexp-help-form (format "\
|
|
|
62 Type SPC or `y' to %s one match, DEL or `n' to skip to next,
|
|
|
63 `!' to %s all remaining matches with no more questions."
|
|
|
64 (downcase operation)
|
|
|
65 (downcase operation)))
|
|
|
66 (query (list 'lambda '(from to)
|
|
|
67 (list 'let
|
|
|
68 (list (list 'help-form
|
|
|
69 rename-regexp-help-form))
|
|
|
70 (list 'dired-query
|
|
|
71 '(quote dired-file-creator-query)
|
|
|
72 operation-prompt
|
|
|
73 '(dired-abbreviate-file-name from)
|
|
|
74 '(dired-abbreviate-file-name to))))))
|
|
|
75 (dired-create-files
|
|
|
76 file-creator operation fn-list name-constructor marker-char query)))
|
|
|
77
|
|
|
78 (defun dired-mark-read-regexp (operation)
|
|
|
79 ;; Prompt user about performing OPERATION.
|
|
|
80 ;; Read and return list of: regexp newname arg whole-path.
|
|
|
81 (let* ((whole-path
|
|
|
82 (equal 0 (prefix-numeric-value current-prefix-arg)))
|
|
|
83 (arg
|
|
|
84 (if whole-path nil current-prefix-arg))
|
|
|
85 (regexp
|
|
|
86 (dired-read-with-history
|
|
|
87 (concat (if whole-path "Path " "") operation " from (regexp): ")
|
|
|
88 dired-flagging-regexp 'dired-regexp-history))
|
|
|
89 (newname
|
|
|
90 (read-string
|
|
|
91 (concat (if whole-path "Path " "") operation " " regexp " to: ")
|
|
|
92 (and (not whole-path) (dired-dwim-target-directory)))))
|
|
|
93 (list regexp newname arg whole-path)))
|
|
|
94
|
|
|
95 ;;; Marking file names matching a regexp.
|
|
|
96
|
|
|
97 (defun dired-mark-files-regexp (regexp &optional marker-char omission-files-p)
|
|
|
98 "\\<dired-mode-map>Mark all files matching REGEXP for use in later commands.
|
|
|
99
|
|
|
100 A prefix argument \\[universal-argument] means to unmark them instead.
|
|
|
101
|
|
|
102 A prefix argument 0 means to mark the files that would me omitted by \\[dired-omit-toggle].
|
|
|
103 A prefix argument 1 means to unmark the files that would be omitted by \\[dired-omit-toggle].
|
|
|
104
|
|
|
105 REGEXP is an Emacs regexp, not a shell wildcard. Thus, use \"\\.o$\" for
|
|
|
106 object files--just `.o' will mark more than you might think. The files \".\"
|
|
|
107 and \"..\" are never marked.
|
|
|
108 "
|
|
|
109 (interactive
|
|
|
110 (let ((unmark (and (not (eq current-prefix-arg 0)) current-prefix-arg))
|
|
|
111 (om-files-p (memq current-prefix-arg '(0 1)))
|
|
|
112 regexp)
|
|
|
113 (if om-files-p
|
|
|
114 (setq regexp (dired-omit-regexp))
|
|
|
115 (setq regexp (dired-read-with-history
|
|
|
116 (concat (if unmark "Unmark" "Mark")
|
|
|
117 " files (regexp): ") nil
|
|
|
118 'dired-regexp-history)))
|
|
|
119 (list regexp (if unmark ?\ ) om-files-p)))
|
|
|
120 (let ((dired-marker-char (or marker-char dired-marker-char)))
|
|
|
121 (dired-mark-if
|
|
|
122 (and (not (looking-at dired-re-dot))
|
|
|
123 (not (eolp)) ; empty line
|
|
|
124 (let ((fn (dired-get-filename nil t)))
|
|
|
125 (and fn (string-match regexp (file-name-nondirectory fn)))))
|
|
|
126 (if omission-files-p
|
|
|
127 "omission candidate file"
|
|
|
128 "matching file"))))
|
|
|
129
|
|
|
130 (defun dired-flag-files-regexp (regexp)
|
|
|
131 "In dired, flag all files containing the specified REGEXP for deletion.
|
|
|
132 The match is against the non-directory part of the filename. Use `^'
|
|
|
133 and `$' to anchor matches. Exclude subdirs by hiding them.
|
|
|
134 `.' and `..' are never flagged."
|
|
|
135 (interactive (list (dired-read-with-history
|
|
|
136 "Flag for deletion (regexp): " nil
|
|
|
137 'dired-regexp-history)))
|
|
|
138 (dired-mark-files-regexp regexp dired-del-marker))
|
|
|
139
|
|
|
140 (defun dired-mark-extension (extension &optional marker-char)
|
|
|
141 "Mark all files with a certain extension for use in later commands.
|
|
|
142 A `.' is not prepended to the string entered."
|
|
|
143 ;; EXTENSION may also be a list of extensions instead of a single one.
|
|
|
144 ;; Optional MARKER-CHAR is marker to use.
|
|
|
145 (interactive "sMark files with extension: \nP")
|
|
|
146 (or (listp extension)
|
|
|
147 (setq extension (list extension)))
|
|
|
148 (dired-mark-files-regexp
|
|
|
149 (concat ".";; don't match names with nothing but an extension
|
|
|
150 "\\("
|
|
|
151 (mapconcat 'regexp-quote extension "\\|")
|
|
|
152 "\\)$")
|
|
|
153 marker-char))
|
|
|
154
|
|
|
155 (defun dired-flag-extension (extension)
|
|
|
156 "In dired, flag all files with a certain extension for deletion.
|
|
|
157 A `.' is not prepended to the string entered."
|
|
|
158 (interactive "sFlag files with extension: ")
|
|
|
159 (dired-mark-extension extension dired-del-marker))
|
|
|
160
|
|
|
161 (defun dired-cleanup (program)
|
|
|
162 "Flag for deletion dispensable files created by PROGRAM.
|
|
|
163 See variable `dired-cleanup-alist'."
|
|
|
164 (interactive
|
|
|
165 (list
|
|
|
166 (let ((dired-cleanup-history (append dired-cleanup-history
|
|
|
167 (mapcar 'car dired-cleanup-alist))))
|
|
|
168 (dired-completing-read
|
|
|
169 "Cleanup files for: " dired-cleanup-alist nil t nil
|
|
|
170 'dired-cleanup-history))))
|
|
|
171 (dired-flag-extension (cdr (assoc program dired-cleanup-alist))))
|
|
|
172
|
|
|
173 ;;; Commands on marked files whose names also match a regexp.
|
|
|
174
|
|
|
175 (defun dired-do-rename-regexp (regexp newname &optional arg whole-path)
|
|
|
176 "Rename marked files containing REGEXP to NEWNAME.
|
|
|
177 As each match is found, the user must type a character saying
|
|
|
178 what to do with it. For directions, type \\[help-command] at that time.
|
|
|
179 NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
|
|
|
180 REGEXP defaults to the last regexp used.
|
|
|
181 With a zero prefix arg, renaming by regexp affects the complete
|
|
|
182 pathname - usually only the non-directory part of file names is used
|
|
|
183 and changed."
|
|
|
184 (interactive (dired-mark-read-regexp "Rename"))
|
|
|
185 (dired-do-create-files-regexp
|
|
|
186 (function dired-rename-file)
|
|
|
187 "Rename" arg regexp newname whole-path dired-keep-marker-rename))
|
|
|
188
|
|
|
189 (defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
|
|
|
190 "Copy all marked files containing REGEXP to NEWNAME.
|
|
|
191 See function `dired-rename-regexp' for more info."
|
|
|
192 (interactive (dired-mark-read-regexp "Copy"))
|
|
|
193 (dired-do-create-files-regexp
|
|
|
194 (function dired-copy-file)
|
|
|
195 (if dired-copy-preserve-time "Copy [-p]" "Copy")
|
|
|
196 arg regexp newname whole-path dired-keep-marker-copy))
|
|
|
197
|
|
|
198 (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
|
|
|
199 "Hardlink all marked files containing REGEXP to NEWNAME.
|
|
|
200 See function `dired-rename-regexp' for more info."
|
|
|
201 (interactive (dired-mark-read-regexp "HardLink"))
|
|
|
202 (dired-do-create-files-regexp
|
|
|
203 (function add-name-to-file)
|
|
|
204 "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink))
|
|
|
205
|
|
|
206 (defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
|
|
|
207 "Symlink all marked files containing REGEXP to NEWNAME.
|
|
|
208 See function `dired-rename-regexp' for more info."
|
|
|
209 (interactive (dired-mark-read-regexp "SymLink"))
|
|
|
210 (dired-do-create-files-regexp
|
|
|
211 (function make-symbolic-link)
|
|
|
212 "SymLink" arg regexp newname whole-path dired-keep-marker-symlink))
|
|
|
213
|
|
|
214 (defun dired-do-relsymlink-regexp (regexp newname &optional whole-path)
|
|
|
215 "RelSymlink all marked files containing REGEXP to NEWNAME.
|
|
|
216 See functions `dired-rename-regexp' and `dired-do-relsymlink'
|
|
|
217 for more info."
|
|
|
218 (interactive (dired-mark-read-regexp "RelSymLink"))
|
|
|
219 (dired-do-create-files-regexp
|
|
|
220 (function dired-make-relative-symlink)
|
|
|
221 "RelSymLink" nil regexp newname whole-path dired-keep-marker-symlink))
|
|
|
222
|
|
|
223 ;;;; Modifying the case of file names.
|
|
|
224
|
|
|
225 (defun dired-create-files-non-directory
|
|
|
226 (file-creator basename-constructor operation arg)
|
|
|
227 ;; Perform FILE-CREATOR on the non-directory part of marked files
|
|
|
228 ;; using function BASENAME-CONSTRUCTOR, with query for each file.
|
|
|
229 ;; OPERATION like in dired-create-files, ARG like in dired-get-marked-files.
|
|
|
230 (let (rename-non-directory-query)
|
|
|
231 (dired-create-files
|
|
|
232 file-creator
|
|
|
233 operation
|
|
|
234 (dired-get-marked-files nil arg)
|
|
|
235 (function
|
|
|
236 (lambda (from)
|
|
|
237 (let ((to (concat (file-name-directory from)
|
|
|
238 (funcall basename-constructor
|
|
|
239 (file-name-nondirectory from)))))
|
|
|
240 (and (let ((help-form (format "\
|
|
|
241 Type SPC or `y' to %s one file, DEL or `n' to skip to next,
|
|
|
242 `!' to %s all remaining matches with no more questions."
|
|
|
243 (downcase operation)
|
|
|
244 (downcase operation))))
|
|
|
245 (dired-query 'rename-non-directory-query
|
|
|
246 (concat operation " `%s' to `%s'")
|
|
|
247 (dired-make-relative from)
|
|
|
248 (dired-make-relative to)))
|
|
|
249 to))))
|
|
|
250 dired-keep-marker-rename)))
|
|
|
251
|
|
|
252 (defun dired-rename-non-directory (basename-constructor operation arg)
|
|
|
253 (dired-create-files-non-directory
|
|
|
254 (function dired-rename-file)
|
|
|
255 basename-constructor operation arg))
|
|
|
256
|
|
|
257 (defun dired-upcase (&optional arg)
|
|
|
258 "Rename all marked (or next ARG) files to upper case."
|
|
|
259 (interactive "P")
|
|
|
260 (dired-rename-non-directory (function upcase) "Rename upcase" arg))
|
|
|
261
|
|
|
262 (defun dired-downcase (&optional arg)
|
|
|
263 "Rename all marked (or next ARG) files to lower case."
|
|
|
264 (interactive "P")
|
|
|
265 (dired-rename-non-directory (function downcase) "Rename downcase" arg))
|
|
|
266
|
|
|
267 ;;; end of dired-rgxp.el
|
