Mercurial > hg > xemacs-beta

comparison lisp/efs/dired-rgxp.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 7e54bd776075 9f59509498e1
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;;
3 ;; File: dired-rgxp.el
4 ;; Dired Version: $Revision: 1.1 $
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