Mercurial > hg > xemacs-beta
comparison lisp/efs/dired-shell.el @ 22:8fc7fe29b841 r19-15b94
Import from CVS: tag r19-15b94
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:50:29 +0200 |
| parents | |
| children | 7e54bd776075 8619ce7e4c50 |
comparison
equal
deleted
inserted
replaced
| 21:b88636d63495 | 22:8fc7fe29b841 |
|---|---|
| 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 |