broken.el

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