diff lisp/process.el @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children 11054d720c21
line wrap: on
line diff
--- a/lisp/process.el	Mon Aug 13 11:19:22 2007 +0200
+++ b/lisp/process.el	Mon Aug 13 11:20:41 2007 +0200
@@ -1,7 +1,7 @@
 ;;; process.el --- commands for subprocesses; split out of simple.el
 
 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 2000 Ben Wing.
+;; Copyright (C) 1995 Ben Wing.
 
 ;; Author: Ben Wing
 ;; Maintainer: XEmacs Development Team
@@ -26,13 +26,6 @@
 
 ;;; 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.
@@ -40,6 +33,9 @@
 ;;; Code:
 
 
+(defvar binary-process-output)
+(defvar buffer-file-type)
+
 (defgroup processes nil
   "Process, subshell, compilation, and job control support."
   :group 'external
@@ -74,110 +70,6 @@
   (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').
@@ -223,10 +115,14 @@
 you quit again before the process exits."
   (let ((temp
 	 (make-temp-name
-	  (concat (file-name-as-directory (temp-directory)) "emacs"))))
+	  (concat (file-name-as-directory (temp-directory))
+		  (if (memq system-type '(ms-dos windows-nt)) "em" "emacs")))))
     (unwind-protect
 	(progn
-	  (write-region start end temp nil 'silent)
+	  (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))
 	  (if deletep (delete-region start end))
 	  (apply #'call-process program temp buffer displayp args))
       (ignore-file-errors (delete-file temp)))))
@@ -403,7 +299,7 @@
 Remaining arguments are strings to give program as arguments."
   (apply 'start-process-internal name buffer program program-args))
 
-(defun open-network-stream (name buffer host service &optional protocol)
+(defun open-network-stream (name buffer host service)
   "Open a TCP connection for a service to a host.
 Returns a subprocess-object to represent the connection.
 Input and output work as for subprocesses; `delete-process' closes it.
@@ -416,44 +312,33 @@
  with any buffer
 Third arg is name of the host to connect to, or its IP address.
 Fourth arg SERVICE is name of the service desired, or an integer
- specifying a port number to connect to.
-Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
- (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
-`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
-lost packets."
-  (open-network-stream-internal name buffer host service protocol))
+ specifying a port number to connect to."
+  (open-network-stream-internal name buffer host service))
 
 (defun shell-quote-argument (argument)
   "Quote an argument for passing as argument to an inferior shell."
-  (if (and (eq system-type 'windows-nt)
-	   ;; #### this is a temporary hack.  a better solution needs
-	   ;; futzing with the c code.  i'll do this shortly.
-	   (let ((progname (downcase (file-name-nondirectory
-				      shell-file-name))))
-	     (or (equal progname "command.com")
-		 (equal progname "cmd.exe"))))
+  (if (eq system-type 'ms-dos)
+      ;; MS-DOS shells don't have quoting, so don't do any.
       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)))))
+    (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 shell-command-to-string (command)
-  "Execute shell command COMMAND and return its output as a string."
+(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>
   (with-output-to-string
     (call-process shell-file-name nil t nil shell-command-switch command)))
 
-(defalias 'exec-to-string 'shell-command-to-string)
+(defalias 'shell-command-to-string 'exec-to-string)
 
 ;;; process.el ends here