(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 6f8322d5ea543bd5a8b6b75df4fc28df1f349981..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
+;; 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.93 $")
-

 ;; 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)
 


@@ -274,7 +272,7 @@ t means do all optimizations.
                 (const :tag "source-level" source)
                 (const :tag "byte-level" byte)))
 
                 (const :tag "source-level" source)
                 (const :tag "byte-level" byte)))
 

-(defcustom byte-compile-delete-errors t
+(defcustom byte-compile-delete-errors nil

   "*If non-nil, the optimizer may delete forms that may signal an error.
 This includes variable references and calls to functions such as `car'."
   :group 'bytecomp
   "*If non-nil, the optimizer may delete forms that may signal an error.
 This includes variable references and calls to functions such as `car'."
   :group 'bytecomp


@@ -327,9 +325,11 @@ If it is 'byte, then only byte-level optimizations will be logged."
   :type 'boolean)
 
 (defconst byte-compile-warning-types
   :type 'boolean)
 
 (defconst byte-compile-warning-types

-  '(redefine callargs free-vars unresolved obsolete noruntime))
+  '(redefine callargs free-vars unresolved obsolete noruntime cl-functions)
+  "The list of warning types used when `byte-compile-warnings' is t.")

 (defcustom byte-compile-warnings t
   "*List of warnings that the byte-compiler should issue (t for all).
 (defcustom byte-compile-warnings t
   "*List of warnings that the byte-compiler should issue (t for all).

+

 Elements of the list may be be:
 
   free-vars   references to variables not in the current lexical scope.
 Elements of the list may be be:
 
   free-vars   references to variables not in the current lexical scope.


@@ -337,13 +337,20 @@ Elements of the list may be be:
   callargs    lambda calls with args that don't match the definition.
   redefine    function cell redefined from a macro to a lambda or vice
               versa, or redefined to take a different number of arguments.
   callargs    lambda calls with args that don't match the definition.
   redefine    function cell redefined from a macro to a lambda or vice
               versa, or redefined to take a different number of arguments.

-  obsolete    obsolete variables and functions."
+  obsolete    obsolete variables and functions.
+  noruntime   functions that may not be defined at runtime (typically
+              defined only under `eval-when-compile').
+  cl-functions    calls to runtime functions from the CL package (as
+                 distinguished from macros and aliases)."

   :group 'bytecomp
   :group 'bytecomp

-  :type '(choice (const :tag "All" t)
+  :type `(choice (const :tag "All" t)

                 (set :menu-tag "Some"
                      (const free-vars) (const unresolved)
                 (set :menu-tag "Some"
                      (const free-vars) (const unresolved)

-                     (const callargs) (const redefined)
-                     (const obsolete) (const noruntime))))
+                     (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.
 
 (defcustom byte-compile-generate-call-tree nil
   "*Non-nil means collect call-graph information when compiling.


@@ -380,6 +387,8 @@ specify different fields to sort on."
   :type '(choice (const name) (const callers) (const calls)
                 (const calls+callers) (const nil)))
 
   :type '(choice (const name) (const callers) (const calls)
                 (const calls+callers) (const nil)))
 

+(defvar byte-compile-debug nil)
+

 ;; (defvar byte-compile-overwrite-file t
 ;;   "If nil, old .elc files are deleted before the new is saved, and .elc
 ;; files will have the same modes as the corresponding .el file.  Otherwise,
 ;; (defvar byte-compile-overwrite-file t
 ;;   "If nil, old .elc files are deleted before the new is saved, and .elc
 ;; files will have the same modes as the corresponding .el file.  Otherwise,


@@ -395,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)
 


@@ -409,7 +420,7 @@ This list lives partly on the stack.")
                                 (byte-compile-eval (byte-compile-top-level
                                                     (cons 'progn body))))))
     (eval-and-compile . (lambda (&rest body)
                                 (byte-compile-eval (byte-compile-top-level
                                                     (cons 'progn body))))))
     (eval-and-compile . (lambda (&rest body)

-                         (eval (cons 'progn body))
+                         (byte-compile-eval-before-compile (cons 'progn body))

                          (cons 'progn body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
                          (cons 'progn body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when


@@ -431,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.


@@ -699,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)))


@@ -764,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)


@@ -774,27 +789,48 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
          ;; Go through load-history, look for newly loaded files
          ;; and mark all the functions defined therein.
          (while (and hist-new (not (eq hist-new hist-orig)))
          ;; Go through load-history, look for newly loaded files
          ;; and mark all the functions defined therein.
          (while (and hist-new (not (eq hist-new hist-orig)))

-           (let ((xs (pop hist-new)))
+           (let ((xs (pop hist-new))
+                 old-autoloads)

              ;; Make sure the file was not already loaded before.
              (unless (assoc (car xs) hist-orig)
                (dolist (s xs)
                  (cond
              ;; Make sure the file was not already loaded before.
              (unless (assoc (car xs) hist-orig)
                (dolist (s xs)
                  (cond

-                  ((symbolp s) (put s 'byte-compile-noruntime t))
+                  ((symbolp s)
+                   (unless (memq s old-autoloads)
+                     (push s byte-compile-noruntime-functions)))
+                  ((and (consp s) (eq t (car s)))
+                   (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.
          ;; Go through current-load-list for the locally defined funs.

-         (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
-           (let ((s (pop hist-nil-new)))
-             (when (symbolp s)
-               (put s 'byte-compile-noruntime t)))))))))
-
+         (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)))
+                 (push s byte-compile-noruntime-functions))
+               (when (and (consp s) (eq t (car s)))
+                 (push (cdr s) old-autoloads))))))))))
+
+(defun byte-compile-eval-before-compile (form)
+  "Evaluate FORM for `eval-and-compile'."
+  (let ((hist-nil-orig current-load-list))
+    (prog1 (eval form)
+      ;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
+      (let ((tem current-load-list))
+       (while (not (eq tem hist-nil-orig))
+         (when (equal (car tem) '(require . cl))
+           (setq byte-compile-warnings
+                 (remq 'cl-functions byte-compile-warnings)))
+         (setq tem (cdr tem)))))))

 \f
 ;;; byte compiler messages
 
 (defvar byte-compile-current-form nil)
 (defvar byte-compile-dest-file nil)
 (defvar byte-compile-current-file nil)
 \f
 ;;; byte compiler messages
 
 (defvar byte-compile-current-form nil)
 (defvar byte-compile-dest-file nil)
 (defvar byte-compile-current-file nil)

+(defvar byte-compile-current-buffer nil)

 
 

+;; Log something that isn't a warning.

 (defmacro byte-compile-log (format-string &rest args)
   (list 'and
        'byte-optimize
 (defmacro byte-compile-log (format-string &rest args)
   (list 'and
        'byte-optimize


@@ -810,100 +846,173 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                           (if (symbolp x) (list 'prin1-to-string x) x))
                         args)))))))
 
                           (if (symbolp x) (list 'prin1-to-string x) x))
                         args)))))))
 

+;; Log something that isn't a warning.
+(defun byte-compile-log-1 (string)
+  (save-excursion
+    (byte-goto-log-buffer)
+    (goto-char (point-max))
+    (byte-compile-warning-prefix nil nil)
+    (cond (noninteractive
+          (message " %s" string))
+         (t
+          (insert (format "%s\n" string))))))
+
+(defvar byte-compile-read-position nil
+  "Character position we began the last `read' from.")
+(defvar byte-compile-last-position nil
+  "Last known character position in the input.")
+
+;; copied from gnus-util.el
+(defsubst byte-compile-delete-first (elt list)
+  (if (eq (car list) elt)
+      (cdr list)
+    (let ((total list))
+      (while (and (cdr list)
+                 (not (eq (cadr list) elt)))
+       (setq list (cdr list)))
+      (when (cdr list)
+       (setcdr list (cddr list)))
+      total)))
+
+;; The purpose of this function is to iterate through the
+;; `read-symbol-positions-list'.  Each time we process, say, a
+;; function definition (`defun') we remove `defun' from
+;; `read-symbol-positions-list', and set `byte-compile-last-position'
+;; to that symbol's character position.  Similarly, if we encounter a
+;; variable reference, like in (1+ foo), we remove `foo' from the
+;; list.  If our current position is after the symbol's position, we
+;; assume we've already passed that point, and look for the next
+;; occurrence of the symbol.
+;; So your're probably asking yourself: Isn't this function a
+;; gross hack?  And the answer, of course, would be yes.
+(defun byte-compile-set-symbol-position (sym &optional allow-previous)
+  (when byte-compile-read-position
+    (let (last entry)
+      (while (progn
+           (setq last byte-compile-last-position
+             entry (assq sym read-symbol-positions-list))
+           (when entry
+           (setq byte-compile-last-position
+             (+ byte-compile-read-position (cdr entry))
+             read-symbol-positions-list
+             (byte-compile-delete-first
+              entry read-symbol-positions-list)))
+              (or (and allow-previous (not (= last byte-compile-last-position)))
+                  (> last byte-compile-last-position)))))))
+

 (defvar byte-compile-last-warned-form nil)
 (defvar byte-compile-last-logged-file nil)
 
 (defvar byte-compile-last-warned-form nil)
 (defvar byte-compile-last-logged-file nil)
 

-(defvar byte-compile-last-line nil
-  "Last known line number in the input.")
-
-
-(defun byte-compile-display-log-head-p ()
-  (and (not (eq byte-compile-current-form :end))
-       (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))))))
-

 (defun byte-goto-log-buffer ()
   (set-buffer (get-buffer-create "*Compile-Log*"))
   (unless (eq major-mode 'compilation-mode)
     (compilation-mode)))
 
 (defun byte-goto-log-buffer ()
   (set-buffer (get-buffer-create "*Compile-Log*"))
   (unless (eq major-mode 'compilation-mode)
     (compilation-mode)))
 

-;; Log a message STRING in *Compile-Log*.
-;; Also log the current function and file if not already done.
-(defun byte-compile-log-1 (string &optional fill)
-  (let* ((file (cond ((stringp byte-compile-current-file)
-                     (format "%s:" byte-compile-current-file))
+;; This is used as warning-prefix for the compiler.
+;; It is always called with the warnings buffer current.
+(defun byte-compile-warning-prefix (level entry)
+  (let* ((dir default-directory)
+        (file (cond ((stringp byte-compile-current-file)
+                     (format "%s:" (file-relative-name byte-compile-current-file dir)))

                     ((bufferp byte-compile-current-file)
                      (format "Buffer %s:"
                              (buffer-name byte-compile-current-file)))
                     (t "")))
         (pos (if (and byte-compile-current-file
                     ((bufferp byte-compile-current-file)
                      (format "Buffer %s:"
                              (buffer-name byte-compile-current-file)))
                     (t "")))
         (pos (if (and byte-compile-current-file

-                      (integerp byte-compile-last-line))
-                 (format "%d:" byte-compile-last-line)
+                      (integerp byte-compile-read-position))
+                 (with-current-buffer byte-compile-current-buffer
+                   (format "%d:%d:" (count-lines (point-min)
+                                                 byte-compile-last-position)
+                           (save-excursion
+                             (goto-char byte-compile-last-position)
+                             (1+ (current-column)))))

                ""))
                ""))

-        (form (or byte-compile-current-form "toplevel form")))
-    (cond (noninteractive
-          (when (byte-compile-display-log-head-p)
-            (message "%s In %s" file form))
-          (message "%s%s %s" file pos string))
-         (t
-          (save-excursion
-             (byte-goto-log-buffer)
-            (goto-char (point-max))
-            (when (byte-compile-display-log-head-p)
-              (insert (format "\nIn %s" form)))
-            (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)))))))
+        (form (if (eq byte-compile-current-form :end) "end of data"
+                (or byte-compile-current-form "toplevel form"))))
+    (when (or (and byte-compile-current-file
+                  (not (equal byte-compile-current-file
+                              byte-compile-last-logged-file)))
+             (and byte-compile-current-form
+                  (not (eq byte-compile-current-form
+                           byte-compile-last-warned-form))))
+      (insert (format "\nIn %s:\n" form)))
+    (when level
+      (insert (format "%s%s" file pos))))

   (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 byte-compile-current-form))
+       byte-compile-last-warned-form byte-compile-current-form)
+  entry)
+
+;; This no-op function is used as the value of warning-series
+;; to tell inner calls to displaying-byte-compile-warnings
+;; not to bind warning-series.
+(defun byte-compile-warning-series (&rest ignore)
+  nil)

 
 ;; 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.

+;; Return the position of the start of the page in the log buffer.

 ;; But do nothing in batch mode.
 (defun byte-compile-log-file ()
 ;; But do nothing in batch mode.
 (defun byte-compile-log-file ()

-  (and byte-compile-current-file
-       (not (equal byte-compile-current-file byte-compile-last-logged-file))
+  (and (not (equal byte-compile-current-file byte-compile-last-logged-file))

        (not noninteractive)
        (save-excursion
        (not noninteractive)
        (save-excursion

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

         (goto-char (point-max))
         (goto-char (point-max))

-        (insert "\n\^L\nCompiling "
-                (if (stringp byte-compile-current-file)
-                    (concat "file " byte-compile-current-file)
-                  (concat "buffer " (buffer-name byte-compile-current-file)))
-                " at " (current-time-string) "\n")
-        (setq byte-compile-last-logged-file byte-compile-current-file))))
+        (let* ((dir (and byte-compile-current-file
+                         (file-name-directory byte-compile-current-file)))
+               (was-same (equal default-directory dir))
+               pt)
+          (when dir
+            (unless was-same
+              (insert (format "Leaving directory `%s'\n" default-directory))))
+          (unless (bolp)
+            (insert "\n"))
+          (setq pt (point-marker))
+          (if byte-compile-current-file
+              (insert "\f\nCompiling "
+                      (if (stringp byte-compile-current-file)
+                          (concat "file " byte-compile-current-file)
+                        (concat "buffer " (buffer-name byte-compile-current-file)))
+                      " at " (current-time-string) "\n")
+            (insert "\f\nCompiling no file at " (current-time-string) "\n"))
+          (when dir
+            (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
+                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)
+       (warning-type-format "")
+       (warning-fill-prefix (if fill "    ")))
+    (display-warning 'bytecomp string level "*Compile-Log*")))

 
 (defun byte-compile-warn (format &rest args)
 
 (defun byte-compile-warn (format &rest args)

+  "Issue a byte compiler warning; use (format FORMAT ARGS...) for message."

   (setq format (apply 'format format args))
   (if byte-compile-error-on-warn
       (error "%s" format)              ; byte-compile-file catches and logs it
   (setq format (apply 'format format args))
   (if byte-compile-error-on-warn
       (error "%s" format)              ; byte-compile-file catches and logs it

-    (byte-compile-log-1 (concat "warning: " format) t)
-    ;; 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))
-    ))
+    (byte-compile-log-warning format t :warning)))

 
 

-;;; This function should be used to report errors that have halted
-;;; compilation of the current file.

 (defun byte-compile-report-error (error-info)
 (defun byte-compile-report-error (error-info)

+  "Report Lisp error in compilation.  ERROR-INFO is the error data."

   (setq byte-compiler-error-flag t)
   (setq byte-compiler-error-flag t)

-  (byte-compile-log-1
-   (concat "error: "
-          (format (if (cdr error-info) "%s (%s)" "%s")
-                  (downcase (get (car error-info) 'error-message))
-                  (prin1-to-string (cdr error-info))))))
+  (byte-compile-log-warning
+   (error-message-string error-info)
+   nil :error))

 
 ;;; Used by make-obsolete.
 (defun byte-compile-obsolete (form)
   (let* ((new (get (car form) 'byte-obsolete-info))
         (handler (nth 1 new))
         (when (nth 2 new)))
 
 ;;; Used by make-obsolete.
 (defun byte-compile-obsolete (form)
   (let* ((new (get (car form) 'byte-obsolete-info))
         (handler (nth 1 new))
         (when (nth 2 new)))

+    (byte-compile-set-symbol-position (car form))

     (if (memq 'obsolete byte-compile-warnings)
        (byte-compile-warn "%s is an obsolete function%s; %s" (car form)
                           (if when (concat " since " when) "")
     (if (memq 'obsolete byte-compile-warnings)
        (byte-compile-warn "%s is an obsolete function%s; %s" (car form)
                           (if when (concat " since " when) "")


@@ -1053,30 +1162,60 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
             (not (numberp (cdr sig))))
        (setcdr sig nil))
     (if sig
             (not (numberp (cdr sig))))
        (setcdr sig nil))
     (if sig

-       (if (or (< ncall (car sig))
+       (when (or (< ncall (car sig))

                (and (cdr sig) (> ncall (cdr sig))))
                (and (cdr sig) (> ncall (cdr sig))))

-           (byte-compile-warn
-             "%s called with %d argument%s, but %s %s"
-             (car form) ncall
-             (if (= 1 ncall) "" "s")
-             (if (< ncall (car sig))
-                 "requires"
-                 "accepts only")
-             (byte-compile-arglist-signature-string sig)))
-      (or (and (fboundp (car form))    ; might be a subr or autoload.
-              (not (get (car form) 'byte-compile-noruntime)))
-         (eq (car form) byte-compile-current-form) ; ## this doesn't work
-                                                   ; with recursion.
-         ;; It's a currently-undefined function.
-         ;; Remember number of args in call.
-         (let ((cons (assq (car form) byte-compile-unresolved-functions))
-               (n (length (cdr form))))
-           (if cons
-               (or (memq n (cdr cons))
-                   (setcdr cons (cons n (cdr cons))))
-               (setq byte-compile-unresolved-functions
-                     (cons (list (car form) n)
-                           byte-compile-unresolved-functions))))))))
+         (byte-compile-set-symbol-position (car form))
+         (byte-compile-warn
+          "%s called with %d argument%s, but %s %s"
+          (car form) ncall
+          (if (= 1 ncall) "" "s")
+          (if (< ncall (car 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.
+            (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.
+       ;; Remember number of args in call.
+       (let ((cons (assq (car form) byte-compile-unresolved-functions))
+             (n (length (cdr form))))
+         (if cons
+             (or (memq n (cdr cons))
+                 (setcdr cons (cons n (cdr cons))))
+           (setq 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.
 
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.


@@ -1090,13 +1229,15 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                            (aref old 0)
                          '(&rest def)))))
              (sig2 (byte-compile-arglist-signature (nth 2 form))))
                            (aref old 0)
                          '(&rest def)))))
              (sig2 (byte-compile-arglist-signature (nth 2 form))))

-         (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-             (byte-compile-warn "%s %s used to take %s %s, now takes %s"
-               (if (eq (car form) 'defun) "function" "macro")
-               (nth 1 form)
-               (byte-compile-arglist-signature-string sig1)
-               (if (equal sig1 '(1 . 1)) "argument" "arguments")
-               (byte-compile-arglist-signature-string sig2))))
+         (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+           (byte-compile-set-symbol-position (nth 1 form))
+           (byte-compile-warn
+            "%s %s used to take %s %s, now takes %s"
+            (if (eq (car form) 'defun) "function" "macro")
+            (nth 1 form)
+            (byte-compile-arglist-signature-string sig1)
+            (if (equal sig1 '(1 . 1)) "argument" "arguments")
+            (byte-compile-arglist-signature-string sig2))))

       ;; This is the first definition.  See if previous calls are compatible.
       (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
            nums sig min max)
       ;; This is the first definition.  See if previous calls are compatible.
       (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
            nums sig min max)


@@ -1106,20 +1247,73 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                    nums (sort (copy-sequence (cdr calls)) (function <))
                    min (car nums)
                    max (car (nreverse nums)))
                    nums (sort (copy-sequence (cdr calls)) (function <))
                    min (car nums)
                    max (car (nreverse nums)))

-             (if (or (< min (car sig))
+             (when (or (< min (car sig))

                      (and (cdr sig) (> max (cdr sig))))
                      (and (cdr sig) (> max (cdr sig))))

-                 (byte-compile-warn
-           "%s being defined to take %s%s, but was previously called with %s"
-                   (nth 1 form)
-                   (byte-compile-arglist-signature-string sig)
-                   (if (equal sig '(1 . 1)) " arg" " args")
-                   (byte-compile-arglist-signature-string (cons min max))))
+               (byte-compile-set-symbol-position (nth 1 form))
+               (byte-compile-warn
+                "%s being defined to take %s%s, but was previously called with %s"
+                (nth 1 form)
+                (byte-compile-arglist-signature-string sig)
+                (if (equal sig '(1 . 1)) " arg" " args")
+                (byte-compile-arglist-signature-string (cons min max))))

 
              (setq byte-compile-unresolved-functions
                    (delq calls byte-compile-unresolved-functions)))))
       )))
 
 
              (setq byte-compile-unresolved-functions
                    (delq calls byte-compile-unresolved-functions)))))
       )))
 

+(defvar byte-compile-cl-functions nil
+  "List of functions defined in CL.")
+
+(defun byte-compile-find-cl-functions ()
+  (unless byte-compile-cl-functions
+    (dolist (elt load-history)
+      (when (and (stringp (car elt))
+                (string-match "^cl\\>" (car elt)))
+       (setq byte-compile-cl-functions
+             (append byte-compile-cl-functions
+                     (cdr elt)))))
+    (let ((tail byte-compile-cl-functions))
+      (while tail
+       (if (and (consp (car tail))
+                (eq (car (car tail)) 'autoload))
+           (setcar tail (cdr (car tail))))
+       (setq tail (cdr tail))))))
+
+(defun byte-compile-cl-warn (form)
+  "Warn if FORM is a call of a function from the CL package."
+  (let ((func (car-safe form)))
+    (if (and byte-compile-cl-functions
+            (memq func byte-compile-cl-functions)
+            ;; 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
+                       '(cl-block-wrapper cl-block-throw
+                         multiple-value-call nth-value
+                         copy-seq first second rest endp cl-member
+                         ;; These are included in generated code
+                         ;; that can't be called except at compile time
+                         ;; or unless cl is loaded anyway.
+                         cl-defsubst-expand cl-struct-setf-expander
+                         ;; 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)))
+            ;; 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)
+

 (defun byte-compile-print-syms (str1 strn syms)
 (defun byte-compile-print-syms (str1 strn syms)

+  (when syms
+    (byte-compile-set-symbol-position (car syms) t))

   (cond ((and (cdr syms) (not noninteractive))
         (let* ((str strn)
                (L (length str))
   (cond ((and (cdr syms) (not noninteractive))
         (let* ((str strn)
                (L (length str))


@@ -1166,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."


@@ -1188,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)
                ;;


@@ -1208,33 +1407,36 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                )
              body)))
 
                )
              body)))
 

-(defvar byte-compile-warnings-point-max nil)

 (defmacro displaying-byte-compile-warnings (&rest body)
 (defmacro displaying-byte-compile-warnings (&rest body)

-  `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
-     ;; Log the file name.
-     (byte-compile-log-file)
-     ;; Record how much is logged now.
-     ;; We will display the log buffer if anything more is logged
-     ;; before the end of BODY.
-     (unless byte-compile-warnings-point-max
-       (save-excursion
-        (byte-goto-log-buffer)
-        (setq byte-compile-warnings-point-max (point-max))))
-     (unwind-protect
-        (condition-case error-info
-            (progn ,@body)
-          (error (byte-compile-report-error error-info)))
-       (with-current-buffer "*Compile-Log*"
-        ;; If there were compilation warnings, display them.
-        (unless (= byte-compile-warnings-point-max (point-max))
-          (select-window
-           (prog1 (selected-window)
-             (select-window (display-buffer (current-buffer)))
-             (goto-char byte-compile-warnings-point-max)
-             (beginning-of-line)
-             (forward-line -1)
-             (recenter 0))))))))
-
+  `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
+         (warning-series-started
+          (and (markerp warning-series)
+               (eq (marker-buffer warning-series)
+                   (get-buffer "*Compile-Log*")))))
+     (byte-compile-find-cl-functions)
+     (if (or (eq warning-series 'byte-compile-warning-series)
+            warning-series-started)
+        ;; warning-series does come from compilation,
+        ;; so don't bind it, but maybe do set it.
+        (let (tem)
+          ;; Log the file name.  Record position of that text.
+          (setq tem (byte-compile-log-file))
+          (unless warning-series-started
+            (setq warning-series (or tem 'byte-compile-warning-series)))
+          (if byte-compile-debug
+              (funcall --displaying-byte-compile-warnings-fn)
+            (condition-case error-info
+                (funcall --displaying-byte-compile-warnings-fn)
+              (error (byte-compile-report-error error-info)))))
+       ;; warning-series does not come from compilation, so bind it.
+       (let ((warning-series
+             ;; Log the file name.  Record position of that text.
+             (or (byte-compile-log-file) 'byte-compile-warning-series)))
+        (if byte-compile-debug
+            (funcall --displaying-byte-compile-warnings-fn)
+          (condition-case error-info
+              (funcall --displaying-byte-compile-warnings-fn)
+            (error (byte-compile-report-error error-info))))))))

 \f
 ;;;###autoload
 (defun byte-force-recompile (directory)
 \f
 ;;;###autoload
 (defun byte-force-recompile (directory)


@@ -1249,12 +1451,13 @@ Files in subdirectories of DIRECTORY are processed also."
 This is if a `.elc' file exists but is older than the `.el' file.
 Files in subdirectories of DIRECTORY are processed also.
 
 This is if a `.elc' file exists but is older than the `.el' file.
 Files in subdirectories of DIRECTORY are processed also.
 

-If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
-But a prefix argument (optional second arg) means ask user,
-for each such `.el' file, whether to compile it.  Prefix argument 0 means
-don't ask and compile the file anyway.
+If the `.elc' file does not exist, normally this function *does not*
+compile the corresponding `.el' file.  However,
+if ARG (the prefix argument) is 0, that means do compile all those files.
+A nonzero ARG means ask the user, for each such `.el' file,
+whether to compile it.

 
 

-A nonzero prefix argument also means ask about each subdirectory.
+A nonzero ARG also means ask about each subdirectory before scanning it.

 
 If the third argument FORCE is non-nil,
 recompile every `.el' file that already has a `.elc' file."
 
 If the third argument FORCE is non-nil,
 recompile every `.el' file that already has a `.elc' file."


@@ -1265,62 +1468,70 @@ recompile every `.el' file that already has a `.elc' file."
       nil
     (save-some-buffers)
     (force-mode-line-update))
       nil
     (save-some-buffers)
     (force-mode-line-update))

-  (let ((directories (list (expand-file-name directory)))
-        (skip-count 0)
-        (fail-count 0)
-       (file-count 0)
-       (dir-count 0)
-       last-dir)
-    (displaying-byte-compile-warnings
-     (while directories
-       (setq directory (car directories))
-       (message "Checking %s..." directory)
-       (let ((files (directory-files directory))
-            source dest)
-        (dolist (file files)
-          (setq source (expand-file-name file directory))
-          (if (and (not (member file '("." ".." "RCS" "CVS")))
-                   (file-directory-p source)
-                   (not (file-symlink-p source)))
-              ;; This file is a subdirectory.  Handle them differently.
-              (when (or (null arg)
-                        (eq 0 arg)
-                        (y-or-n-p (concat "Check " source "? ")))
-                (setq directories
-                      (nconc directories (list source))))
-            ;; It is an ordinary file.  Decide whether to compile it.
-            (if (and (string-match emacs-lisp-file-regexp source)
-                     (file-readable-p source)
-                     (not (auto-save-file-name-p source))
-                     (setq dest (byte-compile-dest-file source))
-                     (if (file-exists-p dest)
-                         ;; File was already compiled.
-                         (or force (file-newer-than-file-p source dest))
-                       ;; No compiled file exists yet.
-                       (and arg
-                            (or (eq 0 arg)
-                                (y-or-n-p (concat "Compile " source "? "))))))
-                (progn (if (and noninteractive (not byte-compile-verbose))
-                           (message "Compiling %s..." source))
-                        (let ((res (byte-compile-file source)))
-                          (cond ((eq res 'no-byte-compile)
-                                 (setq skip-count (1+ skip-count)))
-                                ((eq res t)
-                                 (setq file-count (1+ file-count)))
-                                ((eq res nil)
-                                 (setq fail-count (1+ fail-count)))))
-                       (or noninteractive
-                           (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)"
-            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) "")
-            (if (> dir-count 1) (format " in %d directories" dir-count) ""))))
+  (save-current-buffer
+    (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)
+         (fail-count 0)
+         (file-count 0)
+         (dir-count 0)
+         last-dir)
+      (displaying-byte-compile-warnings
+       (while directories
+        (setq directory (car directories))
+        (message "Checking %s..." directory)
+        (let ((files (directory-files directory))
+              source dest)
+          (dolist (file files)
+            (setq source (expand-file-name file directory))
+            (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.
+                (when (or (null arg)
+                          (eq 0 arg)
+                          (y-or-n-p (concat "Check " source "? ")))
+                  (setq directories
+                        (nconc directories (list source))))
+              ;; It is an ordinary file.  Decide whether to compile it.
+              (if (and (string-match emacs-lisp-file-regexp source)
+                       (file-readable-p source)
+                       (not (auto-save-file-name-p source))
+                       (setq dest (byte-compile-dest-file source))
+                       (if (file-exists-p dest)
+                           ;; File was already compiled.
+                           (or force (file-newer-than-file-p source dest))
+                         ;; No compiled file exists yet.
+                         (and arg
+                              (or (eq 0 arg)
+                                  (y-or-n-p (concat "Compile " source "? "))))))
+                  (progn (if (and noninteractive (not byte-compile-verbose))
+                             (message "Compiling %s..." source))
+                         (let ((res (byte-compile-file source)))
+                           (cond ((eq res 'no-byte-compile)
+                                  (setq skip-count (1+ skip-count)))
+                                 ((eq res t)
+                                  (setq file-count (1+ file-count)))
+                                 ((eq res nil)
+                                  (setq fail-count (1+ fail-count)))))
+                         (or noninteractive
+                             (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)"
+              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) "")
+              (if (> dir-count 1) (format " in %d directories" dir-count) "")))))

 
 (defvar no-byte-compile nil
   "Non-nil to prevent byte-compiling of emacs-lisp code.
 
 (defvar no-byte-compile nil
   "Non-nil to prevent byte-compiling of emacs-lisp code.


@@ -1360,8 +1571,9 @@ The value is non-nil if there were no errors, nil if errors."
                 (y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
            (save-excursion (set-buffer b) (save-buffer)))))
 
                 (y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
            (save-excursion (set-buffer b) (save-buffer)))))
 

+  ;; Force logging of the file name for each file compiled.
+  (setq byte-compile-last-logged-file nil)

   (let ((byte-compile-current-file filename)
   (let ((byte-compile-current-file filename)

-       (byte-compile-last-logged-file nil)

        (set-auto-coding-for-load t)
        target-file input-buffer output-buffer
        byte-compile-dest-file)
        (set-auto-coding-for-load t)
        target-file input-buffer output-buffer
        byte-compile-dest-file)


@@ -1376,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...,


@@ -1396,24 +1608,29 @@ 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)
          ;; We successfully didn't compile this file.
          'no-byte-compile)

-      (if byte-compile-verbose
-         (message "Compiling %s..." filename))
+      (when byte-compile-verbose
+       (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
       ;; within byte-compile-from-buffer lingers in that buffer.
       (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
       ;; within byte-compile-from-buffer lingers in that buffer.

-      (setq output-buffer (byte-compile-from-buffer input-buffer filename))
+      (setq output-buffer
+           (save-current-buffer
+             (byte-compile-from-buffer input-buffer filename)))

       (if byte-compiler-error-flag
          nil
       (if byte-compiler-error-flag
          nil

-       (if byte-compile-verbose
-           (message "Compiling %s...done" filename))
+       (when byte-compile-verbose
+         (message "Compiling %s...done" filename))

        (kill-buffer input-buffer)
        (with-current-buffer output-buffer
          (goto-char (point-max))
        (kill-buffer input-buffer)
        (with-current-buffer output-buffer
          (goto-char (point-max))


@@ -1431,7 +1648,7 @@ The value is non-nil if there were no errors, nil if errors."
                    ;; the build tree, without causing problems when emacs-lisp
                    ;; files in the build tree are recompiled).
                    (delete-file target-file))
                    ;; the build tree, without causing problems when emacs-lisp
                    ;; files in the build tree are recompiled).
                    (delete-file target-file))

-                 (write-region 1 (point-max) target-file))
+                 (write-region (point-min) (point-max) target-file))

              ;; This is just to give a better error message than write-region
              (signal 'file-error
                      (list "Opening output file"
              ;; This is just to give a better error message than write-region
              (signal 'file-error
                      (list "Opening output file"


@@ -1475,16 +1692,22 @@ 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
     (end-of-defun)
     (beginning-of-defun)
     (let* ((byte-compile-current-file nil)
 With argument, insert value in current buffer after the form."
   (interactive "P")
   (save-excursion
     (end-of-defun)
     (beginning-of-defun)
     (let* ((byte-compile-current-file nil)

+          (byte-compile-current-buffer (current-buffer))
+          (byte-compile-read-position (point))
+          (byte-compile-last-position byte-compile-read-position)

           (byte-compile-last-warned-form 'nothing)
           (byte-compile-last-warned-form 'nothing)

-          (value (eval (displaying-byte-compile-warnings
-                        (byte-compile-sexp (read (current-buffer)))))))
+          (value (eval
+                  (let ((read-with-symbol-positions (current-buffer))
+                        (read-symbol-positions-list nil))
+                    (displaying-byte-compile-warnings
+                     (byte-compile-sexp (read (current-buffer))))))))

       (cond (arg
             (message "Compiling from buffer... done.")
             (prin1 value (current-buffer))
       (cond (arg
             (message "Compiling from buffer... done.")
             (prin1 value (current-buffer))


@@ -1495,6 +1718,9 @@ With argument, insert value in current buffer after the form."
 (defun byte-compile-from-buffer (inbuffer &optional filename)
   ;; Filename is used for the loading-into-Emacs-18 error message.
   (let (outbuffer
 (defun byte-compile-from-buffer (inbuffer &optional filename)
   ;; Filename is used for the loading-into-Emacs-18 error message.
   (let (outbuffer

+       (byte-compile-current-buffer inbuffer)
+       (byte-compile-read-position nil)
+       (byte-compile-last-position nil)

        ;; Prevent truncation of flonums and lists as we read and print them
        (float-output-format nil)
        (case-fold-search nil)
        ;; Prevent truncation of flonums and lists as we read and print them
        (float-output-format nil)
        (case-fold-search nil)


@@ -1502,8 +1728,8 @@ With argument, insert value in current buffer after the form."
        (print-level nil)
        ;; Prevent edebug from interfering when we compile
        ;; and put the output into a file.
        (print-level nil)
        ;; Prevent edebug from interfering when we compile
        ;; and put the output into a file.

-       (edebug-all-defs nil)
-       (edebug-all-forms nil)
+;;     (edebug-all-defs nil)
+;;     (edebug-all-forms nil)

        ;; Simulate entry to byte-compile-top-level
        (byte-compile-constants nil)
        (byte-compile-variables nil)
        ;; Simulate entry to byte-compile-top-level
        (byte-compile-constants nil)
        (byte-compile-variables nil)


@@ -1511,6 +1737,10 @@ With argument, insert value in current buffer after the form."
        (byte-compile-depth 0)
        (byte-compile-maxdepth 0)
        (byte-compile-output nil)
        (byte-compile-depth 0)
        (byte-compile-maxdepth 0)
        (byte-compile-output nil)

+       ;; This allows us to get the positions of symbols read; it's
+       ;; new in Emacs 21.4.
+       (read-with-symbol-positions inbuffer)
+       (read-symbol-positions-list nil)

        ;;        #### This is bound in b-c-close-variables.
        ;;        (byte-compile-warnings (if (eq byte-compile-warnings t)
        ;;                                   byte-compile-warning-types
        ;;        #### This is bound in b-c-close-variables.
        ;;        (byte-compile-warnings (if (eq byte-compile-warnings t)
        ;;                                   byte-compile-warning-types


@@ -1543,11 +1773,15 @@ With argument, insert value in current buffer after the form."
                               (looking-at ";"))
                   (forward-line 1))
                 (not (eobp)))
                               (looking-at ";"))
                   (forward-line 1))
                 (not (eobp)))

-         (let ((byte-compile-last-line (count-lines (point-min) (point))))
-           (byte-compile-file-form (read inbuffer))))
-
+         (setq byte-compile-read-position (point)
+               byte-compile-last-position byte-compile-read-position)
+         (let ((form (read inbuffer)))
+           (byte-compile-file-form form)))

        ;; Compile pending forms at end of file.
        (byte-compile-flush-pending)
        ;; 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


@@ -1559,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)


@@ -1623,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")


@@ -1704,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,


@@ -1734,7 +1966,7 @@ list that represents a doc string reference.
                (setq position
                      (byte-compile-output-as-comment
                       (nth (nth 1 info) form) nil))
                (setq position
                      (byte-compile-output-as-comment
                       (nth (nth 1 info) form) nil))

-               (setq position (position-bytes position))
+               (setq position (- (position-bytes position) (point-min) -1))

                ;; If the doc string starts with * (a user variable),
                ;; negate POSITION.
                (if (and (stringp (nth (nth 1 info) form))
                ;; If the doc string starts with * (a user variable),
                ;; negate POSITION.
                (if (and (stringp (nth (nth 1 info) form))


@@ -1754,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))


@@ -1763,12 +1994,23 @@ list that represents a doc string reference.
           (while (setq form (cdr form))
             (setq index (1+ index))
             (insert " ")
           (while (setq form (cdr form))
             (setq index (1+ index))
             (insert " ")

-            (cond ((and (numberp specindex) (= index specindex))
+            (cond ((and (numberp specindex) (= index specindex)
+                        ;; Don't handle the definition dynamically
+                        ;; if it refers (or might refer)
+                        ;; to objects already output
+                        ;; (for instance, gensyms in the arg list).
+                        (let (non-nil)
+                          (dotimes (i (length print-number-table))
+                            (if (aref print-number-table i)
+                                (setq non-nil t)))
+                          (not non-nil)))
+                   ;; Output the byte code and constants specially
+                   ;; for lazy dynamic loading.

                    (let ((position
                           (byte-compile-output-as-comment
                            (cons (car form) (nth 1 form))
                            t)))
                    (let ((position
                           (byte-compile-output-as-comment
                            (cons (car form) (nth 1 form))
                            t)))

-                     (setq position (position-bytes position))
+                     (setq position (- (position-bytes position) (point-min) -1))

                      (princ (format "(#$ . %d) nil" position) outbuffer)
                      (setq form (cdr form))
                      (setq index (1+ index))))
                      (princ (format "(#$ . %d) nil" position) outbuffer)
                      (setq form (cdr form))
                      (setq index (1+ index))))


@@ -1838,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.


@@ -1874,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))


@@ -1886,14 +2129,34 @@ 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
+      ;; those functions.
+      (if (and (consp (car tail))
+              (eq (car (car tail)) 'function)
+              (consp (nth 1 (car tail))))
+         (setcar tail (byte-compile-lambda (nth 1 (car tail))))
+       ;; Likewise for a bare lambda.
+       (if (and (consp (car tail))
+                (eq (car (car tail)) 'lambda))
+           (setcar tail (byte-compile-lambda (car tail)))))
+      (setq tail (cdr tail))))

   form)
 
 (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
 (defun byte-compile-file-form-eval-boundary (form)
   form)
 
 (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
 (defun byte-compile-file-form-eval-boundary (form)

-  (eval form)
+  (let ((old-load-list current-load-list))
+    (eval form)
+    ;; (require 'cl) turns off warnings for cl functions.
+    (let ((tem current-load-list))
+      (while (not (eq tem old-load-list))
+       (when (equal (car tem) '(require . cl))
+         (setq byte-compile-warnings
+               (remq 'cl-functions byte-compile-warnings)))
+       (setq tem (cdr tem)))))

   (byte-compile-keep-pending form 'byte-compile-normal-call))
 
 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
 
 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)


@@ -1930,7 +2193,7 @@ list that represents a doc string reference.
         (that-one (assq name (symbol-value that-kind)))
         (byte-compile-free-references nil)
         (byte-compile-free-assignments nil))
         (that-one (assq name (symbol-value that-kind)))
         (byte-compile-free-references nil)
         (byte-compile-free-assignments nil))

-
+    (byte-compile-set-symbol-position name)

     ;; When a function or macro is defined, add it to the call tree so that
     ;; we can tell when functions are not used.
     (if byte-compile-generate-call-tree
     ;; When a function or macro is defined, add it to the call tree so that
     ;; we can tell when functions are not used.
     (if byte-compile-generate-call-tree


@@ -1953,33 +2216,50 @@ list that represents a doc string reference.
                 (nth 1 form)))
           (setcdr that-one nil))
          (this-one
                 (nth 1 form)))
           (setcdr that-one nil))
          (this-one

-          (if (and (memq 'redefine byte-compile-warnings)
+          (when (and (memq 'redefine byte-compile-warnings)

                    ;; hack: don't warn when compiling the magic internal
                    ;; byte-compiler macros in byte-run.el...
                    (not (assq (nth 1 form)
                               byte-compile-initial-macro-environment)))
                    ;; hack: don't warn when compiling the magic internal
                    ;; byte-compiler macros in byte-run.el...
                    (not (assq (nth 1 form)
                               byte-compile-initial-macro-environment)))

-              (byte-compile-warn "%s %s defined multiple times in this file"
-                                 (if macrop "macro" "function")
-                                 (nth 1 form))))
+            (byte-compile-warn "%s %s defined multiple times in this file"
+                               (if macrop "macro" "function")
+                               (nth 1 form))))

          ((and (fboundp name)
                (eq (car-safe (symbol-function name))
                    (if macrop 'lambda 'macro)))
          ((and (fboundp name)
                (eq (car-safe (symbol-function name))
                    (if macrop 'lambda 'macro)))

-          (if (memq 'redefine byte-compile-warnings)
-              (byte-compile-warn "%s %s being redefined as a %s"
-                                 (if macrop "function" "macro")
-                                 (nth 1 form)
-                                 (if macrop "macro" "function")))
+          (when (memq 'redefine byte-compile-warnings)
+            (byte-compile-warn "%s %s being redefined as a %s"
+                               (if macrop "function" "macro")
+                               (nth 1 form)
+                               (if macrop "macro" "function")))

           ;; shadow existing definition
           (set this-kind
                (cons (cons name nil) (symbol-value this-kind))))
          )
     (let ((body (nthcdr 3 form)))
           ;; shadow existing definition
           (set this-kind
                (cons (cons name nil) (symbol-value this-kind))))
          )
     (let ((body (nthcdr 3 form)))

-      (if (and (stringp (car body))
-              (symbolp (car-safe (cdr-safe body)))
-              (car-safe (cdr-safe body))
-              (stringp (car-safe (cdr-safe (cdr-safe body)))))
-         (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
-                            (nth 1 form))))
+      (when (and (stringp (car body))
+                (symbolp (car-safe (cdr-safe body)))
+                (car-safe (cdr-safe body))
+                (stringp (car-safe (cdr-safe (cdr-safe body)))))
+       (byte-compile-set-symbol-position (nth 1 form))
+       (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+                          (nth 1 form))))
+
+    ;; Generate code for declarations in macro definitions.
+    ;; Remove declarations from the body of the macro definition.
+    (when macrop
+      (let ((tail (nthcdr 2 form)))
+       (when (stringp (car (cdr tail)))
+         (setq tail (cdr tail)))
+       (while (and (consp (car (cdr tail)))
+                   (eq (car (car (cdr tail))) 'declare))
+         (let ((declaration (car (cdr tail))))
+           (setcdr tail (cdr (cdr tail)))
+           (princ `(if macro-declaration-function
+                       (funcall macro-declaration-function
+                                ',name ',declaration))
+                  outbuffer)))))
+

     (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
           (code (byte-compile-byte-code-maker new-one)))
       (if this-one
     (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
           (code (byte-compile-byte-code-maker new-one)))
       (if this-one


@@ -2153,9 +2433,10 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (let (vars)
     (while list
       (let ((arg (car list)))
   (let (vars)
     (while list
       (let ((arg (car list)))

+       (when (symbolp arg)
+         (byte-compile-set-symbol-position arg))

        (cond ((or (not (symbolp 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)


@@ -2178,6 +2459,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-lambda (fun)
   (unless (eq 'lambda (car-safe fun))
     (error "Not a lambda list: %S" fun))
 (defun byte-compile-lambda (fun)
   (unless (eq 'lambda (car-safe fun))
     (error "Not a lambda list: %S" fun))

+  (byte-compile-set-symbol-position 'lambda)

   (byte-compile-check-lambda-list (nth 1 fun))
   (let* ((arglist (nth 1 fun))
         (byte-compile-bound-variables
   (byte-compile-check-lambda-list (nth 1 fun))
   (let* ((arglist (nth 1 fun))
         (byte-compile-bound-variables


@@ -2192,31 +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
-          ;; 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 (or (eq (car-safe form) 'let)
-                              (eq (car-safe form) 'let*)
-                              (eq (car-safe form) '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)))


@@ -2308,10 +2594,10 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         ;; constant was not optimized away because we chose to return it.
         (and (not (assq nil byte-compile-constants)) ; Nil is often there.
              (let ((tmp (reverse byte-compile-constants)))
         ;; constant was not optimized away because we chose to return it.
         (and (not (assq nil byte-compile-constants)) ; Nil is often there.
              (let ((tmp (reverse byte-compile-constants)))

-               (while (and tmp (not (or (symbolp (car (car tmp)))
-                                        (numberp (car (car tmp))))))
+               (while (and tmp (not (or (symbolp (caar tmp))
+                                        (numberp (caar tmp)))))

                  (setq tmp (cdr tmp)))
                  (setq tmp (cdr tmp)))

-               (car (car tmp)))))))
+               (caar tmp))))))

   (byte-compile-out 'byte-return 0)
   (setq byte-compile-output (nreverse byte-compile-output))
   (if (memq byte-optimize '(t byte))
   (byte-compile-out 'byte-return 0)
   (setq byte-compile-output (nreverse byte-compile-output))
   (if (memq byte-optimize '(t byte))


@@ -2403,6 +2689,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-form (form &optional for-effect)
   (setq form (macroexpand form byte-compile-macro-environment))
   (cond ((not (consp form))
 (defun byte-compile-form (form &optional for-effect)
   (setq form (macroexpand form byte-compile-macro-environment))
   (cond ((not (consp form))

+        (when (symbolp form)
+          (byte-compile-set-symbol-position form))

         (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
                (byte-compile-constant form))
               ((and for-effect byte-compile-delete-errors)
         (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
                (byte-compile-constant form))
               ((and for-effect byte-compile-delete-errors)


@@ -2411,8 +2699,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        ((symbolp (car form))
         (let* ((fn (car form))
                (handler (get fn 'byte-compile)))
        ((symbolp (car form))
         (let* ((fn (car form))
                (handler (get fn 'byte-compile)))

-          (if (byte-compile-const-symbol-p fn)
-              (byte-compile-warn "%s called as a function" fn))
+          (byte-compile-set-symbol-position fn)
+          (when (byte-compile-const-symbol-p fn)
+            (byte-compile-warn "%s called as a function" fn))

           (if (and handler
                    (or (not (byte-compile-version-cond
                              byte-compile-compatibility))
           (if (and handler
                    (or (not (byte-compile-version-cond
                              byte-compile-compatibility))


@@ -2420,7 +2709,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
               (funcall handler form)
             (if (memq 'callargs byte-compile-warnings)
                 (byte-compile-callargs-warn form))
               (funcall handler form)
             (if (memq 'callargs byte-compile-warnings)
                 (byte-compile-callargs-warn form))

-            (byte-compile-normal-call form))))
+            (byte-compile-normal-call form))
+          (if (memq 'cl-functions byte-compile-warnings)
+              (byte-compile-cl-warn form))))

        ((and (or (byte-code-function-p (car form))
                  (eq (car-safe (car form)) 'lambda))
              ;; if the form comes out the same way it went in, that's
        ((and (or (byte-code-function-p (car form))
                  (eq (car-safe (car form)) 'lambda))
              ;; if the form comes out the same way it went in, that's


@@ -2440,14 +2731,19 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (byte-compile-out 'byte-call (length (cdr form))))
 
 (defun byte-compile-variable-ref (base-op var)
   (byte-compile-out 'byte-call (length (cdr form))))
 
 (defun byte-compile-variable-ref (base-op 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))
+  (when (symbolp var)
+    (byte-compile-set-symbol-position 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


@@ -2457,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)))))


@@ -2489,6 +2783,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-constant (const)
   (if for-effect
       (setq for-effect nil)
 (defun byte-compile-constant (const)
   (if for-effect
       (setq for-effect nil)

+    (when (symbolp const)
+      (byte-compile-set-symbol-position const))

     (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
 
 ;; Use this for a constant that is not the value of its containing form.
     (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
 
 ;; Use this for a constant that is not the value of its containing form.


@@ -2506,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."


@@ -2666,6 +2963,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 \f
 (defun byte-compile-subr-wrong-args (form n)
 
 \f
 (defun byte-compile-subr-wrong-args (form n)

+  (byte-compile-set-symbol-position (car form))

   (byte-compile-warn "%s called with %d arg%s, but requires %s"
                     (car form) (length (cdr form))
                     (if (= 1 (length (cdr form))) "" "s") n)
   (byte-compile-warn "%s called with %d arg%s, but requires %s"
                     (car form) (length (cdr form))
                     (if (= 1 (length (cdr form))) "" "s") n)


@@ -2736,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


@@ -2977,6 +3274,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
 (byte-defop-compiler-1 mapc byte-compile-funarg)
 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
 (byte-defop-compiler-1 mapc byte-compile-funarg)

+(byte-defop-compiler-1 maphash byte-compile-funarg)
+(byte-defop-compiler-1 map-char-table byte-compile-funarg)

 (byte-defop-compiler-1 sort byte-compile-funarg-2)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)
 (byte-defop-compiler-1 sort byte-compile-funarg-2)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)


@@ -3000,21 +3299,59 @@ 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)))
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))

-  (if (null (nthcdr 3 form))
-      ;; No else-forms
-      (let ((donetag (byte-compile-make-tag)))
-       (byte-compile-goto-if nil for-effect donetag)
-       (byte-compile-form (nth 2 form) for-effect)
-       (byte-compile-out-tag donetag))
-    (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag)))
-      (byte-compile-goto 'byte-goto-if-nil elsetag)
-      (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-out-tag donetag)))
+  ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
+  ;; and avoid warnings about the relevent symbols in the consequent.
+  (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)
+         (byte-compile-maybe-guarded clause
+           (byte-compile-form (nth 2 form) for-effect))
+         (byte-compile-out-tag donetag))
+      (let ((elsetag (byte-compile-make-tag)))
+       (byte-compile-goto 'byte-goto-if-nil elsetag)
+       (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-out-tag donetag))))

   (setq for-effect nil))
 
 (defun byte-compile-cond (clauses)
   (setq for-effect nil))
 
 (defun byte-compile-cond (clauses)


@@ -3033,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)


@@ -3089,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))))))
 


@@ -3132,6 +3467,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Even when optimization is off, /= is optimized to (not (= ...)).
 (defun byte-compile-negation-optimizer (form)
   ;; an optimizer for forms where <form1> is less efficient than (not <form2>)
 ;; Even when optimization is off, /= is optimized to (not (= ...)).
 (defun byte-compile-negation-optimizer (form)
   ;; an optimizer for forms where <form1> is less efficient than (not <form2>)

+  (byte-compile-set-symbol-position (car form))

   (list 'not
     (cons (or (get (car form) 'byte-compile-negated-op)
              (error
   (list 'not
     (cons (or (get (car form) 'byte-compile-negated-op)
              (error


@@ -3166,21 +3502,18 @@ 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))
         (byte-compile-bound-variables
          (if var (cons var byte-compile-bound-variables)
            byte-compile-bound-variables)))
 
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))
         (byte-compile-bound-variables
          (if var (cons var byte-compile-bound-variables)
            byte-compile-bound-variables)))

-    (or (symbolp var)
-       (byte-compile-warn
-        "%s is not a variable-name or nil (in condition-case)" var))
+    (byte-compile-set-symbol-position 'condition-case)
+    (unless (symbolp var)
+      (byte-compile-warn
+       "%s is not a variable-name or nil (in condition-case)" var))

     (byte-compile-push-constant var)
     (byte-compile-push-constant (byte-compile-top-level
                                 (nth 2 form) for-effect))
     (byte-compile-push-constant var)
     (byte-compile-push-constant (byte-compile-top-level
                                 (nth 2 form) for-effect))


@@ -3242,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
 


@@ -3256,13 +3588,26 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defun byte-compile-defun (form)
   ;; This is not used for file-level defuns with doc strings.
 
 (defun byte-compile-defun (form)
   ;; This is not used for file-level defuns with doc strings.

-  (unless (symbolp (car form))
+  (if (symbolp (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)))
     (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)


@@ -3283,13 +3628,20 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (var (nth 1 form))
        (value (nth 2 form))
        (string (nth 3 form)))
        (var (nth 1 form))
        (value (nth 2 form))
        (string (nth 3 form)))

-    (when (> (length form) 4)
-      (byte-compile-warn
-       "%s %s called with %d arguments, but accepts only %s"
-       fun var (length (cdr form)) 3))
+    (byte-compile-set-symbol-position fun)
+    (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


@@ -3302,16 +3654,21 @@ 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)

+  (byte-compile-set-symbol-position 'autoload)

   (and (byte-compile-constp (nth 1 form))
        (byte-compile-constp (nth 5 form))
        (eval (nth 5 form))  ; macro-p
   (and (byte-compile-constp (nth 1 form))
        (byte-compile-constp (nth 5 form))
        (eval (nth 5 form))  ; macro-p


@@ -3325,6 +3682,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Lambdas in valid places are handled as special cases by various code.
 ;; The ones that remain are errors.
 (defun byte-compile-lambda-form (form)
 ;; Lambdas in valid places are handled as special cases by various code.
 ;; The ones that remain are errors.
 (defun byte-compile-lambda-form (form)

+  (byte-compile-set-symbol-position 'lambda)

   (error "`lambda' used as function name is invalid"))
 
 ;; Compile normally, but deal with warnings for the function being defined.
   (error "`lambda' used as function name is invalid"))
 
 ;; Compile normally, but deal with warnings for the function being defined.


@@ -3339,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)))


@@ -3350,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
 


@@ -3377,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))


@@ -3385,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)


@@ -3554,6 +3916,7 @@ invoked interactively."
     ))
 
 \f
     ))
 
 \f

+;;;###autoload

 (defun batch-byte-compile-if-not-done ()
   "Like `byte-compile-file' but doesn't recompile if already up to date.
 Use this from the command line, with `-batch';
 (defun batch-byte-compile-if-not-done ()
   "Like `byte-compile-file' but doesn't recompile if already up to date.
 Use this from the command line, with `-batch';


@@ -3605,6 +3968,17 @@ already up-to-date."
 (defun batch-byte-compile-file (file)
   (condition-case err
       (byte-compile-file file)
 (defun batch-byte-compile-file (file)
   (condition-case err
       (byte-compile-file file)

+    (file-error
+     (message (if (cdr err)
+                 ">>Error occurred processing %s: %s (%s)"
+                 ">>Error occurred processing %s: %s")
+             file
+             (get (car err) 'error-message)
+             (prin1-to-string (cdr err)))
+     (let ((destfile (byte-compile-dest-file file)))
+       (if (file-exists-p destfile)
+          (delete-file destfile)))
+     nil)

     (error
      (message (if (cdr err)
                  ">>Error occurred processing %s: %s (%s)"
     (error
      (message (if (cdr err)
                  ">>Error occurred processing %s: %s (%s)"


@@ -3616,7 +3990,7 @@ already up-to-date."
 
 ;;;###autoload
 (defun batch-byte-recompile-directory ()
 
 ;;;###autoload
 (defun batch-byte-recompile-directory ()

-  "Runs `byte-recompile-directory' on the dirs remaining on the command line.
+  "Run `byte-recompile-directory' on the dirs remaining on the command line.

 Must be used only with `-batch', and kills Emacs on completion.
 For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
   ;; command-line-args-left is what is left of the command line (startup.el)
 Must be used only with `-batch', and kills Emacs on completion.
 For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
   ;; command-line-args-left is what is left of the command line (startup.el)


@@ -3626,36 +4000,23 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
   (or command-line-args-left
       (setq command-line-args-left '(".")))
   (while command-line-args-left
   (or command-line-args-left
       (setq command-line-args-left '(".")))
   (while command-line-args-left

-    (byte-recompile-directory (car command-line-args-left) 0)
+    (byte-recompile-directory (car command-line-args-left))

     (setq command-line-args-left (cdr command-line-args-left)))
   (kill-emacs 0))
 
 
     (setq command-line-args-left (cdr command-line-args-left)))
   (kill-emacs 0))
 
 

-(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")

 (make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
 (make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
 (make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
 (make-obsolete-variable 'inhibit-local-variables
                "use enable-local-variables (with the reversed sense)."
                "before 19.15")
 (make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
 (make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
 (make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
 (make-obsolete-variable 'inhibit-local-variables
                "use enable-local-variables (with the reversed sense)."
                "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")

 (make-obsolete-variable 'unread-command-event
   "use unread-command-events; which is a list of events rather than a single event."
   "before 19.15")
 (make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
 (make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")
 (make-obsolete-variable 'unread-command-event
   "use unread-command-events; which is a list of events rather than a single event."
   "before 19.15")
 (make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
 (make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")

-(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")
+(make-obsolete-variable 'meta-flag "use the set-input-mode function instead." "before 19.34")

 (make-obsolete-variable 'before-change-function
   "use before-change-functions; which is a list of functions rather than a single function."
   "before 19.34")
 (make-obsolete-variable 'before-change-function
   "use before-change-functions; which is a list of functions rather than a single function."
   "before 19.34")


@@ -3663,10 +4024,6 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
   "use after-change-functions; which is a list of functions rather than a single function."
   "before 19.34")
 (make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34")
   "use after-change-functions; which is a list of functions rather than a single function."
   "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")

 
 (provide 'byte-compile)
 (provide 'bytecomp)
 
 (provide 'byte-compile)
 (provide 'bytecomp)


@@ -3674,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)


@@ -3724,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