(beginning-of-defun-raw, end-of-defun):

[gnu-emacs] / lisp / emacs-lisp / bytecomp.el

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 3a0e7da2b1cba75705a42595838774670b674366..32d6694b060753bde100e811fd64419d043a8aee 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,6 +1,6 @@
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 

-;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002
+;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004

 ;;   Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>


@@ -8,10 +8,6 @@
 ;; Maintainer: FSF
 ;; Keywords: lisp
 
 ;; Maintainer: FSF
 ;; Keywords: lisp
 

-;;; This version incorporates changes up to version 2.10 of the
-;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.120 $")
-

 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify


@@ -75,7 +71,7 @@
 ;; User customization variables:
 ;;
 ;; byte-compile-verbose        Whether to report the function currently being
 ;; User customization variables:
 ;;
 ;; byte-compile-verbose        Whether to report the function currently being

-;;                             compiled in the minibuffer;
+;;                             compiled in the echo area;

 ;; byte-optimize               Whether to do optimizations; this may be
 ;;                             t, nil, 'source, or 'byte;
 ;; byte-optimize-log           Whether to report (in excruciating detail)
 ;; byte-optimize               Whether to do optimizations; this may be
 ;;                             t, nil, 'source, or 'byte;
 ;; byte-optimize-log           Whether to report (in excruciating detail)


@@ -91,17 +87,17 @@
 ;;                             finding unused functions, as well as simple
 ;;                             performance metering.
 ;; byte-compile-warnings       List of warnings to issue, or t.  May contain
 ;;                             finding unused functions, as well as simple
 ;;                             performance metering.
 ;; byte-compile-warnings       List of warnings to issue, or t.  May contain

-;;                             'free-vars (references to variables not in the
-;;                                         current lexical scope)
-;;                             'unresolved (calls to unknown functions)
-;;                             'callargs  (lambda calls with args that don't
-;;                                         match the lambda's definition)
-;;                             'redefine  (function cell redefined from
-;;                                         a macro to a lambda or vice versa,
-;;                                         or redefined to take other args)
-;;                             'obsolete  (obsolete variables and functions)
-;;                             'noruntime (calls to functions only defined
-;;                                         within `eval-when-compile')
+;;                             `free-vars' (references to variables not in the
+;;                                          current lexical scope)
+;;                             `unresolved' (calls to unknown functions)
+;;                             `callargs'  (lambda calls with args that don't
+;;                                          match the lambda's definition)
+;;                             `redefine'  (function cell redefined from
+;;                                          a macro to a lambda or vice versa,
+;;                                          or redefined to take other args)
+;;                             `obsolete'  (obsolete variables and functions)
+;;                             `noruntime' (calls to functions only defined
+;;                                          within `eval-when-compile')

 ;; byte-compile-compatibility  Whether the compiler should
 ;;                             generate .elc files which can be loaded into
 ;;                             generic emacs 18.
 ;; byte-compile-compatibility  Whether the compiler should
 ;;                             generate .elc files which can be loaded into
 ;;                             generic emacs 18.


@@ -130,7 +126,7 @@
 ;;              (baz 0))
 ;;
 ;;  o  It is possible to open-code a function in the same file it is defined
 ;;              (baz 0))
 ;;
 ;;  o  It is possible to open-code a function in the same file it is defined

-;;     in without having to load that file before compiling it.  the
+;;     in without having to load that file before compiling it.  The

 ;;     byte-compiler has been modified to remember function definitions in
 ;;     the compilation environment in the same way that it remembers macro
 ;;     definitions.
 ;;     byte-compiler has been modified to remember function definitions in
 ;;     the compilation environment in the same way that it remembers macro
 ;;     definitions.


@@ -159,7 +155,7 @@
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!

-    (load-library "byte-run"))
+    (load "byte-run"))

 
 ;; The feature of compiling in a specific target Emacs version
 ;; has been turned off because compile time options are a bad idea.
 
 ;; The feature of compiling in a specific target Emacs version
 ;; has been turned off because compile time options are a bad idea.


@@ -251,7 +247,9 @@ if you change this variable."
   :type 'boolean)
 
 (defcustom byte-compile-compatibility nil
   :type 'boolean)
 
 (defcustom byte-compile-compatibility nil

-  "*Non-nil means generate output that can run in Emacs 18."
+  "*Non-nil means generate output that can run in Emacs 18.
+This only means that it can run in principle, if it doesn't require
+facilities that have been added more recently."

   :group 'bytecomp
   :type 'boolean)
 
   :group 'bytecomp
   :type 'boolean)
 


@@ -351,6 +349,9 @@ Elements of the list may be be:
                      (const callargs) (const redefine)
                      (const obsolete) (const noruntime) (const cl-functions))))
 
                      (const callargs) (const redefine)
                      (const obsolete) (const noruntime) (const cl-functions))))
 

+(defvar byte-compile-not-obsolete-var nil
+  "If non-nil, this is a variable that shouldn't be reported as obsolete.")
+

 (defcustom byte-compile-generate-call-tree nil
   "*Non-nil means collect call-graph information when compiling.
 This records functions were called and from where.
 (defcustom byte-compile-generate-call-tree nil
   "*Non-nil means collect call-graph information when compiling.
 This records functions were called and from where.


@@ -403,6 +404,8 @@ specify different fields to sort on."
 (defvar byte-compile-bound-variables nil
   "List of variables bound in the context of the current form.
 This list lives partly on the stack.")
 (defvar byte-compile-bound-variables nil
   "List of variables bound in the context of the current form.
 This list lives partly on the stack.")

+(defvar byte-compile-const-variables nil
+  "List of variables declared as constants during compilation of this file.")

 (defvar byte-compile-free-references)
 (defvar byte-compile-free-assignments)
 
 (defvar byte-compile-free-references)
 (defvar byte-compile-free-assignments)
 


@@ -439,6 +442,11 @@ Each element looks like (FUNCTIONNAME . DEFINITION).  It is
 Used for warnings when the function is not known to be defined or is later
 defined with incorrect args.")
 
 Used for warnings when the function is not known to be defined or is later
 defined with incorrect args.")
 

+(defvar byte-compile-noruntime-functions nil
+  "Alist of functions called that may not be defined when the compiled code is run.
+Used for warnings about calling a function that is defined during compilation
+but won't necessarily be defined when the compiled file is loaded.")
+

 (defvar byte-compile-tag-number 0)
 (defvar byte-compile-output nil
   "Alist describing contents to put in byte code string.
 (defvar byte-compile-tag-number 0)
 (defvar byte-compile-output nil
   "Alist describing contents to put in byte code string.


@@ -707,8 +715,7 @@ otherwise pop it")
   (let ((pc 0)                 ; Program counter
        op off                  ; Operation & offset
        (bytes '())             ; Put the output bytes here
   (let ((pc 0)                 ; Program counter
        op off                  ; Operation & offset
        (bytes '())             ; Put the output bytes here

-       (patchlist nil)         ; List of tags and goto's to patch
-       rest rel tmp)
+       (patchlist nil))        ; List of tags and goto's to patch

     (while lap
       (setq op (car (car lap))
            off (cdr (car lap)))
     (while lap
       (setq op (car (car lap))
            off (cdr (car lap)))


@@ -772,7 +779,7 @@ otherwise pop it")
 
 (defun byte-compile-eval (form)
   "Eval FORM and mark the functions defined therein.
 
 (defun byte-compile-eval (form)
   "Eval FORM and mark the functions defined therein.

-Each function's symbol gets marked with the `byte-compile-noruntime' property."
+Each function's symbol gets added to `byte-compile-noruntime-functions'."

   (let ((hist-orig load-history)
        (hist-nil-orig current-load-list))
     (prog1 (eval form)
   (let ((hist-orig load-history)
        (hist-nil-orig current-load-list))
     (prog1 (eval form)


@@ -790,19 +797,19 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                  (cond
                   ((symbolp s)
                    (unless (memq s old-autoloads)
                  (cond
                   ((symbolp s)
                    (unless (memq s old-autoloads)

-                     (put s 'byte-compile-noruntime t)))
+                     (push s byte-compile-noruntime-functions)))

                   ((and (consp s) (eq t (car s)))
                   ((and (consp s) (eq t (car s)))

-                   (push s old-autoloads))
+                   (push (cdr s) old-autoloads))

                   ((and (consp s) (eq 'autoload (car s)))
                   ((and (consp s) (eq 'autoload (car s)))

-                   (put (cdr s) 'byte-compile-noruntime t)))))))
+                   (push (cdr s) byte-compile-noruntime-functions)))))))

          ;; Go through current-load-list for the locally defined funs.
          (let (old-autoloads)
            (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
              (let ((s (pop hist-nil-new)))
                (when (and (symbolp s) (not (memq s old-autoloads)))
          ;; Go through current-load-list for the locally defined funs.
          (let (old-autoloads)
            (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
              (let ((s (pop hist-nil-new)))
                (when (and (symbolp s) (not (memq s old-autoloads)))

-                 (put s 'byte-compile-noruntime t))
+                 (push s byte-compile-noruntime-functions))

                (when (and (consp s) (eq t (car s)))
                (when (and (consp s) (eq t (car s)))

-                 (push s old-autoloads))))))))))
+                 (push (cdr s) old-autoloads))))))))))

 
 (defun byte-compile-eval-before-compile (form)
   "Evaluate FORM for `eval-and-compile'."
 
 (defun byte-compile-eval-before-compile (form)
   "Evaluate FORM for `eval-and-compile'."


@@ -925,7 +932,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
     (when (or (and byte-compile-current-file
                   (not (equal byte-compile-current-file
                               byte-compile-last-logged-file)))
     (when (or (and byte-compile-current-file
                   (not (equal byte-compile-current-file
                               byte-compile-last-logged-file)))

-             (and byte-compile-last-warned-form
+             (and byte-compile-current-form

                   (not (eq byte-compile-current-form
                            byte-compile-last-warned-form))))
       (insert (format "\nIn %s:\n" form)))
                   (not (eq byte-compile-current-form
                            byte-compile-last-warned-form))))
       (insert (format "\nIn %s:\n" form)))


@@ -948,7 +955,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
        (not noninteractive)
        (save-excursion
   (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
        (not noninteractive)
        (save-excursion

-        (byte-goto-log-buffer)
+        (set-buffer (get-buffer-create "*Compile-Log*"))

         (goto-char (point-max))
         (let* ((dir (and byte-compile-current-file
                          (file-name-directory byte-compile-current-file)))
         (goto-char (point-max))
         (let* ((dir (and byte-compile-current-file
                          (file-name-directory byte-compile-current-file)))


@@ -971,14 +978,18 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
             (setq default-directory dir)
             (unless was-same
               (insert (format "Entering directory `%s'\n" default-directory))))
             (setq default-directory dir)
             (unless was-same
               (insert (format "Entering directory `%s'\n" default-directory))))

-          (setq byte-compile-last-logged-file byte-compile-current-file)
+          (setq byte-compile-last-logged-file byte-compile-current-file
+                byte-compile-last-warned-form nil)
+          ;; Do this after setting default-directory.
+          (unless (eq major-mode 'compilation-mode)
+            (compilation-mode))

           pt))))
 
 ;; Log a message STRING in *Compile-Log*.
 ;; Also log the current function and file if not already done.
 (defun byte-compile-log-warning (string &optional fill level)
   (let ((warning-prefix-function 'byte-compile-warning-prefix)
           pt))))
 
 ;; Log a message STRING in *Compile-Log*.
 ;; Also log the current function and file if not already done.
 (defun byte-compile-log-warning (string &optional fill level)
   (let ((warning-prefix-function 'byte-compile-warning-prefix)

-       (warning-group-format "")
+       (warning-type-format "")

        (warning-fill-prefix (if fill "    ")))
     (display-warning 'bytecomp string level "*Compile-Log*")))
 
        (warning-fill-prefix (if fill "    ")))
     (display-warning 'bytecomp string level "*Compile-Log*")))
 


@@ -1162,10 +1173,11 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
               "requires"
             "accepts only")
           (byte-compile-arglist-signature-string sig))))
               "requires"
             "accepts only")
           (byte-compile-arglist-signature-string sig))))

+    (byte-compile-format-warn form)

     ;; Check to see if the function will be available at runtime
     ;; and/or remember its arity if it's unknown.
     (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.
     ;; Check to see if the function will be available at runtime
     ;; and/or remember its arity if it's unknown.
     (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.

-            (not (get (car form) 'byte-compile-noruntime)))
+            (not (memq (car form) byte-compile-noruntime-functions)))

        (eq (car form) byte-compile-current-form) ; ## this doesn't work
                                        ; with recursion.
        ;; It's a currently-undefined function.
        (eq (car form) byte-compile-current-form) ; ## this doesn't work
                                        ; with recursion.
        ;; It's a currently-undefined function.


@@ -1179,6 +1191,32 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                  (cons (list (car form) n)
                        byte-compile-unresolved-functions)))))))
 
                  (cons (list (car form) n)
                        byte-compile-unresolved-functions)))))))
 

+(defun byte-compile-format-warn (form)
+  "Warn if FORM is `format'-like with inconsistent args.
+Applies if head of FORM is a symbol with non-nil property
+`byte-compile-format-like' and first arg is a constant string.
+Then check the number of format fields matches the number of
+extra args."
+  (when (and (symbolp (car form))
+            (stringp (nth 1 form))
+            (get (car form) 'byte-compile-format-like))
+    (let ((nfields (with-temp-buffer
+                    (insert (nth 1 form))
+                    (goto-char 1)
+                    (let ((n 0))
+                      (while (re-search-forward "%." nil t)
+                        (unless (eq ?% (char-after (1+ (match-beginning 0))))
+                          (setq n (1+ n))))
+                      n)))
+         (nargs (- (length form) 2)))
+      (unless (= nargs nfields)
+       (byte-compile-warn
+        "`%s' called with %d args to fill %d format field(s)" (car form)
+        nargs nfields)))))
+
+(dolist (elt '(format message error))
+  (put elt 'byte-compile-format-like t))
+

 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (form macrop)
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (form macrop)


@@ -1246,7 +1284,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   (let ((func (car-safe form)))
     (if (and byte-compile-cl-functions
             (memq func byte-compile-cl-functions)
   (let ((func (car-safe form)))
     (if (and byte-compile-cl-functions
             (memq func byte-compile-cl-functions)

-            ;; Aliases which won't have been expended at this point.
+            ;; Aliases which won't have been expanded at this point.

             ;; These aren't all aliases of subrs, so not trivial to
             ;; avoid hardwiring the list.
             (not (memq func
             ;; These aren't all aliases of subrs, so not trivial to
             ;; avoid hardwiring the list.
             (not (memq func


@@ -1260,7 +1298,15 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                          ;; These would sometimes be warned about
                          ;; but such warnings are never useful,
                          ;; so don't warn about them.
                          ;; These would sometimes be warned about
                          ;; but such warnings are never useful,
                          ;; so don't warn about them.

-                         macroexpand cl-macroexpand-all cl-compiling-file))))
+                         macroexpand cl-macroexpand-all
+                         cl-compiling-file)))
+            ;; Avoid warnings for things which are safe because they
+            ;; have suitable compiler macros, but those aren't
+            ;; expanded at this stage.  There should probably be more
+            ;; here than caaar and friends.
+            (not (and (eq (get func 'byte-compile)
+                          'cl-byte-compile-compiler-macro)
+                      (string-match "\\`c[ad]+r\\'" (symbol-name func)))))

        (byte-compile-warn "Function `%s' from cl package called at runtime"
                           func)))
   form)
        (byte-compile-warn "Function `%s' from cl package called at runtime"
                           func)))
   form)


@@ -1314,9 +1360,13 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   nil)
 
 \f
   nil)
 
 \f

-(defsubst byte-compile-const-symbol-p (symbol)
+(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
+  "Non-nil if SYMBOL is constant.
+If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
+symbol itself."

   (or (memq symbol '(nil t))
   (or (memq symbol '(nil t))

-      (keywordp symbol)))
+      (keywordp symbol)
+      (if any-value (memq symbol byte-compile-const-variables))))

 
 (defmacro byte-compile-constp (form)
   "Return non-nil if FORM is a constant."
 
 (defmacro byte-compile-constp (form)
   "Return non-nil if FORM is a constant."


@@ -1336,6 +1386,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                 (copy-alist byte-compile-initial-macro-environment))
                (byte-compile-function-environment nil)
                (byte-compile-bound-variables nil)
                 (copy-alist byte-compile-initial-macro-environment))
                (byte-compile-function-environment nil)
                (byte-compile-bound-variables nil)

+               (byte-compile-const-variables nil)

                (byte-compile-free-references nil)
                (byte-compile-free-assignments nil)
                ;;
                (byte-compile-free-references nil)
                (byte-compile-free-assignments nil)
                ;;


@@ -1418,8 +1469,11 @@ recompile every `.el' file that already has a `.elc' file."
     (save-some-buffers)
     (force-mode-line-update))
   (save-current-buffer
     (save-some-buffers)
     (force-mode-line-update))
   (save-current-buffer

-    (byte-goto-log-buffer)
-    (setq default-directory directory)
+    (set-buffer (get-buffer-create "*Compile-Log*"))
+    (setq default-directory (expand-file-name directory))
+    ;; compilation-mode copies value of default-directory.
+    (unless (eq major-mode 'compilation-mode)
+      (compilation-mode))

     (let ((directories (list (expand-file-name directory)))
          (default-directory default-directory)
          (skip-count 0)
     (let ((directories (list (expand-file-name directory)))
          (default-directory default-directory)
          (skip-count 0)


@@ -1435,7 +1489,8 @@ recompile every `.el' file that already has a `.elc' file."
               source dest)
           (dolist (file files)
             (setq source (expand-file-name file directory))
               source dest)
           (dolist (file files)
             (setq source (expand-file-name file directory))

-            (if (and (not (member file '("." ".." "RCS" "CVS")))
+            (if (and (not (member file '("RCS" "CVS")))
+                     (not (eq ?\. (aref file 0)))

                      (file-directory-p source)
                      (not (file-symlink-p source)))
                 ;; This file is a subdirectory.  Handle them differently.
                      (file-directory-p source)
                      (not (file-symlink-p source)))
                 ;; This file is a subdirectory.  Handle them differently.


@@ -1533,8 +1588,8 @@ The value is non-nil if there were no errors, nil if errors."
       ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
       (set-buffer-multibyte t)
       (insert-file-contents filename)
       ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
       (set-buffer-multibyte t)
       (insert-file-contents filename)

-      ;; Mimic the way after-insert-file-set-buffer-file-coding-system
-      ;; can make the buffer unibyte when visiting this file.
+      ;; Mimic the way after-insert-file-set-coding can make the
+      ;; buffer unibyte when visiting this file.

       (when (or (eq last-coding-system-used 'no-conversion)
                (eq (coding-system-type last-coding-system-used) 5))
        ;; For coding systems no-conversion and raw-text...,
       (when (or (eq last-coding-system-used 'no-conversion)
                (eq (coding-system-type last-coding-system-used) 5))
        ;; For coding systems no-conversion and raw-text...,


@@ -1553,11 +1608,14 @@ The value is non-nil if there were no errors, nil if errors."
     ;; compile this file.
     (if (with-current-buffer input-buffer no-byte-compile)
        (progn
     ;; compile this file.
     (if (with-current-buffer input-buffer no-byte-compile)
        (progn

-         (message "%s not compiled because of `no-byte-compile: %s'"
-                  (file-relative-name filename)
-                  (with-current-buffer input-buffer no-byte-compile))
-         (if (file-exists-p target-file)
-             (condition-case nil (delete-file target-file) (error nil)))
+         ;; (message "%s not compiled because of `no-byte-compile: %s'"
+         ;;       (file-relative-name filename)
+         ;;       (with-current-buffer input-buffer no-byte-compile))
+         (when (file-exists-p target-file)
+           (message "%s deleted because of `no-byte-compile: %s'"
+                    (file-relative-name 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
          ;; We successfully didn't compile this file.
          'no-byte-compile)
       (when byte-compile-verbose


@@ -1634,7 +1692,7 @@ The value is non-nil if there were no errors, nil if errors."
 ;;;###autoload
 (defun compile-defun (&optional arg)
   "Compile and evaluate the current top-level form.
 ;;;###autoload
 (defun compile-defun (&optional arg)
   "Compile and evaluate the current top-level form.

-Print the result in the minibuffer.
+Print the result in the echo area.

 With argument, insert value in current buffer after the form."
   (interactive "P")
   (save-excursion
 With argument, insert value in current buffer after the form."
   (interactive "P")
   (save-excursion


@@ -1721,6 +1779,9 @@ With argument, insert value in current buffer after the form."
            (byte-compile-file-form form)))
        ;; Compile pending forms at end of file.
        (byte-compile-flush-pending)
            (byte-compile-file-form form)))
        ;; Compile pending forms at end of file.
        (byte-compile-flush-pending)

+       ;; Make warnings about unresolved functions
+       ;; give the end of the file as their position.
+       (setq byte-compile-last-position (point-max))

        (byte-compile-warn-about-unresolved-functions)
        ;; Should we always do this?  When calling multiple files, it
        ;; would be useful to delay this warning until all have
        (byte-compile-warn-about-unresolved-functions)
        ;; Should we always do this?  When calling multiple files, it
        ;; would be useful to delay this warning until all have


@@ -1732,8 +1793,7 @@ With argument, insert value in current buffer after the form."
     outbuffer))
 
 (defun byte-compile-fix-header (filename inbuffer outbuffer)
     outbuffer))
 
 (defun byte-compile-fix-header (filename inbuffer outbuffer)

-  (save-excursion
-    (set-buffer outbuffer)
+  (with-current-buffer outbuffer

     ;; See if the buffer has any multibyte characters.
     (when (< (point-max) (position-bytes (point-max)))
       (when (byte-compile-version-cond byte-compile-compatibility)
     ;; See if the buffer has any multibyte characters.
     (when (< (point-max) (position-bytes (point-max)))
       (when (byte-compile-version-cond byte-compile-compatibility)


@@ -1796,10 +1856,7 @@ With argument, insert value in current buffer after the form."
            " on "
            (current-time-string) "\n;;; from file " filename "\n")
     (insert ";;; in Emacs version " emacs-version "\n")
            " on "
            (current-time-string) "\n;;; from file " filename "\n")
     (insert ";;; in Emacs version " emacs-version "\n")

-    (insert ";;; with bytecomp version "
-           (progn (string-match "[0-9.]+" byte-compile-version)
-                  (match-string 0 byte-compile-version))
-           "\n;;; "
+    (insert ";;; "

            (cond
             ((eq byte-optimize 'source) "with source-level optimization only")
             ((eq byte-optimize 'byte) "with byte-level optimization only")
            (cond
             ((eq byte-optimize 'source) "with source-level optimization only")
             ((eq byte-optimize 'byte) "with byte-level optimization only")


@@ -1877,6 +1934,8 @@ With argument, insert value in current buffer after the form."
       (prin1 form outbuffer)
       nil)))
 
       (prin1 form outbuffer)
       nil)))
 

+(defvar print-gensym-alist)            ;Used before print-circle existed.
+

 (defun byte-compile-output-docform (preface name info form specindex quoted)
   "Print a form with a doc string.  INFO is (prefix doc-index postfix).
 If PREFACE and NAME are non-nil, print them too,
 (defun byte-compile-output-docform (preface name info form specindex quoted)
   "Print a form with a doc string.  INFO is (prefix doc-index postfix).
 If PREFACE and NAME are non-nil, print them too,


@@ -1927,8 +1986,7 @@ list that represents a doc string reference.
               ;; print-gensym-alist not to be cleared
               ;; between calls to print functions.
               (print-gensym '(t))
               ;; print-gensym-alist not to be cleared
               ;; between calls to print functions.
               (print-gensym '(t))

-              ;; print-gensym-alist was used before print-circle existed.
-              print-gensym-alist
+              print-gensym-alist    ; was used before print-circle existed.

               (print-continuous-numbering t)
               print-number-table
               (index 0))
               (print-continuous-numbering t)
               print-number-table
               (index 0))


@@ -2022,10 +2080,10 @@ list that represents a doc string reference.
 
 (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
 (defun byte-compile-file-form-defsubst (form)
 
 (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
 (defun byte-compile-file-form-defsubst (form)

-  (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
-        (setq byte-compile-current-form (nth 1 form))
-        (byte-compile-warn "defsubst %s was used before it was defined"
-                           (nth 1 form))))
+  (when (assq (nth 1 form) byte-compile-unresolved-functions)
+    (setq byte-compile-current-form (nth 1 form))
+    (byte-compile-warn "defsubst %s was used before it was defined"
+                      (nth 1 form)))

   (byte-compile-file-form
    (macroexpand form byte-compile-macro-environment))
   ;; Return nil so the form is not output twice.
   (byte-compile-file-form
    (macroexpand form byte-compile-macro-environment))
   ;; Return nil so the form is not output twice.


@@ -2058,9 +2116,10 @@ list that represents a doc string reference.
       ;; Since there is no doc string, we can compile this as a normal form,
       ;; and not do a file-boundary.
       (byte-compile-keep-pending form)
       ;; Since there is no doc string, we can compile this as a normal form,
       ;; and not do a file-boundary.
       (byte-compile-keep-pending form)

-    (if (memq 'free-vars byte-compile-warnings)
-       (setq byte-compile-bound-variables
-             (cons (nth 1 form) byte-compile-bound-variables)))
+    (when (memq 'free-vars byte-compile-warnings)
+      (push (nth 1 form) byte-compile-bound-variables)
+      (if (eq (car form) 'defconst)
+         (push (nth 1 form) byte-compile-const-variables)))

     (cond ((consp (nth 2 form))
           (setq form (copy-sequence form))
           (setcar (cdr (cdr form))
     (cond ((consp (nth 2 form))
           (setq form (copy-sequence form))
           (setcar (cdr (cdr form))


@@ -2070,9 +2129,8 @@ list that represents a doc string reference.
 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-custom-declare-variable)
 (defun byte-compile-file-form-custom-declare-variable (form)
 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-custom-declare-variable)
 (defun byte-compile-file-form-custom-declare-variable (form)

-  (if (memq 'free-vars byte-compile-warnings)
-      (setq byte-compile-bound-variables
-           (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
+  (when (memq 'free-vars byte-compile-warnings)
+    (push (nth 1 (nth 1 form)) byte-compile-bound-variables))

   (let ((tail (nthcdr 4 form)))
     (while tail
       ;; If there are any (function (lambda ...)) expressions, compile
   (let ((tail (nthcdr 4 form)))
     (while tail
       ;; If there are any (function (lambda ...)) expressions, compile


@@ -2378,8 +2436,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (when (symbolp arg)
          (byte-compile-set-symbol-position arg))
        (cond ((or (not (symbolp arg))
        (when (symbolp arg)
          (byte-compile-set-symbol-position arg))
        (cond ((or (not (symbolp arg))

-                  (keywordp arg)
-                  (memq arg '(t nil)))
+                  (byte-compile-const-symbol-p arg t))

               (error "Invalid lambda variable %s" arg))
              ((eq arg '&rest)
               (unless (cdr list)
               (error "Invalid lambda variable %s" arg))
              ((eq arg '&rest)
               (unless (cdr list)


@@ -2417,30 +2474,35 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                    (if (cdr body)
                        (setq body (cdr body))))))
         (int (assq 'interactive body)))
                    (if (cdr body)
                        (setq body (cdr body))))))
         (int (assq 'interactive body)))

-    (cond (int
-          (byte-compile-set-symbol-position 'interactive)
-          ;; Skip (interactive) if it is in front (the most usual location).
-          (if (eq int (car body))
-              (setq body (cdr body)))
-          (cond ((consp (cdr int))
-                 (if (cdr (cdr int))
-                     (byte-compile-warn "malformed interactive spec: %s"
-                                        (prin1-to-string int)))
-                 ;; If the interactive spec is a call to `list',
-                 ;; don't compile it, because `call-interactively'
-                 ;; looks at the args of `list'.
-                 (let ((form (nth 1 int)))
-                   (while (memq (car-safe form) '(let let* progn save-excursion))
-                     (while (consp (cdr form))
-                       (setq form (cdr form)))
-                     (setq form (car form)))
-                   (or (eq (car-safe form) 'list)
-                       (setq int (list 'interactive
-                                       (byte-compile-top-level (nth 1 int)))))))
-                ((cdr int)
-                 (byte-compile-warn "malformed interactive spec: %s"
-                                    (prin1-to-string int))))))
+    ;; Process the interactive spec.
+    (when int
+      (byte-compile-set-symbol-position 'interactive)
+      ;; Skip (interactive) if it is in front (the most usual location).
+      (if (eq int (car body))
+         (setq body (cdr body)))
+      (cond ((consp (cdr int))
+            (if (cdr (cdr int))
+                (byte-compile-warn "malformed interactive spec: %s"
+                                   (prin1-to-string int)))
+            ;; If the interactive spec is a call to `list', don't
+            ;; compile it, because `call-interactively' looks at the
+            ;; args of `list'.  Actually, compile it to get warnings,
+            ;; but don't use the result.
+            (let ((form (nth 1 int)))
+              (while (memq (car-safe form) '(let let* progn save-excursion))
+                (while (consp (cdr form))
+                  (setq form (cdr form)))
+                (setq form (car form)))
+              (if (eq (car-safe form) 'list)
+                  (byte-compile-top-level (nth 1 int))
+                (setq int (list 'interactive
+                                (byte-compile-top-level (nth 1 int)))))))
+           ((cdr int)
+            (byte-compile-warn "malformed interactive spec: %s"
+                               (prin1-to-string int)))))
+    ;; Process the body.

     (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
     (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))

+      ;; Build the actual byte-coded function.

       (if (and (eq 'byte-code (car-safe compiled))
               (not (byte-compile-version-cond
                     byte-compile-compatibility)))
       (if (and (eq 'byte-code (car-safe compiled))
               (not (byte-compile-version-cond
                     byte-compile-compatibility)))


@@ -2671,14 +2733,17 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-variable-ref (base-op var)
   (when (symbolp var)
     (byte-compile-set-symbol-position var))
 (defun byte-compile-variable-ref (base-op var)
   (when (symbolp var)
     (byte-compile-set-symbol-position var))

-  (if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
-      (byte-compile-warn (if (eq base-op 'byte-varbind)
-                            "attempt to let-bind %s %s"
-                          "variable reference to %s %s")
-                        (if (symbolp var) "constant" "nonvariable")
-                        (prin1-to-string var))
+  (if (or (not (symbolp var))
+         (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
+      (byte-compile-warn
+       (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s %s")
+            ((eq base-op 'byte-varset) "variable assignment to %s %s")
+            (t "variable reference to %s %s"))
+       (if (symbolp var) "constant" "nonvariable")
+       (prin1-to-string var))

     (if (and (get var 'byte-obsolete-variable)
     (if (and (get var 'byte-obsolete-variable)

-            (memq 'obsolete byte-compile-warnings))
+            (memq 'obsolete byte-compile-warnings)
+            (not (eq var byte-compile-not-obsolete-var)))

        (let* ((ob (get var 'byte-obsolete-variable))
               (when (cdr ob)))
          (byte-compile-warn "%s is an obsolete variable%s; %s" var
        (let* ((ob (get var 'byte-obsolete-variable))
               (when (cdr ob)))
          (byte-compile-warn "%s is an obsolete variable%s; %s" var


@@ -2688,30 +2753,28 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                               (format "use %s instead." (car ob))))))
     (if (memq 'free-vars byte-compile-warnings)
        (if (eq base-op 'byte-varbind)
                               (format "use %s instead." (car ob))))))
     (if (memq 'free-vars byte-compile-warnings)
        (if (eq base-op 'byte-varbind)

-           (setq byte-compile-bound-variables
-                 (cons var byte-compile-bound-variables))
+           (push var byte-compile-bound-variables)

          (or (boundp var)
              (memq var byte-compile-bound-variables)
              (if (eq base-op 'byte-varset)
                  (or (memq var byte-compile-free-assignments)
                      (progn
                        (byte-compile-warn "assignment to free variable %s" var)
          (or (boundp var)
              (memq var byte-compile-bound-variables)
              (if (eq base-op 'byte-varset)
                  (or (memq var byte-compile-free-assignments)
                      (progn
                        (byte-compile-warn "assignment to free variable %s" var)

-                       (setq byte-compile-free-assignments
-                             (cons var byte-compile-free-assignments))))
+                       (push var byte-compile-free-assignments)))

                (or (memq var byte-compile-free-references)
                    (progn
                      (byte-compile-warn "reference to free variable %s" var)
                (or (memq var byte-compile-free-references)
                    (progn
                      (byte-compile-warn "reference to free variable %s" var)

-                     (setq byte-compile-free-references
-                           (cons var byte-compile-free-references)))))))))
+                     (push var byte-compile-free-references))))))))

   (let ((tmp (assq var byte-compile-variables)))
   (let ((tmp (assq var byte-compile-variables)))

-    (or tmp
-       (setq tmp (list var)
-             byte-compile-variables (cons tmp byte-compile-variables)))
+    (unless tmp
+      (setq tmp (list var))
+      (push tmp byte-compile-variables))

     (byte-compile-out base-op tmp)))
 
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)
     (byte-compile-out base-op tmp)))
 
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)

-          (assoc ,const byte-compile-constants)
+          (assoc-default ,const byte-compile-constants
+                         'equal-including-properties nil)

         (assq ,const byte-compile-constants))
        (car (setq byte-compile-constants
                  (cons (list ,const) byte-compile-constants)))))
         (assq ,const byte-compile-constants))
        (car (setq byte-compile-constants
                  (cons (list ,const) byte-compile-constants)))))


@@ -2739,6 +2802,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   ;; If function is a symbol, then the variable "byte-SYMBOL" must name
   ;; the opcode to be used.  If function is a list, the first element
   ;; is the function and the second element is the bytecode-symbol.
   ;; If function is a symbol, then the variable "byte-SYMBOL" must name
   ;; the opcode to be used.  If function is a list, the first element
   ;; is the function and the second element is the bytecode-symbol.

+  ;; The second element may be nil, meaning there is no opcode.

   ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
   ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
   ;; If it is nil, then the handler is "byte-compile-SYMBOL."
   ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
   ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
   ;; If it is nil, then the handler is "byte-compile-SYMBOL."


@@ -2970,10 +3034,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (setq args (cdr args))
        (or args (setq args '(0)
                       opcode (get '+ 'byte-opcode)))
        (setq args (cdr args))
        (or args (setq args '(0)
                       opcode (get '+ 'byte-opcode)))

-       (while args
-         (byte-compile-form (car args))
-         (byte-compile-out opcode 0)
-         (setq args (cdr args))))
+       (dolist (arg args)
+         (byte-compile-form arg)
+         (byte-compile-out opcode 0)))

     (byte-compile-constant (eval form))))
 
 \f
     (byte-compile-constant (eval form))))
 
 \f


@@ -3236,51 +3299,55 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
     ,tag))
 
       (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
     ,tag))
 

+(defmacro byte-compile-maybe-guarded (condition &rest body)
+  "Execute forms in BODY, potentially guarded by CONDITION.
+CONDITION is the test in an `if' form or in a `cond' clause.
+BODY is to compile the first arm of the if or the body of the
+cond clause.  If CONDITION is of the form `(foundp 'foo)'
+or `(boundp 'foo)', the relevant warnings from BODY about foo
+being undefined will be suppressed."
+  (declare (indent 1) (debug t))
+  `(let* ((fbound
+          (if (eq 'fboundp (car-safe ,condition))
+              (and (eq 'quote (car-safe (nth 1 ,condition)))
+                   ;; Ignore if the symbol is already on the
+                   ;; unresolved list.
+                   (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol
+                              byte-compile-unresolved-functions))
+                   (nth 1 (nth 1 ,condition)))))
+         (bound (if (or (eq 'boundp (car-safe ,condition))
+                        (eq 'default-boundp (car-safe ,condition)))
+                    (and (eq 'quote (car-safe (nth 1 ,condition)))
+                         (nth 1 (nth 1 ,condition)))))
+         ;; Maybe add to the bound list.
+         (byte-compile-bound-variables
+          (if bound
+              (cons bound byte-compile-bound-variables)
+            byte-compile-bound-variables)))
+     (progn ,@body)
+     ;; Maybe remove the function symbol from the unresolved list.
+     (if fbound
+        (setq byte-compile-unresolved-functions
+              (delq (assq fbound byte-compile-unresolved-functions)
+                    byte-compile-unresolved-functions)))))
+

 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
   ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
   ;; and avoid warnings about the relevent symbols in the consequent.
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
   ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
   ;; and avoid warnings about the relevent symbols in the consequent.

-  (let* ((clause (nth 1 form))
-        (fbound (if (eq 'fboundp (car-safe clause))
-                    (and (eq 'quote (car-safe (nth 1 clause)))
-                         ;; Ignore if the symbol is already on the
-                         ;; unresolved list.
-                         (not (assq
-                               (nth 1 (nth 1 clause)) ; the relevant symbol
-                               byte-compile-unresolved-functions))
-                         (nth 1 (nth 1 clause)))))
-        (bound (if (eq 'boundp (car-safe clause))
-                   (and (eq 'quote (car-safe (nth 1 clause)))
-                        (nth 1 (nth 1 clause)))))
-        (donetag (byte-compile-make-tag)))
+  (let ((clause (nth 1 form))
+       (donetag (byte-compile-make-tag)))

     (if (null (nthcdr 3 form))
        ;; No else-forms
        (progn
          (byte-compile-goto-if nil for-effect donetag)
     (if (null (nthcdr 3 form))
        ;; No else-forms
        (progn
          (byte-compile-goto-if nil for-effect donetag)

-         ;; Maybe add to the bound list.
-         (let ((byte-compile-bound-variables
-                (if bound
-                    (cons bound byte-compile-bound-variables)
-                  byte-compile-bound-variables)))
+         (byte-compile-maybe-guarded clause

            (byte-compile-form (nth 2 form) for-effect))
            (byte-compile-form (nth 2 form) for-effect))

-         ;; Maybe remove the function symbol from the unresolved list.
-         (if fbound
-             (setq byte-compile-unresolved-functions
-                   (delq (assq fbound byte-compile-unresolved-functions)
-                         byte-compile-unresolved-functions)))

          (byte-compile-out-tag donetag))
       (let ((elsetag (byte-compile-make-tag)))
        (byte-compile-goto 'byte-goto-if-nil elsetag)
          (byte-compile-out-tag donetag))
       (let ((elsetag (byte-compile-make-tag)))
        (byte-compile-goto 'byte-goto-if-nil elsetag)

-       ;; As above for the first form.
-       (let ((byte-compile-bound-variables
-                (if bound
-                    (cons bound byte-compile-bound-variables)
-                  byte-compile-bound-variables)))
-           (byte-compile-form (nth 2 form) for-effect))
-       (if fbound
-           (setq byte-compile-unresolved-functions
-                 (delq (assq fbound byte-compile-unresolved-functions)
-                       byte-compile-unresolved-functions)))
+       (byte-compile-maybe-guarded clause
+         (byte-compile-form (nth 2 form) for-effect))

        (byte-compile-goto 'byte-goto donetag)
        (byte-compile-out-tag elsetag)
        (byte-compile-body (cdr (cdr (cdr form))) for-effect)
        (byte-compile-goto 'byte-goto donetag)
        (byte-compile-out-tag elsetag)
        (byte-compile-body (cdr (cdr (cdr form))) for-effect)


@@ -3303,17 +3370,20 @@ If FORM is a lambda or a macro, byte-compile it as a function."
             (if (null (cdr clause))
                 ;; First clause is a singleton.
                 (byte-compile-goto-if t for-effect donetag)
             (if (null (cdr clause))
                 ;; First clause is a singleton.
                 (byte-compile-goto-if t for-effect donetag)

-              (setq nexttag (byte-compile-make-tag))
-              (byte-compile-goto 'byte-goto-if-nil nexttag)
-              (byte-compile-body (cdr clause) for-effect)
-              (byte-compile-goto 'byte-goto donetag)
-              (byte-compile-out-tag nexttag)))))
+                (setq nexttag (byte-compile-make-tag))
+                (byte-compile-goto 'byte-goto-if-nil nexttag)
+                (byte-compile-maybe-guarded (car clause)
+                  (byte-compile-body (cdr clause) for-effect))
+                (byte-compile-goto 'byte-goto donetag)
+                (byte-compile-out-tag nexttag)))))

     ;; Last clause
     ;; Last clause

-    (and (cdr clause) (not (eq (car clause) t))
-        (progn (byte-compile-form (car clause))
-               (byte-compile-goto-if nil for-effect donetag)
-               (setq clause (cdr clause))))
-    (byte-compile-body-do-effect clause)
+    (let ((guard (car clause)))
+      (and (cdr clause) (not (eq guard t))
+          (progn (byte-compile-form guard)
+                 (byte-compile-goto-if nil for-effect donetag)
+                 (setq clause (cdr clause))))
+      (byte-compile-maybe-guarded guard
+       (byte-compile-body-do-effect clause)))

     (byte-compile-out-tag donetag)))
 
 (defun byte-compile-and (form)
     (byte-compile-out-tag donetag)))
 
 (defun byte-compile-and (form)


@@ -3359,31 +3429,26 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-let (form)
   ;; First compute the binding values in the old scope.
   (let ((varlist (car (cdr form))))
 (defun byte-compile-let (form)
   ;; First compute the binding values in the old scope.
   (let ((varlist (car (cdr form))))

-    (while varlist
-      (if (consp (car varlist))
-         (byte-compile-form (car (cdr (car varlist))))
-       (byte-compile-push-constant nil))
-      (setq varlist (cdr varlist))))
+    (dolist (var varlist)
+      (if (consp var)
+         (byte-compile-form (car (cdr var)))
+       (byte-compile-push-constant nil))))

   (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
        (varlist (reverse (car (cdr form)))))
   (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
        (varlist (reverse (car (cdr form)))))

-    (while varlist
-      (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist))
-                                                  (car (car varlist))
-                                                (car varlist)))
-      (setq varlist (cdr varlist)))
+    (dolist (var varlist)
+      (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))

     (byte-compile-body-do-effect (cdr (cdr form)))
     (byte-compile-out 'byte-unbind (length (car (cdr form))))))
 
 (defun byte-compile-let* (form)
   (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
        (varlist (copy-sequence (car (cdr form)))))
     (byte-compile-body-do-effect (cdr (cdr form)))
     (byte-compile-out 'byte-unbind (length (car (cdr form))))))
 
 (defun byte-compile-let* (form)
   (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
        (varlist (copy-sequence (car (cdr form)))))

-    (while varlist
-      (if (atom (car varlist))
+    (dolist (var varlist)
+      (if (atom var)

          (byte-compile-push-constant nil)
          (byte-compile-push-constant nil)

-       (byte-compile-form (car (cdr (car varlist))))
-       (setcar varlist (car (car varlist))))
-      (byte-compile-variable-ref 'byte-varbind (car varlist))
-      (setq varlist (cdr varlist)))
+       (byte-compile-form (car (cdr var)))
+       (setq var (car var)))
+      (byte-compile-variable-ref 'byte-varbind var))

     (byte-compile-body-do-effect (cdr (cdr form)))
     (byte-compile-out 'byte-unbind (length (car (cdr form))))))
 
     (byte-compile-body-do-effect (cdr (cdr form)))
     (byte-compile-out 'byte-unbind (length (car (cdr form))))))
 


@@ -3437,12 +3502,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defun byte-compile-track-mouse (form)
   (byte-compile-form
 
 (defun byte-compile-track-mouse (form)
   (byte-compile-form

-   (list
-    'funcall
-    (list 'quote
-         (list 'lambda nil
-               (cons 'track-mouse
-                     (byte-compile-top-level-body (cdr form))))))))
+   `(funcall '(lambda nil
+               (track-mouse ,@(byte-compile-top-level-body (cdr form)))))))

 
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))
 
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))


@@ -3514,7 +3575,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (byte-compile-out 'byte-temp-output-buffer-setup 0)
   (byte-compile-body (cdr (cdr form)))
   (byte-compile-out 'byte-temp-output-buffer-show 0))
   (byte-compile-out 'byte-temp-output-buffer-setup 0)
   (byte-compile-body (cdr (cdr form)))
   (byte-compile-out 'byte-temp-output-buffer-show 0))

-

 \f
 ;;; top-level forms elsewhere
 
 \f
 ;;; top-level forms elsewhere
 


@@ -3532,11 +3592,22 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (byte-compile-set-symbol-position (car form))
     (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))
       (byte-compile-set-symbol-position (car form))
     (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))

-  (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
-   (list 'fset (list 'quote (nth 1 form))
-        (byte-compile-byte-code-maker
-         (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
-  (byte-compile-discard)
+  (if (byte-compile-version-cond byte-compile-compatibility)
+      (progn
+       (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
+        (list 'fset
+              (list 'quote (nth 1 form))
+              (byte-compile-byte-code-maker
+               (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
+       (byte-compile-discard))
+    ;; We prefer to generate a defalias form so it will record the function
+    ;; definition just like interpreting a defun.
+    (byte-compile-form
+     (list 'defalias
+          (list 'quote (nth 1 form))
+          (byte-compile-byte-code-maker
+           (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))
+     t))

   (byte-compile-constant (nth 1 form)))
 
 (defun byte-compile-defmacro (form)
   (byte-compile-constant (nth 1 form)))
 
 (defun byte-compile-defmacro (form)


@@ -3558,13 +3629,19 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (value (nth 2 form))
        (string (nth 3 form)))
     (byte-compile-set-symbol-position fun)
        (value (nth 2 form))
        (string (nth 3 form)))
     (byte-compile-set-symbol-position fun)

-    (when (> (length form) 4)
-      (byte-compile-warn
-       "%s %s called with %d arguments, but accepts only %s"
-       fun var (length (cdr form)) 3))
+    (when (or (> (length form) 4)
+             (and (eq fun 'defconst) (null (cddr form))))
+      (let ((ncall (length (cdr form))))
+       (byte-compile-warn
+        "%s called with %d argument%s, but %s %s"
+        fun ncall
+        (if (= 1 ncall) "" "s")
+        (if (< ncall 2) "requires" "accepts only")
+        "2-3")))

     (when (memq 'free-vars byte-compile-warnings)
     (when (memq 'free-vars byte-compile-warnings)

-      (setq byte-compile-bound-variables
-           (cons var byte-compile-bound-variables)))
+      (push var byte-compile-bound-variables)
+      (if (eq fun 'defconst)
+         (push var byte-compile-const-variables)))

     (byte-compile-body-do-effect
      (list
       ;; Put the defined variable in this library's load-history entry
     (byte-compile-body-do-effect
      (list
       ;; Put the defined variable in this library's load-history entry


@@ -3577,13 +3654,17 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                             fun var string))
        `(put ',var 'variable-documentation ,string))
       (if (cddr form)          ; `value' provided
                             fun var string))
        `(put ',var 'variable-documentation ,string))
       (if (cddr form)          ; `value' provided

-         (if (eq fun 'defconst)
-             ;; `defconst' sets `var' unconditionally.
-             (let ((tmp (make-symbol "defconst-tmp-var")))
-               `(let ((,tmp ,value))
-                  (eval '(defconst ,var ,tmp))))
-           ;; `defvar' sets `var' only when unbound.
-           `(if (not (boundp ',var)) (setq ,var ,value))))
+         (let ((byte-compile-not-obsolete-var var))
+           (if (eq fun 'defconst)
+               ;; `defconst' sets `var' unconditionally.
+               (let ((tmp (make-symbol "defconst-tmp-var")))
+                 `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
+                           ,value))
+             ;; `defvar' sets `var' only when unbound.
+             `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
+       (when (eq fun 'defconst)
+         ;; This will signal an appropriate error at runtime.
+         `(eval ',form)))

       `',var))))
 
 (defun byte-compile-autoload (form)
       `',var))))
 
 (defun byte-compile-autoload (form)


@@ -3616,8 +3697,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
           (consp (cdr (nth 2 form)))
           (symbolp (nth 1 (nth 2 form))))
       (progn
           (consp (cdr (nth 2 form)))
           (symbolp (nth 1 (nth 2 form))))
       (progn

-       (byte-compile-defalias-warn (nth 1 (nth 1 form))
-                                   (nth 1 (nth 2 form)))
+       (byte-compile-defalias-warn (nth 1 (nth 1 form)))

        (setq byte-compile-function-environment
              (cons (cons (nth 1 (nth 1 form))
                          (nth 1 (nth 2 form)))
        (setq byte-compile-function-environment
              (cons (cons (nth 1 (nth 1 form))
                          (nth 1 (nth 2 form)))


@@ -3627,11 +3707,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Turn off warnings about prior calls to the function being defalias'd.
 ;; This could be smarter and compare those calls with
 ;; the function it is being aliased to.
 ;; Turn off warnings about prior calls to the function being defalias'd.
 ;; This could be smarter and compare those calls with
 ;; the function it is being aliased to.

-(defun byte-compile-defalias-warn (new alias)
+(defun byte-compile-defalias-warn (new)

   (let ((calls (assq new byte-compile-unresolved-functions)))
     (if calls
        (setq byte-compile-unresolved-functions
              (delq calls byte-compile-unresolved-functions)))))
   (let ((calls (assq new byte-compile-unresolved-functions)))
     (if calls
        (setq byte-compile-unresolved-functions
              (delq calls byte-compile-unresolved-functions)))))

+
+(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
+(defun byte-compile-no-warnings (form)
+  (let (byte-compile-warnings)
+    (byte-compile-form (cadr form))))

 \f
 ;;; tags
 
 \f
 ;;; tags
 


@@ -3654,7 +3739,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (setcdr (cdr tag) byte-compile-depth)))
 
 (defun byte-compile-goto (opcode tag)
     (setcdr (cdr tag) byte-compile-depth)))
 
 (defun byte-compile-goto (opcode tag)

-  (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
+  (push (cons opcode tag) byte-compile-output)

   (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
                        (1- byte-compile-depth)
                      byte-compile-depth))
   (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
                        (1- byte-compile-depth)
                      byte-compile-depth))


@@ -3662,7 +3747,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                                (1- byte-compile-depth))))
 
 (defun byte-compile-out (opcode offset)
                                (1- byte-compile-depth))))
 
 (defun byte-compile-out (opcode offset)

-  (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
+  (push (cons opcode offset) byte-compile-output)

   (cond ((eq opcode 'byte-call)
         (setq byte-compile-depth (- byte-compile-depth offset)))
        ((eq opcode 'byte-return)
   (cond ((eq opcode 'byte-call)
         (setq byte-compile-depth (- byte-compile-depth offset)))
        ((eq opcode 'byte-return)


@@ -3946,8 +4031,8 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
 \f
 ;;; report metering (see the hacks in bytecode.c)
 
 \f
 ;;; report metering (see the hacks in bytecode.c)
 

+(defvar byte-code-meter)

 (defun byte-compile-report-ops ()
 (defun byte-compile-report-ops ()

-  (defvar byte-code-meter)

   (with-output-to-temp-buffer "*Meter*"
     (set-buffer "*Meter*")
     (let ((i 0) n op off)
   (with-output-to-temp-buffer "*Meter*"
     (set-buffer "*Meter*")
     (let ((i 0) n op off)


@@ -3996,4 +4081,5 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
 
 (run-hooks 'bytecomp-load-hook)
 
 
 (run-hooks 'bytecomp-load-hook)
 

+;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a

 ;;; bytecomp.el ends here
 ;;; bytecomp.el ends here