Mercurial > hg > xemacs-beta
annotate lisp/bytecomp-runtime.el @ 5402:308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Thu, 14 Oct 2010 17:15:20 +0200 |
| parents | 0d43872986b6 |
| children | ac37a5f7e5be |
| rev | line source |
|---|---|
| 428 | 1 ;;; bytecomp-runtime.el --- byte-compiler support for inlining |
| 2 | |
| 3 ;; Copyright (C) 1992, 1997 Free Software Foundation, Inc. | |
|
4949
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
4 ;; Copyright (C) 2002, 2010 Ben Wing. |
| 428 | 5 |
| 6 ;; Author: Jamie Zawinski <jwz@jwz.org> | |
| 7 ;; Author: Hallvard Furuseth <hbf@ulrik.uio.no> | |
| 8 ;; Maintainer: XEmacs Development Team | |
| 9 ;; Keywords: internal, dumped | |
| 10 | |
| 11 ;; This file is part of XEmacs. | |
| 12 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
13 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
14 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
15 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
16 ;; option) any later version. |
| 428 | 17 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
18 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
21 ;; for more details. |
| 428 | 22 |
| 23 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5264
diff
changeset
|
24 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 25 |
| 26 ;;; Synched up with: FSF 19.30. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;; The code in this file should always be loaded, because it defines things | |
| 33 ;; like "defsubst" which should work interpreted as well. The code in | |
| 34 ;; bytecomp.el and byte-optimize.el can be loaded as needed. | |
| 35 | |
| 36 ;; interface to selectively inlining functions. | |
| 37 ;; This only happens when source-code optimization is turned on. | |
| 38 | |
| 39 ;;; Code: | |
| 40 | |
| 41 ;; Redefined in byte-optimize.el. | |
| 42 ;; This is not documented--it's not clear that we should promote it. | |
| 43 (fset 'inline 'progn) | |
| 44 (put 'inline 'lisp-indent-hook 0) | |
| 45 | |
| 46 | |
| 47 ;;; Interface to inline functions. | |
| 48 | |
| 49 ;; FSF comments the next two out, but I see no reason to do so. --ben | |
| 50 (defmacro proclaim-inline (&rest fns) | |
| 51 "Cause the named functions to be open-coded when called from compiled code. | |
| 52 They will only be compiled open-coded when `byte-optimize' is true." | |
| 53 (cons 'eval-and-compile | |
|
5264
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
54 (mapcan |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
55 #'(lambda (x) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
56 `((or (memq (get ',x 'byte-optimizer) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
57 '(nil byte-compile-inline-expand)) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
58 (error |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
59 "%s already has a byte-optimizer, can't make it inline" |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
60 ',x)) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
61 (put ',x 'byte-optimizer 'byte-compile-inline-expand))) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
62 fns))) |
| 428 | 63 |
| 64 | |
| 65 (defmacro proclaim-notinline (&rest fns) | |
| 66 "Cause the named functions to no longer be open-coded." | |
| 67 (cons 'eval-and-compile | |
|
5264
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
68 (mapcan |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
69 #'(lambda (x) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
70 `((if (eq (get ',x 'byte-optimizer) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
71 'byte-compile-inline-expand) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
72 (put ',x 'byte-optimizer nil)))) |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
73 fns))) |
| 428 | 74 |
| 75 ;; This has a special byte-hunk-handler in bytecomp.el. | |
| 76 (defmacro defsubst (name arglist &rest body) | |
| 77 "Define an inline function. The syntax is just like that of `defun'." | |
| 78 (or (memq (get name 'byte-optimizer) | |
| 79 '(nil byte-compile-inline-expand)) | |
| 80 (error "`%s' is a primitive" name)) | |
| 81 (list 'prog1 | |
| 82 (cons 'defun (cons name (cons arglist body))) | |
| 83 (list 'proclaim-inline name))) | |
| 84 ; Instead of the above line, FSF has this: | |
| 85 ; (list 'eval-and-compile | |
| 86 ; (list 'put (list 'quote name) | |
| 87 ; ''byte-optimizer ''byte-compile-inline-expand)))) | |
| 88 | |
| 2444 | 89 (defun make-obsolete (fn new &optional when) |
| 991 | 90 "Make the byte-compiler warn that function FN is obsolete. |
| 428 | 91 The warning will say that NEW should be used instead. |
| 2444 | 92 If NEW is a string, that is the `use instead' message. |
| 93 If provided, WHEN should be a string indicating when the function | |
| 94 was first made obsolete, for example a date or a release number." | |
| 428 | 95 (interactive "aMake function obsolete: \nxObsoletion replacement: ") |
| 96 (let ((handler (get fn 'byte-compile))) | |
| 97 (if (eq 'byte-compile-obsolete handler) | |
| 98 (setcar (get fn 'byte-obsolete-info) new) | |
| 99 (put fn 'byte-obsolete-info (cons new handler)) | |
| 100 (put fn 'byte-compile 'byte-compile-obsolete))) | |
| 101 fn) | |
| 102 | |
| 2444 | 103 (defun make-obsolete-variable (var new &optional when) |
| 991 | 104 "Make the byte-compiler warn that variable VAR is obsolete, |
| 428 | 105 and NEW should be used instead. If NEW is a string, then that is the |
| 2444 | 106 `use instead' message. |
| 107 If provided, WHEN should be a string indicating when the variable | |
| 108 was first made obsolete, for example a date or a release number." | |
| 428 | 109 (interactive |
| 110 (list | |
| 111 (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t))) | |
| 112 (if (equal str "") (error "")) | |
| 113 (intern str)) | |
| 114 (car (read-from-string (read-string "Obsoletion replacement: "))))) | |
| 115 (put var 'byte-obsolete-variable new) | |
| 116 var) | |
| 117 | |
| 118 ;; By overwhelming demand, we separate out truly obsolete symbols from | |
| 119 ;; those that are present for GNU Emacs compatibility. | |
| 120 (defun make-compatible (fn new) | |
| 991 | 121 "Make the byte-compiler know that function FN is provided for compatibility. |
| 428 | 122 The warning will say that NEW should be used instead. |
| 123 If NEW is a string, that is the `use instead' message." | |
| 124 (interactive "aMake function compatible: \nxCompatible replacement: ") | |
| 125 (let ((handler (get fn 'byte-compile))) | |
| 126 (if (eq 'byte-compile-compatible handler) | |
| 127 (setcar (get fn 'byte-compatible-info) new) | |
| 128 (put fn 'byte-compatible-info (cons new handler)) | |
| 129 (put fn 'byte-compile 'byte-compile-compatible))) | |
| 130 fn) | |
| 131 | |
| 132 (defun make-compatible-variable (var new) | |
| 991 | 133 "Make the byte-compiler know that variable VAR is provided for compatibility, |
| 428 | 134 and NEW should be used instead. If NEW is a string, then that is the |
| 135 `use instead' message." | |
| 136 (interactive | |
| 137 (list | |
| 138 (let ((str (completing-read "Make variable compatible: " | |
| 139 obarray 'boundp t))) | |
| 140 (if (equal str "") (error "")) | |
| 141 (intern str)) | |
| 142 (car (read-from-string (read-string "Compatible replacement: "))))) | |
| 143 (put var 'byte-compatible-variable new) | |
| 144 var) | |
| 145 | |
| 146 (put 'dont-compile 'lisp-indent-hook 0) | |
| 147 (defmacro dont-compile (&rest body) | |
| 148 "Like `progn', but the body always runs interpreted (not compiled). | |
| 149 If you think you need this, you're probably making a mistake somewhere." | |
| 150 (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body))))) | |
| 151 | |
| 152 | |
| 153 ;;; interface to evaluating things at compile time and/or load time | |
| 154 ;;; these macro must come after any uses of them in this file, as their | |
| 155 ;;; definition in the file overrides the magic definitions on the | |
| 156 ;;; byte-compile-macro-environment. | |
| 157 | |
| 158 (put 'eval-when-compile 'lisp-indent-hook 0) | |
| 159 (defmacro eval-when-compile (&rest body) | |
|
5264
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
160 "Like `progn', but evaluates BODY at compile time, and when interpeted. |
| 428 | 161 The result of the body appears to the compiler as a quoted constant." |
| 162 ;; Not necessary because we have it in b-c-initial-macro-environment | |
| 163 ;; (list 'quote (eval (cons 'progn body))) | |
| 164 (cons 'progn body)) | |
| 165 | |
| 166 (put 'eval-and-compile 'lisp-indent-hook 0) | |
| 167 (defmacro eval-and-compile (&rest body) | |
|
5264
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
168 "Like `progn', but evaluates the body at compile time and at load time, |
|
0d43872986b6
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4949
diff
changeset
|
169 and when interpreted." |
| 428 | 170 ;; Remember, it's magic. |
| 171 (cons 'progn body)) | |
| 172 | |
| 173 ;;; From Emacs 20. | |
| 174 (put 'eval-when-feature 'lisp-indent-hook 1) | |
| 175 (defmacro eval-when-feature (feature &rest body) | |
| 176 "Run the body forms when FEATURE is featurep, be it now or later. | |
| 177 Called (eval-when-feature (FEATURE [. FILENAME]) BODYFORMS...). | |
| 178 If (featurep 'FEATURE), evals now; otherwise adds an elt to | |
| 179 `after-load-alist' (which see), using FEATURE as filename if FILENAME is nil." | |
| 180 (let ((file (or (cdr feature) (symbol-name (car feature))))) | |
| 181 `(let ((bodythunk #'(lambda () ,@body))) | |
| 182 (if (featurep ',(car feature)) | |
| 183 (funcall bodythunk) | |
| 184 (setq after-load-alist (cons '(,file . (list 'lambda '() bodythunk)) | |
| 185 after-load-alist)))))) | |
| 502 | 186 |
| 187 | |
| 188 | |
| 189 ;;; Functions to cleanly eliminate warnings about undefined functions | |
| 190 ;;; or variables when the code knows what it's doing. These macros DO | |
| 191 ;;; NOT rely on any byte-compiler changes, and thus can be copied into | |
| 192 ;;; a package and used within it. | |
| 193 | |
| 194 ;; NOTE: As a result of the above requirement, the macros rely on | |
| 195 ;; "tricks" to get the warnings suppressed. A cleaner way, of course, | |
| 196 ;; would be to extend the byte compiler to provide a proper interface. | |
| 197 | |
| 198 ;; #### Should we require an unquoted symbol rather than a quoted one, | |
| 199 ;; as we currently do? The quoting gets no generality, as `eval' is | |
| 200 ;; called at compile time. But most functions and macros want quoted | |
| 201 ;; arguments, and I find it extremely confusing to deal with cases | |
| 202 ;; such as `throw' requiring a quoted argument but `block' an unquoted | |
| 203 ;; one. | |
| 204 | |
| 205 (put 'with-boundp 'lisp-indent-function 1) | |
| 771 | 206 (defmacro with-boundp (variables &rest body) |
| 207 "Evaluate BODY, but do not issue bytecomp warnings about VARIABLES undefined. | |
| 208 VARIABLES can be a symbol or a list of symbols and must be quoted. When | |
| 209 compiling this file, the warnings `reference to free variable VARIABLE' and | |
| 210 `assignment to free variable VARIABLE' will not occur anywhere in BODY, for | |
| 211 any of the listed variables. This is a clean way to avoid such warnings. | |
| 776 | 212 |
| 213 See also `if-boundp', `when-boundp', and `and-boundp' (ways to | |
| 214 conditionalize on a variable being bound and avoid warnings), | |
| 215 `declare-boundp' (issue a variable call without warnings), and | |
| 216 `globally-declare-boundp' (avoid warnings throughout a file about a | |
| 217 variable)." | |
| 771 | 218 (setq variables (eval variables)) |
| 219 (unless (consp variables) | |
| 220 (setq variables (list variables))) | |
| 502 | 221 `(progn |
| 771 | 222 (declare (special ,@variables)) |
| 502 | 223 ,@body)) |
| 224 | |
| 225 (put 'if-boundp 'lisp-indent-function 2) | |
| 771 | 226 (defmacro if-boundp (variable then &rest else) |
| 227 "Equivalent to (if (boundp VARIABLE) THEN ELSE) but handles bytecomp warnings. | |
| 228 VARIABLE should be a quoted symbol. When compiling this file, the warnings | |
| 229 `reference to free variable VARIABLE' and `assignment to free variable | |
| 230 VARIABLE' will not occur anywhere in the if-statement. This is a clean way | |
| 776 | 231 to avoid such warnings. See also `with-boundp' and friends." |
| 771 | 232 `(with-boundp ,variable |
| 233 (if (boundp ,variable) ,then ,@else))) | |
| 502 | 234 |
| 771 | 235 (put 'when-boundp 'lisp-indent-function 1) |
| 236 (defmacro when-boundp (variable &rest body) | |
| 237 "Equivalent to (when (boundp VARIABLE) BODY) but handles bytecomp warnings. | |
| 238 VARIABLE should be a quoted symbol. When compiling this file, the warnings | |
| 239 `reference to free variable VARIABLE' and `assignment to free variable | |
| 240 VARIABLE' will not occur anywhere in the when-statement. This is a clean | |
| 776 | 241 way to avoid such warnings. See also `with-boundp' and friends." |
| 771 | 242 `(with-boundp ,variable |
| 243 (when (boundp ,variable) ,@body))) | |
| 244 | |
| 776 | 245 (put 'and-boundp 'lisp-indent-function 1) |
| 246 (defmacro and-boundp (variable &rest args) | |
| 247 "Equivalent to (and (boundp VARIABLE) ARGS) but handles bytecomp warnings. | |
| 248 VARIABLE should be a quoted symbol. When compiling this file, the warnings | |
| 249 `reference to free variable VARIABLE' and `assignment to free variable | |
| 250 VARIABLE' will not occur anywhere in the and-statement. This is a clean | |
| 251 way to avoid such warnings. See also `with-boundp' and friends." | |
| 252 `(with-boundp ,variable | |
| 253 (and (boundp ,variable) ,@args))) | |
| 254 | |
| 771 | 255 (defmacro declare-boundp (variable) |
| 256 "Evaluate VARIABLE without bytecomp warnings about the symbol. | |
| 257 | |
| 502 | 258 Sample usage is |
| 259 | |
| 260 (declare-boundp gpm-minor-mode) | |
| 261 | |
| 262 which is equivalent to | |
| 263 | |
| 771 | 264 (with-boundp 'gpm-minor-mode |
| 776 | 265 gpm-minor-mode) |
| 266 | |
| 267 See also `with-boundp' and friends." | |
| 771 | 268 `(with-boundp ',variable ,variable)) |
| 502 | 269 |
| 771 | 270 (defmacro globally-declare-boundp (variables) |
| 271 "Declare that all free uses of VARIABLES in this file are valid. | |
| 272 VARIABLES can be a symbol or a list of symbols and must be quoted. | |
| 502 | 273 |
| 771 | 274 When compiling this file, the warnings `reference to free variable |
| 275 VARIABLE' and `assignment to free variable VARIABLE' will not occur | |
| 276 regardless of where references to VARIABLE occur in the file. | |
| 502 | 277 |
| 776 | 278 In general, you should *NOT* use this; use `with-boundp' or its friends to |
| 279 wrap individual uses, as necessary. That way, you're more likely to | |
| 280 remember to put in the explicit checks for the variable's existence that | |
| 281 are usually necessary. However, `globally-declare-boundp' is better in | |
| 282 some circumstances, such as when writing an ELisp package that makes | |
| 283 integral use of optionally-compiled-in functionality (typically, an | |
| 284 interface onto a system library) and checks for the existence of the | |
| 285 functionality at some entry point to the package. See | |
| 286 `globally-declare-fboundp' for more information." | |
| 771 | 287 (setq variables (eval variables)) |
| 288 (if (not (consp variables)) | |
| 289 (setq variables (list variables))) | |
| 502 | 290 `(progn |
| 291 ;; (defvar FOO) has no side effects. | |
| 771 | 292 ,@(mapcar #'(lambda (sym) `(defvar ,sym)) variables))) |
| 502 | 293 |
| 294 (defun byte-compile-with-fboundp (form) | |
| 295 (byte-compile-form (cons 'progn (cdr (cdr form)))) | |
| 296 ;; Unfortunately, byte-compile-unresolved-functions is used not only | |
| 297 ;; for unresolved-function warnings, but also in connection with the | |
| 298 ;; following warnings: | |
| 299 | |
| 300 ;; "defsubst %s was used before it was defined" | |
| 301 ;; "%s being defined to take %s%s, but was previously called with %s" | |
| 302 | |
| 303 ;; By hacking byte-compile-unresolved-functions like this, we | |
| 304 ;; effectively disable these warnings. But code should not be using | |
| 305 ;; `with-fboundp' with a function defined later on in the same | |
| 306 ;; file, so this is not a big deal. | |
| 307 | |
| 308 (let ((symbols (eval (car (cdr form))))) | |
| 309 (unless (consp symbols) | |
| 310 (setq symbols (list symbols))) | |
| 311 (setq symbols (mapcar #'(lambda (sym) (cons sym nil)) symbols)) | |
| 312 (setq byte-compile-unresolved-functions | |
| 313 (set-difference byte-compile-unresolved-functions symbols | |
| 314 :key #'car)) | |
| 315 )) | |
| 316 | |
| 317 ;; EEEEEEEEVIL hack. We need to create our own byte-compilation | |
| 318 ;; method so that the proper variables are bound while compilation | |
| 319 ;; takes place (which is when the warnings get noticed and batched | |
| 320 ;; up). What we really want to do is make `with-fboundp' a macro | |
| 321 ;; that simply `progn's its BODY; but GOD DAMN IT, macros can't have | |
| 322 ;; their own byte-compilation methods! So we make `with-fboundp' a | |
| 323 ;; macro calling `with-fboundp-1', which is cleverly aliased to | |
| 324 ;; progn. This way we can put a byte-compilation method on | |
| 325 ;; `with-fboundp-1', and when interpreting, progn will duly skip | |
| 326 ;; the first, quoted argument, i.e. the symbol name. (We could make | |
| 327 ;; `with-fboundp-1' a regular function, but then we'd have to thunk | |
| 328 ;; BODY and eval it at runtime. We could probably just do this using | |
| 329 ;; (apply 'progn BODY), but the existing method is more obviously | |
| 330 ;; guaranteed to work.) | |
| 331 ;; | |
| 332 ;; In defense, cl-macs.el does a very similar thing with | |
| 333 ;; `cl-block-wrapper'. | |
| 334 | |
| 335 (put 'with-fboundp-1 'byte-compile 'byte-compile-with-fboundp) | |
| 336 (defalias 'with-fboundp-1 'progn) | |
| 337 | |
| 338 (put 'with-fboundp 'lisp-indent-function 1) | |
| 771 | 339 (defmacro with-fboundp (functions &rest body) |
| 340 "Evaluate BODY, but do not issue bytecomp warnings about FUNCTIONS undefined. | |
| 341 FUNCTIONS can be a symbol or a list of symbols and must be quoted. When | |
| 342 compiling this file, the warning `the function FUNCTION is not known to be | |
| 343 defined' will not occur anywhere in BODY, for any of the listed functions. | |
| 776 | 344 This is a clean way to avoid such warnings. |
| 345 | |
| 346 See also `if-fboundp', `when-fboundp', and `and-fboundp' (ways to | |
| 347 conditionalize on a function being bound and avoid warnings), | |
| 348 `declare-fboundp' (issue a function call without warnings), and | |
| 349 `globally-declare-fboundp' (avoid warnings throughout a file about a | |
| 350 function)." | |
| 771 | 351 `(with-fboundp-1 ,functions ,@body)) |
| 502 | 352 |
| 353 (put 'if-fboundp 'lisp-indent-function 2) | |
| 771 | 354 (defmacro if-fboundp (function then &rest else) |
| 355 "Equivalent to (if (fboundp FUNCTION) THEN ELSE) but handles bytecomp warnings. | |
| 356 FUNCTION should be a quoted symbol. When compiling this file, the warning | |
| 357 `the function FUNCTION is not known to be defined' will not occur anywhere | |
| 358 in the if-statement. This is a clean way to avoid such warnings. See also | |
| 776 | 359 `with-fboundp' and friends." |
| 771 | 360 `(with-fboundp ,function |
| 361 (if (fboundp ,function) ,then ,@else))) | |
| 362 | |
| 363 (put 'when-fboundp 'lisp-indent-function 1) | |
| 364 (defmacro when-fboundp (function &rest body) | |
| 365 "Equivalent to (when (fboundp FUNCTION) BODY) but handles bytecomp warnings. | |
| 366 FUNCTION should be a quoted symbol. When compiling this file, the warning | |
| 367 `the function FUNCTION is not known to be defined' will not occur anywhere | |
| 776 | 368 in the when-statement. This is a clean way to avoid such warnings. See also |
| 369 `with-fboundp' and friends." | |
| 771 | 370 `(with-fboundp ,function |
| 371 (when (fboundp ,function) ,@body))) | |
| 502 | 372 |
| 776 | 373 (put 'and-fboundp 'lisp-indent-function 1) |
| 374 (defmacro and-fboundp (function &rest args) | |
| 375 "Equivalent to (and (fboundp FUNCTION) ARGS) but handles bytecomp warnings. | |
| 376 FUNCTION should be a quoted symbol. When compiling this file, the warning | |
| 377 `the function FUNCTION is not known to be defined' will not occur anywhere | |
| 378 in the and-statement. This is a clean way to avoid such warnings. See also | |
| 379 `with-fboundp' and friends." | |
| 380 `(with-fboundp ,function | |
| 381 (and (fboundp ,function) ,@args))) | |
| 382 | |
| 502 | 383 (defmacro declare-fboundp (form) |
| 384 "Execute FORM (a function call) without bytecomp warnings about the call. | |
| 385 Sample usage is | |
| 386 | |
| 387 (declare-fboundp (x-keysym-on-keyboard-sans-modifiers-p 'backspace)) | |
| 388 | |
| 389 which is equivalent to | |
| 390 | |
| 391 (with-fboundp 'x-keysym-on-keyboard-sans-modifiers-p | |
| 776 | 392 (x-keysym-on-keyboard-sans-modifiers-p 'backspace)) |
| 393 | |
| 394 See also `with-fboundp' and friends." | |
| 502 | 395 `(with-fboundp ',(car form) ,form)) |
| 396 | |
| 771 | 397 (defmacro globally-declare-fboundp (functions) |
| 398 "Declare that all calls to function FUNCTIONS in this file are valid. | |
| 399 FUNCTIONS can be a symbol or a list of symbols and must be quoted. | |
| 502 | 400 |
| 771 | 401 When compiling this file, the warning `the function FUNCTION is not known |
| 402 to be defined' will not occur regardless of where calls to FUNCTION occur | |
| 403 in the file. | |
| 502 | 404 |
| 776 | 405 In general, you should *NOT* use this; use `with-fboundp' or its friends to |
| 406 wrap individual uses, as necessary. That way, you're more likely to | |
| 407 remember to put in the explicit checks for the function's existence that | |
| 408 are usually necessary. However, `globally-declare-fboundp' is better in | |
| 409 some circumstances, such as when writing an ELisp package that makes | |
| 410 integral use of optionally-compiled-in functionality (typically, an | |
| 411 interface onto a system library) and checks for the existence of the | |
| 412 functionality at some entry point to the package. The file `ldap.el' is a | |
| 413 good example: It provides a layer on top of the optional LDAP ELisp | |
| 414 primitives, makes calls to them throughout its code, and verifies the | |
| 415 presence of LDAP support at load time. Putting calls to `declare-fboundp' | |
| 416 throughout the code would be a major annoyance." | |
| 502 | 417 (when (cl-compiling-file) |
| 771 | 418 (setq functions (eval functions)) |
| 419 (if (not (consp functions)) | |
| 420 (setq functions (list functions))) | |
| 502 | 421 ;; Another hack. This works because the autoload environment is |
| 422 ;; currently used ONLY to suppress warnings, and the actual | |
| 423 ;; autoload definition is not used. (NOTE: With this definition, | |
| 424 ;; we will get spurious "multiple autoloads for %s" warnings if we | |
| 771 | 425 ;; have an autoload later in the file for any functions in FUNCTIONS. |
| 502 | 426 ;; This is not something that code should ever do, though.) |
| 427 (setq byte-compile-autoload-environment | |
| 771 | 428 (append (mapcar #'(lambda (sym) (cons sym nil)) functions) |
| 502 | 429 byte-compile-autoload-environment))) |
| 430 nil) | |
| 431 | |
| 432 (defun byte-compile-with-byte-compiler-warnings-suppressed (form) | |
| 433 (let ((byte-compile-warnings byte-compile-warnings) | |
| 434 (types (car (cdr form)))) | |
| 435 (unless (consp types) | |
| 436 (setq types (list types))) | |
| 437 (if (eq byte-compile-warnings t) | |
| 438 (setq byte-compile-warnings byte-compile-default-warnings)) | |
| 439 (setq byte-compile-warnings (set-difference byte-compile-warnings types)) | |
| 440 (byte-compile-form (cons 'progn (cdr (cdr form)))))) | |
| 441 | |
| 442 ;; Same hack here as with `with-fboundp'. | |
| 443 (put 'with-byte-compiler-warnings-suppressed-1 'byte-compile | |
| 444 'byte-compile-with-byte-compiler-warnings-suppressed) | |
| 445 (defalias 'with-byte-compiler-warnings-suppressed-1 'progn) | |
| 446 | |
| 447 (put 'with-byte-compiler-warnings-suppressed 'lisp-indent-function 1) | |
| 448 (defmacro with-byte-compiler-warnings-suppressed (type &rest body) | |
| 449 "Evaluate BODY, but do not issue bytecomp warnings TYPE. | |
| 450 TYPE should be one of `redefine', `callargs', `subr-callargs', | |
| 451 `free-vars', `unresolved', `unused-vars', `obsolete', or `pedantic', | |
| 452 or a list of one or more of these symbols. (See `byte-compile-warnings'.) | |
| 453 TYPE must be quoted. | |
| 454 | |
| 455 NOTE: You should *NOT* under normal circumstances be using this! | |
| 456 There are better ways of avoiding most of these warnings. In particular: | |
| 457 | |
| 458 -- use (declare (special ...)) if you are making use of | |
| 459 dynamically-scoped variables. | |
| 776 | 460 -- use `with-fboundp' and friends to avoid warnings about undefined functions |
| 771 | 461 when you know the function actually exists. |
| 776 | 462 -- use `with-boundp' and friends to avoid warnings about undefined variables |
| 771 | 463 when you know the variable actually exists. |
| 502 | 464 -- use `with-obsolete-variable' or `with-obsolete-function' if you |
| 465 are purposely using such a variable or function." | |
| 466 `(with-byte-compiler-warnings-suppressed-1 ,type ,@body)) | |
| 467 | |
| 468 ;; #### These should be more clever. You could (e.g.) try fletting | |
| 469 ;; `byte-compile-obsolete' or temporarily removing the obsolete info | |
| 470 ;; from the symbol and putting it back with an unwind-protect. (Or | |
| 471 ;; better, modify the byte-compiler to provide a proper solution, and | |
| 472 ;; fix these macros to use it if available, or fall back on the way | |
| 473 ;; below. Remember, these definitions need to work with an unchanged | |
| 474 ;; byte compiler so that they can be copied and used in packages.) | |
| 475 | |
| 476 (put 'with-obsolete-variable 'lisp-indent-function 1) | |
| 477 (defmacro with-obsolete-variable (symbol &rest body) | |
| 478 "Evaluate BODY but do not warn about usage of obsolete variable SYMBOL. | |
| 826 | 479 SYMBOL must be quoted and can be a list of SYMBOLS. See also |
| 480 `with-obsolete-function'." | |
| 502 | 481 `(with-byte-compiler-warnings-suppressed 'obsolete ,@body)) |
| 482 | |
| 483 (put 'with-obsolete-function 'lisp-indent-function 1) | |
| 484 (defmacro with-obsolete-function (symbol &rest body) | |
| 485 "Evaluate BODY but do not warn about usage of obsolete function SYMBOL. | |
| 826 | 486 SYMBOL must be quoted and can be a list of SYMBOLS. See also |
| 487 `with-obsolete-variable'." | |
| 502 | 488 `(with-byte-compiler-warnings-suppressed 'obsolete ,@body)) |
| 428 | 489 |
| 490 | |
|
4949
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
491 |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
492 (defmacro error-unless-tests-match (test &optional source) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
493 "Signal an error unless TEST matches when being compiled and loaded. |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
494 This is for use in a file that will be byte-compiled. Unless TEST has the |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
495 same nilness or non-nilness when the file is compiled and loaded, an error |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
496 will be signalled. SOURCE is the name of the source file." |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
497 (let ((source (eval source))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
498 `(unless (eq (not ,test) ,(not (eval test))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
499 (error ,(format "This file was compiled with `%s' %s, |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
500 but it was %s when run. This file needs to be compiled with |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
501 the same value for the expression as when it is run. Please delete |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
502 %s and rebuild." |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
503 test (if (eval test) "true" "false") |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
504 (if (eval test) "false" "true") |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
505 (cond |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
506 ((null source) "the .elc for this file") |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
507 ((string-match "\.elc$" source) source) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
508 ((string-match "\.el$" source) (concat source "c")) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
509 (t (concat source ".elc")))))))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
510 |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
511 (defun byte-compile-file-being-compiled () |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
512 "When byte-compiling a file, return the name of the file being compiled. |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
513 Return nil otherwise." |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
514 (or |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
515 ;;The first of these, but not the second, seems to work noninteractively; |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
516 ;;vice-versa interactively. This is because interactively a *Compile Log* |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
517 ;;buffer is created and byte-compile-log-1 inserts a "Compiling file ..." |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
518 ;;message into thelog buffer, and then sets byte-compile-current-file to |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
519 ;;nil to indicate that the message shouldn't be printed again. |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
520 (and-boundp 'byte-compile-current-file byte-compile-current-file) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
521 (and-boundp 'byte-compile-log-buffer |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
522 (with-current-buffer byte-compile-log-buffer |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
523 (save-excursion |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
524 (and (re-search-backward "Compiling file \\(.*\\) at " nil t) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
525 (match-string 1))))))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
526 |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
527 |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
528 (defmacro compiled-if (test if &rest else) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
529 "Like a regular `if' statement but the TEST will be evalled at compile time. |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
530 If TEST doesn't match at compile time and load time, an error will be |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
531 signalled." |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
532 (let ((being-compiled (byte-compile-file-being-compiled))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
533 `(progn |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
534 (error-unless-tests-match ,test ,being-compiled) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
535 ,(if (eval test) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
536 if |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
537 `(progn ,else))))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
538 |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
539 (defmacro compiled-when (test &rest when) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
540 "Like a regular `when' statement but the TEST will be evalled at compile time. |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
541 See `compiled-if'." |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
542 `(compiled-if ,test (progn ,@when))) |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
543 |
|
018e13fdeaeb
compile-related functions added, for use in Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
2444
diff
changeset
|
544 |
| 428 | 545 ;;; Interface to file-local byte-compiler parameters. |
| 546 ;;; Redefined in bytecomp.el. | |
| 547 | |
| 548 ;;; The great RMS speaketh: | |
| 549 ;;; | |
| 550 ;;; I nuked this because it's not a good idea for users to think of | |
| 551 ;;; using it. These options are a matter of installation preference, | |
| 552 ;;; and have nothing to do with particular source files; it's a | |
| 553 ;;; mistake to suggest to users that they should associate these with | |
| 554 ;;; particular source files. There is hardly any reason to change | |
| 555 ;;; these parameters, anyway. --rms. | |
| 556 ;;; | |
| 557 ;;; But I'll leave this stuff alone. --ben | |
| 558 | |
| 559 (put 'byte-compiler-options 'lisp-indent-hook 0) | |
| 560 (defmacro byte-compiler-options (&rest args) | |
| 561 "Set some compilation-parameters for this file. | |
| 562 This will affect only the file in which it appears; this does nothing when | |
| 563 evaluated, or when loaded from a .el file. | |
| 564 | |
| 565 Each argument to this macro must be a list of a key and a value. | |
| 566 | |
| 567 Keys: Values: Corresponding variable: | |
| 568 | |
| 569 verbose t, nil byte-compile-verbose | |
| 570 optimize t, nil, source, byte byte-optimize | |
| 571 warnings list of warnings byte-compile-warnings | |
| 572 file-format emacs19, emacs20 byte-compile-emacs19-compatibility | |
| 573 | |
| 574 The value specified with the `warnings' option must be a list, containing | |
| 575 some subset of the following flags: | |
| 576 | |
| 577 free-vars references to variables not in the current lexical scope. | |
| 578 unused-vars references to non-global variables bound but not referenced. | |
| 579 unresolved calls to unknown functions. | |
| 580 callargs lambda calls with args that don't match the definition. | |
| 502 | 581 subr-callargs calls to subrs with args that don't match the definition. |
| 428 | 582 redefine function cell redefined from a macro to a lambda or vice |
| 583 versa, or redefined to take a different number of arguments. | |
| 502 | 584 obsolete use of an obsolete function or variable. |
| 585 pedantic warn of use of compatible symbols. | |
| 428 | 586 |
| 587 If the first element if the list is `+' or `-' then the specified elements | |
| 588 are added to or removed from the current set of warnings, instead of the | |
| 589 entire set of warnings being overwritten. | |
| 590 | |
| 591 For example, something like this might appear at the top of a source file: | |
| 592 | |
| 593 (byte-compiler-options | |
| 594 (optimize t) | |
| 595 (warnings (- callargs)) ; Don't warn about arglist mismatch | |
| 596 (warnings (+ unused-vars)) ; Do warn about unused bindings | |
| 597 (file-format emacs19))" | |
| 598 nil) | |
| 599 | |
| 600 ;;; bytecomp-runtime.el ends here |