|
410
|
1 ;;; compat.el --- Mechanism for non-intrusively providing compatibility funs.
|
|
|
2
|
|
|
3 ;; Copyright (C) 2000 Ben Wing.
|
|
|
4
|
|
|
5 ;; Author: Ben Wing <ben@xemacs.org>
|
|
|
6 ;; Maintainer: Ben Wing
|
|
|
7 ;; Keywords: internal
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
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)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
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.
|
|
|
20
|
|
|
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.
|
|
|
25
|
|
|
26 ;;; Synched up with: Not in FSF.
|
|
|
27
|
|
|
28 ;;; Authorship:
|
|
|
29
|
|
|
30 ; Written May 2000 by Ben Wing.
|
|
|
31
|
|
|
32 ;;; Commentary:
|
|
|
33
|
|
|
34 ;; Typical usage:
|
|
|
35
|
|
|
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
37 ;; 1. Wrap modules that define compatibility functions like this: ;;
|
|
|
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
39
|
|
|
40 ;(compat-define-group 'fsf-compat)
|
|
|
41
|
|
|
42 ;(compat-define-functions 'fsf-compat
|
|
|
43
|
|
|
44 ;(defun overlayp (object)
|
|
|
45 ; "Return t if OBJECT is an overlay."
|
|
|
46 ; (and (extentp object)
|
|
|
47 ; (extent-property object 'overlay)))
|
|
|
48
|
|
|
49 ;(defun make-overlay (beg end &optional buffer front-advance rear-advance)
|
|
|
50 ; ...)
|
|
|
51
|
|
|
52 ;...
|
|
|
53
|
|
|
54 ;) ;; end of (compat-define-group 'fsf-compat)
|
|
|
55
|
|
|
56 ;;;; overlay.el ends here
|
|
|
57
|
|
|
58
|
|
|
59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
60 ;; 2. Wrap modules that use the compatibility functions like this: ;;
|
|
|
61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
62
|
|
|
63 ;(compat 'fsf-compat
|
|
|
64
|
|
|
65 ;(defun random-module-my-fun (bar baz)
|
|
|
66 ; (if (fboundp 'overlays-in) (overlays-in bar baz)))
|
|
|
67
|
|
|
68 ;...
|
|
|
69
|
|
|
70 ;) ;; end of (compat 'fsf-compat)
|
|
|
71
|
|
|
72 ;;;; random-module.el ends here
|
|
|
73
|
|
|
74
|
|
|
75 (defun compat-hash-table (group)
|
|
|
76 (get group 'compat-table))
|
|
|
77
|
|
|
78 (defun compat-make-hash-table (group)
|
|
|
79 (put group 'compat-table (make-hash-table)))
|
|
|
80
|
|
|
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
|
|
|
85 `compat' macro.
|
|
|
86
|
|
|
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))))
|
|
|
91
|
|
|
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))))
|
|
|
96
|
|
|
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.
|
|
|
106
|
|
|
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)))
|
|
|
112 (let (fundef
|
|
|
113 (body-tail body))
|
|
|
114 (while body-tail
|
|
|
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))))
|
|
|
121 (let (fundef
|
|
|
122 (body-tail body)
|
|
|
123 result)
|
|
|
124 (while body-tail
|
|
|
125 (setq fundef (car body-tail))
|
|
|
126 (push
|
|
|
127 (cond ((and (consp fundef) (eq (car fundef) 'defun))
|
|
|
128 (nconc (list 'defun
|
|
|
129 (intern (concat (symbol-name group) "-"
|
|
|
130 (symbol-name (second fundef))))
|
|
|
131 (third fundef))
|
|
|
132 (nthcdr 3 fundef)))
|
|
|
133 ((and (consp fundef) (eq (car fundef) 'defmacro))
|
|
|
134 (nconc (list 'defmacro
|
|
|
135 (intern (concat (symbol-name group) "-"
|
|
|
136 (symbol-name (second fundef))))
|
|
|
137 (third fundef))
|
|
|
138 (nthcdr 3 fundef)))
|
|
|
139 (t fundef))
|
|
|
140 result)
|
|
|
141 (setq body-tail (cdr body-tail)))
|
|
|
142 (nconc (list 'compat (list 'quote group)) (nreverse result)))))
|
|
|
143
|
|
|
144 (defvar compat-active-groups nil)
|
|
|
145
|
|
|
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'."
|
|
|
150 (or (fboundp fun)
|
|
|
151 (block nil
|
|
|
152 (mapcar #'(lambda (group)
|
|
|
153 (if (gethash fun (compat-hash-table group))
|
|
|
154 (return t)))
|
|
|
155 groups))))
|
|
|
156
|
|
|
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).
|
|
|
170
|
|
|
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
|
|
|
177 be affected."
|
|
|
178 (let ((group (eval group))
|
|
|
179 defs)
|
|
|
180 (maphash
|
|
|
181 #'(lambda (fun args)
|
|
|
182 (push
|
|
|
183 (list fun args
|
|
|
184 (nconc
|
|
|
185 (list 'list
|
|
|
186 (list 'quote
|
|
|
187 (intern (concat (symbol-name group) "-"
|
|
|
188 (symbol-name fun)))))
|
|
|
189 args))
|
|
|
190 defs))
|
|
|
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))
|
|
|
197 ,@defs)
|
|
|
198 ,@body))))
|
