Merge from mainline.

17 files changed, 729 insertions, 206 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 99447fd8748..56400fbb08f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -35,6 +35,64 @@
         * deps.mk (sysdep.o): Depend on ../lib/allocator.h and on
         ../lib/careadlinkat.h.
 
+2011-04-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        Add lexical binding.
+
+        * window.c (Ftemp_output_buffer_show): New fun.
+        (Fsave_window_excursion):
+        * print.c (Fwith_output_to_temp_buffer): Move to subr.el.
+
+        * lread.c (lisp_file_lexically_bound_p): New function.
+        (Fload): Bind Qlexical_binding.
+        (readevalloop): Remove `evalfun' arg.
+        Bind Qinternal_interpreter_environment.
+        (Feval_buffer): Bind Qlexical_binding.
+        (defvar_int, defvar_bool, defvar_lisp_nopro, defvar_kboard):
+        Mark as dynamic.
+        (syms_of_lread): Declare `lexical-binding'.
+
+        * lisp.h (struct Lisp_Symbol): New field `declared_special'.
+
+        * keyboard.c (eval_dyn): New fun.
+        (menu_item_eval_property): Use it.
+
+        * image.c (parse_image_spec): Use Ffunctionp.
+
+        * fns.c (concat, mapcar1): Accept byte-code-functions.
+
+        * eval.c (Fsetq): Handle lexical vars.
+        (Fdefun, Fdefmacro, Ffunction): Make closures when needed.
+        (Fdefconst, Fdefvaralias, Fdefvar): Mark as dynamic.
+        (FletX, Flet): Obey lexical binding.
+        (Fcommandp): Handle closures.
+        (Feval): New `lexical' arg.
+        (eval_sub): New function extracted from Feval.  Use it almost
+        everywhere where Feval was used.  Look up vars in lexical env.
+        Handle closures.
+        (Ffunctionp): Move from subr.el.
+        (Ffuncall): Handle closures.
+        (apply_lambda): Remove `eval_flags'.
+        (funcall_lambda): Handle closures and new byte-code-functions.
+        (Fspecial_variable_p): New function.
+        (syms_of_eval): Initialize the Vinternal_interpreter_environment var,
+        but without exporting it to Lisp.
+
+        * doc.c (Fdocumentation, store_function_docstring):
+        * data.c (Finteractive_form): Handle closures.
+
+        * callint.c (Fcall_interactively): Preserve lexical-binding mode for
+        interactive spec.
+
+        * bytecode.c (Bstack_ref, Bstack_set, Bstack_set2, BdiscardN): New
+        byte-codes.
+        (exec_byte_code): New function extracted from Fbyte_code to handle new
+        calling convention for byte-code-functions.  Add new byte-codes.
+
+        * buffer.c (defvar_per_buffer): Set new `declared_special' field.
+
+        * alloc.c (Fmake_symbol): Init new `declared_special' field.
+
 2011-03-31  Juanma Barranquero  <lekktu@gmail.com>
 
         * xdisp.c (redisplay_internal): Fix prototype.
diff --git a/src/alloc.c b/src/alloc.c
index 177a2266fb6..07f1caae46b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2940,10 +2940,19 @@ usage: (vector &rest OBJECTS)  */)
 
 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
        doc: /* Create a byte-code object with specified arguments as elements.
-The arguments should be the arglist, bytecode-string, constant vector,
-stack size, (optional) doc string, and (optional) interactive spec.
+The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
+vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
+and (optional) INTERACTIVE-SPEC.
 The first four arguments are required; at most six have any
 significance.
+The ARGLIST can be either like the one of `lambda', in which case the arguments
+will be dynamically bound before executing the byte code, or it can be an
+integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
+minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
+of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
+argument to catch the left-over arguments.  If such an integer is used, the
+arguments will not be dynamically bound but will be instead pushed on the
+stack before executing the byte-code.
 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS)  */)
   (register size_t nargs, Lisp_Object *args)
 {
@@ -3071,6 +3080,7 @@ Its value and function definition are void, and its property list is nil.  */)
   p->gcmarkbit = 0;
   p->interned = SYMBOL_UNINTERNED;
   p->constant = 0;
+  p->declared_special = 0;
   consing_since_gc += sizeof (struct Lisp_Symbol);
   symbols_consed++;
   return val;
diff --git a/src/buffer.c b/src/buffer.c
index 8b56b285e48..cdcd2ccecff 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5240,6 +5240,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
   bo_fwd->type = Lisp_Fwd_Buffer_Obj;
   bo_fwd->offset = offset;
   bo_fwd->slottype = type;
+  sym->declared_special = 1;
   sym->redirect = SYMBOL_FORWARDED;
   {
     /* I tried to do the job without a cast, but it seems impossible.
diff --git a/src/bytecode.c b/src/bytecode.c
index 5a62c913a40..5879d312b07 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -80,9 +80,11 @@ Lisp_Object Qbyte_code_meter;
 
 
 Lisp_Object Qbytecode;
+extern Lisp_Object Qand_optional, Qand_rest;
 
 /*  Byte codes: */
 
+#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup.  */
 #define Bvarref 010
 #define Bvarset 020
 #define Bvarbind 030
@@ -132,7 +134,7 @@ Lisp_Object Qbytecode;
 
 #define Bpoint 0140
 /* Was Bmark in v17.  */
-#define Bsave_current_buffer 0141
+#define Bsave_current_buffer 0141 /* Obsolete.  */
 #define Bgoto_char 0142
 #define Binsert 0143
 #define Bpoint_max 0144
@@ -158,7 +160,7 @@ Lisp_Object Qbytecode;
 #ifdef BYTE_CODE_SAFE
 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
 #endif
-#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
+#define Binteractive_p 0164 /* Obsolete since Emacs-24.1.  */
 
 #define Bforward_char 0165
 #define Bforward_word 0166
@@ -183,16 +185,16 @@ Lisp_Object Qbytecode;
 #define Bdup 0211
 
 #define Bsave_excursion 0212
-#define Bsave_window_excursion 0213
+#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1.  */
 #define Bsave_restriction 0214
 #define Bcatch 0215
 
 #define Bunwind_protect 0216
 #define Bcondition_case 0217
-#define Btemp_output_buffer_setup 0220
-#define Btemp_output_buffer_show 0221
+#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1.  */
+#define Btemp_output_buffer_show 0221  /* Obsolete since Emacs-24.1.  */
 
-#define Bunbind_all 0222
+#define Bunbind_all 0222        /* Obsolete.  Never used.  */
 
 #define Bset_marker 0223
 #define Bmatch_beginning 0224
@@ -228,6 +230,11 @@ Lisp_Object Qbytecode;
 #define BconcatN 0260
 #define BinsertN 0261
 
+/* Bstack_ref is code 0.  */
+#define Bstack_set  0262
+#define Bstack_set2 0263
+#define BdiscardN   0266
+
 #define Bconstant 0300
 
 /* Whether to maintain a `top' and `bottom' field in the stack frame.  */
@@ -414,6 +421,21 @@ the third, MAXDEPTH, the maximum stack depth used in this function.
 If the third argument is incorrect, Emacs may crash.  */)
   (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
 {
+  return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
+}
+
+/* Execute the byte-code in BYTESTR.  VECTOR is the constant vector, and
+   MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
+   emacs may crash!).  If ARGS_TEMPLATE is non-nil, it should be a lisp
+   argument list (including &rest, &optional, etc.), and ARGS, of size
+   NARGS, should be a vector of the actual arguments.  The arguments in
+   ARGS are pushed on the stack according to ARGS_TEMPLATE before
+   executing BYTESTR.  */
+
+Lisp_Object
+exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
+                Lisp_Object args_template, int nargs, Lisp_Object *args)
+{
   int count = SPECPDL_INDEX ();
 #ifdef BYTE_CODE_METER
   int this_op = 0;
@@ -475,6 +497,52 @@ If the third argument is incorrect, Emacs may crash.  */)
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 #endif
 
+  if (INTEGERP (args_template))
+    {
+      int at = XINT (args_template);
+      int rest = at & 128;
+      int mandatory = at & 127;
+      int nonrest = at >> 8;
+      eassert (mandatory <= nonrest);
+      if (nargs <= nonrest)
+        {
+          int i;
+          for (i = 0 ; i < nargs; i++, args++)
+            PUSH (*args);
+          if (nargs < mandatory)
+            /* Too few arguments.  */
+            Fsignal (Qwrong_number_of_arguments,
+                     Fcons (Fcons (make_number (mandatory),
+                                   rest ? Qand_rest : make_number (nonrest)),
+                            Fcons (make_number (nargs), Qnil)));
+          else
+            {
+              for (; i < nonrest; i++)
+                PUSH (Qnil);
+              if (rest)
+                PUSH (Qnil);
+            }
+        }
+      else if (rest)
+        {
+          int i;
+          for (i = 0 ; i < nonrest; i++, args++)
+            PUSH (*args);
+          PUSH (Flist (nargs - nonrest, args));
+        }
+      else
+        /* Too many arguments.  */
+        Fsignal (Qwrong_number_of_arguments,
+                 Fcons (Fcons (make_number (mandatory),
+                               make_number (nonrest)),
+                        Fcons (make_number (nargs), Qnil)));
+    }
+  else if (! NILP (args_template))
+    /* We should push some arguments on the stack.  */
+    {
+      error ("Unknown args template!");
+    }
+
   while (1)
     {
 #ifdef BYTE_CODE_SAFE
@@ -735,7 +803,7 @@ If the third argument is incorrect, Emacs may crash.  */)
           AFTER_POTENTIAL_GC ();
           break;
 
-        case Bunbind_all:
+        case Bunbind_all:       /* Obsolete.  Never used.  */
           /* To unbind back to the beginning of this frame.  Not used yet,
              but will be needed for tail-recursion elimination.  */
           BEFORE_POTENTIAL_GC ();
@@ -863,37 +931,43 @@ If the third argument is incorrect, Emacs may crash.  */)
                                  save_excursion_save ());
           break;
 
-        case Bsave_current_buffer:
+        case Bsave_current_buffer: /* Obsolete since ??.  */
         case Bsave_current_buffer_1:
           record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
           break;
 
-        case Bsave_window_excursion:
-          BEFORE_POTENTIAL_GC ();
-          TOP = Fsave_window_excursion (TOP);
-          AFTER_POTENTIAL_GC ();
-          break;
+        case Bsave_window_excursion: /* Obsolete since 24.1.  */
+          {
+            register int count = SPECPDL_INDEX ();
+            record_unwind_protect (Fset_window_configuration,
+                                   Fcurrent_window_configuration (Qnil));
+            BEFORE_POTENTIAL_GC ();
+            TOP = Fprogn (TOP);
+            unbind_to (count, TOP);
+            AFTER_POTENTIAL_GC ();
+            break;
+          }
 
         case Bsave_restriction:
           record_unwind_protect (save_restriction_restore,
                                  save_restriction_save ());
           break;
 
-        case Bcatch:
+        case Bcatch:            /* FIXME: ill-suited for lexbind */
           {
             Lisp_Object v1;
             BEFORE_POTENTIAL_GC ();
             v1 = POP;
-            TOP = internal_catch (TOP, Feval, v1);
+            TOP = internal_catch (TOP, eval_sub, v1);
             AFTER_POTENTIAL_GC ();
             break;
           }
 
-        case Bunwind_protect:
+        case Bunwind_protect:   /* FIXME: avoid closure for lexbind */
           record_unwind_protect (Fprogn, POP);
           break;
 
-        case Bcondition_case:
+        case Bcondition_case:   /* FIXME: ill-suited for lexbind */
           {
             Lisp_Object handlers, body;
             handlers = POP;
@@ -904,7 +978,7 @@ If the third argument is incorrect, Emacs may crash.  */)
             break;
           }
 
-        case Btemp_output_buffer_setup:
+        case Btemp_output_buffer_setup: /* Obsolete since 24.1.  */
           BEFORE_POTENTIAL_GC ();
           CHECK_STRING (TOP);
           temp_output_buffer_setup (SSDATA (TOP));
@@ -912,7 +986,7 @@ If the third argument is incorrect, Emacs may crash.  */)
           TOP = Vstandard_output;
           break;
 
-        case Btemp_output_buffer_show:
+        case Btemp_output_buffer_show: /* Obsolete since 24.1.  */
           {
             Lisp_Object v1;
             BEFORE_POTENTIAL_GC ();
@@ -1384,7 +1458,7 @@ If the third argument is incorrect, Emacs may crash.  */)
           AFTER_POTENTIAL_GC ();
           break;
 
-        case Binteractive_p:
+        case Binteractive_p:    /* Obsolete since 24.1.  */
           PUSH (Finteractive_p ());
           break;
 
@@ -1674,8 +1748,57 @@ If the third argument is incorrect, Emacs may crash.  */)
 #endif
 
         case 0:
+          /* Actually this is Bstack_ref with offset 0, but we use Bdup
+             for that instead.  */
+          /* case Bstack_ref: */
           abort ();
 
+          /* Handy byte-codes for lexical binding.  */
+        case Bstack_ref+1:
+        case Bstack_ref+2:
+        case Bstack_ref+3:
+        case Bstack_ref+4:
+        case Bstack_ref+5:
+          {
+            Lisp_Object *ptr = top - (op - Bstack_ref);
+            PUSH (*ptr);
+            break;
+          }
+        case Bstack_ref+6:
+          {
+            Lisp_Object *ptr = top - (FETCH);
+            PUSH (*ptr);
+            break;
+          }
+        case Bstack_ref+7:
+          {
+            Lisp_Object *ptr = top - (FETCH2);
+            PUSH (*ptr);
+            break;
+          }
+          /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
+        case Bstack_set:
+          {
+            Lisp_Object *ptr = top - (FETCH);
+            *ptr = POP;
+            break;
+          }
+        case Bstack_set2:
+          {
+            Lisp_Object *ptr = top - (FETCH2);
+            *ptr = POP;
+            break;
+          }
+        case BdiscardN:
+          op = FETCH;
+          if (op & 0x80)
+            {
+              op &= 0x7F;
+              top[-op] = TOP;
+            }
+          DISCARD (op);
+          break;
+
         case 255:
         default:
 #ifdef BYTE_CODE_SAFE
diff --git a/src/callint.c b/src/callint.c
index 40d89acd16c..60570369d9e 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -121,8 +121,9 @@ usage: (interactive &optional ARGS)  */)
 static Lisp_Object
 quotify_arg (register Lisp_Object exp)
 {
-  if (!INTEGERP (exp) && !STRINGP (exp)
-      && !NILP (exp) && !EQ (exp, Qt))
+  if (CONSP (exp)
+      || (SYMBOLP (exp)
+          && !NILP (exp) && !EQ (exp, Qt)))
     return Fcons (Qquote, Fcons (exp, Qnil));
 
   return exp;
@@ -169,6 +170,9 @@ check_mark (int for_region)
 static void
 fix_command (Lisp_Object input, Lisp_Object values)
 {
+  /* FIXME: Instead of this ugly hack, we should provide a way for an
+     interactive spec to return an expression/function that will re-build the
+     args without user intervention.  */
   if (CONSP (input))
     {
       Lisp_Object car;
@@ -332,11 +336,14 @@ invoke it.  If KEYS is omitted or nil, the return value of
   else
     {
       Lisp_Object input;
+      Lisp_Object funval = Findirect_function (function, Qt);
       i = num_input_events;
       input = specs;
       /* Compute the arg values using the user's expression.  */
       GCPRO2 (input, filter_specs);
-      specs = Feval (specs);
+      specs = Feval (specs,
+                     CONSP (funval) && EQ (Qclosure, XCAR (funval))
+                     ? Qt : Qnil);
       UNGCPRO;
       if (i != num_input_events || !NILP (record_flag))
         {
diff --git a/src/data.c b/src/data.c
index ba7ae58d7b2..4b9d2ec0387 100644
--- a/src/data.c
+++ b/src/data.c
@@ -745,7 +745,9 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
-      if (EQ (funcar, Qlambda))
+      if (EQ (funcar, Qclosure))
+        return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
+      else if (EQ (funcar, Qlambda))
         return Fassq (Qinteractive, Fcdr (XCDR (fun)));
       else if (EQ (funcar, Qautoload))
         {
@@ -1431,7 +1433,7 @@ usage: (setq-default [VAR VALUE]...)  */)
 
   do
     {
-      val = Feval (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcar (Fcdr (args_left)));
       symbol = XCAR (args_left);
       Fset_default (symbol, val);
       args_left = Fcdr (XCDR (args_left));
@@ -2101,7 +2103,7 @@ or a byte-code object.  IDX starts at 0.  */)
 
       if (idxval < 0 || idxval >= size)
         args_out_of_range (array, idx);
-      return XVECTOR (array)->contents[idxval];
+      return AREF (array, idxval);
     }
 }
 
diff --git a/src/doc.c b/src/doc.c
index 1ed9949e52c..158b09790f7 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -36,6 +36,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 Lisp_Object Qfunction_documentation;
 
+extern Lisp_Object Qclosure;
 /* Buffer used for reading from documentation file.  */
 static char *get_doc_string_buffer;
 static int get_doc_string_buffer_size;
@@ -374,6 +375,7 @@ string is passed through `substitute-command-keys'.  */)
       else if (EQ (funcar, Qkeymap))
         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
       else if (EQ (funcar, Qlambda)
+               || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
                || EQ (funcar, Qautoload))
         {
           Lisp_Object tem1 = Fcdr (Fcdr (fun));
@@ -480,7 +482,7 @@ aren't strings.  */)
     }
   else if (!STRINGP (tem))
     /* Feval protects its argument.  */
-    tem = Feval (tem);
+    tem = Feval (tem, Qnil);
 
   if (NILP (raw) && STRINGP (tem))
     tem = Fsubstitute_command_keys (tem);
@@ -507,7 +509,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset)
       Lisp_Object tem;
 
       tem = XCAR (fun);
-      if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
+      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
+          || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
         {
           tem = Fcdr (Fcdr (fun));
           if (CONSP (tem) && INTEGERP (XCAR (tem)))
diff --git a/src/eval.c b/src/eval.c
index 718e58c693f..948c2e4d158 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -64,6 +64,8 @@ Lisp_Object Qinhibit_quit;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
 Lisp_Object Qdeclare;
+Lisp_Object Qinternal_interpreter_environment, Qclosure;
+
 Lisp_Object Qdebug;
 
 /* This holds either the symbol `run-hooks' or nil.
@@ -115,10 +117,10 @@ Lisp_Object Vsignaling_function;
 
 int handling_signal;
 
-static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object*);
+static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *);
 static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
 static int interactive_p (int);
-static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int);
+static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
 
 void
 init_eval_once (void)
@@ -127,7 +129,7 @@ init_eval_once (void)
   specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
   specpdl_ptr = specpdl;
   /* Don't forget to update docs (lispref node "Local Variables").  */
-  max_specpdl_size = 1000;
+  max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el.  */
   max_lisp_eval_depth = 600;
 
   Vrun_hooks = Qnil;
@@ -244,7 +246,7 @@ usage: (or CONDITIONS...)  */)
 
   while (CONSP (args))
     {
-      val = Feval (XCAR (args));
+      val = eval_sub (XCAR (args));
       if (!NILP (val))
         break;
       args = XCDR (args);
@@ -268,7 +270,7 @@ usage: (and CONDITIONS...)  */)
 
   while (CONSP (args))
     {
-      val = Feval (XCAR (args));
+      val = eval_sub (XCAR (args));
       if (NILP (val))
         break;
       args = XCDR (args);
@@ -290,11 +292,11 @@ usage: (if COND THEN ELSE...)  */)
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  cond = Feval (Fcar (args));
+  cond = eval_sub (Fcar (args));
   UNGCPRO;
 
   if (!NILP (cond))
-    return Feval (Fcar (Fcdr (args)));
+    return eval_sub (Fcar (Fcdr (args)));
   return Fprogn (Fcdr (Fcdr (args)));
 }
 
@@ -318,7 +320,7 @@ usage: (cond CLAUSES...)  */)
   while (!NILP (args))
     {
       clause = Fcar (args);
-      val = Feval (Fcar (clause));
+      val = eval_sub (Fcar (clause));
       if (!NILP (val))
         {
           if (!EQ (XCDR (clause), Qnil))
@@ -344,7 +346,7 @@ usage: (progn BODY...)  */)
 
   while (CONSP (args))
     {
-      val = Feval (XCAR (args));
+      val = eval_sub (XCAR (args));
       args = XCDR (args);
     }
 
@@ -373,13 +375,12 @@ usage: (prog1 FIRST BODY...)  */)
 
   do
     {
+      Lisp_Object tem = eval_sub (XCAR (args_left));
       if (!(argnum++))
-        val = Feval (Fcar (args_left));
-      else
-        Feval (Fcar (args_left));
-      args_left = Fcdr (args_left);
+        val = tem;
+      args_left = XCDR (args_left);
     }
-  while (!NILP(args_left));
+  while (CONSP (args_left));
 
   UNGCPRO;
   return val;
@@ -408,13 +409,12 @@ usage: (prog2 FORM1 FORM2 BODY...)  */)
 
   do
     {
+      Lisp_Object tem = eval_sub (XCAR (args_left));
       if (!(argnum++))
-        val = Feval (Fcar (args_left));
-      else
-        Feval (Fcar (args_left));
-      args_left = Fcdr (args_left);
+        val = tem;
+      args_left = XCDR (args_left);
     }
-  while (!NILP (args_left));
+  while (CONSP (args_left));
 
   UNGCPRO;
   return val;
@@ -432,7 +432,7 @@ usage: (setq [SYM VAL]...)  */)
   (Lisp_Object args)
 {
   register Lisp_Object args_left;
-  register Lisp_Object val, sym;
+  register Lisp_Object val, sym, lex_binding;
   struct gcpro gcpro1;
 
   if (NILP (args))
@@ -443,9 +443,19 @@ usage: (setq [SYM VAL]...)  */)
 
   do
     {
-      val = Feval (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcar (Fcdr (args_left)));
       sym = Fcar (args_left);
-      Fset (sym, val);
+
+      /* Like for eval_sub, we do not check declared_special here since
+         it's been done when let-binding.  */
+      if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
+          && SYMBOLP (sym)
+          && !NILP (lex_binding
+                    = Fassq (sym, Vinternal_interpreter_environment)))
+        XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
+      else
+        Fset (sym, val);        /* SYM is dynamically bound.  */
+
       args_left = Fcdr (Fcdr (args_left));
     }
   while (!NILP(args_left));
@@ -471,9 +481,21 @@ In byte compilation, `function' causes its argument to be compiled.
 usage: (function ARG)  */)
   (Lisp_Object args)
 {
+  Lisp_Object quoted = XCAR (args);
+
   if (!NILP (Fcdr (args)))
     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
-  return Fcar (args);
+
+  if (!NILP (Vinternal_interpreter_environment)
+      && CONSP (quoted)
+      && EQ (XCAR (quoted), Qlambda))
+    /* This is a lambda expression within a lexical environment;
+       return an interpreted closure instead of a simple lambda.  */
+    return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
+                                   XCDR (quoted)));
+  else
+    /* Simply quote the argument.  */
+    return quoted;
 }
 
 
@@ -496,7 +518,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
 use `called-interactively-p'.  */)
   (void)
 {
-  return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
+  return interactive_p (1) ? Qt : Qnil;
 }
 
 
@@ -589,6 +611,8 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
   fn_name = Fcar (args);
   CHECK_SYMBOL (fn_name);
   defn = Fcons (Qlambda, Fcdr (args));
+  if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization!  */
+    defn = Ffunction (Fcons (defn, Qnil));
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   if (CONSP (XSYMBOL (fn_name)->function)
@@ -660,7 +684,11 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
     tail = Fcons (lambda_list, tail);
   else
     tail = Fcons (lambda_list, Fcons (doc, tail));
-  defn = Fcons (Qmacro, Fcons (Qlambda, tail));
+
+  defn = Fcons (Qlambda, tail);
+  if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization!  */
+    defn = Ffunction (Fcons (defn, Qnil));
+  defn = Fcons (Qmacro, defn);
 
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
@@ -720,6 +748,7 @@ The return value is BASE-VARIABLE.  */)
         error ("Don't know how to make a let-bound variable an alias");
   }
 
+  sym->declared_special = 1;
   sym->redirect = SYMBOL_VARALIAS;
   SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
   sym->constant = SYMBOL_CONSTANT_P (base_variable);
@@ -765,6 +794,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
   tem = Fdefault_boundp (sym);
   if (!NILP (tail))
     {
+      /* Do it before evaluating the initial value, for self-references.  */
+      XSYMBOL (sym)->declared_special = 1;
+
       if (SYMBOL_CONSTANT_P (sym))
         {
           /* For upward compatibility, allow (defvar :foo (quote :foo)).  */
@@ -778,7 +810,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
         }
 
       if (NILP (tem))
-        Fset_default (sym, Feval (Fcar (tail)));
+        Fset_default (sym, eval_sub (Fcar (tail)));
       else
         { /* Check if there is really a global binding rather than just a let
              binding that shadows the global unboundness of the var.  */
@@ -804,6 +836,13 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
         }
       LOADHIST_ATTACH (sym);
     }
+  else if (!NILP (Vinternal_interpreter_environment)
+           && !XSYMBOL (sym)->declared_special)
+    /* A simple (defvar foo) with lexical scoping does "nothing" except
+       declare that var to be dynamically scoped *locally* (i.e. within
+       the current file or let-block).  */
+    Vinternal_interpreter_environment =
+      Fcons (sym, Vinternal_interpreter_environment);
   else
     {
       /* Simple (defvar <var>) should not count as a definition at all.
@@ -834,10 +873,11 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
   if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
     error ("Too many arguments");
 
-  tem = Feval (Fcar (Fcdr (args)));
+  tem = eval_sub (Fcar (Fcdr (args)));
   if (!NILP (Vpurify_flag))
     tem = Fpurecopy (tem);
   Fset_default (sym, tem);
+  XSYMBOL (sym)->declared_special = 1;
   tem = Fcar (Fcdr (Fcdr (args)));
   if (!NILP (tem))
     {
@@ -924,27 +964,53 @@ Each VALUEFORM can refer to the symbols already bound by this VARLIST.
 usage: (let* VARLIST BODY...)  */)
   (Lisp_Object args)
 {
-  Lisp_Object varlist, val, elt;
+  Lisp_Object varlist, var, val, elt, lexenv;
   int count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   GCPRO3 (args, elt, varlist);
 
+  lexenv = Vinternal_interpreter_environment;
+
   varlist = Fcar (args);
-  while (!NILP (varlist))
+  while (CONSP (varlist))
     {
       QUIT;
-      elt = Fcar (varlist);
+
+      elt = XCAR (varlist);
       if (SYMBOLP (elt))
-        specbind (elt, Qnil);
+        {
+          var = elt;
+          val = Qnil;
+        }
       else if (! NILP (Fcdr (Fcdr (elt))))
         signal_error ("`let' bindings can have only one value-form", elt);
       else
         {
-          val = Feval (Fcar (Fcdr (elt)));
-          specbind (Fcar (elt), val);
+          var = Fcar (elt);
+          val = eval_sub (Fcar (Fcdr (elt)));
+        }
+
+      if (!NILP (lexenv) && SYMBOLP (var)
+          && !XSYMBOL (var)->declared_special
+          && NILP (Fmemq (var, Vinternal_interpreter_environment)))
+        /* Lexically bind VAR by adding it to the interpreter's binding
+           alist.  */
+        {
+          Lisp_Object newenv
+            = Fcons (Fcons (var, val), Vinternal_interpreter_environment);
+          if (EQ (Vinternal_interpreter_environment, lexenv))
+            /* Save the old lexical environment on the specpdl stack,
+               but only for the first lexical binding, since we'll never
+               need to revert to one of the intermediate ones.  */
+            specbind (Qinternal_interpreter_environment, newenv);
+          else
+            Vinternal_interpreter_environment = newenv;
         }
-      varlist = Fcdr (varlist);
+      else
+        specbind (var, val);
+
+      varlist = XCDR (varlist);
     }
   UNGCPRO;
   val = Fprogn (Fcdr (args));
@@ -960,7 +1026,7 @@ All the VALUEFORMs are evalled before any symbols are bound.
 usage: (let VARLIST BODY...)  */)
   (Lisp_Object args)
 {
-  Lisp_Object *temps, tem;
+  Lisp_Object *temps, tem, lexenv;
   register Lisp_Object elt, varlist;
   int count = SPECPDL_INDEX ();
   register size_t argnum;
@@ -987,22 +1053,36 @@ usage: (let VARLIST BODY...)  */)
       else if (! NILP (Fcdr (Fcdr (elt))))
         signal_error ("`let' bindings can have only one value-form", elt);
       else
-        temps [argnum++] = Feval (Fcar (Fcdr (elt)));
+        temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
       gcpro2.nvars = argnum;
     }
   UNGCPRO;
 
+  lexenv = Vinternal_interpreter_environment;
+
   varlist = Fcar (args);
   for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
     {
+      Lisp_Object var;
+
       elt = XCAR (varlist);
+      var = SYMBOLP (elt) ? elt : Fcar (elt);
       tem = temps[argnum++];
-      if (SYMBOLP (elt))
-        specbind (elt, tem);
+
+      if (!NILP (lexenv) && SYMBOLP (var)
+          && !XSYMBOL (var)->declared_special
+          && NILP (Fmemq (var, Vinternal_interpreter_environment)))
+        /* Lexically bind VAR by adding it to the lexenv alist.  */
+        lexenv = Fcons (Fcons (var, tem), lexenv);
       else
-        specbind (Fcar (elt), tem);
+        /* Dynamically bind VAR.  */
+        specbind (var, tem);
     }
 
+  if (!EQ (lexenv, Vinternal_interpreter_environment))
+    /* Instantiate a new lexical environment.  */
+    specbind (Qinternal_interpreter_environment, lexenv);
+
   elt = Fprogn (Fcdr (args));
   SAFE_FREE ();
   return unbind_to (count, elt);
@@ -1022,7 +1102,7 @@ usage: (while TEST BODY...)  */)
 
   test = Fcar (args);
   body = Fcdr (args);
-  while (!NILP (Feval (test)))
+  while (!NILP (eval_sub (test)))
     {
       QUIT;
       Fprogn (body);
@@ -1124,7 +1204,7 @@ usage: (catch TAG BODY...)  */)
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  tag = Feval (Fcar (args));
+  tag = eval_sub (Fcar (args));
   UNGCPRO;
   return internal_catch (tag, Fprogn, Fcdr (args));
 }
@@ -1254,7 +1334,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
   int count = SPECPDL_INDEX ();
 
   record_unwind_protect (Fprogn, Fcdr (args));
-  val = Feval (Fcar (args));
+  val = eval_sub (Fcar (args));
   return unbind_to (count, val);
 }
 
@@ -1355,7 +1435,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
   h.tag = &c;
   handlerlist = &h;
 
-  val = Feval (bodyform);
+  val = eval_sub (bodyform);
   catchlist = c.next;
   handlerlist = h.next;
   return val;
@@ -1999,9 +2079,12 @@ then strings and vectors are not accepted.  */)
   if (!CONSP (fun))
     return Qnil;
   funcar = XCAR (fun);
-  if (EQ (funcar, Qlambda))
+  if (EQ (funcar, Qclosure))
+    return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))))
+            ? Qt : if_prop);
+  else if (EQ (funcar, Qlambda))
     return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
-  if (EQ (funcar, Qautoload))
+  else if (EQ (funcar, Qautoload))
     return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
   else
     return Qnil;
@@ -2119,9 +2202,21 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname)
 }
 
 
-DEFUN ("eval", Feval, Seval, 1, 1, 0,
-       doc: /* Evaluate FORM and return its value.  */)
-  (Lisp_Object form)
+DEFUN ("eval", Feval, Seval, 1, 2, 0,
+       doc: /* Evaluate FORM and return its value.
+If LEXICAL is t, evaluate using lexical scoping.  */)
+  (Lisp_Object form, Lisp_Object lexical)
+{
+  int count = SPECPDL_INDEX ();
+  specbind (Qinternal_interpreter_environment,
+            NILP (lexical) ? Qnil : Fcons (Qt, Qnil));
+  return unbind_to (count, eval_sub (form));
+}
+
+/* Eval a sub-expression of the current expression (i.e. in the same
+   lexical scope).  */
+Lisp_Object
+eval_sub (Lisp_Object form)
 {
   Lisp_Object fun, val, original_fun, original_args;
   Lisp_Object funcar;
@@ -2132,7 +2227,20 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
     abort ();
 
   if (SYMBOLP (form))
-    return Fsymbol_value (form);
+    {
+      /* Look up its binding in the lexical environment.
+         We do not pay attention to the declared_special flag here, since we
+         already did that when let-binding the variable.  */
+      Lisp_Object lex_binding
+        = !NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
+        ? Fassq (form, Vinternal_interpreter_environment)
+        : Qnil;
+      if (CONSP (lex_binding))
+        return XCDR (lex_binding);
+      else
+        return Fsymbol_value (form);
+    }
+
   if (!CONSP (form))
     return form;
 
@@ -2216,7 +2324,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
 
           while (!NILP (args_left))
             {
-              vals[argnum++] = Feval (Fcar (args_left));
+              vals[argnum++] = eval_sub (Fcar (args_left));
               args_left = Fcdr (args_left);
               gcpro3.nvars = argnum;
             }
@@ -2237,7 +2345,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
           maxargs = XSUBR (fun)->max_args;
           for (i = 0; i < maxargs; args_left = Fcdr (args_left))
             {
-              argvals[i] = Feval (Fcar (args_left));
+              argvals[i] = eval_sub (Fcar (args_left));
               gcpro3.nvars = ++i;
             }
 
@@ -2297,7 +2405,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
         }
     }
   else if (COMPILEDP (fun))
-    val = apply_lambda (fun, original_args, 1);
+    val = apply_lambda (fun, original_args);
   else
     {
       if (EQ (fun, Qunbound))
@@ -2313,9 +2421,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
           goto retry;
         }
       if (EQ (funcar, Qmacro))
-        val = Feval (apply1 (Fcdr (fun), original_args));
-      else if (EQ (funcar, Qlambda))
-        val = apply_lambda (fun, original_args, 1);
+        val = eval_sub (apply1 (Fcdr (fun), original_args));
+      else if (EQ (funcar, Qlambda)
+               || EQ (funcar, Qclosure))
+        val = apply_lambda (fun, original_args);
       else
         xsignal1 (Qinvalid_function, original_fun);
     }
@@ -2786,6 +2895,39 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
 
 /* The caller should GCPRO all the elements of ARGS.  */
 
+DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
+       doc: /* Non-nil if OBJECT is a function.  */)
+     (Lisp_Object object)
+{
+  if (SYMBOLP (object) && !NILP (Ffboundp (object)))
+    {
+      object = Findirect_function (object, Qt);
+
+      if (CONSP (object) && EQ (XCAR (object), Qautoload))
+        {
+          /* Autoloaded symbols are functions, except if they load
+             macros or keymaps.  */
+          int i;
+          for (i = 0; i < 4 && CONSP (object); i++)
+            object = XCDR (object);
+
+          return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
+        }
+    }
+
+  if (SUBRP (object))
+    return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
+  else if (COMPILEDP (object))
+    return Qt;
+  else if (CONSP (object))
+    {
+      Lisp_Object car = XCAR (object);
+      return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
+    }
+  else
+    return Qnil;
+}
+
 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
        doc: /* Call first argument as a function, passing remaining arguments to it.
 Return the value that function returns.
@@ -2930,7 +3072,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
       funcar = XCAR (fun);
       if (!SYMBOLP (funcar))
         xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qlambda))
+      if (EQ (funcar, Qlambda)
+          || EQ (funcar, Qclosure))
         val = funcall_lambda (fun, numargs, args + 1);
       else if (EQ (funcar, Qautoload))
         {
@@ -2950,7 +3093,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 }
 
 static Lisp_Object
-apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
+apply_lambda (Lisp_Object fun, Lisp_Object args)
 {
   Lisp_Object args_left;
   size_t numargs;
@@ -2970,18 +3113,15 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
   for (i = 0; i < numargs; )
     {
       tem = Fcar (args_left), args_left = Fcdr (args_left);
-      if (eval_flag) tem = Feval (tem);
+      tem = eval_sub (tem);
       arg_vector[i++] = tem;
       gcpro1.nvars = i;
     }
 
   UNGCPRO;
 
-  if (eval_flag)
-    {
-      backtrace_list->args = arg_vector;
-      backtrace_list->nargs = i;
-    }
+  backtrace_list->args = arg_vector;
+  backtrace_list->nargs = i;
   backtrace_list->evalargs = 0;
   tem = funcall_lambda (fun, numargs, arg_vector);
 
@@ -3002,13 +3142,21 @@ static Lisp_Object
 funcall_lambda (Lisp_Object fun, size_t nargs,
                 register Lisp_Object *arg_vector)
 {
-  Lisp_Object val, syms_left, next;
+  Lisp_Object val, syms_left, next, lexenv;
   int count = SPECPDL_INDEX ();
   size_t i;
   int optional, rest;
 
   if (CONSP (fun))
     {
+      if (EQ (XCAR (fun), Qclosure))
+        {
+          fun = XCDR (fun);     /* Drop `closure'.  */
+          lexenv = XCAR (fun);
+          CHECK_LIST_CONS (fun, fun);
+        }
+      else
+        lexenv = Qnil;
       syms_left = XCDR (fun);
       if (CONSP (syms_left))
         syms_left = XCAR (syms_left);
@@ -3016,7 +3164,30 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
         xsignal1 (Qinvalid_function, fun);
     }
   else if (COMPILEDP (fun))
-    syms_left = AREF (fun, COMPILED_ARGLIST);
+    {
+      syms_left = AREF (fun, COMPILED_ARGLIST);
+      if (INTEGERP (syms_left))
+        /* A byte-code object with a non-nil `push args' slot means we
+           shouldn't bind any arguments, instead just call the byte-code
+           interpreter directly; it will push arguments as necessary.
+
+           Byte-code objects with either a non-existant, or a nil value for
+           the `push args' slot (the default), have dynamically-bound
+           arguments, and use the argument-binding code below instead (as do
+           all interpreted functions, even lexically bound ones).  */
+        {
+          /* If we have not actually read the bytecode string
+             and constants vector yet, fetch them from the file.  */
+          if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+            Ffetch_bytecode (fun);
+          return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+                                 AREF (fun, COMPILED_CONSTANTS),
+                                 AREF (fun, COMPILED_STACK_DEPTH),
+                                 syms_left,
+                                 nargs, arg_vector);
+        }
+      lexenv = Qnil;
+    }
   else
     abort ();
 
@@ -3033,17 +3204,29 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
         rest = 1;
       else if (EQ (next, Qand_optional))
         optional = 1;
-      else if (rest)
+      else
         {
-          specbind (next, Flist (nargs - i, &arg_vector[i]));
-          i = nargs;
+          Lisp_Object val;
+          if (rest)
+            {
+              val = Flist (nargs - i, &arg_vector[i]);
+              i = nargs;
+            }
+          else if (i < nargs)
+            val = arg_vector[i++];
+          else if (!optional)
+            xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
+          else
+            val = Qnil;
+
+          /* Bind the argument.  */
+          if (!NILP (lexenv) && SYMBOLP (next))
+            /* Lexically bind NEXT by adding it to the lexenv alist.  */
+            lexenv = Fcons (Fcons (next, val), lexenv);
+          else
+            /* Dynamically bind NEXT.  */
+            specbind (next, val);
         }
-      else if (i < nargs)
-        specbind (next, arg_vector[i++]);
-      else if (!optional)
-        xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
-      else
-        specbind (next, Qnil);
     }
 
   if (!NILP (syms_left))
@@ -3051,6 +3234,10 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
   else if (i < nargs)
     xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
 
+  if (!EQ (lexenv, Vinternal_interpreter_environment))
+    /* Instantiate a new lexical environment.  */
+    specbind (Qinternal_interpreter_environment, lexenv);
+
   if (CONSP (fun))
     val = Fprogn (XCDR (XCDR (fun)));
   else
@@ -3059,9 +3246,10 @@ funcall_lambda (Lisp_Object fun, size_t nargs,
          and constants vector yet, fetch them from the file.  */
       if (CONSP (AREF (fun, COMPILED_BYTECODE)))
         Ffetch_bytecode (fun);
-      val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
-                        AREF (fun, COMPILED_CONSTANTS),
-                        AREF (fun, COMPILED_STACK_DEPTH));
+      val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+                            AREF (fun, COMPILED_CONSTANTS),
+                            AREF (fun, COMPILED_STACK_DEPTH),
+                            Qnil, 0, 0);
     }
 
   return unbind_to (count, val);
@@ -3297,6 +3485,17 @@ unbind_to (int count, Lisp_Object value)
   UNGCPRO;
   return value;
 }
+
+DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0,
+       doc: /* Return non-nil if SYMBOL's global binding has been declared special.
+A special variable is one that will be bound dynamically, even in a
+context where binding is lexical by default.  */)
+  (Lisp_Object symbol)
+{
+   CHECK_SYMBOL (symbol);
+   return XSYMBOL (symbol)->declared_special ? Qt : Qnil;
+}
+
 
 DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
        doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
@@ -3437,6 +3636,8 @@ mark_backtrace (void)
     }
 }
 
+EXFUN (Funintern, 2);
+
 void
 syms_of_eval (void)
 {
@@ -3509,6 +3710,9 @@ before making `inhibit-quit' nil.  */);
   Qand_optional = intern_c_string ("&optional");
   staticpro (&Qand_optional);
 
+  Qclosure = intern_c_string ("closure");
+  staticpro (&Qclosure);
+
   Qdebug = intern_c_string ("debug");
   staticpro (&Qdebug);
 
@@ -3576,6 +3780,28 @@ DECL is a list `(declare ...)' containing the declarations.
 The value the function returns is not used.  */);
   Vmacro_declaration_function = Qnil;
 
+  /* When lexical binding is being used,
+   vinternal_interpreter_environment is non-nil, and contains an alist
+   of lexically-bound variable, or (t), indicating an empty
+   environment.  The lisp name of this variable would be
+   `internal-interpreter-environment' if it weren't hidden.
+   Every element of this list can be either a cons (VAR . VAL)
+   specifying a lexical binding, or a single symbol VAR indicating
+   that this variable should use dynamic scoping.  */
+  Qinternal_interpreter_environment
+    = intern_c_string ("internal-interpreter-environment");
+  staticpro (&Qinternal_interpreter_environment);
+  DEFVAR_LISP ("internal-interpreter-environment",
+                Vinternal_interpreter_environment,
+               doc: /* If non-nil, the current lexical environment of the lisp interpreter.
+When lexical binding is not being used, this variable is nil.
+A value of `(t)' indicates an empty environment, otherwise it is an
+alist of active lexical bindings.  */);
+  Vinternal_interpreter_environment = Qnil;
+  /* Don't export this variable to Elisp, so noone can mess with it
+     (Just imagine if someone makes it buffer-local).  */
+  Funintern (Qinternal_interpreter_environment, Qnil);
+
   Vrun_hooks = intern_c_string ("run-hooks");
   staticpro (&Vrun_hooks);
 
@@ -3625,4 +3851,6 @@ The value the function returns is not used.  */);
   defsubr (&Sbacktrace_debug);
   defsubr (&Sbacktrace);
   defsubr (&Sbacktrace_frame);
+  defsubr (&Sspecial_variable_p);
+  defsubr (&Sfunctionp);
 }
diff --git a/src/fns.c b/src/fns.c
index 95e8badbaa5..bce922859d1 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -510,7 +510,7 @@ concat (size_t nargs, Lisp_Object *args,
           Lisp_Object ch;
           EMACS_INT this_len_byte;
 
-          if (VECTORP (this))
+          if (VECTORP (this) || COMPILEDP (this))
             for (i = 0; i < len; i++)
               {
                 ch = AREF (this, i);
@@ -2297,7 +2297,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
     1) lists are not relocated and 2) the list is marked via `seq' so will not
     be freed */
 
-  if (VECTORP (seq))
+  if (VECTORP (seq) || COMPILEDP (seq))
     {
       for (i = 0; i < leni; i++)
         {
diff --git a/src/image.c b/src/image.c
index 25929d1004c..b37ba398d83 100644
--- a/src/image.c
+++ b/src/image.c
@@ -831,9 +831,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
 
         case IMAGE_FUNCTION_VALUE:
           value = indirect_function (value);
-          if (SUBRP (value)
-              || COMPILEDP (value)
-              || (CONSP (value) && EQ (XCAR (value), Qlambda)))
+          if (!NILP (Ffunctionp (value)))
             break;
           return 0;
 
diff --git a/src/keyboard.c b/src/keyboard.c
index 70098d46ebb..d307250b868 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1134,7 +1134,7 @@ command_loop_2 (Lisp_Object ignore)
 static Lisp_Object
 top_level_2 (void)
 {
-  return Feval (Vtop_level);
+  return Feval (Vtop_level, Qnil);
 }
 
 Lisp_Object
@@ -3095,7 +3095,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event
                  help_form_saved_window_configs);
       record_unwind_protect (read_char_help_form_unwind, Qnil);
 
-      tem0 = Feval (Vhelp_form);
+      tem0 = Feval (Vhelp_form, Qnil);
       if (STRINGP (tem0))
         internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
 
@@ -7571,6 +7571,12 @@ menu_item_eval_property_1 (Lisp_Object arg)
   return Qnil;
 }
 
+static Lisp_Object
+eval_dyn (Lisp_Object form)
+{
+  return Feval (form, Qnil);
+}
+
 /* Evaluate an expression and return the result (or nil if something
    went wrong).  Used to evaluate dynamic parts of menu items.  */
 Lisp_Object
@@ -7579,7 +7585,7 @@ menu_item_eval_property (Lisp_Object sexpr)
   int count = SPECPDL_INDEX ();
   Lisp_Object val;
   specbind (Qinhibit_redisplay, Qt);
-  val = internal_condition_case_1 (Feval, sexpr, Qerror,
+  val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
                                    menu_item_eval_property_1);
   return unbind_to (count, val);
 }
diff --git a/src/lisp.h b/src/lisp.h
index 63f346f6a25..dfaa3fd01f0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1016,6 +1016,10 @@ struct Lisp_Symbol
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
   unsigned interned : 2;
+  
+  /* Non-zero means that this variable has been explicitly declared
+     special (with `defvar' etc), and shouldn't be lexically bound.  */
+  unsigned declared_special : 1;
 
   /* The symbol's name, as a Lisp string.
 
@@ -2814,7 +2818,7 @@ extern void syms_of_lread (void);
 
 /* Defined in eval.c.  */
 extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit;
+extern Lisp_Object Qinhibit_quit, Qclosure;
 extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vsignaling_function;
 extern int handling_signal;
@@ -2844,7 +2848,9 @@ extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
 extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
 extern void signal_error (const char *, Lisp_Object) NO_RETURN;
 EXFUN (Fcommandp, 2);
-EXFUN (Feval, 1);
+EXFUN (Ffunctionp, 1);
+EXFUN (Feval, 2);
+extern Lisp_Object eval_sub (Lisp_Object form);
 EXFUN (Fapply, MANY);
 EXFUN (Ffuncall, MANY);
 EXFUN (Fbacktrace, 0);
@@ -3264,6 +3270,8 @@ extern struct byte_stack *byte_stack_list;
 extern void mark_byte_stack (void);
 #endif
 extern void unmark_byte_stack (void);
+extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
+                                   Lisp_Object, int, Lisp_Object *);
 
 /* Defined in macros.c */
 extern Lisp_Object Qexecute_kbd_macro;
diff --git a/src/lread.c b/src/lread.c
index a5fd1513c39..6a24569f552 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -73,6 +73,7 @@ Lisp_Object Qascii_character, Qload, Qload_file_name;
 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 Lisp_Object Qinhibit_file_name_operation;
 Lisp_Object Qeval_buffer_list;
+Lisp_Object Qlexical_binding;
 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
 
 /* Used instead of Qget_file_char while loading *.elc files compiled
@@ -81,6 +82,8 @@ static Lisp_Object Qget_emacs_mule_file_char;
 
 static Lisp_Object Qload_force_doc_strings;
 
+extern Lisp_Object Qinternal_interpreter_environment;
+
 static Lisp_Object Qload_in_progress;
 
 /* The association list of objects read with the #n=object form.
@@ -147,8 +150,7 @@ static Lisp_Object Vloads_in_progress;
 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                  Lisp_Object);
 
-static void readevalloop (Lisp_Object, FILE*, Lisp_Object,
-                          Lisp_Object (*) (Lisp_Object), int,
+static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int,
                           Lisp_Object, Lisp_Object,
                           Lisp_Object, Lisp_Object);
 static Lisp_Object load_unwind (Lisp_Object);
@@ -769,6 +771,116 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
 
 
 
+
+/* Return true if the lisp code read using READCHARFUN defines a non-nil
+   `lexical-binding' file variable.  After returning, the stream is
+   positioned following the first line, if it is a comment, otherwise
+   nothing is read.  */
+
+static int
+lisp_file_lexically_bound_p (Lisp_Object readcharfun)
+{
+  int ch = READCHAR;
+  if (ch != ';')
+    /* The first line isn't a comment, just give up.  */
+    {
+      UNREAD (ch);
+      return 0;
+    }
+  else
+    /* Look for an appropriate file-variable in the first line.  */
+    {
+      int rv = 0;
+      enum {
+        NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
+      } beg_end_state = NOMINAL;
+      int in_file_vars = 0;
+
+#define UPDATE_BEG_END_STATE(ch)                                \
+  if (beg_end_state == NOMINAL)                                 \
+    beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL);   \
+  else if (beg_end_state == AFTER_FIRST_DASH)                   \
+    beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL);      \
+  else if (beg_end_state == AFTER_ASTERIX)                      \
+    {                                                           \
+      if (ch == '-')                                            \
+        in_file_vars = !in_file_vars;                           \
+      beg_end_state = NOMINAL;                                  \
+    }
+
+      /* Skip until we get to the file vars, if any.  */
+      do
+        {
+          ch = READCHAR;
+          UPDATE_BEG_END_STATE (ch);
+        }
+      while (!in_file_vars && ch != '\n' && ch != EOF);
+
+      while (in_file_vars)
+        {
+          char var[100], *var_end, val[100], *val_end;
+
+          ch = READCHAR;
+
+          /* Read a variable name.  */
+          while (ch == ' ' || ch == '\t')
+            ch = READCHAR;
+
+          var_end = var;
+          while (ch != ':' && ch != '\n' && ch != EOF)
+            {
+              if (var_end < var + sizeof var - 1)
+                *var_end++ = ch;
+              UPDATE_BEG_END_STATE (ch);
+              ch = READCHAR;
+            }
+
+          while (var_end > var
+                 && (var_end[-1] == ' ' || var_end[-1] == '\t'))
+            var_end--;
+          *var_end = '\0';
+
+          if (ch == ':')
+            {
+              /* Read a variable value.  */
+              ch = READCHAR;
+
+              while (ch == ' ' || ch == '\t')
+                ch = READCHAR;
+
+              val_end = val;
+              while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
+                {
+                  if (val_end < val + sizeof val - 1)
+                    *val_end++ = ch;
+                  UPDATE_BEG_END_STATE (ch);
+                  ch = READCHAR;
+                }
+              if (! in_file_vars)
+                /* The value was terminated by an end-marker, which
+                   remove.  */
+                val_end -= 3;
+              while (val_end > val
+                     && (val_end[-1] == ' ' || val_end[-1] == '\t'))
+                val_end--;
+              *val_end = '\0';
+
+              if (strcmp (var, "lexical-binding") == 0)
+                /* This is it...  */
+                {
+                  rv = (strcmp (val, "nil") != 0);
+                  break;
+                }
+            }
+        }
+
+      while (ch != '\n' && ch != EOF)
+        ch = READCHAR;
+
+      return rv;
+    }
+}
+
 /* Value is a version number of byte compiled code if the file
    associated with file descriptor FD is a compiled Lisp file that's
    safe to load.  Only files compiled with Emacs are safe to load.
@@ -1033,6 +1145,12 @@ Return t if the file exists and loads successfully.  */)
     Vloads_in_progress = Fcons (found, Vloads_in_progress);
   }
 
+  /* All loads are by default dynamic, unless the file itself specifies
+     otherwise using a file-variable in the first line.  This is bound here
+     so that it takes effect whether or not we use
+     Vload_source_file_function.  */
+  specbind (Qlexical_binding, Qnil);
+
   /* Get the name for load-history. */
   hist_file_name = (! NILP (Vpurify_flag)
                     ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
@@ -1157,15 +1275,20 @@ Return t if the file exists and loads successfully.  */)
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   specbind (Qload_in_progress, Qt);
+
+  instream = stream;
+  if (lisp_file_lexically_bound_p (Qget_file_char))
+    Fset (Qlexical_binding, Qt);
+
   if (! version || version >= 22)
     readevalloop (Qget_file_char, stream, hist_file_name,
-                  Feval, 0, Qnil, Qnil, Qnil, Qnil);
+                  0, Qnil, Qnil, Qnil, Qnil);
   else
     {
       /* We can't handle a file which was compiled with
          byte-compile-dynamic by older version of Emacs.  */
       specbind (Qload_force_doc_strings, Qt);
-      readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
+      readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name,
                     0, Qnil, Qnil, Qnil, Qnil);
     }
   unbind_to (count, Qnil);
@@ -1535,7 +1658,6 @@ static void
 readevalloop (Lisp_Object readcharfun,
               FILE *stream,
               Lisp_Object sourcename,
-              Lisp_Object (*evalfun) (Lisp_Object),
               int printflag,
               Lisp_Object unibyte, Lisp_Object readfun,
               Lisp_Object start, Lisp_Object end)
@@ -1546,6 +1668,7 @@ readevalloop (Lisp_Object readcharfun,
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   struct buffer *b = 0;
   int continue_reading_p;
+  Lisp_Object lex_bound;
   /* Nonzero if reading an entire buffer.  */
   int whole_buffer = 0;
   /* 1 on the first time around.  */
@@ -1571,6 +1694,14 @@ readevalloop (Lisp_Object readcharfun,
   record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
   load_convert_to_unibyte = !NILP (unibyte);
 
+  /* If lexical binding is active (either because it was specified in
+     the file's header, or via a buffer-local variable), create an empty
+     lexical environment, otherwise, turn off lexical binding.  */
+  lex_bound = find_symbol_value (Qlexical_binding);
+  specbind (Qinternal_interpreter_environment,
+            NILP (lex_bound) || EQ (lex_bound, Qunbound)
+            ? Qnil : Fcons (Qt, Qnil));
+
   GCPRO4 (sourcename, readfun, start, end);
 
   /* Try to ensure sourcename is a truename, except whilst preloading. */
@@ -1672,7 +1803,7 @@ readevalloop (Lisp_Object readcharfun,
       unbind_to (count1, Qnil);
 
       /* Now eval what we just read.  */
-      val = (*evalfun) (val);
+      val = eval_sub (val);
 
       if (printflag)
         {
@@ -1732,7 +1863,8 @@ This function preserves the position of point.  */)
   specbind (Qstandard_output, tem);
   record_unwind_protect (save_excursion_restore, save_excursion_save ());
   BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
-  readevalloop (buf, 0, filename, Feval,
+  specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
+  readevalloop (buf, 0, filename,
                 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
 
@@ -1753,6 +1885,7 @@ which is the input stream for reading characters.
 This function does not move point.  */)
   (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
 {
+  /* FIXME: Do the eval-sexp-add-defvars danse!  */
   int count = SPECPDL_INDEX ();
   Lisp_Object tem, cbuf;
 
@@ -1766,7 +1899,7 @@ This function does not move point.  */)
   specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
 
   /* readevalloop calls functions which check the type of start and end.  */
-  readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename), Feval,
+  readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
                 !NILP (printflag), Qnil, read_function,
                 start, end);
 
@@ -3838,6 +3971,7 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
   sym = intern_c_string (namestring);
   i_fwd->type = Lisp_Fwd_Int;
   i_fwd->intvar = address;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
 }
@@ -3852,6 +3986,7 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd,
   sym = intern_c_string (namestring);
   b_fwd->type = Lisp_Fwd_Bool;
   b_fwd->boolvar = address;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
   Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
@@ -3870,6 +4005,7 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
   sym = intern_c_string (namestring);
   o_fwd->type = Lisp_Fwd_Obj;
   o_fwd->objvar = address;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
 }
@@ -3893,6 +4029,7 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
   sym = intern_c_string (namestring);
   ko_fwd->type = Lisp_Fwd_Kboard_Obj;
   ko_fwd->offset = offset;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
 }
@@ -4320,6 +4457,15 @@ to load.  See also `load-dangerous-libraries'.  */);
   Vbytecomp_version_regexp
     = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
 
+  Qlexical_binding = intern ("lexical-binding");
+  staticpro (&Qlexical_binding);
+  DEFVAR_LISP ("lexical-binding", Vlexical_binding,
+               doc: /* If non-nil, use lexical binding when evaluating code.
+This only applies to code evaluated by `eval-buffer' and `eval-region'.
+This variable is automatically set from the file variables of an interpreted
+  Lisp file read using `load'.  */);
+  Fmake_variable_buffer_local (Qlexical_binding);
+
   DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,
                doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'.  */);
   Veval_buffer_list = Qnil;
diff --git a/src/minibuf.c b/src/minibuf.c
index 7bed9bb2f2d..4adf665f8f4 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -971,7 +971,8 @@ Such arguments are used as in `read-from-minibuffer'.)  */)
 {
   return Feval (read_minibuf (Vread_expression_map, initial_contents,
                               prompt, Qnil, 1, Qread_expression_history,
-                              make_number (0), Qnil, 0, 0));
+                              make_number (0), Qnil, 0, 0),
+                Qnil);
 }
 
 /* Functions that use the minibuffer to read various things. */
diff --git a/src/print.c b/src/print.c
index dd3d1c9bbb2..3e0e168381b 100644
--- a/src/print.c
+++ b/src/print.c
@@ -521,6 +521,7 @@ temp_output_buffer_setup (const char *bufname)
   specbind (Qstandard_output, buf);
 }
 
+/* FIXME: Use Lisp's with-output-to-temp-buffer instead!  */
 Lisp_Object
 internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args)
 {
@@ -542,60 +543,6 @@ internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function
 
   return unbind_to (count, val);
 }
-
-DEFUN ("with-output-to-temp-buffer",
-       Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
-       1, UNEVALLED, 0,
-       doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
-
-This construct makes buffer BUFNAME empty before running BODY.
-It does not make the buffer current for BODY.
-Instead it binds `standard-output' to that buffer, so that output
-generated with `prin1' and similar functions in BODY goes into
-the buffer.
-
-At the end of BODY, this marks buffer BUFNAME unmodifed and displays
-it in a window, but does not select it.  The normal way to do this is
-by calling `display-buffer', then running `temp-buffer-show-hook'.
-However, if `temp-buffer-show-function' is non-nil, it calls that
-function instead (and does not run `temp-buffer-show-hook').  The
-function gets one argument, the buffer to display.
-
-The return value of `with-output-to-temp-buffer' is the value of the
-last form in BODY.  If BODY does not finish normally, the buffer
-BUFNAME is not displayed.
-
-This runs the hook `temp-buffer-setup-hook' before BODY,
-with the buffer BUFNAME temporarily current.  It runs the hook
-`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
-buffer temporarily current, and the window that was used to display it
-temporarily selected.  But it doesn't run `temp-buffer-show-hook'
-if it uses `temp-buffer-show-function'.
-
-usage: (with-output-to-temp-buffer BUFNAME BODY...)  */)
-  (Lisp_Object args)
-{
-  struct gcpro gcpro1;
-  Lisp_Object name;
-  int count = SPECPDL_INDEX ();
-  Lisp_Object buf, val;
-
-  GCPRO1(args);
-  name = Feval (Fcar (args));
-  CHECK_STRING (name);
-  temp_output_buffer_setup (SSDATA (name));
-  buf = Vstandard_output;
-  UNGCPRO;
-
-  val = Fprogn (XCDR (args));
-
-  GCPRO1 (val);
-  temp_output_buffer_show (buf);
-  UNGCPRO;
-
-  return unbind_to (count, val);
-}
-
 
 static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
 static void print_preprocess (Lisp_Object obj);
@@ -2289,6 +2236,4 @@ priorities.  */);
 
   print_prune_charset_plist = Qnil;
   staticpro (&print_prune_charset_plist);
-
-  defsubr (&Swith_output_to_temp_buffer);
 }
diff --git a/src/window.c b/src/window.c
index 0d299b7cd93..5ca46dd3316 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3705,6 +3705,16 @@ temp_output_buffer_show (register Lisp_Object buf)
       }
     }
 }
+
+DEFUN ("internal-temp-output-buffer-show",
+       Ftemp_output_buffer_show, Stemp_output_buffer_show,
+       1, 1, 0,
+       doc: /* Internal function for `with-output-to-temp-buffer''.  */)
+     (Lisp_Object buf)
+{
+  temp_output_buffer_show (buf);
+  return Qnil;
+}
 
 static void
 make_dummy_parent (Lisp_Object window)
@@ -6390,28 +6400,6 @@ redirection (see `redirect-frame-focus').  */)
   return (tem);
 }
 
-DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion,
-       0, UNEVALLED, 0,
-       doc: /* Execute BODY, preserving window sizes and contents.
-Return the value of the last form in BODY.
-Restore which buffer appears in which window, where display starts,
-and the value of point and mark for each window.
-Also restore the choice of selected window.
-Also restore which buffer is current.
-Does not restore the value of point in current buffer.
-usage: (save-window-excursion BODY...)  */)
-  (Lisp_Object args)
-{
-  register Lisp_Object val;
-  register int count = SPECPDL_INDEX ();
-
-  record_unwind_protect (Fset_window_configuration,
-                         Fcurrent_window_configuration (Qnil));
-  val = Fprogn (args);
-  return unbind_to (count, val);
-}
-
-
 
 /***********************************************************************
                             Window Split Tree
@@ -7167,6 +7155,7 @@ frame to be redrawn only if it is a tty frame.  */);
   defsubr (&Sset_window_buffer);
   defsubr (&Sselect_window);
   defsubr (&Sforce_window_update);
+  defsubr (&Stemp_output_buffer_show);
   defsubr (&Ssplit_window);
   defsubr (&Senlarge_window);
   defsubr (&Sshrink_window);
@@ -7185,7 +7174,6 @@ frame to be redrawn only if it is a tty frame.  */);
   defsubr (&Swindow_configuration_frame);
   defsubr (&Sset_window_configuration);
   defsubr (&Scurrent_window_configuration);
-  defsubr (&Ssave_window_excursion);
   defsubr (&Swindow_tree);
   defsubr (&Sset_window_margins);
   defsubr (&Swindow_margins);
diff --git a/src/window.h b/src/window.h
index f788e126d6d..ad627aca340 100644
--- a/src/window.h
+++ b/src/window.h
@@ -853,7 +853,6 @@ EXFUN (Fwindow_minibuffer_p, 1);
 EXFUN (Fdelete_window, 1);
 EXFUN (Fwindow_buffer, 1);
 EXFUN (Fget_buffer_window, 2);
-EXFUN (Fsave_window_excursion, UNEVALLED);
 EXFUN (Fset_window_configuration, 1);
 EXFUN (Fcurrent_window_configuration, 1);
 extern int compare_window_configurations (Lisp_Object, Lisp_Object, int);