comparison src/lread.c @ 2545:d666732c5f41

(readevalloop): New argument is the source file name (or nil if none). All calls changed. Do the two-step necessary to call build_load_history with the correct current-globals list for the current recursion. (build_load_history): New function. (eval_region, eval_buffer): Call readevalloop with new arg. (load_history): New variable.

2544:ec2eb7c5a2da

/* non-zero if inside `load' */
int load_in_progress;

/* Search path for files to be loaded. */
Lisp_Object Vload_path;

/* File for get_file_char to read from.  Use by load */
static FILE *instream;

/* When nonzero, read conses in pure space */

  ptr = (FILE **) xmalloc (sizeof (FILE *));
  *ptr = stream;
  XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
  record_unwind_protect (load_unwind, lispstream);
  load_in_progress++;
  readevalloop (Qget_file_char, stream, Feval, 0);
  unbind_to (count, Qnil);

  /* Run any load-hooks for this file.  */
  temp = Fassoc (str, Vafter_load_alist);
  if (!NILP (temp))

  return -1;
}


Lisp_Object
unreadpure ()	/* Used as unwind-protect function in readevalloop */
{
  read_pure = 0;
  return Qnil;
}

static void
readevalloop (readcharfun, stream, evalfun, printflag)
     Lisp_Object readcharfun;
     FILE *stream;     
     Lisp_Object (*evalfun) ();
     int printflag;
{
  register int c;
  register Lisp_Object val;
  int count = specpdl_ptr - specpdl;

  specbind (Qstandard_input, readcharfun);

  while (1)
    {
      instream = stream;
      c = READCHAR;

	  else
	    Fprint (val, Qnil);
	}
    }

  unbind_to (count, Qnil);
}

#ifndef standalone

  else
    tem = printflag;
  specbind (Qstandard_output, tem);
  record_unwind_protect (save_excursion_restore, save_excursion_save ());
  BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
  readevalloop (buf, 0, Feval, !NILP (printflag));
  unbind_to (count, Qnil);

  return Qnil;
}

point remains at the end of the last character read from the buffer.")
  (printflag)
     Lisp_Object printflag;
{
  int count = specpdl_ptr - specpdl;
  Lisp_Object tem;

  if (NILP (printflag))
    tem = Qsymbolp;
  else
    tem = printflag;
  specbind (Qstandard_output, tem);
  record_unwind_protect (save_excursion_restore, save_excursion_save ());
  SET_PT (BEGV);
  readevalloop (Fcurrent_buffer (), 0, Feval, !NILP (printflag));
  return unbind_to (count, Qnil);
}
#endif

DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r",

point remains at the end of the last character read from the buffer.")
  (b, e, printflag)
     Lisp_Object b, e, printflag;
{
  int count = specpdl_ptr - specpdl;
  Lisp_Object tem;

  if (NILP (printflag))
    tem = Qsymbolp;
  else
    tem = printflag;

  record_unwind_protect (save_restriction_restore, save_restriction_save ());

  /* This both uses b and checks its type.  */
  Fgoto_char (b);
  Fnarrow_to_region (make_number (BEGV), e);
  readevalloop (Fcurrent_buffer (), 0, Feval, !NILP (printflag));

  return unbind_to (count, Qnil);
}

#endif /* standalone */

with no directory specified, since that is how `load' is normally called.\n\
An error in FORMS does not undo the load,\n\
but does prevent execution of the rest of the FORMS.");
  Vafter_load_alist = Qnil;

  Qstandard_input = intern ("standard-input");
  staticpro (&Qstandard_input);

  Qread_char = intern ("read-char");
  staticpro (&Qread_char);

2545:d666732c5f41

/* non-zero if inside `load' */
int load_in_progress;

/* Search path for files to be loaded. */
Lisp_Object Vload_path;

/* This is the user-visible association list that maps features to
   lists of defs in their load files. */
Lisp_Object Vload_history;

/* This is useud to build the load history. */
Lisp_Object Vcurrent_load_list;

/* File for get_file_char to read from.  Use by load */
static FILE *instream;

/* When nonzero, read conses in pure space */

  ptr = (FILE **) xmalloc (sizeof (FILE *));
  *ptr = stream;
  XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
  record_unwind_protect (load_unwind, lispstream);
  load_in_progress++;
  readevalloop (Qget_file_char, stream, str, Feval, 0);
  unbind_to (count, Qnil);

  /* Run any load-hooks for this file.  */
  temp = Fassoc (str, Vafter_load_alist);
  if (!NILP (temp))

  return -1;
}


/* Merge the list we've accumulated of globals from the current input source
   into the load_history variable.  The details depend on whether
   the source has an associated file name or not. */

static void
build_load_history (stream, source)
     FILE *stream;
     Lisp_Object source;
{
  register Lisp_Object tail, prev, newelt;
  register Lisp_Object tem, tem2;
  register int foundit, loading;

  loading = stream || !NARROWED;

  tail = Vload_history;
  prev = Qnil;
  foundit = 0;
  while (!NILP (tail))
    {
      tem = Fcar (tail);

      /* Find the feature's previous assoc list... */
      if (!NILP (Fequal (source, Fcar (tem))))
	{
	  foundit = 1;

	  /*  If we're loading, remove it. */
	  if (loading)
	    {	  
	      if (NILP (prev))
		Vload_history = Fcdr (tail);
	      else
		Fsetcdr (prev, Fcdr (tail));
	    }

	  /*  Otherwise, cons on new symbols that are not already members.  */
	  else
	    {
	      tem2 = Vcurrent_load_list;

	      while (CONSP (tem2))
		{
		  newelt = Fcar (tem2);

		  if (NILP (Fmemq (newelt, tem)))
		    Fsetcar (tail, Fcons (Fcar (tem),
					  Fcons (newelt, Fcdr (tem))));

		  tem2 = Fcdr (tem2);
		  QUIT;
		}
	    }
	}
      else
	prev = tail;
      tail = Fcdr (tail);
      QUIT;
    }

      /* If we're loading, cons the new assoc onto the front of load-history,
	 the most-recently-loaded position.  Also do this if we didn't find
	 an existing member for the current source.  */
      if (loading || !foundit)
	  Vload_history = Fcons (Fnreverse(Vcurrent_load_list),
				 Vload_history);
}

Lisp_Object
unreadpure ()	/* Used as unwind-protect function in readevalloop */
{
  read_pure = 0;
  return Qnil;
}

static void
readevalloop (readcharfun, stream, sourcename, evalfun, printflag)
     Lisp_Object readcharfun;
     FILE *stream;
     Lisp_Object sourcename;
     Lisp_Object (*evalfun) ();
     int printflag;
{
  register int c;
  register Lisp_Object val;
  Lisp_Object oldlist;
  int count = specpdl_ptr - specpdl;
  struct gcpro gcpro1, gcpro2;

  specbind (Qstandard_input, readcharfun);

  oldlist = Vcurrent_load_list;
  GCPRO2 (sourcename, oldlist);

  Vcurrent_load_list = Qnil;
  LOADHIST_ATTACH (sourcename);

  while (1)
    {
      instream = stream;
      c = READCHAR;

	  else
	    Fprint (val, Qnil);
	}
    }

  build_load_history (stream, sourcename);

  Vcurrent_load_list = oldlist;
  UNGCPRO;

  unbind_to (count, Qnil);
}

#ifndef standalone

  else
    tem = printflag;
  specbind (Qstandard_output, tem);
  record_unwind_protect (save_excursion_restore, save_excursion_save ());
  BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
  readevalloop (buf, 0, XBUFFER (buf)->filename, Feval, !NILP (printflag));
  unbind_to (count, Qnil);

  return Qnil;
}

point remains at the end of the last character read from the buffer.")
  (printflag)
     Lisp_Object printflag;
{
  int count = specpdl_ptr - specpdl;
  Lisp_Object tem, cbuf;

  cbuf = Fcurrent_buffer ()

  if (NILP (printflag))
    tem = Qsymbolp;
  else
    tem = printflag;
  specbind (Qstandard_output, tem);
  record_unwind_protect (save_excursion_restore, save_excursion_save ());
  SET_PT (BEGV);
  readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
  return unbind_to (count, Qnil);
}
#endif

DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r",

point remains at the end of the last character read from the buffer.")
  (b, e, printflag)
     Lisp_Object b, e, printflag;
{
  int count = specpdl_ptr - specpdl;
  Lisp_Object tem, cbuf;

  cbuf = Fcurrent_buffer ();

  if (NILP (printflag))
    tem = Qsymbolp;
  else
    tem = printflag;

  record_unwind_protect (save_restriction_restore, save_restriction_save ());

  /* This both uses b and checks its type.  */
  Fgoto_char (b);
  Fnarrow_to_region (make_number (BEGV), e);
  readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));

  return unbind_to (count, Qnil);
}

#endif /* standalone */

with no directory specified, since that is how `load' is normally called.\n\
An error in FORMS does not undo the load,\n\
but does prevent execution of the rest of the FORMS.");
  Vafter_load_alist = Qnil;

  DEFVAR_LISP ("load-history", &Vload_history,
    "Alist mapping source file names to symbols and features.\n\
Each alist element is a list that starts with a file name,\n\
except for one element (optional) that starts with nil and describes\n\
definitions evaluated from buffers not visiting files.\n\
The remaining elements of each list are symbols defined as functions\n\
or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
  Vload_history = Qnil;

  staticpro (&Vcurrent_load_list);
  Vcurrent_load_list = Qnil;

  Qstandard_input = intern ("standard-input");
  staticpro (&Qstandard_input);

  Qread_char = intern ("read-char");
  staticpro (&Qread_char);