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. |
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" |
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 |
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 |
|
|
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) |
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)) |
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, |
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 |
} |
} |
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 |
|
|
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 |
|
|
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 |
|
|
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 |
{ |
{ |
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 (); |
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) |
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) |
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 |
|
|
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. */ |
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 |
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 |
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 |
} |
} |
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++; |
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. */ |
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; |
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 |
{ |
{ |
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; |
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 |
{ |
{ |
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; |
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 |
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, |
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); |
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. |
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) |
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; |
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), |
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; |
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 |
} |
} |
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; |
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), |
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 |
|
|
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; |
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; |
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))) |
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 |
|
|
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 |
} |
} |
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))) |
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 |
|
|
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 |
} |
} |
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 |
|
|
2248 |
case Lisp_Type_Limit: |
case Lisp_Type_Limit: |
2249 |
break; |
break; |
2250 |
} |
} |
2251 |
|
|
2252 |
return 0; |
return 0; |
2253 |
} |
} |
2254 |
|
|
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 |
|
|
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. |
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 |
|
|
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 |
|
|
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 |
|
|
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; |
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 |
|
|
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 |
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 |
} |
} |
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. */ |
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); |
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; |
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. */ |
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 |
|
|
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) |
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); |
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 (); |
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; |
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. */ |
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: |
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. */ |
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 |
|
|
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)); |
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) |
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 |
|
|
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 |
|
|
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 |
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 |
{ |
{ |
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)); |
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 |
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)) |
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); |
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++) |
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); |
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 |
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); |
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 |
|
|