pccl-om.el

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