1 ;;; egg-com.el --- Communication Routines in Egg Input
2 ;;; Method Architecture
4 ;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical
6 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
8 ;; Author: Hisashi Miyashita <himi@bird.scphys.kyoto-u.ac.jp>
9 ;; NIIBE Yutaka <gniibe@mri.co.jp>
10 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
12 ;; This file will be part of GNU Emacs (in future).
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
34 (define-ccl-program ccl-decode-fixed-euc-jp
36 ((r2 = ,(charset-id 'japanese-jisx0208))
37 (r3 = ,(charset-id 'japanese-jisx0212))
38 (r4 = ,(charset-id 'katakana-jisx0201))
45 (write-read-repeat r0))
47 (write-read-repeat r0))
51 (write-read-repeat r0))
54 (write-read-repeat r0)))))))))
56 (define-ccl-program ccl-encode-fixed-euc
61 ; (write-read-repeat r0))
62 (if (r0 == ,(charset-id 'latin-jisx0201)) ; Unify
67 (write-read-repeat r0)))
68 (r6 = (r0 == ,(charset-id 'japanese-jisx0208)))
69 (r6 |= (r0 == ,(charset-id 'japanese-jisx0208-1978)))
70 (r6 |= (r0 == ,(charset-id 'chinese-gb2312)))
71 (r6 |= (r0 == ,(charset-id 'korean-ksc5601)))
76 (write-read-repeat r0)))
77 (r6 = (r0 == ,(charset-id 'katakana-jisx0201)))
78 (r6 |= (r0 == ,(charset-id 'chinese-sisheng)))
82 (write-read-repeat r0)))
83 (if (r0 == ,(charset-id 'japanese-jisx0212)) ;G3
88 (write-read-repeat r0)))
93 (make-coding-system 'fixed-euc-jp 4 ?W "Coding System for fixed EUC Japanese"
94 (cons ccl-decode-fixed-euc-jp ccl-encode-fixed-euc))
96 (defsubst comm-format-u32c (uint32c)
97 (let ((h0 (car uint32c))
99 (let ((b0 (logand (lsh h0 -8) 255))
101 (b2 (logand (lsh h1 -8) 255))
102 (b3 (logand h1 255)))
106 (insert-char b3 1))))
108 (defsubst comm-format-u32 (uint32)
109 (let ((b0 (logand (lsh uint32 -24) 255))
110 (b1 (logand (lsh uint32 -16) 255))
111 (b2 (logand (lsh uint32 -8) 255))
112 (b3 (logand uint32 255)))
118 (defsubst comm-format-i32 (int32)
119 (let ((b0 (logand (ash int32 -24) 255))
120 (b1 (logand (ash int32 -16) 255))
121 (b2 (logand (ash int32 -8) 255))
122 (b3 (logand int32 255)))
128 (defsubst comm-format-u16 (uint16)
129 (let ((b0 (logand (lsh uint16 -8) 255))
130 (b1 (logand uint16 255)))
134 (defsubst comm-format-u8 (uint8)
135 (let ((b0 (logand uint8 255)))
138 ;;; XXX should support other code conversion
139 (defsubst comm-format-u16-string (s)
140 (let ((euc-string (encode-coding-string s 'fixed-euc-jp)))
145 ;;; XXX should support other code conversion
146 (defsubst comm-format-mb-string (s)
147 (let ((euc-string (encode-coding-string s 'euc-japan)))
151 (defsubst comm-format-u8-string (s)
155 (defsubst comm-format-bytes (s)
159 (defmacro comm-format (format &rest args)
160 "Format a string out of a control-list and arguments into the buffer.
161 u means unsigned 32-bit in big endian.
162 i means unsigned 32-bit in big endian.
163 w means unsigned 16-bit in big endian.
164 b means unsigned 8-bit.
165 S means 16-bit(big endian) wide-character string (0x0000 terminated).
166 E means multibyte string (0x00 terminated).
167 s means 8-bit string (0x00 terminated)."
168 (let ((p args) result arg f)
171 (setq f (car format))
175 (cond ((eq f 'U) (list 'comm-format-u32c arg))
176 ((eq f 'u) (list 'comm-format-u32 arg))
177 ((eq f 'i) (list 'comm-format-i32 arg))
178 ((eq f 'w) (list 'comm-format-u16 arg))
179 ((eq f 'b) (list 'comm-format-u8 arg))
180 ((eq f 'S) (list 'comm-format-u16-string arg))
181 ((eq f 'E) (list 'comm-format-mb-string arg))
182 ((eq f 's) (list 'comm-format-u8-string arg))
183 ((eq f 'B) (list 'comm-format-bytes arg))))))
185 (setq format (cdr format)))
190 ;; Do not move the point, leave it where it was.
191 (defun comm-accept-process-output (proc)
193 (accept-process-output proc)
196 ;; Assume PROC is bound to the process of current buffer
197 (defsubst comm-following-char-or-wait (proc)
200 (while (= p (point-max))
201 (accept-process-output proc))
205 (defun comm-following+forward-char (proc)
207 (comm-following-char-or-wait proc)
210 (defsubst comm-unpack-u32c (proc uint32c)
214 (lsh (comm-following+forward-char proc) 8)
215 (comm-following+forward-char proc)))
218 (lsh (comm-following+forward-char proc) 8)
219 (comm-following+forward-char proc)))
220 (set uint32c (cons h0 h1))))
222 (defsubst comm-unpack-u32 (proc uint32)
225 (lsh (comm-following+forward-char proc) 24)
226 (lsh (comm-following+forward-char proc) 16)
227 (lsh (comm-following+forward-char proc) 8)
228 (comm-following+forward-char proc))))
230 (defsubst comm-unpack-u16 (proc uint16)
233 (lsh (comm-following+forward-char proc) 8)
234 (comm-following+forward-char proc))))
236 (defsubst comm-unpack-u8 (proc uint8)
238 (comm-following+forward-char proc)))
240 ;;; XXX should support other conversion (euc-kr, cns)
241 (defsubst comm-unpack-u16-string (proc s)
242 (let ((start (point)))
243 (while (not (search-forward "\0\0" nil t))
244 (comm-accept-process-output proc))
245 (set s (buffer-substring start
247 (decode-coding-region start (- (point) 2)
250 ;;; XXX should support other conversion (euc-kr, cns)
251 (defsubst comm-unpack-mb-string (proc s)
252 (let ((start (point)))
253 (while (not (search-forward "\0" nil t))
254 (comm-accept-process-output proc))
255 (set s (buffer-substring start
257 (decode-coding-region start (- (point) 1)
260 (defsubst comm-unpack-u8-string (proc s)
261 (let ((start (point)))
262 (while (not (search-forward "\0" nil 1))
263 (comm-accept-process-output proc))
264 (set s (buffer-substring start (1- (point))))))
266 (defsubst comm-unpack-bytes (proc s)
267 (let ((start (point)))
268 (while (not (search-forward "\377" nil 1))
269 (comm-accept-process-output proc))
270 (set s (buffer-substring start (1- (point))))))
272 (defmacro comm-unpack (format &rest args)
273 "Unpack a string out of a control-string and set arguments.
274 u means unsigned 32-bit in big endian.
275 w means unsigned 16-bit in big endian.
276 b means unsigned 8-bit.
277 S means 16-bit(big endian) string (0x0000 terminated).
278 E means multibyte string (0x00 terminated).
279 s means 8-bit string (0x00 terminated).
281 (let ((p args) result arg f)
284 (setq f (car format))
288 (cond ((eq f 'U) (list 'comm-unpack-u32c
289 'proc (list 'quote arg)))
290 ((eq f 'u) (list 'comm-unpack-u32
291 'proc (list 'quote arg)))
292 ((eq f 'w) (list 'comm-unpack-u16
293 'proc (list 'quote arg)))
294 ((eq f 'b) (list 'comm-unpack-u8
295 'proc (list 'quote arg)))
296 ((eq f 'S) (list 'comm-unpack-u16-string
297 'proc (list 'quote arg)))
298 ((eq f 'E) (list 'comm-unpack-mb-string
299 'proc (list 'quote arg)))
300 ((eq f 's) (list 'comm-unpack-u8-string
301 'proc (list 'quote arg)))
302 ((eq f 'B) (list 'comm-unpack-u8-string
303 'proc (list 'quote arg)))))))
305 (setq format (cdr format)))
310 (defmacro comm-call-with-proc (proc vlist send-expr &rest receive-exprs)
315 (set-buffer (process-buffer proc))
318 (process-send-region proc (point-min) (point-max))
319 (goto-char (prog1 (point) (accept-process-output proc))))
322 (defmacro comm-call-with-proc-1 (proc vlist send-expr &rest receive-exprs)
329 (process-send-region proc (point-min) (point-max))
330 (goto-char (prog1 (point) (accept-process-output proc))))
334 ;;; egg-com.el ends here.