1 ;;; compat.el --- Mechanism for non-intrusively providing compatibility funs.
3 ;; Copyright (C) 2000 Ben Wing.
5 ;; Author: Ben Wing <ben@xemacs.org>
6 ;; Maintainer: Ben Wing
9 ;; This file is part of XEmacs.
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XEmacs 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 XEmacs; 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.
26 ;;; Synched up with: Not in FSF.
30 ; Written May 2000 by Ben Wing.
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 ;; 1. Wrap modules that define compatibility functions like this: ;;
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40 ;(compat-define-group 'fsf-compat)
42 ;(compat-define-functions 'fsf-compat
44 ;(defun overlayp (object)
45 ; "Return t if OBJECT is an overlay."
46 ; (and (extentp object)
47 ; (extent-property object 'overlay)))
49 ;(defun make-overlay (beg end &optional buffer front-advance rear-advance)
54 ;) ;; end of (compat-define-group 'fsf-compat)
56 ;;;; overlay.el ends here
59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 ;; 2. Wrap modules that use the compatibility functions like this: ;;
61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65 ;(defun random-module-my-fun (bar baz)
66 ; (if (fboundp 'overlays-in) (overlays-in bar baz)))
70 ;) ;; end of (compat 'fsf-compat)
72 ;;;; random-module.el ends here
75 (defun compat-hash-table (group)
76 (get group 'compat-table))
78 (defun compat-make-hash-table (group)
79 (put group 'compat-table (make-hash-table)))
81 (defmacro compat-define-group (group)
82 "Define GROUP as a group of compatibility functions.
83 Individual functions are defined using `compat-define-functions'.
84 Once defined, the functions can be used by wrapping your code in the
87 If GROUP is already defined, nothing happens."
88 (let ((group (eval group)))
89 (or (hash-table-p (compat-hash-table group))
90 (compat-make-hash-table group))))
92 (defmacro compat-clear-functions (group)
93 "Clear all defined functions and macros out of GROUP."
94 (let ((group (eval group)))
95 (clrhash (compat-hash-table group))))
97 (defmacro compat-define-functions (group &rest body)
98 "Define compatibility functions in GROUP.
99 You should simply wrap this around the code that defines the functions.
100 Any functions and macros defined at top level using `defun' or `defmacro'
101 will be noticed and added to GROUP. Other top-level code will be executed
102 normally. All code and definitions in this group can safely reference any
103 other functions in this group -- the code is effectively wrapped in a
104 `compat' call. You can call `compat-define-functions' more than once, if
105 necessary, for a single group.
107 What actually happens is that the functions and macros defined here are in
108 fact defined using names prefixed with GROUP. To use these functions,
109 wrap any calling code with the `compat' macro, which lexically renames
110 the function and macro calls appropriately."
111 (let ((group (eval group)))
115 (setq fundef (car body-tail))
116 (when (and (consp fundef) (eq (car fundef) 'defun))
117 (puthash (second fundef) (third fundef) (compat-hash-table group)))
118 (when (and (consp fundef) (eq (car fundef) 'defmacro))
119 (puthash (second fundef) (third fundef) (compat-hash-table group)))
120 (setq body-tail (cdr body-tail))))
125 (setq fundef (car body-tail))
127 (cond ((and (consp fundef) (eq (car fundef) 'defun))
129 (intern (concat (symbol-name group) "-"
130 (symbol-name (second fundef))))
133 ((and (consp fundef) (eq (car fundef) 'defmacro))
134 (nconc (list 'defmacro
135 (intern (concat (symbol-name group) "-"
136 (symbol-name (second fundef))))
141 (setq body-tail (cdr body-tail)))
142 (nconc (list 'compat (list 'quote group)) (nreverse result)))))
144 (defvar compat-active-groups nil)
146 (defun compat-fboundp (groups fun)
147 "T if FUN is either `fboundp' or one of the compatibility funs in GROUPS.
148 GROUPS is a list of compatibility groups as defined using
149 `compat-define-group'."
152 (mapcar #'(lambda (group)
153 (if (gethash fun (compat-hash-table group))
157 (defmacro compat (group &rest body)
158 "Make use of compatibility functions and macros in GROUP.
159 You should simply wrap this around the code that uses the functions
160 and macros in GROUP. Typically, a call to `compat' should be placed
161 at the top of an ELisp module, with the closing parenthesis at the
162 bottom; use this in place of a `require' statement. Wrapped code can
163 be either function or macro definitions or other ELisp code, and
164 wrapped function or macro definitions need not be at top level. All
165 calls to the compatibility functions or macros will be noticed anywhere
166 within the wrapped code. Calls to `fboundp' within the wrapped code
167 will also behave correctly when called on compatibility functions and
168 macros, even though they would return nil elsewhere (including in code
169 in other modules called dynamically from the wrapped code).
171 The functions and macros define in GROUP are actually defined under
172 prefixed names, to avoid namespace clashes and bad interactions with
173 other code that calls `fboundp'. All calls inside of the wrapped code
174 to the compatibility functions and macros in GROUP are lexically
175 mapped to the prefixed names. Since this is a lexical mapping, code
176 in other modules that is called by functions in this module will not
178 (let ((group (eval group))
187 (intern (concat (symbol-name group) "-"
188 (symbol-name fun)))))
191 (compat-hash-table group))
192 ;; it would be cleaner to use `lexical-let' instead of `let', but that
193 ;; causes function definitions to have obnoxious, unreadable junk in
194 ;; them. #### Move `lexical-let' into C!!!
195 `(let ((compat-active-groups (cons ',group compat-active-groups)))
196 (macrolet ((fboundp (fun) `(compat-fboundp ',compat-active-groups ,fun))