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, 2000 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 ;;; Authorship:
  30
  31 ;; Created 1995 by Ben Wing during Mule work -- some commands split out
  32 ;; of simple.el and wrappers of *-internal functions created so they could
  33 ;; be redefined in a Mule world.
  34 ;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing.
  35
  36 ;;; Commentary:
  37
  38 ;; This file is dumped with XEmacs.
  39
  40 ;;; Code:
  41
  42 \f
  43 (defgroup processes nil
  44   "Process, subshell, compilation, and job control support."
  45   :group 'external
  46   :group 'development)
  47
  48 (defgroup processes-basics nil
  49   "Basic stuff dealing with processes."
  50   :group 'processes)
  51
  52 (defgroup execute nil
  53   "Executing external commands."
  54   :group 'processes)
  55
  56 ;; This may be changed to "/c" in win32-native.el.
  57
  58 (defvar shell-command-switch "-c"
  59   "Switch used to have the shell execute its command line argument.")
  60
  61 (defun start-process-shell-command (name buffer &rest args)
  62   "Start a program in a subprocess.  Return the process object for it.
  63 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
  64 NAME is name for process.  It is modified if necessary to make it unique.
  65 BUFFER is the buffer or (buffer-name) to associate with the process.
  66  Process output goes at end of that buffer, unless you specify
  67  an output stream or filter function to handle the output.
  68  BUFFER may be also nil, meaning that this process is not associated
  69  with any buffer
  70 Third arg is command name, the name of a shell command.
  71 Remaining arguments are the arguments for the command.
  72 Wildcards and redirection are handled as usual in the shell."
  73   ;; We used to use `exec' to replace the shell with the command,
  74   ;; but that failed to handle (...) and semicolon, etc.
  75   (start-process name buffer shell-file-name shell-command-switch
  76                  (mapconcat #'identity args " ")))
  77
  78 (defun call-process-internal (program &optional infile buffer display &rest args)
  79   "Call PROGRAM synchronously in separate process, with coding-system specified.
  80 Arguments are
  81  (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
  82 The program's input comes from file INFILE (nil means `/dev/null').
  83 Insert output in BUFFER before point; t means current buffer;
  84  nil for BUFFER means discard it; 0 means discard and don't wait.
  85 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  86 REAL-BUFFER says what to do with standard output, as above,
  87 while STDERR-FILE says what to do with standard error in the child.
  88 STDERR-FILE may be nil (discard standard error output),
  89 t (mix it with ordinary output), or a file name string.
  90
  91 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
  92 Remaining arguments are strings passed as command arguments to PROGRAM.
  93
  94 If BUFFER is 0, `call-process' returns immediately with value nil.
  95 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
  96  or a signal description string.
  97 If you quit, the process is killed with SIGINT, or SIGKILL if you
  98  quit again."
  99   ;; #### remove windows-nt check when this is ready for prime time.
 100   (if (or (noninteractive) (not (eq 'windows-nt system-type)))
 101       (apply 'old-call-process-internal program infile buffer display args)
 102     (let (proc inbuf errbuf discard)
 103       (unwind-protect
 104           (progn
 105             (when infile
 106               (setq infile (expand-file-name infile))
 107               (setq inbuf (generate-new-buffer "*call-process*"))
 108               (with-current-buffer inbuf
 109                ;; Make sure this works with jka-compr
 110                (let ((file-name-handler-alist nil))
 111                  (insert-file-contents-internal infile nil nil nil nil
 112                                                 'binary))))
 113             (let ((stderr (if (consp buffer) (second buffer) t)))
 114               (if (consp buffer) (setq buffer (car buffer)))
 115               (setq buffer
 116                     (cond ((null buffer) nil)
 117                           ((eq buffer t) (current-buffer))
 118                           ;; use integerp for compatibility with existing
 119                           ;; call-process rmsism.
 120                           ((integerp buffer) (setq discard t) nil)
 121                           (t (get-buffer-create buffer))))
 122               (when (and stderr (not (eq t stderr)))
 123                 (setq stderr (expand-file-name stderr))
 124                 (setq errbuf (generate-new-buffer "*call-process*")))
 125               ;; We read INFILE using the binary coding-system.
 126               ;; We must feed the process using the same coding-system, so
 127               ;; that it really receives the contents of INFILE.
 128               (let ((coding-system-for-write 'binary))
 129                 (setq proc
 130                       (apply 'start-process-internal "*call-process*"
 131                              buffer
 132                              ;#### not implemented until my new process
 133                              ;changes go in.
 134                              ;(if (eq t stderr) buffer (list buffer errbuf))
 135                              program args)))
 136               (if buffer
 137                   (set-marker (process-mark proc) (point buffer) buffer))
 138               (unwind-protect
 139                   (prog1
 140                     (catch 'call-process-done
 141                       (when (not discard)
 142                         (set-process-sentinel
 143                          proc
 144                          #'(lambda (proc status)
 145                              (cond ((eq 'exit (process-status proc))
 146                                     (set-process-sentinel proc nil)
 147                                     (throw 'call-process-done
 148                                            (process-exit-status proc)))
 149                                    ((eq 'signal (process-status proc))
 150                                     (set-process-sentinel proc nil)
 151                                     (throw 'call-process-done status))))))
 152                       (when inbuf
 153                         (process-send-region proc 1
 154                                              (1+ (buffer-size inbuf)) inbuf))
 155                       (process-send-eof proc)
 156                       (when discard
 157                         ;; we're trying really really hard to emulate
 158                         ;; the old call-process.
 159                         (if errbuf
 160                             (set-process-sentinel
 161                              proc
 162                              `(lambda (proc status)
 163                                 (write-region-internal
 164                                  1 (1+ (buffer-size))
 165                                  ,stderr
 166                                  nil 'major-rms-kludge-city nil
 167                                  coding-system-for-write))))
 168                         (setq errbuf nil)
 169                         (setq proc nil)
 170                         (throw 'call-process-done nil))
 171                       (while t
 172                         (accept-process-output proc)
 173                         (if display (sit-for 0))))
 174                     (when errbuf
 175                       (with-current-buffer errbuf
 176                         (write-region-internal 1 (1+ (buffer-size)) stderr
 177                                                nil 'major-rms-kludge-city nil
 178                                                coding-system-for-write))))
 179                 (if proc (set-process-sentinel proc nil)))))
 180         (if inbuf (kill-buffer inbuf))
 181         (if errbuf (kill-buffer errbuf))
 182         (condition-case nil
 183             (if (and proc (process-live-p proc)) (kill-process proc))
 184           (error nil))))))
 185
 186 (defun call-process (program &optional infile buffer displayp &rest args)
 187   "Call PROGRAM synchronously in separate process.
 188 The program's input comes from file INFILE (nil means `/dev/null').
 189 Insert output in BUFFER before point; t means current buffer;
 190  nil for BUFFER means discard it; 0 means discard and don't wait.
 191 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
 192 REAL-BUFFER says what to do with standard output, as above,
 193 while STDERR-FILE says what to do with standard error in the child.
 194 STDERR-FILE may be nil (discard standard error output),
 195 t (mix it with ordinary output), or a file name string.
 196
 197 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
 198 Remaining arguments are strings passed as command arguments to PROGRAM.
 199
 200 If BUFFER is 0, `call-process' returns immediately with value nil.
 201 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
 202  or a signal description string.
 203 If you quit, the process is killed with SIGINT, or SIGKILL if you
 204  quit again."
 205   (apply 'call-process-internal program infile buffer displayp args))
 206
 207 (defun call-process-region (start end program
 208                             &optional deletep buffer displayp
 209                             &rest args)
 210   "Send text from START to END to a synchronous process running PROGRAM.
 211 Delete the text if fourth arg DELETEP is non-nil.
 212
 213 Insert output in BUFFER before point; t means current buffer;
 214  nil for BUFFER means discard it; 0 means discard and don't wait.
 215 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
 216 REAL-BUFFER says what to do with standard output, as above,
 217 while STDERR-FILE says what to do with standard error in the child.
 218 STDERR-FILE may be nil (discard standard error output),
 219 t (mix it with ordinary output), or a file name string.
 220
 221 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
 222 Remaining args are passed to PROGRAM at startup as command args.
 223
 224 If BUFFER is 0, returns immediately with value nil.
 225 Otherwise waits for PROGRAM to terminate
 226 and returns a numeric exit status or a signal description string.
 227 If you quit, the process is first killed with SIGINT, then with SIGKILL if
 228 you quit again before the process exits."
 229   (let ((temp
 230          (make-temp-name
 231           (concat (file-name-as-directory (temp-directory)) "emacs"))))
 232     (unwind-protect
 233         (progn
 234           (write-region start end temp nil 'silent)
 235           (if deletep (delete-region start end))
 236           (apply #'call-process program temp buffer displayp args))
 237       (ignore-file-errors (delete-file temp)))))
 238
 239 \f
 240 (defun shell-command (command &optional output-buffer)
 241   "Execute string COMMAND in inferior shell; display output, if any.
 242
 243 If COMMAND ends in ampersand, execute it asynchronously.
 244 The output appears in the buffer `*Async Shell Command*'.
 245 That buffer is in shell mode.
 246
 247 Otherwise, COMMAND is executed synchronously.  The output appears in the
 248 buffer `*Shell Command Output*'.
 249 If the output is one line, it is displayed in the echo area *as well*,
 250 but it is nonetheless available in buffer `*Shell Command Output*',
 251 even though that buffer is not automatically displayed.
 252 If there is no output, or if output is inserted in the current buffer,
 253 then `*Shell Command Output*' is deleted.
 254
 255 The optional second argument OUTPUT-BUFFER, if non-nil,
 256 says to put the output in some other buffer.
 257 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
 258 If OUTPUT-BUFFER is not a buffer and not nil,
 259 insert output in current buffer.  (This cannot be done asynchronously.)
 260 In either case, the output is inserted after point (leaving mark after it)."
 261   (interactive (list (read-shell-command "Shell command: ")
 262                      current-prefix-arg))
 263   (if (and output-buffer
 264            (not (or (bufferp output-buffer)  (stringp output-buffer))))
 265       (progn (barf-if-buffer-read-only)
 266              (push-mark nil (not (interactive-p)))
 267              ;; We do not use -f for csh; we will not support broken use of
 268              ;; .cshrcs.  Even the BSD csh manual says to use
 269              ;; "if ($?prompt) exit" before things which are not useful
 270              ;; non-interactively.  Besides, if someone wants their other
 271              ;; aliases for shell commands then they can still have them.
 272              (call-process shell-file-name nil t nil
 273                            shell-command-switch command)
 274              (exchange-point-and-mark t))
 275     ;; Preserve the match data in case called from a program.
 276     (save-match-data
 277       (if (string-match "[ \t]*&[ \t]*$" command)
 278           ;; Command ending with ampersand means asynchronous.
 279           (progn
 280             (background (substring command 0 (match-beginning 0)) output-buffer))
 281         (shell-command-on-region (point) (point) command output-buffer)))))
 282
 283 ;; We have a sentinel to prevent insertion of a termination message
 284 ;; in the buffer itself.
 285 (defun shell-command-sentinel (process signal)
 286   (if (memq (process-status process) '(exit signal))
 287       (message "%s: %s."
 288                (car (cdr (cdr (process-command process))))
 289                (substring signal 0 -1))))
 290
 291 (defun shell-command-on-region (start end command
 292                                       &optional output-buffer replace)
 293   "Execute string COMMAND in inferior shell with region as input.
 294 Normally display output (if any) in temp buffer `*Shell Command Output*';
 295 Prefix arg means replace the region with it.
 296
 297 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
 298 If REPLACE is non-nil, that means insert the output
 299 in place of text from START to END, putting point and mark around it.
 300
 301 If the output is one line, it is displayed in the echo area,
 302 but it is nonetheless available in buffer `*Shell Command Output*'
 303 even though that buffer is not automatically displayed.
 304 If there is no output, or if output is inserted in the current buffer,
 305 then `*Shell Command Output*' is deleted.
 306
 307 If the optional fourth argument OUTPUT-BUFFER is non-nil,
 308 that says to put the output in some other buffer.
 309 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
 310 If OUTPUT-BUFFER is not a buffer and not nil,
 311 insert output in the current buffer.
 312 In either case, the output is inserted after point (leaving mark after it)."
 313   (interactive (let ((string
 314                       ;; Do this before calling region-beginning
 315                       ;; and region-end, in case subprocess output
 316                       ;; relocates them while we are in the minibuffer.
 317                       (read-shell-command "Shell command on region: ")))
 318                  ;; call-interactively recognizes region-beginning and
 319                  ;; region-end specially, leaving them in the history.
 320                  (list (region-beginning) (region-end)
 321                        string
 322                        current-prefix-arg
 323                        current-prefix-arg)))
 324   (if (or replace
 325           (and output-buffer
 326                (not (or (bufferp output-buffer) (stringp output-buffer)))))
 327       ;; Replace specified region with output from command.
 328       (let ((swap (and replace (< start end))))
 329         ;; Don't muck with mark unless REPLACE says we should.
 330         (goto-char start)
 331         (and replace (push-mark))
 332         (call-process-region start end shell-file-name t t nil
 333                              shell-command-switch command)
 334         (let ((shell-buffer (get-buffer "*Shell Command Output*")))
 335           (and shell-buffer (not (eq shell-buffer (current-buffer)))
 336                (kill-buffer shell-buffer)))
 337         ;; Don't muck with mark unless REPLACE says we should.
 338         (and replace swap (exchange-point-and-mark t)))
 339       ;; No prefix argument: put the output in a temp buffer,
 340       ;; replacing its entire contents.
 341     (let ((buffer (get-buffer-create
 342                    (or output-buffer "*Shell Command Output*")))
 343           (success nil)
 344           (exit-status nil)
 345           (directory default-directory))
 346       (unwind-protect
 347           (if (eq buffer (current-buffer))
 348               ;; If the input is the same buffer as the output,
 349               ;; delete everything but the specified region,
 350               ;; then replace that region with the output.
 351               (progn (setq buffer-read-only nil)
 352                      (delete-region (max start end) (point-max))
 353                      (delete-region (point-min) (min start end))
 354                      (setq exit-status
 355                            (call-process-region (point-min) (point-max)
 356                                                 shell-file-name t t nil
 357                                                 shell-command-switch command))
 358                      (setq success t))
 359             ;; Clear the output buffer,
 360             ;; then run the command with output there.
 361             (save-excursion
 362               (set-buffer buffer)
 363               (setq buffer-read-only nil)
 364               ;; XEmacs change
 365               (setq default-directory directory)
 366               (erase-buffer))
 367             (setq exit-status
 368                   (call-process-region start end shell-file-name
 369                                        nil buffer nil
 370                                        shell-command-switch command))
 371             (setq success t))
 372         ;; Report the amount of output.
 373         (let ((lines (save-excursion
 374                        (set-buffer buffer)
 375                        (if (= (buffer-size) 0)
 376                            0
 377                          (count-lines (point-min) (point-max))))))
 378           (cond ((= lines 0)
 379                  (if success
 380                      (display-message
 381                       'command
 382                       (if (eql exit-status 0)
 383                           "(Shell command succeeded with no output)"
 384                         "(Shell command failed with no output)")))
 385                  (kill-buffer buffer))
 386                 ((and success (= lines 1))
 387                  (message "%s"
 388                           (save-excursion
 389                             (set-buffer buffer)
 390                             (goto-char (point-min))
 391                             (buffer-substring (point)
 392                                               (progn (end-of-line)
 393                                                      (point))))))
 394                 (t
 395                  (set-window-start (display-buffer buffer) 1))))))))
 396
 397 \f
 398 (defun start-process (name buffer program &rest program-args)
 399   "Start a program in a subprocess.  Return the process object for it.
 400 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
 401 NAME is name for process.  It is modified if necessary to make it unique.
 402 BUFFER is the buffer or (buffer-name) to associate with the process.
 403  Process output goes at end of that buffer, unless you specify
 404  an output stream or filter function to handle the output.
 405  BUFFER may be also nil, meaning that this process is not associated
 406  with any buffer
 407 Third arg is program file name.  It is searched for as in the shell.
 408 Remaining arguments are strings to give program as arguments."
 409   (apply 'start-process-internal name buffer program program-args))
 410
 411 (defun open-network-stream (name buffer host service &optional protocol)
 412   "Open a TCP connection for a service to a host.
 413 Returns a process object to represent the connection.
 414 Input and output work as for subprocesses; `delete-process' closes it.
 415 Args are NAME BUFFER HOST SERVICE.
 416 NAME is name for process.  It is modified if necessary to make it unique.
 417 BUFFER is the buffer (or buffer-name) to associate with the process.
 418  Process output goes at end of that buffer, unless you specify
 419  an output stream or filter function to handle the output.
 420  BUFFER may be also nil, meaning that this process is not associated
 421  with any buffer
 422 Third arg is name of the host to connect to, or its IP address.
 423 Fourth arg SERVICE is name of the service desired, or an integer
 424  specifying a port number to connect to.
 425 Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
 426  (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
 427  supported.  When omitted, 'tcp is assumed.
 428
 429 Output via `process-send-string' and input via buffer or filter (see
 430 `set-process-filter') are stream-oriented.  That means UDP datagrams are
 431 not guaranteed to be sent and received in discrete packets. (But small
 432 datagrams around 500 bytes that are not truncated by `process-send-string'
 433 are usually fine.)  Note further that UDP protocol does not guard against
 434 lost packets."
 435   (open-network-stream-internal name buffer host service protocol))
 436
 437 (defun shell-quote-argument (argument)
 438   "Quote an argument for passing as argument to an inferior shell."
 439   (if (and (eq system-type 'windows-nt)
 440            (let ((progname (downcase (file-name-nondirectory
 441                                       shell-file-name))))
 442              (or (equal progname "command.com")
 443                  (equal progname "cmd.exe"))))
 444       ;; the expectation is that you can take the result of
 445       ;; shell-quote-argument and pass it to as an arg to
 446       ;; (start-process shell-quote-argument ...) and have it end
 447       ;; up as-is in the program's argv[] array.  to do this, we
 448       ;; need to protect against both the shell's and the program's
 449       ;; quoting conventions (and our own conventions in
 450       ;; mswindows-construct-process-command-line!).  Putting quotes
 451       ;; around shell metachars gets through the last two, and applying
 452       ;; the normal VC runtime quoting works with practically all apps.
 453       (mswindows-quote-one-vc-runtime-arg argument t)
 454     (if (equal argument "")
 455         "\"\""
 456       ;; Quote everything except POSIX filename characters.
 457       ;; This should be safe enough even for really weird shells.
 458       (let ((result "") (start 0) end)
 459         (while (string-match "[^-0-9a-zA-Z_./]" argument start)
 460           (setq end (match-beginning 0)
 461                 result (concat result (substring argument start end)
 462                                "\\" (substring argument end (1+ end)))
 463                 start (1+ end)))
 464         (concat result (substring argument start))))))
 465
 466 (defun shell-command-to-string (command)
 467   "Execute shell command COMMAND and return its output as a string."
 468   (with-output-to-string
 469     (call-process shell-file-name nil t nil shell-command-switch command)))
 470
 471 (defalias 'exec-to-string 'shell-command-to-string)
 472
 473 ;;; process.el ends here