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