X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/63efa6c6a559a23be863cad0c08457a2d29a0a67..cfb35800a8765b3458751bd6992a348f97843894:/lisp/emacs-lisp/bytecomp.el diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2bd8d07851..51bbf8a294 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -31,6 +31,10 @@ ;; faster. [`LAP' == `Lisp Assembly Program'.] ;; The user entry points are byte-compile-file and byte-recompile-directory. +;;; Todo: + +;; - Turn "not bound at runtime" functions into autoloads. + ;;; Code: ;; ======================================================================== @@ -450,7 +454,7 @@ Return the compile-time value of FORM." (eval-when-compile . ,(lambda (&rest body) (let ((result nil)) (byte-compile-recurse-toplevel - (cons 'progn body) + (macroexp-progn body) (lambda (form) (setf result (byte-compile-eval @@ -459,7 +463,7 @@ Return the compile-time value of FORM." (list 'quote result)))) (eval-and-compile . ,(lambda (&rest body) (byte-compile-recurse-toplevel - (cons 'progn body) + (macroexp-progn body) (lambda (form) ;; Don't compile here, since we don't know ;; whether to compile as byte-compile-form @@ -975,6 +979,17 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (lambda (x) (if (symbolp x) (list 'prin1-to-string x) x)) args)))))) +(defvar byte-compile--interactive nil + "Determine if `byte-compile--message' uses the minibuffer.") + +(defun byte-compile--message (format &rest args) + "Like `message', except sometimes don't print to minibuffer. +If the variable `byte-compile--interactive' is nil, the message +is not displayed on the minibuffer." + (apply #'message format args) + (unless byte-compile--interactive + (message nil))) + ;; Log something that isn't a warning. (defun byte-compile-log-1 (string) (with-current-buffer byte-compile-log-buffer @@ -982,7 +997,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (goto-char (point-max)) (byte-compile-warning-prefix nil nil) (cond (noninteractive - (message " %s" string)) + (byte-compile--message " %s" string)) (t (insert (format "%s\n" string))))))) @@ -1349,13 +1364,13 @@ extra args." (let ((keyword-args (cdr (cdr (cdr (cdr form))))) (name (cadr form))) (or (not (eq (car-safe name) 'quote)) - (and (eq (car form) 'custom-declare-group) - (equal name ''emacs)) - (plist-get keyword-args :group) - (not (and (consp name) (eq (car name) 'quote))) - (byte-compile-warn - "%s for `%s' fails to specify containing group" - (cdr (assq (car form) + (and (eq (car form) 'custom-declare-group) + (equal name ''emacs)) + (plist-get keyword-args :group) + (not (and (consp name) (eq (car name) 'quote))) + (byte-compile-warn + "%s for `%s' fails to specify containing group" + (cdr (assq (car form) '((custom-declare-group . defgroup) (custom-declare-face . defface) (custom-declare-variable . defcustom)))) @@ -1458,7 +1473,7 @@ extra args." ;; These would sometimes be warned about ;; but such warnings are never useful, ;; so don't warn about them. - macroexpand cl-macroexpand-all + macroexpand cl--compiling-file)))) (byte-compile-warn "function `%s' from cl package called at runtime" func))) @@ -1586,7 +1601,10 @@ extra args." "Recompile every `.el' file in DIRECTORY that already has a `.elc' file. Files in subdirectories of DIRECTORY are processed also." (interactive "DByte force recompile (directory): ") - (byte-recompile-directory directory nil t)) + (let ((byte-compile--interactive + (or byte-compile--interactive + (called-interactively-p 'any)))) + (byte-recompile-directory directory nil t))) ;;;###autoload (defun byte-recompile-directory (directory &optional arg force) @@ -1616,6 +1634,9 @@ that already has a `.elc' file." (compilation-mode)) (let ((directories (list default-directory)) (default-directory default-directory) + (byte-compile--interactive + (or byte-compile--interactive + (called-interactively-p 'any))) (skip-count 0) (fail-count 0) (file-count 0) @@ -1624,7 +1645,7 @@ that already has a `.elc' file." (displaying-byte-compile-warnings (while directories (setq directory (car directories)) - (message "Checking %s..." directory) + (byte-compile--message "Checking %s..." directory) (dolist (file (directory-files directory)) (let ((source (expand-file-name file directory))) (if (file-directory-p source) @@ -1649,13 +1670,13 @@ that already has a `.elc' file." (`t file-count) (_ fail-count))) (or noninteractive - (message "Checking %s..." directory)) + (byte-compile--message "Checking %s..." directory)) (if (not (eq last-dir directory)) (setq last-dir directory dir-count (1+ dir-count))) ))))) (setq directories (cdr directories)))) - (message "Done (Total of %d file%s compiled%s%s%s)" + (byte-compile--message "Done (Total of %d file%s compiled%s%s%s)" file-count (if (= file-count 1) "" "s") (if (> fail-count 0) (format ", %d failed" fail-count) "") (if (> skip-count 0) (format ", %d skipped" skip-count) "") @@ -1702,7 +1723,10 @@ If compilation is needed, this functions returns the result of current-prefix-arg))) (let ((dest (byte-compile-dest-file filename)) ;; Expand now so we get the current buffer's defaults - (filename (expand-file-name filename))) + (filename (expand-file-name filename)) + (byte-compile--interactive + (or byte-compile--interactive + (called-interactively-p 'any)))) (if (if (file-exists-p dest) ;; File was already compiled ;; Compile if forced to, or filename newer @@ -1714,7 +1738,7 @@ If compilation is needed, this functions returns the result of filename "? "))))) (progn (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." filename)) + (byte-compile--message "Compiling %s..." filename)) (byte-compile-file filename load)) (when load (load (if (file-exists-p dest) dest filename))) @@ -1758,6 +1782,9 @@ The value is non-nil if there were no errors, nil if errors." (let ((byte-compile-current-file filename) (byte-compile-current-group nil) (set-auto-coding-for-load t) + (byte-compile--interactive + (or byte-compile--interactive + (called-interactively-p 'any))) target-file input-buffer output-buffer byte-compile-dest-file) (setq target-file (byte-compile-dest-file filename)) @@ -1795,7 +1822,7 @@ The value is non-nil if there were no errors, nil if errors." (progn (setq-default major-mode 'emacs-lisp-mode) ;; Arg of t means don't alter enable-local-variables. - (normal-mode t)) + (delay-mode-hooks (normal-mode t))) (setq-default major-mode dmm)) ;; There may be a file local variable setting (bug#10419). (setq buffer-read-only nil @@ -1813,14 +1840,14 @@ The value is non-nil if there were no errors, nil if errors." ;; (byte-compile-abbreviate-file filename) ;; (with-current-buffer input-buffer no-byte-compile)) (when (file-exists-p target-file) - (message "%s deleted because of `no-byte-compile: %s'" + (byte-compile--message "%s deleted because of `no-byte-compile: %s'" (byte-compile-abbreviate-file target-file) (buffer-local-value 'no-byte-compile input-buffer)) (condition-case nil (delete-file target-file) (error nil))) ;; We successfully didn't compile this file. 'no-byte-compile) (when byte-compile-verbose - (message "Compiling %s..." filename)) + (byte-compile--message "Compiling %s..." filename)) (setq byte-compiler-error-flag nil) ;; It is important that input-buffer not be current at this call, ;; so that the value of point set in input-buffer @@ -1832,7 +1859,7 @@ The value is non-nil if there were no errors, nil if errors." (if byte-compiler-error-flag nil (when byte-compile-verbose - (message "Compiling %s...done" filename)) + (byte-compile--message "Compiling %s...done" filename)) (kill-buffer input-buffer) (with-current-buffer output-buffer (goto-char (point-max)) @@ -1858,7 +1885,7 @@ The value is non-nil if there were no errors, nil if errors." ;; recompiled). Previously this was accomplished by ;; deleting target-file before writing it. (rename-file tempfile target-file t) - (or noninteractive (message "Wrote %s" target-file))) + (or noninteractive (byte-compile--message "Wrote %s" target-file))) ;; This is just to give a better error message than write-region (signal 'file-error (list "Opening output file" @@ -1892,6 +1919,9 @@ With argument ARG, insert value in current buffer after the form." (byte-compile-read-position (point)) (byte-compile-last-position byte-compile-read-position) (byte-compile-last-warned-form 'nothing) + (byte-compile--interactive + (or byte-compile--interactive + (called-interactively-p 'any))) (value (eval (let ((read-with-symbol-positions (current-buffer)) (read-symbol-positions-list nil)) @@ -1899,10 +1929,10 @@ With argument ARG, insert value in current buffer after the form." (byte-compile-sexp (read (current-buffer))))) lexical-binding))) (cond (arg - (message "Compiling from buffer... done.") + (byte-compile--message "Compiling from buffer... done.") (prin1 value (current-buffer)) (insert "\n")) - ((message "%s" (prin1-to-string value))))))) + ((byte-compile--message "%s" (prin1-to-string value))))))) (defun byte-compile-from-buffer (inbuffer) (let ((byte-compile-current-buffer inbuffer) @@ -2319,10 +2349,12 @@ list that represents a doc string reference. form)) (put 'define-abbrev-table 'byte-hunk-handler - 'byte-compile-file-form-define-abbrev-table) -(defun byte-compile-file-form-define-abbrev-table (form) - (if (eq 'quote (car-safe (car-safe (cdr form)))) - (byte-compile--declare-var (car-safe (cdr (cadr form))))) + 'byte-compile-file-form-defvar-function) +(put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function) + +(defun byte-compile-file-form-defvar-function (form) + (pcase-let (((or `',name (let name nil)) (nth 1 form))) + (if name (byte-compile--declare-var name))) (byte-compile-keep-pending form)) (put 'custom-declare-variable 'byte-hunk-handler @@ -2330,8 +2362,7 @@ list that represents a doc string reference. (defun byte-compile-file-form-custom-declare-variable (form) (when (byte-compile-warning-enabled-p 'callargs) (byte-compile-nogroup-warn form)) - (byte-compile--declare-var (nth 1 (nth 1 form))) - (byte-compile-keep-pending form)) + (byte-compile-file-form-defvar-function form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) @@ -2405,7 +2436,7 @@ not to take responsibility for the actual compilation of the code." (byte-compile-arglist-warn name arglist macro)) (if byte-compile-verbose - (message "Compiling %s... (%s)" + (byte-compile--message "Compiling %s... (%s)" (or byte-compile-current-file "") name)) (cond ((not (or macro (listp body))) ;; We do not know positively if the definition is a macro @@ -2575,22 +2606,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; error to a simple message for the known case where signaling an error ;; causes problems. ((byte-code-function-p fun) - (message "Function %s is already compiled" + (byte-compile--message "Function %s is already compiled" (if (symbolp form) form "provided")) fun) (t (when (symbolp form) - (unless (memq (car-safe fun) '(closure lambda)) - (error "Don't know how to compile %S" fun)) (setq lexical-binding (eq (car fun) 'closure)) (setq fun (byte-compile--reify-function fun))) - (unless (eq (car-safe fun) 'lambda) - (error "Don't know how to compile %S" fun)) ;; Expand macros. (setq fun (byte-compile-preprocess fun)) - ;; Get rid of the `function' quote added by the `lambda' macro. - (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) - (setq fun (byte-compile-lambda fun)) + (setq fun (byte-compile-top-level fun nil 'eval)) (if macro (push 'macro fun)) (if (symbolp form) (fset form fun) @@ -2966,6 +2991,16 @@ for symbols generated by the byte compiler itself." (interactive-only (or (get fn 'interactive-only) (memq fn byte-compile-interactive-only-functions)))) + (when (memq fn '(set symbol-value run-hooks ;; add-to-list + add-hook remove-hook run-hook-with-args + run-hook-with-args-until-success + run-hook-with-args-until-failure)) + (pcase (cdr form) + (`(',var . ,_) + (when (assq var byte-compile-lexical-variables) + (byte-compile-log-warning + (format "%s cannot use lexical var `%s'" fn var) + nil :error))))) (when (macroexp--const-symbol-p fn) (byte-compile-warn "`%s' called as a function" fn)) (when (and (byte-compile-warning-enabled-p 'interactive-only) @@ -3079,8 +3114,9 @@ for symbols generated by the byte compiler itself." (dotimes (_ (- (/ (1+ fmax2) 2) alen)) (byte-compile-push-constant nil))) ((zerop (logand fmax2 1)) - (byte-compile-log-warning "Too many arguments for inlined function" - nil :error) + (byte-compile-log-warning + (format "Too many arguments for inlined function %S" form) + nil :error) (byte-compile-discard (- alen (/ fmax2 2)))) (t ;; Turn &rest args into a list. @@ -3453,15 +3489,22 @@ discarding." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) - (body (nthcdr 3 form)) + (docstring-exp (nth 3 form)) + (body (nthcdr 4 form)) (fun (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) - (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure. + (cl-assert (or (> (length env) 0) + docstring-exp)) ;Otherwise, we don't need a closure. (cl-assert (byte-code-function-p fun)) (byte-compile-form `(make-byte-code ',(aref fun 0) ',(aref fun 1) (vconcat (vector . ,env) ',(aref fun 2)) - ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) + ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) + (if docstring-exp + `(,(car rest) + ,docstring-exp + ,@(cddr rest)) + rest))))))) (defun byte-compile-get-closed-var (form) "Byte-compile the special `internal-get-closed-var' form." @@ -4381,8 +4424,8 @@ binding slots have been popped." name macro arglist body rest) (when macro (if (null fun) - (message "Macro %s unrecognized, won't work in file" name) - (message "Macro %s partly recognized, trying our luck" name) + (byte-compile--message "Macro %s unrecognized, won't work in file" name) + (byte-compile--message "Macro %s partly recognized, trying our luck" name) (push (cons name (eval fun)) byte-compile-macro-environment))) (byte-compile-keep-pending form)))) @@ -4508,11 +4551,11 @@ The call tree also lists those functions which are not known to be called \(that is, to which no calls have been compiled\), and which cannot be invoked interactively." (interactive) - (message "Generating call tree...") + (byte-compile--message "Generating call tree...") (with-output-to-temp-buffer "*Call-Tree*" (set-buffer "*Call-Tree*") (erase-buffer) - (message "Generating call tree... (sorting on %s)" + (byte-compile--message "Generating call tree... (sorting on %s)" byte-compile-call-tree-sort) (insert "Call tree for " (cond ((null byte-compile-current-file) (or filename "???"))