home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / fns.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-03-29  |  46.2 KB  |  1,924 lines
  1. /* Random utility Lisp functions.
  2.    Copyright (C) 1985, 1986, 1987, 1992, 1993 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. #ifdef LOAD_AVE_TYPE
  24. #ifdef BSD
  25. /* It appears param.h defines BSD and BSD4_3 in 4.3
  26.    and is not considerate enough to avoid bombing out
  27.    if they are already defined.  */
  28. #undef BSD
  29. #ifdef BSD4_3
  30. #undef BSD4_3
  31. #define XBSD4_3 /* XBSD4_3 says BSD4_3 is supposed to be defined.  */
  32. #endif
  33. #include <sys/param.h>
  34. /* Now if BSD or BSD4_3 was defined and is no longer,
  35.    define it again.  */
  36. #ifndef BSD
  37. #define BSD
  38. #endif
  39. #ifdef XBSD4_3
  40. #ifndef BSD4_3
  41. #define BSD4_3
  42. #endif
  43. #endif /* XBSD4_3 */
  44. #endif /* BSD */
  45. #ifndef VMS
  46. #ifndef NLIST_STRUCT
  47. #include <a.out.h> 
  48. #else /* NLIST_STRUCT */
  49. #include <nlist.h>
  50. #endif /* NLIST_STRUCT */
  51. #endif /* not VMS */
  52. #endif /* LOAD_AVE_TYPE */
  53.  
  54. #ifdef HAVE_HPUX_PSTAT
  55. #include <sys/pstat.h>
  56. #endif /* HAVE_HPUX_PSTAT */
  57.  
  58. /* Note on some machines this defines `vector' as a typedef,
  59.    so make sure we don't use that name in this file.  */
  60. #undef vector
  61. #define vector *****
  62.  
  63. #include "lisp.h"
  64. #include "commands.h"
  65.  
  66. #include "buffer.h"
  67. #include "extents.h"
  68. #ifdef MULTI_SCREEN
  69. #include "screen.h"
  70. #endif
  71.  
  72. #include "events.h"
  73.  
  74. /* Convert 32 bit items <-> (<high16> . <low16>) */
  75.  
  76. Lisp_Object
  77. word_to_lisp (unsigned int item)
  78. {
  79.   return Fcons (make_number (item >> 16), make_number (item & 0xffff));
  80. }
  81.  
  82. unsigned int
  83. lisp_to_word (Lisp_Object obj)
  84. {
  85.   Lisp_Object high;
  86.   Lisp_Object low;
  87.   if ((obj == Qnil) || (!CONSP (obj))) return 0;
  88.   
  89.   high = XCONS (obj)->car;
  90.   if (!FIXNUMP (high)) return 0;
  91.   
  92.   low = XCONS (obj)->cdr; 
  93.   if (!FIXNUMP (low)) return 0;
  94.   
  95.   return (XUINT (high) << 16) | (XUINT (low));
  96. }
  97.  
  98. #ifdef NEED_STRDUP
  99. char *
  100. strdup (s)
  101.      char *s;
  102. {
  103.     char *result = (char *) xmalloc (strlen (s) + 1);
  104.     if (result == (char *) 0)
  105.       return (char *) 0;
  106.     strcpy (result, s);
  107.     return result;
  108. }
  109. #endif
  110.  
  111.  
  112. /* Lucid sound change */
  113. Lisp_Object Vbell_volume;
  114.  
  115. Lisp_Object Qstring_lessp;
  116. Lisp_Object Qyes_or_no_p;
  117.  
  118. DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
  119.   "Return the argument unchanged.")
  120.   (arg)
  121.      Lisp_Object arg;
  122. {
  123.   return arg;
  124. }
  125.  
  126. extern int random ();
  127. extern void srandom ();
  128.  
  129. DEFUN ("random", Frandom, Srandom, 0, 1, 0,
  130.   "Return a pseudo-random number.\n\
  131. On most systems all integers representable in Lisp are equally likely.\n\
  132.   This is 24 bits' worth.\n\
  133. With argument N, return random number in interval [0,N).\n\
  134. With argument t, set the random number seed from the current time and pid.")
  135.   (arg)
  136.      Lisp_Object arg;
  137. {
  138.   int val;
  139.  
  140.   if (EQ (arg, Qt))
  141.     srandom (getpid () + time (0));
  142.   val = random ();
  143.   if (FIXNUMP (arg) && XINT (arg) != 0)
  144.     {
  145.       /* Try to take our random number from the higher bits of VAL,
  146.      not the lower, since (says Gentzel) the low bits of `random'
  147.      are less random than the higher ones.  */
  148.       val &= 0xfffffff;        /* Ensure positive.  */
  149.       val >>= 5;
  150.       if (XINT (arg) < 10000)
  151.     val >>= 6;
  152.       val %= XINT (arg);
  153.     }
  154.   return make_number (val);
  155. }
  156.  
  157. /* Random data-structure functions */
  158.  
  159. DEFUN ("length", Flength, Slength, 1, 1, 0,
  160.   "Return the length of vector, list or string SEQUENCE.\n\
  161. A byte-code function object is also allowed.")
  162.   (obj)
  163.      register Lisp_Object obj;
  164. {
  165.   register Lisp_Object tail, val;
  166.   register int i;
  167.  
  168.  retry:
  169.   if (VECTORP (obj) || STRINGP (obj)
  170.       || COMPILEDP (obj))
  171.     return Farray_length (obj);
  172.   else if (CONSP (obj))
  173.     {
  174.       for (i = 0, tail = obj; !NILP(tail); i++)
  175.     {
  176.       QUIT;
  177.       tail = Fcdr (tail);
  178.     }
  179.  
  180.       XFASTINT (val) = i;
  181.       return val;
  182.     }
  183.   else if (NILP(obj))
  184.     {
  185.       XFASTINT (val) = 0;
  186.       return val;
  187.     }
  188.   else
  189.     {
  190.       obj = wrong_type_argument (Qsequencep, obj);
  191.       goto retry;
  192.     }
  193. }
  194.  
  195. DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
  196.   "T if two strings have identical contents.\n\
  197. Case is significant.\n\
  198. Symbols are also allowed; their print names are used instead.")
  199.   (s1, s2)
  200.      register Lisp_Object s1, s2;
  201. {
  202.   if (SYMBOLP (s1))
  203.     XSET (s1, Lisp_String, XSYMBOL (s1)->name);
  204.   if (SYMBOLP (s2))
  205.     XSET (s2, Lisp_String, XSYMBOL (s2)->name);
  206.   CHECK_STRING (s1, 0);
  207.   CHECK_STRING (s2, 1);
  208.  
  209.   if (XSTRING (s1)->size != XSTRING (s2)->size ||
  210.       memcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
  211.     return Qnil;
  212.   return Qt;
  213. }
  214.  
  215. DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
  216.   "T if first arg string is less than second in lexicographic order.\n\
  217. Case is significant.\n\
  218. Symbols are also allowed; their print names are used instead.")
  219.   (s1, s2)
  220.      register Lisp_Object s1, s2;
  221. {
  222.   register int i;
  223.   register unsigned char *p1, *p2;
  224.   register int end;
  225.  
  226.   if (SYMBOLP (s1))
  227.     XSET (s1, Lisp_String, XSYMBOL (s1)->name);
  228.   if (SYMBOLP (s2))
  229.     XSET (s2, Lisp_String, XSYMBOL (s2)->name);
  230.   CHECK_STRING (s1, 0);
  231.   CHECK_STRING (s2, 1);
  232.  
  233.   p1 = XSTRING (s1)->data;
  234.   p2 = XSTRING (s2)->data;
  235.   end = XSTRING (s1)->size;
  236.   if (end > XSTRING (s2)->size)
  237.     end = XSTRING (s2)->size;
  238.  
  239.   for (i = 0; i < end; i++)
  240.     {
  241.       if (p1[i] != p2[i])
  242.     return p1[i] < p2[i] ? Qt : Qnil;
  243.     }
  244.   return i < XSTRING (s2)->size ? Qt : Qnil;
  245. }
  246.  
  247. static Lisp_Object concat ();
  248.  
  249. /* ARGSUSED */
  250. Lisp_Object
  251. concat2 (s1, s2)
  252.      Lisp_Object s1, s2;
  253. {
  254. #ifdef NO_ARG_ARRAY
  255.   Lisp_Object args[2];
  256.   args[0] = s1;
  257.   args[1] = s2;
  258.   return concat (2, args, Lisp_String, 0);
  259. #else
  260.   return concat (2, &s1, Lisp_String, 0);
  261. #endif /* NO_ARG_ARRAY */
  262. }
  263.  
  264. DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
  265.   "Concatenate all the arguments and make the result a list.\n\
  266. The result is a list whose elements are the elements of all the arguments.\n\
  267. Each argument may be a list, vector or string.\n\
  268. The last argument is not copied if it is a list.")
  269.   (nargs, args)
  270.      int nargs;
  271.      Lisp_Object *args;
  272. {
  273.   return concat (nargs, args, Lisp_Cons, 1);
  274. }
  275.  
  276. DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
  277.   "Concatenate all the arguments and make the result a string.\n\
  278. The result is a string whose elements are the elements of all the arguments.\n\
  279. Each argument may be a string, a list of numbers, or a vector of numbers.")
  280.   (nargs, args)
  281.      int nargs;
  282.      Lisp_Object *args;
  283. {
  284.   return concat (nargs, args, Lisp_String, 0);
  285. }
  286.  
  287. DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
  288.   "Concatenate all the arguments and make the result a vector.\n\
  289. The result is a vector whose elements are the elements of all the arguments.\n\
  290. Each argument may be a list, vector or string.")
  291.   (nargs, args)
  292.      int nargs;
  293.      Lisp_Object *args;
  294. {
  295.   return concat (nargs, args, Lisp_Vector, 0);
  296. }
  297.  
  298. DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
  299.   "Return a copy of a list, vector or string.\n\
  300. The elements of a list or vector are not copied; they are shared\n\
  301. with the original.")
  302.   (arg)
  303.      Lisp_Object arg;
  304. {
  305.   if (NILP (arg)) return arg;
  306.   if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
  307.     arg = wrong_type_argument (Qsequencep, arg);
  308.   /* We handle conses seperately because concat() is big and hairy and
  309.      doesn't handle (copy-sequence '(a b . c)) and it's easier to redo this
  310.      than to fix concat() without worrying about breaking other things.
  311.    */
  312.   if (CONSP (arg))
  313.     {
  314.       Lisp_Object rest = arg;
  315.       Lisp_Object head, tail;
  316.       tail = Qnil;
  317.       while (CONSP (rest))
  318.     {
  319.       Lisp_Object new = Fcons (XCONS (rest)->car, XCONS (rest)->cdr);
  320.       if (NILP (tail))
  321.         head = tail = new;
  322.       else
  323.         XCONS (tail)->cdr = new, tail = new;
  324.       rest = XCONS (rest)->cdr;
  325.       QUIT;
  326.     }
  327.       if (!NILP (tail))
  328.     XCONS (tail)->cdr = rest;
  329.       return head;
  330.     }
  331.   else
  332.     return concat (1, &arg, XTYPE (arg), 0);
  333. }
  334.  
  335. static Lisp_Object
  336. concat (nargs, args, target_type, last_special)
  337.      int nargs;
  338.      Lisp_Object *args;
  339.      enum Lisp_Type target_type;
  340.      int last_special;
  341. {
  342.   Lisp_Object val;
  343.   Lisp_Object len;
  344.   register Lisp_Object tail;
  345.   register Lisp_Object this;
  346.   int toindex;
  347.   register int leni;
  348.   register int argnum;
  349.   Lisp_Object last_tail;
  350.   Lisp_Object prev;
  351.   int mr_structs_size = nargs * sizeof (struct merge_replicas_struct);
  352.   struct merge_replicas_struct *args_mr_structs = 
  353.     (struct merge_replicas_struct *) alloca (mr_structs_size);
  354.  
  355.   memset ((char *) args_mr_structs, 0, mr_structs_size);
  356.  
  357.   /* In append, the last arg isn't treated like the others */
  358.   if (last_special && nargs > 0)
  359.     {
  360.       nargs--;
  361.       last_tail = args[nargs];
  362.     }
  363.   else
  364.     last_tail = Qnil;
  365.  
  366.   /* Check and coerce the arguments. */
  367.   for (argnum = 0; argnum < nargs; argnum++)
  368.     {
  369.       this = args[argnum];
  370.       if (!(CONSP (this) || NILP (this)
  371.         || VECTORP (this) || STRINGP (this)
  372.         || COMPILEDP (this)))
  373.     {
  374.       if (FIXNUMP (this))
  375.             args[argnum] = Fint_to_string (this);
  376.       else
  377.         args[argnum] = wrong_type_argument (Qsequencep, this);
  378.     }
  379.       
  380.       if (STRINGP (this))
  381.         args_mr_structs[argnum].dup_list = XSTRING (this)->dup_list;
  382.       else
  383.         args_mr_structs[argnum].dup_list = Qnil;
  384.     }
  385.  
  386.   for (argnum = 0, leni = 0; argnum < nargs; argnum++)
  387.     {
  388.       this = args[argnum];
  389.       len = Flength (this);
  390.       args_mr_structs[argnum].entry_offset = leni;
  391.       args_mr_structs[argnum].entry_length = XFASTINT (len);
  392.       leni += XFASTINT (len);
  393.     }
  394.   XFASTINT (len) = leni;
  395.  
  396.   if (target_type == Lisp_Cons)
  397.     val = Fmake_list (len, Qnil);
  398.   else if (target_type == Lisp_Vector)
  399.     val = Fmake_vector (len, Qnil);
  400.   else
  401.     {
  402.       val = Fmake_string (len, len);
  403.       XSTRING(val)->dup_list = merge_replicas (nargs, args_mr_structs);
  404.     }
  405.  
  406.   /* In append, if all but last arg are nil, return last arg */
  407.   if (target_type == Lisp_Cons && EQ (val, Qnil))
  408.     return last_tail;
  409.  
  410.   if (CONSP (val))
  411.     tail = val, toindex = -1;    /* -1 in toindex is flag we are
  412.                     making a list */
  413.   else
  414.     toindex = 0;
  415.  
  416.   prev = Qnil;
  417.  
  418.   for (argnum = 0; argnum < nargs; argnum++)
  419.     {
  420.       Lisp_Object thislen;
  421.       int thisleni;
  422.       register int thisindex = 0;
  423.  
  424.       this = args[argnum];
  425.       if (!CONSP (this))
  426.     {
  427.       thislen = Flength (this);
  428.       thisleni = XINT (thislen);
  429.     }
  430.  
  431.       while (1)
  432.     {
  433.       register Lisp_Object elt;
  434.  
  435.       /* We've come to the end of this arg, so exit. */
  436.       if (NILP (this))
  437.         break;
  438.  
  439.       /* Fetch next element of `this' arg into `elt' */
  440.       if (CONSP (this))
  441.         elt = Fcar (this), this = Fcdr (this);
  442.       else
  443.         {
  444.           if (thisindex >= thisleni)
  445.         break;
  446.  
  447.           if (STRINGP (this))
  448.         XFASTINT (elt) = XSTRING (this)->data[thisindex++];
  449.           else
  450.         elt = XVECTOR (this)->contents[thisindex++];
  451.         }
  452.  
  453.       /* Store into result */
  454.       if (toindex < 0)
  455.         {
  456.           /* toindex negative means we are making a list */
  457.           XCONS (tail)->car = elt;
  458.           prev = tail;
  459.           tail = XCONS (tail)->cdr;
  460.         }
  461.       else if (VECTORP (val))
  462.         XVECTOR (val)->contents[toindex++] = elt;
  463.       else
  464.         {
  465.           while (!FIXNUMP (elt))
  466.         elt = wrong_type_argument (Qintegerp, elt);
  467.  
  468.           {
  469. #ifdef MASSC_REGISTER_BUG
  470.         /* Even removing all "register"s doesn't disable this bug!
  471.            Nothing simpler than this seems to work. */
  472.         unsigned char *p = & XSTRING (val)->data[toindex++];
  473.         *p = XINT (elt);
  474. #else
  475.         XSTRING (val)->data[toindex++] = XINT (elt);
  476. #endif
  477.           }
  478.         }
  479.     }
  480.     }
  481.  
  482.   if (!NILP (prev))
  483.     XCONS (prev)->cdr = last_tail;
  484.  
  485.   return val;  
  486. }
  487.  
  488. DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
  489.   "Return a copy of ALIST.\n\
  490. This is an alist which represents the same mapping from objects to objects,\n\
  491. but does not share the alist structure with ALIST.\n\
  492. The objects mapped (cars and cdrs of elements of the alist)\n\
  493. are shared, however.")
  494.   (alist)
  495.      Lisp_Object alist;
  496. {
  497.   register Lisp_Object tem;
  498.  
  499.   CHECK_LIST (alist, 0);
  500.   if (NILP (alist))
  501.     return alist;
  502.   alist = concat (1, &alist, Lisp_Cons, 0);
  503.   for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
  504.     {
  505.       register Lisp_Object car;
  506.       car = XCONS (tem)->car;
  507.  
  508.       if (CONSP (car))
  509.     XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
  510.     }
  511.   return alist;
  512. }
  513.  
  514.  
  515. DEFUN ("copy-tree", Fcopy_tree, Scopy_tree, 1, 1, 0,
  516.   "Return a copy of a list or vector, and substructures.\n\
  517. The argument is copied, and any lists or vectors contained within it\n\
  518. are copied recursively.  Circularities and shared substructures are\n\
  519. not preserved.  Strings are not copied.")
  520.    (arg)
  521.      Lisp_Object arg;
  522. {
  523.   arg = Fcopy_sequence (arg);
  524.   if (CONSP (arg))
  525.     {
  526.       Lisp_Object rest = arg;
  527.       while (CONSP (rest))
  528.     {
  529.       Lisp_Object elt = XCONS (rest)->car;
  530.       QUIT;
  531.       if (CONSP (elt) || VECTORP (elt))
  532.         XCONS (rest)->car = Fcopy_tree (elt);
  533.       if (VECTORP (XCONS (rest)->cdr)) /* hack for (a b . [c d]) */
  534.         XCONS (rest)->cdr = Fcopy_tree (XCONS (rest)->cdr);
  535.       rest = XCONS (rest)->cdr;
  536.     }
  537.     }
  538.   else if (VECTORP (arg))
  539.     {
  540.       int i = XVECTOR (arg)->size;
  541.       int j;
  542.       for (j = 0; j < i; j++)
  543.     {
  544.       Lisp_Object elt = XVECTOR (arg)->contents [j];
  545.       QUIT;
  546.       if (CONSP (elt) || VECTORP (elt))
  547.         XVECTOR (arg)->contents [j] = Fcopy_tree (elt);
  548.     }
  549.     }
  550.   return arg;
  551. }
  552.  
  553.  
  554. DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
  555.   "Return a substring of STRING, starting at index FROM and ending before TO.\n\
  556. TO may be nil or omitted; then the substring runs to the end of STRING.\n\
  557. If FROM or TO is negative, it counts from the end.")
  558.   (string, from, to)
  559.      Lisp_Object string;
  560.      register Lisp_Object from, to;
  561. {
  562.   CHECK_STRING (string, 0);
  563.   CHECK_FIXNUM (from, 1);
  564.   if (NILP (to))
  565.     to = Flength (string);
  566.   else
  567.     CHECK_FIXNUM (to, 2);
  568.  
  569.   if (XINT (from) < 0)
  570.     XSETINT (from, XINT (from) + XSTRING (string)->size);
  571.   if (XINT (to) < 0)
  572.     XSETINT (to, XINT (to) + XSTRING (string)->size);
  573.   if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
  574.         && XINT (to) <= XSTRING (string)->size))
  575.     args_out_of_range_3 (string, from, to);
  576.  
  577.   return make_string ((char *) XSTRING (string)->data + XINT (from),
  578.               XINT (to) - XINT (from));
  579. }
  580.  
  581. DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
  582.   "Take cdr N times on LIST, returns the result.")
  583.   (n, list)
  584.      Lisp_Object n;
  585.      register Lisp_Object list;
  586. {
  587.   register int i, num;
  588.   CHECK_FIXNUM (n, 0);
  589.   num = XINT (n);
  590.   for (i = 0; i < num && ! NILP (list); i++)
  591.     {
  592.       QUIT;
  593.       list = Fcdr (list);
  594.     }
  595.   return list;
  596. }
  597.  
  598. DEFUN ("nth", Fnth, Snth, 2, 2, 0,
  599.   "Return the Nth element of LIST.\n\
  600. N counts from zero.  If LIST is not that long, nil is returned.")
  601.   (n, list)
  602.      Lisp_Object n, list;
  603. {
  604.   return Fcar (Fnthcdr (n, list));
  605. }
  606.  
  607. DEFUN ("elt", Felt, Selt, 2, 2, 0,
  608.   "Return element of SEQUENCE at index N.")
  609.   (seq, n)
  610.      register Lisp_Object seq, n;
  611. {
  612.   CHECK_FIXNUM (n, 0);
  613.   while (1)
  614.     {
  615.       if (CONSP (seq) || NILP (seq))
  616.     return Fcar (Fnthcdr (n, seq));
  617.       else if (STRINGP (seq) ||
  618.            VECTORP (seq))
  619.     return Faref (seq, n);
  620.       else
  621.     seq = wrong_type_argument (Qsequencep, seq);
  622.     }
  623. }
  624.  
  625. DEFUN ("member", Fmember, Smember, 2, 2, 0,
  626.   "Return non-nil if ELT is an element of LIST.  Comparison done with EQUAL.\n\
  627. The value is actually the tail of LIST whose car is ELT.")
  628.   (elt, list)
  629.      register Lisp_Object elt;
  630.      Lisp_Object list;
  631. {
  632.   register Lisp_Object tail;
  633.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  634.     {
  635.       register Lisp_Object tem;
  636.       tem = Fcar (tail);
  637.       if (! NILP (Fequal (elt, tem)))
  638.     return tail;
  639.       QUIT;
  640.     }
  641.   return Qnil;
  642. }
  643.  
  644. DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
  645.   "Return non-nil if ELT is an element of LIST.  Comparison done with EQ.\n\
  646. The value is actually the tail of LIST whose car is ELT.")
  647.   (elt, list)
  648.      register Lisp_Object elt;
  649.      Lisp_Object list;
  650. {
  651.   register Lisp_Object tail;
  652.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  653.     {
  654.       register Lisp_Object tem;
  655.       tem = Fcar (tail);
  656.       if (EQ (elt, tem)) return tail;
  657.       QUIT;
  658.     }
  659.   return Qnil;
  660. }
  661.  
  662. Lisp_Object
  663. memq_no_quit (elt, list)
  664.      register Lisp_Object elt;
  665.      Lisp_Object list;
  666. {
  667.   register Lisp_Object tail;
  668.   for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
  669.     {
  670.       register Lisp_Object tem;
  671.       tem = XCONS (tail)->car;
  672.       if (EQ (elt, tem)) return tail;
  673.     }
  674.   return Qnil;
  675. }
  676.  
  677. DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
  678.   "Return non-nil if ELT is `eq' to the car of an element of LIST.\n\
  679. The value is actually the element of LIST whose car is ELT.")
  680.   (key, list)
  681.      register Lisp_Object key;
  682.      Lisp_Object list;
  683. {
  684.   register Lisp_Object tail;
  685.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  686.     {
  687.       register Lisp_Object elt, tem;
  688.       elt = Fcar (tail);
  689.       if (!CONSP (elt)) continue;
  690.       tem = Fcar (elt);
  691.       if (EQ (key, tem)) return elt;
  692.       QUIT;
  693.     }
  694.   return Qnil;
  695. }
  696.  
  697. /* Like Fassq but never report an error and do not allow quits.
  698.    Use only on lists known never to be circular.  */
  699.  
  700. Lisp_Object
  701. assq_no_quit (key, list)
  702.      register Lisp_Object key;
  703.      Lisp_Object list;
  704. {
  705.   register Lisp_Object tail;
  706.   for (tail = list; CONSP (tail); tail = Fcdr (tail))
  707.     {
  708.       register Lisp_Object elt, tem;
  709.       elt = Fcar (tail);
  710.       if (!CONSP (elt)) continue;
  711.       tem = Fcar (elt);
  712.       if (EQ (key, tem)) return elt;
  713.     }
  714.   return Qnil;
  715. }
  716.  
  717. DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
  718.   "Return non-nil if ELT is `equal' to the car of an element of LIST.\n\
  719. The value is actually the element of LIST whose car is ELT.")
  720.   (key, list)
  721.      register Lisp_Object key;
  722.      Lisp_Object list;
  723. {
  724.   register Lisp_Object tail;
  725.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  726.     {
  727.       register Lisp_Object elt, tem;
  728.       elt = Fcar (tail);
  729.       if (!CONSP (elt)) continue;
  730.       tem = Fequal (Fcar (elt), key);
  731.       if (!NILP (tem)) return elt;
  732.       QUIT;
  733.     }
  734.   return Qnil;
  735. }
  736.  
  737. Lisp_Object
  738. assoc_no_quit (key, list)
  739.      register Lisp_Object key;
  740.      Lisp_Object list;
  741. {
  742.   Lisp_Object result;
  743.   Lisp_Object oinhibit = Vinhibit_quit;
  744.   Vinhibit_quit = Qt;
  745.   result = Fassoc (key, list);
  746.   Vinhibit_quit = oinhibit;
  747.   return result;
  748. }
  749.  
  750. DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
  751.   "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
  752. The value is actually the element of LIST whose cdr is ELT.")
  753.   (key, list)
  754.      register Lisp_Object key;
  755.      Lisp_Object list;
  756. {
  757.   register Lisp_Object tail;
  758.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  759.     {
  760.       register Lisp_Object elt, tem;
  761.       elt = Fcar (tail);
  762.       if (!CONSP (elt)) continue;
  763.       tem = Fcdr (elt);
  764.       if (EQ (key, tem)) return elt;
  765.       QUIT;
  766.     }
  767.   return Qnil;
  768. }
  769.  
  770. Lisp_Object
  771. rassq_no_quit (key, list)
  772.      register Lisp_Object key;
  773.      Lisp_Object list;
  774. {
  775.   register Lisp_Object tail;
  776.   for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
  777.     {
  778.       register Lisp_Object elt, tem;
  779.       elt = XCONS (tail)->car;
  780.       if (!CONSP (elt)) continue;
  781.       tem = XCONS (elt)->cdr;
  782.       if (EQ (key, tem)) return elt;
  783.     }
  784.   return Qnil;
  785. }
  786.  
  787.  
  788. DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
  789.   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
  790. The modified LIST is returned.  Comparison is done with `eq'.\n\
  791. If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
  792. therefore, write `(setq foo (delq element foo))'\n\
  793. to be sure of changing the value of `foo'.")
  794.   (elt, list)
  795.      register Lisp_Object elt;
  796.      Lisp_Object list;
  797. {
  798.   register Lisp_Object tail, prev;
  799.   register Lisp_Object tem;
  800.  
  801.   tail = list;
  802.   prev = Qnil;
  803.   while (!NILP (tail))
  804.     {
  805.       tem = Fcar (tail);
  806.       if (EQ (elt, tem))
  807.     {
  808.       if (NILP (prev))
  809.         list = Fcdr (tail);
  810.       else
  811.         Fsetcdr (prev, Fcdr (tail));
  812.     }
  813.       else
  814.     prev = tail;
  815.       tail = Fcdr (tail);
  816.       QUIT;
  817.     }
  818.   return list;
  819. }
  820.  
  821.  
  822. Lisp_Object
  823. delq_no_quit (elt, list)        /* no quit, no errors; be careful */
  824.      register Lisp_Object elt, list;
  825. {
  826.   register Lisp_Object tail, prev;
  827.   register Lisp_Object tem;
  828.  
  829.   tail = list;
  830.   prev = Qnil;
  831.   while (CONSP (tail))
  832.     {
  833.       tem = XCONS (tail)->car;
  834.       if (EQ (elt, tem))
  835.     {
  836.       if (NILP (prev))
  837.         list = XCONS (tail)->cdr;
  838.       else
  839.         XCONS (prev)->cdr = XCONS (tail)->cdr;
  840.     }
  841.       else
  842.     prev = tail;
  843.       tail = XCONS (tail)->cdr;
  844.     }
  845.   return list;
  846. }
  847.  
  848. DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
  849.   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
  850. The modified LIST is returned.  Comparison is done with `equal'.\n\
  851. If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
  852. therefore, write `(setq foo (delete element foo))'\n\
  853. to be sure of changing the value of `foo'.")
  854.   (elt, list)
  855.      register Lisp_Object elt;
  856.      Lisp_Object list;
  857. {
  858.   register Lisp_Object tail, prev;
  859.   register Lisp_Object tem;
  860.  
  861.   tail = list;
  862.   prev = Qnil;
  863.   while (!NILP (tail))
  864.     {
  865.       tem = Fcar (tail);
  866.       tem = Fequal (elt, tem);
  867.       if (!NILP (tem))
  868.     {
  869.       if (NILP (prev))
  870.         list = Fcdr (tail);
  871.       else
  872.         Fsetcdr (prev, Fcdr (tail));
  873.     }
  874.       else
  875.     prev = tail;
  876.       tail = Fcdr (tail);
  877.       QUIT;
  878.     }
  879.   return list;
  880. }
  881.  
  882.  
  883. DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
  884.   "Reverse LIST by modifying cdr pointers.\n\
  885. Returns the beginning of the reversed list.")
  886.   (list)
  887.      Lisp_Object list;
  888. {
  889.   register Lisp_Object prev, tail, next;
  890.  
  891.   if (NILP (list)) return list;
  892.   prev = Qnil;
  893.   tail = list;
  894.   while (!NILP (tail))
  895.     {
  896.       QUIT;
  897.       next = Fcdr (tail);
  898.       Fsetcdr (tail, prev);
  899.       prev = tail;
  900.       tail = next;
  901.     }
  902.   return prev;
  903. }
  904.  
  905. DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
  906.   "Reverse LIST, copying.  Returns the beginning of the reversed list.\n\
  907. See also the function `nreverse', which is used more often.")
  908.   (list)
  909.      Lisp_Object list;
  910. {
  911.   Lisp_Object length;
  912.   register Lisp_Object *vec;
  913.   register Lisp_Object tail;
  914.   register int i;
  915.  
  916.   length = Flength (list);
  917.   vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
  918.   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
  919.     vec[i] = Fcar (tail);
  920.  
  921.   return Flist (XINT (length), vec);
  922. }
  923.  
  924. static Lisp_Object list_merge ();
  925.  
  926. Lisp_Object list_sort (list, lisp_arg, pred_fn)
  927.      Lisp_Object list, lisp_arg;
  928.      int (*pred_fn)();
  929. {
  930.   Lisp_Object front, back;
  931.   Lisp_Object len, tem;
  932.   struct gcpro gcpro1, gcpro2;
  933.   int length;
  934.  
  935.   front = list;
  936.   len = Flength (list);
  937.   length = XINT (len);
  938.   if (length < 2)
  939.     return list;
  940.  
  941.   XSETINT (len, (length / 2) - 1);
  942.   tem = Fnthcdr (len, list);
  943.   back = Fcdr (tem);
  944.   Fsetcdr (tem, Qnil);
  945.  
  946.   GCPRO2 (front, back);
  947.   front = list_sort (front, lisp_arg, pred_fn);
  948.   back = list_sort (back, lisp_arg, pred_fn);
  949.   UNGCPRO;
  950.   return list_merge (front, back, lisp_arg, pred_fn);
  951. }
  952.  
  953. extern Lisp_Object Qgc_currently_forbidden;
  954.  
  955. /* #### this is stupid and should be expunged */
  956. Lisp_Object
  957. safe_funcall_hook (Lisp_Object hook, int nargs, Lisp_Object arg1,
  958.            Lisp_Object arg2, Lisp_Object arg3)
  959. {
  960.   Lisp_Object result = Qnil;
  961.   int count = specpdl_depth;
  962.   specbind (Qgc_currently_forbidden, 1);
  963.  
  964.   if (!NILP (hook))
  965.     {
  966.       switch (nargs)
  967.     {
  968.     case 0: result = call0 (hook); break;
  969.     case 1: result = call1 (hook, arg1); break;
  970.     case 2: result = call2 (hook, arg1, arg2); break;
  971.     case 3: result = call3 (hook, arg1, arg2, arg3); break;
  972.     }
  973.     }      
  974.   return unbind_to (count, result);
  975. }
  976.  
  977. void
  978. run_hooks_with_args (hook_var, args, nargs)
  979.      Lisp_Object hook_var, *args;
  980.      int nargs;
  981. {
  982.   Lisp_Object rest;
  983.   struct gcpro gcpro1;
  984.   if (NILP (Fboundp (hook_var)))
  985.     return;
  986.   rest = Fsymbol_value (hook_var);
  987.   if (NILP (rest))
  988.     return;
  989.   GCPRO1 (rest);
  990.   if (SYMBOLP (rest) || EQ (Qlambda, Fcar (rest)))
  991.     rest = list1 (rest);
  992.   while (!NILP (rest))
  993.     {
  994.       switch (nargs)
  995.     {
  996.     case 0: call0 (Fcar (rest)); break;
  997.     case 1: call1 (Fcar (rest), args[1]); break;
  998.     case 2: call2 (Fcar (rest), args[1], args[2]); break;
  999.     case 3: call3 (Fcar (rest), args[1], args[2], args[3]); break;
  1000.     case 4: call4 (Fcar (rest), args[1], args[2], args[3], args[4]); break;
  1001.       /* if we ever want more, we'll add the clauses... */
  1002.     default: error ("run_hooks_with_args called with too many args");
  1003.     }
  1004.       rest = Fcdr (rest);
  1005.     }
  1006.   UNGCPRO;
  1007. }
  1008.  
  1009.  
  1010. /* feel free to write the others as needed... */
  1011. void
  1012. run_hooks_1_arg (hook_var, arg)
  1013.      Lisp_Object hook_var, arg;
  1014. {
  1015.   run_hooks_with_args (hook_var, &arg, 1);
  1016. }
  1017.  
  1018.  
  1019. static Lisp_Object 
  1020. merge_pred_function (obj1, obj2, pred)
  1021.      Lisp_Object obj1, obj2, pred;
  1022. {
  1023.   Lisp_Object tmp = Qnil;
  1024.  
  1025.   /* prevents the GC from happening in call2 */
  1026.   int count = specpdl_depth;
  1027.   specbind (Qgc_currently_forbidden, 1);
  1028.   tmp = call2 (pred, obj1, obj2);
  1029.   unbind_to (count, Qnil);
  1030.  
  1031.   if (NILP (tmp)) 
  1032.     return -1;
  1033.   else
  1034.     return 1;
  1035. }
  1036.  
  1037. DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
  1038.   "Sort LIST, stably, comparing elements using PREDICATE.\n\
  1039. Returns the sorted list.  LIST is modified by side effects.\n\
  1040. PREDICATE is called with two elements of LIST, and should return T\n\
  1041. if the first element is \"less\" than the second.")
  1042.   (list, pred)
  1043.      Lisp_Object list, pred;
  1044. {
  1045.   return list_sort (list, pred, merge_pred_function);
  1046. }
  1047.  
  1048. Lisp_Object
  1049. merge (org_l1, org_l2, pred)
  1050.      Lisp_Object org_l1, org_l2, pred;
  1051. {
  1052.   return list_merge (org_l1, org_l2, pred, merge_pred_function);
  1053. }
  1054.  
  1055.  
  1056. static Lisp_Object
  1057. list_merge (org_l1, org_l2, lisp_arg, pred_fn)
  1058.      Lisp_Object org_l1, org_l2, lisp_arg;
  1059.      int (*pred_fn)();
  1060. {
  1061.   Lisp_Object value;
  1062.   register Lisp_Object tail;
  1063.   Lisp_Object tem;
  1064.   register Lisp_Object l1, l2;
  1065.   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
  1066.  
  1067.   l1 = org_l1;
  1068.   l2 = org_l2;
  1069.   tail = Qnil;
  1070.   value = Qnil;
  1071.  
  1072.   /* It is sufficient to protect org_l1 and org_l2.
  1073.      When l1 and l2 are updated, we copy the new values
  1074.      back into the org_ vars.  */
  1075.   
  1076.   GCPRO4 (org_l1, org_l2, lisp_arg, value);
  1077.  
  1078.   while (1)
  1079.     {
  1080.       if (NILP (l1))
  1081.     {
  1082.       UNGCPRO;
  1083.       if (NILP (tail))
  1084.         return l2;
  1085.       Fsetcdr (tail, l2);
  1086.       return value;
  1087.     }
  1088.       if (NILP (l2))
  1089.     {
  1090.       UNGCPRO;
  1091.       if (NILP (tail))
  1092.         return l1;
  1093.       Fsetcdr (tail, l1);
  1094.       return value;
  1095.     }
  1096.  
  1097.       if ((*pred_fn)(Fcar (l2), Fcar (l1), lisp_arg) < 0)
  1098.     {
  1099.       tem = l1;
  1100.       l1 = Fcdr (l1);
  1101.       org_l1 = l1;
  1102.     }
  1103.       else
  1104.     {
  1105.       tem = l2;
  1106.       l2 = Fcdr (l2);
  1107.       org_l2 = l2;
  1108.     }
  1109.       if (NILP (tail))
  1110.     value = tem;
  1111.       else
  1112.     Fsetcdr (tail, tem);
  1113.       tail = tem;
  1114.     }
  1115. }
  1116.  
  1117.  
  1118. DEFUN ("get", Fget, Sget, 2, 2, 0,
  1119.   "Return the value of SYMBOL's PROPNAME property.\n\
  1120. This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
  1121.   (sym, prop)
  1122.      Lisp_Object sym;
  1123.      register Lisp_Object prop;
  1124. {
  1125.   register Lisp_Object tail;
  1126.  
  1127.   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
  1128.     if (EQ (prop, Fcar (tail)))
  1129.       return Fcar (Fcdr (tail));
  1130.  
  1131.   return Qnil;
  1132. }
  1133.  
  1134. DEFUN ("put", Fput, Sput, 3, 3, 0,
  1135.   "Store SYMBOL's PROPNAME property with value VALUE.\n\
  1136. It can be retrieved with `(get SYMBOL PROPNAME)'.")
  1137.   (sym, prop, val)
  1138.      Lisp_Object sym;
  1139.      register Lisp_Object prop;
  1140.      Lisp_Object val;
  1141. {
  1142.   register Lisp_Object tail;
  1143.   Lisp_Object head = Fsymbol_plist (sym);
  1144.  
  1145.   for (tail = head; !NILP (tail); tail = Fcdr (Fcdr (tail)))
  1146.     if (EQ (prop, Fcar (tail)))
  1147.       return Fsetcar (Fcdr (tail), val);
  1148.  
  1149.   Fsetplist (sym, Fcons (prop, Fcons (val, head)));
  1150.   return val;
  1151. }
  1152.  
  1153. DEFUN ("remprop", Fremprop, Sremprop, 2, 2, 0,
  1154.   "Remove from SYMBOL's plist the property PROP and its value.")
  1155.   (symbol, property)
  1156.      Lisp_Object symbol, property;
  1157. {
  1158.   register Lisp_Object tail;
  1159.   register Lisp_Object obj;
  1160.   register Lisp_Object prev;
  1161.   register unsigned char changed = 0;
  1162.  
  1163.   CHECK_SYMBOL (symbol, 0);
  1164.   tail = XSYMBOL (symbol)->plist;
  1165.  
  1166.   obj = Fcar (tail);
  1167.   while (!NILP (obj) && EQ (property, obj))
  1168.     {
  1169.       changed = 1;
  1170.       tail = Fcdr (Fcdr (tail));
  1171.       obj = Fcar (tail);
  1172.     }
  1173.   XSYMBOL (symbol)->plist = tail;
  1174.   
  1175.   prev = tail;
  1176.   tail = Fcdr (Fcdr (tail));
  1177.   while (!NILP (tail))
  1178.     {
  1179.       obj = Fcar (tail);
  1180.       if (EQ (property, obj))
  1181.     {
  1182.       changed = 1;
  1183.           Fsetcdr (Fcdr (prev), (Fcdr (Fcdr (tail))));
  1184.     }
  1185.       prev = tail;
  1186.       tail = Fcdr (Fcdr (tail));
  1187.     }
  1188.  
  1189.   return changed ? Qt : Qnil;
  1190. }
  1191.  
  1192.  
  1193. /* Same as the Common Lisp function GETF.  Never errors,
  1194.    returns nil when there is no match. */
  1195. Lisp_Object
  1196. getf (plist, indicator)
  1197.      Lisp_Object plist, indicator;
  1198. {
  1199.   Lisp_Object tail = plist;
  1200.  
  1201.   while (CONSP (tail))
  1202.     {
  1203.       struct Lisp_Cons *untagged_tail = XCONS (tail);
  1204.       
  1205.       tail = untagged_tail->cdr;
  1206.       if (EQ (untagged_tail->car, indicator))
  1207.     {
  1208.       if (CONSP (tail))
  1209.         return XCONS (tail)->car;
  1210.       else
  1211.         return Qnil;
  1212.     }
  1213.       if (CONSP (tail))
  1214.     tail = XCONS (tail)->cdr;
  1215.       else
  1216.     return Qnil;
  1217.     }
  1218.   return Qnil;
  1219. }
  1220.  
  1221. extern Lisp_Object event_equal (Lisp_Object, Lisp_Object);
  1222.  
  1223. DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
  1224.   "T if two Lisp objects have similar structure and contents.\n\
  1225. They must have the same data type.\n\
  1226. Conses are compared by comparing the cars and the cdrs.\n\
  1227. Vectors and strings are compared element by element.\n\
  1228. Numbers are compared by value.  Symbols must match exactly.")
  1229.   (o1, o2)
  1230.      register Lisp_Object o1, o2;
  1231. {
  1232. do_cdr:
  1233.   QUIT;
  1234.   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
  1235.   if (XINT (o1) == XINT (o2)) return Qt;
  1236.   if (CONSP (o1))
  1237.     {
  1238.       Lisp_Object v1;
  1239.       v1 = Fequal (Fcar (o1), Fcar (o2));
  1240.       if (NILP (v1))
  1241.     return v1;
  1242.       o1 = Fcdr (o1), o2 = Fcdr (o2);
  1243.       goto do_cdr;
  1244.     }
  1245.   if (MARKERP (o1))
  1246.     {
  1247.       return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
  1248.           && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
  1249.     ? Qt : Qnil;
  1250.     }
  1251.   if (VECTORP (o1))
  1252.     {
  1253.       register int index;
  1254.       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
  1255.     return Qnil;
  1256.       for (index = 0; index < XVECTOR (o1)->size; index++)
  1257.     {
  1258.       Lisp_Object v, v1, v2;
  1259.       v1 = XVECTOR (o1)->contents [index];
  1260.       v2 = XVECTOR (o2)->contents [index];
  1261.       v = Fequal (v1, v2);
  1262.       if (NILP (v)) return v;
  1263.     }
  1264.       return Qt;
  1265.     }
  1266.   if (STRINGP (o1))
  1267.     {
  1268.       if (XSTRING (o1)->size != XSTRING (o2)->size)
  1269.     return Qnil;
  1270.       if (memcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
  1271.     return Qnil;
  1272.       return Qt;
  1273.     }
  1274.   if (EVENTP (o1))
  1275.     return event_equal (o1, o2);
  1276. #ifdef LISP_FLOAT_TYPE
  1277.   if (FLOATP (o1))
  1278.     return (XFLOAT (o1)->data == XFLOAT (o2)->data) ? Qt : Qnil;
  1279. #endif
  1280.  
  1281.   return Qnil;
  1282. }
  1283.  
  1284. DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
  1285.   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
  1286.   (array, item)
  1287.      Lisp_Object array, item;
  1288. {
  1289.   register int size, index, charval;
  1290.  retry:
  1291.   if (VECTORP (array))
  1292.     {
  1293.       register Lisp_Object *p = XVECTOR (array)->contents;
  1294.       size = XVECTOR (array)->size;
  1295.       for (index = 0; index < size; index++)
  1296.     p[index] = item;
  1297.     }
  1298.   else if (STRINGP (array))
  1299.     {
  1300.       register unsigned char *p = XSTRING (array)->data;
  1301.       CHECK_FIXNUM (item, 1);
  1302.       charval = XINT (item);
  1303.       size = XSTRING (array)->size;
  1304.       for (index = 0; index < size; index++)
  1305.     p[index] = charval;
  1306.     }
  1307.   else
  1308.     {
  1309.       array = wrong_type_argument (Qarrayp, array);
  1310.       goto retry;
  1311.     }
  1312.   return array;
  1313. }
  1314.  
  1315. /* ARGSUSED */
  1316. Lisp_Object
  1317. nconc2 (s1, s2)
  1318.      Lisp_Object s1, s2;
  1319. {
  1320. #ifdef NO_ARG_ARRAY
  1321.   Lisp_Object args[2];
  1322.   args[0] = s1;
  1323.   args[1] = s2;
  1324.   return Fnconc (2, args);
  1325. #else
  1326.   return Fnconc (2, &s1);
  1327. #endif /* NO_ARG_ARRAY */
  1328. }
  1329.  
  1330. DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
  1331.   "Concatenate any number of lists by altering them.\n\
  1332. Only the last argument is not altered, and need not be a list.")
  1333.   (nargs, args)
  1334.      int nargs;
  1335.      Lisp_Object *args;
  1336. {
  1337.   register int argnum;
  1338.   register Lisp_Object tail, tem, val;
  1339.  
  1340.   val = Qnil;
  1341.  
  1342.   for (argnum = 0; argnum < nargs; argnum++)
  1343.     {
  1344.       tem = args[argnum];
  1345.       if (NILP (tem)) continue;
  1346.  
  1347.       if (NILP (val))
  1348.     val = tem;
  1349.  
  1350.       if (argnum + 1 == nargs) break;
  1351.  
  1352.       if (!CONSP (tem))
  1353.     tem = wrong_type_argument (Qlistp, tem);
  1354.  
  1355.       while (CONSP (tem))
  1356.     {
  1357.       tail = tem;
  1358.       tem = Fcdr (tail);
  1359.       QUIT;
  1360.     }
  1361.  
  1362.       tem = args[argnum + 1];
  1363.       Fsetcdr (tail, tem);
  1364.       if (NILP (tem))
  1365.     args[argnum + 1] = tail;
  1366.     }
  1367.  
  1368.   return val;
  1369. }
  1370.  
  1371. /* This is the guts of all mapping functions.
  1372.  Apply fn to each element of seq, one by one,
  1373.  storing the results into elements of vals, a C vector of Lisp_Objects.
  1374.  leni is the length of vals, which should also be the length of seq. */
  1375.  
  1376. static void
  1377. mapcar1 (leni, vals, fn, seq)
  1378.      int leni;
  1379.      Lisp_Object *vals;
  1380.      Lisp_Object fn, seq;
  1381. {
  1382.   register Lisp_Object tail;
  1383.   Lisp_Object dummy;
  1384.   register int i;
  1385.   struct gcpro gcpro1, gcpro2, gcpro3;
  1386.  
  1387.   /* Don't let vals contain any garbage when GC happens.  */
  1388.   for (i = 0; i < leni; i++)
  1389.     vals[i] = Qnil;
  1390.  
  1391.   GCPRO3 (dummy, fn, seq);
  1392.   gcpro1.var = vals;
  1393.   gcpro1.nvars = leni;
  1394.   /* We need not explicitly protect `tail' because it is used only on lists, and
  1395.     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
  1396.  
  1397.   if (VECTORP (seq))
  1398.     {
  1399.       for (i = 0; i < leni; i++)
  1400.     {
  1401.       dummy = XVECTOR (seq)->contents[i];
  1402.       vals[i] = call1 (fn, dummy);
  1403.     }
  1404.     }
  1405.   else if (STRINGP (seq))
  1406.     {
  1407.       for (i = 0; i < leni; i++)
  1408.     {
  1409.       XFASTINT (dummy) = XSTRING (seq)->data[i];
  1410.       vals[i] = call1 (fn, dummy);
  1411.     }
  1412.     }
  1413.   else   /* Must be a list, since Flength did not get an error */
  1414.     {
  1415.       tail = seq;
  1416.       for (i = 0; i < leni; i++)
  1417.     {
  1418.       vals[i] = call1 (fn, Fcar (tail));
  1419.       tail = Fcdr (tail);
  1420.     }
  1421.     }
  1422.  
  1423.   UNGCPRO;
  1424. }
  1425.  
  1426. DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
  1427.   "Apply FN to each element of SEQ, and concat the results as strings.\n\
  1428. In between each pair of results, stick in SEP.\n\
  1429. Thus, \" \" as SEP results in spaces between the values return by FN.")
  1430.   (fn, seq, sep)
  1431.      Lisp_Object fn, seq, sep;
  1432. {
  1433.   Lisp_Object len;
  1434.   register int leni;
  1435.   int nargs;
  1436.   register Lisp_Object *args;
  1437.   register int i;
  1438.   struct gcpro gcpro1;
  1439.  
  1440.   len = Flength (seq);
  1441.   leni = XINT (len);
  1442.   nargs = leni + leni - 1;
  1443.   if (nargs < 0) return build_string ("");
  1444.  
  1445.   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
  1446.  
  1447.   GCPRO1 (sep);
  1448.   mapcar1 (leni, args, fn, seq);
  1449.   UNGCPRO;
  1450.  
  1451.   for (i = leni - 1; i >= 0; i--)
  1452.     args[i + i] = args[i];
  1453.       
  1454.   for (i = 1; i < nargs; i += 2)
  1455.     args[i] = sep;
  1456.  
  1457.   return Fconcat (nargs, args);
  1458. }
  1459.  
  1460. DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
  1461.   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
  1462. The result is a list just as long as SEQUENCE.\n\
  1463. SEQUENCE may be a list, a vector or a string.")
  1464.   (fn, seq)
  1465.      Lisp_Object fn, seq;
  1466. {
  1467.   register Lisp_Object len;
  1468.   register int leni;
  1469.   register Lisp_Object *args;
  1470.  
  1471.   len = Flength (seq);
  1472.   leni = XFASTINT (len);
  1473.   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
  1474.  
  1475.   mapcar1 (leni, args, fn, seq);
  1476.  
  1477.   return Flist (leni, args);
  1478. }
  1479.  
  1480. /* Avoid static vars inside a function since in HPUX they dump as pure.  */
  1481. static int ldav_initialized;
  1482. static int ldav_channel;
  1483. #ifdef LOAD_AVE_TYPE
  1484. #ifndef VMS
  1485. static struct nlist ldav_nl[2];
  1486. #endif /* VMS */
  1487. #endif /* LOAD_AVE_TYPE */
  1488.  
  1489. #define channel ldav_channel
  1490. #define initialized ldav_initialized
  1491. #define nl ldav_nl
  1492.  
  1493. DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
  1494.   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
  1495. Each of the three load averages is multiplied by 100,\n\
  1496. then converted to integer.\n\
  1497. \n\
  1498. This won't work unless the emacs executable is setgid kmem\n(\
  1499. assuming that /dev/kmem is in the group kmem.)")
  1500.   ()
  1501. {
  1502. #ifndef LOAD_AVE_TYPE
  1503.   error ("load-average not implemented for this operating system");
  1504.  
  1505. #else /* LOAD_AVE_TYPE defined */
  1506.  
  1507.   LOAD_AVE_TYPE load_ave[3];
  1508. #ifdef HAVE_HPUX_PSTAT
  1509.   struct pst_dynamic pst_dyn;
  1510. #endif /* HAVE HPUX_PSTAT */
  1511. #ifdef VMS
  1512. #ifndef eunice
  1513. #include <iodef.h>
  1514. #include <descrip.h>
  1515. #else
  1516. #include <vms/iodef.h>
  1517.   struct {int dsc$w_length; char *dsc$a_pointer;} descriptor;
  1518. #endif /* eunice */
  1519. #endif /* VMS */
  1520.  
  1521.   /* If this fails for any reason, we can return (0 0 0) */
  1522.   load_ave[0] = 0.0; load_ave[1] = 0.0; load_ave[2] = 0.0;
  1523.  
  1524. #ifdef VMS
  1525.   /*
  1526.    *    VMS specific code -- read from the Load Ave driver
  1527.    */
  1528.  
  1529.   /*
  1530.    *    Ensure that there is a channel open to the load ave device
  1531.    */
  1532.   if (initialized == 0)
  1533.     {
  1534.       /* Attempt to open the channel */
  1535. #ifdef eunice
  1536.       descriptor.size = 18;
  1537.       descriptor.ptr  = "$$VMS_LOAD_AVERAGE";
  1538. #else
  1539.       $DESCRIPTOR(descriptor, "LAV0:");
  1540. #endif
  1541.       if (sys$assign (&descriptor, &channel, 0, 0) & 1)
  1542.     initialized = 1;
  1543.     }
  1544.   /*
  1545.    *    Read the load average vector
  1546.    */
  1547.   if (initialized)
  1548.     {
  1549.       if (!(sys$qiow (0, channel, IO$_READVBLK, 0, 0, 0,
  1550.              load_ave, 12, 0, 0, 0, 0)
  1551.         & 1))
  1552.     {
  1553.       sys$dassgn (channel);
  1554.       initialized = 0;
  1555.     }
  1556.     }
  1557. #else  /* not VMS */
  1558.  
  1559. #ifdef HAVE_HPUX_PSTAT
  1560.     pstat(PSTAT_DYNAMIC,(union pstun)&pst_dyn,sizeof(pst_dyn),0,0);
  1561.     load_ave[0] = pst_dyn.psd_avg_1_min;
  1562.     load_ave[1] = pst_dyn.psd_avg_5_min;
  1563.     load_ave[2] = pst_dyn.psd_avg_15_min;
  1564. #else /* HAVE_HPUX_PSTAT */
  1565.   /*
  1566.    *    4.2BSD UNIX-specific code -- read _avenrun from /dev/kmem
  1567.    */
  1568.  
  1569.   /*
  1570.    *    Make sure we have the address of _avenrun
  1571.    */
  1572.   if (nl[0].n_value == 0)
  1573.     {
  1574.       /*
  1575.        *    Get the address of _avenrun
  1576.        */
  1577. #ifndef NLIST_STRUCT
  1578.       strcpy (nl[0].n_name, LDAV_SYMBOL);
  1579.       nl[1].n_zeroes = 0;
  1580. #else /* NLIST_STRUCT */
  1581. #ifdef convex
  1582.       nl[0].n_un.n_name = LDAV_SYMBOL;
  1583.       nl[1].n_un.n_name = 0;
  1584. #else /* not convex */
  1585. #ifdef NEXT_KERNEL_FILE
  1586.       nl[0].n_un.n_name = LDAV_SYMBOL;
  1587.       nl[1].n_un.n_name = 0;
  1588. #else
  1589.       nl[0].n_name = LDAV_SYMBOL;
  1590.       nl[1].n_name = 0;
  1591. #endif /* not NEXT_KERNEL_FILE */
  1592. #endif /* not convex */
  1593. #endif /* NLIST_STRUCT */
  1594.  
  1595. #ifdef NEXT_KERNEL_FILE
  1596.       nlist (NEXT_KERNEL_FILE, nl);
  1597. #else
  1598.       nlist (KERNEL_FILE, nl);
  1599. #endif      /* NEXT_KERNEL_FILE */
  1600.  
  1601. #ifdef FIXUP_KERNEL_SYMBOL_ADDR
  1602.       FIXUP_KERNEL_SYMBOL_ADDR (nl);
  1603. #endif /* FIXUP_KERNEL_SYMBOL_ADDR */
  1604.     }
  1605.   /*
  1606.    *    Make sure we have /dev/kmem open
  1607.    */
  1608.   if (initialized == 0)
  1609.     {
  1610.       /*
  1611.        *    Open /dev/kmem
  1612.        */
  1613.       channel = open ("/dev/kmem", 0);
  1614.       if (channel >= 0) initialized = 1;
  1615.     }
  1616.   /*
  1617.    *    If we can, get the load ave values
  1618.    */
  1619.   if ((nl[0].n_value != 0) && (initialized != 0))
  1620.     {
  1621.       /*
  1622.        *    Seek to the correct address
  1623.        */
  1624.       lseek (channel, (long) nl[0].n_value, 0);
  1625.       if (read (channel, (char *) load_ave, sizeof load_ave)
  1626.       != sizeof(load_ave))
  1627.     {
  1628.       close (channel);
  1629.       initialized = 0;
  1630.     }
  1631.     }
  1632. #endif /* not HAVE_HPUX_PSTAT */
  1633. #endif /* not VMS */
  1634.  
  1635.   /*
  1636.    *    Return the list of load average values
  1637.    */
  1638.   return Fcons (make_number (LOAD_AVE_CVT (load_ave[0])),
  1639.         Fcons (make_number (LOAD_AVE_CVT (load_ave[1])),
  1640.                Fcons (make_number (LOAD_AVE_CVT (load_ave[2])),
  1641.                   Qnil)));
  1642. #endif /* LOAD_AVE_TYPE */
  1643. }
  1644.  
  1645. #undef channel
  1646. #undef initialized
  1647. #undef nl
  1648.  
  1649. Lisp_Object Vfeatures;
  1650.  
  1651. DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
  1652.   "Returns t if FEATURE is present in this Emacs.\n\
  1653. Use this to conditionalize execution of lisp code based on the presence or\n\
  1654. absence of emacs or environment extensions.\n\
  1655. Use `provide' to declare that a feature is available.\n\
  1656. This function looks at the value of the variable `features'.")
  1657.      (feature)
  1658.      Lisp_Object feature;
  1659. {
  1660.   register Lisp_Object tem;
  1661.   CHECK_SYMBOL (feature, 0);
  1662.   tem = Fmemq (feature, Vfeatures);
  1663.   return (NILP (tem)) ? Qnil : Qt;
  1664. }
  1665.  
  1666. DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
  1667.   "Announce that FEATURE is a feature of the current Emacs.")
  1668.      (feature)
  1669.      Lisp_Object feature;
  1670. {
  1671.   register Lisp_Object tem;
  1672.   CHECK_SYMBOL (feature, 0);
  1673.   if (!NILP (Vautoload_queue))
  1674.     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
  1675.   tem = Fmemq (feature, Vfeatures);
  1676.   if (NILP (tem))
  1677.     Vfeatures = Fcons (feature, Vfeatures);
  1678.   return feature;
  1679. }
  1680.  
  1681. DEFUN ("require", Frequire, Srequire, 1, 2, 0,
  1682.   "If feature FEATURE is not loaded, load it from FILENAME.\n\
  1683. If FEATURE is not a member of the list `features', then the feature\n\
  1684. is not loaded; so load the file FILENAME.\n\
  1685. If FILENAME is omitted, the printname of FEATURE is used as the file name.")
  1686.      (feature, file_name)
  1687.      Lisp_Object feature, file_name;
  1688. {
  1689.   register Lisp_Object tem;
  1690.   CHECK_SYMBOL (feature, 0);
  1691.   tem = Fmemq (feature, Vfeatures);
  1692.   if (NILP (tem))
  1693.     {
  1694.       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
  1695.          Qnil, Qt, Qnil);
  1696.       tem = Fmemq (feature, Vfeatures);
  1697.       if (NILP (tem))
  1698.     error ("Required feature %s was not provided",
  1699.            XSYMBOL (feature)->name->data );
  1700.     }
  1701.   return feature;
  1702. }
  1703.  
  1704. /* Sound stuff, by jwz. */
  1705.  
  1706. #ifdef USE_SOUND
  1707. extern void play_sound_file (char *name, int volume);
  1708. extern void play_sound_data (unsigned char *data, int length, int volume);
  1709.  
  1710. extern int interrupt_input;
  1711. extern void request_sigio (void);
  1712. extern void unrequest_sigio (void);
  1713. #endif /* USE_SOUND */
  1714.  
  1715. DEFUN ("play-sound-file", Fplay_sound_file, Splay_sound_file,
  1716.        1, 2, "fSound file name: ",
  1717.  "Play the named sound file on the console speaker at the specified volume\n(\
  1718. 0-100, default specified by the `bell-volume' variable).\n\
  1719. The sound file must be in the Sun/NeXT U-LAW format."
  1720.        )
  1721.      (file, vol)
  1722.     Lisp_Object file, vol;
  1723. {
  1724. #ifdef USE_SOUND
  1725.  
  1726.   CHECK_STRING (file, 0);
  1727.   if (NILP (vol)) vol = Vbell_volume;
  1728.   CHECK_FIXNUM (vol, 0);
  1729.  
  1730.   file = Fexpand_file_name (file, Qnil);
  1731.   if (Qnil == Ffile_readable_p (file))
  1732.     if (Qnil == Ffile_exists_p (file))
  1733.       error ("file does not exist.");
  1734.     else
  1735.       error ("file is unreadable.");
  1736.  
  1737.   /* The sound code doesn't like getting SIGIO interrupts.  Unix sucks! */
  1738.   if (interrupt_input) unrequest_sigio ();
  1739.   play_sound_file ((char *) XSTRING(file)->data, XINT(vol));
  1740.   if (interrupt_input) request_sigio ();
  1741.   QUIT;
  1742.  
  1743. #endif /* USE_SOUND */
  1744.  
  1745.   return Qnil;
  1746. }
  1747.  
  1748. Lisp_Object Vsound_alist;
  1749.  
  1750. #ifdef USE_SOUND
  1751. int not_on_console; /*set at startup to determine whether we can play sounds*/
  1752. #endif
  1753.  
  1754. void (*beep_hook) ();
  1755.  
  1756. DEFUN ("play-sound", Fplay_sound, Splay_sound, 1, 2, 0,
  1757.        "Play a sound of the provided type.\n\
  1758. See the variable sound-alist.")
  1759.      (sound, volume)
  1760.      Lisp_Object sound;
  1761.      Lisp_Object volume;
  1762. {
  1763.   int looking_for_default = 0;
  1764.  
  1765.  TRY_AGAIN:
  1766.     while (!NILP (sound) && SYMBOLP (sound) && !EQ (sound, Qt))
  1767.       {
  1768.     sound = Fcdr (Fassq (sound, Vsound_alist));
  1769.     /* allow (name foo) as well as (name . foo) */
  1770.     if (!CONSP (sound))
  1771.       ;
  1772.     else if (NILP (Fcdr (sound)))
  1773.       {
  1774.         sound = Fcar (sound);
  1775.       }
  1776.     else if (FIXNUMP (Fcar (Fcdr (sound))) &&
  1777.          NILP (Fcdr (Fcdr (sound))))
  1778.       {
  1779.         if (NILP (volume)) volume = Fcar (Fcdr (sound));
  1780.         sound = Fcar (sound);
  1781.       }
  1782.     else if (FIXNUMP (Fcar (sound)) &&
  1783.          NILP (Fcdr (Fcdr (sound))))
  1784.       {
  1785.         if (NILP (volume)) volume = Fcar (sound);
  1786.         sound = Fcar (Fcdr (sound));
  1787.       }
  1788.       }
  1789.  
  1790.   if (NILP (sound) && !looking_for_default)
  1791.     {
  1792.       looking_for_default = 1;
  1793.       sound = intern ("default");
  1794.       goto TRY_AGAIN;
  1795.     }
  1796.  
  1797.   if (!FIXNUMP (volume))
  1798.     volume = Vbell_volume;
  1799.   
  1800. #ifdef USE_SOUND
  1801.   if (not_on_console) sound = Qt;
  1802.  
  1803.   if (!STRINGP (sound))
  1804.     {
  1805.       if (beep_hook) (*beep_hook) (XINT (volume));
  1806.     }
  1807.   else
  1808.     {
  1809.       /* The sound code doesn't like getting SIGIO interrupts.  Unix sucks! */
  1810.       if (interrupt_input) unrequest_sigio ();
  1811.       play_sound_data (XSTRING (sound)->data, XSTRING (sound)->size,
  1812.                XINT (volume));
  1813.       if (interrupt_input) request_sigio ();
  1814.       QUIT;
  1815.     }
  1816. #else  /* ! USE_SOUND */
  1817.   if (beep_hook) (*beep_hook) (XINT (volume));
  1818. #endif  /* ! USE_SOUND */
  1819.  
  1820.   return Qnil;
  1821. }
  1822.  
  1823.  
  1824. void
  1825. syms_of_fns ()
  1826. {
  1827.   defsymbol (&Qstring_lessp, "string-lessp");
  1828.   defsymbol (&Qyes_or_no_p, "yes-or-no-p");
  1829.  
  1830.   DEFVAR_LISP ("features", &Vfeatures,
  1831.     "A list of symbols which are the features of the executing emacs.\n\
  1832. Used by `featurep' and `require', and altered by `provide'.");
  1833.   Vfeatures = Qnil;
  1834.  
  1835.   defsubr (&Sidentity);
  1836.   defsubr (&Srandom);
  1837.   defsubr (&Slength);
  1838.   defsubr (&Sstring_equal);
  1839.   defsubr (&Sstring_lessp);
  1840.   defsubr (&Sappend);
  1841.   defsubr (&Sconcat);
  1842.   defsubr (&Svconcat);
  1843.   defsubr (&Scopy_sequence);
  1844.   defsubr (&Scopy_alist);
  1845.   defsubr (&Scopy_tree);
  1846.   defsubr (&Ssubstring);
  1847.   defsubr (&Snthcdr);
  1848.   defsubr (&Snth);
  1849.   defsubr (&Selt);
  1850.   defsubr (&Smember);
  1851.   defsubr (&Smemq);
  1852.   defsubr (&Sassq);
  1853.   defsubr (&Sassoc);
  1854.   defsubr (&Srassq);
  1855.   defsubr (&Sdelq);
  1856.   defsubr (&Sdelete);
  1857.   defsubr (&Snreverse);
  1858.   defsubr (&Sreverse);
  1859.   defsubr (&Ssort);
  1860.   defsubr (&Sget);
  1861.   defsubr (&Sput);
  1862.   defsubr (&Sremprop);
  1863.   defsubr (&Sequal);
  1864.   defsubr (&Sfillarray);
  1865.   defsubr (&Snconc);
  1866.   defsubr (&Smapcar);
  1867.   defsubr (&Smapconcat);
  1868.   defsubr (&Sload_average);
  1869.   defsubr (&Sfeaturep);
  1870.   defsubr (&Srequire);
  1871.   defsubr (&Sprovide);
  1872.  
  1873.   /* Lucid sound change */
  1874.   DEFVAR_LISP ("bell-volume", &Vbell_volume, "How loud to be, from 0 to 100.");
  1875.   Vbell_volume = make_number (50);
  1876.  
  1877.   DEFVAR_LISP ("sound-alist", &Vsound_alist,
  1878.     "An alist associating symbols with strings of audio-data.\n\
  1879. When `beep' or `ding' is called with one of the symbols, the associated\n\
  1880. sound data will be played instead of the standard beep.  This only works\n\
  1881. if you are logged in on the console of a Sun SparcStation or SGI machine.\n\
  1882. \n\
  1883. Elements of this list should be of one of the following forms:\n\
  1884. \n\
  1885.    ( symbol . string-or-symbol )\n\
  1886.    ( symbol integer string-or-symbol )\n\
  1887. \n\
  1888. If the `string-or-symbol' is a string, then it should contain raw sound data,\n\
  1889. the contents of a `.au' file.  If it is a symbol, then that means that this\n\
  1890. element is an alias for some other element, and the sound-player will look\n\
  1891. for that next.  If the integer is provided, it is the volume at which the\n\
  1892. sound should be played, from 0 to 100.  \n\
  1893. \n\
  1894. If an element of this alist begins with the symbol `default', then that sound\n\
  1895. will be used when no other sound is appropriate.\n\
  1896. \n\
  1897. The symbol `t' in place of a sound-string means to use the default X beep.\n\
  1898. In this way, you can define beep-types to have different volumes even when\n\
  1899. not running on the console of a Sun4.\n\
  1900. \n\
  1901. You should probably add things to this list by calling the function\n\
  1902. load-sound-file.\n\
  1903. \n\
  1904. The following beep-types are used by emacs itself:\n\
  1905. \n\
  1906.     auto-save-error    when an auto-save does not succeed\n\
  1907.     command-error    when the emacs command loop catches an error\n\
  1908.     undefined-key    when you type a key that is undefined\n\
  1909.     undefined-click    when you use an undefined mouse-click combination\n\
  1910.     no-completion    during completing-read\n\
  1911.     y-or-n-p        when you type something other than 'y' or 'n'\n\
  1912.     yes-or-no-p      when you type something other than 'yes' or 'no'\n\
  1913. \n\
  1914. Other lisp packages may use other beep types, but these are the ones that\n\
  1915. the C kernel of emacs uses.");
  1916.   Vsound_alist = Qnil;
  1917.   defsubr (&Splay_sound_file);
  1918.   defsubr (&Splay_sound);
  1919. #ifdef USE_SOUND
  1920.   not_on_console = 0;    /* set by X startup code */
  1921. #endif
  1922.   beep_hook = 0    ;    /* set by X startup code */
  1923. }
  1924.