|
22
|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
2 ;;
|
|
|
3 ;; File: dired-shell.el
|
|
116
|
4 ;; Dired Version: #Revision: 7.9 $
|
|
22
|
5 ;; RCS:
|
|
|
6 ;; Description: Commands for running shell commands on marked files.
|
|
|
7 ;;
|
|
|
8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
9
|
|
|
10 ;;; Requirements and provisions
|
|
|
11 (provide 'dired-shell)
|
|
|
12 (require 'dired)
|
|
|
13 (autoload 'comint-mode "comint")
|
|
|
14
|
|
|
15 ;;; Variables
|
|
|
16
|
|
|
17 (defvar dired-postscript-print-command
|
|
114
|
18 (condition-case nil
|
|
|
19 (progn
|
|
|
20 (require 'ps-print)
|
|
|
21 (concat ps-lpr-command
|
|
|
22 " "
|
|
|
23 (ps-flatten-list (mapcar 'ps-eval-switch ps-lpr-switches))))
|
|
|
24 (error
|
|
|
25 (concat
|
|
|
26 (if (boundp 'lpr-command)
|
|
|
27 lpr-command
|
|
|
28 (if (memq system-type
|
|
|
29 '(usg-unix-v hpux silicon-graphics-unix))
|
|
|
30 "lp"
|
|
|
31 "lpr"))
|
|
|
32 (if (and (boundp 'lpr-switches) lpr-switches)
|
|
|
33 (concat " "
|
|
|
34 (mapconcat 'identity lpr-switches " ")
|
|
|
35 " ")
|
|
|
36 " "))))
|
|
|
37 "Command to print a postscript file.")
|
|
22
|
38
|
|
114
|
39 (defvar dired-text-print-command (concat dired-postscript-print-command "-p ")
|
|
22
|
40 "Command to print a text file.")
|
|
|
41
|
|
|
42 (defvar dired-print-program-alist
|
|
|
43 (list
|
|
|
44 (cons "\\.gif$" (concat "giftoppm * | ppmtopgm | pnmtops | "
|
|
|
45 dired-postscript-print-command))
|
|
|
46 (cons "\\.\\(fts\\|FTS\\)$" (concat "fitstopgm * | pnmtops | "
|
|
|
47 dired-postscript-print-command))
|
|
|
48 ;; People with colour printers won't want the g-flag in djpeg
|
|
|
49 (cons "\\.\\(JPG\\|jpg\\)$" (concat "djpeg -Pg * | pnmtops | "
|
|
|
50 dired-postscript-print-command))
|
|
|
51 (cons "\\.ps\\.\\(gz\\|Z\\)$" (concat "zcat * | "
|
|
|
52 dired-postscript-print-command))
|
|
|
53 (cons "\\.ps$" dired-postscript-print-command)
|
|
|
54 (cons "\\.\\(gz\\|Z\\)$" (concat "zcat * | "
|
|
|
55 dired-postscript-print-command))
|
|
|
56 (cons "\\.dvi$" "dvips")
|
|
|
57 (cons ".*" dired-text-print-command))
|
|
|
58 "Alist of regexps and print commands.
|
|
|
59 This is used by `dired-do-print' to determine the default print command for
|
|
|
60 printing the marked files.")
|
|
|
61
|
|
|
62 (defvar dired-auto-shell-command-alist nil
|
|
|
63 "*Alist of regexps and command lists to guess shell commands.
|
|
|
64 Each element of this list should be a list of regular expression, and a list
|
|
|
65 of guesses for shell commands to be used if the file name matches the regular
|
|
|
66 expression. The list of guesses is evalled. This alist is appended to the front
|
|
|
67 of dired-default-auto-shell-command-alist before prompting for each shell
|
|
|
68 command.")
|
|
|
69
|
|
|
70 (defvar dired-default-auto-shell-command-alist
|
|
|
71 (list
|
|
|
72
|
|
|
73 ;; Archiving
|
|
|
74 '("\\.tar$"
|
|
|
75 (if dired-gnutar-program
|
|
|
76 (concat dired-gnutar-program " xvf")
|
|
|
77 "tar xvf")
|
|
|
78 (if dired-gnutar-program
|
|
|
79 (concat dired-gnutar-program " tvf")
|
|
|
80 "tar tvf"))
|
|
|
81 ;; regexps for compressed archives must come before the .Z rule to
|
|
|
82 ;; be recognized:
|
|
|
83 '("\\.tar\\.\\([zZ]\\|gz\\)\\|\\.tgz$" ; .tgz is for DOS
|
|
|
84 (if dired-gnutar-program
|
|
|
85 (concat dired-gnutar-program " zxvf")
|
|
|
86 "zcat * | tar xvf -")
|
|
|
87 (if dired-gnutar-program
|
|
|
88 (concat dired-gnutar-program " ztvf")
|
|
|
89 "zcat * | tar tvf -"))
|
|
|
90 '("\\.shar.[zZ]$" (if dired-unshar-program
|
|
|
91 (concat "zcat * | " dired-unshar-program)
|
|
|
92 "zcat * | sh"))
|
|
|
93 '("\\.zoo$" "zoo x//")
|
|
|
94 '("\\.zip$" "unzip" "unzip -v")
|
|
|
95 '("\\.lzh$" "lharc x")
|
|
|
96 '("\\.arc$" "arc x")
|
|
|
97 '("\\.shar$" (if dired-unshar-program dired-unshar-program "sh"))
|
|
|
98
|
|
|
99 ;; Encoding/compressing
|
|
|
100 '("\\.uu$" "uudecode")
|
|
|
101 '("\\.hqx$" "mcvert")
|
|
|
102
|
|
|
103 ;; Executing (in the generalized sense)
|
|
|
104 '("\\.sh$" "sh") ; execute shell scripts
|
|
|
105 '("^[Mm]akefile$" "make -f *")
|
|
|
106 '("\\.diff$" "patch -t <")
|
|
|
107
|
|
|
108 ;; Displaying (assumes X)
|
|
|
109 '("\\.xbm$" "bitmap") ; view X11 bitmaps
|
|
|
110 '("\\.gp$" "gnuplot")
|
|
|
111 '("\\.gif$" "xv") ; view gif pictures
|
|
|
112 '("\\.fig$" "xfig") ; edit fig pictures
|
|
|
113 '("\\.ps$" "ghostview")
|
|
|
114
|
|
|
115 ;; Typesetting. For printing documents, see dired-print-program-alist.
|
|
|
116 '("\\.tex$" "latex" "tex")
|
|
|
117 '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi")
|
|
|
118 (if (eq window-system 'x)
|
|
|
119 (if dired-use-file-transformers
|
|
|
120 '("\\.dvi$" "xdvi" "dvips -o *b.ps *")
|
|
|
121 '("\\.dvi$" "xdvi" "dvips"))
|
|
|
122 (if dired-use-file-transformers
|
|
|
123 '("\\.dvi$" "dvips -o *b.ps *")
|
|
|
124 '("\\.dvi$" "dvips")))
|
|
|
125
|
|
|
126 ;; The last word. Things that cannot be grokked with a regexp.
|
|
|
127 '("." (if (> (length files) 1)
|
|
|
128 "tar cvf "
|
|
|
129 (and (= (length files) 1) (file-directory-p
|
|
|
130 (expand-file-name
|
|
|
131 (car files)
|
|
|
132 (dired-current-directory)))
|
|
|
133 (concat "tar cvf " (file-name-nondirectory
|
|
|
134 (directory-file-name (car files)))
|
|
|
135 ".tar"))))
|
|
|
136 )
|
|
|
137 "Default for variable `dired-auto-shell-command-alist' (which see).
|
|
|
138 Set this to nil to turn off shell command guessing.")
|
|
|
139
|
|
|
140 ;; Might use {,} for bash or csh:
|
|
|
141 (defvar dired-shell-prefix ""
|
|
|
142 "Prepended to marked files in dired shell commands.")
|
|
|
143 (defvar dired-shell-postfix ""
|
|
|
144 "Appended to marked files in dired shell commands.")
|
|
|
145 (defvar dired-shell-separator " "
|
|
|
146 "Separates marked files in dired shell commands.")
|
|
|
147
|
|
|
148 (defvar dired-file-wildcard ?*
|
|
|
149 "Wildcard character used by dired shell commands.
|
|
|
150 Indicates where file names should be inserted.")
|
|
|
151
|
|
|
152 (defvar dired-shell-command-separators '(?\ ?| ?> ?< ?& ?;)
|
|
|
153 "Defines the start of a string specifying a word in a shell command.")
|
|
|
154
|
|
|
155 (defvar dired-trans-map
|
|
|
156 (list
|
|
|
157 (cons ?f 'identity)
|
|
|
158 (cons ?n 'file-name-nondirectory)
|
|
|
159 (cons ?d 'file-name-directory)
|
|
|
160 (cons ?b 'dired-file-name-base)
|
|
|
161 (cons ?e 'dired-file-name-extension)
|
|
|
162 (cons ?v 'dired-file-name-sans-rcs-extension)
|
|
|
163 (cons ?z 'dired-file-name-sans-compress-extension))
|
|
|
164 "Alist that associates keys with file transformer functions
|
|
|
165 Each transformer function should be a funcion of one argument, the file name.
|
|
|
166 The keys are characters.")
|
|
|
167
|
|
|
168 (defvar dired-shell-failure-marker ?!
|
|
|
169 "*A marker to mark files on which shell commands fail.
|
|
|
170 If nil, such files are not marked.")
|
|
|
171
|
|
|
172 ;;; Internal variables
|
|
|
173
|
|
|
174 ;; Make sure this gets defined.
|
|
|
175 (defvar shell-command-history nil
|
|
|
176 "History list of previous shell commands.")
|
|
|
177
|
|
|
178 (defvar dired-print-history nil
|
|
|
179 "History of commands used to print files.")
|
|
|
180
|
|
|
181 (defvar dired-shell-input-start) ; only defined in shell output buffers
|
|
|
182
|
|
|
183 ;;; Utility functions and Macros
|
|
|
184
|
|
|
185 (defun dired-shell-quote (filename)
|
|
|
186 ;; Quote a file name for inferior shell (see variable shell-file-name).
|
|
|
187 ;; Quote everything except POSIX filename characters.
|
|
185
|
188 ;; This should be safe enough even for really weird shells.
|
|
22
|
189 (let ((result "") (start 0) end)
|
|
|
190 (while (string-match "[^---0-9a-zA-Z_./]" filename start)
|
|
|
191 (setq end (match-beginning 0)
|
|
|
192 result (concat result (substring filename start end)
|
|
|
193 "\\" (substring filename end (1+ end)))
|
|
|
194 start (1+ end)))
|
|
|
195 (concat result (substring filename start))))
|
|
|
196
|
|
|
197 (defun dired-uniquefy-list (list)
|
|
|
198 ;; Returns list, after removing 2nd and higher occurrences
|
|
|
199 ;; of all elements. Tests elements with equal. Retains the relative
|
|
|
200 ;; order of the elements.
|
|
|
201 ;; For small lists, this way is probably faster than sorting.
|
|
|
202 (let (result)
|
|
|
203 (while list
|
|
|
204 (or (member (car list) result)
|
|
|
205 (setq result (nconc result (list (car list)))))
|
|
|
206 (setq list (cdr list)))
|
|
|
207 result))
|
|
|
208
|
|
|
209 (defun dired-read-shell-command (prompt arg files)
|
|
|
210 ;; Read a dired shell command prompting with PROMPT (using read-string).
|
|
|
211 ;; ARG is the prefix arg and may be used to indicate in the prompt which
|
|
|
212 ;; files are affected.
|
|
|
213 (dired-mark-pop-up
|
|
|
214 nil 'shell files
|
|
|
215 (function
|
|
|
216 (lambda (prompt files)
|
|
|
217 (let* ((default (car shell-command-history))
|
|
|
218 (guesses (dired-guess-default files))
|
|
|
219 (len (length guesses))
|
|
|
220 cmd)
|
|
|
221 (or (zerop len)
|
|
|
222 (setq prompt (format "%s{%d guess%s} "
|
|
|
223 prompt len (if (= len 1) "" "es"))))
|
|
|
224 (if default (setq prompt (concat prompt "[" default "] ")))
|
|
|
225 (put 'guesses 'no-default t) ; for gmhist, in case.
|
|
|
226 (setq guesses (nconc guesses (copy-sequence shell-command-history))
|
|
|
227 cmd (dired-read-with-history prompt nil 'guesses))
|
|
|
228 (if (string-match "^[ \t\n]*$" cmd)
|
|
|
229 (if default
|
|
|
230 (setq cmd default)
|
|
|
231 (error "No shell command given.")))
|
|
|
232 (setq shell-command-history
|
|
|
233 (dired-uniquefy-list
|
|
|
234 (cons cmd shell-command-history)))
|
|
|
235 cmd)))
|
|
|
236 (format prompt (dired-mark-prompt arg files)) files))
|
|
|
237
|
|
|
238 (defmacro dired-trans-subst (transformers filename dir)
|
|
|
239 ;; Applies each transformer supplied in the string TRANSFORMERS in sequence
|
|
|
240 ;; to FILE and returns the concatenation of the results. Also unquotes \\'s.
|
|
|
241 ;; Returns a string if no file transformations were done, otherwise a list
|
|
|
242 ;; consisting of a single string.
|
|
|
243 (` (let* ((transformers (, transformers))
|
|
|
244 (filename (, filename))
|
|
|
245 (len (length transformers))
|
|
|
246 (pos 0)
|
|
|
247 (last 0)
|
|
|
248 (transformed nil)
|
|
|
249 (quoted nil)
|
|
|
250 char result trans)
|
|
|
251 (while (< pos len)
|
|
|
252 (setq char (aref transformers pos))
|
|
|
253 (cond
|
|
|
254 (quoted (setq pos (1+ pos)
|
|
|
255 quoted nil))
|
|
|
256 ((= ?\\ char)
|
|
|
257 (setq quoted t
|
|
|
258 result (concat result (substring transformers last pos))
|
|
|
259 pos (1+ pos)
|
|
|
260 last pos))
|
|
|
261 ((and (null quoted) (= char dired-file-wildcard))
|
|
|
262 (setq pos (1+ pos)
|
|
|
263 trans (and (< pos len)
|
|
|
264 dired-use-file-transformers
|
|
|
265 (assq (aref transformers pos)
|
|
|
266 dired-trans-map))
|
|
|
267 transformed t)
|
|
|
268 (if trans
|
|
|
269 (setq result (concat result
|
|
|
270 (substring transformers last (1- pos))
|
|
|
271 (funcall (cdr trans) filename))
|
|
|
272 pos (1+ pos)
|
|
|
273 last pos)
|
|
|
274 (setq result (concat result (substring transformers last (1- pos))
|
|
|
275 (dired-make-relative filename (, dir) t))
|
|
|
276 last pos)))
|
|
|
277 ((setq pos (1+ pos)))))
|
|
|
278 (if result
|
|
|
279 (progn
|
|
|
280 (setq result (dired-shell-quote
|
|
|
281 (concat result (substring transformers last))))
|
|
|
282 (if transformed (list result) result))
|
|
|
283 transformers))))
|
|
|
284
|
|
|
285 (defun dired-trans-filenames (transformers files dir)
|
|
|
286 ;; Applies a transformer string to a list of filenames,
|
|
|
287 ;; concatenating them into a string. The result will be prefixed
|
|
|
288 ;; by dired-shell-prefix, the filenames separated by dired-shell-separator,
|
|
|
289 ;; and postfixed by dired-shell-postfix.
|
|
|
290 ;; Returns a list if filename subst. was done. A string otherwise.
|
|
|
291 (let ((list files)
|
|
|
292 (res nil)
|
|
|
293 trans)
|
|
|
294 (while list
|
|
|
295 (setq trans (dired-trans-subst transformers (car list) dir))
|
|
|
296 (if (listp trans)
|
|
|
297 (setq res (nconc res trans)
|
|
|
298 list (cdr list))
|
|
|
299 (setq res trans
|
|
|
300 list nil)))
|
|
|
301 (if (listp res)
|
|
|
302 (list
|
|
|
303 (if (> (length files) 1)
|
|
|
304 (concat dired-shell-prefix
|
|
|
305 (mapconcat 'identity res dired-shell-separator)
|
|
|
306 dired-shell-postfix)
|
|
|
307 (car res)))
|
|
|
308 res)))
|
|
|
309
|
|
|
310 (defun dired-trans-command (command files dir)
|
|
|
311 ;; Do all of the trans substitutions in COMMAND for the list
|
|
|
312 ;; of files FILES. FILES must be a list of *absolute* pathnames.
|
|
|
313 ;; DIR is an absolute directory wrto which filenames may be relativized.
|
|
|
314 (let ((len (length command))
|
|
|
315 (start 0)
|
|
|
316 (pos 0)
|
|
|
317 (last 0)
|
|
|
318 result char transed transform)
|
|
|
319 (while (< pos len)
|
|
|
320 ;; read over word separators.
|
|
|
321 (while (and (< pos len) (memq (aref command pos)
|
|
|
322 dired-shell-command-separators))
|
|
|
323 (setq pos (1+ pos)))
|
|
|
324 (setq start pos)
|
|
|
325 ;; read a word
|
|
|
326 (while (and (< pos len) (not (memq (setq char (aref command pos))
|
|
|
327 dired-shell-command-separators)))
|
|
|
328 (setq pos (1+ pos))
|
|
|
329 ;; look out for quoted separators
|
|
|
330 (and (= ?\\ char) (< pos len) (or (memq (setq char (aref command pos))
|
|
|
331 dired-shell-command-separators)
|
|
|
332 (= ?\\ char))
|
|
|
333 (setq pos (1+ pos))))
|
|
|
334 (setq transform (if (= start pos)
|
|
|
335 ""
|
|
|
336 (dired-trans-filenames (substring command start pos)
|
|
|
337 files dir))
|
|
|
338 ;; remember if we did any transforming
|
|
|
339 transed (or transed (listp transform))
|
|
|
340 result (concat result
|
|
|
341 (substring command last start)
|
|
|
342 (if (listp transform)
|
|
|
343 (car transform)
|
|
|
344 transform))
|
|
|
345 last pos))
|
|
|
346 (if transed
|
|
|
347 ;; just return result
|
|
|
348 result
|
|
|
349 ;; add the filenames at the end.
|
|
|
350 (let ((fns (if (> (length files) 1)
|
|
|
351 (concat dired-shell-prefix
|
|
|
352 (mapconcat
|
|
|
353 (function
|
|
|
354 (lambda (fn)
|
|
|
355 (dired-shell-quote
|
|
|
356 (dired-make-relative fn dir t))))
|
|
|
357 files dired-shell-separator)
|
|
|
358 dired-shell-postfix)
|
|
|
359 (dired-shell-quote
|
|
|
360 (dired-make-relative (car files) dir t)))))
|
|
|
361 (concat result " " fns)))))
|
|
|
362
|
|
|
363 (defun dired-shell-stuff-it (command file-list dir on-each)
|
|
|
364 ;; Make up a shell command line from COMMAND and FILE-LIST.
|
|
|
365 ;; If ON-EACH is t, COMMAND should be applied to each file, else
|
|
|
366 ;; simply concat all files and apply COMMAND to this.
|
|
|
367 ;; If ON-EACH is 'dir, the command is run in the directory of each file
|
|
|
368 ;; In this case FILE-LIST must be a list of full paths.
|
|
|
369 ;; FILE-LIST's elements will be quoted for the shell.
|
|
|
370 (cond
|
|
|
371 ((eq on-each 'dir)
|
|
|
372 (let ((subshell-dir nil)
|
|
|
373 (list file-list)
|
|
|
374 (result nil))
|
|
|
375 (while list
|
|
|
376 (let ((cmd (dired-trans-command command (list (car list))
|
|
|
377 (file-name-directory (car list))))
|
|
|
378 (fdir (dired-shell-quote (file-name-directory (car list)))))
|
|
|
379 (setq result
|
|
|
380 (apply 'concat
|
|
|
381 result
|
|
|
382 (if subshell-dir
|
|
|
383 (if (string-equal dir subshell-dir)
|
|
|
384 (list "\; " cmd)
|
|
|
385 (if (string-equal dir fdir)
|
|
|
386 (progn
|
|
|
387 (setq subshell-dir nil)
|
|
|
388 (list "\)\; " cmd))
|
|
|
389 (setq subshell-dir fdir)
|
|
|
390 (list "\)\; \(cd "
|
|
|
391 fdir
|
|
|
392 "\; "
|
|
|
393 cmd)))
|
|
|
394 (if (string-equal fdir dir)
|
|
|
395 (list (and result "\; ")
|
|
|
396 cmd)
|
|
|
397 (setq subshell-dir fdir)
|
|
|
398 (list (and result "\; ")
|
|
|
399 "\(cd "
|
|
|
400 fdir
|
|
|
401 "\; "
|
|
|
402 cmd)))))
|
|
|
403 (setq list (cdr list))))
|
|
|
404 (concat result (and subshell-dir ")"))))
|
|
|
405 (on-each
|
|
|
406 (mapconcat (function
|
|
|
407 (lambda (fn)
|
|
|
408 (dired-trans-command command (list fn) dir)))
|
|
|
409 file-list "; "))
|
|
|
410
|
|
|
411 (t (dired-trans-command command file-list dir))))
|
|
|
412
|
|
|
413 (defun dired-guess-default (files)
|
|
|
414 ;; Guess a list of possible shell commands for FILES.
|
|
|
415 (and dired-default-auto-shell-command-alist
|
|
|
416 files
|
|
|
417 (let ((alist (append dired-auto-shell-command-alist
|
|
|
418 dired-default-auto-shell-command-alist))
|
|
|
419 guesses)
|
|
|
420 (while alist
|
|
|
421 (let* ((elt (car alist))
|
|
|
422 (regexp (car elt)))
|
|
|
423 (setq guesses
|
|
|
424 (nconc guesses
|
|
|
425 (catch 'missed
|
|
|
426 (mapcar (function
|
|
|
427 (lambda (file)
|
|
|
428 (or (string-match regexp file)
|
|
|
429 (throw 'missed nil))))
|
|
|
430 files)
|
|
|
431 (delq nil (mapcar 'eval (cdr elt)))))))
|
|
|
432 (setq alist (cdr alist)))
|
|
|
433 (dired-uniquefy-list guesses))))
|
|
|
434
|
|
|
435 (defun dired-shell-unhandle-file-name (filename)
|
|
|
436 "Turn a file name into a form that can be sent to a shell process.
|
|
|
437 This is particularly usefull if we are sending file names to a remote shell."
|
|
|
438 (let ((handler (find-file-name-handler filename 'dired-shell-unhandle-file-name)))
|
|
|
439 (if handler
|
|
|
440 (funcall handler 'dired-shell-unhandle-file-name filename)
|
|
|
441 filename)))
|
|
|
442
|
|
|
443 ;;; Actually running the shell command
|
|
|
444
|
|
|
445 (defun dired-run-shell-command-closeout (buffer &optional message)
|
|
|
446 ;; Report on the number of lines produced by a shell command.
|
|
|
447 (if (get-buffer buffer)
|
|
|
448 (save-excursion
|
|
|
449 (set-buffer buffer)
|
|
|
450 (if (zerop (buffer-size))
|
|
|
451 (progn
|
|
|
452 (if message
|
|
|
453 (message "Shell command completed with no output. %s"
|
|
|
454 message)
|
|
|
455 (message "Shell command completed with no output."))
|
|
|
456 (kill-buffer buffer))
|
|
|
457 (set-window-start (display-buffer buffer) 1)
|
|
|
458 (if message
|
|
|
459 (message "Shell command completed. %s" message)
|
|
|
460 (message "Shell command completed."))))))
|
|
|
461
|
|
|
462 (defun dired-rsc-filter (proc string)
|
|
|
463 ;; Do save-excursion by hand so that we can leave point
|
|
|
464 ;; numerically unchanged despite an insertion immediately
|
|
|
465 ;; after it.
|
|
|
466 (let* ((obuf (current-buffer))
|
|
|
467 (buffer (process-buffer proc))
|
|
|
468 opoint
|
|
|
469 (window (get-buffer-window buffer))
|
|
|
470 (pos (window-start window)))
|
|
|
471 (unwind-protect
|
|
|
472 (progn
|
|
|
473 (set-buffer buffer)
|
|
|
474 (setq opoint (point))
|
|
|
475 (goto-char (point-max))
|
|
|
476 (insert-before-markers string))
|
|
|
477 ;; insert-before-markers moved this marker: set it back.
|
|
|
478 (set-window-start window pos)
|
|
|
479 ;; Finish our save-excursion.
|
|
|
480 (goto-char opoint)
|
|
|
481 (set-buffer obuf))))
|
|
|
482
|
|
|
483 (defun dired-rsc-sentinel (process signal)
|
|
|
484 ;; Sentinel function used by dired-run-shell-command
|
|
|
485 (if (memq (process-status process) '(exit signal))
|
|
|
486 (let ((buffer (get-buffer (process-buffer process))))
|
|
|
487 (if buffer
|
|
|
488 (save-excursion
|
|
|
489 (set-buffer buffer)
|
|
|
490 (if (zerop (buffer-size))
|
|
|
491 (message
|
|
|
492 "Dired & shell command completed with no output.")
|
|
|
493 (let ((lines (count-lines dired-shell-input-start
|
|
|
494 (point-max))))
|
|
|
495 (message
|
|
|
496 "Dired & shell command completed with %d line%s of output."
|
|
|
497 lines (dired-plural-s lines))))
|
|
|
498 (setq mode-line-process nil)))
|
|
|
499 (delete-process process))))
|
|
|
500
|
|
|
501 (defun dired-shell-call-process (command dir &optional in-background)
|
|
|
502 ;; Call a shell command as a process in the current buffer.
|
|
|
503 ;; The process should try to run in DIR. DIR is also
|
|
|
504 ;; used to lookup a file-name-handler.
|
|
|
505 ;; Must return the process object if IN-BACKGROUND is non-nil,
|
|
|
506 ;; otherwise the process exit status.
|
|
|
507 (let ((handler (find-file-name-handler dir 'dired-shell-call-process)))
|
|
|
508 (if handler
|
|
|
509 (funcall handler 'dired-shell-call-process command dir in-background)
|
|
|
510 (let ((process-connection-type ; don't waste pty's
|
|
|
511 (null (null in-background))))
|
|
|
512 (setq default-directory dir)
|
|
|
513 (if in-background
|
|
|
514 (progn
|
|
|
515 (setq mode-line-process '(": %s"))
|
|
|
516 (start-process "Shell" (current-buffer)
|
|
|
517 shell-file-name "-c" command))
|
|
|
518 (call-process shell-file-name nil t nil "-c" command))))))
|
|
|
519
|
|
|
520 (defun dired-run-shell-command (command dir in-background &optional append)
|
|
|
521 ;; COMMAND is shell command
|
|
|
522 ;; DIR is directory in which to do the shell command.
|
|
|
523 ;; If IN-BACKGROUND is non-nil, the shell command is run in the background.
|
|
|
524 ;; If it is a string, this is written as header into the output buffer
|
|
|
525 ;; before the command is run.
|
|
|
526 ;; If APPEND is non-nil, the results are appended to the contents
|
|
|
527 ;; of *shell-command* buffer, without erasing its previous contents.
|
|
|
528 (save-excursion
|
|
|
529 (if in-background
|
|
|
530 (let* ((buffer (get-buffer-create
|
|
|
531 "*Background Shell Command Output*"))
|
|
|
532 (n 2)
|
|
|
533 proc)
|
|
|
534 ;; No reason why we can't run two+ background commands.
|
|
|
535 (while (get-buffer-process buffer)
|
|
|
536 (setq buffer (get-buffer-create
|
|
|
537 (concat "*Background Shell Command Output*<"
|
|
|
538 (int-to-string n) ">"))
|
|
|
539 n (1+ n)))
|
|
|
540 (set-buffer buffer)
|
|
|
541 (or (eq major-mode 'comint-mode)
|
|
|
542 (progn
|
|
|
543 (comint-mode)
|
|
|
544 (set (make-local-variable 'comint-prompt-regexp)
|
|
|
545 "^[^\n]*\\? *")))
|
|
|
546 (display-buffer buffer)
|
|
|
547 (barf-if-buffer-read-only)
|
|
|
548 ;; If will kill a process, query first.
|
|
|
549
|
|
|
550 (set (make-local-variable 'dired-shell-input-start) (point-min))
|
|
|
551 (if append
|
|
|
552 (progn
|
|
|
553 (goto-char (point-max))
|
|
|
554 (or (= (preceding-char) ?\n) (bobp) (insert "\n")))
|
|
|
555 (erase-buffer)
|
|
|
556 (if (stringp in-background)
|
|
|
557 (progn
|
|
|
558 (insert in-background)
|
|
|
559 (set (make-local-variable 'dired-shell-input-start)
|
|
|
560 (point)))))
|
|
|
561 (setq proc (dired-shell-call-process command dir t))
|
|
|
562 (set-marker (process-mark proc) (point))
|
|
|
563 (set-process-sentinel proc 'dired-rsc-sentinel)
|
|
|
564 (set-process-filter proc 'dired-rsc-filter)
|
|
|
565 nil) ; return
|
|
|
566 (let ((buffer (get-buffer-create "*Shell Command Output*")))
|
|
|
567 (set-buffer buffer)
|
|
|
568 (barf-if-buffer-read-only)
|
|
|
569 (set (make-local-variable 'dired-shell-input-start) (point-min))
|
|
|
570 (if append
|
|
|
571 (progn
|
|
|
572 (goto-char (point-max))
|
|
|
573 (or (= (preceding-char) ?\n) (bobp) (insert "\n")))
|
|
|
574 (erase-buffer))
|
|
|
575 (dired-shell-call-process command dir)))))
|
|
|
576
|
|
|
577 ;;; User commands
|
|
|
578
|
|
|
579 (defun dired-do-shell-command (command arg files &optional in-background)
|
|
|
580 ;; ARG = (16) means operate on each file, in its own directory.
|
|
|
581 ;; ARG = (4) means operate on each file, but in the current
|
|
|
582 ;; default-directory.
|
|
|
583 "Run a shell command COMMAND on the marked files.
|
|
|
584 If no files are marked or a non-zero numeric prefix arg is given,
|
|
|
585 the next ARG files are used. Use prefix 1 to indicate the current file.
|
|
|
586
|
|
|
587 Normally the shell command is executed in the current dired subdirectory.
|
|
|
588 This is the directory in the dired buffer which currently contains the point.
|
|
|
589 One shell command is run for all of the files.
|
|
|
590 e.g. cmd file1 file2 file3 ...
|
|
|
591 If the total length of of the command exceeds 10000 characters, the files will
|
|
|
592 be bunched to forms commands shorter than this length, and successive commands
|
|
|
593 will be sent.
|
|
|
594
|
|
|
595 With a prefix of \\[universal-argument], a separate command for each file will
|
|
|
596 be executed.
|
|
|
597
|
|
|
598 With a prefix of \\[universal-argument] \\[universal-argument], a separate command will be sent for each file,
|
|
|
599 and the command will be executed in the directory of that file. The explicit
|
|
|
600 command will be of the form
|
|
|
601
|
|
|
602 cd dir; cmd file
|
|
|
603
|
|
|
604 When prompting for the shell command, dired will always indicate the directory
|
|
|
605 in which the command will be executed.
|
|
|
606
|
|
|
607 The following documentation depends on the settings of `dired-file-wildcard',
|
|
|
608 `dired-shell-command-separators', `dired-trans-map', `dired-shell-prefix',
|
|
|
609 `dired-shell-separator', and `dired-shell-postfix'. See the documentation for
|
|
|
610 these variables. Below, I will assume default settings for these variables.
|
|
|
611
|
|
|
612 If the shell command contains a *, then the list of files is substituted for *.
|
|
|
613 The filenames will be written as relative to the directory in which the shell
|
|
|
614 command is executing. If there is no *, and the command does not end in &,
|
|
|
615 then the files are appended to the end of the command. If the command ends in
|
|
|
616 a &, then the files are inserted before the &.
|
|
|
617
|
|
|
618 If `dired-use-file-transformers' is non-nil, then certain 2-character
|
|
|
619 sequences represent parts of the file name.
|
|
|
620 The default transformers are:
|
|
|
621 *f = full file name
|
|
|
622 *n = file name without directory
|
|
|
623 *d = file name's directory
|
|
|
624 This will end in a \"/\" in unix.
|
|
|
625 *e = file names extension
|
|
|
626 By default this the part of the file name without directory, which
|
|
|
627 proceeds the first \".\". If \".\" is the first character of the name,
|
|
|
628 then this \".\" is ignored. The definition of extension can
|
|
|
629 be customized with `dired-filename-re-ext'.
|
|
|
630 *b = file base name
|
|
|
631 This is the part of the file name without directory that precedes
|
|
|
632 the extension.
|
|
|
633 *v = file name with out version control extension (i.e. \",v\")
|
|
|
634 *z = file name without compression extension
|
|
|
635 (i.e. \".Z\", \".z\", or \".gz\")
|
|
|
636
|
|
|
637 Shell commands are divided into words separated by spaces. Then for each
|
|
|
638 word the file name transformers are applied to the list of files, the result
|
|
|
639 concatenated together and substituted for the word in the shell command.
|
|
|
640
|
|
|
641 For example
|
|
|
642 cmd -a *f -b *d*b.fizzle applied to /foo/bar and /la/di/da results in
|
|
|
643 cmd -a /foo/bar /la/di/da -b /foo/bar.fizzle /la/di/da.fizzle
|
|
|
644
|
|
|
645 The \"on-each\" prefixes \\[universal-argument] and 0, also apply while
|
|
|
646 using file transformers. As well, when using file-transformers * still
|
|
|
647 represents the file name relative to the current directory. Not that this
|
|
|
648 differs from *f, which always represents the full pathname.
|
|
|
649
|
|
|
650 A \"\\\" can always be used to quote any character having special meaning.
|
|
|
651 For example, if the current directory is /la, then *n applied
|
|
|
652 to /la/di/da returns la, whereas *\\n returns di/dan. Similarly,
|
|
|
653 \"*d\\ *n\" returns \"/la/di da\".
|
|
|
654
|
|
|
655 The prefix character for file name transformers is always the same as
|
|
|
656 `dired-file-wildcard'."
|
|
|
657
|
|
|
658 (interactive
|
|
|
659 (let ((on-each (or (equal '(4) current-prefix-arg)
|
|
|
660 (equal '(16) current-prefix-arg)))
|
|
|
661 (files (dired-get-marked-files
|
|
|
662 nil (and (not (consp current-prefix-arg))
|
|
|
663 current-prefix-arg)))
|
|
|
664 (dir (and (not (equal current-prefix-arg '(16)))
|
|
|
665 (dired-current-directory))))
|
|
|
666 (list
|
|
|
667 (dired-read-shell-command
|
|
|
668 (concat (if dir
|
|
138
|
669 (format "! in %s " (dired-abbreviate-file-name dir))
|
|
22
|
670 "cd <dir>; ! ")
|
|
|
671 "on "
|
|
|
672 (if on-each "each ")
|
|
|
673 "%s: ")
|
|
|
674 (and (not on-each) current-prefix-arg)
|
|
|
675 (if dir
|
|
|
676 (mapcar (function
|
|
|
677 (lambda (fn)
|
|
|
678 (dired-make-relative fn dir t)))
|
|
|
679 files)
|
|
|
680 files))
|
|
|
681 current-prefix-arg files nil)))
|
|
|
682
|
|
|
683 ;; Check for background commands
|
|
|
684 (if (string-match "[ \t]*&[ \t]*$" command)
|
|
|
685 (setq command (substring command 0 (match-beginning 0))
|
|
|
686 in-background t))
|
|
|
687
|
|
|
688 ;; Look out for remote file names.
|
|
|
689
|
|
|
690 (let* ((on-each (or (equal arg '(4)) (and (equal arg '(16)) 'dir)))
|
|
|
691 (ufiles (mapcar 'dired-shell-unhandle-file-name files))
|
|
|
692 (dir (dired-current-directory))
|
|
|
693 (udir (dired-shell-unhandle-file-name dir)))
|
|
|
694
|
|
|
695 (save-excursion ; in case `shell-command' changes buffer
|
|
|
696 (cond
|
|
|
697
|
|
|
698 ((null ufiles)
|
|
|
699 ;; Just run as a command on no files.
|
|
|
700 (if in-background
|
|
|
701 (dired-run-shell-command command dir t)
|
|
|
702 (dired-run-shell-command command dir nil)
|
|
|
703 (dired-run-shell-command-closeout "*Shell Command Output*")))
|
|
|
704
|
|
|
705 (in-background
|
|
|
706 ;; Can't use dired-bunch-files for background shell commands.
|
|
|
707 ;; as we will create a bunch of process running simultaneously.
|
|
|
708 ;; A better solution needs to be found.
|
|
|
709 (dired-run-shell-command
|
|
|
710 (dired-shell-stuff-it command ufiles udir on-each)
|
|
|
711 dir (if (equal arg '(16))
|
|
|
712 (concat "cd <dir>; \"" command "\"\n\n")
|
|
|
713 (concat "\"" command "\" in " dir "\n\n"))))
|
|
|
714 (on-each
|
|
|
715 (let ((buff (get-buffer "*Shell Command Output*"))
|
|
|
716 failures this-command this-dir ufile return message)
|
|
|
717 (if buff
|
|
|
718 (save-excursion
|
|
|
719 (set-buffer buff)
|
|
|
720 (erase-buffer)))
|
|
|
721 (while ufiles
|
|
|
722 (setq ufile (car ufiles))
|
|
|
723 (if (eq on-each 'dir)
|
|
|
724 (setq this-dir (dired-shell-quote (file-name-directory (directory-file-name ufile)))
|
|
|
725 this-command (concat "cd " this-dir "; " command))
|
|
|
726 (setq this-command command)
|
|
|
727 (or this-dir (setq this-dir udir)))
|
|
|
728 (setq return
|
|
|
729 (dired-run-shell-command
|
|
|
730 (dired-shell-stuff-it this-command (list ufile) this-dir nil)
|
|
|
731 this-dir nil t))
|
|
|
732 (if (and (integerp return) (/= return 0))
|
|
|
733 (save-excursion
|
|
|
734 (let ((file (nth (- (length files) (length (member ufile ufiles))) files)))
|
|
|
735 (if (and dired-shell-failure-marker
|
|
|
736 (dired-goto-file file))
|
|
|
737 (let ((dired-marker-char dired-shell-failure-marker))
|
|
|
738 (dired-mark 1)))
|
|
|
739 (setq failures (cons file failures)))))
|
|
|
740 (setq ufiles (cdr ufiles)))
|
|
|
741 (if failures
|
|
|
742 (let ((num (length failures)))
|
|
|
743 (setq message
|
|
|
744 (if dired-shell-failure-marker
|
|
|
745 (format
|
|
|
746 "Marked %d failure%s with %c."
|
|
|
747 num (dired-plural-s num)
|
|
|
748 dired-shell-failure-marker)
|
|
|
749 "Failed on %d file%s." num
|
|
|
750 (dired-plural-s num)))
|
|
|
751 (dired-log
|
|
|
752 (current-buffer)
|
|
|
753 "Shell command %s failed (non-zero exit status) for:\n %s"
|
|
|
754 command failures)
|
|
|
755 (dired-log (current-buffer) t)))
|
|
|
756 (dired-run-shell-command-closeout "*Shell Command Output*" message)))
|
|
|
757
|
|
|
758 (t
|
|
|
759 (dired-bunch-files
|
|
|
760 (- 10000 (length command))
|
|
|
761 (function (lambda (&rest ufiles)
|
|
|
762 (dired-run-shell-command
|
|
|
763 (dired-shell-stuff-it command ufiles udir nil)
|
|
|
764 dir nil)
|
|
|
765 nil)) ; for the sake of nconc in dired-bunch-files
|
|
|
766 nil ufiles)
|
|
|
767 (dired-run-shell-command-closeout "*Shell Command Output*"))))
|
|
|
768 ;; Update any directories
|
|
|
769 (or in-background
|
|
|
770 (let ((dired-no-confirm '(revert-subdirs)))
|
|
|
771 (dired-verify-modtimes)))))
|
|
|
772
|
|
|
773 (defun dired-do-background-shell-command (command arg files)
|
|
|
774 "Like \\[dired-do-shell-command], but starts command in background.
|
|
|
775 Note that you can type input to the command in its buffer.
|
|
|
776 This requires background.el from the comint package to work."
|
|
|
777 ;; With the version in emacs-19.el, you can alternatively just
|
|
|
778 ;; append an `&' to any shell command to make it run in the
|
|
|
779 ;; background, but you can't type input to it.
|
|
|
780 (interactive
|
|
|
781 (let ((on-each (or (equal '(4) current-prefix-arg)
|
|
|
782 (equal '(16) current-prefix-arg)))
|
|
|
783 (files (dired-get-marked-files
|
|
|
784 nil (and (not (consp current-prefix-arg))
|
|
|
785 current-prefix-arg)))
|
|
|
786 (dir (and (not (equal current-prefix-arg '(16)))
|
|
|
787 (dired-current-directory))))
|
|
|
788 (list
|
|
|
789 (dired-read-shell-command
|
|
|
790 (concat "& "
|
|
|
791 (if dir
|
|
|
792 (format "in %s " (dired-abbreviate-file-name dir))
|
|
|
793 "cd <dir>; ")
|
|
|
794 "on "
|
|
|
795 (if on-each "each ")
|
|
|
796 "%s: ")
|
|
|
797 (and (not on-each) current-prefix-arg)
|
|
|
798 (if dir
|
|
|
799 (mapcar (function
|
|
|
800 (lambda (fn)
|
|
|
801 (dired-make-relative fn dir t)))
|
|
|
802 files)
|
|
|
803 files))
|
|
|
804 current-prefix-arg files)))
|
|
|
805 (dired-do-shell-command command arg files t))
|
|
|
806
|
|
|
807 ;;; Printing files
|
|
|
808
|
|
|
809 (defun dired-do-print (&optional arg command files)
|
|
|
810 "Print the marked (or next ARG) files.
|
|
|
811 Uses the shell command coming from variable `dired-print-program-alist'."
|
|
|
812 (interactive
|
|
|
813 (progn
|
|
|
814 (if dired-print-history
|
|
|
815 (setq dired-print-history (dired-uniquefy-list dired-print-history))
|
|
|
816 (setq dired-print-history (mapcar 'cdr dired-print-program-alist)))
|
|
|
817 (let* ((files (dired-get-marked-files nil current-prefix-arg))
|
|
|
818 (rel-files (mapcar (function
|
|
|
819 (lambda (fn)
|
|
|
820 (dired-make-relative
|
|
|
821 fn
|
|
|
822 (dired-current-directory) t)))
|
|
|
823 files))
|
|
|
824 (alist dired-print-program-alist)
|
|
|
825 (first (car files))
|
|
|
826 (dired-print-history (copy-sequence dired-print-history))
|
|
|
827 elt initial command)
|
|
|
828 ;; For gmhist
|
|
|
829 (put 'dired-print-history 'no-default t)
|
|
|
830 (if first
|
|
|
831 (while (and alist (not initial))
|
|
|
832 (if (string-match (car (car alist)) first)
|
|
|
833 (setq initial (cdr (car alist)))
|
|
|
834 (setq alist (cdr alist)))))
|
|
|
835 (if (and initial (setq elt (member initial dired-print-history)))
|
|
|
836 (setq dired-print-history (nconc
|
|
|
837 (delq (car elt) dired-print-history)
|
|
|
838 (list initial))))
|
|
|
839 (setq command
|
|
|
840 (dired-mark-read-string
|
|
|
841 "Print %s with: "
|
|
|
842 initial 'print current-prefix-arg rel-files
|
|
|
843 'dired-print-history))
|
|
|
844 (list current-prefix-arg command files))))
|
|
|
845 (or files
|
|
|
846 (setq files (dired-get-marked-files nil arg)))
|
|
|
847 (while files
|
|
|
848 (dired-print-file command (car files))
|
|
|
849 (setq files (cdr files))))
|
|
|
850
|
|
|
851 (defun dired-print-file (command file)
|
|
|
852 ;; Using COMMAND, print FILE.
|
|
|
853 (let ((handler (find-file-name-handler file 'dired-print-file)))
|
|
|
854 (if handler
|
|
|
855 (funcall handler 'dired-print-file command file)
|
|
|
856 (let ((rel-file (dired-make-relative file (dired-current-directory) t)))
|
|
|
857 (message "Spooling %s..." rel-file)
|
|
|
858 (shell-command (dired-trans-command command (list file) ""))
|
|
|
859 (message "Spooling %s...done" rel-file)))))
|
|
|
860
|
|
|
861 ;;; end of dired-shell.el
|
