cgit.sxemacs.org Git - packages/blob - xemacs-packages/dired/dired-shell.el

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