428
+ − 1 ;;; code-process.el --- Process coding functions for XEmacs.
+ − 2
+ − 3 ;; Copyright (C) 1985-1987, 1993, 1994, 1997 Free Software Foundation, Inc.
+ − 4 ;; Copyright (C) 1995 Ben Wing
+ − 5 ;; Copyright (C) 1997 MORIOKA Tomohiko
+ − 6
+ − 7 ;; Author: Ben Wing
+ − 8 ;; MORIOKA Tomohiko
+ − 9 ;; Maintainer: XEmacs Development Team
+ − 10 ;; Keywords: mule, multilingual, coding system, process
+ − 11
+ − 12 ;; This file is part of XEmacs.
+ − 13
+ − 14 ;; This file is very similar to code-process.el
+ − 15
+ − 16 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 17 ;; under the terms of the GNU General Public License as published by
+ − 18 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 19 ;; any later version.
+ − 20
+ − 21 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 24 ;; General Public License for more details.
+ − 25
+ − 26 ;; You should have received a copy of the GNU General Public License
+ − 27 ;; along with XEmacs; see the file COPYING. If not, write to the Free
+ − 28 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ − 29 ;; 02111-1307, USA.
+ − 30
+ − 31 ;;; Code:
+ − 32
+ − 33 (defvar process-coding-system-alist nil
+ − 34 "Alist to decide a coding system to use for a process I/O operation.
+ − 35 The format is ((PATTERN . VAL) ...),
+ − 36 where PATTERN is a regular expression matching a program name,
+ − 37 VAL is a coding system, a cons of coding systems, or a function symbol.
+ − 38 If VAL is a coding system, it is used for both decoding what received
+ − 39 from the program and encoding what sent to the program.
+ − 40 If VAL is a cons of coding systems, the car part is used for decoding,
+ − 41 and the cdr part is used for encoding.
+ − 42 If VAL is a function symbol, the function must return a coding system
+ − 43 or a cons of coding systems which are used as above.")
+ − 44
+ − 45 (defun call-process (program &optional infile buffer displayp &rest args)
+ − 46 "Call PROGRAM synchronously in separate process.
+ − 47 The program's input comes from file INFILE (nil means `/dev/null').
+ − 48 Insert output in BUFFER before point; t means current buffer;
+ − 49 nil for BUFFER means discard it; 0 means discard and don't wait.
+ − 50 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+ − 51 REAL-BUFFER says what to do with standard output, as above,
+ − 52 while STDERR-FILE says what to do with standard error in the child.
+ − 53 STDERR-FILE may be nil (discard standard error output),
+ − 54 t (mix it with ordinary output), or a file name string.
+ − 55
+ − 56 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
+ − 57 Remaining arguments are strings passed as command arguments to PROGRAM.
+ − 58
+ − 59 If BUFFER is 0, `call-process' returns immediately with value nil.
+ − 60 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
+ − 61 or a signal description string.
+ − 62 If you quit, the process is killed with SIGINT, or SIGKILL if you
+ − 63 quit again."
+ − 64 (let* ((coding-system-for-read
+ − 65 (or coding-system-for-read
+ − 66 (let (ret)
+ − 67 (catch 'found
+ − 68 (let ((alist process-coding-system-alist)
+ − 69 (case-fold-search nil))
+ − 70 (while alist
+ − 71 (if (string-match (car (car alist)) program)
+ − 72 (throw 'found (setq ret (cdr (car alist))))
+ − 73 )
+ − 74 (setq alist (cdr alist))
+ − 75 )))
+ − 76 (if (functionp ret)
+ − 77 (setq ret (funcall ret 'call-process program))
+ − 78 )
+ − 79 (cond ((consp ret) (car ret))
+ − 80 ((not ret) 'undecided)
+ − 81 ((find-coding-system ret) ret)
+ − 82 )
+ − 83 ))))
+ − 84 (apply 'call-process-internal program infile buffer displayp args)
+ − 85 ))
+ − 86
+ − 87 (defun call-process-region (start end program
+ − 88 &optional deletep buffer displayp
+ − 89 &rest args)
+ − 90 "Send text from START to END to a synchronous process running PROGRAM.
+ − 91 Delete the text if fourth arg DELETEP is non-nil.
+ − 92
+ − 93 Insert output in BUFFER before point; t means current buffer;
+ − 94 nil for BUFFER means discard it; 0 means discard and don't wait.
+ − 95 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+ − 96 REAL-BUFFER says what to do with standard output, as above,
+ − 97 while STDERR-FILE says what to do with standard error in the child.
+ − 98 STDERR-FILE may be nil (discard standard error output),
+ − 99 t (mix it with ordinary output), or a file name string.
+ − 100
+ − 101 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
+ − 102 Remaining args are passed to PROGRAM at startup as command args.
+ − 103
+ − 104 If BUFFER is 0, returns immediately with value nil.
+ − 105 Otherwise waits for PROGRAM to terminate
+ − 106 and returns a numeric exit status or a signal description string.
+ − 107 If you quit, the process is first killed with SIGINT, then with SIGKILL if
+ − 108 you quit again before the process exits."
+ − 109 (let ((temp
+ − 110 (make-temp-name
440
+ − 111 (concat (file-name-as-directory (temp-directory)) "emacs"))))
428
+ − 112 (unwind-protect
+ − 113 (let (cs-r cs-w)
+ − 114 (let (ret)
+ − 115 (catch 'found
+ − 116 (let ((alist process-coding-system-alist)
+ − 117 (case-fold-search nil))
+ − 118 (while alist
+ − 119 (if (string-match (car (car alist)) program)
+ − 120 (throw 'found (setq ret (cdr (car alist)))))
+ − 121 (setq alist (cdr alist))
+ − 122 )))
+ − 123 (if (functionp ret)
+ − 124 (setq ret (funcall ret 'call-process-region program)))
+ − 125 (cond ((consp ret)
+ − 126 (setq cs-r (car ret)
+ − 127 cs-w (cdr ret)))
442
+ − 128 ((null ret)
+ − 129 (setq cs-r buffer-file-coding-system
+ − 130 cs-w buffer-file-coding-system))
428
+ − 131 ((find-coding-system ret)
+ − 132 (setq cs-r ret
+ − 133 cs-w ret))))
+ − 134 (let ((coding-system-for-read
+ − 135 (or coding-system-for-read cs-r))
+ − 136 (coding-system-for-write
+ − 137 (or coding-system-for-write cs-w)))
440
+ − 138 (write-region start end temp nil 'silent)
428
+ − 139 (if deletep (delete-region start end))
+ − 140 (apply #'call-process program temp buffer displayp args)))
+ − 141 (ignore-file-errors (delete-file temp)))))
+ − 142
+ − 143 (defun start-process (name buffer program &rest program-args)
+ − 144 "Start a program in a subprocess. Return the process object for it.
+ − 145 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
+ − 146 NAME is name for process. It is modified if necessary to make it unique.
+ − 147 BUFFER is the buffer or (buffer-name) to associate with the process.
+ − 148 Process output goes at end of that buffer, unless you specify
+ − 149 an output stream or filter function to handle the output.
+ − 150 BUFFER may be also nil, meaning that this process is not associated
+ − 151 with any buffer
+ − 152 Third arg is program file name. It is searched for as in the shell.
+ − 153 Remaining arguments are strings to give program as arguments.
+ − 154 INCODE and OUTCODE specify the coding-system objects used in input/output
+ − 155 from/to the process."
+ − 156 (let (cs-r cs-w)
+ − 157 (let (ret)
+ − 158 (catch 'found
+ − 159 (let ((alist process-coding-system-alist)
+ − 160 (case-fold-search nil))
+ − 161 (while alist
+ − 162 (if (string-match (car (car alist)) program)
+ − 163 (throw 'found (setq ret (cdr (car alist)))))
+ − 164 (setq alist (cdr alist))
+ − 165 )))
+ − 166 (if (functionp ret)
+ − 167 (setq ret (funcall ret 'start-process program)))
+ − 168 (cond ((consp ret)
+ − 169 (setq cs-r (car ret)
+ − 170 cs-w (cdr ret)))
+ − 171 ((find-coding-system ret)
+ − 172 (setq cs-r ret
+ − 173 cs-w ret))))
+ − 174 (let ((coding-system-for-read
+ − 175 (or coding-system-for-read cs-r 'undecided))
+ − 176 (coding-system-for-write
+ − 177 (or coding-system-for-write cs-w)))
+ − 178 (apply 'start-process-internal name buffer program program-args)
+ − 179 )))
+ − 180
+ − 181 (defvar network-coding-system-alist nil
+ − 182 "Alist to decide a coding system to use for a network I/O operation.
+ − 183 The format is ((PATTERN . VAL) ...),
+ − 184 where PATTERN is a regular expression matching a network service name
+ − 185 or is a port number to connect to,
+ − 186 VAL is a coding system, a cons of coding systems, or a function symbol.
+ − 187 If VAL is a coding system, it is used for both decoding what received
+ − 188 from the network stream and encoding what sent to the network stream.
+ − 189 If VAL is a cons of coding systems, the car part is used for decoding,
+ − 190 and the cdr part is used for encoding.
+ − 191 If VAL is a function symbol, the function must return a coding system
+ − 192 or a cons of coding systems which are used as above.
+ − 193
+ − 194 See also the function `find-operation-coding-system'.")
+ − 195
+ − 196 (defun open-network-stream (name buffer host service &optional protocol)
+ − 197 "Open a TCP connection for a service to a host.
444
+ − 198 Return a process object to represent the connection.
428
+ − 199 Input and output work as for subprocesses; `delete-process' closes it.
+ − 200 Args are NAME BUFFER HOST SERVICE.
+ − 201 NAME is name for process. It is modified if necessary to make it unique.
+ − 202 BUFFER is the buffer (or buffer-name) to associate with the process.
+ − 203 Process output goes at end of that buffer, unless you specify
+ − 204 an output stream or filter function to handle the output.
+ − 205 BUFFER may be also nil, meaning that this process is not associated
+ − 206 with any buffer
+ − 207 Third arg is name of the host to connect to, or its IP address.
+ − 208 Fourth arg SERVICE is name of the service desired, or an integer
+ − 209 specifying a port number to connect to.
+ − 210 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
+ − 211 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
+ − 212 supported. When omitted, 'tcp is assumed.
+ − 213
442
+ − 214 Output via `process-send-string' and input via buffer or filter (see
428
+ − 215 `set-process-filter') are stream-oriented. That means UDP datagrams are
+ − 216 not guaranteed to be sent and received in discrete packets. (But small
+ − 217 datagrams around 500 bytes that are not truncated by `process-send-string'
+ − 218 are usually fine.) Note further that UDP protocol does not guard against
+ − 219 lost packets."
+ − 220 (let (cs-r cs-w)
+ − 221 (let (ret)
+ − 222 (catch 'found
+ − 223 (let ((alist network-coding-system-alist)
+ − 224 (case-fold-search nil)
+ − 225 pattern)
+ − 226 (while alist
+ − 227 (setq pattern (car (car alist)))
+ − 228 (and
+ − 229 (cond ((numberp pattern)
+ − 230 (and (numberp service)
+ − 231 (eq pattern service)))
+ − 232 ((stringp pattern)
+ − 233 (or (and (stringp service)
+ − 234 (string-match pattern service))
+ − 235 (and (numberp service)
+ − 236 (string-match pattern
+ − 237 (number-to-string service))))))
+ − 238 (throw 'found (setq ret (cdr (car alist)))))
+ − 239 (setq alist (cdr alist))
+ − 240 )))
+ − 241 (if (functionp ret)
+ − 242 (setq ret (funcall ret 'open-network-stream service)))
+ − 243 (cond ((consp ret)
+ − 244 (setq cs-r (car ret)
+ − 245 cs-w (cdr ret)))
+ − 246 ((find-coding-system ret)
+ − 247 (setq cs-r ret
+ − 248 cs-w ret))))
+ − 249 (let ((coding-system-for-read
+ − 250 (or coding-system-for-read cs-r))
+ − 251 (coding-system-for-write
+ − 252 (or coding-system-for-write cs-w)))
+ − 253 (open-network-stream-internal name buffer host service protocol))))
+ − 254
440
+ − 255 ;;; code-process.el ends here
