(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 fcac1fedd096f7d7e8a87838b10ee93d5e7788eb..32d6694b060753bde100e811fd64419d043a8aee 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,6 +1,6 @@
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 

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

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


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

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

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


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


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

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

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


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

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

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


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


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


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

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

                   ((and (consp s) (eq t (car s)))
                    (push (cdr s) old-autoloads))
                   ((and (consp s) (eq 'autoload (car s)))
                   ((and (consp s) (eq t (car s)))
                    (push (cdr s) old-autoloads))
                   ((and (consp s) (eq 'autoload (car s)))

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

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

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

                (when (and (consp s) (eq t (car s)))
                  (push (cdr s) old-autoloads))))))))))
 
                (when (and (consp s) (eq t (car s)))
                  (push (cdr s) old-autoloads))))))))))
 


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

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

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


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

-          (setq byte-compile-last-logged-file byte-compile-current-file)
+          (setq byte-compile-last-logged-file byte-compile-current-file
+                byte-compile-last-warned-form nil)

           ;; Do this after setting default-directory.
           (unless (eq major-mode 'compilation-mode)
             (compilation-mode))
           ;; Do this after setting default-directory.
           (unless (eq major-mode 'compilation-mode)
             (compilation-mode))


@@ -982,7 +989,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 ;; 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)
 ;; Also log the current function and file if not already done.
 (defun byte-compile-log-warning (string &optional fill level)
   (let ((warning-prefix-function 'byte-compile-warning-prefix)

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

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


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

+    (byte-compile-format-warn form)

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

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

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


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

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

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


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

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

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


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

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

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


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

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

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


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


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

-         (message "%s not compiled because of `no-byte-compile: %s'"
-                  (file-relative-name filename)
-                  (with-current-buffer input-buffer no-byte-compile))
-         (if (file-exists-p target-file)
-             (condition-case nil (delete-file target-file) (error nil)))
+         ;; (message "%s not compiled because of `no-byte-compile: %s'"
+         ;;       (file-relative-name filename)
+         ;;       (with-current-buffer input-buffer no-byte-compile))
+         (when (file-exists-p target-file)
+           (message "%s deleted because of `no-byte-compile: %s'"
+                    (file-relative-name target-file)
+                    (buffer-local-value 'no-byte-compile input-buffer))
+           (condition-case nil (delete-file target-file) (error nil)))

          ;; We successfully didn't compile this file.
          'no-byte-compile)
       (when byte-compile-verbose
          ;; We successfully didn't compile this file.
          'no-byte-compile)
       (when byte-compile-verbose


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

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

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


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


@@ -2441,17 +2484,19 @@ If FORM is a lambda or a macro, byte-compile it as a function."
             (if (cdr (cdr int))
                 (byte-compile-warn "malformed interactive spec: %s"
                                    (prin1-to-string 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'.
+            ;; 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)))
             (let ((form (nth 1 int)))
               (while (memq (car-safe form) '(let let* progn save-excursion))
                 (while (consp (cdr form))
                   (setq form (cdr form)))
                 (setq form (car form)))

-              (or (eq (car-safe form) 'list)
-                  (setq int (list 'interactive
-                                  (byte-compile-top-level (nth 1 int)))))))
+              (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)))))
            ((cdr int)
             (byte-compile-warn "malformed interactive spec: %s"
                                (prin1-to-string int)))))


@@ -2697,7 +2742,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (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)

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


@@ -2727,7 +2773,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)
 
 (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)))))


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


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

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

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

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

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

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

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

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

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

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

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


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


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


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

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

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


@@ -3566,9 +3631,13 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (byte-compile-set-symbol-position fun)
     (when (or (> (length form) 4)
              (and (eq fun 'defconst) (null (cddr form))))
     (byte-compile-set-symbol-position fun)
     (when (or (> (length form) 4)
              (and (eq fun 'defconst) (null (cddr form))))

-      (byte-compile-warn
-       "%s called with %d arguments, but accepts only %s"
-       fun (length (cdr form)) "2-3"))
+      (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)
       (push var byte-compile-bound-variables)
       (if (eq fun 'defconst)
     (when (memq 'free-vars byte-compile-warnings)
       (push var byte-compile-bound-variables)
       (if (eq fun 'defconst)


@@ -3585,13 +3654,14 @@ 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")))
-               `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
-                         ,value))
-           ;; `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)))
        (when (eq fun 'defconst)
          ;; This will signal an appropriate error at runtime.
          `(eval ',form)))


@@ -3642,6 +3712,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (if calls
        (setq byte-compile-unresolved-functions
              (delq calls 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
 


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


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