broken.el

   1 ;;; broken.el --- Emacs broken facility information registry.
   2
   3 ;; Copyright (C) 1998, 1999 Tanaka Akira <akr@jaist.ac.jp>
   4
   5 ;; Author: Tanaka Akira <akr@jaist.ac.jp>
   6 ;; Keywords: emulation, compatibility, incompatibility, 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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Code:
  26
  27 (require 'static)
  28 (require 'poe)
  29
  30 (eval-and-compile
  31
  32   (defvar notice-non-obvious-broken-facility t
  33     "If the value is t, non-obvious broken facility is noticed when
  34 `broken-facility' macro is expanded.")
  35
  36   (defun broken-facility-internal (facility &optional docstring assertion)
  37     "Declare that FACILITY emulation is broken if ASSERTION is nil."
  38     (when docstring
  39       (put facility 'broken-docstring docstring))
  40     (put facility 'broken (not assertion)))
  41
  42   (defun broken-p (facility)
  43     "t if FACILITY emulation is broken."
  44     (get facility 'broken))
  45
  46   (defun broken-facility-description (facility)
  47     "Return description for FACILITY."
  48     (get facility 'broken-docstring))
  49
  50   )
  51
  52 (put 'broken-facility 'lisp-indent-function 1)
  53 (defmacro broken-facility (facility &optional docstring assertion no-notice)
  54   "Declare that FACILITY emulation is broken if ASSERTION is nil.
  55 ASSERTION is evaluated statically.
  56
  57 FACILITY must be symbol.
  58
  59 If ASSERTION is not omitted and evaluated to nil and NO-NOTICE is nil,
  60 it is noticed."
  61   (` (static-if (, assertion)
  62          (eval-and-compile
  63            (broken-facility-internal '(, facility) (, docstring) t))
  64        (eval-when-compile
  65          (when (and '(, assertion) (not '(, no-notice))
  66                     notice-non-obvious-broken-facility)
  67            (message "BROKEN FACILITY DETECTED: %s" (, docstring)))
  68          nil)
  69        (eval-and-compile
  70          (broken-facility-internal '(, facility) (, docstring) nil)))))
  71
  72 (put 'if-broken 'lisp-indent-function 2)
  73 (defmacro if-broken (facility then &rest else)
  74   "If FACILITY is broken, expand to THEN, otherwise (progn . ELSE)."
  75   (` (static-if (broken-p '(, facility))
  76          (, then)
  77        (,@ else))))
  78
  79
  80 (put 'when-broken 'lisp-indent-function 1)
  81 (defmacro when-broken (facility &rest body)
  82   "If FACILITY is broken, expand to (progn . BODY), otherwise nil."
  83   (` (static-when (broken-p '(, facility))
  84        (,@ body))))
  85
  86 (put 'unless-broken 'lisp-indent-function 1)
  87 (defmacro unless-broken (facility &rest body)
  88   "If FACILITY is not broken, expand to (progn . BODY), otherwise nil."
  89   (` (static-unless (broken-p '(, facility))
  90        (,@ body))))
  91
  92 (defmacro check-broken-facility (facility)
  93   "Check FACILITY is broken or not. If the status is different on
  94 compile(macro expansion) time and run time, warn it."
  95   (` (if-broken (, facility)
  96          (unless (broken-p '(, facility))
  97            (message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s"
  98                     (or
  99                      '(, (broken-facility-description facility))
 100                      (broken-facility-description '(, facility)))))
 101        (when (broken-p '(, facility))
 102          (message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s"
 103                   (or
 104                    (broken-facility-description '(, facility))
 105                    '(, (broken-facility-description facility))))))))
 106
 107
 108 ;;; @ end
 109 ;;;
 110
 111 (require 'product)
 112 (product-provide (provide 'broken) (require 'apel-ver))
 113
 114 ;;; broken.el ends here