/[emacs]/emacs/src/fns.c
ViewVC logotype

Diff of /emacs/src/fns.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.314 by eliz, Wed Jun 5 17:47:50 2002 UTC revision 1.314.2.1 by miles, Fri Apr 4 06:20:58 2003 UTC
# Line 1  Line 1 
1  /* Random utility Lisp functions.  /* Random utility Lisp functions.
2     Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001     Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 2002
3     Free Software Foundation, Inc.     Free Software Foundation, Inc.
4    
5  This file is part of GNU Emacs.  This file is part of GNU Emacs.
# Line 26  Boston, MA 02111-1307, USA.  */ Line 26  Boston, MA 02111-1307, USA.  */
26  #endif  #endif
27  #include <time.h>  #include <time.h>
28    
29    #ifndef MAC_OSX
30    /* On Mac OS X, defining this conflicts with precompiled headers.  */
31    
32  /* Note on some machines this defines `vector' as a typedef,  /* Note on some machines this defines `vector' as a typedef,
33     so make sure we don't use that name in this file.  */     so make sure we don't use that name in this file.  */
34  #undef vector  #undef vector
35  #define vector *****  #define vector *****
36    
37    #endif  /* ! MAC_OSX */
38    
39  #include "lisp.h"  #include "lisp.h"
40  #include "commands.h"  #include "commands.h"
41  #include "charset.h"  #include "charset.h"
42    #include "coding.h"
43  #include "buffer.h"  #include "buffer.h"
44  #include "keyboard.h"  #include "keyboard.h"
45  #include "keymap.h"  #include "keymap.h"
# Line 47  Boston, MA 02111-1307, USA.  */ Line 52  Boston, MA 02111-1307, USA.  */
52  #endif  #endif
53    
54  #ifndef NULL  #ifndef NULL
55  #define NULL (void *)0  #define NULL ((POINTER_TYPE *)0)
56  #endif  #endif
57    
58  /* Nonzero enables use of dialog boxes for questions  /* Nonzero enables use of dialog boxes for questions
# Line 56  int use_dialog_box; Line 61  int use_dialog_box;
61    
62  extern int minibuffer_auto_raise;  extern int minibuffer_auto_raise;
63  extern Lisp_Object minibuf_window;  extern Lisp_Object minibuf_window;
64    extern Lisp_Object Vlocale_coding_system;
65    
66  Lisp_Object Qstring_lessp, Qprovide, Qrequire;  Lisp_Object Qstring_lessp, Qprovide, Qrequire;
67  Lisp_Object Qyes_or_no_p_history;  Lisp_Object Qyes_or_no_p_history;
68  Lisp_Object Qcursor_in_echo_area;  Lisp_Object Qcursor_in_echo_area;
69  Lisp_Object Qwidget_type;  Lisp_Object Qwidget_type;
70    Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
71    
72  extern Lisp_Object Qinput_method_function;  extern Lisp_Object Qinput_method_function;
73    
# Line 121  With argument t, set the random number s Line 128  With argument t, set the random number s
128  DEFUN ("length", Flength, Slength, 1, 1, 0,  DEFUN ("length", Flength, Slength, 1, 1, 0,
129         doc: /* Return the length of vector, list or string SEQUENCE.         doc: /* Return the length of vector, list or string SEQUENCE.
130  A byte-code function object is also allowed.  A byte-code function object is also allowed.
131  If the string contains multibyte characters, this is not the necessarily  If the string contains multibyte characters, this is not necessarily
132  the number of bytes in the string; it is the number of characters.  the number of bytes in the string; it is the number of characters.
133  To get the number of bytes, use `string-bytes'. */)  To get the number of bytes, use `string-bytes'. */)
134       (sequence)       (sequence)
# Line 132  To get the number of bytes, use `string- Line 139  To get the number of bytes, use `string-
139    
140   retry:   retry:
141    if (STRINGP (sequence))    if (STRINGP (sequence))
142      XSETFASTINT (val, XSTRING (sequence)->size);      XSETFASTINT (val, SCHARS (sequence));
143    else if (VECTORP (sequence))    else if (VECTORP (sequence))
144      XSETFASTINT (val, XVECTOR (sequence)->size);      XSETFASTINT (val, XVECTOR (sequence)->size);
145    else if (CHAR_TABLE_P (sequence))    else if (CHAR_TABLE_P (sequence))
# Line 201  which is at least the number of distinct Line 208  which is at least the number of distinct
208    return length;    return length;
209  }  }
210    
211  DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,  DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
212         doc: /* Return the number of bytes in STRING.         doc: /* Return the number of bytes in STRING.
213  If STRING is a multibyte string, this is greater than the length of STRING. */)  If STRING is a multibyte string, this is greater than the length of STRING. */)
214       (string)       (string)
215       Lisp_Object string;       Lisp_Object string;
216  {  {
217    CHECK_STRING (string);    CHECK_STRING (string);
218    return make_number (STRING_BYTES (XSTRING (string)));    return make_number (SBYTES (string));
219  }  }
220    
221  DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,  DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
# Line 225  Symbols are also allowed; their print na Line 232  Symbols are also allowed; their print na
232    CHECK_STRING (s1);    CHECK_STRING (s1);
233    CHECK_STRING (s2);    CHECK_STRING (s2);
234    
235    if (XSTRING (s1)->size != XSTRING (s2)->size    if (SCHARS (s1) != SCHARS (s2)
236        || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2))        || SBYTES (s1) != SBYTES (s2)
237        || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1))))        || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
238      return Qnil;      return Qnil;
239    return Qt;    return Qt;
240  }  }
# Line 272  If string STR1 is greater, the value is Line 279  If string STR1 is greater, the value is
279    i1_byte = string_char_to_byte (str1, i1);    i1_byte = string_char_to_byte (str1, i1);
280    i2_byte = string_char_to_byte (str2, i2);    i2_byte = string_char_to_byte (str2, i2);
281    
282    end1_char = XSTRING (str1)->size;    end1_char = SCHARS (str1);
283    if (! NILP (end1) && end1_char > XINT (end1))    if (! NILP (end1) && end1_char > XINT (end1))
284      end1_char = XINT (end1);      end1_char = XINT (end1);
285    
286    end2_char = XSTRING (str2)->size;    end2_char = SCHARS (str2);
287    if (! NILP (end2) && end2_char > XINT (end2))    if (! NILP (end2) && end2_char > XINT (end2))
288      end2_char = XINT (end2);      end2_char = XINT (end2);
289    
# Line 290  If string STR1 is greater, the value is Line 297  If string STR1 is greater, the value is
297          FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);          FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
298        else        else
299          {          {
300            c1 = XSTRING (str1)->data[i1++];            c1 = SREF (str1, i1++);
301            c1 = unibyte_char_to_multibyte (c1);            c1 = unibyte_char_to_multibyte (c1);
302          }          }
303    
# Line 298  If string STR1 is greater, the value is Line 305  If string STR1 is greater, the value is
305          FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);          FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
306        else        else
307          {          {
308            c2 = XSTRING (str2)->data[i2++];            c2 = SREF (str2, i2++);
309            c2 = unibyte_char_to_multibyte (c2);            c2 = unibyte_char_to_multibyte (c2);
310          }          }
311    
# Line 354  Symbols are also allowed; their print na Line 361  Symbols are also allowed; their print na
361    
362    i1 = i1_byte = i2 = i2_byte = 0;    i1 = i1_byte = i2 = i2_byte = 0;
363    
364    end = XSTRING (s1)->size;    end = SCHARS (s1);
365    if (end > XSTRING (s2)->size)    if (end > SCHARS (s2))
366      end = XSTRING (s2)->size;      end = SCHARS (s2);
367    
368    while (i1 < end)    while (i1 < end)
369      {      {
# Line 370  Symbols are also allowed; their print na Line 377  Symbols are also allowed; their print na
377        if (c1 != c2)        if (c1 != c2)
378          return c1 < c2 ? Qt : Qnil;          return c1 < c2 ? Qt : Qnil;
379      }      }
380    return i1 < XSTRING (s2)->size ? Qt : Qnil;    return i1 < SCHARS (s2) ? Qt : Qnil;
381  }  }
382    
383  static Lisp_Object concat ();  static Lisp_Object concat ();
# Line 443  usage: (vconcat &rest SEQUENCES)   */) Line 450  usage: (vconcat &rest SEQUENCES)   */)
450    return concat (nargs, args, Lisp_Vectorlike, 0);    return concat (nargs, args, Lisp_Vectorlike, 0);
451  }  }
452    
453  /* Retrun a copy of a sub char table ARG.  The elements except for a  /* Return a copy of a sub char table ARG.  The elements except for a
454     nested sub char table are not copied.  */     nested sub char table are not copied.  */
455  static Lisp_Object  static Lisp_Object
456  copy_sub_char_table (arg)  copy_sub_char_table (arg)
# Line 466  copy_sub_char_table (arg) Line 473  copy_sub_char_table (arg)
473    
474    
475  DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,  DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
476         doc: /* Return a copy of a list, vector or string.         doc: /* Return a copy of a list, vector, string or char-table.
477  The elements of a list or vector are not copied; they are shared  The elements of a list or vector are not copied; they are shared
478  with the original. */)  with the original. */)
479       (arg)       (arg)
# Line 641  concat (nargs, args, target_type, last_s Line 648  concat (nargs, args, target_type, last_s
648                if (STRING_MULTIBYTE (this))                if (STRING_MULTIBYTE (this))
649                  {                  {
650                    some_multibyte = 1;                    some_multibyte = 1;
651                    result_len_byte += STRING_BYTES (XSTRING (this));                    result_len_byte += SBYTES (this);
652                  }                  }
653                else                else
654                  result_len_byte += count_size_as_multibyte (XSTRING (this)->data,                  result_len_byte += count_size_as_multibyte (SDATA (this),
655                                                              XSTRING (this)->size);                                                              SCHARS (this));
656              }              }
657          }          }
658    
# Line 695  concat (nargs, args, target_type, last_s Line 702  concat (nargs, args, target_type, last_s
702        if (STRINGP (this) && STRINGP (val)        if (STRINGP (this) && STRINGP (val)
703            && STRING_MULTIBYTE (this) == some_multibyte)            && STRING_MULTIBYTE (this) == some_multibyte)
704          {          {
705            int thislen_byte = STRING_BYTES (XSTRING (this));            int thislen_byte = SBYTES (this);
706            int combined;            int combined;
707    
708            bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,            bcopy (SDATA (this), SDATA (val) + toindex_byte,
709                   STRING_BYTES (XSTRING (this)));                   SBYTES (this));
710            combined =  (some_multibyte && toindex_byte > 0            combined =  (some_multibyte && toindex_byte > 0
711                         ? count_combining (XSTRING (val)->data,                         ? count_combining (SDATA (val),
712                                            toindex_byte + thislen_byte,                                            toindex_byte + thislen_byte,
713                                            toindex_byte)                                            toindex_byte)
714                         : 0);                         : 0);
715            if (! NULL_INTERVAL_P (XSTRING (this)->intervals))            if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
716              {              {
717                textprops[num_textprops].argnum = argnum;                textprops[num_textprops].argnum = argnum;
718                /* We ignore text properties on characters being combined.  */                /* We ignore text properties on characters being combined.  */
# Line 714  concat (nargs, args, target_type, last_s Line 721  concat (nargs, args, target_type, last_s
721              }              }
722            toindex_byte += thislen_byte;            toindex_byte += thislen_byte;
723            toindex += thisleni - combined;            toindex += thisleni - combined;
724            XSTRING (val)->size -= combined;            STRING_SET_CHARS (val, SCHARS (val) - combined);
725          }          }
726        /* Copy a single-byte string to a multibyte string.  */        /* Copy a single-byte string to a multibyte string.  */
727        else if (STRINGP (this) && STRINGP (val))        else if (STRINGP (this) && STRINGP (val))
728          {          {
729            if (! NULL_INTERVAL_P (XSTRING (this)->intervals))            if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
730              {              {
731                textprops[num_textprops].argnum = argnum;                textprops[num_textprops].argnum = argnum;
732                textprops[num_textprops].from = 0;                textprops[num_textprops].from = 0;
733                textprops[num_textprops++].to = toindex;                textprops[num_textprops++].to = toindex;
734              }              }
735            toindex_byte += copy_text (XSTRING (this)->data,            toindex_byte += copy_text (SDATA (this),
736                                       XSTRING (val)->data + toindex_byte,                                       SDATA (val) + toindex_byte,
737                                       XSTRING (this)->size, 0, 1);                                       SCHARS (this), 0, 1);
738            toindex += thisleni;            toindex += thisleni;
739          }          }
740        else        else
# Line 755  concat (nargs, args, target_type, last_s Line 762  concat (nargs, args, target_type, last_s
762                    }                    }
763                  else                  else
764                    {                    {
765                      XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);                      XSETFASTINT (elt, SREF (this, thisindex++));
766                      if (some_multibyte                      if (some_multibyte
767                          && (XINT (elt) >= 0240                          && (XINT (elt) >= 0240
768                              || (XINT (elt) >= 0200                              || (XINT (elt) >= 0200
# Line 797  concat (nargs, args, target_type, last_s Line 804  concat (nargs, args, target_type, last_s
804                      if (some_multibyte)                      if (some_multibyte)
805                        toindex_byte                        toindex_byte
806                          += CHAR_STRING (XINT (elt),                          += CHAR_STRING (XINT (elt),
807                                          XSTRING (val)->data + toindex_byte);                                          SDATA (val) + toindex_byte);
808                      else                      else
809                        XSTRING (val)->data[toindex_byte++] = XINT (elt);                        SSET (val, toindex_byte++, XINT (elt));
810                      if (some_multibyte                      if (some_multibyte
811                          && toindex_byte > 0                          && toindex_byte > 0
812                          && count_combining (XSTRING (val)->data,                          && count_combining (SDATA (val),
813                                              toindex_byte, toindex_byte - 1))                                              toindex_byte, toindex_byte - 1))
814                        XSTRING (val)->size--;                        STRING_SET_CHARS (val, SCHARS (val) - 1);
815                      else                      else
816                        toindex++;                        toindex++;
817                    }                    }
# Line 815  concat (nargs, args, target_type, last_s Line 822  concat (nargs, args, target_type, last_s
822                      int c = XINT (elt);                      int c = XINT (elt);
823                      /* P exists as a variable                      /* P exists as a variable
824                         to avoid a bug on the Masscomp C compiler.  */                         to avoid a bug on the Masscomp C compiler.  */
825                      unsigned char *p = & XSTRING (val)->data[toindex_byte];                      unsigned char *p = SDATA (val) + toindex_byte;
826    
827                      toindex_byte += CHAR_STRING (c, p);                      toindex_byte += CHAR_STRING (c, p);
828                      toindex++;                      toindex++;
# Line 836  concat (nargs, args, target_type, last_s Line 843  concat (nargs, args, target_type, last_s
843            this = args[textprops[argnum].argnum];            this = args[textprops[argnum].argnum];
844            props = text_property_list (this,            props = text_property_list (this,
845                                        make_number (0),                                        make_number (0),
846                                        make_number (XSTRING (this)->size),                                        make_number (SCHARS (this)),
847                                        Qnil);                                        Qnil);
848            /* If successive arguments have properites, be sure that the            /* If successive arguments have properites, be sure that the
849               value of `composition' property be the copy.  */               value of `composition' property be the copy.  */
# Line 844  concat (nargs, args, target_type, last_s Line 851  concat (nargs, args, target_type, last_s
851              make_composition_value_copy (props);              make_composition_value_copy (props);
852            add_text_properties_from_list (val, props,            add_text_properties_from_list (val, props,
853                                           make_number (textprops[argnum].to));                                           make_number (textprops[argnum].to));
854            last_to_end = textprops[argnum].to + XSTRING (this)->size;            last_to_end = textprops[argnum].to + SCHARS (this);
855          }          }
856      }      }
857    return val;    return val;
# Line 875  string_char_to_byte (string, char_index) Line 882  string_char_to_byte (string, char_index)
882      return char_index;      return char_index;
883    
884    best_below = best_below_byte = 0;    best_below = best_below_byte = 0;
885    best_above = XSTRING (string)->size;    best_above = SCHARS (string);
886    best_above_byte = STRING_BYTES (XSTRING (string));    best_above_byte = SBYTES (string);
887    
888    if (EQ (string, string_char_byte_cache_string))    if (EQ (string, string_char_byte_cache_string))
889      {      {
# Line 907  string_char_to_byte (string, char_index) Line 914  string_char_to_byte (string, char_index)
914      {      {
915        while (best_above > char_index)        while (best_above > char_index)
916          {          {
917            unsigned char *pend = XSTRING (string)->data + best_above_byte;            unsigned char *pend = SDATA (string) + best_above_byte;
918            unsigned char *pbeg = pend - best_above_byte;            unsigned char *pbeg = pend - best_above_byte;
919            unsigned char *p = pend - 1;            unsigned char *p = pend - 1;
920            int bytes;            int bytes;
# Line 948  string_byte_to_char (string, byte_index) Line 955  string_byte_to_char (string, byte_index)
955      return byte_index;      return byte_index;
956    
957    best_below = best_below_byte = 0;    best_below = best_below_byte = 0;
958    best_above = XSTRING (string)->size;    best_above = SCHARS (string);
959    best_above_byte = STRING_BYTES (XSTRING (string));    best_above_byte = SBYTES (string);
960    
961    if (EQ (string, string_char_byte_cache_string))    if (EQ (string, string_char_byte_cache_string))
962      {      {
# Line 980  string_byte_to_char (string, byte_index) Line 987  string_byte_to_char (string, byte_index)
987      {      {
988        while (best_above_byte > byte_index)        while (best_above_byte > byte_index)
989          {          {
990            unsigned char *pend = XSTRING (string)->data + best_above_byte;            unsigned char *pend = SDATA (string) + best_above_byte;
991            unsigned char *pbeg = pend - best_above_byte;            unsigned char *pbeg = pend - best_above_byte;
992            unsigned char *p = pend - 1;            unsigned char *p = pend - 1;
993            int bytes;            int bytes;
# Line 1020  string_make_multibyte (string) Line 1027  string_make_multibyte (string)
1027    if (STRING_MULTIBYTE (string))    if (STRING_MULTIBYTE (string))
1028      return string;      return string;
1029    
1030    nbytes = count_size_as_multibyte (XSTRING (string)->data,    nbytes = count_size_as_multibyte (SDATA (string),
1031                                      XSTRING (string)->size);                                      SCHARS (string));
1032    /* If all the chars are ASCII, they won't need any more bytes    /* If all the chars are ASCII, they won't need any more bytes
1033       once converted.  In that case, we can return STRING itself.  */       once converted.  In that case, we can return STRING itself.  */
1034    if (nbytes == STRING_BYTES (XSTRING (string)))    if (nbytes == SBYTES (string))
1035      return string;      return string;
1036    
1037    buf = (unsigned char *) alloca (nbytes);    buf = (unsigned char *) alloca (nbytes);
1038    copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),    copy_text (SDATA (string), buf, SBYTES (string),
1039               0, 1);               0, 1);
1040    
1041    return make_multibyte_string (buf, XSTRING (string)->size, nbytes);    return make_multibyte_string (buf, SCHARS (string), nbytes);
1042    }
1043    
1044    
1045    /* Convert STRING to a multibyte string without changing each
1046       character codes.  Thus, characters 0200 trough 0237 are converted
1047       to eight-bit-control characters, and characters 0240 through 0377
1048       are converted eight-bit-graphic characters. */
1049    
1050    Lisp_Object
1051    string_to_multibyte (string)
1052         Lisp_Object string;
1053    {
1054      unsigned char *buf;
1055      int nbytes;
1056    
1057      if (STRING_MULTIBYTE (string))
1058        return string;
1059    
1060      nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
1061      /* If all the chars are ASCII or eight-bit-graphic, they won't need
1062         any more bytes once converted.  */
1063      if (nbytes == SBYTES (string))
1064        return make_multibyte_string (SDATA (string), nbytes, nbytes);
1065    
1066      buf = (unsigned char *) alloca (nbytes);
1067      bcopy (SDATA (string), buf, SBYTES (string));
1068      str_to_multibyte (buf, nbytes, SBYTES (string));
1069    
1070      return make_multibyte_string (buf, SCHARS (string), nbytes);
1071  }  }
1072    
1073    
1074  /* Convert STRING to a single-byte string.  */  /* Convert STRING to a single-byte string.  */
1075    
1076  Lisp_Object  Lisp_Object
# Line 1045  string_make_unibyte (string) Line 1082  string_make_unibyte (string)
1082    if (! STRING_MULTIBYTE (string))    if (! STRING_MULTIBYTE (string))
1083      return string;      return string;
1084    
1085    buf = (unsigned char *) alloca (XSTRING (string)->size);    buf = (unsigned char *) alloca (SCHARS (string));
1086    
1087    copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),    copy_text (SDATA (string), buf, SBYTES (string),
1088               1, 0);               1, 0);
1089    
1090    return make_unibyte_string (buf, XSTRING (string)->size);    return make_unibyte_string (buf, SCHARS (string));
1091  }  }
1092    
1093  DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte,  DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte,
# Line 1096  corresponding single byte.  */) Line 1133  corresponding single byte.  */)
1133    
1134    if (STRING_MULTIBYTE (string))    if (STRING_MULTIBYTE (string))
1135      {      {
1136        int bytes = STRING_BYTES (XSTRING (string));        int bytes = SBYTES (string);
1137        unsigned char *str = (unsigned char *) xmalloc (bytes);        unsigned char *str = (unsigned char *) xmalloc (bytes);
1138    
1139        bcopy (XSTRING (string)->data, str, bytes);        bcopy (SDATA (string), str, bytes);
1140        bytes = str_as_unibyte (str, bytes);        bytes = str_as_unibyte (str, bytes);
1141        string = make_unibyte_string (str, bytes);        string = make_unibyte_string (str, bytes);
1142        xfree (str);        xfree (str);
# Line 1125  multibyte character of charset `eight-bi Line 1162  multibyte character of charset `eight-bi
1162        Lisp_Object new_string;        Lisp_Object new_string;
1163        int nchars, nbytes;        int nchars, nbytes;
1164    
1165        parse_str_as_multibyte (XSTRING (string)->data,        parse_str_as_multibyte (SDATA (string),
1166                                STRING_BYTES (XSTRING (string)),                                SBYTES (string),
1167                                &nchars, &nbytes);                                &nchars, &nbytes);
1168        new_string = make_uninit_multibyte_string (nchars, nbytes);        new_string = make_uninit_multibyte_string (nchars, nbytes);
1169        bcopy (XSTRING (string)->data, XSTRING (new_string)->data,        bcopy (SDATA (string), SDATA (new_string),
1170               STRING_BYTES (XSTRING (string)));               SBYTES (string));
1171        if (nbytes != STRING_BYTES (XSTRING (string)))        if (nbytes != SBYTES (string))
1172          str_as_multibyte (XSTRING (new_string)->data, nbytes,          str_as_multibyte (SDATA (new_string), nbytes,
1173                            STRING_BYTES (XSTRING (string)), NULL);                            SBYTES (string), NULL);
1174        string = new_string;        string = new_string;
1175        XSTRING (string)->intervals = NULL_INTERVAL;        STRING_SET_INTERVALS (string, NULL_INTERVAL);
1176      }      }
1177    return string;    return string;
1178  }  }
1179    
1180    DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte,
1181           1, 1, 0,
1182           doc: /* Return a multibyte string with the same individual chars as STRING.
1183    If STRING is multibyte, the result is STRING itself.
1184    Otherwise it is a newly created string, with no text properties.
1185    Characters 0200 through 0237 are converted to eight-bit-control
1186    characters of the same character code.  Characters 0240 through 0377
1187    are converted to eight-bit-control characters of the same character
1188    codes.  */)
1189         (string)
1190         Lisp_Object string;
1191    {
1192      CHECK_STRING (string);
1193    
1194      return string_to_multibyte (string);
1195    }
1196    
1197    
1198  DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,  DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
1199         doc: /* Return a copy of ALIST.         doc: /* Return a copy of ALIST.
# Line 1170  Elements of ALIST that are not conses ar Line 1225  Elements of ALIST that are not conses ar
1225  DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,  DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
1226         doc: /* Return a substring of STRING, starting at index FROM and ending before TO.         doc: /* Return a substring of STRING, starting at index FROM and ending before TO.
1227  TO may be nil or omitted; then the substring runs to the end of STRING.  TO may be nil or omitted; then the substring runs to the end of STRING.
1228  If FROM or TO is negative, it counts from the end.  FROM and TO start at 0.  If either is negative, it counts from the end.
1229    
1230  This function allows vectors as well as strings.  */)  This function allows vectors as well as strings.  */)
1231       (string, from, to)       (string, from, to)
# Line 1190  This function allows vectors as well as Line 1245  This function allows vectors as well as
1245    
1246    if (STRINGP (string))    if (STRINGP (string))
1247      {      {
1248        size = XSTRING (string)->size;        size = SCHARS (string);
1249        size_byte = STRING_BYTES (XSTRING (string));        size_byte = SBYTES (string);
1250      }      }
1251    else    else
1252      size = XVECTOR (string)->size;      size = XVECTOR (string)->size;
# Line 1225  This function allows vectors as well as Line 1280  This function allows vectors as well as
1280    
1281    if (STRINGP (string))    if (STRINGP (string))
1282      {      {
1283        res = make_specified_string (XSTRING (string)->data + from_byte,        res = make_specified_string (SDATA (string) + from_byte,
1284                                     to_char - from_char, to_byte - from_byte,                                     to_char - from_char, to_byte - from_byte,
1285                                     STRING_MULTIBYTE (string));                                     STRING_MULTIBYTE (string));
1286        copy_text_properties (make_number (from_char), make_number (to_char),        copy_text_properties (make_number (from_char), make_number (to_char),
# Line 1257  With one argument, just copy STRING with Line 1312  With one argument, just copy STRING with
1312    
1313    CHECK_STRING (string);    CHECK_STRING (string);
1314    
1315    size = XSTRING (string)->size;    size = SCHARS (string);
1316    size_byte = STRING_BYTES (XSTRING (string));    size_byte = SBYTES (string);
1317    
1318    if (NILP (from))    if (NILP (from))
1319      from_char = from_byte = 0;      from_char = from_byte = 0;
# Line 1292  With one argument, just copy STRING with Line 1347  With one argument, just copy STRING with
1347      args_out_of_range_3 (string, make_number (from_char),      args_out_of_range_3 (string, make_number (from_char),
1348                           make_number (to_char));                           make_number (to_char));
1349    
1350    return make_specified_string (XSTRING (string)->data + from_byte,    return make_specified_string (SDATA (string) + from_byte,
1351                                  to_char - from_char, to_byte - from_byte,                                  to_char - from_char, to_byte - from_byte,
1352                                  STRING_MULTIBYTE (string));                                  STRING_MULTIBYTE (string));
1353  }  }
# Line 1314  substring_both (string, from, from_byte, Line 1369  substring_both (string, from, from_byte,
1369    
1370    if (STRINGP (string))    if (STRINGP (string))
1371      {      {
1372        size = XSTRING (string)->size;        size = SCHARS (string);
1373        size_byte = STRING_BYTES (XSTRING (string));        size_byte = SBYTES (string);
1374      }      }
1375    else    else
1376      size = XVECTOR (string)->size;      size = XVECTOR (string)->size;
# Line 1325  substring_both (string, from, from_byte, Line 1380  substring_both (string, from, from_byte,
1380    
1381    if (STRINGP (string))    if (STRINGP (string))
1382      {      {
1383        res = make_specified_string (XSTRING (string)->data + from_byte,        res = make_specified_string (SDATA (string) + from_byte,
1384                                     to - from, to_byte - from_byte,                                     to - from, to_byte - from_byte,
1385                                     STRING_MULTIBYTE (string));                                     STRING_MULTIBYTE (string));
1386        copy_text_properties (make_number (from), make_number (to),        copy_text_properties (make_number (from), make_number (to),
# Line 1693  to be sure of changing the value of `foo Line 1748  to be sure of changing the value of `foo
1748        int c;        int c;
1749    
1750        for (i = nchars = nbytes = ibyte = 0;        for (i = nchars = nbytes = ibyte = 0;
1751             i < XSTRING (seq)->size;             i < SCHARS (seq);
1752             ++i, ibyte += cbytes)             ++i, ibyte += cbytes)
1753          {          {
1754            if (STRING_MULTIBYTE (seq))            if (STRING_MULTIBYTE (seq))
1755              {              {
1756                c = STRING_CHAR (&XSTRING (seq)->data[ibyte],                c = STRING_CHAR (SDATA (seq) + ibyte,
1757                                 STRING_BYTES (XSTRING (seq)) - ibyte);                                 SBYTES (seq) - ibyte);
1758                cbytes = CHAR_BYTES (c);                cbytes = CHAR_BYTES (c);
1759              }              }
1760            else            else
1761              {              {
1762                c = XSTRING (seq)->data[i];                c = SREF (seq, i);
1763                cbytes = 1;                cbytes = 1;
1764              }              }
1765    
# Line 1715  to be sure of changing the value of `foo Line 1770  to be sure of changing the value of `foo
1770              }              }
1771          }          }
1772    
1773        if (nchars != XSTRING (seq)->size)        if (nchars != SCHARS (seq))
1774          {          {
1775            Lisp_Object tem;            Lisp_Object tem;
1776    
1777            tem = make_uninit_multibyte_string (nchars, nbytes);            tem = make_uninit_multibyte_string (nchars, nbytes);
1778            if (!STRING_MULTIBYTE (seq))            if (!STRING_MULTIBYTE (seq))
1779              SET_STRING_BYTES (XSTRING (tem), -1);              STRING_SET_UNIBYTE (tem);
1780    
1781            for (i = nchars = nbytes = ibyte = 0;            for (i = nchars = nbytes = ibyte = 0;
1782                 i < XSTRING (seq)->size;                 i < SCHARS (seq);
1783                 ++i, ibyte += cbytes)                 ++i, ibyte += cbytes)
1784              {              {
1785                if (STRING_MULTIBYTE (seq))                if (STRING_MULTIBYTE (seq))
1786                  {                  {
1787                    c = STRING_CHAR (&XSTRING (seq)->data[ibyte],                    c = STRING_CHAR (SDATA (seq) + ibyte,
1788                                     STRING_BYTES (XSTRING (seq)) - ibyte);                                     SBYTES (seq) - ibyte);
1789                    cbytes = CHAR_BYTES (c);                    cbytes = CHAR_BYTES (c);
1790                  }                  }
1791                else                else
1792                  {                  {
1793                    c = XSTRING (seq)->data[i];                    c = SREF (seq, i);
1794                    cbytes = 1;                    cbytes = 1;
1795                  }                  }
1796    
1797                if (!INTEGERP (elt) || c != XINT (elt))                if (!INTEGERP (elt) || c != XINT (elt))
1798                  {                  {
1799                    unsigned char *from = &XSTRING (seq)->data[ibyte];                    unsigned char *from = SDATA (seq) + ibyte;
1800                    unsigned char *to   = &XSTRING (tem)->data[nbytes];                    unsigned char *to   = SDATA (tem) + nbytes;
1801                    EMACS_INT n;                    EMACS_INT n;
1802    
1803                    ++nchars;                    ++nchars;
# Line 1814  See also the function `nreverse', which Line 1869  See also the function `nreverse', which
1869    Lisp_Object new;    Lisp_Object new;
1870    
1871    for (new = Qnil; CONSP (list); list = XCDR (list))    for (new = Qnil; CONSP (list); list = XCDR (list))
1872      new = Fcons (XCAR (list), new);      {
1873          QUIT;
1874          new = Fcons (XCAR (list), new);
1875        }
1876    if (!NILP (list))    if (!NILP (list))
1877      wrong_type_argument (Qconsp, list);      wrong_type_argument (Qconsp, list);
1878    return new;    return new;
# Line 1925  one of the properties on the list.  */) Line 1983  one of the properties on the list.  */)
1983       Lisp_Object prop;       Lisp_Object prop;
1984  {  {
1985    Lisp_Object tail;    Lisp_Object tail;
1986      
1987    for (tail = plist;    for (tail = plist;
1988         CONSP (tail) && CONSP (XCDR (tail));         CONSP (tail) && CONSP (XCDR (tail));
1989         tail = XCDR (XCDR (tail)))         tail = XCDR (XCDR (tail)))
# Line 1941  one of the properties on the list.  */) Line 1999  one of the properties on the list.  */)
1999    
2000    if (!NILP (tail))    if (!NILP (tail))
2001      wrong_type_argument (Qlistp, prop);      wrong_type_argument (Qlistp, prop);
2002      
2003    return Qnil;    return Qnil;
2004  }  }
2005    
# Line 1979  The PLIST is modified by side effects. Line 2037  The PLIST is modified by side effects.
2037            Fsetcar (XCDR (tail), val);            Fsetcar (XCDR (tail), val);
2038            return plist;            return plist;
2039          }          }
2040          
2041        prev = tail;        prev = tail;
2042        QUIT;        QUIT;
2043      }      }
# Line 2014  one of the properties on the list.  */) Line 2072  one of the properties on the list.  */)
2072       Lisp_Object prop;       Lisp_Object prop;
2073  {  {
2074    Lisp_Object tail;    Lisp_Object tail;
2075      
2076    for (tail = plist;    for (tail = plist;
2077         CONSP (tail) && CONSP (XCDR (tail));         CONSP (tail) && CONSP (XCDR (tail));
2078         tail = XCDR (XCDR (tail)))         tail = XCDR (XCDR (tail)))
# Line 2027  one of the properties on the list.  */) Line 2085  one of the properties on the list.  */)
2085    
2086    if (!NILP (tail))    if (!NILP (tail))
2087      wrong_type_argument (Qlistp, prop);      wrong_type_argument (Qlistp, prop);
2088      
2089    return Qnil;    return Qnil;
2090  }  }
2091    
# Line 2055  The PLIST is modified by side effects. Line 2113  The PLIST is modified by side effects.
2113            Fsetcar (XCDR (tail), val);            Fsetcar (XCDR (tail), val);
2114            return plist;            return plist;
2115          }          }
2116          
2117        prev = tail;        prev = tail;
2118        QUIT;        QUIT;
2119      }      }
# Line 2176  internal_equal (o1, o2, depth) Line 2234  internal_equal (o1, o2, depth)
2234        break;        break;
2235    
2236      case Lisp_String:      case Lisp_String:
2237        if (XSTRING (o1)->size != XSTRING (o2)->size)        if (SCHARS (o1) != SCHARS (o2))
2238          return 0;          return 0;
2239        if (STRING_BYTES (XSTRING (o1)) != STRING_BYTES (XSTRING (o2)))        if (SBYTES (o1) != SBYTES (o2))
2240          return 0;          return 0;
2241        if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,        if (bcmp (SDATA (o1), SDATA (o2),
2242                  STRING_BYTES (XSTRING (o1))))                  SBYTES (o1)))
2243          return 0;          return 0;
2244        return 1;        return 1;
2245    
# Line 2190  internal_equal (o1, o2, depth) Line 2248  internal_equal (o1, o2, depth)
2248      case Lisp_Type_Limit:      case Lisp_Type_Limit:
2249        break;        break;
2250      }      }
2251      
2252    return 0;    return 0;
2253  }  }
2254    
# Line 2221  ARRAY is a vector, string, char-table, o Line 2279  ARRAY is a vector, string, char-table, o
2279      }      }
2280    else if (STRINGP (array))    else if (STRINGP (array))
2281      {      {
2282        register unsigned char *p = XSTRING (array)->data;        register unsigned char *p = SDATA (array);
2283        CHECK_NUMBER (item);        CHECK_NUMBER (item);
2284        charval = XINT (item);        charval = XINT (item);
2285        size = XSTRING (array)->size;        size = SCHARS (array);
2286        if (STRING_MULTIBYTE (array))        if (STRING_MULTIBYTE (array))
2287          {          {
2288            unsigned char str[MAX_MULTIBYTE_LENGTH];            unsigned char str[MAX_MULTIBYTE_LENGTH];
2289            int len = CHAR_STRING (charval, str);            int len = CHAR_STRING (charval, str);
2290            int size_byte = STRING_BYTES (XSTRING (array));            int size_byte = SBYTES (array);
2291            unsigned char *p1 = p, *endp = p + size_byte;            unsigned char *p1 = p, *endp = p + size_byte;
2292            int i;            int i;
2293    
# Line 2646  map_char_table (c_function, function, su Line 2704  map_char_table (c_function, function, su
2704      }      }
2705  }  }
2706    
2707    static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c));
2708    static void
2709    void_call2 (a, b, c)
2710         Lisp_Object a, b, c;
2711    {
2712      call2 (a, b, c);
2713    }
2714    
2715  DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,  DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
2716         2, 2, 0,         2, 2, 0,
2717         doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.         doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.
# Line 2659  The key is always a possible IDX argumen Line 2725  The key is always a possible IDX argumen
2725    
2726    CHECK_CHAR_TABLE (char_table);    CHECK_CHAR_TABLE (char_table);
2727    
2728    map_char_table (NULL, function, char_table, char_table, 0, indices);    /* When Lisp_Object is represented as a union, `call2' cannot directly
2729         be passed to map_char_table because it returns a Lisp_Object rather
2730         than returning nothing.
2731         Casting leads to crashes on some architectures.  -stef  */
2732      map_char_table (void_call2, Qnil, char_table, function, 0, indices);
2733    return Qnil;    return Qnil;
2734  }  }
2735    
# Line 2742  usage: (nconc &rest LISTS)  */) Line 2812  usage: (nconc &rest LISTS)  */)
2812        while (CONSP (tem))        while (CONSP (tem))
2813          {          {
2814            tail = tem;            tail = tem;
2815            tem = Fcdr (tail);            tem = XCDR (tail);
2816            QUIT;            QUIT;
2817          }          }
2818    
# Line 2935  is nil and `use-dialog-box' is non-nil. Line 3005  is nil and `use-dialog-box' is non-nil.
3005    Lisp_Object xprompt;    Lisp_Object xprompt;
3006    Lisp_Object args[2];    Lisp_Object args[2];
3007    struct gcpro gcpro1, gcpro2;    struct gcpro gcpro1, gcpro2;
3008    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
3009    
3010    specbind (Qcursor_in_echo_area, Qt);    specbind (Qcursor_in_echo_area, Qt);
3011    
# Line 3113  is nil, and `use-dialog-box' is non-nil. Line 3183  is nil, and `use-dialog-box' is non-nil.
3183        ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,        ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
3184                                                Qyes_or_no_p_history, Qnil,                                                Qyes_or_no_p_history, Qnil,
3185                                                Qnil));                                                Qnil));
3186        if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))        if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes"))
3187          {          {
3188            UNGCPRO;            UNGCPRO;
3189            return Qt;            return Qt;
3190          }          }
3191        if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))        if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no"))
3192          {          {
3193            UNGCPRO;            UNGCPRO;
3194            return Qnil;            return Qnil;
# Line 3133  is nil, and `use-dialog-box' is non-nil. Line 3203  is nil, and `use-dialog-box' is non-nil.
3203    
3204  DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,  DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
3205         doc: /* Return list of 1 minute, 5 minute and 15 minute load averages.         doc: /* Return list of 1 minute, 5 minute and 15 minute load averages.
3206        
3207  Each of the three load averages is multiplied by 100, then converted  Each of the three load averages is multiplied by 100, then converted
3208  to integer.  to integer.
3209    
# Line 3168  extern Lisp_Object Vafter_load_alist; Line 3238  extern Lisp_Object Vafter_load_alist;
3238    
3239  DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0,  DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0,
3240         doc: /* Returns t if FEATURE is present in this Emacs.         doc: /* Returns t if FEATURE is present in this Emacs.
3241        
3242  Use this to conditionalize execution of lisp code based on the  Use this to conditionalize execution of lisp code based on the
3243  presence or absence of emacs or environment extensions.  presence or absence of emacs or environment extensions.
3244  Use `provide' to declare that a feature is available.  This function  Use `provide' to declare that a feature is available.  This function
# Line 3206  particular subfeatures supported in this Line 3276  particular subfeatures supported in this
3276    
3277    /* Run any load-hooks for this file.  */    /* Run any load-hooks for this file.  */
3278    tem = Fassq (feature, Vafter_load_alist);    tem = Fassq (feature, Vafter_load_alist);
3279    if (!NILP (tem))    if (CONSP (tem))
3280      Fprogn (Fcdr (tem));      Fprogn (XCDR (tem));
3281    
3282    return feature;    return feature;
3283  }  }
# Line 3246  The normal messages at start and end of Line 3316  The normal messages at start and end of
3316    
3317    tem = Fmemq (feature, Vfeatures);    tem = Fmemq (feature, Vfeatures);
3318    
   LOADHIST_ATTACH (Fcons (Qrequire, feature));  
     
3319    if (NILP (tem))    if (NILP (tem))
3320      {      {
3321        int count = specpdl_ptr - specpdl;        int count = SPECPDL_INDEX ();
3322        int nesting = 0;        int nesting = 0;
3323    
3324          LOADHIST_ATTACH (Fcons (Qrequire, feature));
3325    
3326        /* This is to make sure that loadup.el gives a clear picture        /* This is to make sure that loadup.el gives a clear picture
3327           of what files are preloaded and when.  */           of what files are preloaded and when.  */
3328        if (! NILP (Vpurify_flag))        if (! NILP (Vpurify_flag))
3329          error ("(require %s) while preparing to dump",          error ("(require %s) while preparing to dump",
3330                 XSTRING (SYMBOL_NAME (feature))->data);                 SDATA (SYMBOL_NAME (feature)));
3331          
3332        /* A certain amount of recursive `require' is legitimate,        /* A certain amount of recursive `require' is legitimate,
3333           but if we require the same feature recursively 3 times,           but if we require the same feature recursively 3 times,
3334           signal an error.  */           signal an error.  */
# Line 3269  The normal messages at start and end of Line 3339  The normal messages at start and end of
3339              nesting++;              nesting++;
3340            tem = XCDR (tem);            tem = XCDR (tem);
3341          }          }
3342        if (nesting > 2)        if (nesting > 3)
3343          error ("Recursive `require' for feature `%s'",          error ("Recursive `require' for feature `%s'",
3344                 XSTRING (SYMBOL_NAME (feature))->data);                 SDATA (SYMBOL_NAME (feature)));
3345    
3346        /* Update the list for any nested `require's that occur.  */        /* Update the list for any nested `require's that occur.  */
3347        record_unwind_protect (require_unwind, require_nesting_list);        record_unwind_protect (require_unwind, require_nesting_list);
# Line 3294  The normal messages at start and end of Line 3364  The normal messages at start and end of
3364        tem = Fmemq (feature, Vfeatures);        tem = Fmemq (feature, Vfeatures);
3365        if (NILP (tem))        if (NILP (tem))
3366          error ("Required feature `%s' was not provided",          error ("Required feature `%s' was not provided",
3367                 XSTRING (SYMBOL_NAME (feature))->data);                 SDATA (SYMBOL_NAME (feature)));
3368    
3369        /* Once loading finishes, don't undo it.  */        /* Once loading finishes, don't undo it.  */
3370        Vautoload_queue = Qt;        Vautoload_queue = Qt;
# Line 3389  usage: (widget-apply WIDGET PROPERTY &re Line 3459  usage: (widget-apply WIDGET PROPERTY &re
3459    UNGCPRO;    UNGCPRO;
3460    return result;    return result;
3461  }  }
3462    
3463    #ifdef HAVE_LANGINFO_CODESET
3464    #include <langinfo.h>
3465    #endif
3466    
3467    DEFUN ("langinfo", Flanginfo, Slanginfo, 1, 1, 0,
3468           doc: /* Access locale data ITEM, if available.
3469    
3470    ITEM may be one of the following:
3471    `codeset', returning the character set as a string (locale item CODESET);
3472    `days', returning a 7-element vector of day names (locale items DAY_n);
3473    `months', returning a 12-element vector of month names (locale items MON_n);
3474    `paper', returning a list (WIDTH, HEIGHT) for the default paper size,
3475      where the width and height are in mm (locale items PAPER_WIDTH,
3476      PAPER_HEIGHT).
3477    
3478    If the system can't provide such information through a call to
3479    nl_langinfo(3), return nil.
3480    
3481    See also Info node `(libc)Locales'.
3482    
3483    The data read from the system are decoded using `locale-coding-system'.  */)
3484         (item)
3485         Lisp_Object item;
3486    {
3487      char *str = NULL;
3488    #ifdef HAVE_LANGINFO_CODESET
3489      Lisp_Object val;
3490      if (EQ (item, Qcodeset))
3491        {
3492          str = nl_langinfo (CODESET);
3493          return build_string (str);
3494        }
3495    #ifdef DAY_1
3496      else if (EQ (item, Qdays))    /* e.g. for calendar-day-name-array */
3497        {
3498          Lisp_Object v = Fmake_vector (make_number (7), Qnil);
3499          int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
3500          int i;
3501          synchronize_system_time_locale ();
3502          for (i = 0; i < 7; i++)
3503            {
3504              str = nl_langinfo (days[i]);
3505              val = make_unibyte_string (str, strlen (str));
3506              /* Fixme: Is this coding system necessarily right, even if
3507                 it is consistent with CODESET?  If not, what to do?  */
3508              Faset (v, make_number (i),
3509                     code_convert_string_norecord (val, Vlocale_coding_system,
3510                                                   0));
3511            }
3512          return v;
3513        }
3514    #endif  /* DAY_1 */
3515    #ifdef MON_1
3516      else if (EQ (item, Qmonths))  /* e.g. for calendar-month-name-array */
3517        {
3518          struct Lisp_Vector *p = allocate_vector (12);
3519          int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
3520                            MON_8, MON_9, MON_10, MON_11, MON_12};
3521          int i;
3522          synchronize_system_time_locale ();
3523          for (i = 0; i < 12; i++)
3524            {
3525              str = nl_langinfo (months[i]);
3526              val = make_unibyte_string (str, strlen (str));
3527              p->contents[i] =
3528                code_convert_string_norecord (val, Vlocale_coding_system, 0);
3529            }
3530          XSETVECTOR (val, p);
3531          return val;
3532        }
3533    #endif  /* MON_1 */
3534    /* LC_PAPER stuff isn't defined as accessible in glibc as of 2.3.1,
3535       but is in the locale files.  This could be used by ps-print.  */
3536    #ifdef PAPER_WIDTH
3537      else if (EQ (item, Qpaper))
3538        {
3539          return list2 (make_number (nl_langinfo (PAPER_WIDTH)),
3540                        make_number (nl_langinfo (PAPER_HEIGHT)));
3541        }
3542    #endif  /* PAPER_WIDTH */
3543    #endif  /* HAVE_LANGINFO_CODESET*/
3544        return Qnil;
3545    }
3546    
3547  /* base64 encode/decode functions (RFC 2045).  /* base64 encode/decode functions (RFC 2045).
3548     Based on code from GNU recode. */     Based on code from GNU recode. */
# Line 3557  into shorter lines.  */) Line 3711  into shorter lines.  */)
3711    /* We need to allocate enough room for encoding the text.    /* We need to allocate enough room for encoding the text.
3712       We need 33 1/3% more space, plus a newline every 76       We need 33 1/3% more space, plus a newline every 76
3713       characters, and then we round up. */       characters, and then we round up. */
3714    length = STRING_BYTES (XSTRING (string));    length = SBYTES (string);
3715    allength = length + length/3 + 1;    allength = length + length/3 + 1;
3716    allength += allength / MIME_LINE_LENGTH + 1 + 6;    allength += allength / MIME_LINE_LENGTH + 1 + 6;
3717    
# Line 3567  into shorter lines.  */) Line 3721  into shorter lines.  */)
3721    else    else
3722      encoded = (char *) xmalloc (allength);      encoded = (char *) xmalloc (allength);
3723    
3724    encoded_length = base64_encode_1 (XSTRING (string)->data,    encoded_length = base64_encode_1 (SDATA (string),
3725                                      encoded, length, NILP (no_line_break),                                      encoded, length, NILP (no_line_break),
3726                                      STRING_MULTIBYTE (string));                                      STRING_MULTIBYTE (string));
3727    if (encoded_length > allength)    if (encoded_length > allength)
# Line 3760  DEFUN ("base64-decode-string", Fbase64_d Line 3914  DEFUN ("base64-decode-string", Fbase64_d
3914    
3915    CHECK_STRING (string);    CHECK_STRING (string);
3916    
3917    length = STRING_BYTES (XSTRING (string));    length = SBYTES (string);
3918    /* We need to allocate enough room for decoding the text. */    /* We need to allocate enough room for decoding the text. */
3919    if (length <= MAX_ALLOCA)    if (length <= MAX_ALLOCA)
3920      decoded = (char *) alloca (length);      decoded = (char *) alloca (length);
# Line 3768  DEFUN ("base64-decode-string", Fbase64_d Line 3922  DEFUN ("base64-decode-string", Fbase64_d
3922      decoded = (char *) xmalloc (length);      decoded = (char *) xmalloc (length);
3923    
3924    /* The decoded result should be unibyte. */    /* The decoded result should be unibyte. */
3925    decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length,    decoded_length = base64_decode_1 (SDATA (string), decoded, length,
3926                                      0, NULL);                                      0, NULL);
3927    if (decoded_length > length)    if (decoded_length > length)
3928      abort ();      abort ();
# Line 3896  base64_decode_1 (from, to, length, multi Line 4050  base64_decode_1 (from, to, length, multi
4050     if a `:linear-search t' argument is given to make-hash-table.  */     if a `:linear-search t' argument is given to make-hash-table.  */
4051    
4052    
 /* Value is the key part of entry IDX in hash table H.  */  
   
 #define HASH_KEY(H, IDX)   AREF ((H)->key_and_value, 2 * (IDX))  
   
 /* Value is the value part of entry IDX in hash table H.  */  
   
 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)  
   
 /* Value is the index of the next entry following the one at IDX  
    in hash table H.  */  
   
 #define HASH_NEXT(H, IDX)  AREF ((H)->next, (IDX))  
   
 /* Value is the hash code computed for entry IDX in hash table H.  */  
   
 #define HASH_HASH(H, IDX)  AREF ((H)->hash, (IDX))  
   
 /* Value is the index of the element in hash table H that is the  
    start of the collision list at index IDX in the index vector of H.  */  
   
 #define HASH_INDEX(H, IDX)  AREF ((H)->index, (IDX))  
   
 /* Value is the size of hash table H.  */  
   
 #define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size  
   
4053  /* The list of all weak hash tables.  Don't staticpro this one.  */  /* The list of all weak hash tables.  Don't staticpro this one.  */
4054    
4055  Lisp_Object Vweak_hash_tables;  Lisp_Object Vweak_hash_tables;
# Line 4652  sweep_weak_hash_tables () Line 4780  sweep_weak_hash_tables ()
4780      {      {
4781        h = XHASH_TABLE (table);        h = XHASH_TABLE (table);
4782        next = h->next_weak;        next = h->next_weak;
4783          
4784        if (h->size & ARRAY_MARK_FLAG)        if (h->size & ARRAY_MARK_FLAG)
4785          {          {
4786            /* TABLE is marked as used.  Sweep its contents.  */            /* TABLE is marked as used.  Sweep its contents.  */
# Line 4798  sxhash (obj, depth) Line 4926  sxhash (obj, depth)
4926        break;        break;
4927    
4928      case Lisp_Symbol:      case Lisp_Symbol:
4929        hash = sxhash_string (XSTRING (SYMBOL_NAME (obj))->data,        hash = sxhash_string (SDATA (SYMBOL_NAME (obj)),
4930                              XSTRING (SYMBOL_NAME (obj))->size);                              SCHARS (SYMBOL_NAME (obj)));
4931        break;        break;
4932    
4933      case Lisp_Misc:      case Lisp_Misc:
# Line 4807  sxhash (obj, depth) Line 4935  sxhash (obj, depth)
4935        break;        break;
4936    
4937      case Lisp_String:      case Lisp_String:
4938        hash = sxhash_string (XSTRING (obj)->data, XSTRING (obj)->size);        hash = sxhash_string (SDATA (obj), SCHARS (obj));
4939        break;        break;
4940    
4941        /* This can be everything from a vector to an overlay.  */        /* This can be everything from a vector to an overlay.  */
# Line 4865  DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, Line 4993  DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1,
4993    
4994  DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,  DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
4995         doc: /* Create and return a new hash table.         doc: /* Create and return a new hash table.
4996              
4997  Arguments are specified as keyword/argument pairs.  The following  Arguments are specified as keyword/argument pairs.  The following
4998  arguments are defined:  arguments are defined:
4999    
# Line 4929  usage: (make-hash-table &rest KEYWORD-AR Line 5057  usage: (make-hash-table &rest KEYWORD-AR
5057    
5058    /* See if there's a `:size SIZE' argument.  */    /* See if there's a `:size SIZE' argument.  */
5059    i = get_key_arg (QCsize, nargs, args, used);    i = get_key_arg (QCsize, nargs, args, used);
5060    size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i];    size = i < 0 ? Qnil : args[i];
5061    if (!INTEGERP (size) || XINT (size) < 0)    if (NILP (size))
5062        size = make_number (DEFAULT_HASH_SIZE);
5063      else if (!INTEGERP (size) || XINT (size) < 0)
5064      Fsignal (Qerror,      Fsignal (Qerror,
5065               list2 (build_string ("Invalid hash table size"),               list2 (build_string ("Invalid hash table size"),
5066                      size));                      size));
# Line 4988  DEFUN ("copy-hash-table", Fcopy_hash_tab Line 5118  DEFUN ("copy-hash-table", Fcopy_hash_tab
5118  }  }
5119    
5120    
 DEFUN ("makehash", Fmakehash, Smakehash, 0, 1, 0,  
        doc: /* Create a new hash table.  
             
 Optional first argument TEST specifies how to compare keys in the  
 table.  Predefined tests are `eq', `eql', and `equal'.  Default is  
 `eql'.  New tests can be defined with `define-hash-table-test'.  */)  
      (test)  
      Lisp_Object test;  
 {  
   Lisp_Object args[2];  
   args[0] = QCtest;  
   args[1] = NILP (test) ? Qeql : test;  
   return Fmake_hash_table (2, args);  
 }  
   
   
5121  DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,  DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
5122         doc: /* Return the number of elements in TABLE.  */)         doc: /* Return the number of elements in TABLE.  */)
5123       (table)       (table)
# Line 5154  FUNCTION is called with 2 arguments KEY Line 5268  FUNCTION is called with 2 arguments KEY
5268  DEFUN ("define-hash-table-test", Fdefine_hash_table_test,  DEFUN ("define-hash-table-test", Fdefine_hash_table_test,
5269         Sdefine_hash_table_test, 3, 3, 0,         Sdefine_hash_table_test, 3, 3, 0,
5270         doc: /* Define a new hash table test with name NAME, a symbol.         doc: /* Define a new hash table test with name NAME, a symbol.
5271              
5272  In hash tables created with NAME specified as test, use TEST to  In hash tables created with NAME specified as test, use TEST to
5273  compare keys, and HASH for computing hash codes of keys.  compare keys, and HASH for computing hash codes of keys.
5274    
# Line 5180  including negative integers.  */) Line 5294  including negative integers.  */)
5294    
5295  DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,  DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
5296         doc: /* Return MD5 message digest of OBJECT, a buffer or string.         doc: /* Return MD5 message digest of OBJECT, a buffer or string.
5297              
5298  A message digest is a cryptographic checksum of a document, and the  A message digest is a cryptographic checksum of a document, and the
5299  algorithm to calculate it is defined in RFC 1321.  algorithm to calculate it is defined in RFC 1321.
5300    
# Line 5228  guesswork fails.  Normally, an error is Line 5342  guesswork fails.  Normally, an error is
5342            if (STRING_MULTIBYTE (object))            if (STRING_MULTIBYTE (object))
5343              /* use default, we can't guess correct value */              /* use default, we can't guess correct value */
5344              coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list));              coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list));
5345            else            else
5346              coding_system = Qraw_text;              coding_system = Qraw_text;
5347          }          }
5348          
5349        if (NILP (Fcoding_system_p (coding_system)))        if (NILP (Fcoding_system_p (coding_system)))
5350          {          {
5351            /* Invalid coding system.  */            /* Invalid coding system.  */
5352              
5353            if (!NILP (noerror))            if (!NILP (noerror))
5354              coding_system = Qraw_text;              coding_system = Qraw_text;
5355            else            else
# Line 5246  guesswork fails.  Normally, an error is Line 5360  guesswork fails.  Normally, an error is
5360        if (STRING_MULTIBYTE (object))        if (STRING_MULTIBYTE (object))
5361          object = code_convert_string1 (object, coding_system, Qnil, 1);          object = code_convert_string1 (object, coding_system, Qnil, 1);
5362    
5363        size = XSTRING (object)->size;        size = SCHARS (object);
5364        size_byte = STRING_BYTES (XSTRING (object));        size_byte = SBYTES (object);
5365    
5366        if (!NILP (start))        if (!NILP (start))
5367          {          {
# Line 5269  guesswork fails.  Normally, an error is Line 5383  guesswork fails.  Normally, an error is
5383        else        else
5384          {          {
5385            CHECK_NUMBER (end);            CHECK_NUMBER (end);
5386              
5387            end_char = XINT (end);            end_char = XINT (end);
5388    
5389            if (end_char < 0)            if (end_char < 0)
5390              end_char += size;              end_char += size;
5391              
5392            end_byte = string_char_to_byte (object, end_char);            end_byte = string_char_to_byte (object, end_char);
5393          }          }
5394          
5395        if (!(0 <= start_char && start_char <= end_char && end_char <= size))        if (!(0 <= start_char && start_char <= end_char && end_char <= size))
5396          args_out_of_range_3 (object, make_number (start_char),          args_out_of_range_3 (object, make_number (start_char),
5397                               make_number (end_char));                               make_number (end_char));
# Line 5287  guesswork fails.  Normally, an error is Line 5401  guesswork fails.  Normally, an error is
5401        CHECK_BUFFER (object);        CHECK_BUFFER (object);
5402    
5403        bp = XBUFFER (object);        bp = XBUFFER (object);
5404              
5405        if (NILP (start))        if (NILP (start))
5406          b = BUF_BEGV (bp);          b = BUF_BEGV (bp);
5407        else        else
# Line 5303  guesswork fails.  Normally, an error is Line 5417  guesswork fails.  Normally, an error is
5417            CHECK_NUMBER_COERCE_MARKER (end);            CHECK_NUMBER_COERCE_MARKER (end);
5418            e = XINT (end);            e = XINT (end);
5419          }          }
5420          
5421        if (b > e)        if (b > e)
5422          temp = b, b = e, e = temp;          temp = b, b = e, e = temp;
5423          
5424        if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp)))        if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp)))
5425          args_out_of_range (start, end);          args_out_of_range (start, end);
5426          
5427        if (NILP (coding_system))        if (NILP (coding_system))
5428          {          {
5429            /* Decide the coding-system to encode the data with.            /* Decide the coding-system to encode the data with.
5430               See fileio.c:Fwrite-region */               See fileio.c:Fwrite-region */
5431    
5432            if (!NILP (Vcoding_system_for_write))            if (!NILP (Vcoding_system_for_write))
# Line 5334  guesswork fails.  Normally, an error is Line 5448  guesswork fails.  Normally, an error is
5448                  {                  {
5449                    /* Check file-coding-system-alist.  */                    /* Check file-coding-system-alist.  */
5450                    Lisp_Object args[4], val;                    Lisp_Object args[4], val;
5451                      
5452                    args[0] = Qwrite_region; args[1] = start; args[2] = end;                    args[0] = Qwrite_region; args[1] = start; args[2] = end;
5453                    args[3] = Fbuffer_file_name(object);                    args[3] = Fbuffer_file_name(object);
5454                    val = Ffind_operation_coding_system (4, args);                    val = Ffind_operation_coding_system (4, args);
# Line 5379  guesswork fails.  Normally, an error is Line 5493  guesswork fails.  Normally, an error is
5493          object = code_convert_string1 (object, coding_system, Qnil, 1);          object = code_convert_string1 (object, coding_system, Qnil, 1);
5494      }      }
5495    
5496    md5_buffer (XSTRING (object)->data + start_byte,    md5_buffer (SDATA (object) + start_byte,
5497                STRING_BYTES(XSTRING (object)) - (size_byte - end_byte),                SBYTES (object) - (size_byte - end_byte),
5498                digest);                digest);
5499    
5500    for (i = 0; i < 16; i++)    for (i = 0; i < 16; i++)
# Line 5427  syms_of_fns () Line 5541  syms_of_fns ()
5541    defsubr (&Ssxhash);    defsubr (&Ssxhash);
5542    defsubr (&Smake_hash_table);    defsubr (&Smake_hash_table);
5543    defsubr (&Scopy_hash_table);    defsubr (&Scopy_hash_table);
   defsubr (&Smakehash);  
5544    defsubr (&Shash_table_count);    defsubr (&Shash_table_count);
5545    defsubr (&Shash_table_rehash_size);    defsubr (&Shash_table_rehash_size);
5546    defsubr (&Shash_table_rehash_threshold);    defsubr (&Shash_table_rehash_threshold);
# Line 5470  Used by `featurep' and `require', and al Line 5583  Used by `featurep' and `require', and al
5583    Qsubfeatures = intern ("subfeatures");    Qsubfeatures = intern ("subfeatures");
5584    staticpro (&Qsubfeatures);    staticpro (&Qsubfeatures);
5585    
5586    #ifdef HAVE_LANGINFO_CODESET
5587      Qcodeset = intern ("codeset");
5588      staticpro (&Qcodeset);
5589      Qdays = intern ("days");
5590      staticpro (&Qdays);
5591      Qmonths = intern ("months");
5592      staticpro (&Qmonths);
5593      Qpaper = intern ("paper");
5594      staticpro (&Qpaper);
5595    #endif  /* HAVE_LANGINFO_CODESET */
5596    
5597    DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,    DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
5598      doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.      doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
5599  This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands  This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
# Line 5492  invoked by mouse clicks and mouse menu i Line 5616  invoked by mouse clicks and mouse menu i
5616    defsubr (&Sstring_make_unibyte);    defsubr (&Sstring_make_unibyte);
5617    defsubr (&Sstring_as_multibyte);    defsubr (&Sstring_as_multibyte);
5618    defsubr (&Sstring_as_unibyte);    defsubr (&Sstring_as_unibyte);
5619      defsubr (&Sstring_to_multibyte);
5620    defsubr (&Scopy_alist);    defsubr (&Scopy_alist);
5621    defsubr (&Ssubstring);    defsubr (&Ssubstring);
5622    defsubr (&Ssubstring_no_properties);    defsubr (&Ssubstring_no_properties);
# Line 5546  invoked by mouse clicks and mouse menu i Line 5671  invoked by mouse clicks and mouse menu i
5671    defsubr (&Sbase64_encode_string);    defsubr (&Sbase64_encode_string);
5672    defsubr (&Sbase64_decode_string);    defsubr (&Sbase64_decode_string);
5673    defsubr (&Smd5);    defsubr (&Smd5);
5674      defsubr (&Slanginfo);
5675  }  }
5676    
5677    

Legend:
Removed from v.1.314  
changed lines
  Added in v.1.314.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26