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