1 |
;;; bytecomp.el --- compilation of Lisp code into byte code |
;;; bytecomp.el --- compilation of Lisp code into byte code |
2 |
|
|
3 |
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002 |
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, 2003 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Jamie Zawinski <jwz@lucid.com> |
;; Author: Jamie Zawinski <jwz@lucid.com> |
91 |
;; finding unused functions, as well as simple |
;; finding unused functions, as well as simple |
92 |
;; performance metering. |
;; performance metering. |
93 |
;; byte-compile-warnings List of warnings to issue, or t. May contain |
;; byte-compile-warnings List of warnings to issue, or t. May contain |
94 |
;; 'free-vars (references to variables not in the |
;; `free-vars' (references to variables not in the |
95 |
;; current lexical scope) |
;; current lexical scope) |
96 |
;; 'unresolved (calls to unknown functions) |
;; `unresolved' (calls to unknown functions) |
97 |
;; 'callargs (lambda calls with args that don't |
;; `callargs' (lambda calls with args that don't |
98 |
;; match the lambda's definition) |
;; match the lambda's definition) |
99 |
;; 'redefine (function cell redefined from |
;; `redefine' (function cell redefined from |
100 |
;; a macro to a lambda or vice versa, |
;; a macro to a lambda or vice versa, |
101 |
;; or redefined to take other args) |
;; or redefined to take other args) |
102 |
;; 'obsolete (obsolete variables and functions) |
;; `obsolete' (obsolete variables and functions) |
103 |
;; 'noruntime (calls to functions only defined |
;; `noruntime' (calls to functions only defined |
104 |
;; within `eval-when-compile') |
;; within `eval-when-compile') |
105 |
;; byte-compile-compatibility Whether the compiler should |
;; byte-compile-compatibility Whether the compiler should |
106 |
;; generate .elc files which can be loaded into |
;; generate .elc files which can be loaded into |
107 |
;; generic emacs 18. |
;; generic emacs 18. |
285 |
(const :tag "source-level" source) |
(const :tag "source-level" source) |
286 |
(const :tag "byte-level" byte))) |
(const :tag "byte-level" byte))) |
287 |
|
|
288 |
(defcustom byte-compile-delete-errors t |
(defcustom byte-compile-delete-errors nil |
289 |
"*If non-nil, the optimizer may delete forms that may signal an error. |
"*If non-nil, the optimizer may delete forms that may signal an error. |
290 |
This includes variable references and calls to functions such as `car'." |
This includes variable references and calls to functions such as `car'." |
291 |
:group 'bytecomp |
:group 'bytecomp |
338 |
:type 'boolean) |
:type 'boolean) |
339 |
|
|
340 |
(defconst byte-compile-warning-types |
(defconst byte-compile-warning-types |
341 |
'(redefine callargs free-vars unresolved obsolete noruntime)) |
'(redefine callargs free-vars unresolved obsolete noruntime cl-functions) |
342 |
|
"The list of warning types used when `byte-compile-warnings' is t.") |
343 |
(defcustom byte-compile-warnings t |
(defcustom byte-compile-warnings t |
344 |
"*List of warnings that the byte-compiler should issue (t for all). |
"*List of warnings that the byte-compiler should issue (t for all). |
345 |
|
|
346 |
Elements of the list may be be: |
Elements of the list may be be: |
347 |
|
|
348 |
free-vars references to variables not in the current lexical scope. |
free-vars references to variables not in the current lexical scope. |
350 |
callargs lambda calls with args that don't match the definition. |
callargs lambda calls with args that don't match the definition. |
351 |
redefine function cell redefined from a macro to a lambda or vice |
redefine function cell redefined from a macro to a lambda or vice |
352 |
versa, or redefined to take a different number of arguments. |
versa, or redefined to take a different number of arguments. |
353 |
obsolete obsolete variables and functions." |
obsolete obsolete variables and functions. |
354 |
|
noruntime functions that may not be defined at runtime (typically |
355 |
|
defined only under `eval-when-compile'). |
356 |
|
cl-functions calls to runtime functions from the CL package (as |
357 |
|
distinguished from macros and aliases)." |
358 |
:group 'bytecomp |
:group 'bytecomp |
359 |
:type '(choice (const :tag "All" t) |
:type `(choice (const :tag "All" t) |
360 |
(set :menu-tag "Some" |
(set :menu-tag "Some" |
361 |
(const free-vars) (const unresolved) |
(const free-vars) (const unresolved) |
362 |
(const callargs) (const redefined) |
(const callargs) (const redefine) |
363 |
(const obsolete) (const noruntime)))) |
(const obsolete) (const noruntime) (const cl-functions)))) |
364 |
|
|
365 |
(defcustom byte-compile-generate-call-tree nil |
(defcustom byte-compile-generate-call-tree nil |
366 |
"*Non-nil means collect call-graph information when compiling. |
"*Non-nil means collect call-graph information when compiling. |
433 |
(cons 'progn body) |
(cons 'progn body) |
434 |
byte-compile-initial-macro-environment)))))) |
byte-compile-initial-macro-environment)))))) |
435 |
(eval-and-compile . (lambda (&rest body) |
(eval-and-compile . (lambda (&rest body) |
436 |
(eval (cons 'progn body)) |
(byte-compile-eval-before-compile (cons 'progn body)) |
437 |
(cons 'progn body)))) |
(cons 'progn body)))) |
438 |
"The default macro-environment passed to macroexpand by the compiler. |
"The default macro-environment passed to macroexpand by the compiler. |
439 |
Placing a macro here will cause a macro to have different semantics when |
Placing a macro here will cause a macro to have different semantics when |
858 |
;; Go through load-history, look for newly loaded files |
;; Go through load-history, look for newly loaded files |
859 |
;; and mark all the functions defined therein. |
;; and mark all the functions defined therein. |
860 |
(while (and hist-new (not (eq hist-new hist-orig))) |
(while (and hist-new (not (eq hist-new hist-orig))) |
861 |
(let ((xs (pop hist-new))) |
(let ((xs (pop hist-new)) |
862 |
|
old-autoloads) |
863 |
;; Make sure the file was not already loaded before. |
;; Make sure the file was not already loaded before. |
864 |
(unless (assoc (car xs) hist-orig) |
(unless (assoc (car xs) hist-orig) |
865 |
(dolist (s xs) |
(dolist (s xs) |
866 |
(cond |
(cond |
867 |
((symbolp s) (put s 'byte-compile-noruntime t)) |
((symbolp s) |
868 |
|
(unless (memq s old-autoloads) |
869 |
|
(put s 'byte-compile-noruntime t))) |
870 |
|
((and (consp s) (eq t (car s))) |
871 |
|
(push s old-autoloads)) |
872 |
((and (consp s) (eq 'autoload (car s))) |
((and (consp s) (eq 'autoload (car s))) |
873 |
(put (cdr s) 'byte-compile-noruntime t))))))) |
(put (cdr s) 'byte-compile-noruntime t))))))) |
874 |
;; Go through current-load-list for the locally defined funs. |
;; Go through current-load-list for the locally defined funs. |
875 |
(while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) |
(let (old-autoloads) |
876 |
(let ((s (pop hist-nil-new))) |
(while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) |
877 |
(when (symbolp s) |
(let ((s (pop hist-nil-new))) |
878 |
(put s 'byte-compile-noruntime t))))))))) |
(when (and (symbolp s) (not (memq s old-autoloads))) |
879 |
|
(put s 'byte-compile-noruntime t)) |
880 |
|
(when (and (consp s) (eq t (car s))) |
881 |
|
(push s old-autoloads)))))))))) |
882 |
|
|
883 |
|
(defun byte-compile-eval-before-compile (form) |
884 |
|
"Evaluate FORM for `eval-and-compile'." |
885 |
|
(let ((hist-nil-orig current-load-list)) |
886 |
|
(prog1 (eval form) |
887 |
|
;; (eval-and-compile (require 'cl) turns off warnings for cl functions. |
888 |
|
(let ((tem current-load-list)) |
889 |
|
(while (not (eq tem hist-nil-orig)) |
890 |
|
(when (equal (car tem) '(require . cl)) |
891 |
|
(setq byte-compile-warnings |
892 |
|
(remq 'cl-functions byte-compile-warnings))) |
893 |
|
(setq tem (cdr tem))))))) |
894 |
|
|
895 |
;;; byte compiler messages |
;;; byte compiler messages |
896 |
|
|
899 |
(defvar byte-compile-current-file nil) |
(defvar byte-compile-current-file nil) |
900 |
(defvar byte-compile-current-buffer nil) |
(defvar byte-compile-current-buffer nil) |
901 |
|
|
902 |
|
;; Log something that isn't a warning. |
903 |
(defmacro byte-compile-log (format-string &rest args) |
(defmacro byte-compile-log (format-string &rest args) |
904 |
(list 'and |
(list 'and |
905 |
'byte-optimize |
'byte-optimize |
915 |
(if (symbolp x) (list 'prin1-to-string x) x)) |
(if (symbolp x) (list 'prin1-to-string x) x)) |
916 |
args))))))) |
args))))))) |
917 |
|
|
918 |
(defvar byte-compile-last-warned-form nil) |
;; Log something that isn't a warning. |
919 |
(defvar byte-compile-last-logged-file nil) |
(defun byte-compile-log-1 (string) |
920 |
|
(save-excursion |
921 |
|
(byte-goto-log-buffer) |
922 |
|
(goto-char (point-max)) |
923 |
|
(byte-compile-warning-prefix nil nil) |
924 |
|
(cond (noninteractive |
925 |
|
(message " %s" string)) |
926 |
|
(t |
927 |
|
(insert (format "%s\n" string)))))) |
928 |
|
|
929 |
(defvar byte-compile-read-position nil |
(defvar byte-compile-read-position nil |
930 |
"Character position we began the last `read' from.") |
"Character position we began the last `read' from.") |
932 |
"Last known character position in the input.") |
"Last known character position in the input.") |
933 |
|
|
934 |
;; copied from gnus-util.el |
;; copied from gnus-util.el |
935 |
(defun byte-compile-delete-first (elt list) |
(defsubst byte-compile-delete-first (elt list) |
936 |
(if (eq (car list) elt) |
(if (eq (car list) elt) |
937 |
(cdr list) |
(cdr list) |
938 |
(let ((total list)) |
(let ((total list)) |
951 |
;; variable reference, like in (1+ foo), we remove `foo' from the |
;; variable reference, like in (1+ foo), we remove `foo' from the |
952 |
;; list. If our current position is after the symbol's position, we |
;; list. If our current position is after the symbol's position, we |
953 |
;; assume we've already passed that point, and look for the next |
;; assume we've already passed that point, and look for the next |
954 |
;; occurence of the symbol. |
;; occurrence of the symbol. |
955 |
;; So your're probably asking yourself: Isn't this function a |
;; So your're probably asking yourself: Isn't this function a |
956 |
;; gross hack? And the answer, of course, would be yes. |
;; gross hack? And the answer, of course, would be yes. |
957 |
(defun byte-compile-set-symbol-position (sym &optional allow-previous) |
(defun byte-compile-set-symbol-position (sym &optional allow-previous) |
958 |
(when byte-compile-read-position |
(when byte-compile-read-position |
959 |
(let ((last nil)) |
(let (last entry) |
960 |
(while (progn |
(while (progn |
961 |
(setq last byte-compile-last-position) |
(setq last byte-compile-last-position |
962 |
(let* ((entry (assq sym read-symbol-positions-list)) |
entry (assq sym read-symbol-positions-list)) |
963 |
(cur (cdr entry))) |
(when entry |
964 |
(setq byte-compile-last-position |
(setq byte-compile-last-position |
965 |
(if cur |
(+ byte-compile-read-position (cdr entry)) |
966 |
(+ byte-compile-read-position cur) |
read-symbol-positions-list |
967 |
last)) |
(byte-compile-delete-first |
968 |
(setq |
entry read-symbol-positions-list))) |
|
read-symbol-positions-list |
|
|
(byte-compile-delete-first entry read-symbol-positions-list))) |
|
969 |
(or (and allow-previous (not (= last byte-compile-last-position))) |
(or (and allow-previous (not (= last byte-compile-last-position))) |
970 |
(> last byte-compile-last-position))))))) |
(> last byte-compile-last-position))))))) |
971 |
|
|
972 |
(defun byte-compile-display-log-head-p () |
(defvar byte-compile-last-warned-form nil) |
973 |
(and (not (eq byte-compile-current-form :end)) |
(defvar byte-compile-last-logged-file nil) |
|
(or (and byte-compile-current-file |
|
|
(not (equal byte-compile-current-file |
|
|
byte-compile-last-logged-file))) |
|
|
(and byte-compile-last-warned-form |
|
|
(not (eq byte-compile-current-form |
|
|
byte-compile-last-warned-form)))))) |
|
974 |
|
|
975 |
(defun byte-goto-log-buffer () |
(defun byte-goto-log-buffer () |
976 |
(set-buffer (get-buffer-create "*Compile-Log*")) |
(set-buffer (get-buffer-create "*Compile-Log*")) |
977 |
(unless (eq major-mode 'compilation-mode) |
(unless (eq major-mode 'compilation-mode) |
978 |
(compilation-mode))) |
(compilation-mode))) |
979 |
|
|
980 |
;; Log a message STRING in *Compile-Log*. |
;; This is used as warning-prefix for the compiler. |
981 |
;; Also log the current function and file if not already done. |
;; It is always called with the warnings buffer current. |
982 |
(defun byte-compile-log-1 (string &optional fill) |
(defun byte-compile-warning-prefix (level entry) |
983 |
(let* ((file (cond ((stringp byte-compile-current-file) |
(let* ((dir default-directory) |
984 |
(format "%s:" byte-compile-current-file)) |
(file (cond ((stringp byte-compile-current-file) |
985 |
|
(format "%s:" (file-relative-name byte-compile-current-file dir))) |
986 |
((bufferp byte-compile-current-file) |
((bufferp byte-compile-current-file) |
987 |
(format "Buffer %s:" |
(format "Buffer %s:" |
988 |
(buffer-name byte-compile-current-file))) |
(buffer-name byte-compile-current-file))) |
996 |
(goto-char byte-compile-last-position) |
(goto-char byte-compile-last-position) |
997 |
(1+ (current-column))))) |
(1+ (current-column))))) |
998 |
"")) |
"")) |
999 |
(form (or byte-compile-current-form "toplevel form"))) |
(form (if (eq byte-compile-current-form :end) "end of data" |
1000 |
(cond (noninteractive |
(or byte-compile-current-form "toplevel form")))) |
1001 |
(when (byte-compile-display-log-head-p) |
(when (or (and byte-compile-current-file |
1002 |
(message "%s In %s" file form)) |
(not (equal byte-compile-current-file |
1003 |
(message "%s%s %s" file pos string)) |
byte-compile-last-logged-file))) |
1004 |
(t |
(and byte-compile-last-warned-form |
1005 |
(save-excursion |
(not (eq byte-compile-current-form |
1006 |
(byte-goto-log-buffer) |
byte-compile-last-warned-form)))) |
1007 |
(goto-char (point-max)) |
(insert (format "\nIn %s:\n" form))) |
1008 |
(when (byte-compile-display-log-head-p) |
(when level |
1009 |
(insert (format "\nIn %s" form))) |
(insert (format "%s%s" file pos)))) |
|
(insert (format "\n%s%s\n%s\n" file pos string)) |
|
|
(when (and fill (not (string-match "\n" string))) |
|
|
(let ((fill-prefix " ") (fill-column 78)) |
|
|
(fill-paragraph nil))))))) |
|
1010 |
(setq byte-compile-last-logged-file byte-compile-current-file |
(setq byte-compile-last-logged-file byte-compile-current-file |
1011 |
byte-compile-last-warned-form byte-compile-current-form)) |
byte-compile-last-warned-form byte-compile-current-form) |
1012 |
|
entry) |
1013 |
|
|
1014 |
|
;; This no-op function is used as the value of warning-series |
1015 |
|
;; to tell inner calls to displaying-byte-compile-warnings |
1016 |
|
;; not to bind warning-series. |
1017 |
|
(defun byte-compile-warning-series (&rest ignore) |
1018 |
|
nil) |
1019 |
|
|
1020 |
;; Log the start of a file in *Compile-Log*, and mark it as done. |
;; Log the start of a file in *Compile-Log*, and mark it as done. |
1021 |
|
;; Return the position of the start of the page in the log buffer. |
1022 |
;; But do nothing in batch mode. |
;; But do nothing in batch mode. |
1023 |
(defun byte-compile-log-file () |
(defun byte-compile-log-file () |
1024 |
(and byte-compile-current-file |
(and (not (equal byte-compile-current-file byte-compile-last-logged-file)) |
|
(not (equal byte-compile-current-file byte-compile-last-logged-file)) |
|
1025 |
(not noninteractive) |
(not noninteractive) |
1026 |
(save-excursion |
(save-excursion |
1027 |
(byte-goto-log-buffer) |
(byte-goto-log-buffer) |
1028 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1029 |
(insert "\n\^L\nCompiling " |
(let* ((dir (and byte-compile-current-file |
1030 |
(if (stringp byte-compile-current-file) |
(file-name-directory byte-compile-current-file))) |
1031 |
(concat "file " byte-compile-current-file) |
(was-same (equal default-directory dir)) |
1032 |
(concat "buffer " (buffer-name byte-compile-current-file))) |
pt) |
1033 |
" at " (current-time-string) "\n") |
(when dir |
1034 |
(setq byte-compile-last-logged-file byte-compile-current-file)))) |
(unless was-same |
1035 |
|
(insert (format "Leaving directory `%s'\n" default-directory)))) |
1036 |
|
(unless (bolp) |
1037 |
|
(insert "\n")) |
1038 |
|
(setq pt (point-marker)) |
1039 |
|
(if byte-compile-current-file |
1040 |
|
(insert "\f\nCompiling " |
1041 |
|
(if (stringp byte-compile-current-file) |
1042 |
|
(concat "file " byte-compile-current-file) |
1043 |
|
(concat "buffer " (buffer-name byte-compile-current-file))) |
1044 |
|
" at " (current-time-string) "\n") |
1045 |
|
(insert "\f\nCompiling no file at " (current-time-string) "\n")) |
1046 |
|
(when dir |
1047 |
|
(setq default-directory dir) |
1048 |
|
(unless was-same |
1049 |
|
(insert (format "Entering directory `%s'\n" default-directory)))) |
1050 |
|
(setq byte-compile-last-logged-file byte-compile-current-file) |
1051 |
|
pt)))) |
1052 |
|
|
1053 |
|
;; Log a message STRING in *Compile-Log*. |
1054 |
|
;; Also log the current function and file if not already done. |
1055 |
|
(defun byte-compile-log-warning (string &optional fill level) |
1056 |
|
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
1057 |
|
(warning-group-format "") |
1058 |
|
(warning-fill-prefix (if fill " "))) |
1059 |
|
(display-warning 'bytecomp string level "*Compile-Log*"))) |
1060 |
|
|
1061 |
(defun byte-compile-warn (format &rest args) |
(defun byte-compile-warn (format &rest args) |
1062 |
|
"Issue a byte compiler warning; use (format FORMAT ARGS...) for message." |
1063 |
(setq format (apply 'format format args)) |
(setq format (apply 'format format args)) |
1064 |
(if byte-compile-error-on-warn |
(if byte-compile-error-on-warn |
1065 |
(error "%s" format) ; byte-compile-file catches and logs it |
(error "%s" format) ; byte-compile-file catches and logs it |
1066 |
(byte-compile-log-1 (concat "warning: " format) t) |
(byte-compile-log-warning format t :warning))) |
|
;; It is useless to flash warnings too fast to be read. |
|
|
;; Besides, they will all be shown at the end. |
|
|
;; (or noninteractive ; already written on stdout. |
|
|
;; (message "Warning: %s" format)) |
|
|
)) |
|
1067 |
|
|
|
;;; This function should be used to report errors that have halted |
|
|
;;; compilation of the current file. |
|
1068 |
(defun byte-compile-report-error (error-info) |
(defun byte-compile-report-error (error-info) |
1069 |
|
"Report Lisp error in compilation. ERROR-INFO is the error data." |
1070 |
(setq byte-compiler-error-flag t) |
(setq byte-compiler-error-flag t) |
1071 |
(byte-compile-log-1 |
(byte-compile-log-warning |
1072 |
(concat "error: " |
(error-message-string error-info) |
1073 |
(format (if (cdr error-info) "%s (%s)" "%s") |
nil :error)) |
|
(downcase (get (car error-info) 'error-message)) |
|
|
(prin1-to-string (cdr error-info)))))) |
|
1074 |
|
|
1075 |
;;; Used by make-obsolete. |
;;; Used by make-obsolete. |
1076 |
(defun byte-compile-obsolete (form) |
(defun byte-compile-obsolete (form) |
1237 |
(if (< ncall (car sig)) |
(if (< ncall (car sig)) |
1238 |
"requires" |
"requires" |
1239 |
"accepts only") |
"accepts only") |
1240 |
(byte-compile-arglist-signature-string sig))) |
(byte-compile-arglist-signature-string sig)))) |
1241 |
(or (and (fboundp (car form)) ; might be a subr or autoload. |
;; Check to see if the function will be available at runtime |
1242 |
(not (get (car form) 'byte-compile-noruntime))) |
;; and/or remember its arity if it's unknown. |
1243 |
(eq (car form) byte-compile-current-form) ; ## this doesn't work |
(or (and (or sig (fboundp (car form))) ; might be a subr or autoload. |
1244 |
; with recursion. |
(not (get (car form) 'byte-compile-noruntime))) |
1245 |
;; It's a currently-undefined function. |
(eq (car form) byte-compile-current-form) ; ## this doesn't work |
1246 |
;; Remember number of args in call. |
; with recursion. |
1247 |
(let ((cons (assq (car form) byte-compile-unresolved-functions)) |
;; It's a currently-undefined function. |
1248 |
(n (length (cdr form)))) |
;; Remember number of args in call. |
1249 |
(if cons |
(let ((cons (assq (car form) byte-compile-unresolved-functions)) |
1250 |
(or (memq n (cdr cons)) |
(n (length (cdr form)))) |
1251 |
(setcdr cons (cons n (cdr cons)))) |
(if cons |
1252 |
(setq byte-compile-unresolved-functions |
(or (memq n (cdr cons)) |
1253 |
(cons (list (car form) n) |
(setcdr cons (cons n (cdr cons)))) |
1254 |
byte-compile-unresolved-functions)))))))) |
(setq byte-compile-unresolved-functions |
1255 |
|
(cons (list (car form) n) |
1256 |
|
byte-compile-unresolved-functions))))))) |
1257 |
|
|
1258 |
;; Warn if the function or macro is being redefined with a different |
;; Warn if the function or macro is being redefined with a different |
1259 |
;; number of arguments. |
;; number of arguments. |
1299 |
(delq calls byte-compile-unresolved-functions))))) |
(delq calls byte-compile-unresolved-functions))))) |
1300 |
))) |
))) |
1301 |
|
|
1302 |
|
(defvar byte-compile-cl-functions nil |
1303 |
|
"List of functions defined in CL.") |
1304 |
|
|
1305 |
|
(defun byte-compile-find-cl-functions () |
1306 |
|
(unless byte-compile-cl-functions |
1307 |
|
(dolist (elt load-history) |
1308 |
|
(when (and (stringp (car elt)) |
1309 |
|
(string-match "^cl\\>" (car elt))) |
1310 |
|
(setq byte-compile-cl-functions |
1311 |
|
(append byte-compile-cl-functions |
1312 |
|
(cdr elt))))) |
1313 |
|
(let ((tail byte-compile-cl-functions)) |
1314 |
|
(while tail |
1315 |
|
(if (and (consp (car tail)) |
1316 |
|
(eq (car (car tail)) 'autoload)) |
1317 |
|
(setcar tail (cdr (car tail)))) |
1318 |
|
(setq tail (cdr tail)))))) |
1319 |
|
|
1320 |
|
(defun byte-compile-cl-warn (form) |
1321 |
|
"Warn if FORM is a call of a function from the CL package." |
1322 |
|
(let ((func (car-safe form))) |
1323 |
|
(if (and byte-compile-cl-functions |
1324 |
|
(memq func byte-compile-cl-functions) |
1325 |
|
;; Aliases which won't have been expended at this point. |
1326 |
|
;; These aren't all aliases of subrs, so not trivial to |
1327 |
|
;; avoid hardwiring the list. |
1328 |
|
(not (memq func |
1329 |
|
'(cl-block-wrapper cl-block-throw |
1330 |
|
multiple-value-call nth-value |
1331 |
|
copy-seq first second rest endp cl-member |
1332 |
|
;; These are included in generated code |
1333 |
|
;; that can't be called except at compile time |
1334 |
|
;; or unless cl is loaded anyway. |
1335 |
|
cl-defsubst-expand cl-struct-setf-expander |
1336 |
|
;; These would sometimes be warned about |
1337 |
|
;; but such warnings are never useful, |
1338 |
|
;; so don't warn about them. |
1339 |
|
macroexpand cl-macroexpand-all cl-compiling-file)))) |
1340 |
|
(byte-compile-warn "Function `%s' from cl package called at runtime" |
1341 |
|
func))) |
1342 |
|
form) |
1343 |
|
|
1344 |
(defun byte-compile-print-syms (str1 strn syms) |
(defun byte-compile-print-syms (str1 strn syms) |
1345 |
(when syms |
(when syms |
1346 |
(byte-compile-set-symbol-position (car syms) t)) |
(byte-compile-set-symbol-position (car syms) t)) |
1432 |
) |
) |
1433 |
body))) |
body))) |
1434 |
|
|
|
(defvar byte-compile-warnings-point-max nil) |
|
1435 |
(defmacro displaying-byte-compile-warnings (&rest body) |
(defmacro displaying-byte-compile-warnings (&rest body) |
1436 |
`(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max)) |
`(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) |
1437 |
;; Log the file name. |
(warning-series-started |
1438 |
(byte-compile-log-file) |
(and (markerp warning-series) |
1439 |
;; Record how much is logged now. |
(eq (marker-buffer warning-series) |
1440 |
;; We will display the log buffer if anything more is logged |
(get-buffer "*Compile-Log*"))))) |
1441 |
;; before the end of BODY. |
(byte-compile-find-cl-functions) |
1442 |
(unless byte-compile-warnings-point-max |
(if (or (eq warning-series 'byte-compile-warning-series) |
1443 |
(save-excursion |
warning-series-started) |
1444 |
(byte-goto-log-buffer) |
;; warning-series does come from compilation, |
1445 |
(setq byte-compile-warnings-point-max (point-max)))) |
;; so don't bind it, but maybe do set it. |
1446 |
(unwind-protect |
(let (tem) |
1447 |
(let ((--displaying-byte-compile-warnings-fn (lambda () |
;; Log the file name. Record position of that text. |
1448 |
,@body))) |
(setq tem (byte-compile-log-file)) |
1449 |
|
(unless warning-series-started |
1450 |
|
(setq warning-series (or tem 'byte-compile-warning-series))) |
1451 |
(if byte-compile-debug |
(if byte-compile-debug |
1452 |
(funcall --displaying-byte-compile-warnings-fn) |
(funcall --displaying-byte-compile-warnings-fn) |
1453 |
(condition-case error-info |
(condition-case error-info |
1454 |
(funcall --displaying-byte-compile-warnings-fn) |
(funcall --displaying-byte-compile-warnings-fn) |
1455 |
(error (byte-compile-report-error error-info))))) |
(error (byte-compile-report-error error-info))))) |
1456 |
(with-current-buffer "*Compile-Log*" |
;; warning-series does not come from compilation, so bind it. |
1457 |
;; If there were compilation warnings, display them. |
(let ((warning-series |
1458 |
(unless (= byte-compile-warnings-point-max (point-max)) |
;; Log the file name. Record position of that text. |
1459 |
(select-window |
(or (byte-compile-log-file) 'byte-compile-warning-series))) |
1460 |
(prog1 (selected-window) |
(if byte-compile-debug |
1461 |
(select-window (display-buffer (current-buffer))) |
(funcall --displaying-byte-compile-warnings-fn) |
1462 |
(goto-char byte-compile-warnings-point-max) |
(condition-case error-info |
1463 |
(beginning-of-line) |
(funcall --displaying-byte-compile-warnings-fn) |
1464 |
(forward-line -1) |
(error (byte-compile-report-error error-info)))))))) |
|
(recenter 0)))))))) |
|
|
|
|
1465 |
|
|
1466 |
;;;###autoload |
;;;###autoload |
1467 |
(defun byte-force-recompile (directory) |
(defun byte-force-recompile (directory) |
1476 |
This is if a `.elc' file exists but is older than the `.el' file. |
This is if a `.elc' file exists but is older than the `.el' file. |
1477 |
Files in subdirectories of DIRECTORY are processed also. |
Files in subdirectories of DIRECTORY are processed also. |
1478 |
|
|
1479 |
If the `.elc' file does not exist, normally the `.el' file is *not* compiled. |
If the `.elc' file does not exist, normally this function *does not* |
1480 |
But a prefix argument (optional second arg) means ask user, |
compile the corresponding `.el' file. However, |
1481 |
for each such `.el' file, whether to compile it. Prefix argument 0 means |
if ARG (the prefix argument) is 0, that means do compile all those files. |
1482 |
don't ask and compile the file anyway. |
A nonzero ARG means ask the user, for each such `.el' file, |
1483 |
|
whether to compile it. |
1484 |
|
|
1485 |
A nonzero prefix argument also means ask about each subdirectory. |
A nonzero ARG also means ask about each subdirectory before scanning it. |
1486 |
|
|
1487 |
If the third argument FORCE is non-nil, |
If the third argument FORCE is non-nil, |
1488 |
recompile every `.el' file that already has a `.elc' file." |
recompile every `.el' file that already has a `.elc' file." |
1493 |
nil |
nil |
1494 |
(save-some-buffers) |
(save-some-buffers) |
1495 |
(force-mode-line-update)) |
(force-mode-line-update)) |
1496 |
(let ((directories (list (expand-file-name directory))) |
(save-current-buffer |
1497 |
(skip-count 0) |
(byte-goto-log-buffer) |
1498 |
(fail-count 0) |
(setq default-directory directory) |
1499 |
(file-count 0) |
(let ((directories (list (expand-file-name directory))) |
1500 |
(dir-count 0) |
(default-directory default-directory) |
1501 |
last-dir) |
(skip-count 0) |
1502 |
(displaying-byte-compile-warnings |
(fail-count 0) |
1503 |
(while directories |
(file-count 0) |
1504 |
(setq directory (car directories)) |
(dir-count 0) |
1505 |
(message "Checking %s..." directory) |
last-dir) |
1506 |
(let ((files (directory-files directory)) |
(displaying-byte-compile-warnings |
1507 |
source dest) |
(while directories |
1508 |
(dolist (file files) |
(setq directory (car directories)) |
1509 |
(setq source (expand-file-name file directory)) |
(message "Checking %s..." directory) |
1510 |
(if (and (not (member file '("." ".." "RCS" "CVS"))) |
(let ((files (directory-files directory)) |
1511 |
(file-directory-p source) |
source dest) |
1512 |
(not (file-symlink-p source))) |
(dolist (file files) |
1513 |
;; This file is a subdirectory. Handle them differently. |
(setq source (expand-file-name file directory)) |
1514 |
(when (or (null arg) |
(if (and (not (member file '("." ".." "RCS" "CVS"))) |
1515 |
(eq 0 arg) |
(file-directory-p source) |
1516 |
(y-or-n-p (concat "Check " source "? "))) |
(not (file-symlink-p source))) |
1517 |
(setq directories |
;; This file is a subdirectory. Handle them differently. |
1518 |
(nconc directories (list source)))) |
(when (or (null arg) |
1519 |
;; It is an ordinary file. Decide whether to compile it. |
(eq 0 arg) |
1520 |
(if (and (string-match emacs-lisp-file-regexp source) |
(y-or-n-p (concat "Check " source "? "))) |
1521 |
(file-readable-p source) |
(setq directories |
1522 |
(not (auto-save-file-name-p source)) |
(nconc directories (list source)))) |
1523 |
(setq dest (byte-compile-dest-file source)) |
;; It is an ordinary file. Decide whether to compile it. |
1524 |
(if (file-exists-p dest) |
(if (and (string-match emacs-lisp-file-regexp source) |
1525 |
;; File was already compiled. |
(file-readable-p source) |
1526 |
(or force (file-newer-than-file-p source dest)) |
(not (auto-save-file-name-p source)) |
1527 |
;; No compiled file exists yet. |
(setq dest (byte-compile-dest-file source)) |
1528 |
(and arg |
(if (file-exists-p dest) |
1529 |
(or (eq 0 arg) |
;; File was already compiled. |
1530 |
(y-or-n-p (concat "Compile " source "? ")))))) |
(or force (file-newer-than-file-p source dest)) |
1531 |
(progn (if (and noninteractive (not byte-compile-verbose)) |
;; No compiled file exists yet. |
1532 |
(message "Compiling %s..." source)) |
(and arg |
1533 |
(let ((res (byte-compile-file source))) |
(or (eq 0 arg) |
1534 |
(cond ((eq res 'no-byte-compile) |
(y-or-n-p (concat "Compile " source "? ")))))) |
1535 |
(setq skip-count (1+ skip-count))) |
(progn (if (and noninteractive (not byte-compile-verbose)) |
1536 |
((eq res t) |
(message "Compiling %s..." source)) |
1537 |
(setq file-count (1+ file-count))) |
(let ((res (byte-compile-file source))) |
1538 |
((eq res nil) |
(cond ((eq res 'no-byte-compile) |
1539 |
(setq fail-count (1+ fail-count))))) |
(setq skip-count (1+ skip-count))) |
1540 |
(or noninteractive |
((eq res t) |
1541 |
(message "Checking %s..." directory)) |
(setq file-count (1+ file-count))) |
1542 |
(if (not (eq last-dir directory)) |
((eq res nil) |
1543 |
(setq last-dir directory |
(setq fail-count (1+ fail-count))))) |
1544 |
dir-count (1+ dir-count))) |
(or noninteractive |
1545 |
))))) |
(message "Checking %s..." directory)) |
1546 |
(setq directories (cdr directories)))) |
(if (not (eq last-dir directory)) |
1547 |
(message "Done (Total of %d file%s compiled%s%s%s)" |
(setq last-dir directory |
1548 |
file-count (if (= file-count 1) "" "s") |
dir-count (1+ dir-count))) |
1549 |
(if (> fail-count 0) (format ", %d failed" fail-count) "") |
))))) |
1550 |
(if (> skip-count 0) (format ", %d skipped" skip-count) "") |
(setq directories (cdr directories)))) |
1551 |
(if (> dir-count 1) (format " in %d directories" dir-count) "")))) |
(message "Done (Total of %d file%s compiled%s%s%s)" |
1552 |
|
file-count (if (= file-count 1) "" "s") |
1553 |
|
(if (> fail-count 0) (format ", %d failed" fail-count) "") |
1554 |
|
(if (> skip-count 0) (format ", %d skipped" skip-count) "") |
1555 |
|
(if (> dir-count 1) (format " in %d directories" dir-count) ""))))) |
1556 |
|
|
1557 |
(defvar no-byte-compile nil |
(defvar no-byte-compile nil |
1558 |
"Non-nil to prevent byte-compiling of emacs-lisp code. |
"Non-nil to prevent byte-compiling of emacs-lisp code. |
1592 |
(y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) |
(y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) |
1593 |
(save-excursion (set-buffer b) (save-buffer))))) |
(save-excursion (set-buffer b) (save-buffer))))) |
1594 |
|
|
1595 |
|
;; Force logging of the file name for each file compiled. |
1596 |
|
(setq byte-compile-last-logged-file nil) |
1597 |
(let ((byte-compile-current-file filename) |
(let ((byte-compile-current-file filename) |
|
(byte-compile-last-logged-file nil) |
|
1598 |
(set-auto-coding-for-load t) |
(set-auto-coding-for-load t) |
1599 |
target-file input-buffer output-buffer |
target-file input-buffer output-buffer |
1600 |
byte-compile-dest-file) |
byte-compile-dest-file) |
1642 |
;; It is important that input-buffer not be current at this call, |
;; It is important that input-buffer not be current at this call, |
1643 |
;; so that the value of point set in input-buffer |
;; so that the value of point set in input-buffer |
1644 |
;; within byte-compile-from-buffer lingers in that buffer. |
;; within byte-compile-from-buffer lingers in that buffer. |
1645 |
(setq output-buffer (byte-compile-from-buffer input-buffer filename)) |
(setq output-buffer |
1646 |
|
(save-current-buffer |
1647 |
|
(byte-compile-from-buffer input-buffer filename))) |
1648 |
(if byte-compiler-error-flag |
(if byte-compiler-error-flag |
1649 |
nil |
nil |
1650 |
(when byte-compile-verbose |
(when byte-compile-verbose |
1666 |
;; the build tree, without causing problems when emacs-lisp |
;; the build tree, without causing problems when emacs-lisp |
1667 |
;; files in the build tree are recompiled). |
;; files in the build tree are recompiled). |
1668 |
(delete-file target-file)) |
(delete-file target-file)) |
1669 |
(write-region 1 (point-max) target-file)) |
(write-region (point-min) (point-max) target-file)) |
1670 |
;; This is just to give a better error message than write-region |
;; This is just to give a better error message than write-region |
1671 |
(signal 'file-error |
(signal 'file-error |
1672 |
(list "Opening output file" |
(list "Opening output file" |
1722 |
(byte-compile-last-position byte-compile-read-position) |
(byte-compile-last-position byte-compile-read-position) |
1723 |
(byte-compile-last-warned-form 'nothing) |
(byte-compile-last-warned-form 'nothing) |
1724 |
(value (eval |
(value (eval |
1725 |
(let ((read-with-symbol-positions inbuffer) |
(let ((read-with-symbol-positions (current-buffer)) |
1726 |
(read-symbol-positions-list nil)) |
(read-symbol-positions-list nil)) |
1727 |
(displaying-byte-compile-warnings |
(displaying-byte-compile-warnings |
1728 |
(byte-compile-sexp (read (current-buffer)))))))) |
(byte-compile-sexp (read (current-buffer)))))))) |
1983 |
(setq position |
(setq position |
1984 |
(byte-compile-output-as-comment |
(byte-compile-output-as-comment |
1985 |
(nth (nth 1 info) form) nil)) |
(nth (nth 1 info) form) nil)) |
1986 |
(setq position (position-bytes position)) |
(setq position (- (position-bytes position) (point-min) -1)) |
1987 |
;; If the doc string starts with * (a user variable), |
;; If the doc string starts with * (a user variable), |
1988 |
;; negate POSITION. |
;; negate POSITION. |
1989 |
(if (and (stringp (nth (nth 1 info) form)) |
(if (and (stringp (nth (nth 1 info) form)) |
2012 |
(while (setq form (cdr form)) |
(while (setq form (cdr form)) |
2013 |
(setq index (1+ index)) |
(setq index (1+ index)) |
2014 |
(insert " ") |
(insert " ") |
2015 |
(cond ((and (numberp specindex) (= index specindex)) |
(cond ((and (numberp specindex) (= index specindex) |
2016 |
|
;; Don't handle the definition dynamically |
2017 |
|
;; if it refers (or might refer) |
2018 |
|
;; to objects already output |
2019 |
|
;; (for instance, gensyms in the arg list). |
2020 |
|
(let (non-nil) |
2021 |
|
(dotimes (i (length print-number-table)) |
2022 |
|
(if (aref print-number-table i) |
2023 |
|
(setq non-nil t))) |
2024 |
|
(not non-nil))) |
2025 |
|
;; Output the byte code and constants specially |
2026 |
|
;; for lazy dynamic loading. |
2027 |
(let ((position |
(let ((position |
2028 |
(byte-compile-output-as-comment |
(byte-compile-output-as-comment |
2029 |
(cons (car form) (nth 1 form)) |
(cons (car form) (nth 1 form)) |
2030 |
t))) |
t))) |
2031 |
(setq position (position-bytes position)) |
(setq position (- (position-bytes position) (point-min) -1)) |
2032 |
(princ (format "(#$ . %d) nil" position) outbuffer) |
(princ (format "(#$ . %d) nil" position) outbuffer) |
2033 |
(setq form (cdr form)) |
(setq form (cdr form)) |
2034 |
(setq index (1+ index)))) |
(setq index (1+ index)))) |
2146 |
(if (memq 'free-vars byte-compile-warnings) |
(if (memq 'free-vars byte-compile-warnings) |
2147 |
(setq byte-compile-bound-variables |
(setq byte-compile-bound-variables |
2148 |
(cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) |
(cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) |
2149 |
|
(let ((tail (nthcdr 4 form))) |
2150 |
|
(while tail |
2151 |
|
;; If there are any (function (lambda ...)) expressions, compile |
2152 |
|
;; those functions. |
2153 |
|
(if (and (consp (car tail)) |
2154 |
|
(eq (car (car tail)) 'function) |
2155 |
|
(consp (nth 1 (car tail)))) |
2156 |
|
(setcar tail (byte-compile-lambda (nth 1 (car tail)))) |
2157 |
|
;; Likewise for a bare lambda. |
2158 |
|
(if (and (consp (car tail)) |
2159 |
|
(eq (car (car tail)) 'lambda)) |
2160 |
|
(setcar tail (byte-compile-lambda (car tail))))) |
2161 |
|
(setq tail (cdr tail)))) |
2162 |
form) |
form) |
2163 |
|
|
2164 |
(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) |
(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) |
2165 |
(defun byte-compile-file-form-eval-boundary (form) |
(defun byte-compile-file-form-eval-boundary (form) |
2166 |
(eval form) |
(let ((old-load-list current-load-list)) |
2167 |
|
(eval form) |
2168 |
|
;; (require 'cl) turns off warnings for cl functions. |
2169 |
|
(let ((tem current-load-list)) |
2170 |
|
(while (not (eq tem old-load-list)) |
2171 |
|
(when (equal (car tem) '(require . cl)) |
2172 |
|
(setq byte-compile-warnings |
2173 |
|
(remq 'cl-functions byte-compile-warnings))) |
2174 |
|
(setq tem (cdr tem))))) |
2175 |
(byte-compile-keep-pending form 'byte-compile-normal-call)) |
(byte-compile-keep-pending form 'byte-compile-normal-call)) |
2176 |
|
|
2177 |
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |
2259 |
(byte-compile-set-symbol-position (nth 1 form)) |
(byte-compile-set-symbol-position (nth 1 form)) |
2260 |
(byte-compile-warn "probable `\"' without `\\' in doc string of %s" |
(byte-compile-warn "probable `\"' without `\\' in doc string of %s" |
2261 |
(nth 1 form)))) |
(nth 1 form)))) |
2262 |
|
|
2263 |
;; Generate code for declarations in macro definitions. |
;; Generate code for declarations in macro definitions. |
2264 |
;; Remove declarations from the body of the macro definition. |
;; Remove declarations from the body of the macro definition. |
2265 |
(when macrop |
(when macrop |
2274 |
(funcall macro-declaration-function |
(funcall macro-declaration-function |
2275 |
',name ',declaration)) |
',name ',declaration)) |
2276 |
outbuffer))))) |
outbuffer))))) |
2277 |
|
|
2278 |
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) |
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) |
2279 |
(code (byte-compile-byte-code-maker new-one))) |
(code (byte-compile-byte-code-maker new-one))) |
2280 |
(if this-one |
(if this-one |
2511 |
;; don't compile it, because `call-interactively' |
;; don't compile it, because `call-interactively' |
2512 |
;; looks at the args of `list'. |
;; looks at the args of `list'. |
2513 |
(let ((form (nth 1 int))) |
(let ((form (nth 1 int))) |
2514 |
(while (or (eq (car-safe form) 'let) |
(while (memq (car-safe form) '(let let* progn save-excursion)) |
|
(eq (car-safe form) 'let*) |
|
|
(eq (car-safe form) 'save-excursion)) |
|
2515 |
(while (consp (cdr form)) |
(while (consp (cdr form)) |
2516 |
(setq form (cdr form))) |
(setq form (cdr form))) |
2517 |
(setq form (car form))) |
(setq form (car form))) |
2677 |
;; constant was not optimized away because we chose to return it. |
;; constant was not optimized away because we chose to return it. |
2678 |
(and (not (assq nil byte-compile-constants)) ; Nil is often there. |
(and (not (assq nil byte-compile-constants)) ; Nil is often there. |
2679 |
(let ((tmp (reverse byte-compile-constants))) |
(let ((tmp (reverse byte-compile-constants))) |
2680 |
(while (and tmp (not (or (symbolp (car (car tmp))) |
(while (and tmp (not (or (symbolp (caar tmp)) |
2681 |
(numberp (car (car tmp)))))) |
(numberp (caar tmp))))) |
2682 |
(setq tmp (cdr tmp))) |
(setq tmp (cdr tmp))) |
2683 |
(car (car tmp))))))) |
(caar tmp)))))) |
2684 |
(byte-compile-out 'byte-return 0) |
(byte-compile-out 'byte-return 0) |
2685 |
(setq byte-compile-output (nreverse byte-compile-output)) |
(setq byte-compile-output (nreverse byte-compile-output)) |
2686 |
(if (memq byte-optimize '(t byte)) |
(if (memq byte-optimize '(t byte)) |
2792 |
(funcall handler form) |
(funcall handler form) |
2793 |
(if (memq 'callargs byte-compile-warnings) |
(if (memq 'callargs byte-compile-warnings) |
2794 |
(byte-compile-callargs-warn form)) |
(byte-compile-callargs-warn form)) |
2795 |
(byte-compile-normal-call form)))) |
(byte-compile-normal-call form)) |
2796 |
|
(if (memq 'cl-functions byte-compile-warnings) |
2797 |
|
(byte-compile-cl-warn form)))) |
2798 |
((and (or (byte-code-function-p (car form)) |
((and (or (byte-code-function-p (car form)) |
2799 |
(eq (car-safe (car form)) 'lambda)) |
(eq (car-safe (car form)) 'lambda)) |
2800 |
;; if the form comes out the same way it went in, that's |
;; if the form comes out the same way it went in, that's |
3424 |
(byte-defop-compiler-1 or) |
(byte-defop-compiler-1 or) |
3425 |
(byte-defop-compiler-1 while) |
(byte-defop-compiler-1 while) |
3426 |
(byte-defop-compiler-1 funcall) |
(byte-defop-compiler-1 funcall) |
3427 |
|
(byte-defop-compiler-1 apply byte-compile-funarg) |
3428 |
|
(byte-defop-compiler-1 mapcar byte-compile-funarg) |
3429 |
|
(byte-defop-compiler-1 mapatoms byte-compile-funarg) |
3430 |
|
(byte-defop-compiler-1 mapconcat byte-compile-funarg) |
3431 |
|
(byte-defop-compiler-1 mapc byte-compile-funarg) |
3432 |
|
(byte-defop-compiler-1 maphash byte-compile-funarg) |
3433 |
|
(byte-defop-compiler-1 map-char-table byte-compile-funarg) |
3434 |
|
(byte-defop-compiler-1 sort byte-compile-funarg-2) |
3435 |
(byte-defop-compiler-1 let) |
(byte-defop-compiler-1 let) |
3436 |
(byte-defop-compiler-1 let*) |
(byte-defop-compiler-1 let*) |
3437 |
|
|
3456 |
|
|
3457 |
(defun byte-compile-if (form) |
(defun byte-compile-if (form) |
3458 |
(byte-compile-form (car (cdr form))) |
(byte-compile-form (car (cdr form))) |
3459 |
(if (null (nthcdr 3 form)) |
;; Check whether we have `(if (fboundp ...' or `(if (boundp ...' |
3460 |
;; No else-forms |
;; and avoid warnings about the relevent symbols in the consequent. |
3461 |
(let ((donetag (byte-compile-make-tag))) |
(let* ((clause (nth 1 form)) |
3462 |
(byte-compile-goto-if nil for-effect donetag) |
(fbound (if (eq 'fboundp (car-safe clause)) |
3463 |
(byte-compile-form (nth 2 form) for-effect) |
(and (eq 'quote (car-safe (nth 1 clause))) |
3464 |
(byte-compile-out-tag donetag)) |
;; Ignore if the symbol is already on the |
3465 |
(let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag))) |
;; unresolved list. |
3466 |
(byte-compile-goto 'byte-goto-if-nil elsetag) |
(not (assq |
3467 |
(byte-compile-form (nth 2 form) for-effect) |
(nth 1 (nth 1 clause)) ; the relevant symbol |
3468 |
(byte-compile-goto 'byte-goto donetag) |
byte-compile-unresolved-functions)) |
3469 |
(byte-compile-out-tag elsetag) |
(nth 1 (nth 1 clause))))) |
3470 |
(byte-compile-body (cdr (cdr (cdr form))) for-effect) |
(bound (if (eq 'boundp (car-safe clause)) |
3471 |
(byte-compile-out-tag donetag))) |
(and (eq 'quote (car-safe (nth 1 clause))) |
3472 |
|
(nth 1 (nth 1 clause))))) |
3473 |
|
(donetag (byte-compile-make-tag))) |
3474 |
|
(if (null (nthcdr 3 form)) |
3475 |
|
;; No else-forms |
3476 |
|
(progn |
3477 |
|
(byte-compile-goto-if nil for-effect donetag) |
3478 |
|
;; Maybe add to the bound list. |
3479 |
|
(let ((byte-compile-bound-variables |
3480 |
|
(if bound |
3481 |
|
(cons bound byte-compile-bound-variables) |
3482 |
|
byte-compile-bound-variables))) |
3483 |
|
(byte-compile-form (nth 2 form) for-effect)) |
3484 |
|
;; Maybe remove the function symbol from the unresolved list. |
3485 |
|
(if fbound |
3486 |
|
(setq byte-compile-unresolved-functions |
3487 |
|
(delq (assq fbound byte-compile-unresolved-functions) |
3488 |
|
byte-compile-unresolved-functions))) |
3489 |
|
(byte-compile-out-tag donetag)) |
3490 |
|
(let ((elsetag (byte-compile-make-tag))) |
3491 |
|
(byte-compile-goto 'byte-goto-if-nil elsetag) |
3492 |
|
;; As above for the first form. |
3493 |
|
(let ((byte-compile-bound-variables |
3494 |
|
(if bound |
3495 |
|
(cons bound byte-compile-bound-variables) |
3496 |
|
byte-compile-bound-variables))) |
3497 |
|
(byte-compile-form (nth 2 form) for-effect)) |
3498 |
|
(if fbound |
3499 |
|
(setq byte-compile-unresolved-functions |
3500 |
|
(delq (assq fbound byte-compile-unresolved-functions) |
3501 |
|
byte-compile-unresolved-functions))) |
3502 |
|
(byte-compile-goto 'byte-goto donetag) |
3503 |
|
(byte-compile-out-tag elsetag) |
3504 |
|
(byte-compile-body (cdr (cdr (cdr form))) for-effect) |
3505 |
|
(byte-compile-out-tag donetag)))) |
3506 |
(setq for-effect nil)) |
(setq for-effect nil)) |
3507 |
|
|
3508 |
(defun byte-compile-cond (clauses) |
(defun byte-compile-cond (clauses) |
4263 |
|
|
4264 |
;;;###autoload |
;;;###autoload |
4265 |
(defun batch-byte-recompile-directory () |
(defun batch-byte-recompile-directory () |
4266 |
"Runs `byte-recompile-directory' on the dirs remaining on the command line. |
"Run `byte-recompile-directory' on the dirs remaining on the command line. |
4267 |
Must be used only with `-batch', and kills Emacs on completion. |
Must be used only with `-batch', and kills Emacs on completion. |
4268 |
For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." |
For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." |
4269 |
;; command-line-args-left is what is left of the command line (startup.el) |
;; command-line-args-left is what is left of the command line (startup.el) |
4273 |
(or command-line-args-left |
(or command-line-args-left |
4274 |
(setq command-line-args-left '("."))) |
(setq command-line-args-left '("."))) |
4275 |
(while command-line-args-left |
(while command-line-args-left |
4276 |
(byte-recompile-directory (car command-line-args-left) 0) |
(byte-recompile-directory (car command-line-args-left)) |
4277 |
(setq command-line-args-left (cdr command-line-args-left))) |
(setq command-line-args-left (cdr command-line-args-left))) |
4278 |
(kill-emacs 0)) |
(kill-emacs 0)) |
4279 |
|
|
4280 |
|
|
|
(make-obsolete 'dot 'point "before 19.15") |
|
|
(make-obsolete 'dot-max 'point-max "before 19.15") |
|
|
(make-obsolete 'dot-min 'point-min "before 19.15") |
|
|
(make-obsolete 'dot-marker 'point-marker "before 19.15") |
|
|
|
|
|
(make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15") |
|
|
(make-obsolete 'baud-rate "use the baud-rate variable instead" "before 19.15") |
|
|
(make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15") |
|
|
(make-obsolete 'define-function 'defalias "20.1") |
|
4281 |
(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15") |
(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15") |
4282 |
(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15") |
(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15") |
4283 |
(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15") |
(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15") |
4284 |
(make-obsolete-variable 'inhibit-local-variables |
(make-obsolete-variable 'inhibit-local-variables |
4285 |
"use enable-local-variables (with the reversed sense)." |
"use enable-local-variables (with the reversed sense)." |
4286 |
"before 19.15") |
"before 19.15") |
|
(make-obsolete-variable 'unread-command-char |
|
|
"use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1." |
|
|
"before 19.15") |
|
4287 |
(make-obsolete-variable 'unread-command-event |
(make-obsolete-variable 'unread-command-event |
4288 |
"use unread-command-events; which is a list of events rather than a single event." |
"use unread-command-events; which is a list of events rather than a single event." |
4289 |
"before 19.15") |
"before 19.15") |
4290 |
(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15") |
(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15") |
4291 |
(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15") |
(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15") |
4292 |
(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead." "before 19.34") |
(make-obsolete-variable 'meta-flag "use the set-input-mode function instead." "before 19.34") |
|
(make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34") |
|
4293 |
(make-obsolete-variable 'before-change-function |
(make-obsolete-variable 'before-change-function |
4294 |
"use before-change-functions; which is a list of functions rather than a single function." |
"use before-change-functions; which is a list of functions rather than a single function." |
4295 |
"before 19.34") |
"before 19.34") |
4297 |
"use after-change-functions; which is a list of functions rather than a single function." |
"use after-change-functions; which is a list of functions rather than a single function." |
4298 |
"before 19.34") |
"before 19.34") |
4299 |
(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34") |
(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34") |
|
(make-obsolete-variable 'post-command-idle-hook |
|
|
"use timers instead, with `run-with-idle-timer'." "before 19.34") |
|
|
(make-obsolete-variable 'post-command-idle-delay |
|
|
"use timers instead, with `run-with-idle-timer'." "before 19.34") |
|
4300 |
|
|
4301 |
(provide 'byte-compile) |
(provide 'byte-compile) |
4302 |
(provide 'bytecomp) |
(provide 'bytecomp) |