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 (or (boundp 'current-load-list) (setq current-load-list nil))
  50
  51 (require 'static)
  52
  53
  54 ;;; Conditional define.
  55
  56 (put 'defun-maybe 'lisp-indent-function 'defun)
  57 (defmacro defun-maybe (name &rest everything-else)
  58   "Define NAME as a function if NAME is not defined.
  59 See also the function `defun'."
  60   (or (and (fboundp name)
  61            (not (get name 'defun-maybe)))
  62       (` (or (fboundp (quote (, name)))
  63              (prog1
  64                  (defun (, name) (,@ everything-else))
  65                ;; This `defun' will be compiled to `fset', which does
  66                ;; not update `load-history'.
  67                ;; We must update `current-load-list' explicitly.
  68                (setq current-load-list
  69                      (cons (quote (, name)) current-load-list))
  70                (put (quote (, name)) 'defun-maybe t))))))
  71
  72 (put 'defmacro-maybe 'lisp-indent-function 'defun)
  73 (defmacro defmacro-maybe (name &rest everything-else)
  74   "Define NAME as a macro if NAME is not defined.
  75 See also the function `defmacro'."
  76   (or (and (fboundp name)
  77            (not (get name 'defmacro-maybe)))
  78       (` (or (fboundp (quote (, name)))
  79              (prog1
  80                  (defmacro (, name) (,@ everything-else))
  81                (setq current-load-list
  82                      (cons (quote (, name)) current-load-list))
  83                (put (quote (, name)) 'defmacro-maybe t))))))
  84
  85 (put 'defsubst-maybe 'lisp-indent-function 'defun)
  86 (defmacro defsubst-maybe (name &rest everything-else)
  87   "Define NAME as an inline function if NAME is not defined.
  88 See also the macro `defsubst'."
  89   (or (and (fboundp name)
  90            (not (get name 'defsubst-maybe)))
  91       (` (or (fboundp (quote (, name)))
  92              (prog1
  93                  (defsubst (, name) (,@ everything-else))
  94                (setq current-load-list
  95                      (cons (quote (, name)) current-load-list))
  96                (put (quote (, name)) 'defsubst-maybe t))))))
  97
  98 (defmacro defalias-maybe (symbol definition)
  99   "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
 100 See also the function `defalias'."
 101   (setq symbol (eval symbol))
 102   (or (and (fboundp symbol)
 103            (not (get symbol 'defalias-maybe)))
 104       (` (or (fboundp (quote (, symbol)))
 105              (prog1
 106                  (defalias (quote (, symbol)) (, definition))
 107                (setq current-load-list
 108                      (cons (quote (, symbol)) current-load-list))
 109                (put (quote (, symbol)) 'defalias-maybe t))))))
 110
 111 (defmacro defvar-maybe (name &rest everything-else)
 112   "Define NAME as a variable if NAME is not defined.
 113 See also the function `defvar'."
 114   (or (and (boundp name)
 115            (not (get name 'defvar-maybe)))
 116       (` (or (boundp (quote (, name)))
 117              (prog1
 118                  (defvar (, name) (,@ everything-else))
 119                ;; byte-compiler will generate code to update
 120                ;; `load-history'.
 121                (put (quote (, name)) 'defvar-maybe t))))))
 122
 123 (defmacro defconst-maybe (name &rest everything-else)
 124   "Define NAME as a constant variable if NAME is not defined.
 125 See also the function `defconst'."
 126   (or (and (boundp name)
 127            (not (get name 'defconst-maybe)))
 128       (` (or (boundp (quote (, name)))
 129              (prog1
 130                  (defconst (, name) (,@ everything-else))
 131                (put (quote (, name)) 'defconst-maybe t))))))
 132
 133 (defmacro defun-maybe-cond (name args &optional doc &rest clauses)
 134   "Define NAME as a function if NAME is not defined.
 135 CLAUSES are like those of `cond' expression, but each condition is evaluated
 136 at compile-time and, if the value is non-nil, the body of the clause is used
 137 for function definition of NAME.
 138 See also the function `defun'."
 139   (or (stringp doc)
 140       (setq clauses (cons doc clauses)
 141             doc nil))
 142   (or (and (fboundp name)
 143            (not (get name 'defun-maybe)))
 144       (` (or (fboundp (quote (, name)))
 145              (prog1
 146                  (static-cond
 147                   (,@ (mapcar
 148                        (function
 149                         (lambda (case)
 150                           (list (car case)
 151                                 (if doc
 152                                     (` (defun (, name) (, args)
 153                                          (, doc)
 154                                          (,@ (cdr case))))
 155                                   (` (defun (, name) (, args)
 156                                        (,@ (cdr case))))))))
 157                        clauses)))
 158                (setq current-load-list
 159                      (cons (quote (, name)) current-load-list))
 160                (put (quote (, name)) 'defun-maybe t))))))
 161
 162 (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
 163   "Define NAME as a macro if NAME is not defined.
 164 CLAUSES are like those of `cond' expression, but each condition is evaluated
 165 at compile-time and, if the value is non-nil, the body of the clause is used
 166 for macro definition of NAME.
 167 See also the function `defmacro'."
 168   (or (stringp doc)
 169       (setq clauses (cons doc clauses)
 170             doc nil))
 171   (or (and (fboundp name)
 172            (not (get name 'defmacro-maybe)))
 173       (` (or (fboundp (quote (, name)))
 174              (prog1
 175                  (static-cond
 176                   (,@ (mapcar
 177                        (function
 178                         (lambda (case)
 179                           (list (car case)
 180                                 (if doc
 181                                     (` (defmacro (, name) (, args)
 182                                          (, doc)
 183                                          (,@ (cdr case))))
 184                                   (` (defmacro (, name) (, args)
 185                                        (,@ (cdr case))))))))
 186                        clauses)))
 187                (setq current-load-list
 188                      (cons (quote (, name)) current-load-list))
 189                (put (quote (, name)) 'defmacro-maybe t))))))
 190
 191 (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
 192   "Define NAME as an inline function if NAME is not defined.
 193 CLAUSES are like those of `cond' expression, but each condition is evaluated
 194 at compile-time and, if the value is non-nil, the body of the clause is used
 195 for function definition of NAME.
 196 See also the macro `defsubst'."
 197   (or (stringp doc)
 198       (setq clauses (cons doc clauses)
 199             doc nil))
 200   (or (and (fboundp name)
 201            (not (get name 'defsubst-maybe)))
 202       (` (or (fboundp (quote (, name)))
 203              (prog1
 204                  (static-cond
 205                   (,@ (mapcar
 206                        (function
 207                         (lambda (case)
 208                           (list (car case)
 209                                 (if doc
 210                                     (` (defsubst (, name) (, args)
 211                                          (, doc)
 212                                          (,@ (cdr case))))
 213                                   (` (defsubst (, name) (, args)
 214                                        (,@ (cdr case))))))))
 215                        clauses)))
 216                (setq current-load-list
 217                      (cons (quote (, name)) current-load-list))
 218                (put (quote (, name)) 'defsubst-maybe t))))))
 219
 220
 221 ;;; Edebug spec.
 222
 223 ;; `def-edebug-spec' is an autoloaded macro in v19 and later.
 224 ;; (Note that recent XEmacs provides "edebug" as a separate package.)
 225 (defmacro-maybe def-edebug-spec (symbol spec)
 226   "Set the edebug-form-spec property of SYMBOL according to SPEC.
 227 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
 228 \(naming a function\), or a list."
 229   (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
 230
 231 ;; edebug-spec for `def*-maybe' macros.
 232 (def-edebug-spec defun-maybe defun)
 233 (def-edebug-spec defmacro-maybe defmacro)
 234 (def-edebug-spec defsubst-maybe defun)
 235 (def-edebug-spec defun-maybe-cond
 236   (&define name lambda-list
 237            [&optional stringp]
 238            [&rest ([&not eval] [&rest sexp])]
 239            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 240            &rest (&rest sexp)))
 241 (def-edebug-spec defmacro-maybe-cond
 242   (&define name lambda-list
 243            [&rest ([&not eval] [&rest sexp])]
 244            [&optional (eval def-body)]
 245            &rest (&rest sexp)))
 246 (def-edebug-spec defsubst-maybe-cond
 247   (&define name lambda-list
 248            [&optional stringp]
 249            [&rest ([&not eval] [&rest sexp])]
 250            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 251            &rest (&rest sexp)))
 252
 253 ;; edebug-spec for `static-*' macros are also defined here.
 254 ;; XXX: not defined yet.  FIXME!
 255 ;; (def-edebug-spec static-if ...)
 256 ;; (def-edebug-spec static-when ...)
 257 ;; (def-edebug-spec static-unless ...)
 258 ;; (def-edebug-spec static-condition-case ...)
 259 ;; (def-edebug-spec static-defconst ...)
 260 ;; (def-edebug-spec static-cond ...)
 261
 262
 263 ;;; End.
 264
 265 (provide 'pym)
 266
 267 ;;; pym.el ends here