(U-000278B8): Apply new conventions for glyph granularity.

[chise/xemacs-chise.git.1] / lisp / process.el

diff --git a/lisp/process.el b/lisp/process.el
index c0602de..690ef80 100644 (file)
--- a/lisp/process.el
+++ b/lisp/process.el
@@ -20,7 +20,7 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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.
 
 ;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 

@@ -53,6 +53,7 @@
   "Executing external commands."
   :group 'processes)
 
   "Executing external commands."
   :group 'processes)
 

+;; This may be changed to "/c" in win32-native.el.

 
 (defvar shell-command-switch "-c"
   "Switch used to have the shell execute its command line argument.")
 
 (defvar shell-command-switch "-c"
   "Switch used to have the shell execute its command line argument.")

@@ -105,8 +106,10 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
              (setq infile (expand-file-name infile))
              (setq inbuf (generate-new-buffer "*call-process*"))
              (with-current-buffer inbuf
              (setq infile (expand-file-name infile))
              (setq inbuf (generate-new-buffer "*call-process*"))
              (with-current-buffer inbuf

-               (insert-file-contents-internal infile nil nil nil nil
-                                              coding-system-for-read)))
+               ;; 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
            (let ((stderr (if (consp buffer) (second buffer) t)))
              (if (consp buffer) (setq buffer (car buffer)))
              (setq buffer

@@ -119,17 +122,21 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you
              (when (and stderr (not (eq t stderr)))
                (setq stderr (expand-file-name stderr))
                (setq errbuf (generate-new-buffer "*call-process*")))
              (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))
+             ;; We read INFILE using the binary coding-system.
+             ;; We must feed the process using the same coding-system, so
+             ;; that it really receives the contents of INFILE.
+             (let ((coding-system-for-write 'binary))
+               (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
              (if buffer
                  (set-marker (process-mark proc) (point buffer) buffer))
              (unwind-protect

-                 (progn
+                 (prog1

                    (catch 'call-process-done
                      (when (not discard)
                        (set-process-sentinel
                    (catch 'call-process-done
                      (when (not discard)
                        (set-process-sentinel

@@ -256,7 +263,7 @@ In either case, the output is inserted after point (leaving mark after it)."
   (if (and output-buffer
           (not (or (bufferp output-buffer)  (stringp output-buffer))))
       (progn (barf-if-buffer-read-only)
   (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
             ;; 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

@@ -270,7 +277,7 @@ In either case, the output is inserted after point (leaving mark after it)."
       (if (string-match "[ \t]*&[ \t]*$" command)
          ;; Command ending with ampersand means asynchronous.
          (progn
       (if (string-match "[ \t]*&[ \t]*$" command)
          ;; Command ending with ampersand means asynchronous.
          (progn

-           (background (substring command 0 (match-beginning 0))))
+           (background (substring command 0 (match-beginning 0)) output-buffer))

        (shell-command-on-region (point) (point) command output-buffer)))))
 
 ;; We have a sentinel to prevent insertion of a termination message
        (shell-command-on-region (point) (point) command output-buffer)))))
 
 ;; We have a sentinel to prevent insertion of a termination message

@@ -343,7 +350,7 @@ In either case, the output is inserted after point (leaving mark after it)."
              ;; then replace that region with the output.
              (progn (setq buffer-read-only nil)
                     (delete-region (max start end) (point-max))
              ;; then replace that region with the output.
              (progn (setq buffer-read-only nil)
                     (delete-region (max start end) (point-max))

-                    (delete-region (point-min) (max start end))
+                    (delete-region (point-min) (min start end))

                     (setq exit-status
                           (call-process-region (point-min) (point-max)
                                                shell-file-name t t nil
                     (setq exit-status
                           (call-process-region (point-min) (point-max)
                                                shell-file-name t t nil

@@ -403,7 +410,7 @@ Remaining arguments are strings to give program as arguments."
 
 (defun open-network-stream (name buffer host service &optional protocol)
   "Open a TCP connection for a service to a host.
 
 (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.
 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.

@@ -419,7 +426,7 @@ Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
  (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
  supported.  When omitted, 'tcp is assumed.
 
  (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'
 `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'

@@ -429,17 +436,32 @@ lost packets."
 
 (defun shell-quote-argument (argument)
   "Quote an argument for passing as argument to an inferior shell."
 
 (defun shell-quote-argument (argument)
   "Quote an argument for passing as argument to an inferior shell."

-  (if (eq system-type 'windows-nt)
-      (nt-quote-process-args (list shell-file-name 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 (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)
+    (if (equal 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 shell-command-to-string (command)
   "Execute shell command COMMAND and return its output as a string."