1 ;;; pccl-20.el --- Portable CCL utility for Emacs 20 and XEmacs-21-mule
3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
4 ;; Copyright (C) 1998 Tanaka Akira
6 ;; Author: Tanaka Akira <akr@jaist.ac.jp>
7 ;; Keywords: emulation, compatibility, Mule
9 ;; This file is part of APEL (A Portable Emacs Library).
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
30 (eval-when-compile (require 'ccl))
33 (broken-facility ccl-accept-symbol-as-program
34 "Emacs does not accept symbol as CCL program."
36 (define-ccl-program test-ccl-identity
37 '(1 ((read r0) (loop (write-read-repeat r0)))))
41 (if (fboundp 'ccl-vector-execute-on-string)
42 'ccl-vector-execute-on-string
43 'ccl-execute-on-string)
53 (if (featurep 'xemacs)
54 (defun make-ccl-coding-system (name mnemonic docstring decoder encoder)
56 Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
58 CODING-SYSTEM, DECODER and ENCODER must be symbol."
61 (list 'mnemonic (char-to-string mnemonic)
62 'decode (symbol-value decoder)
63 'encode (symbol-value encoder))))
64 (defun make-ccl-coding-system
65 (coding-system mnemonic docstring decoder encoder)
67 Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
69 CODING-SYSTEM, DECODER and ENCODER must be symbol."
70 (when-broken ccl-accept-symbol-as-program
71 (setq decoder (symbol-value decoder))
72 (setq encoder (symbol-value encoder)))
73 (make-coding-system coding-system 4 mnemonic docstring
74 (cons decoder encoder)))
77 (when-broken ccl-accept-symbol-as-program
79 (when (subrp (symbol-function 'ccl-execute))
80 (fset 'ccl-vector-program-execute
81 (symbol-function 'ccl-execute))
82 (defun ccl-execute (ccl-prog reg)
84 Execute CCL-PROG with registers initialized by REGISTERS.
85 If CCL-PROG is symbol, it is dereferenced.
86 \[Emacs 20.3 emulating function]"
87 (ccl-vector-program-execute
88 (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
91 (when (subrp (symbol-function 'ccl-execute-on-string))
92 (fset 'ccl-vector-program-execute-on-string
93 (symbol-function 'ccl-execute-on-string))
94 (defun ccl-execute-on-string (ccl-prog status string &optional contin)
96 Execute CCL-PROG with initial STATUS on STRING.
97 If CCL-PROG is symbol, it is dereferenced.
98 \[Emacs 20.3 emulating function]"
99 (ccl-vector-program-execute-on-string
100 (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
101 status string contin)))
106 (define-ccl-program test-ccl-eof-block
113 (make-ccl-coding-system
114 'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester"
115 'test-ccl-eof-block 'test-ccl-eof-block)
118 (broken-facility ccl-execute-eof-block-on-encoding-null
119 "Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input."
120 (equal (encode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
122 (broken-facility ccl-execute-eof-block-on-encoding-some
123 "Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input."
124 (equal (encode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
126 (broken-facility ccl-execute-eof-block-on-decoding-null
127 "Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input."
128 (equal (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
130 (broken-facility ccl-execute-eof-block-on-decoding-some
131 "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input."
132 (equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
134 (broken-facility ccl-execute-eof-block-on-encoding
135 "Emacs may forget executing CCL_EOF_BLOCK with encoding."
136 (not (or (broken-p 'ccl-execute-eof-block-on-encoding-null)
137 (broken-p 'ccl-execute-eof-block-on-encoding-some)))
140 (broken-facility ccl-execute-eof-block-on-decoding
141 "Emacs may forget executing CCL_EOF_BLOCK with decoding."
142 (not (or (broken-p 'ccl-execute-eof-block-on-decoding-null)
143 (broken-p 'ccl-execute-eof-block-on-decoding-some)))
146 (broken-facility ccl-execute-eof-block
147 "Emacs may forget executing CCL_EOF_BLOCK."
148 (not (or (broken-p 'ccl-execute-eof-block-on-encoding)
149 (broken-p 'ccl-execute-eof-block-on-decoding)))
158 ;;; pccl-20.el ends here