X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Ffns.c;h=8a832a2a86dfdfa6e3114e119cc9e8d878b2aaf6;hp=ea6fcfe917589c2869bb3bc5b8f1178111c189d5;hb=716cfba952c1dc0d2cf5c968971f3780ba728a89;hpb=113b194be934327de99a168d809271db252c07c4 diff --git a/src/fns.c b/src/fns.c index ea6fcfe..8a832a2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -61,7 +61,7 @@ Lisp_Object Qidentity; static int internal_old_equal (Lisp_Object, Lisp_Object, int); static Lisp_Object -mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_bit_vector (Lisp_Object obj) { return Qnil; } @@ -69,10 +69,10 @@ mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) static void print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - int i; - struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); - int len = bit_vector_length (v); - int last = len; + size_t i; + Lisp_Bit_Vector *v = XBIT_VECTOR (obj); + size_t len = bit_vector_length (v); + size_t last = len; if (INTP (Vprint_length)) last = min (len, XINT (Vprint_length)); @@ -92,8 +92,8 @@ print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) static int bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); - struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); + Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); + Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); return ((bit_vector_length (v1) == bit_vector_length (v2)) && !memcmp (v1->bits, v2->bits, @@ -104,17 +104,24 @@ bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) static unsigned long bit_vector_hash (Lisp_Object obj, int depth) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); + Lisp_Bit_Vector *v = XBIT_VECTOR (obj); return HASH2 (bit_vector_length (v), memory_hash (v->bits, BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * sizeof (long))); } +static const struct lrecord_description bit_vector_description[] = { + { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) }, + { XD_END } +}; + + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, mark_bit_vector, print_bit_vector, 0, bit_vector_equal, bit_vector_hash, - struct Lisp_Bit_Vector); + bit_vector_description, + Lisp_Bit_Vector); DEFUN ("identity", Fidentity, 1, 1, 0, /* Return the argument unchanged. @@ -177,7 +184,7 @@ length_with_bytecode_hack (Lisp_Object seq) return XINT (Flength (seq)); else { - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); return (f->flags.interactivep ? COMPILED_INTERACTIVE : f->flags.domainp ? COMPILED_DOMAIN : @@ -208,7 +215,7 @@ Return the length of vector, bit vector, list or string SEQUENCE. return make_int (XSTRING_CHAR_LENGTH (sequence)); else if (CONSP (sequence)) { - int len; + size_t len; GET_EXTERNAL_LIST_LENGTH (sequence, len); return make_int (len); } @@ -235,7 +242,7 @@ which is at least the number of distinct elements. (list)) { Lisp_Object hare, tortoise; - int len; + size_t len; for (hare = tortoise = list, len = 0; CONSP (hare) && (! EQ (hare, tortoise) || len == 0); @@ -261,7 +268,7 @@ Symbols are also allowed; their print names are used instead. (s1, s2)) { Bytecount len; - struct Lisp_String *p1, *p2; + Lisp_String *p1, *p2; if (SYMBOLP (s1)) p1 = XSYMBOL (s1)->name; @@ -308,7 +315,7 @@ may be solved. */ (s1, s2)) { - struct Lisp_String *p1, *p2; + Lisp_String *p1, *p2; Charcount end, len2; int i; @@ -339,32 +346,41 @@ may be solved. properly, it would still not work because strcoll() does not handle multiple locales. This is the fundamental flaw in the locale model. */ - Bytecount bcend = charcount_to_bytecount (string_data (p1), end); - /* Compare strings using collation order of locale. */ - /* Need to be tricky to handle embedded nulls. */ + { + Bytecount bcend = charcount_to_bytecount (string_data (p1), end); + /* Compare strings using collation order of locale. */ + /* Need to be tricky to handle embedded nulls. */ - for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1) - { - int val = strcoll ((char *) string_data (p1) + i, - (char *) string_data (p2) + i); - if (val < 0) - return Qt; - if (val > 0) - return Qnil; - } + for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1) + { + int val = strcoll ((char *) string_data (p1) + i, + (char *) string_data (p2) + i); + if (val < 0) + return Qt; + if (val > 0) + return Qnil; + } + } #else /* not I18N2, or MULE */ - /* #### It is not really necessary to do this: We could compare - byte-by-byte and still get a reasonable comparison, since this - would compare characters with a charset in the same way. - With a little rearrangement of the leading bytes, we could - make most inter-charset comparisons work out the same, too; - even if some don't, this is not a big deal because inter-charset - comparisons aren't really well-defined anyway. */ - for (i = 0; i < end; i++) - { - if (string_char (p1, i) != string_char (p2, i)) - return string_char (p1, i) < string_char (p2, i) ? Qt : Qnil; - } + { + Bufbyte *ptr1 = string_data (p1); + Bufbyte *ptr2 = string_data (p2); + + /* #### It is not really necessary to do this: We could compare + byte-by-byte and still get a reasonable comparison, since this + would compare characters with a charset in the same way. With + a little rearrangement of the leading bytes, we could make most + inter-charset comparisons work out the same, too; even if some + don't, this is not a big deal because inter-charset comparisons + aren't really well-defined anyway. */ + for (i = 0; i < end; i++) + { + if (charptr_emchar (ptr1) != charptr_emchar (ptr2)) + return charptr_emchar (ptr1) < charptr_emchar (ptr2) ? Qt : Qnil; + INC_CHARPTR (ptr1); + INC_CHARPTR (ptr2); + } + } #endif /* not I18N2, or MULE */ /* Can't do i < len2 because then comparison between "foo" and "foo^@" won't work right in I18N2 case */ @@ -378,7 +394,7 @@ of the string are changed (e.g. with `aset'). It wraps around occasionally. */ (string)) { - struct Lisp_String *s; + Lisp_String *s; CHECK_STRING (string); s = XSTRING (string); @@ -391,7 +407,7 @@ of the string are changed (e.g. with `aset'). It wraps around occasionally. void bump_string_modiff (Lisp_Object str) { - struct Lisp_String *s = XSTRING (str); + Lisp_String *s = XSTRING (str); Lisp_Object *ptr = &s->plist; #ifdef I18N3 @@ -506,7 +522,7 @@ copy_list (Lisp_Object list) Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); Lisp_Object last = list_copy; Lisp_Object hare, tortoise; - int len; + size_t len; for (tortoise = hare = XCDR (list), len = 1; CONSP (hare); @@ -907,7 +923,7 @@ If SEQ is a string, relevant parts of the string-extent-data are copied */ (seq, from, to)) { - int len, f, t; + EMACS_INT len, f, t; if (STRINGP (seq)) return Fsubstring (seq, from, to); @@ -941,7 +957,7 @@ If SEQ is a string, relevant parts of the string-extent-data are copied if (VECTORP (seq)) { Lisp_Object result = make_vector (t - f, Qnil); - int i; + EMACS_INT i; Lisp_Object *in_elts = XVECTOR_DATA (seq); Lisp_Object *out_elts = XVECTOR_DATA (result); @@ -953,7 +969,7 @@ If SEQ is a string, relevant parts of the string-extent-data are copied if (LISTP (seq)) { Lisp_Object result = Qnil; - int i; + EMACS_INT i; seq = Fnthcdr (make_int (f), seq); @@ -969,7 +985,7 @@ If SEQ is a string, relevant parts of the string-extent-data are copied /* bit vector */ { Lisp_Object result = make_bit_vector (t - f, Qzero); - int i; + EMACS_INT i; for (i = f; i < t; i++) set_bit_vector_bit (XBIT_VECTOR (result), i - f, @@ -984,7 +1000,7 @@ Take cdr N times on LIST, and return the result. */ (n, list)) { - REGISTER int i; + REGISTER size_t i; REGISTER Lisp_Object tail = list; CHECK_NATNUM (n); for (i = XINT (n); i; i--) @@ -1043,7 +1059,7 @@ Return element of SEQUENCE at index N. #ifdef LOSING_BYTECODE else if (COMPILED_FUNCTIONP (sequence)) { - int idx = XINT (n); + EMACS_INT idx = XINT (n); if (idx < 0) { lose: @@ -1095,7 +1111,7 @@ If N is greater than the length of LIST, then LIST itself is returned. */ (list, n)) { - int int_n, count; + EMACS_INT int_n, count; Lisp_Object retval, tortoise, hare; CHECK_LIST (list); @@ -1131,7 +1147,7 @@ If LIST has N or fewer elements, nil is returned and LIST is unmodified. */ (list, n)) { - int int_n; + EMACS_INT int_n; CHECK_LIST (list); @@ -1834,7 +1850,7 @@ int plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present, int laxp, int depth) { - int eqp = (depth == -1); /* -1 as depth means us eq, not equal. */ + int eqp = (depth == -1); /* -1 as depth means use eq, not equal. */ int la, lb, m, i, fill; Lisp_Object *keys, *vals; char *flags; @@ -1878,10 +1894,10 @@ plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present, { if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth)) { - if ((eqp - /* We narrowly escaped being Ebolified here. */ - ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) - : !internal_equal (v, vals [i], depth))) + if (eqp + /* We narrowly escaped being Ebolified here. */ + ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) + : !internal_equal (v, vals [i], depth)) /* a property in B has a different value than in A */ goto MISMATCH; flags [i] = 1; @@ -2585,7 +2601,7 @@ symbol_remprop (Lisp_Object symbol, Lisp_Object propname) static Lisp_Object * -string_plist_ptr (struct Lisp_String *s) +string_plist_ptr (Lisp_String *s) { Lisp_Object *ptr = &s->plist; @@ -2597,7 +2613,7 @@ string_plist_ptr (struct Lisp_String *s) } static Lisp_Object -string_getprop (struct Lisp_String *s, Lisp_Object property, +string_getprop (Lisp_String *s, Lisp_Object property, Lisp_Object default_) { Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0, @@ -2606,20 +2622,20 @@ string_getprop (struct Lisp_String *s, Lisp_Object property, } static void -string_putprop (struct Lisp_String *s, Lisp_Object property, +string_putprop (Lisp_String *s, Lisp_Object property, Lisp_Object value) { external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME); } static int -string_remprop (struct Lisp_String *s, Lisp_Object property) +string_remprop (Lisp_String *s, Lisp_Object property) { return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME); } static Lisp_Object -string_plist (struct Lisp_String *s) +string_plist (Lisp_String *s) { return *string_plist_ptr (s); } @@ -2705,12 +2721,6 @@ See also `get', `remprop', and `object-plist'. return value; } -void -pure_put (Lisp_Object sym, Lisp_Object prop, Lisp_Object val) -{ - Fput (sym, prop, Fpurecopy (val)); -} - DEFUN ("remprop", Fremprop, 2, 2, 0, /* Remove from OBJECT's property list the property PROPNAME and its value. OBJECT can be a symbol, face, extent, or string. Returns @@ -2854,7 +2864,7 @@ Do not use it. DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* -Store each element of ARRAY with ITEM. +Destructively modify ARRAY by replacing each element with ITEM. ARRAY is a vector, bit vector, or string. */ (array, item)) @@ -2862,15 +2872,28 @@ ARRAY is a vector, bit vector, or string. retry: if (STRINGP (array)) { - Emchar charval; - struct Lisp_String *s = XSTRING (array); - Charcount len = string_char_length (s); - Charcount i; + Lisp_String *s = XSTRING (array); + Bytecount old_bytecount = string_length (s); + Bytecount new_bytecount; + Bytecount item_bytecount; + Bufbyte item_buf[MAX_EMCHAR_LEN]; + Bufbyte *p; + Bufbyte *end; + CHECK_CHAR_COERCE_INT (item); CHECK_LISP_WRITEABLE (array); - charval = XCHAR (item); - for (i = 0; i < len; i++) - set_string_char (s, i, charval); + + item_bytecount = set_charptr_emchar (item_buf, XCHAR (item)); + new_bytecount = item_bytecount * string_char_length (s); + + resize_string (s, -1, new_bytecount - old_bytecount); + + for (p = string_data (s), end = p + new_bytecount; + p < end; + p += item_bytecount) + memcpy (p, item_buf, item_bytecount); + *p = '\0'; + bump_string_modiff (array); } else if (VECTORP (array)) @@ -2883,7 +2906,7 @@ ARRAY is a vector, bit vector, or string. } else if (BIT_VECTORP (array)) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (array); + Lisp_Bit_Vector *v = XBIT_VECTOR (array); int len = bit_vector_length (v); int bit; CHECK_BIT (item); @@ -3033,15 +3056,16 @@ changing the value of `foo'. } -/* This is the guts of all mapping functions. - Apply fn to each element of seq, one by one, - storing the results into elements of vals, a C vector of Lisp_Objects. - leni is the length of vals, which should also be the length of seq. +/* This is the guts of several mapping functions. + Apply FUNCTION to each element of SEQUENCE, one by one, + storing the results into elements of VALS, a C vector of Lisp_Objects. + LENI is the length of VALS, which should also be the length of SEQUENCE. If VALS is a null pointer, do not accumulate the results. */ static void -mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) +mapcar1 (size_t leni, Lisp_Object *vals, + Lisp_Object function, Lisp_Object sequence) { Lisp_Object result; Lisp_Object args[2]; @@ -3054,21 +3078,61 @@ mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) gcpro1.nvars = 0; } - args[0] = fn; + args[0] = function; - if (LISTP (seq)) + if (LISTP (sequence)) { - for (i = 0; i < leni; i++) + /* A devious `function' could either: + - insert garbage into the list in front of us, causing XCDR to crash + - amputate the list behind us using (setcdr), causing the remaining + elts to lose their GCPRO status. + + if (vals != 0) we avoid this by copying the elts into the + `vals' array. By a stroke of luck, `vals' is exactly large + enough to hold the elts left to be traversed as well as the + results computed so far. + + if (vals == 0) we don't have any free space available and + don't want to eat up any more stack with alloca(). + So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */ + + if (vals) { - args[1] = XCAR (seq); - seq = XCDR (seq); - result = Ffuncall (2, args); - if (vals) vals[gcpro1.nvars++] = result; + Lisp_Object *val = vals; + Lisp_Object elt; + + LIST_LOOP_2 (elt, sequence) + *val++ = elt; + + gcpro1.nvars = leni; + + for (i = 0; i < leni; i++) + { + args[1] = vals[i]; + vals[i] = Ffuncall (2, args); + } + } + else + { + Lisp_Object elt, tail; + struct gcpro ngcpro1; + + NGCPRO1 (tail); + + { + EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) + { + args[1] = elt; + Ffuncall (2, args); + } + } + + NUNGCPRO; } } - else if (VECTORP (seq)) + else if (VECTORP (sequence)) { - Lisp_Object *objs = XVECTOR_DATA (seq); + Lisp_Object *objs = XVECTOR_DATA (sequence); for (i = 0; i < leni; i++) { args[1] = *objs++; @@ -3076,10 +3140,16 @@ mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) if (vals) vals[gcpro1.nvars++] = result; } } - else if (STRINGP (seq)) + else if (STRINGP (sequence)) { - Bufbyte *p = XSTRING_DATA (seq); - for (i = 0; i < leni; i++) + /* The string data of `sequence' might be relocated during GC. */ + Bytecount slen = XSTRING_LENGTH (sequence); + Bufbyte *p = alloca_array (Bufbyte, slen); + Bufbyte *end = p + slen; + + memcpy (p, XSTRING_DATA (sequence), slen); + + while (p < end) { args[1] = make_char (charptr_emchar (p)); INC_CHARPTR (p); @@ -3087,9 +3157,9 @@ mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) if (vals) vals[gcpro1.nvars++] = result; } } - else if (BIT_VECTORP (seq)) + else if (BIT_VECTORP (sequence)) { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq); + Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); for (i = 0; i < leni; i++) { args[1] = make_int (bit_vector_bit (v, i)); @@ -3098,20 +3168,21 @@ mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) } } else - abort(); /* cannot get here since Flength(seq) did not get an error */ + abort(); /* cannot get here since Flength(sequence) did not get an error */ if (vals) UNGCPRO; } DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* -Apply FN to each element of SEQ, and concat the results as strings. -In between each pair of results, stick in SEP. -Thus, " " as SEP results in spaces between the values returned by FN. +Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. +In between each pair of results, insert SEPARATOR. Thus, using " " as +SEPARATOR results in spaces between the values returned by FUNCTION. +SEQUENCE may be a list, a vector, a bit vector, or a string. */ - (fn, seq, sep)) + (function, sequence, separator)) { - size_t len = XINT (Flength (seq)); + size_t len = XINT (Flength (sequence)); Lisp_Object *args; int i; struct gcpro gcpro1; @@ -3121,63 +3192,66 @@ Thus, " " as SEP results in spaces between the values returned by FN. args = alloca_array (Lisp_Object, nargs); - GCPRO1 (sep); - mapcar1 (len, args, fn, seq); + GCPRO1 (separator); + mapcar1 (len, args, function, sequence); UNGCPRO; for (i = len - 1; i >= 0; i--) args[i + i] = args[i]; for (i = 1; i < nargs; i += 2) - args[i] = sep; + args[i] = separator; return Fconcat (nargs, args); } DEFUN ("mapcar", Fmapcar, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE, and make a list of the results. -The result is a list just as long as SEQUENCE. +Apply FUNCTION to each element of SEQUENCE; return a list of the results. +The result is a list of the same length as SEQUENCE. SEQUENCE may be a list, a vector, a bit vector, or a string. */ - (fn, seq)) + (function, sequence)) { - size_t len = XINT (Flength (seq)); + size_t len = XINT (Flength (sequence)); Lisp_Object *args = alloca_array (Lisp_Object, len); - mapcar1 (len, args, fn, seq); + mapcar1 (len, args, function, sequence); return Flist (len, args); } DEFUN ("mapvector", Fmapvector, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE, making a vector of the results. +Apply FUNCTION to each element of SEQUENCE; return a vector of the results. The result is a vector of the same length as SEQUENCE. -SEQUENCE may be a list, a vector or a string. +SEQUENCE may be a list, a vector, a bit vector, or a string. */ - (fn, seq)) + (function, sequence)) { - size_t len = XINT (Flength (seq)); + size_t len = XINT (Flength (sequence)); Lisp_Object result = make_vector (len, Qnil); struct gcpro gcpro1; GCPRO1 (result); - mapcar1 (len, XVECTOR_DATA (result), fn, seq); + mapcar1 (len, XVECTOR_DATA (result), function, sequence); UNGCPRO; return result; } -DEFUN ("mapc", Fmapc, 2, 2, 0, /* +DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /* Apply FUNCTION to each element of SEQUENCE. SEQUENCE may be a list, a vector, a bit vector, or a string. This function is like `mapcar' but does not accumulate the results, which is more efficient if you do not use the results. + +The difference between this and `mapc' is that `mapc' supports all +the spiffy Common Lisp arguments. You should normally use `mapc'. */ - (fn, seq)) + (function, sequence)) { - mapcar1 (XINT (Flength (seq)), 0, fn, seq); + mapcar1 (XINT (Flength (sequence)), 0, function, sequence); - return seq; + return sequence; } @@ -3382,9 +3456,12 @@ If FILENAME is omitted, the printname of FEATURE is used as the file name. } /* base64 encode/decode functions. - Based on code from GNU recode. */ -#define MIME_LINE_LENGTH 76 + Originally based on code from GNU recode. Ported to FSF Emacs by + Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and + subsequently heavily hacked by Hrvoje Niksic. */ + +#define MIME_LINE_LENGTH 72 #define IS_ASCII(Character) \ ((Character) < 128) @@ -3504,102 +3581,89 @@ base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break) } #undef ADVANCE_INPUT -/* Semantically identical to ADVANCE_INPUT above, only no >255 - checking is needed for decoding -- checking is covered by IS_BASE64 - below. */ -#define ADVANCE_INPUT(c, stream) \ - (ec = Lstream_get_emchar (stream), \ - ec == -1 ? 0 : (c = (Bufbyte)ec, 1)) - -/* Get next character from the stream, but ignore it if it's - whitespace. ENDP is set to 1 if EOF is hit. */ -#define ADVANCE_INPUT_IGNORE_WHITESPACE(c, endp, stream) do { \ - endp = 0; \ - do { \ - if (!ADVANCE_INPUT (c, stream)) \ - endp = 1; \ - } while (!endp && (c == ' ' || c == '\t' || c == '\r' || c == '\n' \ - || c == '\f' || c == '\v')); \ -} while (0) - -#define STORE_BYTE(pos, val) do { \ +/* Get next character from the stream, except that non-base64 + characters are ignored. This is in accordance with rfc2045. EC + should be an Emchar, so that it can hold -1 as the value for EOF. */ +#define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \ + ec = Lstream_get_emchar (stream); \ + ++streampos; \ + /* IS_BASE64 may not be called with negative arguments so check for \ + EOF first. */ \ + if (ec < 0 || IS_BASE64 (ec) || ec == '=') \ + break; \ +} while (1) + +#define STORE_BYTE(pos, val, ccnt) do { \ pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \ - ++*ccptr; \ + ++ccnt; \ } while (0) static Bytind base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr) { + Charcount ccnt = 0; Bufbyte *e = to; - unsigned long value; + EMACS_INT streampos = 0; - *ccptr = 0; while (1) { - Bufbyte c; Emchar ec; - int endp; - - ADVANCE_INPUT_IGNORE_WHITESPACE (c, endp, istream); - if (endp) - break; + unsigned long value; /* Process first byte of a quadruplet. */ - if (!IS_BASE64 (c)) - return -1; - value = base64_char_to_value[c] << 18; + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + break; + if (ec == '=') + signal_simple_error ("Illegal `=' character while decoding base64", + make_int (streampos)); + value = base64_char_to_value[ec] << 18; /* Process second byte of a quadruplet. */ - ADVANCE_INPUT_IGNORE_WHITESPACE (c, endp, istream); - if (endp) - return -1; - - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c] << 12; - - STORE_BYTE (e, value >> 16); + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + if (ec == '=') + signal_simple_error ("Illegal `=' character while decoding base64", + make_int (streampos)); + value |= base64_char_to_value[ec] << 12; + STORE_BYTE (e, value >> 16, ccnt); /* Process third byte of a quadruplet. */ - ADVANCE_INPUT_IGNORE_WHITESPACE (c, endp, istream); - if (endp) - return -1; + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); - if (c == '=') + if (ec == '=') { - ADVANCE_INPUT_IGNORE_WHITESPACE (c, endp, istream); - if (endp) - return -1; - if (c != '=') - return -1; + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + if (ec != '=') + signal_simple_error ("Padding `=' expected but not found while decoding base64", + make_int (streampos)); continue; } - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c] << 6; - - STORE_BYTE (e, 0xff & value >> 8); + value |= base64_char_to_value[ec] << 6; + STORE_BYTE (e, 0xff & value >> 8, ccnt); /* Process fourth byte of a quadruplet. */ - ADVANCE_INPUT_IGNORE_WHITESPACE (c, endp, istream); - if (endp) - return -1; - - if (c == '=') + ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); + if (ec < 0) + error ("Premature EOF while decoding base64"); + if (ec == '=') continue; - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c]; - - STORE_BYTE (e, 0xff & value); + value |= base64_char_to_value[ec]; + STORE_BYTE (e, 0xff & value, ccnt); } + *ccptr = ccnt; return e - to; } #undef ADVANCE_INPUT -#undef ADVANCE_INPUT_IGNORE_WHITESPACE +#undef ADVANCE_INPUT_IGNORE_NONBASE64 #undef STORE_BYTE static Lisp_Object @@ -3677,8 +3741,8 @@ into shorter lines. XMALLOC_UNBIND (encoded, allength, speccount); buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); - /* Simulate FSF Emacs: if point was in the region, place it at the - beginning. */ + /* Simulate FSF Emacs implementation of this function: if point was + in the region, place it at the beginning. */ if (old_pt >= begv && old_pt < zv) BUF_SET_PT (buf, begv); @@ -3719,6 +3783,7 @@ DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* Base64-decode the region between BEG and END. Return the length of the decoded text. If the region can't be decoded, return nil and don't modify the buffer. +Characters out of the base64 alphabet are ignored. */ (beg, end)) { @@ -3743,13 +3808,6 @@ If the region can't be decoded, return nil and don't modify the buffer. abort (); Lstream_delete (XLSTREAM (input)); - if (decoded_length < 0) - { - /* The decoding wasn't possible. */ - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return Qnil; - } - /* Now we have decoded the region, so we insert the new contents and delete the old. (Insert first in order to preserve markers.) */ BUF_SET_PT (buf, begv); @@ -3758,8 +3816,8 @@ If the region can't be decoded, return nil and don't modify the buffer. buffer_delete_range (buf, begv + cc_decoded_length, zv + cc_decoded_length, 0); - /* Simulate FSF Emacs: if point was in the region, place it at the - beginning. */ + /* Simulate FSF Emacs implementation of this function: if point was + in the region, place it at the beginning. */ if (old_pt >= begv && old_pt < zv) BUF_SET_PT (buf, begv); @@ -3768,6 +3826,7 @@ If the region can't be decoded, return nil and don't modify the buffer. DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /* Base64-decode STRING and return the result. +Characters out of the base64 alphabet are ignored. */ (string)) { @@ -3790,13 +3849,6 @@ Base64-decode STRING and return the result. abort (); Lstream_delete (XLSTREAM (input)); - if (decoded_length < 0) - { - /* The decoding wasn't possible. */ - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return Qnil; - } - result = make_string (decoded, decoded_length); XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); return result; @@ -3884,7 +3936,7 @@ syms_of_fns (void) DEFSUBR (Fnconc); DEFSUBR (Fmapcar); DEFSUBR (Fmapvector); - DEFSUBR (Fmapc); + DEFSUBR (Fmapc_internal); DEFSUBR (Fmapconcat); DEFSUBR (Fload_average); DEFSUBR (Ffeaturep);