(make-char): Fix typo in docstring.

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

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f6e2946aa8b454ab84152d4650fb546c0ed7e5a1..02a88c13973837dd4efe5fa7f855bd3245b76e43 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,7 +1,7 @@
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 

-;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
+;;   2003, 2004, 2005, 2006 Free Software Foundation, Inc.

 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>


@@ -22,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the

-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -98,6 +98,9 @@
 ;;                             `obsolete'  (obsolete variables and functions)
 ;;                             `noruntime' (calls to functions only defined
 ;;                                          within `eval-when-compile')
 ;;                             `obsolete'  (obsolete variables and functions)
 ;;                             `noruntime' (calls to functions only defined
 ;;                                          within `eval-when-compile')

+;;                             `cl-warnings' (calls to CL functions)
+;;                             `interactive-only' (calls to commands that are
+;;                                                not good to call from Lisp)

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


@@ -190,7 +193,7 @@
 
 
 (defgroup bytecomp nil
 
 
 (defgroup bytecomp nil

-  "Emacs Lisp byte-compiler"
+  "Emacs Lisp byte-compiler."

   :group 'lisp)
 
 (defcustom emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
   :group 'lisp)
 
 (defcustom emacs-lisp-file-regexp (if (eq system-type 'vax-vms)


@@ -290,6 +293,7 @@ For example, add  -*-byte-compile-dynamic: t;-*- on the first line.
 
 When this option is true, if you load the compiled file and then move it,
 the functions you loaded will not be able to run.")
 
 When this option is true, if you load the compiled file and then move it,
 the functions you loaded will not be able to run.")

+;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)

 
 (defcustom byte-compile-dynamic-docstrings t
   "*If non-nil, compile doc strings for lazy access.
 
 (defcustom byte-compile-dynamic-docstrings t
   "*If non-nil, compile doc strings for lazy access.


@@ -308,6 +312,7 @@ You can also set the variable globally.
 This option is enabled by default because it reduces Emacs memory usage."
   :group 'bytecomp
   :type 'boolean)
 This option is enabled by default because it reduces Emacs memory usage."
   :group 'bytecomp
   :type 'boolean)

+;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)

 
 (defcustom byte-optimize-log nil
   "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
 
 (defcustom byte-optimize-log nil
   "*If true, the byte-compiler will log its optimizations into *Compile-Log*.


@@ -325,7 +330,8 @@ 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 cl-functions)
+  '(redefine callargs free-vars unresolved
+            obsolete noruntime cl-functions interactive-only)

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


@@ -334,27 +340,49 @@ Elements of the list may be be:
 
   free-vars   references to variables not in the current lexical scope.
   unresolved  calls to unknown functions.
 
   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 definition.
-  redefine    function cell redefined from a macro to a lambda or vice
+  callargs    function calls with args that don't match the definition.
+  redefine    function name redefined from a macro to ordinary function or vice

               versa, or redefined to take a different number of arguments.
   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
               versa, or redefined to take a different number of arguments.
   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)."
+                 distinguished from macros and aliases).
+  interactive-only
+             commands that normally shouldn't be called from Lisp code."

   :group 'bytecomp
   :type `(choice (const :tag "All" t)
                 (set :menu-tag "Some"
                      (const free-vars) (const unresolved)
                      (const callargs) (const redefine)
   :group 'bytecomp
   :type `(choice (const :tag "All" t)
                 (set :menu-tag "Some"
                      (const free-vars) (const unresolved)
                      (const callargs) (const redefine)

-                     (const obsolete) (const noruntime) (const cl-functions))))
+                     (const obsolete) (const noruntime)
+                     (const cl-functions) (const interactive-only))))
+(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
+;;;###autoload
+(defun byte-compile-warnings-safe-p (x)
+  (or (booleanp x)
+      (and (listp x)
+          (equal (mapcar
+                  (lambda (e)
+                    (when (memq e '(free-vars unresolved
+                                    callargs redefine
+                                    obsolete noruntime
+                                    cl-functions interactive-only))
+                      e))
+                  x)
+                 x))))
+
+(defvar byte-compile-interactive-only-functions
+  '(beginning-of-buffer end-of-buffer replace-string replace-regexp
+    insert-file insert-buffer insert-file-literally)
+  "List of commands that are not meant to be called from Lisp.")

 
 (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.
 
 (defvar byte-compile-not-obsolete-var nil
   "If non-nil, this is a variable that shouldn't be reported as obsolete.")
 
 (defcustom byte-compile-generate-call-tree nil
   "*Non-nil means collect call-graph information when compiling.

-This records functions were called and from where.
+This records which functions were called and from where.

 If the value is t, compilation displays the call graph when it finishes.
 If the value is neither t nor nil, compilation asks you whether to display
 the graph.
 If the value is t, compilation displays the call graph when it finishes.
 If the value is neither t nor nil, compilation asks you whether to display
 the graph.


@@ -435,7 +463,9 @@ Each element looks like (MACRONAME . DEFINITION).  It is
   "Alist of functions defined in the file being compiled.
 This is so we can inline them when necessary.
 Each element looks like (FUNCTIONNAME . DEFINITION).  It is
   "Alist of functions defined in the file being compiled.
 This is so we can inline them when necessary.
 Each element looks like (FUNCTIONNAME . DEFINITION).  It is

-\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
+\(FUNCTIONNAME . nil) when a function is redefined as a macro.
+It is \(FUNCTIONNAME . t) when all we know is that it was defined,
+and we don't know the definition.")

 
 (defvar byte-compile-unresolved-functions nil
   "Alist of undefined functions to which calls have been compiled.
 
 (defvar byte-compile-unresolved-functions nil
   "Alist of undefined functions to which calls have been compiled.


@@ -792,7 +822,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
            (let ((xs (pop hist-new))
                  old-autoloads)
              ;; Make sure the file was not already loaded before.
            (let ((xs (pop hist-new))
                  old-autoloads)
              ;; Make sure the file was not already loaded before.

-             (unless (assoc (car xs) hist-orig)
+             (unless (or (assoc (car xs) hist-orig)
+                         (equal (car xs) "cl"))

                (dolist (s xs)
                  (cond
                   ((symbolp s)
                (dolist (s xs)
                  (cond
                   ((symbolp s)


@@ -809,7 +840,18 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
                (when (and (symbolp s) (not (memq s old-autoloads)))
                  (push s byte-compile-noruntime-functions))
                (when (and (consp s) (eq t (car s)))
                (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))))))))))
+                 (push (cdr s) old-autoloads)))))))
+      (when (memq 'cl-functions byte-compile-warnings)
+       (let ((hist-new load-history)
+             (hist-nil-new current-load-list))
+         ;; 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))
+                 old-autoloads)
+             ;; Make sure the file was not already loaded before.
+             (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
+               (byte-compile-find-cl-functions)))))))))

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


@@ -832,30 +874,29 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 
 ;; Log something that isn't a warning.
 (defmacro byte-compile-log (format-string &rest args)
 
 ;; Log something that isn't a warning.
 (defmacro byte-compile-log (format-string &rest args)

-  (list 'and
-       'byte-optimize
-       '(memq byte-optimize-log '(t source))
-       (list 'let '((print-escape-newlines t)
-                    (print-level 4)
-                    (print-length 4))
-             (list 'byte-compile-log-1
-                   (cons 'format
-                     (cons format-string
-                       (mapcar
-                        (lambda (x)
-                          (if (symbolp x) (list 'prin1-to-string x) x))
-                        args)))))))
+  `(and
+    byte-optimize
+    (memq byte-optimize-log '(t source))
+    (let ((print-escape-newlines t)
+         (print-level 4)
+         (print-length 4))
+      (byte-compile-log-1
+       (format
+       ,format-string
+       ,@(mapcar
+          (lambda (x) (if (symbolp x) (list 'prin1-to-string x) x))
+          args))))))

 
 ;; Log something that isn't a warning.
 (defun byte-compile-log-1 (string)
 
 ;; 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))))))
+  (with-current-buffer "*Compile-Log*"
+    (let ((inhibit-read-only t))
+      (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-read-position nil
   "Character position we began the last `read' from.")


@@ -883,35 +924,38 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 ;; 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.
 ;; 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.

+;;
+;; This function should not be called twice for the same occurrence of
+;; a symbol, and it should not be called for symbols generated by the
+;; byte compiler itself; because rather than just fail looking up the
+;; symbol, we may find an occurrence of the symbol further ahead, and
+;; then `byte-compile-last-position' as advanced too far.
+;;

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

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

 ;; 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)
 ;; 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)
+  (let* ((inhibit-read-only t)
+        (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)
         (file (cond ((stringp byte-compile-current-file)
                      (format "%s:" (file-relative-name byte-compile-current-file dir)))
                     ((bufferp byte-compile-current-file)


@@ -957,7 +1001,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
        (save-excursion
         (set-buffer (get-buffer-create "*Compile-Log*"))
         (goto-char (point-max))
        (save-excursion
         (set-buffer (get-buffer-create "*Compile-Log*"))
         (goto-char (point-max))

-        (let* ((dir (and byte-compile-current-file
+        (let* ((inhibit-read-only t)
+               (dir (and byte-compile-current-file

                          (file-name-directory byte-compile-current-file)))
                (was-same (equal default-directory dir))
                pt)
                          (file-name-directory byte-compile-current-file)))
                (was-same (equal default-directory dir))
                pt)


@@ -983,6 +1028,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
           ;; Do this after setting default-directory.
           (unless (eq major-mode 'compilation-mode)
             (compilation-mode))
           ;; Do this after setting default-directory.
           (unless (eq major-mode 'compilation-mode)
             (compilation-mode))

+          (compilation-forget-errors)

           pt))))
 
 ;; Log a message STRING in *Compile-Log*.
           pt))))
 
 ;; Log a message STRING in *Compile-Log*.


@@ -990,7 +1036,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 (defun byte-compile-log-warning (string &optional fill level)
   (let ((warning-prefix-function 'byte-compile-warning-prefix)
        (warning-type-format "")
 (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 "    ")))
+       (warning-fill-prefix (if fill "    "))
+       (inhibit-read-only t))

     (display-warning 'bytecomp string level "*Compile-Log*")))
 
 (defun byte-compile-warn (format &rest args)
     (display-warning 'bytecomp string level "*Compile-Log*")))
 
 (defun byte-compile-warn (format &rest args)


@@ -1014,11 +1061,11 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
         (when (nth 2 new)))
     (byte-compile-set-symbol-position (car form))
     (if (memq 'obsolete byte-compile-warnings)
         (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) "")
+       (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
+                          (if when (concat " (as of Emacs " when ")") "")

                           (if (stringp (car new))
                               (car new)
                           (if (stringp (car new))
                               (car new)

-                            (format "use %s instead." (car new)))))
+                            (format "use `%s' instead." (car new)))))

     (funcall (or handler 'byte-compile-normal-call) form)))
 \f
 ;; Compiler options
     (funcall (or handler 'byte-compile-normal-call) form)))
 \f
 ;; Compiler options


@@ -1081,6 +1128,10 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 \f
 ;;; sanity-checking arglists
 
 \f
 ;;; sanity-checking arglists
 

+;; If a function has an entry saying (FUNCTION . t).
+;; that means we know it is defined but we don't know how.
+;; If a function has an entry saying (FUNCTION . nil),
+;; that means treat it as not defined.

 (defun byte-compile-fdefinition (name macro-p)
   (let* ((list (if macro-p
                   byte-compile-macro-environment
 (defun byte-compile-fdefinition (name macro-p)
   (let* ((list (if macro-p
                   byte-compile-macro-environment


@@ -1146,7 +1197,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 (defun byte-compile-callargs-warn (form)
   (let* ((def (or (byte-compile-fdefinition (car form) nil)
                  (byte-compile-fdefinition (car form) t)))
 (defun byte-compile-callargs-warn (form)
   (let* ((def (or (byte-compile-fdefinition (car form) nil)
                  (byte-compile-fdefinition (car form) t)))

-        (sig (if def
+        (sig (if (and def (not (eq def t)))

                  (byte-compile-arglist-signature
                   (if (eq 'lambda (car-safe def))
                       (nth 1 def)
                  (byte-compile-arglist-signature
                   (if (eq 'lambda (car-safe def))
                       (nth 1 def)


@@ -1176,7 +1227,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
     (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.
     (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.
+    (or (and (or def (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.
             (not (memq (car form) byte-compile-noruntime-functions)))
        (eq (car form) byte-compile-current-form) ; ## this doesn't work
                                        ; with recursion.


@@ -1187,9 +1238,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
          (if cons
              (or (memq n (cdr cons))
                  (setcdr cons (cons n (cdr cons))))
          (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)))))))
+           (push (list (car form) n)
+                 byte-compile-unresolved-functions))))))

 
 (defun byte-compile-format-warn (form)
   "Warn if FORM is `format'-like with inconsistent args.
 
 (defun byte-compile-format-warn (form)
   "Warn if FORM is `format'-like with inconsistent args.


@@ -1217,11 +1267,28 @@ extra args."
 (dolist (elt '(format message error))
   (put elt 'byte-compile-format-like t))
 
 (dolist (elt '(format message error))
   (put elt 'byte-compile-format-like t))
 

+;; Warn if a custom definition fails to specify :group.
+(defun byte-compile-nogroup-warn (form)
+  (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
+       (name (cadr form)))
+    (or (not (eq (car-safe name) 'quote))
+       (and (eq (car form) 'custom-declare-group)
+            (equal name ''emacs))
+       (plist-get keyword-args :group)
+       (not (and (consp name) (eq (car name) 'quote)))
+       (byte-compile-warn
+        "%s for `%s' fails to specify containing group"
+        (cdr (assq (car form)
+                   '((custom-declare-group . defgroup)
+                     (custom-declare-face . defface)
+                     (custom-declare-variable . defcustom))))
+        (cadr name)))))
+

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

-    (if old
+    (if (and old (not (eq old t)))

        (let ((sig1 (byte-compile-arglist-signature
                      (if (eq 'lambda (car-safe old))
                          (nth 1 old)
        (let ((sig1 (byte-compile-arglist-signature
                      (if (eq 'lambda (car-safe old))
                          (nth 1 old)


@@ -1538,6 +1605,7 @@ recompile every `.el' file that already has a `.elc' file."
 This is normally set in local file variables at the end of the elisp file:
 
 ;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
 This is normally set in local file variables at the end of the elisp file:
 
 ;; Local Variables:\n;; no-byte-compile: t\n;; End: ")

+;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)

 
 ;;;###autoload
 (defun byte-compile-file (filename &optional load)
 
 ;;;###autoload
 (defun byte-compile-file (filename &optional load)


@@ -1599,8 +1667,12 @@ The value is non-nil if there were no errors, nil if errors."
       ;; If they change the file name, then change it for the output also.
       (let ((buffer-file-name filename)
            (default-major-mode 'emacs-lisp-mode)
       ;; If they change the file name, then change it for the output also.
       (let ((buffer-file-name filename)
            (default-major-mode 'emacs-lisp-mode)

+           ;; Ignore unsafe local variables.
+           ;; We only care about a few of them for our purposes.
+           (enable-local-variables :safe)

            (enable-local-eval nil))
            (enable-local-eval nil))

-        (normal-mode)
+       ;; Arg of t means don't alter enable-local-variables.
+        (normal-mode t)

         (setq filename buffer-file-name))
       ;; Set the default directory, in case an eval-when-compile uses it.
       (setq default-directory (file-name-directory filename)))
         (setq filename buffer-file-name))
       ;; Set the default directory, in case an eval-when-compile uses it.
       (setq default-directory (file-name-directory filename)))


@@ -1738,7 +1810,7 @@ With argument, insert value in current buffer after the form."
        (byte-compile-maxdepth 0)
        (byte-compile-output nil)
        ;; This allows us to get the positions of symbols read; it's
        (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.
+       ;; new in Emacs 22.1.

        (read-with-symbol-positions inbuffer)
        (read-symbol-positions-list nil)
        ;;        #### This is bound in b-c-close-variables.
        (read-with-symbol-positions inbuffer)
        (read-symbol-positions-list nil)
        ;;        #### This is bound in b-c-close-variables.


@@ -2082,7 +2154,7 @@ list that represents a doc string reference.
 (defun byte-compile-file-form-defsubst (form)
   (when (assq (nth 1 form) byte-compile-unresolved-functions)
     (setq byte-compile-current-form (nth 1 form))
 (defun byte-compile-file-form-defsubst (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"
+    (byte-compile-warn "defsubst `%s' was used before it was defined"

                       (nth 1 form)))
   (byte-compile-file-form
    (macroexpand form byte-compile-macro-environment))
                       (nth 1 form)))
   (byte-compile-file-form
    (macroexpand form byte-compile-macro-environment))


@@ -2101,9 +2173,9 @@ list that represents a doc string reference.
           (eq (car (nth 1 form)) 'quote)
           (consp (cdr (nth 1 form)))
           (symbolp (nth 1 (nth 1 form))))
           (eq (car (nth 1 form)) 'quote)
           (consp (cdr (nth 1 form)))
           (symbolp (nth 1 (nth 1 form))))

-      (add-to-list 'byte-compile-function-environment
-                  (cons (nth 1 (nth 1 form))
-                        (cons 'autoload (cdr (cdr form))))))
+      (push (cons (nth 1 (nth 1 form))
+                 (cons 'autoload (cdr (cdr form))))
+           byte-compile-function-environment))

   (if (stringp (nth 3 form))
       form
     ;; No doc string, so we can compile this as a normal form.
   (if (stringp (nth 3 form))
       form
     ;; No doc string, so we can compile this as a normal form.


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

+  (when (memq 'callargs byte-compile-warnings)
+    (byte-compile-nogroup-warn form))

   (when (memq 'free-vars byte-compile-warnings)
     (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
   (let ((tail (nthcdr 4 form)))
   (when (memq 'free-vars byte-compile-warnings)
     (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
   (let ((tail (nthcdr 4 form)))


@@ -2146,17 +2220,15 @@ list that represents a doc string reference.
       (setq tail (cdr tail))))
   form)
 
       (setq tail (cdr tail))))
   form)
 

-(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
-(defun byte-compile-file-form-eval-boundary (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)))))
+(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
+(defun byte-compile-file-form-require (form)
+  (let ((old-load-list current-load-list)
+       (args (mapcar 'eval (cdr form))))
+    (apply 'require args)
+    ;; Detect (require 'cl) in a way that works even if cl is already loaded.
+    (if (member (car args) '("cl" cl))
+       (setq byte-compile-warnings
+             (remq 'cl-functions byte-compile-warnings))))

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


@@ -2212,7 +2284,7 @@ list that represents a doc string reference.
                    (not (assq (nth 1 form)
                               byte-compile-initial-macro-environment)))
               (byte-compile-warn
                    (not (assq (nth 1 form)
                               byte-compile-initial-macro-environment)))
               (byte-compile-warn

-                "%s defined multiple times, as both function and macro"
+                "`%s' defined multiple times, as both function and macro"

                 (nth 1 form)))
           (setcdr that-one nil))
          (this-one
                 (nth 1 form)))
           (setcdr that-one nil))
          (this-one


@@ -2221,14 +2293,14 @@ list that represents a doc string reference.
                    ;; byte-compiler macros in byte-run.el...
                    (not (assq (nth 1 form)
                               byte-compile-initial-macro-environment)))
                    ;; 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"
+            (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)))
           (when (memq 'redefine byte-compile-warnings)
                                (if macrop "macro" "function")
                                (nth 1 form))))
          ((and (fboundp name)
                (eq (car-safe (symbol-function name))
                    (if macrop 'lambda 'macro)))
           (when (memq 'redefine byte-compile-warnings)

-            (byte-compile-warn "%s %s being redefined as a %s"
+            (byte-compile-warn "%s `%s' being redefined as a %s"

                                (if macrop "function" "macro")
                                (nth 1 form)
                                (if macrop "macro" "function")))
                                (if macrop "function" "macro")
                                (nth 1 form)
                                (if macrop "macro" "function")))


@@ -2260,7 +2332,7 @@ list that represents a doc string reference.
                                 ',name ',declaration))
                   outbuffer)))))
 
                                 ',name ',declaration))
                   outbuffer)))))
 

-    (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
+    (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))

           (code (byte-compile-byte-code-maker new-one)))
       (if this-one
          (setcdr this-one new-one)
           (code (byte-compile-byte-code-maker new-one)))
       (if this-one
          (setcdr this-one new-one)


@@ -2456,10 +2528,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Byte-compile a lambda-expression and return a valid function.
 ;; The value is usually a compiled function but may be the original
 ;; lambda-expression.
 ;; Byte-compile a lambda-expression and return a valid function.
 ;; The value is usually a compiled function but may be the original
 ;; lambda-expression.

-(defun byte-compile-lambda (fun)
-  (unless (eq 'lambda (car-safe fun))
-    (error "Not a lambda list: %S" fun))
-  (byte-compile-set-symbol-position 'lambda)
+;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
+;; of the list FUN and `byte-compile-set-symbol-position' is not called.
+;; Use this feature to avoid calling `byte-compile-set-symbol-position'
+;; for symbols generated by the byte compiler itself.
+(defun byte-compile-lambda (fun &optional add-lambda)
+  (if add-lambda
+      (setq fun (cons '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


@@ -2689,26 +2767,39 @@ 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))
         (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))

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

                (byte-compile-constant form))
               ((and for-effect byte-compile-delete-errors)
                (byte-compile-constant form))
               ((and for-effect byte-compile-delete-errors)

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

                (setq for-effect nil))
               (t (byte-compile-variable-ref 'byte-varref form))))
        ((symbolp (car form))
         (let* ((fn (car form))
                (handler (get fn 'byte-compile)))
                (setq for-effect nil))
               (t (byte-compile-variable-ref 'byte-varref form))))
        ((symbolp (car form))
         (let* ((fn (car form))
                (handler (get fn 'byte-compile)))

-          (byte-compile-set-symbol-position fn)

           (when (byte-compile-const-symbol-p fn)
           (when (byte-compile-const-symbol-p fn)

-            (byte-compile-warn "%s called as a function" fn))
+            (byte-compile-warn "`%s' called as a function" fn))
+          (and (memq 'interactive-only byte-compile-warnings)
+               (memq fn byte-compile-interactive-only-functions)
+               (byte-compile-warn "`%s' used from Lisp code\n\
+That command is designed for interactive use only" fn))

           (if (and handler
           (if (and handler

-                   (or (not (byte-compile-version-cond
-                             byte-compile-compatibility))
-                       (not (get (get fn 'byte-opcode) 'emacs19-opcode))))
-              (funcall handler form)
-            (if (memq 'callargs byte-compile-warnings)
-                (byte-compile-callargs-warn form))
+                    ;; Make sure that function exists.  This is important
+                    ;; for CL compiler macros since the symbol may be
+                    ;; `cl-byte-compile-compiler-macro' but if CL isn't
+                    ;; loaded, this function doesn't exist.
+                    (or (not (memq handler '(cl-byte-compile-compiler-macro)))
+                        (functionp handler))
+                   (not (and (byte-compile-version-cond
+                               byte-compile-compatibility)
+                              (get (get fn 'byte-opcode) 'emacs19-opcode))))
+               (funcall handler form)
+            (when (memq 'callargs byte-compile-warnings)
+              (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
+                  (byte-compile-nogroup-warn form))
+              (byte-compile-callargs-warn form))

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


@@ -2736,9 +2827,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (if (or (not (symbolp var))
          (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
       (byte-compile-warn
   (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"))
+       (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 (symbolp var) "constant" "nonvariable")
        (prin1-to-string var))
     (if (and (get var 'byte-obsolete-variable)


@@ -2746,11 +2837,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
             (not (eq var byte-compile-not-obsolete-var)))
        (let* ((ob (get var 'byte-obsolete-variable))
               (when (cdr ob)))
             (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
-                            (if when (concat " since " when) "")
+         (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
+                            (if when (concat " (as of Emacs " when ")") "")

                             (if (stringp (car ob))
                                 (car ob)
                             (if (stringp (car ob))
                                 (car ob)

-                              (format "use %s instead." (car ob))))))
+                              (format "use `%s' instead." (car ob))))))

     (if (memq 'free-vars byte-compile-warnings)
        (if (eq base-op 'byte-varbind)
            (push var byte-compile-bound-variables)
     (if (memq 'free-vars byte-compile-warnings)
        (if (eq base-op 'byte-varbind)
            (push var byte-compile-bound-variables)


@@ -2759,11 +2850,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
              (if (eq base-op 'byte-varset)
                  (or (memq var byte-compile-free-assignments)
                      (progn
              (if (eq base-op 'byte-varset)
                  (or (memq var byte-compile-free-assignments)
                      (progn

-                       (byte-compile-warn "assignment to free variable %s" var)
+                       (byte-compile-warn "assignment to free variable `%s'" var)

                        (push var byte-compile-free-assignments)))
                (or (memq var byte-compile-free-references)
                    (progn
                        (push var byte-compile-free-assignments)))
                (or (memq var byte-compile-free-references)
                    (progn

-                     (byte-compile-warn "reference to free variable %s" var)
+                     (byte-compile-warn "reference to free variable `%s'" var)

                      (push var byte-compile-free-references))))))))
   (let ((tmp (assq var byte-compile-variables)))
     (unless tmp
                      (push var byte-compile-free-references))))))))
   (let ((tmp (assq var byte-compile-variables)))
     (unless tmp


@@ -2868,9 +2959,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (put 'byte-concatN 'byte-opcode-invert 'concat)
 (put 'byte-insertN 'byte-opcode-invert 'insert)
 
 (put 'byte-concatN 'byte-opcode-invert 'concat)
 (put 'byte-insertN 'byte-opcode-invert 'insert)
 

-(byte-defop-compiler (dot byte-point)          0)
-(byte-defop-compiler (dot-max byte-point-max)  0)
-(byte-defop-compiler (dot-min byte-point-min)  0)

 (byte-defop-compiler point             0)
 ;;(byte-defop-compiler mark            0) ;; obsolete
 (byte-defop-compiler point-max         0)
 (byte-defop-compiler point             0)
 ;;(byte-defop-compiler mark            0) ;; obsolete
 (byte-defop-compiler point-max         0)


@@ -2906,7 +2994,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler char-after                0-1)
 (byte-defop-compiler set-buffer                1)
 ;;(byte-defop-compiler set-mark                1) ;; obsolete
 (byte-defop-compiler char-after                0-1)
 (byte-defop-compiler set-buffer                1)
 ;;(byte-defop-compiler set-mark                1) ;; obsolete

-(byte-defop-compiler19 forward-word    1)
+(byte-defop-compiler19 forward-word    0-1)

 (byte-defop-compiler19 char-syntax     1)
 (byte-defop-compiler19 nreverse                1)
 (byte-defop-compiler19 car-safe                1)
 (byte-defop-compiler19 char-syntax     1)
 (byte-defop-compiler19 nreverse                1)
 (byte-defop-compiler19 car-safe                1)


@@ -2964,7 +3052,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 \f
 (defun byte-compile-subr-wrong-args (form n)
   (byte-compile-set-symbol-position (car form))
 \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"
+  (byte-compile-warn "`%s' called with %d arg%s, but requires %s"

                     (car form) (length (cdr form))
                     (if (= 1 (length (cdr form))) "" "s") n)
   ;; get run-time wrong-number-of-args error.
                     (car form) (length (cdr form))
                     (if (= 1 (length (cdr form))) "" "s") n)
   ;; get run-time wrong-number-of-args error.


@@ -3130,7 +3218,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
          (if (and (consp (car body))
                   (not (eq 'byte-code (car (car body)))))
              (byte-compile-warn
          (if (and (consp (car body))
                   (not (eq 'byte-code (car (car body)))))
              (byte-compile-warn

-      "A quoted lambda form is the second argument of fset.  This is probably
+      "A quoted lambda form is the second argument of `fset'.  This is probably

      not what you want, as that lambda cannot be compiled.  Consider using
      the syntax (function (lambda (...) ...)) instead.")))))
   (byte-compile-two-args form))
      not what you want, as that lambda cannot be compiled.  Consider using
      the syntax (function (lambda (...) ...)) instead.")))))
   (byte-compile-two-args form))


@@ -3301,11 +3389,14 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defmacro byte-compile-maybe-guarded (condition &rest body)
   "Execute forms in BODY, potentially guarded by CONDITION.
 
 (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."
+CONDITION is a variable whose value is a test in an `if' or `cond'.
+BODY is the code to compile  first arm of the if or the body of the
+cond clause.  If CONDITION's value is of the form (fboundp 'foo)
+or (boundp 'foo), the relevant warnings from BODY about foo's
+being undefined will be suppressed.
+
+If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
+that suppresses all warnings during execution of BODY."

   (declare (indent 1) (debug t))
   `(let* ((fbound
           (if (eq 'fboundp (car-safe ,condition))
   (declare (indent 1) (debug t))
   `(let* ((fbound
           (if (eq 'fboundp (car-safe ,condition))


@@ -3323,13 +3414,19 @@ being undefined will be suppressed."
          (byte-compile-bound-variables
           (if bound
               (cons bound byte-compile-bound-variables)
          (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)))))
+            byte-compile-bound-variables))
+         ;; Suppress all warnings, for code not used in Emacs.
+         (byte-compile-warnings
+          (if (member ,condition '((featurep 'xemacs)
+                                   (not (featurep 'emacs))))
+              nil byte-compile-warnings)))
+     (unwind-protect
+        (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)))


@@ -3350,7 +3447,8 @@ being undefined will be suppressed."
          (byte-compile-form (nth 2 form) for-effect))
        (byte-compile-goto 'byte-goto donetag)
        (byte-compile-out-tag 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-maybe-guarded (list 'not clause)
+         (byte-compile-body (cdr (cdr (cdr form))) for-effect))

        (byte-compile-out-tag donetag))))
   (setq for-effect nil))
 
        (byte-compile-out-tag donetag))))
   (setq for-effect nil))
 


@@ -3370,12 +3468,12 @@ being undefined will be suppressed."
             (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-maybe-guarded (car clause)
-                  (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
     (let ((guard (car clause)))
       (and (cdr clause) (not (eq guard t))
     ;; Last clause
     (let ((guard (car clause)))
       (and (cdr clause) (not (eq guard t))


@@ -3391,24 +3489,38 @@ being undefined will be suppressed."
        (args (cdr form)))
     (if (null args)
        (byte-compile-form-do-effect t)
        (args (cdr form)))
     (if (null args)
        (byte-compile-form-do-effect t)

-      (while (cdr args)
-       (byte-compile-form (car args))
+      (byte-compile-and-recursion args failtag))))
+
+;; Handle compilation of a nontrivial `and' call.
+;; We use tail recursion so we can use byte-compile-maybe-guarded.
+(defun byte-compile-and-recursion (rest failtag)
+  (if (cdr rest)
+      (progn
+       (byte-compile-form (car rest))

        (byte-compile-goto-if nil for-effect failtag)
        (byte-compile-goto-if nil for-effect failtag)

-       (setq args (cdr args)))
-      (byte-compile-form-do-effect (car args))
-      (byte-compile-out-tag failtag))))
+       (byte-compile-maybe-guarded (car rest)
+         (byte-compile-and-recursion (cdr rest) failtag)))
+    (byte-compile-form-do-effect (car rest))
+    (byte-compile-out-tag failtag)))

 
 (defun byte-compile-or (form)
   (let ((wintag (byte-compile-make-tag))
        (args (cdr form)))
     (if (null args)
        (byte-compile-form-do-effect nil)
 
 (defun byte-compile-or (form)
   (let ((wintag (byte-compile-make-tag))
        (args (cdr form)))
     (if (null args)
        (byte-compile-form-do-effect nil)

-      (while (cdr args)
-       (byte-compile-form (car args))
+      (byte-compile-or-recursion args wintag))))
+
+;; Handle compilation of a nontrivial `or' call.
+;; We use tail recursion so we can use byte-compile-maybe-guarded.
+(defun byte-compile-or-recursion (rest wintag)
+  (if (cdr rest)
+      (progn
+       (byte-compile-form (car rest))

        (byte-compile-goto-if t for-effect wintag)
        (byte-compile-goto-if t for-effect wintag)

-       (setq args (cdr args)))
-      (byte-compile-form-do-effect (car args))
-      (byte-compile-out-tag wintag))))
+       (byte-compile-maybe-guarded (list 'not (car rest))
+         (byte-compile-or-recursion (cdr rest) wintag)))
+    (byte-compile-form-do-effect (car rest))
+    (byte-compile-out-tag wintag)))

 
 (defun byte-compile-while (form)
   (let ((endtag (byte-compile-make-tag))
 
 (defun byte-compile-while (form)
   (let ((endtag (byte-compile-make-tag))


@@ -3513,7 +3625,7 @@ being undefined will be suppressed."
     (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
       (byte-compile-warn
     (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))
+       "`%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))


@@ -3531,13 +3643,13 @@ being undefined will be suppressed."
                                   (setq syms (cdr syms)))
                                 ok))))
                  (byte-compile-warn
                                   (setq syms (cdr syms)))
                                 ok))))
                  (byte-compile-warn

-                   "%s is not a condition name or list of such (in condition-case)"
+                   "`%s' is not a condition name or list of such (in condition-case)"

                    (prin1-to-string condition)))
 ;;                ((not (or (eq condition 't)
 ;;                       (and (stringp (get condition 'error-message))
 ;;                            (consp (get condition 'error-conditions)))))
 ;;                 (byte-compile-warn
                    (prin1-to-string condition)))
 ;;                ((not (or (eq condition 't)
 ;;                       (and (stringp (get condition 'error-message))
 ;;                            (consp (get condition 'error-conditions)))))
 ;;                 (byte-compile-warn

-;;                   "%s is not a known condition name (in condition-case)"
+;;                   "`%s' is not a known condition name (in condition-case)"

 ;;                   condition))
                )
          (setq compiled-clauses
 ;;                   condition))
                )
          (setq compiled-clauses


@@ -3584,7 +3696,6 @@ being undefined will be suppressed."
 (byte-defop-compiler-1 defconst byte-compile-defvar)
 (byte-defop-compiler-1 autoload)
 (byte-defop-compiler-1 lambda byte-compile-lambda-form)
 (byte-defop-compiler-1 defconst byte-compile-defvar)
 (byte-defop-compiler-1 autoload)
 (byte-defop-compiler-1 lambda byte-compile-lambda-form)

-(byte-defop-compiler-1 defalias)

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


@@ -3598,7 +3709,7 @@ being undefined will be suppressed."
         (list 'fset
               (list 'quote (nth 1 form))
               (byte-compile-byte-code-maker
         (list 'fset
               (list 'quote (nth 1 form))
               (byte-compile-byte-code-maker

-               (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
+               (byte-compile-lambda (cdr (cdr form)) t))))

        (byte-compile-discard))
     ;; We prefer to generate a defalias form so it will record the function
     ;; definition just like interpreting a defun.
        (byte-compile-discard))
     ;; We prefer to generate a defalias form so it will record the function
     ;; definition just like interpreting a defun.


@@ -3606,7 +3717,7 @@ being undefined will be suppressed."
      (list 'defalias
           (list 'quote (nth 1 form))
           (byte-compile-byte-code-maker
      (list 'defalias
           (list 'quote (nth 1 form))
           (byte-compile-byte-code-maker

-           (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))
+           (byte-compile-lambda (cdr (cdr form)) t)))

      t))
   (byte-compile-constant (nth 1 form)))
 
      t))
   (byte-compile-constant (nth 1 form)))
 


@@ -3615,8 +3726,7 @@ being undefined will be suppressed."
   (byte-compile-body-do-effect
    (list (list 'fset (list 'quote (nth 1 form))
               (let ((code (byte-compile-byte-code-maker
   (byte-compile-body-do-effect
    (list (list 'fset (list 'quote (nth 1 form))
               (let ((code (byte-compile-byte-code-maker

-                           (byte-compile-lambda
-                            (cons 'lambda (cdr (cdr form)))))))
+                           (byte-compile-lambda (cdr (cdr form)) t))))

                 (if (eq (car-safe code) 'make-byte-code)
                     (list 'cons ''macro code)
                   (list 'quote (cons 'macro (eval code))))))
                 (if (eq (car-safe code) 'make-byte-code)
                     (list 'cons ''macro code)
                   (list 'quote (cons 'macro (eval code))))))


@@ -3633,7 +3743,7 @@ being undefined will be suppressed."
              (and (eq fun 'defconst) (null (cddr form))))
       (let ((ncall (length (cdr form))))
        (byte-compile-warn
              (and (eq fun 'defconst) (null (cddr form))))
       (let ((ncall (length (cdr form))))
        (byte-compile-warn

-        "%s called with %d argument%s, but %s %s"
+        "`%s' called with %d argument%s, but %s %s"

         fun ncall
         (if (= 1 ncall) "" "s")
         (if (< ncall 2) "requires" "accepts only")
         fun ncall
         (if (= 1 ncall) "" "s")
         (if (< ncall 2) "requires" "accepts only")


@@ -3650,7 +3760,7 @@ being undefined will be suppressed."
        `(push ',var current-load-list))
       (when (> (length form) 3)
        (when (and string (not (stringp string)))
        `(push ',var current-load-list))
       (when (> (length form) 3)
        (when (and string (not (stringp string)))

-         (byte-compile-warn "third arg to %s %s is not a string: %s"
+         (byte-compile-warn "third arg to `%s %s' is not a string: %s"

                             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


@@ -3686,23 +3796,31 @@ being undefined will be suppressed."
   (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.

-(defun byte-compile-defalias (form)
+(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
+(defun byte-compile-file-form-defalias (form)

   (if (and (consp (cdr form)) (consp (nth 1 form))
           (eq (car (nth 1 form)) 'quote)
           (consp (cdr (nth 1 form)))
   (if (and (consp (cdr form)) (consp (nth 1 form))
           (eq (car (nth 1 form)) 'quote)
           (consp (cdr (nth 1 form)))

-          (symbolp (nth 1 (nth 1 form)))
-          (consp (nthcdr 2 form))
-          (consp (nth 2 form))
-          (eq (car (nth 2 form)) 'quote)
-          (consp (cdr (nth 2 form)))
-          (symbolp (nth 1 (nth 2 form))))
-      (progn
+          (symbolp (nth 1 (nth 1 form))))
+      (let ((constant
+            (and (consp (nthcdr 2 form))
+                 (consp (nth 2 form))
+                 (eq (car (nth 2 form)) 'quote)
+                 (consp (cdr (nth 2 form)))
+                 (symbolp (nth 1 (nth 2 form))))))

        (byte-compile-defalias-warn (nth 1 (nth 1 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)))
-                   byte-compile-function-environment))))
-  (byte-compile-normal-call form))
+       (push (cons (nth 1 (nth 1 form))
+                   (if constant (nth 1 (nth 2 form)) t))
+             byte-compile-function-environment)))
+  ;; We used to jus do: (byte-compile-normal-call form)
+  ;; But it turns out that this fails to optimize the code.
+  ;; So instead we now do the same as what other byte-hunk-handlers do,
+  ;; which is to call back byte-compile-file-form and then return nil.
+  ;; Except that we can't just call byte-compile-file-form since it would
+  ;; call us right back.
+  (byte-compile-keep-pending form)
+  ;; Return nil so the form is not output twice.
+  nil)

 
 ;; Turn off warnings about prior calls to the function being defalias'd.
 ;; This could be smarter and compare those calls with
 
 ;; Turn off warnings about prior calls to the function being defalias'd.
 ;; This could be smarter and compare those calls with


@@ -3717,6 +3835,19 @@ being undefined will be suppressed."
 (defun byte-compile-no-warnings (form)
   (let (byte-compile-warnings)
     (byte-compile-form (cons 'progn (cdr form)))))
 (defun byte-compile-no-warnings (form)
   (let (byte-compile-warnings)
     (byte-compile-form (cons 'progn (cdr form)))))

+
+;; Warn about misuses of make-variable-buffer-local.
+(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
+(defun byte-compile-make-variable-buffer-local (form)
+  (if (eq (car-safe (car-safe (cdr-safe form))) 'quote)
+      (byte-compile-warn
+       "`make-variable-buffer-local' should be called at toplevel"))
+  (byte-compile-normal-call form))
+(put 'make-variable-buffer-local
+     'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
+(defun byte-compile-form-make-variable-buffer-local (form)
+  (byte-compile-keep-pending form 'byte-compile-normal-call))
+

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


@@ -3884,15 +4015,18 @@ invoked interactively."
                                 (mapconcat 'symbol-name callers ", ")
                               "<top level>"))
              (let ((fill-prefix "    "))
                                 (mapconcat 'symbol-name callers ", ")
                               "<top level>"))
              (let ((fill-prefix "    "))

-               (fill-region-as-paragraph p (point)))))
+               (fill-region-as-paragraph p (point)))
+              (unless (= 0 (current-column))
+                (insert "\n"))))

        (if calls
            (progn
              (insert "  calls:\n")
              (setq p (point))
              (insert "    " (mapconcat 'symbol-name calls ", "))
              (let ((fill-prefix "    "))
        (if calls
            (progn
              (insert "  calls:\n")
              (setq p (point))
              (insert "    " (mapconcat 'symbol-name calls ", "))
              (let ((fill-prefix "    "))

-               (fill-region-as-paragraph p (point)))))
-       (insert "\n")
+               (fill-region-as-paragraph p (point)))
+              (unless (= 0 (current-column))
+                (insert "\n"))))

        (setq rest (cdr rest)))
 
       (message "Generating call tree...(finding uncalled functions...)")
        (setq rest (cdr rest)))
 
       (message "Generating call tree...(finding uncalled functions...)")


@@ -3901,7 +4035,7 @@ invoked interactively."
        (while rest
          (or (nth 1 (car rest))
              (null (setq f (car (car rest))))
        (while rest
          (or (nth 1 (car rest))
              (null (setq f (car (car rest))))

-             (byte-compile-fdefinition f t)
+             (functionp (byte-compile-fdefinition f t))

              (commandp (byte-compile-fdefinition f nil))
              (setq uncalled (cons f uncalled)))
          (setq rest (cdr rest)))
              (commandp (byte-compile-fdefinition f nil))
              (setq uncalled (cons f uncalled)))
          (setq rest (cdr rest)))


@@ -3994,7 +4128,11 @@ already up-to-date."
 (defun batch-byte-recompile-directory (&optional arg)
   "Run `byte-recompile-directory' on the dirs remaining on the command line.
 Must be used only with `-batch', and kills Emacs on completion.
 (defun batch-byte-recompile-directory (&optional arg)
   "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 .'."
+For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
+
+Optional argument ARG is passed as second argument ARG to
+`batch-recompile-directory'; see there for its possible values
+and corresponding effects."

   ;; command-line-args-left is what is left of the command line (startup.el)
   (defvar command-line-args-left)      ;Avoid 'free variable' warning
   (if (not noninteractive)
   ;; command-line-args-left is what is left of the command line (startup.el)
   (defvar command-line-args-left)      ;Avoid 'free variable' warning
   (if (not noninteractive)


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

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


@@ -4083,5 +4200,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
+;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a

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