Mercurial > hg > xemacs-beta
annotate lisp/code-process.el @ 5565:48a3d3281b48
Pass eighth bit on TTY consoles to coding system if needed.
src/ChangeLog addition:
2011-09-06 Aidan Kehoe <kehoea@parhasard.net>
* redisplay-tty.c (init_tty_for_redisplay):
Only set the console meta key flag to treat the eight bit as meta
if the native coding system doesn't need that.
* general-slots.h:
* mule-coding.c:
* mule-coding.c (syms_of_mule_coding):
Move Qiso2022, Qseven to general-slots.h, they're now used in
redisplay-tty.c.
lisp/ChangeLog addition:
2011-09-06 Aidan Kehoe <kehoea@parhasard.net>
* mule/mule-cmds.el (set-language-environment-coding-systems):
Set the input mode for TTY consoles to use the eighth bit for
character information if the native coding system for the language
environment needs that.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 06 Sep 2011 11:44:50 +0100 |
| parents | 91b3aa59f49b |
| children | a216b3c2b09e |
| rev | line source |
|---|---|
| 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 | |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
16 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
17 ;; under the terms of the GNU General Public License as published by the |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
18 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
19 ;; option) any later version. |
| 428 | 20 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
21 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
22 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
23 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
24 ;; for more details. |
| 428 | 25 |
| 26 ;; You should have received a copy of the GNU General Public License | |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2356
diff
changeset
|
27 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 28 |
| 29 ;;; Code: | |
| 30 | |
| 31 (defvar process-coding-system-alist nil | |
| 32 "Alist to decide a coding system to use for a process I/O operation. | |
| 33 The format is ((PATTERN . VAL) ...), | |
| 34 where PATTERN is a regular expression matching a program name, | |
| 35 VAL is a coding system, a cons of coding systems, or a function symbol. | |
| 36 If VAL is a coding system, it is used for both decoding what received | |
| 37 from the program and encoding what sent to the program. | |
| 38 If VAL is a cons of coding systems, the car part is used for decoding, | |
| 39 and the cdr part is used for encoding. | |
| 853 | 40 If VAL is a function symbol, it is called with two arguments, a symbol |
| 41 indicating the operation being performed (one of `start-process', | |
| 42 `call-process', `open-network-stream', or `open-multicast-group') and the | |
| 43 program name. The function must return a coding system or a cons of | |
| 44 coding systems which are used as above.") | |
| 428 | 45 |
| 46 (defun call-process (program &optional infile buffer displayp &rest args) | |
| 47 "Call PROGRAM synchronously in separate process. | |
| 853 | 48 |
| 428 | 49 The program's input comes from file INFILE (nil means `/dev/null'). |
| 853 | 50 XEmacs feature: INFILE can also be a list of (BUFFER [START [END]]), i.e. |
| 51 a list of one to three elements, consisting of a buffer and optionally | |
| 52 a start position or start and end position. In this case, input comes | |
| 53 from the buffer, starting from START (defaults to the beginning of the | |
| 54 buffer) and ending at END (defaults to the end of the buffer). | |
| 55 | |
| 428 | 56 Insert output in BUFFER before point; t means current buffer; |
| 57 nil for BUFFER means discard it; 0 means discard and don't wait. | |
| 837 | 58 If BUFFER is a string, then find or create a buffer with that name, |
| 59 then insert the output in that buffer, before point. | |
| 428 | 60 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
| 61 REAL-BUFFER says what to do with standard output, as above, | |
| 62 while STDERR-FILE says what to do with standard error in the child. | |
| 63 STDERR-FILE may be nil (discard standard error output), | |
| 853 | 64 t (mix it with ordinary output), a file name string, or (XEmacs feature) |
| 65 a buffer object. If STDERR-FILE is a buffer object (but not the name of | |
| 66 a buffer, since that would be interpreted as a file), the standard error | |
| 67 output will be inserted into the buffer before point. | |
| 428 | 68 |
| 853 | 69 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. |
| 428 | 70 Remaining arguments are strings passed as command arguments to PROGRAM. |
| 71 | |
| 853 | 72 If BUFFER is 0, returns immediately with value nil. |
| 73 Otherwise waits for PROGRAM to terminate and returns a numeric exit status | |
| 74 or a signal description string. If you quit, the process is first killed | |
| 75 with SIGINT, then with SIGKILL if you quit again before the process exits. | |
| 76 | |
| 77 If INFILE is a file, we transfer its exact contents to the process without | |
| 78 any encoding/decoding. (#### This policy might change.) | |
| 79 | |
| 80 Otherwise, the read/write coding systems used for process I/O on the | |
| 81 process are determined as follows: | |
| 82 | |
| 83 1. `coding-system-for-read', `coding-system-for-write', if non-nil. | |
| 84 (Intended as a temporary overriding mechanism for use by Lisp | |
| 85 code.) | |
| 86 2. The matching value for the process name from `process-coding-system-alist', | |
| 87 if any, and if non-nil. The value may be either a single coding | |
| 88 system, used for both read and write; or a cons of read/write; or a | |
| 89 function, called to get one of the other two values. | |
| 90 3. For writing: If a buffer was given in INFILE, the value of | |
| 91 `buffer-file-coding-system' in that buffer. | |
| 92 For reading: if a buffer was given in BUFFER, the value of | |
| 93 `buffer-file-coding-system-for-read' in that buffer. | |
| 94 4. The value of `default-process-coding-system', which should be a cons | |
| 95 of read/write coding systems, if the values are non-nil. | |
| 96 5. The coding system `undecided' for read, and `raw-text' for write. | |
| 97 | |
| 98 Note that the processes of determining the read and write coding systems | |
| 99 proceed essentially independently one from the other, as in `start-process'." | |
| 100 (let (cs-r cs-w) | |
| 101 (let (ret) | |
| 102 (catch 'found | |
| 103 (let ((alist process-coding-system-alist) | |
| 104 (case-fold-search nil)) | |
| 105 (while alist | |
| 106 (if (string-match (car (car alist)) program) | |
| 107 (throw 'found (setq ret (cdr (car alist))))) | |
| 108 (setq alist (cdr alist)) | |
| 109 ))) | |
| 110 (if (functionp ret) | |
| 111 (setq ret (funcall ret 'call-process program))) | |
| 112 (cond ((consp ret) | |
| 113 (setq cs-r (car ret) | |
| 114 cs-w (cdr ret))) | |
| 115 ((and ret (find-coding-system ret)) | |
| 116 (setq cs-r ret | |
| 117 cs-w ret)))) | |
| 118 (let ((coding-system-for-read | |
| 119 (or coding-system-for-read cs-r | |
| 120 (let ((thebuf (if (consp buffer) (car buffer) buffer))) | |
| 121 (and (or (bufferp thebuf) (stringp thebuf)) | |
| 122 (get-buffer thebuf) | |
| 123 (symbol-value-in-buffer | |
| 857 | 124 'buffer-file-coding-system-for-read (get-buffer thebuf)))) |
| 853 | 125 (car default-process-coding-system) |
| 126 'undecided)) | |
| 127 (coding-system-for-write | |
| 128 (or coding-system-for-write cs-w | |
| 129 (and (consp infile) | |
| 130 (symbol-value-in-buffer | |
| 131 'buffer-file-coding-system | |
| 132 (get-buffer (car infile)))) | |
| 133 (cdr default-process-coding-system) | |
| 134 'raw-text))) | |
| 135 (apply 'call-process-internal program infile buffer displayp args)))) | |
| 428 | 136 |
| 137 (defun call-process-region (start end program | |
| 138 &optional deletep buffer displayp | |
| 139 &rest args) | |
| 140 "Send text from START to END to a synchronous process running PROGRAM. | |
| 141 Delete the text if fourth arg DELETEP is non-nil. | |
| 142 | |
| 143 Insert output in BUFFER before point; t means current buffer; | |
| 144 nil for BUFFER means discard it; 0 means discard and don't wait. | |
| 837 | 145 If BUFFER is a string, then find or create a buffer with that name, |
| 146 then insert the output in that buffer, before point. | |
| 428 | 147 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
| 148 REAL-BUFFER says what to do with standard output, as above, | |
| 149 while STDERR-FILE says what to do with standard error in the child. | |
| 150 STDERR-FILE may be nil (discard standard error output), | |
| 853 | 151 t (mix it with ordinary output), a file name string, or (XEmacs feature) |
| 152 a buffer object. If STDERR-FILE is a buffer object (but not the name of | |
| 153 a buffer, since that would be interpreted as a file), the standard error | |
| 154 output will be inserted into the buffer before point. | |
| 428 | 155 |
| 156 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted. | |
| 157 Remaining args are passed to PROGRAM at startup as command args. | |
| 158 | |
| 159 If BUFFER is 0, returns immediately with value nil. | |
| 853 | 160 Otherwise waits for PROGRAM to terminate and returns a numeric exit status |
| 161 or a signal description string. If you quit, the process is first killed | |
| 162 with SIGINT, then with SIGKILL if you quit again before the process exits. | |
| 163 | |
| 164 The read/write coding systems used for process I/O on the process are | |
| 165 the same as for `call-process'." | |
| 2356 | 166 |
| 167 ;; We can't delete the region before feeding it to `call-process', so we | |
| 168 ;; take care not to delete the insertion when we delete the region. START | |
| 169 ;; and END may not be markers; copy them. (point) will end up after the | |
| 170 ;; insertion. A copy of (point) tracks the beginning of the insertion. | |
| 171 | |
| 172 (let ((s (and deletep (copy-marker start))) ; Only YOU can | |
| 173 (e (and deletep (copy-marker end t))) ; prevent | |
| 174 (p (and deletep (copy-marker (point)))) ; excess consing! | |
| 175 (retval | |
| 176 (apply #'call-process program (list (current-buffer) start end) | |
| 177 buffer displayp args))) | |
| 178 (when deletep | |
| 179 (if (<= s p e) | |
| 180 ;; region was split by insertion | |
| 181 ;; the order checks are gilt lilies | |
| 182 (progn (when (< (point) e) (delete-region (point) e)) | |
| 183 (when (< s p) (delete-region s p))) | |
| 184 ;; insertion was outside of region | |
| 185 (delete-region s e))) | |
| 186 retval)) | |
| 428 | 187 |
| 188 (defun start-process (name buffer program &rest program-args) | |
| 189 "Start a program in a subprocess. Return the process object for it. | |
| 190 NAME is name for process. It is modified if necessary to make it unique. | |
| 191 BUFFER is the buffer or (buffer-name) to associate with the process. | |
| 853 | 192 Process output goes at end of that buffer, unless you specify |
| 193 an output stream or filter function to handle the output. | |
| 194 BUFFER may be also nil, meaning that this process is not associated | |
| 195 with any buffer. | |
| 196 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case, | |
| 197 REAL-BUFFER says what to do with standard output, as above, | |
| 198 while STDERR-BUFFER says what to do with standard error in the child. | |
| 199 STDERR-BUFFER may be nil (discard standard error output, unless a stderr | |
| 200 filter is set). Note that if you do not use this form at process creation, | |
| 201 stdout and stderr will be mixed in the output buffer, and this cannot be | |
| 202 changed, even by setting a stderr filter. | |
| 428 | 203 Third arg is program file name. It is searched for as in the shell. |
| 204 Remaining arguments are strings to give program as arguments. | |
| 853 | 205 |
| 206 The read/write coding systems used for process I/O on the process are | |
| 207 determined as follows: | |
| 208 | |
| 209 1. `coding-system-for-read', `coding-system-for-write', if non-nil. | |
| 210 (Intended as a temporary overriding mechanism for use by Lisp | |
| 211 code.) | |
| 212 2. The matching value for the process name from `process-coding-system-alist', | |
| 213 if any, and if non-nil. The value may be either a single coding | |
| 214 system, used for both read and write; or a cons of read/write; or a | |
| 215 function, called to get one of the other two values. | |
| 216 3. The value of `default-process-coding-system', which should be a cons | |
| 217 of read/write coding systems, if the values are non-nil. | |
| 218 4. The coding system `undecided' for read, and `raw-text' for write. | |
| 219 | |
| 220 Note that the processes of determining the read and write coding systems | |
| 221 proceed essentially independently one from the other. For example, a value | |
| 222 determined from `process-coding-system-alist' might specify a read coding | |
| 223 system but not a write coding system, in which the read coding system is as | |
| 224 specified and the write coding system comes from proceeding to step 3 (and | |
| 225 looking in `default-process-coding-system'). | |
| 226 | |
| 227 You can change the coding systems later on using | |
| 228 `set-process-coding-system', `set-process-input-coding-system', or | |
| 229 `set-process-output-coding-system'. | |
| 230 | |
| 231 See also `set-process-filter' and `set-process-stderr-filter'." | |
| 428 | 232 (let (cs-r cs-w) |
| 233 (let (ret) | |
| 234 (catch 'found | |
| 235 (let ((alist process-coding-system-alist) | |
| 236 (case-fold-search nil)) | |
| 237 (while alist | |
| 238 (if (string-match (car (car alist)) program) | |
| 239 (throw 'found (setq ret (cdr (car alist))))) | |
| 240 (setq alist (cdr alist)) | |
| 241 ))) | |
| 242 (if (functionp ret) | |
| 243 (setq ret (funcall ret 'start-process program))) | |
| 244 (cond ((consp ret) | |
| 245 (setq cs-r (car ret) | |
| 246 cs-w (cdr ret))) | |
| 853 | 247 ((and ret (find-coding-system ret)) |
| 428 | 248 (setq cs-r ret |
| 249 cs-w ret)))) | |
| 250 (let ((coding-system-for-read | |
| 771 | 251 (or coding-system-for-read cs-r |
| 853 | 252 (car default-process-coding-system) 'undecided)) |
| 428 | 253 (coding-system-for-write |
| 771 | 254 (or coding-system-for-write cs-w |
| 853 | 255 (cdr default-process-coding-system) 'raw-text))) |
| 428 | 256 (apply 'start-process-internal name buffer program program-args) |
| 257 ))) | |
| 258 | |
| 259 (defvar network-coding-system-alist nil | |
| 260 "Alist to decide a coding system to use for a network I/O operation. | |
| 261 The format is ((PATTERN . VAL) ...), | |
| 262 where PATTERN is a regular expression matching a network service name | |
| 263 or is a port number to connect to, | |
| 264 VAL is a coding system, a cons of coding systems, or a function symbol. | |
| 265 If VAL is a coding system, it is used for both decoding what received | |
| 266 from the network stream and encoding what sent to the network stream. | |
| 267 If VAL is a cons of coding systems, the car part is used for decoding, | |
| 268 and the cdr part is used for encoding. | |
| 269 If VAL is a function symbol, the function must return a coding system | |
| 270 or a cons of coding systems which are used as above. | |
| 271 | |
| 272 See also the function `find-operation-coding-system'.") | |
| 273 | |
| 274 (defun open-network-stream (name buffer host service &optional protocol) | |
| 275 "Open a TCP connection for a service to a host. | |
| 444 | 276 Return a process object to represent the connection. |
| 428 | 277 Input and output work as for subprocesses; `delete-process' closes it. |
| 278 NAME is name for process. It is modified if necessary to make it unique. | |
| 279 BUFFER is the buffer (or buffer-name) to associate with the process. | |
| 280 Process output goes at end of that buffer, unless you specify | |
| 281 an output stream or filter function to handle the output. | |
| 282 BUFFER may be also nil, meaning that this process is not associated | |
| 853 | 283 with any buffer. |
| 428 | 284 Third arg is name of the host to connect to, or its IP address. |
| 285 Fourth arg SERVICE is name of the service desired, or an integer | |
| 286 specifying a port number to connect to. | |
| 287 Fifth argument PROTOCOL is a network protocol. Currently 'tcp | |
| 288 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are | |
| 289 supported. When omitted, 'tcp is assumed. | |
| 290 | |
| 442 | 291 Output via `process-send-string' and input via buffer or filter (see |
| 428 | 292 `set-process-filter') are stream-oriented. That means UDP datagrams are |
| 293 not guaranteed to be sent and received in discrete packets. (But small | |
| 294 datagrams around 500 bytes that are not truncated by `process-send-string' | |
| 295 are usually fine.) Note further that UDP protocol does not guard against | |
| 853 | 296 lost packets. |
| 297 | |
| 298 The read/write coding systems used for process I/O on the process are | |
| 299 determined as follows: | |
| 300 | |
| 301 1. `coding-system-for-read', `coding-system-for-write', if non-nil. | |
| 302 (Intended as a temporary overriding mechanism for use by Lisp | |
| 303 code.) | |
| 304 2. The matching value for the service from `network-coding-system-alist', | |
| 305 if any, and if non-nil. The value may be either a single coding | |
| 306 system, used for both read and write; or a cons of read/write; or a | |
| 307 function, called to get one of the other two values. | |
| 308 3. The value of `default-network-coding-system', which should be a cons | |
| 309 of read/write coding systems, if the values are non-nil. | |
| 310 4. The coding system `undecided' for read, and `raw-text' for write. | |
| 311 | |
| 312 Note that the processes of determining the read and write coding systems | |
| 313 proceed essentially independently one from the other, as in `start-process'. | |
| 314 | |
| 315 You can change the coding systems later on using | |
| 316 `set-process-coding-system', `set-process-input-coding-system', or | |
| 317 `set-process-output-coding-system'." | |
| 428 | 318 (let (cs-r cs-w) |
| 319 (let (ret) | |
| 320 (catch 'found | |
| 321 (let ((alist network-coding-system-alist) | |
| 322 (case-fold-search nil) | |
| 323 pattern) | |
| 324 (while alist | |
| 325 (setq pattern (car (car alist))) | |
| 326 (and | |
| 327 (cond ((numberp pattern) | |
| 328 (and (numberp service) | |
| 329 (eq pattern service))) | |
| 330 ((stringp pattern) | |
| 331 (or (and (stringp service) | |
| 332 (string-match pattern service)) | |
| 333 (and (numberp service) | |
| 334 (string-match pattern | |
| 335 (number-to-string service)))))) | |
| 336 (throw 'found (setq ret (cdr (car alist))))) | |
| 337 (setq alist (cdr alist)) | |
| 338 ))) | |
| 339 (if (functionp ret) | |
| 340 (setq ret (funcall ret 'open-network-stream service))) | |
| 341 (cond ((consp ret) | |
| 342 (setq cs-r (car ret) | |
| 343 cs-w (cdr ret))) | |
| 853 | 344 ((and ret (find-coding-system ret)) |
| 428 | 345 (setq cs-r ret |
| 346 cs-w ret)))) | |
| 347 (let ((coding-system-for-read | |
| 853 | 348 (or coding-system-for-read cs-r |
| 349 (car default-network-coding-system) | |
| 350 'undecided)) | |
| 428 | 351 (coding-system-for-write |
| 853 | 352 (or coding-system-for-write cs-w |
| 353 (cdr default-network-coding-system) | |
| 354 'raw-text))) | |
| 428 | 355 (open-network-stream-internal name buffer host service protocol)))) |
| 356 | |
| 771 | 357 (defun set-buffer-process-coding-system (decoding encoding) |
| 358 "Set coding systems for the process associated with the current buffer. | |
| 359 DECODING is the coding system to be used to decode input from the process, | |
| 360 ENCODING is the coding system to be used to encode output to the process. | |
| 361 | |
| 853 | 362 For a list of possible values of CODING-SYSTEM, use \\[coding-system-list]." |
| 771 | 363 (interactive |
| 364 "zCoding-system for process input: \nzCoding-system for process output: ") | |
| 365 (let ((proc (get-buffer-process (current-buffer)))) | |
| 366 (if (null proc) | |
| 367 (error "no process") | |
| 368 (get-coding-system decoding) | |
| 369 (get-coding-system encoding) | |
| 370 (set-process-coding-system proc decoding encoding))) | |
| 371 (force-mode-line-update)) | |
| 372 | |
| 440 | 373 ;;; code-process.el ends here |