;;; broken.el --- Emacs broken facility infomation registry.
-;; Copyright (C) 1998 Tanaka Akira <akr@jaist.ac.jp>
+;; Copyright (C) 1998, 1999 Tanaka Akira <akr@jaist.ac.jp>
;; Author: Tanaka Akira <akr@jaist.ac.jp>
;; Keywords: emulation, compatibility, incompatibility, Mule
;;; Code:
+(require 'static)
+(require 'poe)
+
(eval-and-compile
-(defvar notice-non-obvious-broken-facility t
- "If the value is t, non-obvious broken facility is noticed when
+ (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-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-p (facility)
+ "t if FACILITY emulation is broken."
+ (get facility 'broken))
-(defun broken-facility-description (facility)
- "Return description for FACILITY."
- (get facility 'broken-docstring))
+ (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)
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)))
+If ASSERTION is not ommited and evaluated to nil and NO-NOTICE is nil,
+it is noticed."
+ (` (static-if (, assertion)
+ (eval-and-compile
+ (broken-facility-internal '(, facility) (, docstring) t))
+ (eval-when-compile
+ (when (and '(, assertion) (not '(, no-notice))
+ notice-non-obvious-broken-facility)
+ (message "BROKEN FACILITY DETECTED: %s" (, docstring)))
+ nil)
+ (eval-and-compile
+ (broken-facility-internal '(, facility) (, docstring) nil)))))
(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)))
+ (` (static-if (broken-p '(, facility))
+ (, then)
+ (,@ 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)))
+ (` (static-when (broken-p '(, facility))
+ (,@ 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)))
+ (` (static-unless (broken-p '(, facility))
+ (,@ body))))
(defmacro check-broken-facility (facility)
"Check FACILITY is broken or not. If the status is different on
compile(macro expansion) time and run time, warn it."
- `(if-broken ,facility
- (unless (broken-p ',facility)
- (message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s"
+ (` (if-broken (, facility)
+ (unless (broken-p '(, facility))
+ (message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s"
+ (or
+ '(, (broken-facility-description facility))
+ (broken-facility-description '(, facility)))))
+ (when (broken-p '(, facility))
+ (message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s"
(or
- ',(broken-facility-description facility)
- (broken-facility-description ',facility))))
- (when (broken-p ',facility)
- (message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s"
- (or
- (broken-facility-description ',facility)
- ',(broken-facility-description facility))))))
+ (broken-facility-description '(, facility))
+ '(, (broken-facility-description facility))))))))
;;; @ end