git.chise.org Git - chise/xemacs-chise.git.1/blob - 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