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