git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/process.el

   1 ;;; process.el --- commands for subprocesses; split out of simple.el
   2
   3 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Ben Wing.
   5
   6 ;; Author: Ben Wing
   7 ;; Maintainer: XEmacs Development Team
   8 ;; Keywords: internal, processes, dumped
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Synched up with: FSF 19.30.
  28
  29 ;;; Commentary:
  30
  31 ;; This file is dumped with XEmacs.
  32
  33 ;;; Code:
  34
  35 \f
  36 (defgroup processes nil
  37   "Process, subshell, compilation, and job control support."
  38   :group 'external
  39   :group 'development)
  40
  41 (defgroup processes-basics nil
  42   "Basic stuff dealing with processes."
  43   :group 'processes)
  44
  45 (defgroup execute nil
  46   "Executing external commands."
  47   :group 'processes)
  48
  49
  50 (defvar shell-command-switch "-c"
  51   "Switch used to have the shell execute its command line argument.")
  52
  53 (defun start-process-shell-command (name buffer &rest args)
  54   "Start a program in a subprocess.  Return the process object for it.
  55 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
  56 NAME is name for process.  It is modified if necessary to make it unique.
  57 BUFFER is the buffer or (buffer-name) to associate with the process.
  58  Process output goes at end of that buffer, unless you specify
  59  an output stream or filter function to handle the output.
  60  BUFFER may be also nil, meaning that this process is not associated
  61  with any buffer
  62 Third arg is command name, the name of a shell command.
  63 Remaining arguments are the arguments for the command.
  64 Wildcards and redirection are handled as usual in the shell."
  65   (cond
  66    ((eq system-type 'vax-vms)
  67     (apply 'start-process name buffer args))
  68    ;; We used to use `exec' to replace the shell with the command,
  69    ;; but that failed to handle (...) and semicolon, etc.
  70    (t
  71     (start-process name buffer shell-file-name shell-command-switch
  72                    (mapconcat 'identity args " ")))))
  73
  74 (defun call-process (program &optional infile buffer displayp &rest args)
  75   "Call PROGRAM synchronously in separate process.
  76 The program's input comes from file INFILE (nil means `/dev/null').
  77 Insert output in BUFFER before point; t means current buffer;
  78  nil for BUFFER means discard it; 0 means discard and don't wait.
  79 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  80 REAL-BUFFER says what to do with standard output, as above,
  81 while STDERR-FILE says what to do with standard error in the child.
  82 STDERR-FILE may be nil (discard standard error output),
  83 t (mix it with ordinary output), or a file name string.
  84
  85 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
  86 Remaining arguments are strings passed as command arguments to PROGRAM.
  87
  88 If BUFFER is 0, `call-process' returns immediately with value nil.
  89 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
  90  or a signal description string.
  91 If you quit, the process is killed with SIGINT, or SIGKILL if you
  92  quit again."
  93   (apply 'call-process-internal program infile buffer displayp args))
  94
  95 (defun call-process-region (start end program
  96                             &optional deletep buffer displayp
  97                             &rest args)
  98   "Send text from START to END to a synchronous process running PROGRAM.
  99 Delete the text if fourth arg DELETEP is non-nil.
 100
 101 Insert output in BUFFER before point; t means current buffer;
 102  nil for BUFFER means discard it; 0 means discard and don't wait.
 103 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
 104 REAL-BUFFER says what to do with standard output, as above,
 105 while STDERR-FILE says what to do with standard error in the child.
 106 STDERR-FILE may be nil (discard standard error output),
 107 t (mix it with ordinary output), or a file name string.
 108
 109 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
 110 Remaining args are passed to PROGRAM at startup as command args.
 111
 112 If BUFFER is 0, returns immediately with value nil.
 113 Otherwise waits for PROGRAM to terminate
 114 and returns a numeric exit status or a signal description string.
 115 If you quit, the process is first killed with SIGINT, then with SIGKILL if
 116 you quit again before the process exits."
 117   (let ((temp (cond ((eq system-type 'vax-vms)
 118                      (make-temp-name "tmp:emacs"))
 119                     ((or (eq system-type 'ms-dos)
 120                          (eq system-type 'windows-nt))
 121                      (make-temp-name
 122                       (concat (file-name-as-directory
 123                                (temp-directory))
 124                                "em")))
 125                     (t
 126                      (make-temp-name
 127                       (concat (file-name-as-directory
 128                                (temp-directory))
 129                               "emacs"))))))
 130     (unwind-protect
 131         (progn
 132           (if (or (eq system-type 'ms-dos)
 133                   (eq system-type 'windows-nt))
 134               (let ((buffer-file-type binary-process-output))
 135                 (write-region start end temp nil 'silent))
 136             (write-region start end temp nil 'silent))
 137           (if deletep (delete-region start end))
 138           (apply #'call-process program temp buffer displayp args))
 139       (condition-case ()
 140           (delete-file temp)
 141         (file-error nil)))))
 142
 143 \f
 144 (defun shell-command (command &optional output-buffer)
 145   "Execute string COMMAND in inferior shell; display output, if any.
 146
 147 If COMMAND ends in ampersand, execute it asynchronously.
 148 The output appears in the buffer `*Async Shell Command*'.
 149 That buffer is in shell mode.
 150
 151 Otherwise, COMMAND is executed synchronously.  The output appears in the
 152 buffer `*Shell Command Output*'.
 153 If the output is one line, it is displayed in the echo area *as well*,
 154 but it is nonetheless available in buffer `*Shell Command Output*',
 155 even though that buffer is not automatically displayed.
 156 If there is no output, or if output is inserted in the current buffer,
 157 then `*Shell Command Output*' is deleted.
 158
 159 The optional second argument OUTPUT-BUFFER, if non-nil,
 160 says to put the output in some other buffer.
 161 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
 162 If OUTPUT-BUFFER is not a buffer and not nil,
 163 insert output in current buffer.  (This cannot be done asynchronously.)
 164 In either case, the output is inserted after point (leaving mark after it)."
 165   (interactive (list (read-shell-command "Shell command: ")
 166                      current-prefix-arg))
 167   (if (and output-buffer
 168            (not (or (bufferp output-buffer)  (stringp output-buffer))))
 169       (progn (barf-if-buffer-read-only)
 170              (push-mark)
 171              ;; We do not use -f for csh; we will not support broken use of
 172              ;; .cshrcs.  Even the BSD csh manual says to use
 173              ;; "if ($?prompt) exit" before things which are not useful
 174              ;; non-interactively.  Besides, if someone wants their other
 175              ;; aliases for shell commands then they can still have them.
 176              (call-process shell-file-name nil t nil
 177                            shell-command-switch command)
 178              (exchange-point-and-mark t))
 179     ;; Preserve the match data in case called from a program.
 180     (save-match-data
 181       (if (string-match "[ \t]*&[ \t]*$" command)
 182           ;; Command ending with ampersand means asynchronous.
 183           (progn
 184             (background (substring command 0 (match-beginning 0))))
 185         (shell-command-on-region (point) (point) command output-buffer)))))
 186
 187 ;; We have a sentinel to prevent insertion of a termination message
 188 ;; in the buffer itself.
 189 (defun shell-command-sentinel (process signal)
 190   (if (memq (process-status process) '(exit signal))
 191       (message "%s: %s."
 192                (car (cdr (cdr (process-command process))))
 193                (substring signal 0 -1))))
 194
 195 (defun shell-command-on-region (start end command
 196                                       &optional output-buffer replace)
 197   "Execute string COMMAND in inferior shell with region as input.
 198 Normally display output (if any) in temp buffer `*Shell Command Output*';
 199 Prefix arg means replace the region with it.
 200
 201 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
 202 If REPLACE is non-nil, that means insert the output
 203 in place of text from START to END, putting point and mark around it.
 204
 205 If the output is one line, it is displayed in the echo area,
 206 but it is nonetheless available in buffer `*Shell Command Output*'
 207 even though that buffer is not automatically displayed.
 208 If there is no output, or if output is inserted in the current buffer,
 209 then `*Shell Command Output*' is deleted.
 210
 211 If the optional fourth argument OUTPUT-BUFFER is non-nil,
 212 that says to put the output in some other buffer.
 213 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
 214 If OUTPUT-BUFFER is not a buffer and not nil,
 215 insert output in the current buffer.
 216 In either case, the output is inserted after point (leaving mark after it)."
 217   (interactive (let ((string
 218                       ;; Do this before calling region-beginning
 219                       ;; and region-end, in case subprocess output
 220                       ;; relocates them while we are in the minibuffer.
 221                       (read-shell-command "Shell command on region: ")))
 222                  ;; call-interactively recognizes region-beginning and
 223                  ;; region-end specially, leaving them in the history.
 224                  (list (region-beginning) (region-end)
 225                        string
 226                        current-prefix-arg
 227                        current-prefix-arg)))
 228   (if (or replace
 229           (and output-buffer
 230                (not (or (bufferp output-buffer) (stringp output-buffer)))))
 231       ;; Replace specified region with output from command.
 232       (let ((swap (and replace (< start end))))
 233         ;; Don't muck with mark unless REPLACE says we should.
 234         (goto-char start)
 235         (and replace (push-mark))
 236         (call-process-region start end shell-file-name t t nil
 237                              shell-command-switch command)
 238         (let ((shell-buffer (get-buffer "*Shell Command Output*")))
 239           (and shell-buffer (not (eq shell-buffer (current-buffer)))
 240                (kill-buffer shell-buffer)))
 241         ;; Don't muck with mark unless REPLACE says we should.
 242         (and replace swap (exchange-point-and-mark t)))
 243       ;; No prefix argument: put the output in a temp buffer,
 244       ;; replacing its entire contents.
 245     (let ((buffer (get-buffer-create
 246                    (or output-buffer "*Shell Command Output*")))
 247           (success nil)
 248           (exit-status nil)
 249           (directory default-directory))
 250       (unwind-protect
 251           (if (eq buffer (current-buffer))
 252               ;; If the input is the same buffer as the output,
 253               ;; delete everything but the specified region,
 254               ;; then replace that region with the output.
 255               (progn (setq buffer-read-only nil)
 256                      (delete-region (max start end) (point-max))
 257                      (delete-region (point-min) (max start end))
 258                      (setq exit-status
 259                            (call-process-region (point-min) (point-max)
 260                                                 shell-file-name t t nil
 261                                                 shell-command-switch command))
 262                      (setq success t))
 263             ;; Clear the output buffer,
 264             ;; then run the command with output there.
 265             (save-excursion
 266               (set-buffer buffer)
 267               (setq buffer-read-only nil)
 268               ;; XEmacs change
 269               (setq default-directory directory)
 270               (erase-buffer))
 271             (setq exit-status
 272                   (call-process-region start end shell-file-name
 273                                        nil buffer nil
 274                                        shell-command-switch command))
 275             (setq success t))
 276         ;; Report the amount of output.
 277         (let ((lines (save-excursion
 278                        (set-buffer buffer)
 279                        (if (= (buffer-size) 0)
 280                            0
 281                          (count-lines (point-min) (point-max))))))
 282           (cond ((= lines 0)
 283                  (if success
 284                      (display-message
 285                       'command
 286                       (if (eql exit-status 0)
 287                           "(Shell command succeeded with no output)"
 288                         "(Shell command failed with no output)")))
 289                  (kill-buffer buffer))
 290                 ((and success (= lines 1))
 291                  (message "%s"
 292                           (save-excursion
 293                             (set-buffer buffer)
 294                             (goto-char (point-min))
 295                             (buffer-substring (point)
 296                                               (progn (end-of-line)
 297                                                      (point))))))
 298                 (t
 299                  (set-window-start (display-buffer buffer) 1))))))))
 300
 301 \f
 302 (defun start-process (name buffer program &rest program-args)
 303   "Start a program in a subprocess.  Return the process object for it.
 304 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
 305 NAME is name for process.  It is modified if necessary to make it unique.
 306 BUFFER is the buffer or (buffer-name) to associate with the process.
 307  Process output goes at end of that buffer, unless you specify
 308  an output stream or filter function to handle the output.
 309  BUFFER may be also nil, meaning that this process is not associated
 310  with any buffer
 311 Third arg is program file name.  It is searched for as in the shell.
 312 Remaining arguments are strings to give program as arguments."
 313   (apply 'start-process-internal name buffer program program-args))
 314
 315 (defun open-network-stream (name buffer host service)
 316   "Open a TCP connection for a service to a host.
 317 Returns a subprocess-object to represent the connection.
 318 Input and output work as for subprocesses; `delete-process' closes it.
 319 Args are NAME BUFFER HOST SERVICE.
 320 NAME is name for process.  It is modified if necessary to make it unique.
 321 BUFFER is the buffer (or buffer-name) to associate with the process.
 322  Process output goes at end of that buffer, unless you specify
 323  an output stream or filter function to handle the output.
 324  BUFFER may be also nil, meaning that this process is not associated
 325  with any buffer
 326 Third arg is name of the host to connect to, or its IP address.
 327 Fourth arg SERVICE is name of the service desired, or an integer
 328  specifying a port number to connect to."
 329   (open-network-stream-internal name buffer host service))
 330
 331 (defun shell-quote-argument (argument)
 332   "Quote an argument for passing as argument to an inferior shell."
 333   (if (eq system-type 'ms-dos)
 334       ;; MS-DOS shells don't have quoting, so don't do any.
 335       argument
 336     (if (eq system-type 'windows-nt)
 337         (concat "\"" argument "\"")
 338       ;; Quote everything except POSIX filename characters.
 339       ;; This should be safe enough even for really weird shells.
 340       (let ((result "") (start 0) end)
 341         (while (string-match "[^-0-9a-zA-Z_./]" argument start)
 342           (setq end (match-beginning 0)
 343                 result (concat result (substring argument start end)
 344                                "\\" (substring argument end (1+ end)))
 345                 start (1+ end)))
 346         (concat result (substring argument start))))))
 347
 348 (defun exec-to-string (command)
 349   "Execute COMMAND as an external process and return the output of that
 350 process as a string"
 351   ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu>
 352   (with-output-to-string
 353     (call-process shell-file-name nil t nil "-c" command)))
 354
 355 (defalias 'shell-command-to-string 'exec-to-string)
 356
 357 ;;; process.el ends here