pym.el

   1 ;;; pym.el --- Macros for Your Poe.
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;;      Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
   7 ;; Keywords: byte-compile, evaluation, edebug, internal
   8
   9 ;; This file is part of APEL (A Portable Emacs Library).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This module provides `def*-maybe' macros for conditional definition.
  29 ;;
  30 ;; Many APEL modules use these macros to provide emulation version of
  31 ;; Emacs builtins (both C primitives and lisp subroutines) for backward
  32 ;; compatibility.  While compilation time, if `def*-maybe' find that
  33 ;; functions/variables being defined is already provided by Emacs used
  34 ;; for compilation, it does not leave the definitions in compiled code
  35 ;; and resulting .elc will be highly specialized for your environment.
  36
  37 ;; For `find-function' lovers, the following definitions may work with
  38 ;; `def*-maybe'.
  39 ;;
  40 ;; (setq find-function-regexp
  41 ;;       "^\\s-*(def[^cgvW]\\(\\w\\|-\\)+\\*?\\s-+'?%s\\(\\s-\\|$\\)")
  42 ;; (setq find-variable-regexp
  43 ;;       "^\\s-*(def[^umaW]\\(\\w\\|-\\)+\\*?\\s-+%s\\(\\s-\\|$\\)")
  44 ;;
  45 ;; I'm too lazy to write better regexps, sorry. -- shuhei
  46
  47 ;;; Code:
  48
  49 ;; for `load-history'.
  50 (or (boundp 'current-load-list) (setq current-load-list nil))
  51
  52 (require 'static)
  53
  54
  55 ;;; Conditional define.
  56
  57 (put 'defun-maybe 'lisp-indent-function 'defun)
  58 (defmacro defun-maybe (name &rest everything-else)
  59   "Define NAME as a function if NAME is not defined.
  60 See also the function `defun'."
  61   (or (and (fboundp name)
  62            (not (get name 'defun-maybe)))
  63       (` (or (fboundp (quote (, name)))
  64              (prog1
  65                  (defun (, name) (,@ everything-else))
  66                ;; This `defun' will be compiled to `fset',
  67                ;; which does not update `load-history'.
  68                ;; We must update `current-load-list' explicitly.
  69                (setq current-load-list
  70                      (cons (quote (, name)) current-load-list))
  71                (put (quote (, name)) 'defun-maybe t))))))
  72
  73 (put 'defmacro-maybe 'lisp-indent-function 'defun)
  74 (defmacro defmacro-maybe (name &rest everything-else)
  75   "Define NAME as a macro if NAME is not defined.
  76 See also the function `defmacro'."
  77   (or (and (fboundp name)
  78            (not (get name 'defmacro-maybe)))
  79       (` (or (fboundp (quote (, name)))
  80              (prog1
  81                  (defmacro (, name) (,@ everything-else))
  82                ;; This `defmacro' will be compiled to `fset',
  83                ;; which does not update `load-history'.
  84                ;; We must update `current-load-list' explicitly.
  85                (setq current-load-list
  86                      (cons (quote (, name)) current-load-list))
  87                (put (quote (, name)) 'defmacro-maybe t))))))
  88
  89 (put 'defsubst-maybe 'lisp-indent-function 'defun)
  90 (defmacro defsubst-maybe (name &rest everything-else)
  91   "Define NAME as an inline function if NAME is not defined.
  92 See also the macro `defsubst'."
  93   (or (and (fboundp name)
  94            (not (get name 'defsubst-maybe)))
  95       (` (or (fboundp (quote (, name)))
  96              (prog1
  97                  (defsubst (, name) (,@ everything-else))
  98                ;; This `defsubst' will be compiled to `fset',
  99                ;; which does not update `load-history'.
 100                ;; We must update `current-load-list' explicitly.
 101                (setq current-load-list
 102                      (cons (quote (, name)) current-load-list))
 103                (put (quote (, name)) 'defsubst-maybe t))))))
 104
 105 (defmacro defalias-maybe (symbol definition)
 106   "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
 107 See also the function `defalias'."
 108   (setq symbol (eval symbol))
 109   (or (and (fboundp symbol)
 110            (not (get symbol 'defalias-maybe)))
 111       (` (or (fboundp (quote (, symbol)))
 112              (prog1
 113                  (defalias (quote (, symbol)) (, definition))
 114                ;; `defalias' updates `load-history' internally.
 115                (put (quote (, symbol)) 'defalias-maybe t))))))
 116
 117 (defmacro defvar-maybe (name &rest everything-else)
 118   "Define NAME as a variable if NAME is not defined.
 119 See also the function `defvar'."
 120   (or (and (boundp name)
 121            (not (get name 'defvar-maybe)))
 122       (` (or (boundp (quote (, name)))
 123              (prog1
 124                  (defvar (, name) (,@ everything-else))
 125                ;; byte-compiler will generate code to update
 126                ;; `load-history'.
 127                (put (quote (, name)) 'defvar-maybe t))))))
 128
 129 (defmacro defconst-maybe (name &rest everything-else)
 130   "Define NAME as a constant variable if NAME is not defined.
 131 See also the function `defconst'."
 132   (or (and (boundp name)
 133            (not (get name 'defconst-maybe)))
 134       (` (or (boundp (quote (, name)))
 135              (prog1
 136                  (defconst (, name) (,@ everything-else))
 137                ;; byte-compiler will generate code to update
 138                ;; `load-history'.
 139                (put (quote (, name)) 'defconst-maybe t))))))
 140
 141 (defmacro defun-maybe-cond (name args &optional doc &rest clauses)
 142   "Define NAME as a function if NAME is not defined.
 143 CLAUSES are like those of `cond' expression, but each condition is evaluated
 144 at compile-time and, if the value is non-nil, the body of the clause is used
 145 for function definition of NAME.
 146 See also the function `defun'."
 147   (or (stringp doc)
 148       (setq clauses (cons doc clauses)
 149             doc nil))
 150   (or (and (fboundp name)
 151            (not (get name 'defun-maybe)))
 152       (` (or (fboundp (quote (, name)))
 153              (prog1
 154                  (static-cond
 155                   (,@ (mapcar
 156                        (function
 157                         (lambda (case)
 158                           (list (car case)
 159                                 (if doc
 160                                     (` (defun (, name) (, args)
 161                                          (, doc)
 162                                          (,@ (cdr case))))
 163                                   (` (defun (, name) (, args)
 164                                        (,@ (cdr case))))))))
 165                        clauses)))
 166                ;; This `defun' will be compiled to `fset',
 167                ;; which does not update `load-history'.
 168                ;; We must update `current-load-list' explicitly.
 169                (setq current-load-list
 170                      (cons (quote (, name)) current-load-list))
 171                (put (quote (, name)) 'defun-maybe t))))))
 172
 173 (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
 174   "Define NAME as a macro if NAME is not defined.
 175 CLAUSES are like those of `cond' expression, but each condition is evaluated
 176 at compile-time and, if the value is non-nil, the body of the clause is used
 177 for macro definition of NAME.
 178 See also the function `defmacro'."
 179   (or (stringp doc)
 180       (setq clauses (cons doc clauses)
 181             doc nil))
 182   (or (and (fboundp name)
 183            (not (get name 'defmacro-maybe)))
 184       (` (or (fboundp (quote (, name)))
 185              (prog1
 186                  (static-cond
 187                   (,@ (mapcar
 188                        (function
 189                         (lambda (case)
 190                           (list (car case)
 191                                 (if doc
 192                                     (` (defmacro (, name) (, args)
 193                                          (, doc)
 194                                          (,@ (cdr case))))
 195                                   (` (defmacro (, name) (, args)
 196                                        (,@ (cdr case))))))))
 197                        clauses)))
 198                ;; This `defmacro' will be compiled to `fset',
 199                ;; which does not update `load-history'.
 200                ;; We must update `current-load-list' explicitly.
 201                (setq current-load-list
 202                      (cons (quote (, name)) current-load-list))
 203                (put (quote (, name)) 'defmacro-maybe t))))))
 204
 205 (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
 206   "Define NAME as an inline function if NAME is not defined.
 207 CLAUSES are like those of `cond' expression, but each condition is evaluated
 208 at compile-time and, if the value is non-nil, the body of the clause is used
 209 for function definition of NAME.
 210 See also the macro `defsubst'."
 211   (or (stringp doc)
 212       (setq clauses (cons doc clauses)
 213             doc nil))
 214   (or (and (fboundp name)
 215            (not (get name 'defsubst-maybe)))
 216       (` (or (fboundp (quote (, name)))
 217              (prog1
 218                  (static-cond
 219                   (,@ (mapcar
 220                        (function
 221                         (lambda (case)
 222                           (list (car case)
 223                                 (if doc
 224                                     (` (defsubst (, name) (, args)
 225                                          (, doc)
 226                                          (,@ (cdr case))))
 227                                   (` (defsubst (, name) (, args)
 228                                        (,@ (cdr case))))))))
 229                        clauses)))
 230                ;; This `defsubst' will be compiled to `fset',
 231                ;; which does not update `load-history'.
 232                ;; We must update `current-load-list' explicitly.
 233                (setq current-load-list
 234                      (cons (quote (, name)) current-load-list))
 235                (put (quote (, name)) 'defsubst-maybe t))))))
 236
 237
 238 ;;; Edebug spec.
 239
 240 ;; `def-edebug-spec' is an autoloaded macro in v19 and later.
 241 ;; (Note that recent XEmacs provides "edebug" as a separate package.)
 242 (defmacro-maybe def-edebug-spec (symbol spec)
 243   "Set the edebug-form-spec property of SYMBOL according to SPEC.
 244 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
 245 \(naming a function\), or a list."
 246   (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
 247
 248 ;; edebug-spec for `def*-maybe' macros.
 249 (def-edebug-spec defun-maybe defun)
 250 (def-edebug-spec defmacro-maybe defmacro)
 251 (def-edebug-spec defsubst-maybe defun)
 252 (def-edebug-spec defun-maybe-cond
 253   (&define name lambda-list
 254            [&optional stringp]
 255            [&rest ([&not eval] [&rest sexp])]
 256            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 257            &rest (&rest sexp)))
 258 (def-edebug-spec defmacro-maybe-cond
 259   (&define name lambda-list
 260            [&rest ([&not eval] [&rest sexp])]
 261            [&optional (eval def-body)]
 262            &rest (&rest sexp)))
 263 (def-edebug-spec defsubst-maybe-cond
 264   (&define name lambda-list
 265            [&optional stringp]
 266            [&rest ([&not eval] [&rest sexp])]
 267            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 268            &rest (&rest sexp)))
 269
 270 ;; edebug-spec for `static-*' macros are also defined here.
 271 ;; XXX: not defined yet.  FIXME!
 272 ;; (def-edebug-spec static-if ...)
 273 ;; (def-edebug-spec static-when ...)
 274 ;; (def-edebug-spec static-unless ...)
 275 ;; (def-edebug-spec static-condition-case ...)
 276 ;; (def-edebug-spec static-defconst ...)
 277 ;; (def-edebug-spec static-cond ...)
 278
 279
 280 ;;; for backward compatibility.
 281
 282 (defun subr-fboundp (symbol)
 283   "Return t if SYMBOL's function definition is a built-in function."
 284   (and (fboundp symbol)
 285        (subrp (symbol-function symbol))))
 286 ;; (make-obsolete 'subr-fboundp "don't use it.")
 287
 288
 289 ;;; End.
 290
 291 (require 'product)
 292 (product-provide (provide 'pym) (require 'apel-ver))
 293
 294 ;;; pym.el ends here