/* Random utility Lisp functions.
- Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "intervals.h"
#include "frame.h"
#include "window.h"
+#include "blockinput.h"
#if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS)
#include "xterm.h"
#endif
(sequence)
register Lisp_Object sequence;
{
- register Lisp_Object tail, val;
+ register Lisp_Object val;
register int i;
retry:
past the character that we are comparing;
hence we don't add or subtract 1 here. */
if (c1 < c2)
- return make_number (- i1);
+ return make_number (- i1 + XINT (start1));
else
- return make_number (i1);
+ return make_number (i1 - XINT (start1));
}
if (i1 < end1_char)
register Lisp_Object tail;
register Lisp_Object this;
int toindex;
- int toindex_byte;
+ int toindex_byte = 0;
register int result_len;
register int result_len_byte;
register int argnum;
string can't be decided until we finish the whole concatination.
So, we record strings that have text properties to be copied
here, and copy the text properties after the concatination. */
- struct textprop_rec *textprops;
+ struct textprop_rec *textprops = NULL;
/* Number of elments in textprops. */
int num_textprops = 0;
+ tail = Qnil;
+
/* In append, the last arg isn't treated like the others */
if (last_special && nargs > 0)
{
for (argnum = 0; argnum < nargs; argnum++)
{
Lisp_Object thislen;
- int thisleni;
+ int thisleni = 0;
register unsigned int thisindex = 0;
register unsigned int thisindex_byte = 0;
if (num_textprops > 0)
{
Lisp_Object props;
+ int last_to_end = -1;
for (argnum = 0; argnum < num_textprops; argnum++)
{
Qnil);
/* If successive arguments have properites, be sure that the
value of `composition' property be the copy. */
- if (argnum > 0
- && textprops[argnum - 1].argnum + 1 == textprops[argnum].argnum)
+ if (last_to_end == textprops[argnum].to)
make_composition_value_copy (props);
add_text_properties_from_list (val, props,
make_number (textprops[argnum].to));
+ last_to_end = textprops[argnum].to + XSTRING (this)->size;
}
}
return val;
"Return a unibyte string with the same individual bytes as STRING.\n\
If STRING is unibyte, the result is STRING itself.\n\
Otherwise it is a newly created string, with no text properties.\n\
-If STRING is multibyte and contains a character of charset `binary',\n\
-it is converted to the corresponding single byte.")
+If STRING is multibyte and contains a character of charset\n\
+`eight-bit-control' or `eight-bit-graphic', it is converted to the\n\
+corresponding single byte.")
(string)
Lisp_Object string;
{
If STRING is multibyte, the result is STRING itself.\n\
Otherwise it is a newly created string, with no text properties.\n\
If STRING is unibyte and contains an individual 8-bit byte (i.e. not\n\
-part of multibyte form), it is converted to the corresponding\n\
-multibyte character of charset `binary'.")
+part of a multibyte form), it is converted to the corresponding\n\
+multibyte character of charset `eight-bit-control' or `eight-bit-graphic'.")
(string)
Lisp_Object string;
{
{
Lisp_Object res;
int size;
- int size_byte;
+ int size_byte = 0;
int from_char, to_char;
- int from_byte, to_byte;
+ int from_byte = 0, to_byte = 0;
if (! (STRINGP (string) || VECTORP (string)))
wrong_type_argument (Qarrayp, string);
{
if (VECTORP (seq))
{
- EMACS_INT i, n, size;
+ EMACS_INT i, n;
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
if (n != ASIZE (seq))
{
- struct Lisp_Vector *p = allocate_vectorlike (n);
+ struct Lisp_Vector *p = allocate_vector (n);
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
p->contents[n++] = AREF (seq, i);
- p->size = n;
XSETVECTOR (seq, p);
}
}
tail = tem;
}
}
-\f
+\f
DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
"Extract a value from a property list.\n\
PLIST is a property list, which is a list of the form\n\
one of the properties on the list.")
(plist, prop)
Lisp_Object plist;
- register Lisp_Object prop;
+ Lisp_Object prop;
{
- register Lisp_Object tail;
- for (tail = plist; !NILP (tail); tail = Fcdr (XCDR (tail)))
+ Lisp_Object tail;
+
+ for (tail = plist;
+ CONSP (tail) && CONSP (XCDR (tail));
+ tail = XCDR (XCDR (tail)))
{
- register Lisp_Object tem;
- tem = Fcar (tail);
- if (EQ (prop, tem))
- return Fcar (XCDR (tail));
+ if (EQ (prop, XCAR (tail)))
+ return XCAR (XCDR (tail));
+
+ /* This function can be called asynchronously
+ (setup_coding_system). Don't QUIT in that case. */
+ if (!interrupt_input_blocked)
+ QUIT;
}
+
+ if (!NILP (tail))
+ wrong_type_argument (Qlistp, prop);
+
return Qnil;
}
Fsetcar (XCDR (tail), val);
return plist;
}
+
prev = tail;
+ QUIT;
}
newcell = Fcons (prop, Fcons (val, Qnil));
if (NILP (prev))
STRING_BYTES (XSTRING (o1))))
return 0;
return 1;
+
+ case Lisp_Int:
+ case Lisp_Symbol:
+ case Lisp_Type_Limit:
+ break;
}
+
return 0;
}
\f
XCHAR_TABLE (char_table)->contents[charset + 128] = value;
return value;
}
- char_table = temp;
- if (! SUB_CHAR_TABLE_P (char_table))
+ if (SUB_CHAR_TABLE_P (temp))
+ char_table = temp;
+ else
char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
- = make_sub_char_table (temp));
+ = make_sub_char_table (temp));
temp = XCHAR_TABLE (char_table)->contents[code1];
if (SUB_CHAR_TABLE_P (temp))
XCHAR_TABLE (temp)->defalt = value;
elt = XCHAR_TABLE (table)->contents[i];
if (!SUB_CHAR_TABLE_P (elt))
continue;
- dim = CHARSET_DIMENSION (i);
+ dim = CHARSET_DIMENSION (i - 128);
if (dim == 2)
for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim);
register int argnum;
register Lisp_Object tail, tem, val;
- val = Qnil;
+ val = tail = Qnil;
for (argnum = 0; argnum < nargs; argnum++)
{
`recenter', and `quit'.\)\n\
\n\
Under a windowing system a dialog box will be used if `last-nonmenu-event'\n\
-is nil.")
+is nil and `use-dialog-box' is non-nil.")
(prompt)
Lisp_Object prompt;
{
GCPRO2 (prompt, xprompt);
#ifdef HAVE_X_WINDOWS
- if (display_busy_cursor_p)
- cancel_busy_cursor ();
+ if (display_hourglass_p)
+ cancel_hourglass ();
#endif
while (1)
&& have_menus_p ())
{
Lisp_Object pane, menu;
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (3);
pane = Fcons (Fcons (build_string ("Yes"), Qt),
Fcons (Fcons (build_string ("No"), Qnil),
Qnil));
and can edit it until it has been confirmed.\n\
\n\
Under a windowing system a dialog box will be used if `last-nonmenu-event'\n\
-is nil.")
+is nil, and `use-dialog-box' is non-nil.")
(prompt)
Lisp_Object prompt;
{
&& have_menus_p ())
{
Lisp_Object pane, menu, obj;
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (4);
pane = Fcons (Fcons (build_string ("Yes"), Qt),
Fcons (Fcons (build_string ("No"), Qnil),
Qnil));
If FEATURE is not a member of the list `features', then the feature\n\
is not loaded; so load the file FILENAME.\n\
If FILENAME is omitted, the printname of FEATURE is used as the file name,\n\
-but in this case `load' insists on adding the suffix `.el' or `.elc'.\n\
+and `load' will try to load this name appended with the suffix `.elc',\n\
+`.el' or the unmodified name, in that order.\n\
If the optional third argument NOERROR is non-nil,\n\
-then return nil if the file is not found.\n\
-Normally the return value is FEATURE.")
- (feature, file_name, noerror)
- Lisp_Object feature, file_name, noerror;
+then return nil if the file is not found instead of signaling an error.\n\
+Normally the return value is FEATURE.\n\
+The normal messages at start and end of loading FILENAME are suppressed.")
+ (feature, filename, noerror)
+ Lisp_Object feature, filename, noerror;
{
register Lisp_Object tem;
CHECK_SYMBOL (feature, 0);
tem = Fmemq (feature, Vfeatures);
+
LOADHIST_ATTACH (Fcons (Qrequire, feature));
+
if (NILP (tem))
{
int count = specpdl_ptr - specpdl;
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- tem = Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
- noerror, Qt, Qnil, (NILP (file_name) ? Qt : Qnil));
+ tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
+ noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
/* If load failed entirely, return nil. */
if (NILP (tem))
return unbind_to (count, Qnil);
return result;
}
\f
-/* base64 encode/decode functions.
+/* base64 encode/decode functions (RFC 2045).
Based on code from GNU recode. */
#define MIME_LINE_LENGTH 76
/* Used by base64_decode_1 to retrieve a non-base64-ignorable
character or return retval if there are no characters left to
process. */
-#define READ_QUADRUPLET_BYTE(retval) \
- do \
- { \
- if (i == length) \
- return (retval); \
- c = from[i++]; \
- } \
+#define READ_QUADRUPLET_BYTE(retval) \
+ do \
+ { \
+ if (i == length) \
+ { \
+ if (nchars_return) \
+ *nchars_return = nchars; \
+ return (retval); \
+ } \
+ c = from[i++]; \
+ } \
while (IS_BASE64_IGNORABLE (c))
/* Don't use alloca for regions larger than this, lest we overflow
static int base64_encode_1 P_ ((const char *, char *, int, int, int));
-static int base64_decode_1 P_ ((const char *, char *, int));
+static int base64_decode_1 P_ ((const char *, char *, int, int, int *));
DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
2, 3, "r",
/* The encoding wasn't possible. */
if (length > MAX_ALLOCA)
xfree (encoded);
- error ("Base64 encoding failed");
+ error ("Multibyte character in data for base64 encoding");
}
/* Now we have encoded the region, so we insert the new contents
/* The encoding wasn't possible. */
if (length > MAX_ALLOCA)
xfree (encoded);
- error ("Base64 encoding failed");
+ error ("Multibyte character in data for base64 encoding");
}
encoded_string = make_unibyte_string (encoded, encoded_length);
{
int counter = 0, i = 0;
char *e = to;
- unsigned char c;
+ int c;
unsigned int value;
int bytes;
if (multibyte)
{
c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (c >= 256)
return -1;
i += bytes;
}
if (multibyte)
{
c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
+ if (c >= 256)
+ return -1;
i += bytes;
}
else
if (multibyte)
{
c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
+ if (c >= 256)
+ return -1;
i += bytes;
}
else
(beg, end)
Lisp_Object beg, end;
{
- int ibeg, iend, length;
+ int ibeg, iend, length, allength;
char *decoded;
int old_pos = PT;
int decoded_length;
int inserted_chars;
+ int multibyte = !NILP (current_buffer->enable_multibyte_characters);
validate_region (&beg, &end);
iend = CHAR_TO_BYTE (XFASTINT (end));
length = iend - ibeg;
- /* We need to allocate enough room for decoding the text. */
- if (length <= MAX_ALLOCA)
- decoded = (char *) alloca (length);
+
+ /* We need to allocate enough room for decoding the text. If we are
+ working on a multibyte buffer, each decoded code may occupy at
+ most two bytes. */
+ allength = multibyte ? length * 2 : length;
+ if (allength <= MAX_ALLOCA)
+ decoded = (char *) alloca (allength);
else
- decoded = (char *) xmalloc (length);
+ decoded = (char *) xmalloc (allength);
move_gap_both (XFASTINT (beg), ibeg);
- decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length);
- if (decoded_length > length)
+ decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length,
+ multibyte, &inserted_chars);
+ if (decoded_length > allength)
abort ();
if (decoded_length < 0)
{
/* The decoding wasn't possible. */
- if (length > MAX_ALLOCA)
+ if (allength > MAX_ALLOCA)
xfree (decoded);
- error ("Base64 decoding failed");
+ error ("Invalid base64 data");
}
- inserted_chars = decoded_length;
- if (!NILP (current_buffer->enable_multibyte_characters))
- decoded_length = str_to_multibyte (decoded, length, decoded_length);
-
/* Now we have decoded the region, so we insert the new contents
and delete the old. (Insert first in order to preserve markers.) */
TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0);
- if (length > MAX_ALLOCA)
+ if (allength > MAX_ALLOCA)
xfree (decoded);
/* Delete the original text. */
del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars,
else
decoded = (char *) xmalloc (length);
- decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length);
+ /* The decoded result should be unibyte. */
+ decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length,
+ 0, NULL);
if (decoded_length > length)
abort ();
else if (decoded_length >= 0)
if (length > MAX_ALLOCA)
xfree (decoded);
if (!STRINGP (decoded_string))
- error ("Base64 decoding failed");
+ error ("Invalid base64 data");
return decoded_string;
}
+/* Base64-decode the data at FROM of LENGHT bytes into TO. If
+ MULTIBYTE is nonzero, the decoded result should be in multibyte
+ form. If NCHARS_RETRUN is not NULL, store the number of produced
+ characters in *NCHARS_RETURN. */
+
static int
-base64_decode_1 (from, to, length)
+base64_decode_1 (from, to, length, multibyte, nchars_return)
const char *from;
char *to;
int length;
+ int multibyte;
+ int *nchars_return;
{
int i = 0;
char *e = to;
unsigned char c;
unsigned long value;
+ int nchars = 0;
while (1)
{
return -1;
value |= base64_char_to_value[c] << 12;
- *e++ = (unsigned char) (value >> 16);
+ c = (unsigned char) (value >> 16);
+ if (multibyte)
+ e += CHAR_STRING (c, e);
+ else
+ *e++ = c;
+ nchars++;
/* Process third byte of a quadruplet. */
return -1;
value |= base64_char_to_value[c] << 6;
- *e++ = (unsigned char) (0xff & value >> 8);
+ c = (unsigned char) (0xff & value >> 8);
+ if (multibyte)
+ e += CHAR_STRING (c, e);
+ else
+ *e++ = c;
+ nchars++;
/* Process fourth byte of a quadruplet. */
return -1;
value |= base64_char_to_value[c];
- *e++ = (unsigned char) (0xff & value);
+ c = (unsigned char) (0xff & value);
+ if (multibyte)
+ e += CHAR_STRING (c, e);
+ else
+ *e++ = c;
+ nchars++;
}
}
old_size = XVECTOR (vec)->size;
xassert (new_size >= old_size);
- v = allocate_vectorlike (new_size);
- v->size = new_size;
+ v = allocate_vector (new_size);
bcopy (XVECTOR (vec)->contents, v->contents,
old_size * sizeof *v->contents);
for (i = old_size; i < new_size; ++i)
struct Lisp_Hash_Table *h;
Lisp_Object key;
{
- /* Lisp strings can change their address. Don't try to compute a
- hash code for a string from its address. */
- if (STRINGP (key))
- return sxhash_string (XSTRING (key)->data, XSTRING (key)->size);
- else
- return XUINT (key) ^ XGCTYPE (key);
+ unsigned hash = XUINT (key) ^ XGCTYPE (key);
+ xassert ((hash & ~VALMASK) == 0);
+ return hash;
}
struct Lisp_Hash_Table *h;
Lisp_Object key;
{
- /* Lisp strings can change their address. Don't try to compute a
- hash code for a string from its address. */
- if (STRINGP (key))
- return sxhash_string (XSTRING (key)->data, XSTRING (key)->size);
- else if (FLOATP (key))
- return sxhash (key, 0);
+ unsigned hash;
+ if (FLOATP (key))
+ hash = sxhash (key, 0);
else
- return XUINT (key) ^ XGCTYPE (key);
+ hash = XUINT (key) ^ XGCTYPE (key);
+ xassert ((hash & ~VALMASK) == 0);
+ return hash;
}
struct Lisp_Hash_Table *h;
Lisp_Object key;
{
- return sxhash (key, 0);
+ unsigned hash = sxhash (key, 0);
+ xassert ((hash & ~VALMASK) == 0);
+ return hash;
}
hash = Ffuncall (2, args);
if (!INTEGERP (hash))
Fsignal (Qerror,
- list2 (build_string ("Illegal hash code returned from \
+ list2 (build_string ("Invalid hash code returned from \
user-supplied hash function"),
hash));
return XUINT (hash);
`equal' or a symbol denoting a user-defined test named TEST with
test and hash functions USER_TEST and USER_HASH.
- Give the table initial capacity SIZE, SIZE > 0, an integer.
+ Give the table initial capacity SIZE, SIZE >= 0, an integer.
If REHASH_SIZE is an integer, it must be > 0, and this hash table's
new size when it becomes full is computed by adding REHASH_SIZE to
Lisp_Object user_test, user_hash;
{
struct Lisp_Hash_Table *h;
- struct Lisp_Vector *v;
Lisp_Object table;
- int index_size, i, len, sz;
+ int index_size, i, sz;
/* Preconditions. */
xassert (SYMBOLP (test));
- xassert (INTEGERP (size) && XINT (size) > 0);
+ xassert (INTEGERP (size) && XINT (size) >= 0);
xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
|| (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0));
xassert (FLOATP (rehash_threshold)
&& XFLOATINT (rehash_threshold) > 0
&& XFLOATINT (rehash_threshold) <= 1.0);
- /* Allocate a vector, and initialize it. */
- len = VECSIZE (struct Lisp_Hash_Table);
- v = allocate_vectorlike (len);
- v->size = len;
- for (i = 0; i < len; ++i)
- v->contents[i] = Qnil;
+ if (XFASTINT (size) == 0)
+ size = make_number (1);
+
+ /* Allocate a table and initialize it. */
+ h = allocate_hash_table ();
/* Initialize hash table slots. */
sz = XFASTINT (size);
- h = (struct Lisp_Hash_Table *) v;
h->test = test;
if (EQ (test, Qeql))
Lisp_Object table;
struct Lisp_Hash_Table *h2;
struct Lisp_Vector *v, *next;
- int len;
- len = VECSIZE (struct Lisp_Hash_Table);
- v = allocate_vectorlike (len);
- h2 = (struct Lisp_Hash_Table *) v;
+ h2 = allocate_hash_table ();
next = h2->vec_next;
bcopy (h1, h2, sizeof *h2);
h2->vec_next = next;
for (bucket = 0; bucket < n; ++bucket)
{
- Lisp_Object idx, prev;
+ Lisp_Object idx, next, prev;
/* Follow collision chain, removing entries that
don't survive this garbage collection. */
- idx = HASH_INDEX (h, bucket);
prev = Qnil;
- while (!GC_NILP (idx))
+ for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next)
{
- int remove_p;
int i = XFASTINT (idx);
- Lisp_Object next;
- int key_known_to_survive_p, value_known_to_survive_p;
-
- key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
- value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+ int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
+ int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+ int remove_p;
if (EQ (h->weak, Qkey))
remove_p = !key_known_to_survive_p;
else if (EQ (h->weak, Qvalue))
remove_p = !value_known_to_survive_p;
else if (EQ (h->weak, Qkey_or_value))
- remove_p = !key_known_to_survive_p || !value_known_to_survive_p;
+ remove_p = !(key_known_to_survive_p || value_known_to_survive_p);
else if (EQ (h->weak, Qkey_and_value))
- remove_p = !key_known_to_survive_p && !value_known_to_survive_p;
+ remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
else
abort ();
{
/* Take out of collision chain. */
if (GC_NILP (prev))
- HASH_INDEX (h, i) = next;
+ HASH_INDEX (h, bucket) = next;
else
HASH_NEXT (h, XFASTINT (prev)) = next;
}
}
}
-
- idx = next;
}
}
void
sweep_weak_hash_tables ()
{
- Lisp_Object table;
- struct Lisp_Hash_Table *h, *prev;
+ Lisp_Object table, used, next;
+ struct Lisp_Hash_Table *h;
int marked;
/* Mark all keys and values that are in use. Keep on marking until
while (marked);
/* Remove tables and entries that aren't used. */
- prev = NULL;
- for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak)
+ for (table = Vweak_hash_tables, used = Qnil; !GC_NILP (table); table = next)
{
- prev = h;
h = XHASH_TABLE (table);
-
+ next = h->next_weak;
+
if (h->size & ARRAY_MARK_FLAG)
{
+ /* TABLE is marked as used. Sweep its contents. */
if (XFASTINT (h->count) > 0)
sweep_weak_table (h, 1);
- }
- else
- {
- /* Table is not marked, and will thus be freed.
- Take it out of the list of weak hash tables. */
- if (prev)
- prev->next_weak = h->next_weak;
- else
- Vweak_hash_tables = h->next_weak;
+
+ /* Add table to the list of used weak hash tables. */
+ h->next_weak = used;
+ used = table;
}
}
+
+ Vweak_hash_tables = used;
}
+ (unsigned)(Y))
-/* Return a hash for string PTR which has length LEN. */
+/* Return a hash for string PTR which has length LEN. The hash
+ code returned is guaranteed to fit in a Lisp integer. */
static unsigned
sxhash_string (ptr, len)
hash = ((hash << 3) + (hash >> 28) + c);
}
- return hash & 07777777777;
+ return hash & VALMASK;
}
prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || XFASTINT (Flength (prop)) < 2)
- Fsignal (Qerror, list2 (build_string ("Illegal hash table test"),
+ Fsignal (Qerror, list2 (build_string ("Invalid hash table test"),
test));
user_test = Fnth (make_number (0), prop);
user_hash = Fnth (make_number (1), prop);
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i];
- if (!INTEGERP (size) || XINT (size) <= 0)
+ if (!INTEGERP (size) || XINT (size) < 0)
Fsignal (Qerror,
- list2 (build_string ("Illegal hash table size"),
+ list2 (build_string ("Invalid hash table size"),
size));
/* Look for `:rehash-size SIZE'. */
|| (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
|| XFLOATINT (rehash_size) <= 1.0)
Fsignal (Qerror,
- list2 (build_string ("Illegal hash table rehash size"),
+ list2 (build_string ("Invalid hash table rehash size"),
rehash_size));
/* Look for `:rehash-threshold THRESHOLD'. */
|| XFLOATINT (rehash_threshold) <= 0.0
|| XFLOATINT (rehash_threshold) > 1.0)
Fsignal (Qerror,
- list2 (build_string ("Illegal hash table rehash threshold"),
+ list2 (build_string ("Invalid hash table rehash threshold"),
rehash_threshold));
/* Look for `:weakness WEAK'. */
&& !EQ (weak, Qvalue)
&& !EQ (weak, Qkey_or_value)
&& !EQ (weak, Qkey_and_value))
- Fsignal (Qerror, list2 (build_string ("Illegal hash table weakness"),
+ Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"),
weak));
/* Now, all args should have been used up, or there's a problem. */
}
+\f
+/************************************************************************
+ MD5
+ ************************************************************************/
+
+#include "md5.h"
+#include "coding.h"
+
+DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
+ "Return MD5 message digest of OBJECT, a buffer or string.\n\
+A message digest is a cryptographic checksum of a document,\n\
+and the algorithm to calculate it is defined in RFC 1321.\n\
+\n\
+The two optional arguments START and END are character positions\n\
+specifying for which part of OBJECT the message digest should be computed.\n\
+If nil or omitted, the digest is computed for the whole OBJECT.\n\
+\n\
+The MD5 message digest is computed from the result of encoding the\n\
+text in a coding system, not directly from the internal Emacs form\n\
+of the text. The optional fourth argument CODING-SYSTEM specifies\n\
+which coding system to encode the text with. It should be the same\n\
+coding system that you used or will use when actually writing the text\n\
+into a file.\n\
+\n\
+If CODING-SYSTEM is nil or omitted, the default depends on OBJECT.\n\
+If OBJECT is a buffer, the default for CODING-SYSTEM is whatever\n\
+coding system would be chosen by default for writing this text\n\
+into a file.\n\
+\n\
+If OBJECT is a string, the most preferred coding system (see the\n\
+command `prefer-coding-system') is used.\n\
+\n\
+If NOERROR is non-nil, silently assume the `raw_text' coding if the\n\
+guesswork fails. Normally, an error is signaled in such case.")
+ (object, start, end, coding_system, noerror)
+ Lisp_Object object, start, end, coding_system, noerror;
+{
+ unsigned char digest[16];
+ unsigned char value[33];
+ int i;
+ int size;
+ int size_byte = 0;
+ int start_char = 0, end_char = 0;
+ int start_byte = 0, end_byte = 0;
+ register int b, e;
+ register struct buffer *bp;
+ int temp;
+
+ if (STRINGP (object))
+ {
+ if (NILP (coding_system))
+ {
+ /* Decide the coding-system to encode the data with. */
+
+ if (STRING_MULTIBYTE (object))
+ /* use default, we can't guess correct value */
+ coding_system = XSYMBOL (XCAR (Vcoding_category_list))->value;
+ else
+ coding_system = Qraw_text;
+ }
+
+ if (NILP (Fcoding_system_p (coding_system)))
+ {
+ /* Invalid coding system. */
+
+ if (!NILP (noerror))
+ coding_system = Qraw_text;
+ else
+ while (1)
+ Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ }
+
+ if (STRING_MULTIBYTE (object))
+ object = code_convert_string1 (object, coding_system, Qnil, 1);
+
+ size = XSTRING (object)->size;
+ size_byte = STRING_BYTES (XSTRING (object));
+
+ if (!NILP (start))
+ {
+ CHECK_NUMBER (start, 1);
+
+ start_char = XINT (start);
+
+ if (start_char < 0)
+ start_char += size;
+
+ start_byte = string_char_to_byte (object, start_char);
+ }
+
+ if (NILP (end))
+ {
+ end_char = size;
+ end_byte = size_byte;
+ }
+ else
+ {
+ CHECK_NUMBER (end, 2);
+
+ end_char = XINT (end);
+
+ if (end_char < 0)
+ end_char += size;
+
+ end_byte = string_char_to_byte (object, end_char);
+ }
+
+ if (!(0 <= start_char && start_char <= end_char && end_char <= size))
+ args_out_of_range_3 (object, make_number (start_char),
+ make_number (end_char));
+ }
+ else
+ {
+ CHECK_BUFFER (object, 0);
+
+ bp = XBUFFER (object);
+
+ if (NILP (start))
+ b = BUF_BEGV (bp);
+ else
+ {
+ CHECK_NUMBER_COERCE_MARKER (start, 0);
+ b = XINT (start);
+ }
+
+ if (NILP (end))
+ e = BUF_ZV (bp);
+ else
+ {
+ CHECK_NUMBER_COERCE_MARKER (end, 1);
+ e = XINT (end);
+ }
+
+ if (b > e)
+ temp = b, b = e, e = temp;
+
+ if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp)))
+ args_out_of_range (start, end);
+
+ if (NILP (coding_system))
+ {
+ /* Decide the coding-system to encode the data with.
+ See fileio.c:Fwrite-region */
+
+ if (!NILP (Vcoding_system_for_write))
+ coding_system = Vcoding_system_for_write;
+ else
+ {
+ int force_raw_text = 0;
+
+ coding_system = XBUFFER (object)->buffer_file_coding_system;
+ if (NILP (coding_system)
+ || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+ {
+ coding_system = Qnil;
+ if (NILP (current_buffer->enable_multibyte_characters))
+ force_raw_text = 1;
+ }
+
+ if (NILP (coding_system) && !NILP (Fbuffer_file_name(object)))
+ {
+ /* Check file-coding-system-alist. */
+ Lisp_Object args[4], val;
+
+ args[0] = Qwrite_region; args[1] = start; args[2] = end;
+ args[3] = Fbuffer_file_name(object);
+ val = Ffind_operation_coding_system (4, args);
+ if (CONSP (val) && !NILP (XCDR (val)))
+ coding_system = XCDR (val);
+ }
+
+ if (NILP (coding_system)
+ && !NILP (XBUFFER (object)->buffer_file_coding_system))
+ {
+ /* If we still have not decided a coding system, use the
+ default value of buffer-file-coding-system. */
+ coding_system = XBUFFER (object)->buffer_file_coding_system;
+ }
+
+ if (!force_raw_text
+ && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
+ /* Confirm that VAL can surely encode the current region. */
+ coding_system = call3 (Vselect_safe_coding_system_function,
+ make_number (b), make_number (e),
+ coding_system);
+
+ if (force_raw_text)
+ coding_system = Qraw_text;
+ }
+
+ if (NILP (Fcoding_system_p (coding_system)))
+ {
+ /* Invalid coding system. */
+
+ if (!NILP (noerror))
+ coding_system = Qraw_text;
+ else
+ while (1)
+ Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ }
+ }
+
+ object = make_buffer_string (b, e, 0);
+
+ if (STRING_MULTIBYTE (object))
+ object = code_convert_string1 (object, coding_system, Qnil, 1);
+ }
+
+ md5_buffer (XSTRING (object)->data + start_byte,
+ STRING_BYTES(XSTRING (object)) - (size_byte - end_byte),
+ digest);
+
+ for (i = 0; i < 16; i++)
+ sprintf (&value[2 * i], "%02x", digest[i]);
+ value[32] = '\0';
+
+ return make_string (value, 32);
+}
\f
void
defsubr (&Sbase64_decode_region);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
+ defsubr (&Smd5);
}