pccl.el

   1 ;;; pccl.el --- Portable CCL utility for Mule 2.*
   2
   3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: emulation, compatibility, Mule
   7
   8 ;; This file is part of APEL (A Portable Emacs Library).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'broken)
  28
  29 (broken-facility ccl-usable
  30   "Emacs has not CCL."
  31   (and (featurep 'mule)
  32        (if (featurep 'xemacs)
  33            (>= emacs-major-version 21)
  34          (>= emacs-major-version 19))))
  35
  36 (unless-broken ccl-usable
  37   (require 'ccl)
  38   (require 'advice)
  39
  40   (if (featurep 'mule)
  41       (if (featurep 'xemacs)
  42           (if (>= emacs-major-version 21)
  43               ;; for XEmacs 21 with mule
  44               (require 'pccl-20))
  45         (if (>= emacs-major-version 20)
  46             ;; for Emacs 20
  47             (require 'pccl-20)
  48           ;; for Mule 2.*
  49           (require 'pccl-om))))
  50
  51   (defadvice define-ccl-program
  52     (before accept-long-ccl-program activate)
  53     "When CCL-PROGRAM is too long, internal buffer is extended automaticaly."
  54     (let ((try-ccl-compile t)
  55           (prog (eval (ad-get-arg 1))))
  56       (ad-set-arg 1 (` '(, prog)))
  57       (while try-ccl-compile
  58         (setq try-ccl-compile nil)
  59         (condition-case sig
  60             (ccl-compile prog)
  61           (args-out-of-range
  62            (if (and (eq (car (cdr sig)) ccl-program-vector)
  63                     (= (car (cdr (cdr sig))) (length ccl-program-vector)))
  64                (setq ccl-program-vector
  65                      (make-vector (* 2 (length ccl-program-vector)) 0)
  66                      try-ccl-compile t)
  67              (signal (car sig) (cdr sig))))))))
  68   )
  69
  70
  71 ;;; @ end
  72 ;;;
  73
  74 (require 'product)
  75 (product-provide (provide 'pccl) (require 'apel-ver))
  76
  77 ;;; pccl.el ends here