From: tomo Date: Fri, 22 Dec 2000 12:00:40 +0000 (+0000) Subject: Move poe/broken.el and poe/static.el to emacs-lisp/. X-Git-Tag: semi21-1_14_2-emh-1_14_1~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=47c1e121f5b613c3d33a47a2a73c617933ecfd1e;p=elisp%2Flemi.git Move poe/broken.el and poe/static.el to emacs-lisp/. --- diff --git a/emacs-lisp/broken.el b/emacs-lisp/broken.el new file mode 100644 index 0000000..d30d97c --- /dev/null +++ b/emacs-lisp/broken.el @@ -0,0 +1,113 @@ +;;; broken.el --- Emacs broken facility infomation registry. + +;; Copyright (C) 1998, 1999 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: + +(require 'static) + +(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." + (` (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)." + (` (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." + (` (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." + (` (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" + (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)))))))) + + +;;; @ end +;;; + +(require 'product) +(product-provide (provide 'broken) (require 'apel-ver)) + +;;; broken.el ends here diff --git a/emacs-lisp/static.el b/emacs-lisp/static.el new file mode 100644 index 0000000..b64440d --- /dev/null +++ b/emacs-lisp/static.el @@ -0,0 +1,89 @@ +;;; static.el --- tools for static evaluation. + +;; Copyright (C) 1999 Tanaka Akira + +;; Author: Tanaka Akira +;; Keywords: byte compile, evaluation + +;; 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: + +(put 'static-if 'lisp-indent-function 2) +(defmacro static-if (cond then &rest else) + "`if' expression but COND is evaluated at compile-time." + (if (eval cond) + then + (` (progn (,@ else))))) + +(put 'static-when 'lisp-indent-function 1) +(defmacro static-when (cond &rest body) + "`when' expression but COND is evaluated at compile-time." + (if (eval cond) + (` (progn (,@ body))))) + +(put 'static-unless 'lisp-indent-function 1) +(defmacro static-unless (cond &rest body) + "`unless' expression but COND is evaluated at compile-time." + (if (eval cond) + nil + (` (progn (,@ body))))) + +(put 'static-condition-case 'lisp-indent-function 2) +(defmacro static-condition-case (var bodyform &rest handlers) + "`condition-case' expression but BODYFORM is evaluated at compile-time." + (eval (` (condition-case (, var) + (list (quote quote) (, bodyform)) + (,@ (mapcar + (if var + (function + (lambda (h) + (` ((, (car h)) + (list (quote funcall) + (function (lambda ((, var)) (,@ (cdr h)))) + (list (quote quote) (, var))))))) + (function + (lambda (h) + (` ((, (car h)) (quote (progn (,@ (cdr h))))))))) + handlers)))))) + +(put 'static-defconst 'lisp-indent-function 'defun) +(defmacro static-defconst (symbol initvalue &optional docstring) + "`defconst' expression but INITVALUE is evaluated at compile-time. + +The variable SYMBOL can be referenced at either compile-time or run-time." + (let ((value (eval initvalue))) + (eval (` (defconst (, symbol) (quote (, value)) (, docstring)))) + (` (defconst (, symbol) (quote (, value)) (, docstring))))) + +(defmacro static-cond (&rest clauses) + "`cond' expression but the car of each clause is evaluated at compile-time." + (while (and clauses + (not (eval (car (car clauses))))) + (setq clauses (cdr clauses))) + (if clauses + (cons 'progn (cdr (car clauses))))) + + +;;; @ end +;;; + +(require 'product) +(product-provide (provide 'static) (require 'apel-ver)) + +;;; static.el ends here diff --git a/poe/broken.el b/poe/broken.el deleted file mode 100644 index d30d97c..0000000 --- a/poe/broken.el +++ /dev/null @@ -1,113 +0,0 @@ -;;; broken.el --- Emacs broken facility infomation registry. - -;; Copyright (C) 1998, 1999 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: - -(require 'static) - -(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." - (` (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)." - (` (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." - (` (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." - (` (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" - (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)))))))) - - -;;; @ end -;;; - -(require 'product) -(product-provide (provide 'broken) (require 'apel-ver)) - -;;; broken.el ends here diff --git a/poe/static.el b/poe/static.el deleted file mode 100644 index b64440d..0000000 --- a/poe/static.el +++ /dev/null @@ -1,89 +0,0 @@ -;;; static.el --- tools for static evaluation. - -;; Copyright (C) 1999 Tanaka Akira - -;; Author: Tanaka Akira -;; Keywords: byte compile, evaluation - -;; 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: - -(put 'static-if 'lisp-indent-function 2) -(defmacro static-if (cond then &rest else) - "`if' expression but COND is evaluated at compile-time." - (if (eval cond) - then - (` (progn (,@ else))))) - -(put 'static-when 'lisp-indent-function 1) -(defmacro static-when (cond &rest body) - "`when' expression but COND is evaluated at compile-time." - (if (eval cond) - (` (progn (,@ body))))) - -(put 'static-unless 'lisp-indent-function 1) -(defmacro static-unless (cond &rest body) - "`unless' expression but COND is evaluated at compile-time." - (if (eval cond) - nil - (` (progn (,@ body))))) - -(put 'static-condition-case 'lisp-indent-function 2) -(defmacro static-condition-case (var bodyform &rest handlers) - "`condition-case' expression but BODYFORM is evaluated at compile-time." - (eval (` (condition-case (, var) - (list (quote quote) (, bodyform)) - (,@ (mapcar - (if var - (function - (lambda (h) - (` ((, (car h)) - (list (quote funcall) - (function (lambda ((, var)) (,@ (cdr h)))) - (list (quote quote) (, var))))))) - (function - (lambda (h) - (` ((, (car h)) (quote (progn (,@ (cdr h))))))))) - handlers)))))) - -(put 'static-defconst 'lisp-indent-function 'defun) -(defmacro static-defconst (symbol initvalue &optional docstring) - "`defconst' expression but INITVALUE is evaluated at compile-time. - -The variable SYMBOL can be referenced at either compile-time or run-time." - (let ((value (eval initvalue))) - (eval (` (defconst (, symbol) (quote (, value)) (, docstring)))) - (` (defconst (, symbol) (quote (, value)) (, docstring))))) - -(defmacro static-cond (&rest clauses) - "`cond' expression but the car of each clause is evaluated at compile-time." - (while (and clauses - (not (eval (car (car clauses))))) - (setq clauses (cdr clauses))) - (if clauses - (cons 'progn (cdr (car clauses))))) - - -;;; @ end -;;; - -(require 'product) -(product-provide (provide 'static) (require 'apel-ver)) - -;;; static.el ends here