;;; process.el --- commands for subprocesses; split out of simple.el
;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Ben Wing.
+;; Copyright (C) 1995, 2000 Ben Wing.
;; Author: Ben Wing
;; Maintainer: XEmacs Development Team
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING. If not, write to the
+;; along with XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Synched up with: FSF 19.30.
+;;; Authorship:
+
+;; Created 1995 by Ben Wing during Mule work -- some commands split out
+;; of simple.el and wrappers of *-internal functions created so they could
+;; be redefined in a Mule world.
+;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing.
+
;;; Commentary:
;; This file is dumped with XEmacs.
;;; Code:
\f
-(defvar binary-process-output)
-(defvar buffer-file-type)
-
(defgroup processes nil
"Process, subshell, compilation, and job control support."
:group 'external
(start-process name buffer shell-file-name shell-command-switch
(mapconcat #'identity args " ")))
+(defun call-process-internal (program &optional infile buffer display &rest args)
+ "Call PROGRAM synchronously in separate process, with coding-system specified.
+Arguments are
+ (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
+The program's input comes from file INFILE (nil means `/dev/null').
+Insert output in BUFFER before point; t means current buffer;
+ nil for BUFFER means discard it; 0 means discard and don't wait.
+BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+REAL-BUFFER says what to do with standard output, as above,
+while STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may be nil (discard standard error output),
+t (mix it with ordinary output), or a file name string.
+
+Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
+Remaining arguments are strings passed as command arguments to PROGRAM.
+
+If BUFFER is 0, `call-process' returns immediately with value nil.
+Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
+ or a signal description string.
+If you quit, the process is killed with SIGINT, or SIGKILL if you
+ quit again."
+ ;; #### remove windows-nt check when this is ready for prime time.
+ (if (or (noninteractive) (not (eq 'windows-nt system-type)))
+ (apply 'old-call-process-internal program infile buffer display args)
+ (let (proc inbuf errbuf discard)
+ (unwind-protect
+ (progn
+ (when infile
+ (setq infile (expand-file-name infile))
+ (setq inbuf (generate-new-buffer "*call-process*"))
+ (with-current-buffer inbuf
+ ;; Make sure this works with jka-compr
+ (let ((file-name-handler-alist nil))
+ (insert-file-contents-internal infile nil nil nil nil
+ 'binary))))
+ (let ((stderr (if (consp buffer) (second buffer) t)))
+ (if (consp buffer) (setq buffer (car buffer)))
+ (setq buffer
+ (cond ((null buffer) nil)
+ ((eq buffer t) (current-buffer))
+ ;; use integerp for compatibility with existing
+ ;; call-process rmsism.
+ ((integerp buffer) (setq discard t) nil)
+ (t (get-buffer-create buffer))))
+ (when (and stderr (not (eq t stderr)))
+ (setq stderr (expand-file-name stderr))
+ (setq errbuf (generate-new-buffer "*call-process*")))
+ (setq proc
+ (apply 'start-process-internal "*call-process*"
+ buffer
+ ;#### not implemented until my new process
+ ;changes go in.
+ ;(if (eq t stderr) buffer (list buffer errbuf))
+ program args))
+ (if buffer
+ (set-marker (process-mark proc) (point buffer) buffer))
+ (unwind-protect
+ (prog1
+ (catch 'call-process-done
+ (when (not discard)
+ (set-process-sentinel
+ proc
+ #'(lambda (proc status)
+ (cond ((eq 'exit (process-status proc))
+ (set-process-sentinel proc nil)
+ (throw 'call-process-done
+ (process-exit-status proc)))
+ ((eq 'signal (process-status proc))
+ (set-process-sentinel proc nil)
+ (throw 'call-process-done status))))))
+ (when inbuf
+ (process-send-region proc 1
+ (1+ (buffer-size inbuf)) inbuf))
+ (process-send-eof proc)
+ (when discard
+ ;; we're trying really really hard to emulate
+ ;; the old call-process.
+ (if errbuf
+ (set-process-sentinel
+ proc
+ `(lambda (proc status)
+ (write-region-internal
+ 1 (1+ (buffer-size))
+ ,stderr
+ nil 'major-rms-kludge-city nil
+ coding-system-for-write))))
+ (setq errbuf nil)
+ (setq proc nil)
+ (throw 'call-process-done nil))
+ (while t
+ (accept-process-output proc)
+ (if display (sit-for 0))))
+ (when errbuf
+ (with-current-buffer errbuf
+ (write-region-internal 1 (1+ (buffer-size)) stderr
+ nil 'major-rms-kludge-city nil
+ coding-system-for-write))))
+ (if proc (set-process-sentinel proc nil)))))
+ (if inbuf (kill-buffer inbuf))
+ (if errbuf (kill-buffer errbuf))
+ (condition-case nil
+ (if (and proc (process-live-p proc)) (kill-process proc))
+ (error nil))))))
+
(defun call-process (program &optional infile buffer displayp &rest args)
"Call PROGRAM synchronously in separate process.
The program's input comes from file INFILE (nil means `/dev/null').
you quit again before the process exits."
(let ((temp
(make-temp-name
- (concat (file-name-as-directory (temp-directory))
- (if (memq system-type '(ms-dos windows-nt)) "em" "emacs")))))
+ (concat (file-name-as-directory (temp-directory)) "emacs"))))
(unwind-protect
(progn
- (if (memq system-type '(ms-dos windows-nt))
- (let ((buffer-file-type binary-process-output))
- (write-region start end temp nil 'silent))
- (write-region start end temp nil 'silent))
+ (write-region start end temp nil 'silent)
(if deletep (delete-region start end))
(apply #'call-process program temp buffer displayp args))
(ignore-file-errors (delete-file temp)))))
(if (and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer))))
(progn (barf-if-buffer-read-only)
- (push-mark)
+ (push-mark nil (not (interactive-p)))
;; We do not use -f for csh; we will not support broken use of
;; .cshrcs. Even the BSD csh manual says to use
;; "if ($?prompt) exit" before things which are not useful
(defun open-network-stream (name buffer host service &optional protocol)
"Open a TCP connection for a service to a host.
-Returns a subprocess-object to represent the connection.
+Returns a process object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
Args are NAME BUFFER HOST SERVICE.
NAME is name for process. It is modified if necessary to make it unique.
(Transmission Control Protocol) and 'udp (User Datagram Protocol) are
supported. When omitted, 'tcp is assumed.
-Ouput via `process-send-string' and input via buffer or filter (see
+Output via `process-send-string' and input via buffer or filter (see
`set-process-filter') are stream-oriented. That means UDP datagrams are
not guaranteed to be sent and received in discrete packets. (But small
datagrams around 500 bytes that are not truncated by `process-send-string'
-are usually fine.) Note further that UDP protocol does not guard against
+are usually fine.) Note further that UDP protocol does not guard against
lost packets."
(open-network-stream-internal name buffer host service protocol))
(defun shell-quote-argument (argument)
"Quote an argument for passing as argument to an inferior shell."
- (if (eq system-type 'ms-dos)
- ;; MS-DOS shells don't have quoting, so don't do any.
- argument
- (if (eq system-type 'windows-nt)
- (concat "\"" argument "\"")
- ;; Quote everything except POSIX filename characters.
- ;; This should be safe enough even for really weird shells.
- (let ((result "") (start 0) end)
- (while (string-match "[^-0-9a-zA-Z_./]" argument start)
- (setq end (match-beginning 0)
- result (concat result (substring argument start end)
- "\\" (substring argument end (1+ end)))
- start (1+ end)))
- (concat result (substring argument start))))))
-
-(defun exec-to-string (command)
- "Execute COMMAND as an external process and return the output of that
-process as a string"
- ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu>
+ (if (and (eq system-type 'windows-nt)
+ (let ((progname (downcase (file-name-nondirectory
+ shell-file-name))))
+ (or (equal progname "command.com")
+ (equal progname "cmd.exe"))))
+ ;; the expectation is that you can take the result of
+ ;; shell-quote-argument and pass it to as an arg to
+ ;; (start-process shell-quote-argument ...) and have it end
+ ;; up as-is in the program's argv[] array. to do this, we
+ ;; need to protect against both the shell's and the program's
+ ;; quoting conventions (and our own conventions in
+ ;; mswindows-construct-process-command-line!). Putting quotes
+ ;; around shell metachars gets through the last two, and applying
+ ;; the normal VC runtime quoting works with practically all apps.
+ (mswindows-quote-one-vc-runtime-arg argument t)
+ ;; Quote everything except POSIX filename characters.
+ ;; This should be safe enough even for really weird shells.
+ (let ((result "") (start 0) end)
+ (while (string-match "[^-0-9a-zA-Z_./]" argument start)
+ (setq end (match-beginning 0)
+ result (concat result (substring argument start end)
+ "\\" (substring argument end (1+ end)))
+ start (1+ end)))
+ (concat result (substring argument start)))))
+
+(defun shell-command-to-string (command)
+ "Execute shell command COMMAND and return its output as a string."
(with-output-to-string
(call-process shell-file-name nil t nil shell-command-switch command)))
-(defalias 'shell-command-to-string 'exec-to-string)
+(defalias 'exec-to-string 'shell-command-to-string)
;;; process.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff