(wait_for_termination): Copy code from 18.59 (but sans BSD4_1 alternatives).

[gnu-emacs] / src / fns.c

diff --git a/src/fns.c b/src/fns.c
index 6eb97d4683ab749b612e001f0396e96efde1d07d..328cf984c71f455bab27791e009016af11621698 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -31,7 +31,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "buffer.h"
 #include "keyboard.h"
 
-Lisp_Object Qstring_lessp;
+Lisp_Object Qstring_lessp, Qprovide, Qrequire;
 
 static Lisp_Object internal_equal ();
 \f
@@ -49,27 +49,27 @@ On most systems all integers representable in Lisp are equally likely.\n\
   This is 24 bits' worth.\n\
 With argument N, return random number in interval [0,N).\n\
 With argument t, set the random number seed from the current time and pid.")
-  (arg)
-     Lisp_Object arg;
+  (limit)
+     Lisp_Object limit;
 {
   int val;
   extern long random ();
   extern srandom ();
   extern long time ();
 
-  if (EQ (arg, Qt))
+  if (EQ (limit, Qt))
     srandom (getpid () + time (0));
   val = random ();
-  if (XTYPE (arg) == Lisp_Int && XINT (arg) != 0)
+  if (XTYPE (limit) == Lisp_Int && XINT (limit) != 0)
     {
       /* Try to take our random number from the higher bits of VAL,
         not the lower, since (says Gentzel) the low bits of `random'
         are less random than the higher ones.  */
       val &= 0xfffffff;                /* Ensure positive.  */
       val >>= 5;
-      if (XINT (arg) < 10000)
+      if (XINT (limit) < 10000)
        val >>= 6;
-      val %= XINT (arg);
+      val %= XINT (limit);
     }
   return make_number (val);
 }
@@ -262,7 +262,7 @@ concat (nargs, args, target_type, last_special)
            || XTYPE (this) == Lisp_Compiled))
        {
          if (XTYPE (this) == Lisp_Int)
-            args[argnum] = Fint_to_string (this);
+            args[argnum] = Fnumber_to_string (this);
          else
            args[argnum] = wrong_type_argument (Qsequencep, this);
        }
@@ -836,12 +836,19 @@ internal_equal (o1, o2, depth)
     error ("Stack overflow in equal");
 do_cdr:
   QUIT;
+  if (EQ (o1, o2)) return Qt;
+#ifdef LISP_FLOAT_TYPE
+  if (NUMBERP (o1) && NUMBERP (o2))
+    {
+      return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
+    }
+#endif
   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
-  if (XINT (o1) == XINT (o2)) return Qt;
-  if (XTYPE (o1) == Lisp_Cons)
+  if (XTYPE (o1) == Lisp_Cons
+      || XTYPE (o1) == Lisp_Overlay)
     {
       Lisp_Object v1;
-      v1 = Fequal (Fcar (o1), Fcar (o2), depth + 1);
+      v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
       if (NILP (v1))
        return v1;
       o1 = Fcdr (o1), o2 = Fcdr (o2);
@@ -853,7 +860,8 @@ do_cdr:
              && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
        ? Qt : Qnil;
     }
-  if (XTYPE (o1) == Lisp_Vector)
+  if (XTYPE (o1) == Lisp_Vector
+      || XTYPE (o1) == Lisp_Compiled)
     {
       register int index;
       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
@@ -863,7 +871,7 @@ do_cdr:
          Lisp_Object v, v1, v2;
          v1 = XVECTOR (o1)->contents [index];
          v2 = XVECTOR (o2)->contents [index];
-         v = Fequal (v1, v2, depth + 1);
+         v = internal_equal (v1, v2, depth + 1);
          if (NILP (v)) return v;
        }
       return Qt;
@@ -1086,45 +1094,57 @@ Also accepts Space to mean yes, or Delete to mean no.")
   (prompt)
      Lisp_Object prompt;
 {
-  register Lisp_Object obj; 
-  register int ans;
+  register Lisp_Object obj, key, def, answer_string, map;
+  register int answer;
   Lisp_Object xprompt;
   Lisp_Object args[2];
   int ocech = cursor_in_echo_area;
   struct gcpro gcpro1, gcpro2;
 
+  map = Fsymbol_value (intern ("query-replace-map"));
+
   CHECK_STRING (prompt, 0);
   xprompt = prompt;
   GCPRO2 (prompt, xprompt);
 
   while (1)
     {
-      message ("%s(y or n) ", XSTRING (xprompt)->data);
       cursor_in_echo_area = 1;
+      message ("%s(y or n) ", XSTRING (xprompt)->data);
 
-      obj = read_char (0, 0, 0, Qnil, 0);
-      if (XTYPE (obj) == Lisp_Int)
-       ans = XINT (obj);
-      else
-       continue;
+      obj = read_filtered_event (1, 0, 0);
+      cursor_in_echo_area = 0;
+      /* If we need to quit, quit with cursor_in_echo_area = 0.  */
+      QUIT;
 
-      cursor_in_echo_area = -1;
-      message ("%s(y or n) %c", XSTRING (xprompt)->data, ans);
-      cursor_in_echo_area = ocech;
-      /* Accept a C-g or C-] (abort-recursive-edit) as quit requests.  */
-      if (ans == 7 || ans == '\035')
+      key = Fmake_vector (make_number (1), obj);
+      def = Flookup_key (map, key);
+      answer_string = Fsingle_key_description (obj);
+
+      if (EQ (def, intern ("skip")))
+       {
+         answer = 0;
+         break;
+       }
+      else if (EQ (def, intern ("act")))
+       {
+         answer = 1;
+         break;
+       }
+      else if (EQ (def, intern ("recenter")))
+       {
+         Frecenter (Qnil);
+         xprompt = prompt;
+         continue;
+       }
+      else if (EQ (def, intern ("quit")))
        Vquit_flag = Qt;
+
       QUIT;
 
       /* If we don't clear this, then the next call to read_char will
         return quit_char again, and we'll enter an infinite loop.  */
       Vquit_flag = Qnil;
-      if (ans >= 0)
-       ans = DOWNCASE (ans);
-      if (ans == 'y' || ans == ' ')
-       { ans = 'y'; break; }
-      if (ans == 'n' || ans == 127)
-       break;
 
       Fding (Qnil);
       Fdiscard_input ();
@@ -1136,7 +1156,15 @@ Also accepts Space to mean yes, or Delete to mean no.")
        }
     }
   UNGCPRO;
-  return (ans == 'y' ? Qt : Qnil);
+
+  if (! noninteractive)
+    {
+      cursor_in_echo_area = -1;
+      message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
+      cursor_in_echo_area = ocech;
+    }
+
+  return answer ? Qt : Qnil;
 }
 \f
 /* This is how C code calls `yes-or-no-p' and allows the user
@@ -1246,6 +1274,7 @@ DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
   tem = Fmemq (feature, Vfeatures);
   if (NILP (tem))
     Vfeatures = Fcons (feature, Vfeatures);
+  LOADHIST_ATTACH (Fcons (Qprovide, feature));
   return feature;
 }
 
@@ -1260,6 +1289,7 @@ If FILENAME is omitted, the printname of FEATURE is used as the file name.")
   register Lisp_Object tem;
   CHECK_SYMBOL (feature, 0);
   tem = Fmemq (feature, Vfeatures);
+  LOADHIST_ATTACH (Fcons (Qrequire, feature));
   if (NILP (tem))
     {
       int count = specpdl_ptr - specpdl;
@@ -1287,6 +1317,10 @@ syms_of_fns ()
 {
   Qstring_lessp = intern ("string-lessp");
   staticpro (&Qstring_lessp);
+  Qprovide = intern ("provide");
+  staticpro (&Qprovide);
+  Qrequire = intern ("require");
+  staticpro (&Qrequire);
 
   DEFVAR_LISP ("features", &Vfeatures,
     "A list of symbols which are the features of the executing emacs.\n\