/
pccl-om.el
130 lines (103 loc) · 4.34 KB
/
pccl-om.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
;;; pccl-om.el --- Portable CCL utility for Mule 2.*
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Copyright (C) 1998 Tanaka Akira
;; Author: Tanaka Akira <akr@jaist.ac.jp>
;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;; Keywords: emulation, compatibility, Mule
;; This file is part of APEL (A Portable Emacs Library).
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Code:
(eval-when-compile (require 'ccl))
(require 'broken)
(broken-facility ccl-accept-symbol-as-program
"Emacs does not accept symbol as CCL program.")
(eval-and-compile
(defun make-ccl-coding-system
(coding-system mnemonic doc-string decoder encoder)
"\
Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
CODING-SYSTEM, DECODER and ENCODER must be symbol."
(setq decoder (symbol-value decoder)
encoder (symbol-value encoder))
(make-coding-system coding-system 4 mnemonic doc-string
nil ; Mule takes one more optional argument: EOL-TYPE.
(cons decoder encoder)))
)
(defun ccl-execute (ccl-prog reg)
"Execute CCL-PROG with registers initialized by REGISTERS.
If CCL-PROG is symbol, it is dereferenced.
\[Emacs 20.3 emulating function]"
(exec-ccl
(if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
reg))
(defun ccl-execute-on-string (ccl-prog status string &optional contin)
"Execute CCL-PROG with initial STATUS on STRING.
If CCL-PROG is symbol, it is dereferenced.
\[Emacs 20.3 emulating function]"
(exec-ccl-string
(if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
status string))
(broken-facility ccl-execute-on-string-ignore-contin
"CONTIN argument for ccl-execute-on-string is ignored.")
(eval-when-compile
(define-ccl-program test-ccl-eof-block
'(1
((read r0)
(write r0)
(read r0))
(write "[EOF]")))
(make-ccl-coding-system
'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester"
'test-ccl-eof-block 'test-ccl-eof-block)
)
(broken-facility ccl-execute-eof-block-on-encoding-null
"Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input."
(equal (code-convert-string "" *internal* 'test-ccl-eof-block-cs) "[EOF]"))
(broken-facility ccl-execute-eof-block-on-encoding-some
"Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input."
(equal (code-convert-string "a" *internal* 'test-ccl-eof-block-cs) "a[EOF]"))
(broken-facility ccl-execute-eof-block-on-decoding-null
"Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input."
(equal (code-convert-string "" 'test-ccl-eof-block-cs *internal*) "[EOF]"))
(broken-facility ccl-execute-eof-block-on-decoding-some
"Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input."
(equal (code-convert-string "a" 'test-ccl-eof-block-cs *internal*) "a[EOF]"))
(broken-facility ccl-execute-eof-block-on-encoding
"Emacs may forget executing CCL_EOF_BLOCK with encoding."
(not (or (broken-p 'ccl-execute-eof-block-on-encoding-null)
(broken-p 'ccl-execute-eof-block-on-encoding-some)))
t)
(broken-facility ccl-execute-eof-block-on-decoding
"Emacs may forget executing CCL_EOF_BLOCK with decoding."
(not (or (broken-p 'ccl-execute-eof-block-on-decoding-null)
(broken-p 'ccl-execute-eof-block-on-decoding-some)))
t)
(broken-facility ccl-execute-eof-block
"Emacs may forget executing CCL_EOF_BLOCK."
(not (or (broken-p 'ccl-execute-eof-block-on-encoding)
(broken-p 'ccl-execute-eof-block-on-decoding)))
t)
(broken-facility ccl-cascading-read
"Emacs CCL read command does not accept more than 2 arguments."
(condition-case nil
(progn
(define-ccl-program cascading-read-test
'(1
(read r0 r1 r2)))
t)
(error nil)))
;;; @ end
;;;
(provide 'pccl-om)
;;; pccl-om.el ends here