1 ;;; pym.el --- Macros for Your Poe
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
4 ;; Free Software Foundation, Inc.
6 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
7 ;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
8 ;; Katsumi Yamaoka <yamaoka@jpl.org>
9 ;; Keywords: byte-compile, evaluation, edebug, internal
11 ;; This file is part of APEL (A Portable Emacs Library).
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
30 ;; This module provides `def*-maybe' macros for conditional definition.
32 ;; Many APEL modules use these macros to provide the emulating version
33 ;; of the Emacs builtins (both C primitives and lisp subroutines) for
34 ;; backward compatibility. While compilation time, if `def*-maybe'
35 ;; find that functions/variables being defined is already provided by
36 ;; Emacs used for compilation, it does not leave the definitions in
37 ;; compiled code and resulting .elc files will be highly specialized
38 ;; for your environment. Lisp programmers should be aware that these
39 ;; macros will never provide functions or variables at run-time if they
40 ;; are defined for some reason (or by accident) at compilation time.
42 ;; For `find-function' lovers, the following definitions may work with
45 ;; (setq find-function-regexp
46 ;; "^\\s-*(def[^cgvW]\\(\\w\\|-\\)+\\*?\\s-+'?%s\\(\\s-\\|$\\)")
47 ;; (setq find-variable-regexp
48 ;; "^\\s-*(def[^umaW]\\(\\w\\|-\\)+\\*?\\s-+%s\\(\\s-\\|$\\)")
50 ;; I'm too lazy to write better regexps, sorry. -- shuhei
57 ;;; Conditional define.
59 ; Hack for "old" byte-compiler; we can't use `eval-and-compile' here.
62 ;;(or (car features) (provide 'feature-for-dummy))
64 (defvar def*-maybe-enable-compile-time-hack nil
65 "If non-nil, `def*-maybe' macros will do compile-time check.
66 `def*-maybe' macro normally checks existence of its target function or
67 variable at load-time. But if this variable is non-nil at compile-time,
68 existence of its target is first checked at compile-time, and if exists,
69 it will emit no compiled code at all!
70 You should set this variable to non-nil only when you really know what
73 (put 'defun-maybe 'lisp-indent-function 'defun)
74 (defmacro defun-maybe (name &rest everything-else)
75 "Define NAME as a function if NAME is not defined.
76 Note that it will never produce a byte-compiled code when NAME has
77 already been defined at the compile-time and the value for
78 `def*-maybe-enable-compile-time-hack' is non-nil. In order to always
79 check for the existence of NAME, use `defun-when-void' instead. See
80 also the function `defun'."
81 (if (or (null def*-maybe-enable-compile-time-hack)
83 (get name 'defun-maybe))
84 (let ((qname (` (quote (, name)))))
87 (if (not (fboundp (, qname)))
89 ;; Use `defalias' to update `load-history'.
91 (function (lambda (,@ everything-else))))
92 (put (, qname) 'defun-maybe t))))))))
94 (put 'defmacro-maybe 'lisp-indent-function 'defun)
95 (defmacro defmacro-maybe (name &rest everything-else)
96 "Define NAME as a macro if NAME is not defined.
97 Note that it will never produce a byte-compiled code when NAME has
98 already been defined at the compile-time and the value for
99 `def*-maybe-enable-compile-time-hack' is non-nil. In order to always
100 check for the existence of NAME, use `defmacro-when-void' instead.
101 See also the function `defmacro'."
102 (if (or (null def*-maybe-enable-compile-time-hack)
104 (get name 'defmacro-maybe))
105 (let ((qname (` (quote (, name)))))
106 (` (if (fboundp (, qname))
109 (defmacro (, name) (,@ everything-else))
110 ;; Use `defalias' to update `load-history'.
111 (defalias (, qname) (symbol-function (, qname)))
112 (put (, qname) 'defmacro-maybe t)))))))
114 (put 'defsubst-maybe 'lisp-indent-function 'defun)
115 (defmacro defsubst-maybe (name &rest everything-else)
116 "Define NAME as an inline function if NAME is not defined.
117 Note that it will never produce a byte-compiled code when NAME has
118 already been defined at the compile-time and the value for
119 `def*-maybe-enable-compile-time-hack' is non-nil. In order to always
120 check for the existence of NAME, use `defsubst-when-void' instead.
121 See also the macro `defsubst'."
122 (if (or (null def*-maybe-enable-compile-time-hack)
124 (get name 'defsubst-maybe))
125 (let ((qname (` (quote (, name)))))
126 (` (if (fboundp (, qname))
129 (defsubst (, name) (,@ everything-else))
130 ;; Use `defalias' to update `load-history'.
131 (defalias (, qname) (symbol-function (, qname)))
132 (put (, qname) 'defsubst-maybe t)))))))
134 (defmacro defalias-maybe (symbol definition)
135 "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
136 Note that it will never produce a byte-compiled code when SYMBOL has
137 already been defined at the compile-time and the value for
138 `def*-maybe-enable-compile-time-hack' is non-nil. In order to always
139 check for the existence of SYMBOL, use `defalias-when-void' instead.
140 See also the function `defalias'."
141 (setq symbol (eval symbol))
142 (if (or (null def*-maybe-enable-compile-time-hack)
143 (not (fboundp symbol))
144 (get symbol 'defalias-maybe))
145 (let ((qsymbol (` (quote (, symbol)))))
146 (` (if (fboundp (, qsymbol))
147 (symbol-function (, qsymbol))
149 ;; `defalias' updates `load-history' internally.
150 (defalias (, qsymbol) (, definition))
151 (put (, qsymbol) 'defalias-maybe t)))))))
153 (defmacro defvar-maybe (name &rest everything-else)
154 "Define NAME as a variable if NAME is not defined.
155 Note that it will never produce a byte-compiled code when NAME has
156 already been defined at the compile-time and the value for
157 `def*-maybe-enable-compile-time-hack' is non-nil. In order to always
158 check for the existence of NAME, use `defvar-when-void' instead. See
159 also the function `defvar'."
160 (if (or (null def*-maybe-enable-compile-time-hack)
162 (get name 'defvar-maybe))
163 (let ((qname (` (quote (, name)))))
164 (` (if (boundp (, qname))
167 ;; byte-compiler will generate code to update
169 (defvar (, name) (,@ everything-else))
170 (put (, qname) 'defvar-maybe t)))))))
172 (defmacro defconst-maybe (name &rest everything-else)
173 "Define NAME as a constant variable if NAME is not defined.
174 Note that it will never produce a byte-compiled code when NAME has
175 already been defined at the compile-time and the value for
176 `def*-maybe-enable-compile-time-hack' is non-nil. In order to always
177 check for the existence of NAME, use `defconst-when-void' instead.
178 See also the function `defconst'."
179 (if (or (null def*-maybe-enable-compile-time-hack)
181 (get name 'defconst-maybe))
182 (let ((qname (` (quote (, name)))))
183 (` (if (boundp (, qname))
186 ;; byte-compiler will generate code to update
188 (defconst (, name) (,@ everything-else))
189 (put (, qname) 'defconst-maybe t)))))))
191 (defmacro defun-maybe-cond (name args &optional doc &rest clauses)
192 "Define NAME as a function if NAME is not defined.
193 Note that it will never produce a byte-compiled code when NAME has
194 already been defined at the compile-time and the value for
195 `def*-maybe-enable-compile-time-hack' is non-nil.
196 CLAUSES are like those of `cond' expression, but each condition is
197 evaluated at compile-time and, if the value is non-nil, the body of
198 the clause is used for function definition of NAME. See also the
201 (setq clauses (cons doc clauses)
203 (if (or (null def*-maybe-enable-compile-time-hack)
205 (get name 'defun-maybe))
206 (let ((qname (` (quote (, name)))))
209 (if (not (fboundp (, qname)))
217 (` (defalias (, qname)
222 (` (defalias (, qname)
225 (,@ (cdr case))))))))))
227 (put (, qname) 'defun-maybe t))))))))
229 (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
230 "Define NAME as a macro if NAME is not defined.
231 Note that it will never produce a byte-compiled code when NAME has
232 already been defined at the compile-time and the value for
233 `def*-maybe-enable-compile-time-hack' is non-nil.
234 CLAUSES are like those of `cond' expression, but each condition is
235 evaluated at compile-time and, if the value is non-nil, the body of
236 the clause is used for macro definition of NAME. See also the
237 function `defmacro'."
239 (setq clauses (cons doc clauses)
241 (if (or (null def*-maybe-enable-compile-time-hack)
243 (get name 'defmacro-maybe))
244 (let ((qname (` (quote (, name)))))
245 (` (if (fboundp (, qname))
255 (defmacro (, name) (, args)
259 (symbol-function (, qname)))))
261 (defmacro (, name) (, args)
264 (symbol-function (, qname)))))))))
266 (put (, qname) 'defmacro-maybe t)))))))
268 (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
269 "Define NAME as an inline function if NAME is not defined.
270 Note that it will never produce a byte-compiled code when NAME has
271 already been defined at the compile-time and the value for
272 `def*-maybe-enable-compile-time-hack' is non-nil.
273 CLAUSES are like those of `cond' expression, but each condition is
274 evaluated at compile-time and, if the value is non-nil, the body of
275 the clause is used for function definition of NAME. See also the
278 (setq clauses (cons doc clauses)
280 (if (or (null def*-maybe-enable-compile-time-hack)
282 (get name 'defsubst-maybe))
283 (let ((qname (` (quote (, name)))))
284 (` (if (fboundp (, qname))
294 (defsubst (, name) (, args)
298 (symbol-function (, qname)))))
300 (defsubst (, name) (, args)
303 (symbol-function (, qname)))))))))
305 (put (, qname) 'defsubst-maybe t)))))))
308 ;;; Conditional define (always do load-time check).
310 (put 'defun-when-void 'lisp-indent-function 'defun)
311 (defmacro defun-when-void (&rest args)
312 "Define a function, just like `defun', unless it's already defined.
313 Used for compatibility among different emacs variants. Note that the
314 macro with the same name in XEmacs will be replaced with it. See also
315 the macro `defun-maybe'."
316 (let ((qname (list 'quote (car args))))
317 (setq args (cdr args))
320 (if (not (fboundp (, qname)))
321 ;; Use `defalias' to update `load-history'.
323 (function (lambda (,@ args)))))))))
325 (put 'defmacro-when-void 'lisp-indent-function 'defun)
326 (defmacro defmacro-when-void (name &rest everything-else)
327 "Define NAME as a macro if NAME is not defined at the load-time.
328 See also the function `defmacro' and the macro `defmacro-maybe'."
329 (let ((qname (` (quote (, name)))))
330 (` (if (fboundp (, qname))
333 (defmacro (, name) (,@ everything-else))
334 ;; Use `defalias' to update `load-history'.
335 (defalias (, qname) (symbol-function (, qname))))))))
337 (put 'defsubst-when-void 'lisp-indent-function 'defun)
338 (defmacro defsubst-when-void (name &rest everything-else)
339 "Define NAME as an inline function if NAME is not defined at the
340 load-time. See also the macros `defsubst' and `defsubst-maybe'."
341 (let ((qname (` (quote (, name)))))
342 (` (if (fboundp (, qname))
345 (defsubst (, name) (,@ everything-else))
346 ;; Use `defalias' to update `load-history'.
347 (defalias (, qname) (symbol-function (, qname))))))))
349 (defmacro defalias-when-void (symbol definition)
350 "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined at
351 the load-time. See also the function `defalias' and the macro
353 (let* ((symbol (eval symbol))
354 (qsymbol (` (quote (, symbol)))))
355 (` (if (fboundp (, qsymbol))
356 (symbol-function (, qsymbol))
357 ;; `defalias' updates `load-history' internally.
358 (defalias (, qsymbol) (, definition))))))
360 (defmacro defvar-when-void (name &rest everything-else)
361 "Define NAME as a variable if NAME is not defined at the load-time.
362 See also the function `defvar' and the macro `defvar-maybe'."
363 (let ((qname (` (quote (, name)))))
364 (` (if (boundp (, qname))
366 ;; byte-compiler will generate code to update
368 (defvar (, name) (,@ everything-else))))))
370 (defmacro defconst-when-void (name &rest everything-else)
371 "Define NAME as a constant variable if NAME is not defined at the
372 load-time. See also the function `defconst' and the macro
374 (let ((qname (` (quote (, name)))))
375 (` (if (boundp (, qname))
377 ;; byte-compiler will generate code to update
379 (defconst (, name) (,@ everything-else))))))
384 ;; `def-edebug-spec' is an autoloaded macro in v19 and later.
385 ;; (Note that recent XEmacs provides "edebug" as a separate package.)
386 (defmacro-maybe def-edebug-spec (symbol spec)
387 "Set the edebug-form-spec property of SYMBOL according to SPEC.
388 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
389 \(naming a function\), or a list."
390 (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
392 ;; edebug-spec for `def*-maybe' macros.
393 (def-edebug-spec defun-maybe defun)
394 (def-edebug-spec defmacro-maybe defmacro)
395 (def-edebug-spec defsubst-maybe defun)
396 (def-edebug-spec defun-maybe-cond
397 (&define name lambda-list
399 [&rest ([¬ eval] [&rest sexp])]
400 [&optional (eval [&optional ("interactive" interactive)] def-body)]
402 (def-edebug-spec defmacro-maybe-cond
403 (&define name lambda-list
404 [&rest ([¬ eval] [&rest sexp])]
405 [&optional (eval def-body)]
407 (def-edebug-spec defsubst-maybe-cond
408 (&define name lambda-list
410 [&rest ([¬ eval] [&rest sexp])]
411 [&optional (eval [&optional ("interactive" interactive)] def-body)]
414 ;; edebug-spec for `static-*' macros are also defined here.
415 (def-edebug-spec static-if t)
416 (def-edebug-spec static-when when)
417 (def-edebug-spec static-unless unless)
418 (def-edebug-spec static-condition-case condition-case)
419 (def-edebug-spec static-defconst defconst)
420 (def-edebug-spec static-cond cond)
423 ;;; for backward compatibility.
425 (defun subr-fboundp (symbol)
426 "Return t if SYMBOL's function definition is a built-in function."
427 (and (fboundp symbol)
428 (subrp (symbol-function symbol))))
429 ;; (make-obsolete 'subr-fboundp "don't use it.")
435 (product-provide (provide 'pym) (require 'apel-ver))