(x_free_gcs): Add prototype.
[bpt/emacs.git] / src / fns.c
index fce3d72..a317f1b 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,5 +1,6 @@
 /* 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
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -2418,7 +2419,7 @@ DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
       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);
@@ -3173,7 +3174,7 @@ ARGS are passed as extra arguments to the function.")
   return result;
 }
 \f
-/* base64 encode/decode functions.
+/* base64 encode/decode functions (RFC 2045).
    Based on code from GNU recode. */
 
 #define MIME_LINE_LENGTH 76
@@ -3189,13 +3190,17 @@ ARGS are passed as extra arguments to the function.")
 /* 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
@@ -3252,7 +3257,7 @@ static short base64_char_to_value[128] =
 
 
 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",
@@ -3296,7 +3301,7 @@ into shorter lines.")
       /* 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
@@ -3357,7 +3362,7 @@ into shorter lines.")
       /* 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);
@@ -3386,9 +3391,9 @@ base64_encode_1 (from, to, length, line_break, multibyte)
       if (multibyte)
        {
          c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
-         if (bytes > 1)
+         if (c >= 256)
            return -1;
-         i++;
+         i += bytes;
        }
       else
        c = from[i++];
@@ -3424,9 +3429,9 @@ base64_encode_1 (from, to, length, line_break, multibyte)
       if (multibyte)
        {
          c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
-         if (bytes > 1)
+         if (c >= 256)
            return -1;
-         i++;
+         i += bytes;
        }
       else
        c = from[i++];
@@ -3446,9 +3451,9 @@ base64_encode_1 (from, to, length, line_break, multibyte)
       if (multibyte)
        {
          c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
-         if (bytes > 1)
+         if (c >= 256)
            return -1;
-         i++;
+         i += bytes;
        }
       else
        c = from[i++];
@@ -3469,11 +3474,12 @@ If the region can't be decoded, signal an error and don't modify the buffer.")
      (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);
 
@@ -3481,34 +3487,35 @@ If the region can't be decoded, signal an error and don't modify the buffer.")
   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,
@@ -3544,7 +3551,9 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
   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)
@@ -3555,21 +3564,29 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
   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)
     {
@@ -3589,7 +3606,12 @@ base64_decode_1 (from, to, length)
        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.  */
 
@@ -3608,7 +3630,12 @@ base64_decode_1 (from, to, length)
        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.  */
 
@@ -3621,7 +3648,12 @@ base64_decode_1 (from, to, length)
        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++;
     }
 }
 
@@ -4932,6 +4964,211 @@ integers, including negative integers.")
 }
 
 
+\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\
+\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\
+Third optional argument CODING-SYSTEM specifies the coding system text\n\
+should be converted to before computing the digest.  If nil or omitted,\n\
+the current format is used or a format is guessed.\n\
+\n\
+Fourth optional argument NOERROR is there for compatability with other\n\
+Emacsen and is ignored.")
+  (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
@@ -5080,6 +5317,7 @@ invoked by mouse clicks and mouse menu items.");
   defsubr (&Sbase64_decode_region);
   defsubr (&Sbase64_encode_string);
   defsubr (&Sbase64_decode_string);
+  defsubr (&Smd5);
 }