From 1f6362ded1410b83ef9550b7f54f6fa5e6bc6730 Mon Sep 17 00:00:00 2001 From: akr Date: Sat, 19 Sep 1998 00:40:50 +0000 Subject: [PATCH] * broken.el: New file. * pccl.el (apel-broken-facility): Abolished (apel-broken-p): Abolished * EMU-ELS (emu-modules): Add 'broken. * Makefile (elc): Do not remove emu*.elc. * pccl-20.el: require 'broken. (ccl-use-symbol-as-program): Abolished. (ccl-accept-symbol-as-program): New facility. (make-ccl-coding-system): Use `when-broken' to define. (ccl-encoder-eof-block-is-broken): Abolished. (ccl-decoder-eof-block-is-broken): Abolished. (ccl-eof-block-is-broken): Abolished (ccl-execute-eof-block-on-encoding-null): New facility. (ccl-execute-eof-block-on-encoding-some): Ditto. (ccl-execute-eof-block-on-decoding-null): Ditto. (ccl-execute-eof-block-on-decoding-some): Ditto. (ccl-execute-eof-block-on-encoding): Ditto. (ccl-execute-eof-block-on-decoding): Ditto. (ccl-execute-eof-block): Ditto. * pccl-om.el: require 'broken. (ccl-use-symbol-as-program): Abolished. (ccl-accept-symbol-as-program): New facility. (ccl-encoder-eof-block-is-broken): Abolished. (ccl-decoder-eof-block-is-broken): Abolished. (ccl-eof-block-is-broken): Abolished (ccl-execute-eof-block-on-encoding-null): New facility. (ccl-execute-eof-block-on-encoding-some): Ditto. (ccl-execute-eof-block-on-decoding-null): Ditto. (ccl-execute-eof-block-on-decoding-some): Ditto. (ccl-execute-eof-block-on-encoding): Ditto. (ccl-execute-eof-block-on-decoding): Ditto. (ccl-execute-eof-block): Ditto. (ccl-execute-on-string-ignore-contin): New facility. --- ChangeLog | 41 ++++++++++++++ EMU-ELS | 1 + Makefile | 1 - broken.el | 89 +++++++++++++++++++++++++++++ pccl-20.el | 182 ++++++++++++++++++++++++++++++++---------------------------- pccl-om.el | 97 +++++++++++++++++++------------- pccl.el | 9 --- 7 files changed, 287 insertions(+), 133 deletions(-) create mode 100644 broken.el diff --git a/ChangeLog b/ChangeLog index 1355a6d..7cebb59 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,44 @@ +1998-09-19 Tanaka Akira + + * broken.el: New file. + + * pccl.el (apel-broken-facility): Abolished + (apel-broken-p): Abolished + + * EMU-ELS (emu-modules): Add 'broken. + + * Makefile (elc): Do not remove emu*.elc. + + * pccl-20.el: require 'broken. + (ccl-use-symbol-as-program): Abolished. + (ccl-accept-symbol-as-program): New facility. + (make-ccl-coding-system): Use `when-broken' to define. + (ccl-encoder-eof-block-is-broken): Abolished. + (ccl-decoder-eof-block-is-broken): Abolished. + (ccl-eof-block-is-broken): Abolished + (ccl-execute-eof-block-on-encoding-null): New facility. + (ccl-execute-eof-block-on-encoding-some): Ditto. + (ccl-execute-eof-block-on-decoding-null): Ditto. + (ccl-execute-eof-block-on-decoding-some): Ditto. + (ccl-execute-eof-block-on-encoding): Ditto. + (ccl-execute-eof-block-on-decoding): Ditto. + (ccl-execute-eof-block): Ditto. + + * pccl-om.el: require 'broken. + (ccl-use-symbol-as-program): Abolished. + (ccl-accept-symbol-as-program): New facility. + (ccl-encoder-eof-block-is-broken): Abolished. + (ccl-decoder-eof-block-is-broken): Abolished. + (ccl-eof-block-is-broken): Abolished + (ccl-execute-eof-block-on-encoding-null): New facility. + (ccl-execute-eof-block-on-encoding-some): Ditto. + (ccl-execute-eof-block-on-decoding-null): Ditto. + (ccl-execute-eof-block-on-decoding-some): Ditto. + (ccl-execute-eof-block-on-encoding): Ditto. + (ccl-execute-eof-block-on-decoding): Ditto. + (ccl-execute-eof-block): Ditto. + (ccl-execute-on-string-ignore-contin): New facility. + 1998-09-18 Tanaka Akira * pccl.el (apel-broken-facility): New function. diff --git a/EMU-ELS b/EMU-ELS index 8a2f0ff..b021714 100644 --- a/EMU-ELS +++ b/EMU-ELS @@ -66,6 +66,7 @@ (setq emu-modules (append poe-modules poem-modules mcs-modules pccl-modules emu-modules)) + (setq emu-modules (cons 'broken emu-modules)) ) ;;; EMU-ELS ends here diff --git a/Makefile b/Makefile index b7294c3..db7f739 100644 --- a/Makefile +++ b/Makefile @@ -18,7 +18,6 @@ PACKAGEDIR = NONE elc: - -rm emu*.elc $(EMACS) $(FLAGS) -f compile-apel install: diff --git a/broken.el b/broken.el new file mode 100644 index 0000000..553f6bd --- /dev/null +++ b/broken.el @@ -0,0 +1,89 @@ +;;; broken.el --- Emacs broken facility infomation registry. + +;; Copyright (C) 1998 Tanaka Akira + +;; Author: Tanaka Akira +;; Keywords: emulation, compatibility, incompatibility, 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-and-compile + +(defvar notice-non-obvious-broken-facility t + "If the value is t, non-obvious broken facility is noticed when +`broken-facility' macro is expanded.") + +(defun broken-facility-internal (facility &optional docstring assertion) + "Declare that FACILITY emulation is broken if ASSERTION is nil." + (when docstring + (put facility 'broken-docstring docstring)) + (put facility 'broken (not assertion))) + +(defun broken-p (facility) + "t if FACILITY emulation is broken." + (get facility 'broken)) + +(defun broken-facility-description (facility) + "Return description for FACILITY." + (get facility 'broken-docstring)) + +) + +(put 'broken-facility 'lisp-indent-function 1) +(defmacro broken-facility (facility &optional docstring assertion no-notice) + "Declare that FACILITY emulation is broken if ASSERTION is nil. +ASSERTION is evaluated statically. + +FACILITY must be symbol. + +If ASSERTION is not ommited and evaluated to nil and NO-NOTICE is nil, it is noticed." + (let ((assertion-value (eval assertion))) + (eval `(broken-facility-internal ',facility ,docstring ',assertion-value)) + (when (and assertion (not assertion-value) (not no-notice) + notice-non-obvious-broken-facility) + (message "BROKEN FACILITY DETECTED: %s" docstring)) + `(broken-facility-internal ',facility ,docstring ',assertion-value))) + +(put 'if-broken 'lisp-indent-function 2) +(defmacro if-broken (facility then &rest else) + "If FACILITY is broken, expand to THEN, otherwise (progn . ELSE)." + (if (broken-p facility) + then + `(progn . ,else))) + +(put 'when-broken 'lisp-indent-function 1) +(defmacro when-broken (facility &rest body) + "If FACILITY is broken, expand to (progn . BODY), otherwise nil." + (when (broken-p facility) + `(progn . ,body))) + +(put 'unless-broken 'lisp-indent-function 1) +(defmacro unless-broken (facility &rest body) + "If FACILITY is not broken, expand to (progn . BODY), otherwise nil." + (unless (broken-p facility) + `(progn . ,body))) + + +;;; @ end +;;; + +(provide 'broken) + +;;; broken.el ends here diff --git a/pccl-20.el b/pccl-20.el index a18c65b..18cade1 100644 --- a/pccl-20.el +++ b/pccl-20.el @@ -28,113 +28,127 @@ (require 'poem) (eval-when-compile (require 'ccl)) - -(eval-when-compile - (defconst ccl-use-symbol-as-program - (progn - (define-ccl-program ew-ccl-identity-program - '(1 ((read r0) (loop (write-read-repeat r0))))) - (condition-case nil - (progn - (funcall - (if (fboundp 'ccl-vector-program-execute-on-string) - 'ccl-vector-program-execute-on-string - 'ccl-execute-on-string) - 'ew-ccl-identity-program - (make-vector 9 nil) - "") - t) - (error nil))) - "\ -T if CCL related builtins accept symbol as CCL program. -(20.2 with ExCCL, 20.3 or later) -Otherwise nil (20.2 without ExCCL or former). - -Because emu provides functions accepting symbol as CCL program, -user programs should not refer this variable.") - ) +(require 'broken) + +(broken-facility ccl-accept-symbol-as-program + "Emacs does not accept symbol as CCL program." + (progn + (define-ccl-program test-ccl-identity + '(1 ((read r0) (loop (write-read-repeat r0))))) + (condition-case nil + (progn + (funcall + (if (fboundp 'ccl-vector-execute-on-string) + 'ccl-vector-execute-on-string + 'ccl-execute-on-string) + 'test-ccl-identity + (make-vector 9 nil) + "") + t) + (error nil))) + t) (eval-and-compile - (defconst ccl-use-symbol-as-program - (eval-when-compile ccl-use-symbol-as-program)) (if (featurep 'xemacs) - (defun make-ccl-coding-system (name mnemonic doc-string decoder encoder) + (defun make-ccl-coding-system (name mnemonic docstring decoder encoder) + "\ +Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER. + +CODING-SYSTEM, DECODER and ENCODER must be symbol." (make-coding-system - name 'ccl doc-string + name 'ccl docstring (list 'mnemonic (char-to-string mnemonic) 'decode (symbol-value decoder) 'encode (symbol-value encoder)))) (defun make-ccl-coding-system - (coding-system mnemonic doc-string decoder encoder) + (coding-system mnemonic docstring decoder encoder) "\ -Define a new CODING-SYSTEM (symbol) by CCL programs -DECODER (symbol) and ENCODER (symbol)." - (unless ccl-use-symbol-as-program +Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER. + +CODING-SYSTEM, DECODER and ENCODER must be symbol." + (when-broken ccl-accept-symbol-as-program (setq decoder (symbol-value decoder)) (setq encoder (symbol-value encoder))) - (make-coding-system coding-system 4 mnemonic doc-string + (make-coding-system coding-system 4 mnemonic docstring (cons decoder encoder))) - )) - -(eval-when-compile - (define-ccl-program test-ccl-eof-block - '(1 - (read r0) - (write "[EOF]"))) - - (unless (coding-system-p 'test-ccl-eof-block-cs) - (make-ccl-coding-system - 'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester" - 'test-ccl-eof-block 'test-ccl-eof-block) ) - ) -(defconst ccl-encoder-eof-block-is-broken - (eval-when-compile - (not (equal (encode-coding-string "" 'test-ccl-eof-block-cs) - "[EOF]"))) - "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on -encoding.") - -(defconst ccl-decoder-eof-block-is-broken - (eval-when-compile - (not (equal (decode-coding-string "" 'test-ccl-eof-block-cs) - "[EOF]"))) - "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on -decoding.") - -(defconst ccl-eof-block-is-broken - (or ccl-encoder-eof-block-is-broken - ccl-decoder-eof-block-is-broken)) - -(unless ccl-use-symbol-as-program - - (when (subrp (symbol-function 'ccl-execute)) - (fset 'ccl-vector-program-execute - (symbol-function 'ccl-execute)) - (defun ccl-execute (ccl-prog reg) - "\ + (when-broken ccl-accept-symbol-as-program + + (when (subrp (symbol-function 'ccl-execute)) + (fset 'ccl-vector-program-execute + (symbol-function 'ccl-execute)) + (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]" - (ccl-vector-program-execute - (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) - reg))) - - (when (subrp (symbol-function 'ccl-execute-on-string)) - (fset 'ccl-vector-program-execute-on-string - (symbol-function 'ccl-execute-on-string)) - (defun ccl-execute-on-string (ccl-prog status string &optional contin) - "\ + (ccl-vector-program-execute + (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) + reg))) + + (when (subrp (symbol-function 'ccl-execute-on-string)) + (fset 'ccl-vector-program-execute-on-string + (symbol-function 'ccl-execute-on-string)) + (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]" - (ccl-vector-program-execute-on-string - (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) - status string contin))) + (ccl-vector-program-execute-on-string + (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) + status string contin))) + ) + ) + +(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 (encode-coding-string "" '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 (encode-coding-string "a" '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 (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]")) + +(broken-facility ccl-execute-eof-block-on-decoding-some + "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input." + (equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "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) + ;;; @ end ;;; diff --git a/pccl-om.el b/pccl-om.el index 609eaa9..40e2080 100644 --- a/pccl-om.el +++ b/pccl-om.el @@ -29,56 +29,25 @@ (require 'poem) (eval-when-compile (require 'ccl)) +(require 'broken) -(defconst ccl-use-symbol-as-program nil - "t if CCL related builtins accept symbol as CCL program. -(20.2 with ExCCL, 20.3 or later) -Otherwise nil (20.2 without ExCCL or former). - -Because emu provides functions accepting symbol as CCL program, -user programs should not refer this variable.") +(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 (symbol) by CCL programs -DECODER (symbol) and ENCODER (symbol)." + "\ +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. + nil ; Mule takes one more optional argument: EOL-TYPE. (cons decoder encoder))) ) -(eval-when-compile - (define-ccl-program test-ccl-eof-block - '(1 - (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) - ) - -(defconst ccl-encoder-eof-block-is-broken - (eval-when-compile - (not (equal (encode-coding-string "" 'test-ccl-eof-block-cs) - "[EOF]"))) - "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on -encoding.") - -(defconst ccl-decoder-eof-block-is-broken - (eval-when-compile - (not (equal (decode-coding-string "" 'test-ccl-eof-block-cs) - "[EOF]"))) - "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on -decoding.") - -(defconst ccl-eof-block-is-broken - (or ccl-encoder-eof-block-is-broken - ccl-decoder-eof-block-is-broken)) - (defun ccl-execute (ccl-prog reg) "Execute CCL-PROG with registers initialized by REGISTERS. If CCL-PROG is symbol, it is dereferenced. @@ -95,6 +64,56 @@ If CCL-PROG is symbol, it is dereferenced. (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 (encode-coding-string "" '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 (encode-coding-string "a" '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 (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]")) + +(broken-facility ccl-execute-eof-block-on-decoding-some + "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input." + (equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "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) + ;;; @ end ;;; diff --git a/pccl.el b/pccl.el index 9214785..eca8323 100644 --- a/pccl.el +++ b/pccl.el @@ -3,7 +3,6 @@ ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Tanaka Akira ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -25,14 +24,6 @@ ;;; Code: -(defun apel-broken-facility (facility) - "Declare that FACILITY emulation is broken." - (put facility 'poe-broken t)) - -(defun apel-broken-p (facility) - "t if FACILITY emulation is broken." - (get facility 'poe-broken)) - (if (featurep 'mule) (if (>= emacs-major-version 20) ;; for Emacs 20 and XEmacs-mule -- 1.7.10.4