DEFVAR_INT ("while-time-interval", &while_time_interval,
            doc: /* Check for input during while after this number of millisec.
If equal or less than 0 do not check for input.
You are supposed to let bind this variable for code where you want this check.

See also `while-throw-values'. If this is nil do not check for input. */);
  while_time_interval = 0;

DEFVAR_LISP ("while-throw-values", &Vwhile_throw_values,
             doc: /* List with catch symbol and value to throw during while.
If input arrives during `while' then `throw' to symbol and value in this list.

Optionally the list may contain a third element, if the list contains a third element then this should be a symbol.  Throw then happens only if this variable symbol is non-nil, or, if it is a function if it returns non-nil.

The full format of this variable is

   \(CATCH-SYM VALUE-SYM TEST-SYM)

where TEST-SYM is optional.

See also `while-time-interval' for when the test for input availability is done.
*/);
Vwhile_throw_values = Qnil;

DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
       doc: /* If TEST yields non-nil, eval BODY... and repeat.
The order of execution is thus TEST, BODY, TEST, BODY and so on
until TEST returns nil.
usage: (while TEST BODY...)

The execution can be interrupted by input.  See `while-time-interval'
for more information.  */)
     (args)
     Lisp_Object args;
{
  Lisp_Object test, body;
  struct gcpro gcpro1, gcpro2;
  EMACS_TIME t;
  time_t sec;
  int usec;
  time_t sec_next;
  int usec_next;
  int check_input = (while_time_interval > 0) && Flistp (Vwhile_throw_values);
  Lisp_Object catch_sym, value_sym, test_sym, value_sym_value;

  if (check_input)
    {
      /* Check Vwhile_trhow and while_time_interval value types
         first! */
      catch_sym = Fnth (0, Vwhile_throw_values);
      value_sym = Fnth (1, Vwhile_throw_values);
      test_sym  = Fnth (2, Vwhile_throw_values);
      check_input = Fsymbolp (catch_sym)
        && (NILP (test_sym)  || (Fsymbolp (test_sym)  && (Fboundp (test_sym)  || Ffboundp (test_sym))))
        && (NILP (value_sym) || (Fsymbolp (value_sym) && (Fboundp (value_sym) || Ffboundp (value_sym))));
      if (check_input)
        {
          EMACS_GET_TIME (t);
          usec = EMACS_USECS (t);
          sec = EMACS_SECS (t);
          sec_next = sec;
          usec_next = usec + while_time_interval;
          if (usec_next > 1000)
            {
              /* Fix-me: what are the op in c?? */
              sec_next = usec_next % 1000;
              usec_next = use_next mod 1000;
            }
        }
    }

  GCPRO2 (test, body);

  test = Fcar (args);
  body = Fcdr (args);
  while (!NILP (Feval (test)))
    {
      QUIT;
      /* Maybe not check time every time? */
      if (check_input)
        {
          EMACS_GET_TIME (t);
          usec = EMACS_USECS (t);
          sec = EMACS_SECS (t);
          if (sec > sec_next || usec > usec_next)
            {
              if ((NILP (test_sym)
                   ||
                   !NILP (Fboundp (test_sym) ? Fsymbol_value (test_sym) : Fcall0 (test_sym)))
                  &&
                  Finput_pending_p ())
                {
                  value_sym_value = (Fboundp (value_sym) ?
                                     Fsymbol_value (value_sym) :
                                     (Ffboundp (value_sym) ?
                                      Fcall0 (value_sym) :
                                      value_sym));
                  Fthrow (catch_sym, value_sym_value);
                }
              sec_next = sec;
              usec_next = usec + while_time_interval;
              if (usec_next > 1000)
                {
                  sec_next = usec_next % 1000;
                  usec_next = use_next mod 1000;
                }
            }
        }
      Fprogn (body);
    }

  UNGCPRO;
  return Qnil;
}