src/fns.c

   1 /* Random utility Lisp functions.
   2    Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <config.h>
  22
  23 /* Note on some machines this defines `vector' as a typedef,
  24    so make sure we don't use that name in this file.  */
  25 #undef vector
  26 #define vector *****
  27
  28 #include "lisp.h"
  29 #include "commands.h"
  30
  31 #include "buffer.h"
  32 #include "keyboard.h"
  33 #include "intervals.h"
  34
  35 extern Lisp_Object Flookup_key ();
  36
  37 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
  38 Lisp_Object Qyes_or_no_p_history;
  39
  40 static int internal_equal ();
  41 \f
  42 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
  43   "Return the argument unchanged.")
  44   (arg)
  45      Lisp_Object arg;
  46 {
  47   return arg;
  48 }
  49
  50 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
  51   "Return a pseudo-random number.\n\
  52 On most systems all integers representable in Lisp are equally likely.\n\
  53   This is 24 bits' worth.\n\
  54 With argument N, return random number in interval [0,N).\n\
  55 With argument t, set the random number seed from the current time and pid.")
  56   (limit)
  57      Lisp_Object limit;
  58 {
  59   int val;
  60   unsigned long denominator;
  61   extern long random ();
  62   extern srandom ();
  63   extern long time ();
  64
  65   if (EQ (limit, Qt))
  66     srandom (getpid () + time (0));
  67   if (INTEGERP (limit) && XINT (limit) > 0)
  68     {
  69       if (XFASTINT (limit) >= 0x40000000)
  70         /* This case may occur on 64-bit machines.  */
  71         val = random () % XFASTINT (limit);
  72       else
  73         {
  74           /* Try to take our random number from the higher bits of VAL,
  75              not the lower, since (says Gentzel) the low bits of `random'
  76              are less random than the higher ones.  We do this by using the
  77              quotient rather than the remainder.  At the high end of the RNG
  78              it's possible to get a quotient larger than limit; discarding
  79              these values eliminates the bias that would otherwise appear
  80              when using a large limit.  */
  81           denominator = (unsigned long)0x40000000 / XFASTINT (limit);
  82           do
  83             val = (random () & 0x3fffffff) / denominator;
  84           while (val >= XFASTINT (limit));
  85         }
  86     }
  87   else
  88     val = random ();
  89   return make_number (val);
  90 }
  91 \f
  92 /* Random data-structure functions */
  93
  94 DEFUN ("length", Flength, Slength, 1, 1, 0,
  95   "Return the length of vector, list or string SEQUENCE.\n\
  96 A byte-code function object is also allowed.")
  97   (obj)
  98      register Lisp_Object obj;
  99 {
 100   register Lisp_Object tail, val;
 101   register int i;
 102
 103  retry:
 104   if (STRINGP (obj))
 105     XSETFASTINT (val, XSTRING (obj)->size);
 106   else if (VECTORP (obj))
 107     XSETFASTINT (val, XVECTOR (obj)->size);
 108   else if (COMPILEDP (obj))
 109     XSETFASTINT (val, XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK);
 110   else if (CONSP (obj))
 111     {
 112       for (i = 0, tail = obj; !NILP (tail); i++)
 113         {
 114           QUIT;
 115           tail = Fcdr (tail);
 116         }
 117
 118       XSETFASTINT (val, i);
 119     }
 120   else if (NILP (obj))
 121     XSETFASTINT (val, 0);
 122   else
 123     {
 124       obj = wrong_type_argument (Qsequencep, obj);
 125       goto retry;
 126     }
 127   return val;
 128 }
 129
 130 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
 131   "T if two strings have identical contents.\n\
 132 Case is significant, but text properties are ignored.\n\
 133 Symbols are also allowed; their print names are used instead.")
 134   (s1, s2)
 135      register Lisp_Object s1, s2;
 136 {
 137   if (SYMBOLP (s1))
 138     XSETSTRING (s1, XSYMBOL (s1)->name);
 139   if (SYMBOLP (s2))
 140     XSETSTRING (s2, XSYMBOL (s2)->name);
 141   CHECK_STRING (s1, 0);
 142   CHECK_STRING (s2, 1);
 143
 144   if (XSTRING (s1)->size != XSTRING (s2)->size ||
 145       bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
 146     return Qnil;
 147   return Qt;
 148 }
 149
 150 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
 151   "T if first arg string is less than second in lexicographic order.\n\
 152 Case is significant.\n\
 153 Symbols are also allowed; their print names are used instead.")
 154   (s1, s2)
 155      register Lisp_Object s1, s2;
 156 {
 157   register int i;
 158   register unsigned char *p1, *p2;
 159   register int end;
 160
 161   if (SYMBOLP (s1))
 162     XSETSTRING (s1, XSYMBOL (s1)->name);
 163   if (SYMBOLP (s2))
 164     XSETSTRING (s2, XSYMBOL (s2)->name);
 165   CHECK_STRING (s1, 0);
 166   CHECK_STRING (s2, 1);
 167
 168   p1 = XSTRING (s1)->data;
 169   p2 = XSTRING (s2)->data;
 170   end = XSTRING (s1)->size;
 171   if (end > XSTRING (s2)->size)
 172     end = XSTRING (s2)->size;
 173
 174   for (i = 0; i < end; i++)
 175     {
 176       if (p1[i] != p2[i])
 177         return p1[i] < p2[i] ? Qt : Qnil;
 178     }
 179   return i < XSTRING (s2)->size ? Qt : Qnil;
 180 }
 181 \f
 182 static Lisp_Object concat ();
 183
 184 /* ARGSUSED */
 185 Lisp_Object
 186 concat2 (s1, s2)
 187      Lisp_Object s1, s2;
 188 {
 189 #ifdef NO_ARG_ARRAY
 190   Lisp_Object args[2];
 191   args[0] = s1;
 192   args[1] = s2;
 193   return concat (2, args, Lisp_String, 0);
 194 #else
 195   return concat (2, &s1, Lisp_String, 0);
 196 #endif /* NO_ARG_ARRAY */
 197 }
 198
 199 /* ARGSUSED */
 200 Lisp_Object
 201 concat3 (s1, s2, s3)
 202      Lisp_Object s1, s2, s3;
 203 {
 204 #ifdef NO_ARG_ARRAY
 205   Lisp_Object args[3];
 206   args[0] = s1;
 207   args[1] = s2;
 208   args[2] = s3;
 209   return concat (3, args, Lisp_String, 0);
 210 #else
 211   return concat (3, &s1, Lisp_String, 0);
 212 #endif /* NO_ARG_ARRAY */
 213 }
 214
 215 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
 216   "Concatenate all the arguments and make the result a list.\n\
 217 The result is a list whose elements are the elements of all the arguments.\n\
 218 Each argument may be a list, vector or string.\n\
 219 The last argument is not copied, just used as the tail of the new list.")
 220   (nargs, args)
 221      int nargs;
 222      Lisp_Object *args;
 223 {
 224   return concat (nargs, args, Lisp_Cons, 1);
 225 }
 226
 227 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
 228   "Concatenate all the arguments and make the result a string.\n\
 229 The result is a string whose elements are the elements of all the arguments.\n\
 230 Each argument may be a string, a list of characters (integers),\n\
 231 or a vector of characters (integers).")
 232   (nargs, args)
 233      int nargs;
 234      Lisp_Object *args;
 235 {
 236   return concat (nargs, args, Lisp_String, 0);
 237 }
 238
 239 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
 240   "Concatenate all the arguments and make the result a vector.\n\
 241 The result is a vector whose elements are the elements of all the arguments.\n\
 242 Each argument may be a list, vector or string.")
 243   (nargs, args)
 244      int nargs;
 245      Lisp_Object *args;
 246 {
 247   return concat (nargs, args, Lisp_Vectorlike, 0);
 248 }
 249
 250 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
 251   "Return a copy of a list, vector or string.\n\
 252 The elements of a list or vector are not copied; they are shared\n\
 253 with the original.")
 254   (arg)
 255      Lisp_Object arg;
 256 {
 257   if (NILP (arg)) return arg;
 258   if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
 259     arg = wrong_type_argument (Qsequencep, arg);
 260   return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
 261 }
 262
 263 static Lisp_Object
 264 concat (nargs, args, target_type, last_special)
 265      int nargs;
 266      Lisp_Object *args;
 267      enum Lisp_Type target_type;
 268      int last_special;
 269 {
 270   Lisp_Object val;
 271   Lisp_Object len;
 272   register Lisp_Object tail;
 273   register Lisp_Object this;
 274   int toindex;
 275   register int leni;
 276   register int argnum;
 277   Lisp_Object last_tail;
 278   Lisp_Object prev;
 279
 280   /* In append, the last arg isn't treated like the others */
 281   if (last_special && nargs > 0)
 282     {
 283       nargs--;
 284       last_tail = args[nargs];
 285     }
 286   else
 287     last_tail = Qnil;
 288
 289   for (argnum = 0; argnum < nargs; argnum++)
 290     {
 291       this = args[argnum];
 292       if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
 293             || COMPILEDP (this)))
 294         {
 295           if (INTEGERP (this))
 296             args[argnum] = Fnumber_to_string (this);
 297           else
 298             args[argnum] = wrong_type_argument (Qsequencep, this);
 299         }
 300     }
 301
 302   for (argnum = 0, leni = 0; argnum < nargs; argnum++)
 303     {
 304       this = args[argnum];
 305       len = Flength (this);
 306       leni += XFASTINT (len);
 307     }
 308
 309   XSETFASTINT (len, leni);
 310
 311   if (target_type == Lisp_Cons)
 312     val = Fmake_list (len, Qnil);
 313   else if (target_type == Lisp_Vectorlike)
 314     val = Fmake_vector (len, Qnil);
 315   else
 316     val = Fmake_string (len, len);
 317
 318   /* In append, if all but last arg are nil, return last arg */
 319   if (target_type == Lisp_Cons && EQ (val, Qnil))
 320     return last_tail;
 321
 322   if (CONSP (val))
 323     tail = val, toindex = -1;           /* -1 in toindex is flag we are making a list */
 324   else
 325     toindex = 0;
 326
 327   prev = Qnil;
 328
 329   for (argnum = 0; argnum < nargs; argnum++)
 330     {
 331       Lisp_Object thislen;
 332       int thisleni;
 333       register int thisindex = 0;
 334
 335       this = args[argnum];
 336       if (!CONSP (this))
 337         thislen = Flength (this), thisleni = XINT (thislen);
 338
 339       if (STRINGP (this) && STRINGP (val)
 340           && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
 341         {
 342           copy_text_properties (make_number (0), thislen, this,
 343                                 make_number (toindex), val, Qnil);
 344         }
 345
 346       while (1)
 347         {
 348           register Lisp_Object elt;
 349
 350           /* Fetch next element of `this' arg into `elt', or break if
 351              `this' is exhausted. */
 352           if (NILP (this)) break;
 353           if (CONSP (this))
 354             elt = Fcar (this), this = Fcdr (this);
 355           else
 356             {
 357               if (thisindex >= thisleni) break;
 358               if (STRINGP (this))
 359                 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
 360               else
 361                 elt = XVECTOR (this)->contents[thisindex++];
 362             }
 363
 364           /* Store into result */
 365           if (toindex < 0)
 366             {
 367               XCONS (tail)->car = elt;
 368               prev = tail;
 369               tail = XCONS (tail)->cdr;
 370             }
 371           else if (VECTORP (val))
 372             XVECTOR (val)->contents[toindex++] = elt;
 373           else
 374             {
 375               while (!INTEGERP (elt))
 376                 elt = wrong_type_argument (Qintegerp, elt);
 377               {
 378 #ifdef MASSC_REGISTER_BUG
 379                 /* Even removing all "register"s doesn't disable this bug!
 380                    Nothing simpler than this seems to work. */
 381                 unsigned char *p = & XSTRING (val)->data[toindex++];
 382                 *p = XINT (elt);
 383 #else
 384                 XSTRING (val)->data[toindex++] = XINT (elt);
 385 #endif
 386               }
 387             }
 388         }
 389     }
 390   if (!NILP (prev))
 391     XCONS (prev)->cdr = last_tail;
 392
 393   return val;
 394 }
 395 \f
 396 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
 397   "Return a copy of ALIST.\n\
 398 This is an alist which represents the same mapping from objects to objects,\n\
 399 but does not share the alist structure with ALIST.\n\
 400 The objects mapped (cars and cdrs of elements of the alist)\n\
 401 are shared, however.\n\
 402 Elements of ALIST that are not conses are also shared.")
 403   (alist)
 404      Lisp_Object alist;
 405 {
 406   register Lisp_Object tem;
 407
 408   CHECK_LIST (alist, 0);
 409   if (NILP (alist))
 410     return alist;
 411   alist = concat (1, &alist, Lisp_Cons, 0);
 412   for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
 413     {
 414       register Lisp_Object car;
 415       car = XCONS (tem)->car;
 416
 417       if (CONSP (car))
 418         XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
 419     }
 420   return alist;
 421 }
 422
 423 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
 424   "Return a substring of STRING, starting at index FROM and ending before TO.\n\
 425 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
 426 If FROM or TO is negative, it counts from the end.")
 427   (string, from, to)
 428      Lisp_Object string;
 429      register Lisp_Object from, to;
 430 {
 431   Lisp_Object res;
 432
 433   CHECK_STRING (string, 0);
 434   CHECK_NUMBER (from, 1);
 435   if (NILP (to))
 436     to = Flength (string);
 437   else
 438     CHECK_NUMBER (to, 2);
 439
 440   if (XINT (from) < 0)
 441     XSETINT (from, XINT (from) + XSTRING (string)->size);
 442   if (XINT (to) < 0)
 443     XSETINT (to, XINT (to) + XSTRING (string)->size);
 444   if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
 445         && XINT (to) <= XSTRING (string)->size))
 446     args_out_of_range_3 (string, from, to);
 447
 448   res = make_string (XSTRING (string)->data + XINT (from),
 449                      XINT (to) - XINT (from));
 450   copy_text_properties (from, to, string, make_number (0), res, Qnil);
 451   return res;
 452 }
 453 \f
 454 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
 455   "Take cdr N times on LIST, returns the result.")
 456   (n, list)
 457      Lisp_Object n;
 458      register Lisp_Object list;
 459 {
 460   register int i, num;
 461   CHECK_NUMBER (n, 0);
 462   num = XINT (n);
 463   for (i = 0; i < num && !NILP (list); i++)
 464     {
 465       QUIT;
 466       list = Fcdr (list);
 467     }
 468   return list;
 469 }
 470
 471 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
 472   "Return the Nth element of LIST.\n\
 473 N counts from zero.  If LIST is not that long, nil is returned.")
 474   (n, list)
 475      Lisp_Object n, list;
 476 {
 477   return Fcar (Fnthcdr (n, list));
 478 }
 479
 480 DEFUN ("elt", Felt, Selt, 2, 2, 0,
 481   "Return element of SEQUENCE at index N.")
 482   (seq, n)
 483      register Lisp_Object seq, n;
 484 {
 485   CHECK_NUMBER (n, 0);
 486   while (1)
 487     {
 488       if (CONSP (seq) || NILP (seq))
 489         return Fcar (Fnthcdr (n, seq));
 490       else if (STRINGP (seq) || VECTORP (seq))
 491         return Faref (seq, n);
 492       else
 493         seq = wrong_type_argument (Qsequencep, seq);
 494     }
 495 }
 496
 497 DEFUN ("member", Fmember, Smember, 2, 2, 0,
 498   "Return non-nil if ELT is an element of LIST.  Comparison done with `equal'.\n\
 499 The value is actually the tail of LIST whose car is ELT.")
 500   (elt, list)
 501      register Lisp_Object elt;
 502      Lisp_Object list;
 503 {
 504   register Lisp_Object tail;
 505   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 506     {
 507       register Lisp_Object tem;
 508       tem = Fcar (tail);
 509       if (! NILP (Fequal (elt, tem)))
 510         return tail;
 511       QUIT;
 512     }
 513   return Qnil;
 514 }
 515
 516 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
 517   "Return non-nil if ELT is an element of LIST.  Comparison done with EQ.\n\
 518 The value is actually the tail of LIST whose car is ELT.")
 519   (elt, list)
 520      register Lisp_Object elt;
 521      Lisp_Object list;
 522 {
 523   register Lisp_Object tail;
 524   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 525     {
 526       register Lisp_Object tem;
 527       tem = Fcar (tail);
 528       if (EQ (elt, tem)) return tail;
 529       QUIT;
 530     }
 531   return Qnil;
 532 }
 533
 534 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
 535   "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
 536 The value is actually the element of LIST whose car is KEY.\n\
 537 Elements of LIST that are not conses are ignored.")
 538   (key, list)
 539      register Lisp_Object key;
 540      Lisp_Object list;
 541 {
 542   register Lisp_Object tail;
 543   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 544     {
 545       register Lisp_Object elt, tem;
 546       elt = Fcar (tail);
 547       if (!CONSP (elt)) continue;
 548       tem = Fcar (elt);
 549       if (EQ (key, tem)) return elt;
 550       QUIT;
 551     }
 552   return Qnil;
 553 }
 554
 555 /* Like Fassq but never report an error and do not allow quits.
 556    Use only on lists known never to be circular.  */
 557
 558 Lisp_Object
 559 assq_no_quit (key, list)
 560      register Lisp_Object key;
 561      Lisp_Object list;
 562 {
 563   register Lisp_Object tail;
 564   for (tail = list; CONSP (tail); tail = Fcdr (tail))
 565     {
 566       register Lisp_Object elt, tem;
 567       elt = Fcar (tail);
 568       if (!CONSP (elt)) continue;
 569       tem = Fcar (elt);
 570       if (EQ (key, tem)) return elt;
 571     }
 572   return Qnil;
 573 }
 574
 575 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
 576   "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
 577 The value is actually the element of LIST whose car is KEY.")
 578   (key, list)
 579      register Lisp_Object key;
 580      Lisp_Object list;
 581 {
 582   register Lisp_Object tail;
 583   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 584     {
 585       register Lisp_Object elt, tem;
 586       elt = Fcar (tail);
 587       if (!CONSP (elt)) continue;
 588       tem = Fequal (Fcar (elt), key);
 589       if (!NILP (tem)) return elt;
 590       QUIT;
 591     }
 592   return Qnil;
 593 }
 594
 595 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
 596   "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
 597 The value is actually the element of LIST whose cdr is ELT.")
 598   (key, list)
 599      register Lisp_Object key;
 600      Lisp_Object list;
 601 {
 602   register Lisp_Object tail;
 603   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 604     {
 605       register Lisp_Object elt, tem;
 606       elt = Fcar (tail);
 607       if (!CONSP (elt)) continue;
 608       tem = Fcdr (elt);
 609       if (EQ (key, tem)) return elt;
 610       QUIT;
 611     }
 612   return Qnil;
 613 }
 614 \f
 615 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
 616   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
 617 The modified LIST is returned.  Comparison is done with `eq'.\n\
 618 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
 619 therefore, write `(setq foo (delq element foo))'\n\
 620 to be sure of changing the value of `foo'.")
 621   (elt, list)
 622      register Lisp_Object elt;
 623      Lisp_Object list;
 624 {
 625   register Lisp_Object tail, prev;
 626   register Lisp_Object tem;
 627
 628   tail = list;
 629   prev = Qnil;
 630   while (!NILP (tail))
 631     {
 632       tem = Fcar (tail);
 633       if (EQ (elt, tem))
 634         {
 635           if (NILP (prev))
 636             list = Fcdr (tail);
 637           else
 638             Fsetcdr (prev, Fcdr (tail));
 639         }
 640       else
 641         prev = tail;
 642       tail = Fcdr (tail);
 643       QUIT;
 644     }
 645   return list;
 646 }
 647
 648 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
 649   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
 650 The modified LIST is returned.  Comparison is done with `equal'.\n\
 651 If the first member of LIST is ELT, deleting it is not a side effect;\n\
 652 it is simply using a different list.\n\
 653 Therefore, write `(setq foo (delete element foo))'\n\
 654 to be sure of changing the value of `foo'.")
 655   (elt, list)
 656      register Lisp_Object elt;
 657      Lisp_Object list;
 658 {
 659   register Lisp_Object tail, prev;
 660   register Lisp_Object tem;
 661
 662   tail = list;
 663   prev = Qnil;
 664   while (!NILP (tail))
 665     {
 666       tem = Fcar (tail);
 667       if (! NILP (Fequal (elt, tem)))
 668         {
 669           if (NILP (prev))
 670             list = Fcdr (tail);
 671           else
 672             Fsetcdr (prev, Fcdr (tail));
 673         }
 674       else
 675         prev = tail;
 676       tail = Fcdr (tail);
 677       QUIT;
 678     }
 679   return list;
 680 }
 681
 682 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
 683   "Reverse LIST by modifying cdr pointers.\n\
 684 Returns the beginning of the reversed list.")
 685   (list)
 686      Lisp_Object list;
 687 {
 688   register Lisp_Object prev, tail, next;
 689
 690   if (NILP (list)) return list;
 691   prev = Qnil;
 692   tail = list;
 693   while (!NILP (tail))
 694     {
 695       QUIT;
 696       next = Fcdr (tail);
 697       Fsetcdr (tail, prev);
 698       prev = tail;
 699       tail = next;
 700     }
 701   return prev;
 702 }
 703
 704 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
 705   "Reverse LIST, copying.  Returns the beginning of the reversed list.\n\
 706 See also the function `nreverse', which is used more often.")
 707   (list)
 708      Lisp_Object list;
 709 {
 710   Lisp_Object length;
 711   register Lisp_Object *vec;
 712   register Lisp_Object tail;
 713   register int i;
 714
 715   length = Flength (list);
 716   vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
 717   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
 718     vec[i] = Fcar (tail);
 719
 720   return Flist (XINT (length), vec);
 721 }
 722 \f
 723 Lisp_Object merge ();
 724
 725 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
 726   "Sort LIST, stably, comparing elements using PREDICATE.\n\
 727 Returns the sorted list.  LIST is modified by side effects.\n\
 728 PREDICATE is called with two elements of LIST, and should return T\n\
 729 if the first element is \"less\" than the second.")
 730   (list, pred)
 731      Lisp_Object list, pred;
 732 {
 733   Lisp_Object front, back;
 734   register Lisp_Object len, tem;
 735   struct gcpro gcpro1, gcpro2;
 736   register int length;
 737
 738   front = list;
 739   len = Flength (list);
 740   length = XINT (len);
 741   if (length < 2)
 742     return list;
 743
 744   XSETINT (len, (length / 2) - 1);
 745   tem = Fnthcdr (len, list);
 746   back = Fcdr (tem);
 747   Fsetcdr (tem, Qnil);
 748
 749   GCPRO2 (front, back);
 750   front = Fsort (front, pred);
 751   back = Fsort (back, pred);
 752   UNGCPRO;
 753   return merge (front, back, pred);
 754 }
 755
 756 Lisp_Object
 757 merge (org_l1, org_l2, pred)
 758      Lisp_Object org_l1, org_l2;
 759      Lisp_Object pred;
 760 {
 761   Lisp_Object value;
 762   register Lisp_Object tail;
 763   Lisp_Object tem;
 764   register Lisp_Object l1, l2;
 765   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 766
 767   l1 = org_l1;
 768   l2 = org_l2;
 769   tail = Qnil;
 770   value = Qnil;
 771
 772   /* It is sufficient to protect org_l1 and org_l2.
 773      When l1 and l2 are updated, we copy the new values
 774      back into the org_ vars.  */
 775   GCPRO4 (org_l1, org_l2, pred, value);
 776
 777   while (1)
 778     {
 779       if (NILP (l1))
 780         {
 781           UNGCPRO;
 782           if (NILP (tail))
 783             return l2;
 784           Fsetcdr (tail, l2);
 785           return value;
 786         }
 787       if (NILP (l2))
 788         {
 789           UNGCPRO;
 790           if (NILP (tail))
 791             return l1;
 792           Fsetcdr (tail, l1);
 793           return value;
 794         }
 795       tem = call2 (pred, Fcar (l2), Fcar (l1));
 796       if (NILP (tem))
 797         {
 798           tem = l1;
 799           l1 = Fcdr (l1);
 800           org_l1 = l1;
 801         }
 802       else
 803         {
 804           tem = l2;
 805           l2 = Fcdr (l2);
 806           org_l2 = l2;
 807         }
 808       if (NILP (tail))
 809         value = tem;
 810       else
 811         Fsetcdr (tail, tem);
 812       tail = tem;
 813     }
 814 }
 815 \f
 816 DEFUN ("get", Fget, Sget, 2, 2, 0,
 817   "Return the value of SYMBOL's PROPNAME property.\n\
 818 This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
 819   (sym, prop)
 820      Lisp_Object sym;
 821      register Lisp_Object prop;
 822 {
 823   register Lisp_Object tail;
 824   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 825     {
 826       register Lisp_Object tem;
 827       tem = Fcar (tail);
 828       if (EQ (prop, tem))
 829         return Fcar (Fcdr (tail));
 830     }
 831   return Qnil;
 832 }
 833
 834 DEFUN ("put", Fput, Sput, 3, 3, 0,
 835   "Store SYMBOL's PROPNAME property with value VALUE.\n\
 836 It can be retrieved with `(get SYMBOL PROPNAME)'.")
 837   (sym, prop, val)
 838      Lisp_Object sym;
 839      register Lisp_Object prop;
 840      Lisp_Object val;
 841 {
 842   register Lisp_Object tail, prev;
 843   Lisp_Object newcell;
 844   prev = Qnil;
 845   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 846     {
 847       register Lisp_Object tem;
 848       tem = Fcar (tail);
 849       if (EQ (prop, tem))
 850         return Fsetcar (Fcdr (tail), val);
 851       prev = tail;
 852     }
 853   newcell = Fcons (prop, Fcons (val, Qnil));
 854   if (NILP (prev))
 855     Fsetplist (sym, newcell);
 856   else
 857     Fsetcdr (Fcdr (prev), newcell);
 858   return val;
 859 }
 860
 861 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
 862   "T if two Lisp objects have similar structure and contents.\n\
 863 They must have the same data type.\n\
 864 Conses are compared by comparing the cars and the cdrs.\n\
 865 Vectors and strings are compared element by element.\n\
 866 Numbers are compared by value, but integers cannot equal floats.\n\
 867  (Use `=' if you want integers and floats to be able to be equal.)\n\
 868 Symbols must match exactly.")
 869   (o1, o2)
 870      register Lisp_Object o1, o2;
 871 {
 872   return internal_equal (o1, o2, 0) ? Qt : Qnil;
 873 }
 874
 875 static int
 876 internal_equal (o1, o2, depth)
 877      register Lisp_Object o1, o2;
 878      int depth;
 879 {
 880   if (depth > 200)
 881     error ("Stack overflow in equal");
 882
 883  tail_recurse:
 884   QUIT;
 885   if (EQ (o1, o2))
 886     return 1;
 887   if (XTYPE (o1) != XTYPE (o2))
 888     return 0;
 889
 890   switch (XTYPE (o1))
 891     {
 892 #ifdef LISP_FLOAT_TYPE
 893     case Lisp_Float:
 894       return (extract_float (o1) == extract_float (o2));
 895 #endif
 896
 897     case Lisp_Cons:
 898       {
 899         if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1))
 900           return 0;
 901         o1 = XCONS (o1)->cdr;
 902         o2 = XCONS (o2)->cdr;
 903         goto tail_recurse;
 904       }
 905
 906     case Lisp_Misc:
 907       if (MISCP (o1) && XMISC (o1)->type != XMISC (o2)->type)
 908         return 0;
 909       if (OVERLAYP (o1))
 910         {
 911           if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1),
 912                                depth + 1)
 913               || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o1),
 914                                   depth + 1))
 915             return 0;
 916           o1 = XOVERLAY (o1)->plist;
 917           o2 = XOVERLAY (o2)->plist;
 918           goto tail_recurse;
 919         }
 920       if (MARKERP (o1))
 921         {
 922           return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
 923                   && (XMARKER (o1)->buffer == 0
 924                       || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos));
 925         }
 926       break;
 927
 928     case Lisp_Vectorlike:
 929       if ((VECTORP (o1) && VECTORP (o2))
 930           ||
 931           (COMPILEDP (o1) && COMPILEDP (o2)))
 932         {
 933           register int index;
 934           if (XVECTOR (o1)->size != XVECTOR (o2)->size)
 935             return 0;
 936           for (index = 0; index < XVECTOR (o1)->size; index++)
 937             {
 938               Lisp_Object v1, v2;
 939               v1 = XVECTOR (o1)->contents [index];
 940               v2 = XVECTOR (o2)->contents [index];
 941               if (!internal_equal (v1, v2, depth + 1))
 942                 return 0;
 943             }
 944           return 1;
 945         }
 946       break;
 947
 948     case Lisp_String:
 949       if (STRINGP (o1))
 950         {
 951           if (XSTRING (o1)->size != XSTRING (o2)->size)
 952             return 0;
 953           if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,
 954                     XSTRING (o1)->size))
 955             return 0;
 956 #ifdef USE_TEXT_PROPERTIES
 957           /* If the strings have intervals, verify they match;
 958              if not, they are unequal.  */
 959           if ((XSTRING (o1)->intervals != 0 || XSTRING (o2)->intervals != 0)
 960               && ! compare_string_intervals (o1, o2))
 961             return 0;
 962 #endif
 963           return 1;
 964         }
 965     }
 966   return 0;
 967 }
 968 \f
 969 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
 970   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
 971   (array, item)
 972      Lisp_Object array, item;
 973 {
 974   register int size, index, charval;
 975  retry:
 976   if (VECTORP (array))
 977     {
 978       register Lisp_Object *p = XVECTOR (array)->contents;
 979       size = XVECTOR (array)->size;
 980       for (index = 0; index < size; index++)
 981         p[index] = item;
 982     }
 983   else if (STRINGP (array))
 984     {
 985       register unsigned char *p = XSTRING (array)->data;
 986       CHECK_NUMBER (item, 1);
 987       charval = XINT (item);
 988       size = XSTRING (array)->size;
 989       for (index = 0; index < size; index++)
 990         p[index] = charval;
 991     }
 992   else
 993     {
 994       array = wrong_type_argument (Qarrayp, array);
 995       goto retry;
 996     }
 997   return array;
 998 }
 999
1000 /* ARGSUSED */
1001 Lisp_Object
1002 nconc2 (s1, s2)
1003      Lisp_Object s1, s2;
1004 {
1005 #ifdef NO_ARG_ARRAY
1006   Lisp_Object args[2];
1007   args[0] = s1;
1008   args[1] = s2;
1009   return Fnconc (2, args);
1010 #else
1011   return Fnconc (2, &s1);
1012 #endif /* NO_ARG_ARRAY */
1013 }
1014
1015 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
1016   "Concatenate any number of lists by altering them.\n\
1017 Only the last argument is not altered, and need not be a list.")
1018   (nargs, args)
1019      int nargs;
1020      Lisp_Object *args;
1021 {
1022   register int argnum;
1023   register Lisp_Object tail, tem, val;
1024
1025   val = Qnil;
1026
1027   for (argnum = 0; argnum < nargs; argnum++)
1028     {
1029       tem = args[argnum];
1030       if (NILP (tem)) continue;
1031
1032       if (NILP (val))
1033         val = tem;
1034
1035       if (argnum + 1 == nargs) break;
1036
1037       if (!CONSP (tem))
1038         tem = wrong_type_argument (Qlistp, tem);
1039
1040       while (CONSP (tem))
1041         {
1042           tail = tem;
1043           tem = Fcdr (tail);
1044           QUIT;
1045         }
1046
1047       tem = args[argnum + 1];
1048       Fsetcdr (tail, tem);
1049       if (NILP (tem))
1050         args[argnum + 1] = tail;
1051     }
1052
1053   return val;
1054 }
1055 \f
1056 /* This is the guts of all mapping functions.
1057  Apply fn to each element of seq, one by one,
1058  storing the results into elements of vals, a C vector of Lisp_Objects.
1059  leni is the length of vals, which should also be the length of seq. */
1060
1061 static void
1062 mapcar1 (leni, vals, fn, seq)
1063      int leni;
1064      Lisp_Object *vals;
1065      Lisp_Object fn, seq;
1066 {
1067   register Lisp_Object tail;
1068   Lisp_Object dummy;
1069   register int i;
1070   struct gcpro gcpro1, gcpro2, gcpro3;
1071
1072   /* Don't let vals contain any garbage when GC happens.  */
1073   for (i = 0; i < leni; i++)
1074     vals[i] = Qnil;
1075
1076   GCPRO3 (dummy, fn, seq);
1077   gcpro1.var = vals;
1078   gcpro1.nvars = leni;
1079   /* We need not explicitly protect `tail' because it is used only on lists, and
1080     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
1081
1082   if (VECTORP (seq))
1083     {
1084       for (i = 0; i < leni; i++)
1085         {
1086           dummy = XVECTOR (seq)->contents[i];
1087           vals[i] = call1 (fn, dummy);
1088         }
1089     }
1090   else if (STRINGP (seq))
1091     {
1092       for (i = 0; i < leni; i++)
1093         {
1094           XSETFASTINT (dummy, XSTRING (seq)->data[i]);
1095           vals[i] = call1 (fn, dummy);
1096         }
1097     }
1098   else   /* Must be a list, since Flength did not get an error */
1099     {
1100       tail = seq;
1101       for (i = 0; i < leni; i++)
1102         {
1103           vals[i] = call1 (fn, Fcar (tail));
1104           tail = Fcdr (tail);
1105         }
1106     }
1107
1108   UNGCPRO;
1109 }
1110
1111 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
1112   "Apply FN to each element of SEQ, and concat the results as strings.\n\
1113 In between each pair of results, stick in SEP.\n\
1114 Thus, \" \" as SEP results in spaces between the values returned by FN.")
1115   (fn, seq, sep)
1116      Lisp_Object fn, seq, sep;
1117 {
1118   Lisp_Object len;
1119   register int leni;
1120   int nargs;
1121   register Lisp_Object *args;
1122   register int i;
1123   struct gcpro gcpro1;
1124
1125   len = Flength (seq);
1126   leni = XINT (len);
1127   nargs = leni + leni - 1;
1128   if (nargs < 0) return build_string ("");
1129
1130   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
1131
1132   GCPRO1 (sep);
1133   mapcar1 (leni, args, fn, seq);
1134   UNGCPRO;
1135
1136   for (i = leni - 1; i >= 0; i--)
1137     args[i + i] = args[i];
1138
1139   for (i = 1; i < nargs; i += 2)
1140     args[i] = sep;
1141
1142   return Fconcat (nargs, args);
1143 }
1144
1145 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
1146   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
1147 The result is a list just as long as SEQUENCE.\n\
1148 SEQUENCE may be a list, a vector or a string.")
1149   (fn, seq)
1150      Lisp_Object fn, seq;
1151 {
1152   register Lisp_Object len;
1153   register int leni;
1154   register Lisp_Object *args;
1155
1156   len = Flength (seq);
1157   leni = XFASTINT (len);
1158   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
1159
1160   mapcar1 (leni, args, fn, seq);
1161
1162   return Flist (leni, args);
1163 }
1164 \f
1165 /* Anything that calls this function must protect from GC!  */
1166
1167 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
1168   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
1169 Takes one argument, which is the string to display to ask the question.\n\
1170 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
1171 No confirmation of the answer is requested; a single character is enough.\n\
1172 Also accepts Space to mean yes, or Delete to mean no.")
1173   (prompt)
1174      Lisp_Object prompt;
1175 {
1176   register Lisp_Object obj, key, def, answer_string, map;
1177   register int answer;
1178   Lisp_Object xprompt;
1179   Lisp_Object args[2];
1180   int ocech = cursor_in_echo_area;
1181   struct gcpro gcpro1, gcpro2;
1182
1183   map = Fsymbol_value (intern ("query-replace-map"));
1184
1185   CHECK_STRING (prompt, 0);
1186   xprompt = prompt;
1187   GCPRO2 (prompt, xprompt);
1188
1189   while (1)
1190     {
1191 #ifdef HAVE_X_MENU
1192       if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1193           && using_x_p ())
1194         {
1195           Lisp_Object pane, menu;
1196           redisplay_preserve_echo_area ();
1197           pane = Fcons (Fcons (build_string ("Yes"), Qt),
1198                         Fcons (Fcons (build_string ("No"), Qnil),
1199                                Qnil));
1200           menu = Fcons (prompt, pane);
1201           obj = Fx_popup_dialog (Qt, menu);
1202           answer = !NILP (obj);
1203           break;
1204         }
1205 #endif
1206       cursor_in_echo_area = 1;
1207       message ("%s(y or n) ", XSTRING (xprompt)->data);
1208
1209       obj = read_filtered_event (1, 0, 0);
1210       cursor_in_echo_area = 0;
1211       /* If we need to quit, quit with cursor_in_echo_area = 0.  */
1212       QUIT;
1213
1214       key = Fmake_vector (make_number (1), obj);
1215       def = Flookup_key (map, key);
1216       answer_string = Fsingle_key_description (obj);
1217
1218       if (EQ (def, intern ("skip")))
1219         {
1220           answer = 0;
1221           break;
1222         }
1223       else if (EQ (def, intern ("act")))
1224         {
1225           answer = 1;
1226           break;
1227         }
1228       else if (EQ (def, intern ("recenter")))
1229         {
1230           Frecenter (Qnil);
1231           xprompt = prompt;
1232           continue;
1233         }
1234       else if (EQ (def, intern ("quit")))
1235         Vquit_flag = Qt;
1236       /* We want to exit this command for exit-prefix,
1237          and this is the only way to do it.  */
1238       else if (EQ (def, intern ("exit-prefix")))
1239         Vquit_flag = Qt;
1240
1241       QUIT;
1242
1243       /* If we don't clear this, then the next call to read_char will
1244          return quit_char again, and we'll enter an infinite loop.  */
1245       Vquit_flag = Qnil;
1246
1247       Fding (Qnil);
1248       Fdiscard_input ();
1249       if (EQ (xprompt, prompt))
1250         {
1251           args[0] = build_string ("Please answer y or n.  ");
1252           args[1] = prompt;
1253           xprompt = Fconcat (2, args);
1254         }
1255     }
1256   UNGCPRO;
1257
1258   if (! noninteractive)
1259     {
1260       cursor_in_echo_area = -1;
1261       message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
1262       cursor_in_echo_area = ocech;
1263     }
1264
1265   return answer ? Qt : Qnil;
1266 }
1267 \f
1268 /* This is how C code calls `yes-or-no-p' and allows the user
1269    to redefined it.
1270
1271    Anything that calls this function must protect from GC!  */
1272
1273 Lisp_Object
1274 do_yes_or_no_p (prompt)
1275      Lisp_Object prompt;
1276 {
1277   return call1 (intern ("yes-or-no-p"), prompt);
1278 }
1279
1280 /* Anything that calls this function must protect from GC!  */
1281
1282 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
1283   "Ask user a yes-or-no question.  Return t if answer is yes.\n\
1284 Takes one argument, which is the string to display to ask the question.\n\
1285 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
1286 The user must confirm the answer with RET,\n\
1287 and can edit it until it as been confirmed.")
1288   (prompt)
1289      Lisp_Object prompt;
1290 {
1291   register Lisp_Object ans;
1292   Lisp_Object args[2];
1293   struct gcpro gcpro1;
1294   Lisp_Object menu;
1295
1296   CHECK_STRING (prompt, 0);
1297
1298 #ifdef HAVE_X_MENU
1299   if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1300       && using_x_p ())
1301     {
1302       Lisp_Object pane, menu, obj;
1303       redisplay_preserve_echo_area ();
1304       pane = Fcons (Fcons (build_string ("Yes"), Qt),
1305                     Fcons (Fcons (build_string ("No"), Qnil),
1306                            Qnil));
1307       GCPRO1 (pane);
1308       menu = Fcons (prompt, pane);
1309       obj = Fx_popup_dialog (Qt, menu);
1310       UNGCPRO;
1311       return obj;
1312     }
1313 #endif
1314
1315   args[0] = prompt;
1316   args[1] = build_string ("(yes or no) ");
1317   prompt = Fconcat (2, args);
1318
1319   GCPRO1 (prompt);
1320
1321   while (1)
1322     {
1323       ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
1324                                               Qyes_or_no_p_history));
1325       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
1326         {
1327           UNGCPRO;
1328           return Qt;
1329         }
1330       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
1331         {
1332           UNGCPRO;
1333           return Qnil;
1334         }
1335
1336       Fding (Qnil);
1337       Fdiscard_input ();
1338       message ("Please answer yes or no.");
1339       Fsleep_for (make_number (2), Qnil);
1340     }
1341 }
1342 \f
1343 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
1344   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
1345 Each of the three load averages is multiplied by 100,\n\
1346 then converted to integer.\n\
1347 If the 5-minute or 15-minute load averages are not available, return a\n\
1348 shortened list, containing only those averages which are available.")
1349   ()
1350 {
1351   double load_ave[3];
1352   int loads = getloadavg (load_ave, 3);
1353   Lisp_Object ret;
1354
1355   if (loads < 0)
1356     error ("load-average not implemented for this operating system");
1357
1358   ret = Qnil;
1359   while (loads > 0)
1360     ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
1361
1362   return ret;
1363 }
1364 \f
1365 Lisp_Object Vfeatures;
1366
1367 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
1368   "Returns t if FEATURE is present in this Emacs.\n\
1369 Use this to conditionalize execution of lisp code based on the presence or\n\
1370 absence of emacs or environment extensions.\n\
1371 Use `provide' to declare that a feature is available.\n\
1372 This function looks at the value of the variable `features'.")
1373      (feature)
1374      Lisp_Object feature;
1375 {
1376   register Lisp_Object tem;
1377   CHECK_SYMBOL (feature, 0);
1378   tem = Fmemq (feature, Vfeatures);
1379   return (NILP (tem)) ? Qnil : Qt;
1380 }
1381
1382 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
1383   "Announce that FEATURE is a feature of the current Emacs.")
1384      (feature)
1385      Lisp_Object feature;
1386 {
1387   register Lisp_Object tem;
1388   CHECK_SYMBOL (feature, 0);
1389   if (!NILP (Vautoload_queue))
1390     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
1391   tem = Fmemq (feature, Vfeatures);
1392   if (NILP (tem))
1393     Vfeatures = Fcons (feature, Vfeatures);
1394   LOADHIST_ATTACH (Fcons (Qprovide, feature));
1395   return feature;
1396 }
1397
1398 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
1399   "If feature FEATURE is not loaded, load it from FILENAME.\n\
1400 If FEATURE is not a member of the list `features', then the feature\n\
1401 is not loaded; so load the file FILENAME.\n\
1402 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
1403      (feature, file_name)
1404      Lisp_Object feature, file_name;
1405 {
1406   register Lisp_Object tem;
1407   CHECK_SYMBOL (feature, 0);
1408   tem = Fmemq (feature, Vfeatures);
1409   LOADHIST_ATTACH (Fcons (Qrequire, feature));
1410   if (NILP (tem))
1411     {
1412       int count = specpdl_ptr - specpdl;
1413
1414       /* Value saved here is to be restored into Vautoload_queue */
1415       record_unwind_protect (un_autoload, Vautoload_queue);
1416       Vautoload_queue = Qt;
1417
1418       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
1419              Qnil, Qt, Qnil);
1420
1421       tem = Fmemq (feature, Vfeatures);
1422       if (NILP (tem))
1423         error ("Required feature %s was not provided",
1424                XSYMBOL (feature)->name->data );
1425
1426       /* Once loading finishes, don't undo it.  */
1427       Vautoload_queue = Qt;
1428       feature = unbind_to (count, feature);
1429     }
1430   return feature;
1431 }
1432 \f
1433 syms_of_fns ()
1434 {
1435   Qstring_lessp = intern ("string-lessp");
1436   staticpro (&Qstring_lessp);
1437   Qprovide = intern ("provide");
1438   staticpro (&Qprovide);
1439   Qrequire = intern ("require");
1440   staticpro (&Qrequire);
1441   Qyes_or_no_p_history = intern ("yes-or-no-p-history");
1442   staticpro (&Qyes_or_no_p_history);
1443
1444   DEFVAR_LISP ("features", &Vfeatures,
1445     "A list of symbols which are the features of the executing emacs.\n\
1446 Used by `featurep' and `require', and altered by `provide'.");
1447   Vfeatures = Qnil;
1448
1449   defsubr (&Sidentity);
1450   defsubr (&Srandom);
1451   defsubr (&Slength);
1452   defsubr (&Sstring_equal);
1453   defsubr (&Sstring_lessp);
1454   defsubr (&Sappend);
1455   defsubr (&Sconcat);
1456   defsubr (&Svconcat);
1457   defsubr (&Scopy_sequence);
1458   defsubr (&Scopy_alist);
1459   defsubr (&Ssubstring);
1460   defsubr (&Snthcdr);
1461   defsubr (&Snth);
1462   defsubr (&Selt);
1463   defsubr (&Smember);
1464   defsubr (&Smemq);
1465   defsubr (&Sassq);
1466   defsubr (&Sassoc);
1467   defsubr (&Srassq);
1468   defsubr (&Sdelq);
1469   defsubr (&Sdelete);
1470   defsubr (&Snreverse);
1471   defsubr (&Sreverse);
1472   defsubr (&Ssort);
1473   defsubr (&Sget);
1474   defsubr (&Sput);
1475   defsubr (&Sequal);
1476   defsubr (&Sfillarray);
1477   defsubr (&Snconc);
1478   defsubr (&Smapcar);
1479   defsubr (&Smapconcat);
1480   defsubr (&Sy_or_n_p);
1481   defsubr (&Syes_or_no_p);
1482   defsubr (&Sload_average);
1483   defsubr (&Sfeaturep);
1484   defsubr (&Srequire);
1485   defsubr (&Sprovide);
1486 }