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., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, 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 the emulating version
  31 ;; of the Emacs builtins (both C primitives and lisp subroutines) for
  32 ;; backward compatibility.  While compilation time, if `def*-maybe'
  33 ;; find that functions/variables being defined is already provided by
  34 ;; Emacs used for compilation, it does not leave the definitions in
  35 ;; compiled code and resulting .elc files will be highly specialized
  36 ;; for your environment.  Lisp programmers should be aware that these
  37 ;; macros will never provide functions or variables at run-time if they
  38 ;; are defined for some reason (or by accident) at compilation time.
  39
  40 ;; For `find-function' lovers, the following definitions may work with
  41 ;; `def*-maybe'.
  42 ;;
  43 ;; (setq find-function-regexp
  44 ;;       "^\\s-*(def[^cgvW]\\(\\w\\|-\\)+\\*?\\s-+'?%s\\(\\s-\\|$\\)")
  45 ;; (setq find-variable-regexp
  46 ;;       "^\\s-*(def[^umaW]\\(\\w\\|-\\)+\\*?\\s-+%s\\(\\s-\\|$\\)")
  47 ;;
  48 ;; I'm too lazy to write better regexps, sorry. -- shuhei
  49
  50 ;;; Code:
  51
  52 ;; for `load-history'.
  53 (or (boundp 'current-load-list) (setq current-load-list nil))
  54
  55 (require 'static)
  56
  57
  58 ;;; Conditional define.
  59
  60 (put 'defun-maybe 'lisp-indent-function 'defun)
  61 (defmacro defun-maybe (name &rest everything-else)
  62   "Define NAME as a function if NAME is not defined.
  63 See also the function `defun'."
  64   (or (and (fboundp name)
  65            (not (get name 'defun-maybe)))
  66       (` (or (fboundp (quote (, name)))
  67              (prog1
  68                  (defun (, name) (,@ everything-else))
  69                ;; This `defun' will be compiled to `fset',
  70                ;; which does not update `load-history'.
  71                ;; We must update `current-load-list' explicitly.
  72                (setq current-load-list
  73                      (cons (quote (, name)) current-load-list))
  74                (put (quote (, name)) 'defun-maybe t))))))
  75
  76 (put 'defmacro-maybe 'lisp-indent-function 'defun)
  77 (defmacro defmacro-maybe (name &rest everything-else)
  78   "Define NAME as a macro if NAME is not defined.
  79 See also the function `defmacro'."
  80   (or (and (fboundp name)
  81            (not (get name 'defmacro-maybe)))
  82       (` (or (fboundp (quote (, name)))
  83              (prog1
  84                  (defmacro (, name) (,@ everything-else))
  85                ;; This `defmacro' will be compiled to `fset',
  86                ;; which does not update `load-history'.
  87                ;; We must update `current-load-list' explicitly.
  88                (setq current-load-list
  89                      (cons (quote (, name)) current-load-list))
  90                (put (quote (, name)) 'defmacro-maybe t))))))
  91
  92 (put 'defsubst-maybe 'lisp-indent-function 'defun)
  93 (defmacro defsubst-maybe (name &rest everything-else)
  94   "Define NAME as an inline function if NAME is not defined.
  95 See also the macro `defsubst'."
  96   (or (and (fboundp name)
  97            (not (get name 'defsubst-maybe)))
  98       (` (or (fboundp (quote (, name)))
  99              (prog1
 100                  (defsubst (, name) (,@ everything-else))
 101                ;; This `defsubst' will be compiled to `fset',
 102                ;; which does not update `load-history'.
 103                ;; We must update `current-load-list' explicitly.
 104                (setq current-load-list
 105                      (cons (quote (, name)) current-load-list))
 106                (put (quote (, name)) 'defsubst-maybe t))))))
 107
 108 (defmacro defalias-maybe (symbol definition)
 109   "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
 110 See also the function `defalias'."
 111   (setq symbol (eval symbol))
 112   (or (and (fboundp symbol)
 113            (not (get symbol 'defalias-maybe)))
 114       (` (or (fboundp (quote (, symbol)))
 115              (prog1
 116                  (defalias (quote (, symbol)) (, definition))
 117                ;; `defalias' updates `load-history' internally.
 118                (put (quote (, symbol)) 'defalias-maybe t))))))
 119
 120 (defmacro defvar-maybe (name &rest everything-else)
 121   "Define NAME as a variable if NAME is not defined.
 122 See also the function `defvar'."
 123   (or (and (boundp name)
 124            (not (get name 'defvar-maybe)))
 125       (` (or (boundp (quote (, name)))
 126              (prog1
 127                  (defvar (, name) (,@ everything-else))
 128                ;; byte-compiler will generate code to update
 129                ;; `load-history'.
 130                (put (quote (, name)) 'defvar-maybe t))))))
 131
 132 (defmacro defconst-maybe (name &rest everything-else)
 133   "Define NAME as a constant variable if NAME is not defined.
 134 See also the function `defconst'."
 135   (or (and (boundp name)
 136            (not (get name 'defconst-maybe)))
 137       (` (or (boundp (quote (, name)))
 138              (prog1
 139                  (defconst (, name) (,@ everything-else))
 140                ;; byte-compiler will generate code to update
 141                ;; `load-history'.
 142                (put (quote (, name)) 'defconst-maybe t))))))
 143
 144 (defmacro defun-maybe-cond (name args &optional doc &rest clauses)
 145   "Define NAME as a function if NAME is not defined.
 146 CLAUSES are like those of `cond' expression, but each condition is evaluated
 147 at compile-time and, if the value is non-nil, the body of the clause is used
 148 for function definition of NAME.
 149 See also the function `defun'."
 150   (or (stringp doc)
 151       (setq clauses (cons doc clauses)
 152             doc nil))
 153   (or (and (fboundp name)
 154            (not (get name 'defun-maybe)))
 155       (` (or (fboundp (quote (, name)))
 156              (prog1
 157                  (static-cond
 158                   (,@ (mapcar
 159                        (function
 160                         (lambda (case)
 161                           (list (car case)
 162                                 (if doc
 163                                     (` (defun (, name) (, args)
 164                                          (, doc)
 165                                          (,@ (cdr case))))
 166                                   (` (defun (, name) (, args)
 167                                        (,@ (cdr case))))))))
 168                        clauses)))
 169                ;; This `defun' will be compiled to `fset',
 170                ;; which does not update `load-history'.
 171                ;; We must update `current-load-list' explicitly.
 172                (setq current-load-list
 173                      (cons (quote (, name)) current-load-list))
 174                (put (quote (, name)) 'defun-maybe t))))))
 175
 176 (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
 177   "Define NAME as a macro if NAME is not defined.
 178 CLAUSES are like those of `cond' expression, but each condition is evaluated
 179 at compile-time and, if the value is non-nil, the body of the clause is used
 180 for macro definition of NAME.
 181 See also the function `defmacro'."
 182   (or (stringp doc)
 183       (setq clauses (cons doc clauses)
 184             doc nil))
 185   (or (and (fboundp name)
 186            (not (get name 'defmacro-maybe)))
 187       (` (or (fboundp (quote (, name)))
 188              (prog1
 189                  (static-cond
 190                   (,@ (mapcar
 191                        (function
 192                         (lambda (case)
 193                           (list (car case)
 194                                 (if doc
 195                                     (` (defmacro (, name) (, args)
 196                                          (, doc)
 197                                          (,@ (cdr case))))
 198                                   (` (defmacro (, name) (, args)
 199                                        (,@ (cdr case))))))))
 200                        clauses)))
 201                ;; This `defmacro' will be compiled to `fset',
 202                ;; which does not update `load-history'.
 203                ;; We must update `current-load-list' explicitly.
 204                (setq current-load-list
 205                      (cons (quote (, name)) current-load-list))
 206                (put (quote (, name)) 'defmacro-maybe t))))))
 207
 208 (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
 209   "Define NAME as an inline function if NAME is not defined.
 210 CLAUSES are like those of `cond' expression, but each condition is evaluated
 211 at compile-time and, if the value is non-nil, the body of the clause is used
 212 for function definition of NAME.
 213 See also the macro `defsubst'."
 214   (or (stringp doc)
 215       (setq clauses (cons doc clauses)
 216             doc nil))
 217   (or (and (fboundp name)
 218            (not (get name 'defsubst-maybe)))
 219       (` (or (fboundp (quote (, name)))
 220              (prog1
 221                  (static-cond
 222                   (,@ (mapcar
 223                        (function
 224                         (lambda (case)
 225                           (list (car case)
 226                                 (if doc
 227                                     (` (defsubst (, name) (, args)
 228                                          (, doc)
 229                                          (,@ (cdr case))))
 230                                   (` (defsubst (, name) (, args)
 231                                        (,@ (cdr case))))))))
 232                        clauses)))
 233                ;; This `defsubst' will be compiled to `fset',
 234                ;; which does not update `load-history'.
 235                ;; We must update `current-load-list' explicitly.
 236                (setq current-load-list
 237                      (cons (quote (, name)) current-load-list))
 238                (put (quote (, name)) 'defsubst-maybe t))))))
 239
 240
 241 ;;; Edebug spec.
 242
 243 ;; `def-edebug-spec' is an autoloaded macro in v19 and later.
 244 ;; (Note that recent XEmacs provides "edebug" as a separate package.)
 245 (defmacro-maybe def-edebug-spec (symbol spec)
 246   "Set the edebug-form-spec property of SYMBOL according to SPEC.
 247 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
 248 \(naming a function\), or a list."
 249   (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
 250
 251 ;; edebug-spec for `def*-maybe' macros.
 252 (def-edebug-spec defun-maybe defun)
 253 (def-edebug-spec defmacro-maybe defmacro)
 254 (def-edebug-spec defsubst-maybe defun)
 255 (def-edebug-spec defun-maybe-cond
 256   (&define name lambda-list
 257            [&optional stringp]
 258            [&rest ([&not eval] [&rest sexp])]
 259            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 260            &rest (&rest sexp)))
 261 (def-edebug-spec defmacro-maybe-cond
 262   (&define name lambda-list
 263            [&rest ([&not eval] [&rest sexp])]
 264            [&optional (eval def-body)]
 265            &rest (&rest sexp)))
 266 (def-edebug-spec defsubst-maybe-cond
 267   (&define name lambda-list
 268            [&optional stringp]
 269            [&rest ([&not eval] [&rest sexp])]
 270            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 271            &rest (&rest sexp)))
 272
 273 ;; edebug-spec for `static-*' macros are also defined here.
 274 (def-edebug-spec static-if t)
 275 (def-edebug-spec static-when when)
 276 (def-edebug-spec static-unless unless)
 277 (def-edebug-spec static-condition-case condition-case)
 278 (def-edebug-spec static-defconst defconst)
 279 (def-edebug-spec static-cond cond)
 280
 281
 282 ;;; for backward compatibility.
 283
 284 (defun subr-fboundp (symbol)
 285   "Return t if SYMBOL's function definition is a built-in function."
 286   (and (fboundp symbol)
 287        (subrp (symbol-function symbol))))
 288 ;; (make-obsolete 'subr-fboundp "don't use it.")
 289
 290
 291 ;;; End.
 292
 293 (require 'product)
 294 (product-provide (provide 'pym) (require 'apel-ver))
 295
 296 ;;; pym.el ends here