Mercurial > hg > xemacs-beta
annotate lisp/bytecomp-runtime.el @ 5276:dd2976af8783
Add some missing #includes, termcap.c, hopefully fixing Adam Sjoegren's build.
2010-09-18 Aidan Kehoe <kehoea@parhasard.net>
* termcap.c:
Add a couple of missing includes here, which should fix builds
that use this file. (I have no access to such builds, but Mats'
buildbot shows output that indicates they fail at link time since
DEVICE_BAUD_RATE and IS_DIRECTORY_SEP are available.)
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 18 Sep 2010 15:03:54 +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 |