Mercurial > emacs
comparison lisp/emacs-lisp/bytecomp.el @ 85730:a1e136978a9a
(byte-compile-warnings): Document `not'.
(byte-compile-warnings-safe-p): Handle `not'.
(byte-compile-warning-enabled-p, byte-compile-disable-warning)
(byte-compile-enable-warning): New functions.
(byte-compile-eval-before-compile)
(byte-compile-file-form-require): Use byte-compile-disable-warning.
(byte-compile-close-variables): Locally bind byte-compile-warnings,
but do not modify it.
(byte-compile-eval, byte-compile-obsolete)
(byte-compile-warn-about-unresolved-functions)
(byte-compile-file-form-defvar)
(byte-compile-file-form-custom-declare-variable)
(byte-compile-file-form-require)
(byte-compile-file-form-defmumble, byte-compile-lambda)
(byte-compile-form, byte-compile-normal-call)
(byte-compile-variable-ref, byte-compile-defvar)
(byte-compile-make-variable-buffer-local):
Use byte-compile-warning-enabled-p.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sun, 28 Oct 2007 23:52:50 +0000 |
parents | 13b5281d0188 |
children | 1b8904c5babf |
comparison
equal
deleted
inserted
replaced
85729:bd2837f89a3b | 85730:a1e136978a9a |
---|---|
360 cl-functions calls to runtime functions from the CL package (as | 360 cl-functions calls to runtime functions from the CL package (as |
361 distinguished from macros and aliases). | 361 distinguished from macros and aliases). |
362 interactive-only | 362 interactive-only |
363 commands that normally shouldn't be called from Lisp code. | 363 commands that normally shouldn't be called from Lisp code. |
364 make-local calls to make-variable-buffer-local that may be incorrect. | 364 make-local calls to make-variable-buffer-local that may be incorrect. |
365 mapcar mapcar called for effect." | 365 mapcar mapcar called for effect. |
366 | |
367 If the list begins with `not', then the remaining elements specify warnings to | |
368 suppress. For example, (not mapcar) will suppress warnings about mapcar." | |
366 :group 'bytecomp | 369 :group 'bytecomp |
367 :type `(choice (const :tag "All" t) | 370 :type `(choice (const :tag "All" t) |
368 (set :menu-tag "Some" | 371 (set :menu-tag "Some" |
369 (const free-vars) (const unresolved) | 372 (const free-vars) (const unresolved) |
370 (const callargs) (const redefine) | 373 (const callargs) (const redefine) |
375 | 378 |
376 ;;;###autoload | 379 ;;;###autoload |
377 (defun byte-compile-warnings-safe-p (x) | 380 (defun byte-compile-warnings-safe-p (x) |
378 (or (booleanp x) | 381 (or (booleanp x) |
379 (and (listp x) | 382 (and (listp x) |
383 (if (eq (car x) 'not) (setq x (cdr x)) | |
384 t) | |
380 (equal (mapcar | 385 (equal (mapcar |
381 (lambda (e) | 386 (lambda (e) |
382 (when (memq e '(free-vars unresolved | 387 (when (memq e '(free-vars unresolved |
383 callargs redefine | 388 callargs redefine |
384 obsolete noruntime | 389 obsolete noruntime |
385 cl-functions interactive-only | 390 cl-functions interactive-only |
386 make-local mapcar)) | 391 make-local mapcar)) |
387 e)) | 392 e)) |
388 x) | 393 x) |
389 x)))) | 394 x)))) |
395 | |
396 (defun byte-compile-warning-enabled-p (warning) | |
397 "Return non-nil if WARNING is enabled, according to `byte-compile-warnings'." | |
398 (or (eq byte-compile-warnings t) | |
399 (if (eq (car byte-compile-warnings) 'not) | |
400 (not (memq warning byte-compile-warnings)) | |
401 (memq warning byte-compile-warnings)))) | |
402 | |
403 ;;;###autoload | |
404 (defun byte-compile-disable-warning (warning) | |
405 "Change `byte-compile-warnings' to disable WARNING. | |
406 If `byte-compile-warnings' is t, set it to `(not WARNING)'. | |
407 Otherwise, if the first element is `not', add WARNING, else remove it." | |
408 (setq byte-compile-warnings | |
409 (cond ((eq byte-compile-warnings t) | |
410 (list 'not warning)) | |
411 ((eq (car byte-compile-warnings) 'not) | |
412 (if (memq warning byte-compile-warnings) | |
413 byte-compile-warnings | |
414 (append byte-compile-warnings (list warning)))) | |
415 (t | |
416 (delq warning byte-compile-warnings))))) | |
417 | |
418 ;;;###autoload | |
419 (defun byte-compile-enable-warning (warning) | |
420 "Change `byte-compile-warnings' to enable WARNING. | |
421 If `byte-compile-warnings' is `t', do nothing. Otherwise, if the | |
422 first element is `not', remove WARNING, else add it." | |
423 (or (eq byte-compile-warnings t) | |
424 (setq byte-compile-warnings | |
425 (cond ((eq (car byte-compile-warnings) 'not) | |
426 (delq warning byte-compile-warnings)) | |
427 ((memq warning byte-compile-warnings) | |
428 byte-compile-warnings) | |
429 (t | |
430 (append byte-compile-warnings (list warning))))))) | |
390 | 431 |
391 (defvar byte-compile-interactive-only-functions | 432 (defvar byte-compile-interactive-only-functions |
392 '(beginning-of-buffer end-of-buffer replace-string replace-regexp | 433 '(beginning-of-buffer end-of-buffer replace-string replace-regexp |
393 insert-file insert-buffer insert-file-literally previous-line next-line) | 434 insert-file insert-buffer insert-file-literally previous-line next-line) |
394 "List of commands that are not meant to be called from Lisp.") | 435 "List of commands that are not meant to be called from Lisp.") |
828 "Eval FORM and mark the functions defined therein. | 869 "Eval FORM and mark the functions defined therein. |
829 Each function's symbol gets added to `byte-compile-noruntime-functions'." | 870 Each function's symbol gets added to `byte-compile-noruntime-functions'." |
830 (let ((hist-orig load-history) | 871 (let ((hist-orig load-history) |
831 (hist-nil-orig current-load-list)) | 872 (hist-nil-orig current-load-list)) |
832 (prog1 (eval form) | 873 (prog1 (eval form) |
833 (when (memq 'noruntime byte-compile-warnings) | 874 (when (byte-compile-warning-enabled-p 'noruntime) |
834 (let ((hist-new load-history) | 875 (let ((hist-new load-history) |
835 (hist-nil-new current-load-list)) | 876 (hist-nil-new current-load-list)) |
836 ;; Go through load-history, look for newly loaded files | 877 ;; Go through load-history, look for newly loaded files |
837 ;; and mark all the functions defined therein. | 878 ;; and mark all the functions defined therein. |
838 (while (and hist-new (not (eq hist-new hist-orig))) | 879 (while (and hist-new (not (eq hist-new hist-orig))) |
856 (let ((s (pop hist-nil-new))) | 897 (let ((s (pop hist-nil-new))) |
857 (when (and (symbolp s) (not (memq s old-autoloads))) | 898 (when (and (symbolp s) (not (memq s old-autoloads))) |
858 (push s byte-compile-noruntime-functions)) | 899 (push s byte-compile-noruntime-functions)) |
859 (when (and (consp s) (eq t (car s))) | 900 (when (and (consp s) (eq t (car s))) |
860 (push (cdr s) old-autoloads))))))) | 901 (push (cdr s) old-autoloads))))))) |
861 (when (memq 'cl-functions byte-compile-warnings) | 902 (when (byte-compile-warning-enabled-p 'cl-functions) |
862 (let ((hist-new load-history)) | 903 (let ((hist-new load-history)) |
863 ;; Go through load-history, look for newly loaded files | 904 ;; Go through load-history, look for newly loaded files |
864 ;; and mark all the functions defined therein. | 905 ;; and mark all the functions defined therein. |
865 (while (and hist-new (not (eq hist-new hist-orig))) | 906 (while (and hist-new (not (eq hist-new hist-orig))) |
866 (let ((xs (pop hist-new))) | 907 (let ((xs (pop hist-new))) |
874 (prog1 (eval form) | 915 (prog1 (eval form) |
875 ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. | 916 ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. |
876 (let ((tem current-load-list)) | 917 (let ((tem current-load-list)) |
877 (while (not (eq tem hist-nil-orig)) | 918 (while (not (eq tem hist-nil-orig)) |
878 (when (equal (car tem) '(require . cl)) | 919 (when (equal (car tem) '(require . cl)) |
879 (setq byte-compile-warnings | 920 (byte-compile-disable-warning 'cl-functions)) |
880 (remq 'cl-functions byte-compile-warnings))) | |
881 (setq tem (cdr tem))))))) | 921 (setq tem (cdr tem))))))) |
882 | 922 |
883 ;;; byte compiler messages | 923 ;;; byte compiler messages |
884 | 924 |
885 (defvar byte-compile-current-form nil) | 925 (defvar byte-compile-current-form nil) |
1073 (defun byte-compile-obsolete (form) | 1113 (defun byte-compile-obsolete (form) |
1074 (let* ((new (get (car form) 'byte-obsolete-info)) | 1114 (let* ((new (get (car form) 'byte-obsolete-info)) |
1075 (handler (nth 1 new)) | 1115 (handler (nth 1 new)) |
1076 (when (nth 2 new))) | 1116 (when (nth 2 new))) |
1077 (byte-compile-set-symbol-position (car form)) | 1117 (byte-compile-set-symbol-position (car form)) |
1078 (if (memq 'obsolete byte-compile-warnings) | 1118 (if (byte-compile-warning-enabled-p 'obsolete) |
1079 (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form) | 1119 (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form) |
1080 (if when (concat " (as of Emacs " when ")") "") | 1120 (if when (concat " (as of Emacs " when ")") "") |
1081 (if (stringp (car new)) | 1121 (if (stringp (car new)) |
1082 (car new) | 1122 (car new) |
1083 (format "use `%s' instead." (car new))))) | 1123 (format "use `%s' instead." (car new))))) |
1419 | 1459 |
1420 ;; If we have compiled any calls to functions which are not known to be | 1460 ;; If we have compiled any calls to functions which are not known to be |
1421 ;; defined, issue a warning enumerating them. | 1461 ;; defined, issue a warning enumerating them. |
1422 ;; `unresolved' in the list `byte-compile-warnings' disables this. | 1462 ;; `unresolved' in the list `byte-compile-warnings' disables this. |
1423 (defun byte-compile-warn-about-unresolved-functions () | 1463 (defun byte-compile-warn-about-unresolved-functions () |
1424 (when (memq 'unresolved byte-compile-warnings) | 1464 (when (byte-compile-warning-enabled-p 'unresolved) |
1425 (let ((byte-compile-current-form :end) | 1465 (let ((byte-compile-current-form :end) |
1426 (noruntime nil) | 1466 (noruntime nil) |
1427 (unresolved nil)) | 1467 (unresolved nil)) |
1428 ;; Separate the functions that will not be available at runtime | 1468 ;; Separate the functions that will not be available at runtime |
1429 ;; from the truly unresolved ones. | 1469 ;; from the truly unresolved ones. |
1482 (byte-compile-dynamic byte-compile-dynamic) | 1522 (byte-compile-dynamic byte-compile-dynamic) |
1483 (byte-compile-dynamic-docstrings | 1523 (byte-compile-dynamic-docstrings |
1484 byte-compile-dynamic-docstrings) | 1524 byte-compile-dynamic-docstrings) |
1485 ;; (byte-compile-generate-emacs19-bytecodes | 1525 ;; (byte-compile-generate-emacs19-bytecodes |
1486 ;; byte-compile-generate-emacs19-bytecodes) | 1526 ;; byte-compile-generate-emacs19-bytecodes) |
1487 (byte-compile-warnings (if (eq byte-compile-warnings t) | 1527 (byte-compile-warnings byte-compile-warnings) |
1488 byte-compile-warning-types | |
1489 byte-compile-warnings)) | |
1490 ) | 1528 ) |
1491 body))) | 1529 body))) |
1492 | 1530 |
1493 (defmacro displaying-byte-compile-warnings (&rest body) | 1531 (defmacro displaying-byte-compile-warnings (&rest body) |
1494 `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) | 1532 `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) |
1827 ;; This allows us to get the positions of symbols read; it's | 1865 ;; This allows us to get the positions of symbols read; it's |
1828 ;; new in Emacs 22.1. | 1866 ;; new in Emacs 22.1. |
1829 (read-with-symbol-positions inbuffer) | 1867 (read-with-symbol-positions inbuffer) |
1830 (read-symbol-positions-list nil) | 1868 (read-symbol-positions-list nil) |
1831 ;; #### This is bound in b-c-close-variables. | 1869 ;; #### This is bound in b-c-close-variables. |
1832 ;; (byte-compile-warnings (if (eq byte-compile-warnings t) | 1870 ;; (byte-compile-warnings byte-compile-warnings) |
1833 ;; byte-compile-warning-types | |
1834 ;; byte-compile-warnings)) | |
1835 ) | 1871 ) |
1836 (byte-compile-close-variables | 1872 (byte-compile-close-variables |
1837 (with-current-buffer | 1873 (with-current-buffer |
1838 (setq outbuffer (get-buffer-create " *Compiler Output*")) | 1874 (setq outbuffer (get-buffer-create " *Compiler Output*")) |
1839 (set-buffer-multibyte t) | 1875 (set-buffer-multibyte t) |
2208 (defun byte-compile-file-form-defvar (form) | 2244 (defun byte-compile-file-form-defvar (form) |
2209 (if (null (nth 3 form)) | 2245 (if (null (nth 3 form)) |
2210 ;; Since there is no doc string, we can compile this as a normal form, | 2246 ;; Since there is no doc string, we can compile this as a normal form, |
2211 ;; and not do a file-boundary. | 2247 ;; and not do a file-boundary. |
2212 (byte-compile-keep-pending form) | 2248 (byte-compile-keep-pending form) |
2213 (when (memq 'free-vars byte-compile-warnings) | 2249 (when (byte-compile-warning-enabled-p 'free-vars) |
2214 (push (nth 1 form) byte-compile-bound-variables) | 2250 (push (nth 1 form) byte-compile-bound-variables) |
2215 (if (eq (car form) 'defconst) | 2251 (if (eq (car form) 'defconst) |
2216 (push (nth 1 form) byte-compile-const-variables))) | 2252 (push (nth 1 form) byte-compile-const-variables))) |
2217 (cond ((consp (nth 2 form)) | 2253 (cond ((consp (nth 2 form)) |
2218 (setq form (copy-sequence form)) | 2254 (setq form (copy-sequence form)) |
2221 form)) | 2257 form)) |
2222 | 2258 |
2223 (put 'custom-declare-variable 'byte-hunk-handler | 2259 (put 'custom-declare-variable 'byte-hunk-handler |
2224 'byte-compile-file-form-custom-declare-variable) | 2260 'byte-compile-file-form-custom-declare-variable) |
2225 (defun byte-compile-file-form-custom-declare-variable (form) | 2261 (defun byte-compile-file-form-custom-declare-variable (form) |
2226 (when (memq 'callargs byte-compile-warnings) | 2262 (when (byte-compile-warning-enabled-p 'callargs) |
2227 (byte-compile-nogroup-warn form)) | 2263 (byte-compile-nogroup-warn form)) |
2228 (when (memq 'free-vars byte-compile-warnings) | 2264 (when (byte-compile-warning-enabled-p 'free-vars) |
2229 (push (nth 1 (nth 1 form)) byte-compile-bound-variables)) | 2265 (push (nth 1 (nth 1 form)) byte-compile-bound-variables)) |
2230 (let ((tail (nthcdr 4 form))) | 2266 (let ((tail (nthcdr 4 form))) |
2231 (while tail | 2267 (while tail |
2232 ;; If there are any (function (lambda ...)) expressions, compile | 2268 ;; If there are any (function (lambda ...)) expressions, compile |
2233 ;; those functions. | 2269 ;; those functions. |
2246 (defun byte-compile-file-form-require (form) | 2282 (defun byte-compile-file-form-require (form) |
2247 (let ((args (mapcar 'eval (cdr form)))) | 2283 (let ((args (mapcar 'eval (cdr form)))) |
2248 (apply 'require args) | 2284 (apply 'require args) |
2249 ;; Detect (require 'cl) in a way that works even if cl is already loaded. | 2285 ;; Detect (require 'cl) in a way that works even if cl is already loaded. |
2250 (if (member (car args) '("cl" cl)) | 2286 (if (member (car args) '("cl" cl)) |
2251 (setq byte-compile-warnings | 2287 (byte-compile-disable-warning 'cl-functions))) |
2252 (remq 'cl-functions byte-compile-warnings)))) | |
2253 (byte-compile-keep-pending form 'byte-compile-normal-call)) | 2288 (byte-compile-keep-pending form 'byte-compile-normal-call)) |
2254 | 2289 |
2255 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) | 2290 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |
2256 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) | 2291 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) |
2257 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) | 2292 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) |
2293 (or (assq name byte-compile-call-tree) | 2328 (or (assq name byte-compile-call-tree) |
2294 (setq byte-compile-call-tree | 2329 (setq byte-compile-call-tree |
2295 (cons (list name nil nil) byte-compile-call-tree)))) | 2330 (cons (list name nil nil) byte-compile-call-tree)))) |
2296 | 2331 |
2297 (setq byte-compile-current-form name) ; for warnings | 2332 (setq byte-compile-current-form name) ; for warnings |
2298 (if (memq 'redefine byte-compile-warnings) | 2333 (if (byte-compile-warning-enabled-p 'redefine) |
2299 (byte-compile-arglist-warn form macrop)) | 2334 (byte-compile-arglist-warn form macrop)) |
2300 (if byte-compile-verbose | 2335 (if byte-compile-verbose |
2301 (message "Compiling %s... (%s)" (or filename "") (nth 1 form))) | 2336 (message "Compiling %s... (%s)" (or filename "") (nth 1 form))) |
2302 (cond (that-one | 2337 (cond (that-one |
2303 (if (and (memq 'redefine byte-compile-warnings) | 2338 (if (and (byte-compile-warning-enabled-p 'redefine) |
2304 ;; don't warn when compiling the stubs in byte-run... | 2339 ;; don't warn when compiling the stubs in byte-run... |
2305 (not (assq (nth 1 form) | 2340 (not (assq (nth 1 form) |
2306 byte-compile-initial-macro-environment))) | 2341 byte-compile-initial-macro-environment))) |
2307 (byte-compile-warn | 2342 (byte-compile-warn |
2308 "`%s' defined multiple times, as both function and macro" | 2343 "`%s' defined multiple times, as both function and macro" |
2309 (nth 1 form))) | 2344 (nth 1 form))) |
2310 (setcdr that-one nil)) | 2345 (setcdr that-one nil)) |
2311 (this-one | 2346 (this-one |
2312 (when (and (memq 'redefine byte-compile-warnings) | 2347 (when (and (byte-compile-warning-enabled-p 'redefine) |
2313 ;; hack: don't warn when compiling the magic internal | 2348 ;; hack: don't warn when compiling the magic internal |
2314 ;; byte-compiler macros in byte-run.el... | 2349 ;; byte-compiler macros in byte-run.el... |
2315 (not (assq (nth 1 form) | 2350 (not (assq (nth 1 form) |
2316 byte-compile-initial-macro-environment))) | 2351 byte-compile-initial-macro-environment))) |
2317 (byte-compile-warn "%s `%s' defined multiple times in this file" | 2352 (byte-compile-warn "%s `%s' defined multiple times in this file" |
2318 (if macrop "macro" "function") | 2353 (if macrop "macro" "function") |
2319 (nth 1 form)))) | 2354 (nth 1 form)))) |
2320 ((and (fboundp name) | 2355 ((and (fboundp name) |
2321 (eq (car-safe (symbol-function name)) | 2356 (eq (car-safe (symbol-function name)) |
2322 (if macrop 'lambda 'macro))) | 2357 (if macrop 'lambda 'macro))) |
2323 (when (memq 'redefine byte-compile-warnings) | 2358 (when (byte-compile-warning-enabled-p 'redefine) |
2324 (byte-compile-warn "%s `%s' being redefined as a %s" | 2359 (byte-compile-warn "%s `%s' being redefined as a %s" |
2325 (if macrop "function" "macro") | 2360 (if macrop "function" "macro") |
2326 (nth 1 form) | 2361 (nth 1 form) |
2327 (if macrop "macro" "function"))) | 2362 (if macrop "macro" "function"))) |
2328 ;; shadow existing definition | 2363 ;; shadow existing definition |
2558 (error "Not a lambda list: %S" fun)) | 2593 (error "Not a lambda list: %S" fun)) |
2559 (byte-compile-set-symbol-position 'lambda)) | 2594 (byte-compile-set-symbol-position 'lambda)) |
2560 (byte-compile-check-lambda-list (nth 1 fun)) | 2595 (byte-compile-check-lambda-list (nth 1 fun)) |
2561 (let* ((arglist (nth 1 fun)) | 2596 (let* ((arglist (nth 1 fun)) |
2562 (byte-compile-bound-variables | 2597 (byte-compile-bound-variables |
2563 (nconc (and (memq 'free-vars byte-compile-warnings) | 2598 (nconc (and (byte-compile-warning-enabled-p 'free-vars) |
2564 (delq '&rest (delq '&optional (copy-sequence arglist)))) | 2599 (delq '&rest (delq '&optional (copy-sequence arglist)))) |
2565 byte-compile-bound-variables)) | 2600 byte-compile-bound-variables)) |
2566 (body (cdr (cdr fun))) | 2601 (body (cdr (cdr fun))) |
2567 (doc (if (stringp (car body)) | 2602 (doc (if (stringp (car body)) |
2568 (prog1 (car body) | 2603 (prog1 (car body) |
2798 ((symbolp (car form)) | 2833 ((symbolp (car form)) |
2799 (let* ((fn (car form)) | 2834 (let* ((fn (car form)) |
2800 (handler (get fn 'byte-compile))) | 2835 (handler (get fn 'byte-compile))) |
2801 (when (byte-compile-const-symbol-p fn) | 2836 (when (byte-compile-const-symbol-p fn) |
2802 (byte-compile-warn "`%s' called as a function" fn)) | 2837 (byte-compile-warn "`%s' called as a function" fn)) |
2803 (and (memq 'interactive-only byte-compile-warnings) | 2838 (and (byte-compile-warning-enabled-p 'interactive-only) |
2804 (memq fn byte-compile-interactive-only-functions) | 2839 (memq fn byte-compile-interactive-only-functions) |
2805 (byte-compile-warn "`%s' used from Lisp code\n\ | 2840 (byte-compile-warn "`%s' used from Lisp code\n\ |
2806 That command is designed for interactive use only" fn)) | 2841 That command is designed for interactive use only" fn)) |
2807 (if (and handler | 2842 (if (and handler |
2808 ;; Make sure that function exists. This is important | 2843 ;; Make sure that function exists. This is important |
2813 (functionp handler)) | 2848 (functionp handler)) |
2814 (not (and (byte-compile-version-cond | 2849 (not (and (byte-compile-version-cond |
2815 byte-compile-compatibility) | 2850 byte-compile-compatibility) |
2816 (get (get fn 'byte-opcode) 'emacs19-opcode)))) | 2851 (get (get fn 'byte-opcode) 'emacs19-opcode)))) |
2817 (funcall handler form) | 2852 (funcall handler form) |
2818 (when (memq 'callargs byte-compile-warnings) | 2853 (when (byte-compile-warning-enabled-p 'callargs) |
2819 (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face)) | 2854 (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face)) |
2820 (byte-compile-nogroup-warn form)) | 2855 (byte-compile-nogroup-warn form)) |
2821 (byte-compile-callargs-warn form)) | 2856 (byte-compile-callargs-warn form)) |
2822 (byte-compile-normal-call form)) | 2857 (byte-compile-normal-call form)) |
2823 (if (memq 'cl-functions byte-compile-warnings) | 2858 (if (byte-compile-warning-enabled-p 'cl-functions) |
2824 (byte-compile-cl-warn form)))) | 2859 (byte-compile-cl-warn form)))) |
2825 ((and (or (byte-code-function-p (car form)) | 2860 ((and (or (byte-code-function-p (car form)) |
2826 (eq (car-safe (car form)) 'lambda)) | 2861 (eq (car-safe (car form)) 'lambda)) |
2827 ;; if the form comes out the same way it went in, that's | 2862 ;; if the form comes out the same way it went in, that's |
2828 ;; because it was malformed, and we couldn't unfold it. | 2863 ;; because it was malformed, and we couldn't unfold it. |
2835 | 2870 |
2836 (defun byte-compile-normal-call (form) | 2871 (defun byte-compile-normal-call (form) |
2837 (if byte-compile-generate-call-tree | 2872 (if byte-compile-generate-call-tree |
2838 (byte-compile-annotate-call-tree form)) | 2873 (byte-compile-annotate-call-tree form)) |
2839 (when (and for-effect (eq (car form) 'mapcar) | 2874 (when (and for-effect (eq (car form) 'mapcar) |
2840 (memq 'mapcar byte-compile-warnings)) | 2875 (byte-compile-warning-enabled-p 'mapcar)) |
2841 (byte-compile-set-symbol-position 'mapcar) | 2876 (byte-compile-set-symbol-position 'mapcar) |
2842 (byte-compile-warn | 2877 (byte-compile-warn |
2843 "`mapcar' called for effect; use `mapc' or `dolist' instead")) | 2878 "`mapcar' called for effect; use `mapc' or `dolist' instead")) |
2844 (byte-compile-push-constant (car form)) | 2879 (byte-compile-push-constant (car form)) |
2845 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. | 2880 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. |
2855 ((eq base-op 'byte-varset) "variable assignment to %s `%s'") | 2890 ((eq base-op 'byte-varset) "variable assignment to %s `%s'") |
2856 (t "variable reference to %s `%s'")) | 2891 (t "variable reference to %s `%s'")) |
2857 (if (symbolp var) "constant" "nonvariable") | 2892 (if (symbolp var) "constant" "nonvariable") |
2858 (prin1-to-string var)) | 2893 (prin1-to-string var)) |
2859 (if (and (get var 'byte-obsolete-variable) | 2894 (if (and (get var 'byte-obsolete-variable) |
2860 (memq 'obsolete byte-compile-warnings) | 2895 (byte-compile-warning-enabled-p 'obsolete) |
2861 (not (eq var byte-compile-not-obsolete-var))) | 2896 (not (eq var byte-compile-not-obsolete-var))) |
2862 (let* ((ob (get var 'byte-obsolete-variable)) | 2897 (let* ((ob (get var 'byte-obsolete-variable)) |
2863 (when (cdr ob))) | 2898 (when (cdr ob))) |
2864 (byte-compile-warn "`%s' is an obsolete variable%s; %s" var | 2899 (byte-compile-warn "`%s' is an obsolete variable%s; %s" var |
2865 (if when (concat " (as of Emacs " when ")") "") | 2900 (if when (concat " (as of Emacs " when ")") "") |
2866 (if (stringp (car ob)) | 2901 (if (stringp (car ob)) |
2867 (car ob) | 2902 (car ob) |
2868 (format "use `%s' instead." (car ob)))))) | 2903 (format "use `%s' instead." (car ob)))))) |
2869 (if (memq 'free-vars byte-compile-warnings) | 2904 (if (byte-compile-warning-enabled-p 'free-vars) |
2870 (if (eq base-op 'byte-varbind) | 2905 (if (eq base-op 'byte-varbind) |
2871 (push var byte-compile-bound-variables) | 2906 (push var byte-compile-bound-variables) |
2872 (or (boundp var) | 2907 (or (boundp var) |
2873 (memq var byte-compile-bound-variables) | 2908 (memq var byte-compile-bound-variables) |
2874 (if (eq base-op 'byte-varset) | 2909 (if (eq base-op 'byte-varset) |
3805 "`%s' called with %d argument%s, but %s %s" | 3840 "`%s' called with %d argument%s, but %s %s" |
3806 fun ncall | 3841 fun ncall |
3807 (if (= 1 ncall) "" "s") | 3842 (if (= 1 ncall) "" "s") |
3808 (if (< ncall 2) "requires" "accepts only") | 3843 (if (< ncall 2) "requires" "accepts only") |
3809 "2-3"))) | 3844 "2-3"))) |
3810 (when (memq 'free-vars byte-compile-warnings) | 3845 (when (byte-compile-warning-enabled-p 'free-vars) |
3811 (push var byte-compile-bound-variables) | 3846 (push var byte-compile-bound-variables) |
3812 (if (eq fun 'defconst) | 3847 (if (eq fun 'defconst) |
3813 (push var byte-compile-const-variables))) | 3848 (push var byte-compile-const-variables))) |
3814 (byte-compile-body-do-effect | 3849 (byte-compile-body-do-effect |
3815 (list | 3850 (list |
3897 | 3932 |
3898 ;; Warn about misuses of make-variable-buffer-local. | 3933 ;; Warn about misuses of make-variable-buffer-local. |
3899 (byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local) | 3934 (byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local) |
3900 (defun byte-compile-make-variable-buffer-local (form) | 3935 (defun byte-compile-make-variable-buffer-local (form) |
3901 (if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote) | 3936 (if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote) |
3902 (memq 'make-local byte-compile-warnings)) | 3937 (byte-compile-warning-enabled-p 'make-local)) |
3903 (byte-compile-warn | 3938 (byte-compile-warn |
3904 "`make-variable-buffer-local' should be called at toplevel")) | 3939 "`make-variable-buffer-local' should be called at toplevel")) |
3905 (byte-compile-normal-call form)) | 3940 (byte-compile-normal-call form)) |
3906 (put 'make-variable-buffer-local | 3941 (put 'make-variable-buffer-local |
3907 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) | 3942 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) |