+1998-09-19 Tanaka Akira <akr@jaist.ac.jp>
+
+ * 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 <akr@jaist.ac.jp>
* pccl.el (apel-broken-facility): New function.
(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
elc:
- -rm emu*.elc
$(EMACS) $(FLAGS) -f compile-apel
install:
--- /dev/null
+;;; broken.el --- Emacs broken facility infomation registry.
+
+;; Copyright (C) 1998 Tanaka Akira <akr@jaist.ac.jp>
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; 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
(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
;;;
(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.
(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
;;;
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Tanaka Akira <akr@jaist.ac.jp>
;; Keywords: emulation, compatibility, Mule
;; This file is part of APEL (A Portable Emacs Library).
;;; 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
projects / elisp / apel.git / commitdiff