428
+ − 1 ;;; code-process.el --- Process coding functions for XEmacs.
+ − 2
+ − 3 ;; Copyright (C) 1985-1987, 1993, 1994, 1997 Free Software Foundation, Inc.
853
+ − 4 ;; Copyright (C) 1995, 2000, 2002 Ben Wing
428
+ − 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.
853
+ − 42 If VAL is a function symbol, it is called with two arguments, a symbol
+ − 43 indicating the operation being performed (one of `start-process',
+ − 44 `call-process', `open-network-stream', or `open-multicast-group') and the
+ − 45 program name. The function must return a coding system or a cons of
+ − 46 coding systems which are used as above.")
428
+ − 47
+ − 48 (defun call-process (program &optional infile buffer displayp &rest args)
+ − 49 "Call PROGRAM synchronously in separate process.
853
+ − 50
428
+ − 51 The program's input comes from file INFILE (nil means `/dev/null').
853
+ − 52 XEmacs feature: INFILE can also be a list of (BUFFER [START [END]]), i.e.
+ − 53 a list of one to three elements, consisting of a buffer and optionally
+ − 54 a start position or start and end position. In this case, input comes
+ − 55 from the buffer, starting from START (defaults to the beginning of the
+ − 56 buffer) and ending at END (defaults to the end of the buffer).
+ − 57
428
+ − 58 Insert output in BUFFER before point; t means current buffer;
+ − 59 nil for BUFFER means discard it; 0 means discard and don't wait.
837
+ − 60 If BUFFER is a string, then find or create a buffer with that name,
+ − 61 then insert the output in that buffer, before point.
428
+ − 62 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+ − 63 REAL-BUFFER says what to do with standard output, as above,
+ − 64 while STDERR-FILE says what to do with standard error in the child.
+ − 65 STDERR-FILE may be nil (discard standard error output),
853
+ − 66 t (mix it with ordinary output), a file name string, or (XEmacs feature)
+ − 67 a buffer object. If STDERR-FILE is a buffer object (but not the name of
+ − 68 a buffer, since that would be interpreted as a file), the standard error
+ − 69 output will be inserted into the buffer before point.
428
+ − 70
853
+ − 71 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
428
+ − 72 Remaining arguments are strings passed as command arguments to PROGRAM.
+ − 73
853
+ − 74 If BUFFER is 0, returns immediately with value nil.
+ − 75 Otherwise waits for PROGRAM to terminate and returns a numeric exit status
+ − 76 or a signal description string. If you quit, the process is first killed
+ − 77 with SIGINT, then with SIGKILL if you quit again before the process exits.
+ − 78
+ − 79 If INFILE is a file, we transfer its exact contents to the process without
+ − 80 any encoding/decoding. (#### This policy might change.)
+ − 81
+ − 82 Otherwise, the read/write coding systems used for process I/O on the
+ − 83 process are determined as follows:
+ − 84
+ − 85 1. `coding-system-for-read', `coding-system-for-write', if non-nil.
+ − 86 (Intended as a temporary overriding mechanism for use by Lisp
+ − 87 code.)
+ − 88 2. The matching value for the process name from `process-coding-system-alist',
+ − 89 if any, and if non-nil. The value may be either a single coding
+ − 90 system, used for both read and write; or a cons of read/write; or a
+ − 91 function, called to get one of the other two values.
+ − 92 3. For writing: If a buffer was given in INFILE, the value of
+ − 93 `buffer-file-coding-system' in that buffer.
+ − 94 For reading: if a buffer was given in BUFFER, the value of
+ − 95 `buffer-file-coding-system-for-read' in that buffer.
+ − 96 4. The value of `default-process-coding-system', which should be a cons
+ − 97 of read/write coding systems, if the values are non-nil.
+ − 98 5. The coding system `undecided' for read, and `raw-text' for write.
+ − 99
+ − 100 Note that the processes of determining the read and write coding systems
+ − 101 proceed essentially independently one from the other, as in `start-process'."
+ − 102 (let (cs-r cs-w)
+ − 103 (let (ret)
+ − 104 (catch 'found
+ − 105 (let ((alist process-coding-system-alist)
+ − 106 (case-fold-search nil))
+ − 107 (while alist
+ − 108 (if (string-match (car (car alist)) program)
+ − 109 (throw 'found (setq ret (cdr (car alist)))))
+ − 110 (setq alist (cdr alist))
+ − 111 )))
+ − 112 (if (functionp ret)
+ − 113 (setq ret (funcall ret 'call-process program)))
+ − 114 (cond ((consp ret)
+ − 115 (setq cs-r (car ret)
+ − 116 cs-w (cdr ret)))
+ − 117 ((and ret (find-coding-system ret))
+ − 118 (setq cs-r ret
+ − 119 cs-w ret))))
+ − 120 (let ((coding-system-for-read
+ − 121 (or coding-system-for-read cs-r
+ − 122 (let ((thebuf (if (consp buffer) (car buffer) buffer)))
+ − 123 (and (or (bufferp thebuf) (stringp thebuf))
+ − 124 (get-buffer thebuf)
+ − 125 (symbol-value-in-buffer
857
+ − 126 'buffer-file-coding-system-for-read (get-buffer thebuf))))
853
+ − 127 (car default-process-coding-system)
+ − 128 'undecided))
+ − 129 (coding-system-for-write
+ − 130 (or coding-system-for-write cs-w
+ − 131 (and (consp infile)
+ − 132 (symbol-value-in-buffer
+ − 133 'buffer-file-coding-system
+ − 134 (get-buffer (car infile))))
+ − 135 (cdr default-process-coding-system)
+ − 136 'raw-text)))
+ − 137 (apply 'call-process-internal program infile buffer displayp args))))
428
+ − 138
+ − 139 (defun call-process-region (start end program
+ − 140 &optional deletep buffer displayp
+ − 141 &rest args)
+ − 142 "Send text from START to END to a synchronous process running PROGRAM.
+ − 143 Delete the text if fourth arg DELETEP is non-nil.
+ − 144
+ − 145 Insert output in BUFFER before point; t means current buffer;
+ − 146 nil for BUFFER means discard it; 0 means discard and don't wait.
837
+ − 147 If BUFFER is a string, then find or create a buffer with that name,
+ − 148 then insert the output in that buffer, before point.
428
+ − 149 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
+ − 150 REAL-BUFFER says what to do with standard output, as above,
+ − 151 while STDERR-FILE says what to do with standard error in the child.
+ − 152 STDERR-FILE may be nil (discard standard error output),
853
+ − 153 t (mix it with ordinary output), a file name string, or (XEmacs feature)
+ − 154 a buffer object. If STDERR-FILE is a buffer object (but not the name of
+ − 155 a buffer, since that would be interpreted as a file), the standard error
+ − 156 output will be inserted into the buffer before point.
428
+ − 157
+ − 158 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
+ − 159 Remaining args are passed to PROGRAM at startup as command args.
+ − 160
+ − 161 If BUFFER is 0, returns immediately with value nil.
853
+ − 162 Otherwise waits for PROGRAM to terminate and returns a numeric exit status
+ − 163 or a signal description string. If you quit, the process is first killed
+ − 164 with SIGINT, then with SIGKILL if you quit again before the process exits.
+ − 165
+ − 166 The read/write coding systems used for process I/O on the process are
+ − 167 the same as for `call-process'."
+ − 168 ;; We used to delete the text before calling call-process; that was when
+ − 169 ;; a temporary file was used to pass the text to call-process. Now that
+ − 170 ;; we don't do that, we delete the text afterward; if it's being inserted
+ − 171 ;; in the same buffer, make sure we track the insertion, and don't get
+ − 172 ;; any of it in the deleted region if insertion happens at either end
+ − 173 ;; of the region.
+ − 174 (let ((s (and deletep (copy-marker start t)))
+ − 175 (e (and deletep (copy-marker end))))
+ − 176 (apply #'call-process program (list (current-buffer) start end)
+ − 177 buffer displayp args)
+ − 178 (if deletep (delete-region s e))))
428
+ − 179
+ − 180 (defun start-process (name buffer program &rest program-args)
+ − 181 "Start a program in a subprocess. Return the process object for it.
+ − 182 NAME is name for process. It is modified if necessary to make it unique.
+ − 183 BUFFER is the buffer or (buffer-name) to associate with the process.
853
+ − 184 Process output goes at end of that buffer, unless you specify
+ − 185 an output stream or filter function to handle the output.
+ − 186 BUFFER may be also nil, meaning that this process is not associated
+ − 187 with any buffer.
+ − 188 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case,
+ − 189 REAL-BUFFER says what to do with standard output, as above,
+ − 190 while STDERR-BUFFER says what to do with standard error in the child.
+ − 191 STDERR-BUFFER may be nil (discard standard error output, unless a stderr
+ − 192 filter is set). Note that if you do not use this form at process creation,
+ − 193 stdout and stderr will be mixed in the output buffer, and this cannot be
+ − 194 changed, even by setting a stderr filter.
428
+ − 195 Third arg is program file name. It is searched for as in the shell.
+ − 196 Remaining arguments are strings to give program as arguments.
853
+ − 197
+ − 198 The read/write coding systems used for process I/O on the process are
+ − 199 determined as follows:
+ − 200
+ − 201 1. `coding-system-for-read', `coding-system-for-write', if non-nil.
+ − 202 (Intended as a temporary overriding mechanism for use by Lisp
+ − 203 code.)
+ − 204 2. The matching value for the process name from `process-coding-system-alist',
+ − 205 if any, and if non-nil. The value may be either a single coding
+ − 206 system, used for both read and write; or a cons of read/write; or a
+ − 207 function, called to get one of the other two values.
+ − 208 3. The value of `default-process-coding-system', which should be a cons
+ − 209 of read/write coding systems, if the values are non-nil.
+ − 210 4. The coding system `undecided' for read, and `raw-text' for write.
+ − 211
+ − 212 Note that the processes of determining the read and write coding systems
+ − 213 proceed essentially independently one from the other. For example, a value
+ − 214 determined from `process-coding-system-alist' might specify a read coding
+ − 215 system but not a write coding system, in which the read coding system is as
+ − 216 specified and the write coding system comes from proceeding to step 3 (and
+ − 217 looking in `default-process-coding-system').
+ − 218
+ − 219 You can change the coding systems later on using
+ − 220 `set-process-coding-system', `set-process-input-coding-system', or
+ − 221 `set-process-output-coding-system'.
+ − 222
+ − 223 See also `set-process-filter' and `set-process-stderr-filter'."
428
+ − 224 (let (cs-r cs-w)
+ − 225 (let (ret)
+ − 226 (catch 'found
+ − 227 (let ((alist process-coding-system-alist)
+ − 228 (case-fold-search nil))
+ − 229 (while alist
+ − 230 (if (string-match (car (car alist)) program)
+ − 231 (throw 'found (setq ret (cdr (car alist)))))
+ − 232 (setq alist (cdr alist))
+ − 233 )))
+ − 234 (if (functionp ret)
+ − 235 (setq ret (funcall ret 'start-process program)))
+ − 236 (cond ((consp ret)
+ − 237 (setq cs-r (car ret)
+ − 238 cs-w (cdr ret)))
853
+ − 239 ((and ret (find-coding-system ret))
428
+ − 240 (setq cs-r ret
+ − 241 cs-w ret))))
+ − 242 (let ((coding-system-for-read
771
+ − 243 (or coding-system-for-read cs-r
853
+ − 244 (car default-process-coding-system) 'undecided))
428
+ − 245 (coding-system-for-write
771
+ − 246 (or coding-system-for-write cs-w
853
+ − 247 (cdr default-process-coding-system) 'raw-text)))
428
+ − 248 (apply 'start-process-internal name buffer program program-args)
+ − 249 )))
+ − 250
+ − 251 (defvar network-coding-system-alist nil
+ − 252 "Alist to decide a coding system to use for a network I/O operation.
+ − 253 The format is ((PATTERN . VAL) ...),
+ − 254 where PATTERN is a regular expression matching a network service name
+ − 255 or is a port number to connect to,
+ − 256 VAL is a coding system, a cons of coding systems, or a function symbol.
+ − 257 If VAL is a coding system, it is used for both decoding what received
+ − 258 from the network stream and encoding what sent to the network stream.
+ − 259 If VAL is a cons of coding systems, the car part is used for decoding,
+ − 260 and the cdr part is used for encoding.
+ − 261 If VAL is a function symbol, the function must return a coding system
+ − 262 or a cons of coding systems which are used as above.
+ − 263
+ − 264 See also the function `find-operation-coding-system'.")
+ − 265
+ − 266 (defun open-network-stream (name buffer host service &optional protocol)
+ − 267 "Open a TCP connection for a service to a host.
444
+ − 268 Return a process object to represent the connection.
428
+ − 269 Input and output work as for subprocesses; `delete-process' closes it.
+ − 270 NAME is name for process. It is modified if necessary to make it unique.
+ − 271 BUFFER is the buffer (or buffer-name) to associate with the process.
+ − 272 Process output goes at end of that buffer, unless you specify
+ − 273 an output stream or filter function to handle the output.
+ − 274 BUFFER may be also nil, meaning that this process is not associated
853
+ − 275 with any buffer.
428
+ − 276 Third arg is name of the host to connect to, or its IP address.
+ − 277 Fourth arg SERVICE is name of the service desired, or an integer
+ − 278 specifying a port number to connect to.
+ − 279 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
+ − 280 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
+ − 281 supported. When omitted, 'tcp is assumed.
+ − 282
442
+ − 283 Output via `process-send-string' and input via buffer or filter (see
428
+ − 284 `set-process-filter') are stream-oriented. That means UDP datagrams are
+ − 285 not guaranteed to be sent and received in discrete packets. (But small
+ − 286 datagrams around 500 bytes that are not truncated by `process-send-string'
+ − 287 are usually fine.) Note further that UDP protocol does not guard against
853
+ − 288 lost packets.
+ − 289
+ − 290 The read/write coding systems used for process I/O on the process are
+ − 291 determined as follows:
+ − 292
+ − 293 1. `coding-system-for-read', `coding-system-for-write', if non-nil.
+ − 294 (Intended as a temporary overriding mechanism for use by Lisp
+ − 295 code.)
+ − 296 2. The matching value for the service from `network-coding-system-alist',
+ − 297 if any, and if non-nil. The value may be either a single coding
+ − 298 system, used for both read and write; or a cons of read/write; or a
+ − 299 function, called to get one of the other two values.
+ − 300 3. The value of `default-network-coding-system', which should be a cons
+ − 301 of read/write coding systems, if the values are non-nil.
+ − 302 4. The coding system `undecided' for read, and `raw-text' for write.
+ − 303
+ − 304 Note that the processes of determining the read and write coding systems
+ − 305 proceed essentially independently one from the other, as in `start-process'.
+ − 306
+ − 307 You can change the coding systems later on using
+ − 308 `set-process-coding-system', `set-process-input-coding-system', or
+ − 309 `set-process-output-coding-system'."
428
+ − 310 (let (cs-r cs-w)
+ − 311 (let (ret)
+ − 312 (catch 'found
+ − 313 (let ((alist network-coding-system-alist)
+ − 314 (case-fold-search nil)
+ − 315 pattern)
+ − 316 (while alist
+ − 317 (setq pattern (car (car alist)))
+ − 318 (and
+ − 319 (cond ((numberp pattern)
+ − 320 (and (numberp service)
+ − 321 (eq pattern service)))
+ − 322 ((stringp pattern)
+ − 323 (or (and (stringp service)
+ − 324 (string-match pattern service))
+ − 325 (and (numberp service)
+ − 326 (string-match pattern
+ − 327 (number-to-string service))))))
+ − 328 (throw 'found (setq ret (cdr (car alist)))))
+ − 329 (setq alist (cdr alist))
+ − 330 )))
+ − 331 (if (functionp ret)
+ − 332 (setq ret (funcall ret 'open-network-stream service)))
+ − 333 (cond ((consp ret)
+ − 334 (setq cs-r (car ret)
+ − 335 cs-w (cdr ret)))
853
+ − 336 ((and ret (find-coding-system ret))
428
+ − 337 (setq cs-r ret
+ − 338 cs-w ret))))
+ − 339 (let ((coding-system-for-read
853
+ − 340 (or coding-system-for-read cs-r
+ − 341 (car default-network-coding-system)
+ − 342 'undecided))
428
+ − 343 (coding-system-for-write
853
+ − 344 (or coding-system-for-write cs-w
+ − 345 (cdr default-network-coding-system)
+ − 346 'raw-text)))
428
+ − 347 (open-network-stream-internal name buffer host service protocol))))
+ − 348
771
+ − 349 (defun set-buffer-process-coding-system (decoding encoding)
+ − 350 "Set coding systems for the process associated with the current buffer.
+ − 351 DECODING is the coding system to be used to decode input from the process,
+ − 352 ENCODING is the coding system to be used to encode output to the process.
+ − 353
853
+ − 354 For a list of possible values of CODING-SYSTEM, use \\[coding-system-list]."
771
+ − 355 (interactive
+ − 356 "zCoding-system for process input: \nzCoding-system for process output: ")
+ − 357 (let ((proc (get-buffer-process (current-buffer))))
+ − 358 (if (null proc)
+ − 359 (error "no process")
+ − 360 (get-coding-system decoding)
+ − 361 (get-coding-system encoding)
+ − 362 (set-process-coding-system proc decoding encoding)))
+ − 363 (force-mode-line-update))
+ − 364
440
+ − 365 ;;; code-process.el ends here
