(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 3948dae610b0b6192c97365adc99ef8172ad6507..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
 
 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,

-;;   2003, 2004, 2005  Free Software Foundation, Inc.
+;;   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:
 


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


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


@@ -311,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*.


@@ -355,10 +357,24 @@ Elements of the list may be be:
                      (const callargs) (const redefine)
                      (const obsolete) (const noruntime)
                      (const cl-functions) (const interactive-only))))
                      (const callargs) (const redefine)
                      (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
 
 (defvar byte-compile-interactive-only-functions
   '(beginning-of-buffer end-of-buffer replace-string replace-regexp

-                       insert-file)
+    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
   "List of commands that are not meant to be called from Lisp.")
 
 (defvar byte-compile-not-obsolete-var nil


@@ -908,6 +924,13 @@ 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)
 ;; 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)


@@ -1248,7 +1271,10 @@ extra args."
 (defun byte-compile-nogroup-warn (form)
   (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
        (name (cadr form)))
 (defun byte-compile-nogroup-warn (form)
   (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
        (name (cadr form)))

-    (or (plist-get keyword-args :group)
+    (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"
        (not (and (consp name) (eq (car name) 'quote)))
        (byte-compile-warn
         "%s for `%s' fails to specify containing group"


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


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


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


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


@@ -2749,12 +2786,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                (byte-compile-warn "`%s' used from Lisp code\n\
 That command is designed for interactive use only" fn))
           (if (and handler
                (byte-compile-warn "`%s' used from Lisp code\n\
 That command is designed for interactive use only" fn))
           (if (and handler

-                   (or (not (byte-compile-version-cond
-                             byte-compile-compatibility))
-                       (not (get (get fn 'byte-opcode) 'emacs19-opcode))))
-              (progn
-                (byte-compile-set-symbol-position fn)
-                (funcall handler 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))
             (when (memq 'callargs byte-compile-warnings)
               (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
                   (byte-compile-nogroup-warn form))


@@ -3348,11 +3389,14 @@ That command is designed for interactive use only" fn))
 
 (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))


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


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


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


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


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


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


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


@@ -3748,7 +3812,15 @@ being undefined will be suppressed."
        (push (cons (nth 1 (nth 1 form))
                    (if constant (nth 1 (nth 2 form)) t))
              byte-compile-function-environment)))
        (push (cons (nth 1 (nth 1 form))
                    (if constant (nth 1 (nth 2 form)) t))
              byte-compile-function-environment)))

-  (byte-compile-normal-call form))
+  ;; 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


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


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