1 ;;; pym.el --- Macros for Your Poe.
3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
6 ;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
7 ;; Keywords: byte-compile, evaluation, edebug, internal
9 ;; This file is part of APEL (A Portable Emacs Library).
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.
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.
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.
28 ;; This module provides `def*-maybe' macros for conditional definition.
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.
37 ;; For `find-function' lovers, the following definitions may work with
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-\\|$\\)")
45 ;; I'm too lazy to write better regexps, sorry. -- shuhei
49 (or (boundp 'current-load-list) (setq current-load-list nil))
51 ;; we cannot use `eval-when-compile' here because v18 does not have it.
55 ;;; Conditional define.
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)))
65 (defun (, name) (,@ everything-else))
66 ;; This `defun' will be compiled to `fset', which does
67 ;; 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))))))
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)))
81 (defmacro (, name) (,@ everything-else))
82 (setq current-load-list
83 (cons (quote (, name)) current-load-list))
84 (put (quote (, name)) 'defmacro-maybe t))))))
86 (put 'defsubst-maybe 'lisp-indent-function 'defun)
87 (defmacro defsubst-maybe (name &rest everything-else)
88 "Define NAME as an inline function if NAME is not defined.
89 See also the macro `defsubst'."
90 (or (and (fboundp name)
91 (not (get name 'defsubst-maybe)))
92 (` (or (fboundp (quote (, name)))
94 (defsubst (, name) (,@ everything-else))
95 (setq current-load-list
96 (cons (quote (, name)) current-load-list))
97 (put (quote (, name)) 'defsubst-maybe t))))))
99 (defmacro defalias-maybe (symbol definition)
100 "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
101 See also the function `defalias'."
102 (setq symbol (eval symbol))
103 (or (and (fboundp symbol)
104 (not (get symbol 'defalias-maybe)))
105 (` (or (fboundp (quote (, symbol)))
107 (defalias (quote (, symbol)) (, definition))
108 (setq current-load-list
109 (cons (quote (, symbol)) current-load-list))
110 (put (quote (, symbol)) 'defalias-maybe t))))))
112 (defmacro defvar-maybe (name &rest everything-else)
113 "Define NAME as a variable if NAME is not defined.
114 See also the function `defvar'."
115 (or (and (boundp name)
116 (not (get name 'defvar-maybe)))
117 (` (or (boundp (quote (, name)))
119 (defvar (, name) (,@ everything-else))
120 ;; byte-compiler will generate code to update
122 (put (quote (, name)) 'defvar-maybe t))))))
124 (defmacro defconst-maybe (name &rest everything-else)
125 "Define NAME as a constant variable if NAME is not defined.
126 See also the function `defconst'."
127 (or (and (boundp name)
128 (not (get name 'defconst-maybe)))
129 (` (or (boundp (quote (, name)))
131 (defconst (, name) (,@ everything-else))
132 (put (quote (, name)) 'defconst-maybe t))))))
134 (defmacro defun-maybe-cond (name args &optional doc &rest clauses)
135 "Define NAME as a function if NAME is not defined.
136 CLAUSES are like those of `cond' expression, but each condition is evaluated
137 at compile-time and, if the value is non-nil, the body of the clause is used
138 for function definition of NAME.
139 See also the function `defun'."
141 (setq clauses (cons doc clauses)
143 (or (and (fboundp name)
144 (not (get name 'defun-maybe)))
145 (` (or (fboundp (quote (, name)))
153 (` (defun (, name) (, args)
156 (` (defun (, name) (, args)
157 (,@ (cdr case))))))))
159 (setq current-load-list
160 (cons (quote (, name)) current-load-list))
161 (put (quote (, name)) 'defun-maybe t))))))
163 (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
164 "Define NAME as a macro if NAME is not defined.
165 CLAUSES are like those of `cond' expression, but each condition is evaluated
166 at compile-time and, if the value is non-nil, the body of the clause is used
167 for macro definition of NAME.
168 See also the function `defmacro'."
170 (setq clauses (cons doc clauses)
172 (or (and (fboundp name)
173 (not (get name 'defmacro-maybe)))
174 (` (or (fboundp (quote (, name)))
182 (` (defmacro (, name) (, args)
185 (` (defmacro (, name) (, args)
186 (,@ (cdr case))))))))
188 (setq current-load-list
189 (cons (quote (, name)) current-load-list))
190 (put (quote (, name)) 'defmacro-maybe t))))))
192 (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
193 "Define NAME as an inline function if NAME is not defined.
194 CLAUSES are like those of `cond' expression, but each condition is evaluated
195 at compile-time and, if the value is non-nil, the body of the clause is used
196 for function definition of NAME.
197 See also the macro `defsubst'."
199 (setq clauses (cons doc clauses)
201 (or (and (fboundp name)
202 (not (get name 'defsubst-maybe)))
203 (` (or (fboundp (quote (, name)))
211 (` (defsubst (, name) (, args)
214 (` (defsubst (, name) (, args)
215 (,@ (cdr case))))))))
217 (setq current-load-list
218 (cons (quote (, name)) current-load-list))
219 (put (quote (, name)) 'defsubst-maybe t))))))
224 ;; `def-edebug-spec' is an autoloaded macro in v19 and later.
225 ;; (Note that recent XEmacs provides "edebug" as a separate package.)
226 (defmacro-maybe def-edebug-spec (symbol spec)
227 "Set the edebug-form-spec property of SYMBOL according to SPEC.
228 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
229 \(naming a function\), or a list."
230 (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
232 ;; edebug-spec for `def*-maybe' macros.
233 (def-edebug-spec defun-maybe defun)
234 (def-edebug-spec defmacro-maybe defmacro)
235 (def-edebug-spec defsubst-maybe defun)
236 (def-edebug-spec defun-maybe-cond
237 (&define name lambda-list
239 [&rest ([¬ eval] [&rest sexp])]
240 [&optional (eval [&optional ("interactive" interactive)] def-body)]
242 (def-edebug-spec defmacro-maybe-cond
243 (&define name lambda-list
244 [&rest ([¬ eval] [&rest sexp])]
245 [&optional (eval def-body)]
247 (def-edebug-spec defsubst-maybe-cond
248 (&define name lambda-list
250 [&rest ([¬ eval] [&rest sexp])]
251 [&optional (eval [&optional ("interactive" interactive)] def-body)]
254 ;; edebug-spec for `static-*' macros are also defined here.
255 ;; XXX: not defined yet. FIXME!
256 ;; (def-edebug-spec static-if ...)
257 ;; (def-edebug-spec static-when ...)
258 ;; (def-edebug-spec static-unless ...)
259 ;; (def-edebug-spec static-condition-case ...)
260 ;; (def-edebug-spec static-defconst ...)
261 ;; (def-edebug-spec static-cond ...)