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