(Fcharset_priority_list, Fset_charset_priority): New
[bpt/emacs.git] / src / charset.c
index d3f2ff3..23bf78e 100644 (file)
@@ -48,18 +48,18 @@ Boston, MA 02111-1307, USA.  */
 #endif /* emacs */
 
 
-/*** GENERAL NOTE on CODED CHARACTER SET (CHARSET) ***
+/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
 
   A coded character set ("charset" hereafter) is a meaningful
-  collection (i.e. language, culture, functionality, etc) of
+  collection (i.e. language, culture, functionality, etc.) of
   characters.  Emacs handles multiple charsets at once.  In Emacs Lisp
-  code, a charset is represented by symbol.  In C code, a charset is
-  represented by its ID number or by a pointer the struct charset.
+  code, a charset is represented by symbol.  In C code, a charset is
+  represented by its ID number or by a pointer to a struct charset.
 
   The actual information about each charset is stored in two places.
   Lispy information is stored in the hash table Vcharset_hash_table as
   a vector (charset attributes).  The other information is stored in
-  charset_table as struct charset.
+  charset_table as struct charset.
 
 */
 
@@ -185,12 +185,10 @@ load_charset_map (charset, entries, n_entries, control_flag)
   int control_flag;
 {
   Lisp_Object vec, table;
-  unsigned min_code = CHARSET_MIN_CODE (charset);
   unsigned max_code = CHARSET_MAX_CODE (charset);
   int ascii_compatible_p = charset->ascii_compatible_p;
   int min_char, max_char, nonascii_min_char;
   int i;
-  int first;
   unsigned char *fast_map = charset->fast_map;
 
   if (n_entries <= 0)
@@ -215,7 +213,7 @@ load_charset_map (charset, entries, n_entries, control_flag)
   for (i = 0; i < n_entries; i++)
     {
       unsigned from, to;
-      int c, char_index;
+      int c;
       int idx = i % 0x10000;
 
       if (i > 0 && idx == 0)
@@ -385,7 +383,6 @@ load_charset_map_from_file (charset, mapfile, control_flag)
   FILE *fp;
   int eof;
   Lisp_Object suffixes;
-  int i;
   struct charset_map_entries *head, *entries;
   int n_entries;
 
@@ -537,7 +534,7 @@ DEFUN ("charsetp", Fcharsetp, Scharsetp, 1, 1, 0,
 
 void
 map_charset_chars (c_function, function, charset_symbol, arg)
-     void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object);
+     void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
      Lisp_Object function, charset_symbol, arg;
 {
   int id;
@@ -632,12 +629,13 @@ map_charset_chars (c_function, function, charset_symbol, arg)
 }
   
 DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 3, 0,
-       doc: /* Call FUNCTION for each characters in CHARSET.
-FUNCTION is called with an argument RANGE and the 2nd optional
+       doc: /* Call FUNCTION for all characters in CHARSET.
+FUNCTION is called with an argument RANGE and optional 2nd
 argument ARG.
 
-RANGE is a cons (FROM .  TO), where FROM and TO indicates a range of
-character sequence that are contained in CHARSET.  */)
+RANGE is either a cons (FROM .  TO), where FROM and TO indicate a range of
+characters contained in CHARSET or a single character in the case that
+FROM and TO would be equal.  (The charset mapping may have gaps.)*/)
      (function, charset, arg)
        Lisp_Object function, charset, arg;
 {
@@ -653,7 +651,8 @@ character sequence that are contained in CHARSET.  */)
 
 DEFUN ("define-charset-internal", Fdefine_charset_internal,
        Sdefine_charset_internal, charset_arg_max, MANY, 0,
-       doc: /* For internal use only.  */)
+       doc: /* For internal use only.
+usage: (define-charset-internal ...)  */)
      (nargs, args)
      int nargs;
      Lisp_Object *args;
@@ -720,7 +719,7 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
   if (! charset.code_linear_p)
     {
       charset.code_space_mask = (unsigned char *) xmalloc (256);
-      bzero (charset.code_space_mask, sizeof (charset.code_space_mask));
+      bzero (charset.code_space_mask, 256);
       for (i = 0; i < 4; i++)
        for (j = charset.code_space[i * 4]; j <= charset.code_space[i * 4 + 1];
             j++)
@@ -889,6 +888,7 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
   if (charset.hash_index >= 0)
     {
       new_definition_p = 0;
+      id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
       HASH_VALUE (hash_table, charset.hash_index) = attrs;
     }
   else
@@ -904,11 +904,10 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
                         sizeof (struct charset) * charset_table_size));
        }
       id = charset_table_used++;
-      ASET (attrs, charset_id, make_number (id));
       new_definition_p = 1;
     }
 
-
+  ASET (attrs, charset_id, make_number (id));
   charset.id = id;
   charset_table[id] = charset;
 
@@ -924,6 +923,8 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
   if (charset.emacs_mule_id >= 0)
     {
       emacs_mule_charset[charset.emacs_mule_id] = CHARSET_FROM_ID (id);
+      if (charset.emacs_mule_id < 0xA0)
+       emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 1;
       if (new_definition_p)
        Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list,
                                           Fcons (make_number (id), Qnil));
@@ -939,7 +940,6 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
   return Qnil;
 }
 
-
 DEFUN ("define-charset-alias", Fdefine_charset_alias,
        Sdefine_charset_alias, 2, 2, 0,
        doc: /* Define ALIAS as an alias for charset CHARSET.  */)
@@ -950,6 +950,7 @@ DEFUN ("define-charset-alias", Fdefine_charset_alias,
 
   CHECK_CHARSET_GET_ATTR (charset, attr);
   Fputhash (alias, attr, Vcharset_hash_table);
+  Vcharset_list = Fcons (alias, Vcharset_list);
   return Qnil;
 }
 
@@ -1030,12 +1031,12 @@ DEFUN ("unify-charset", Funify_charset, Sunify_charset, 1, 2, 0,
 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
        Sget_unused_iso_final_char, 2, 2, 0,
        doc: /*
-Return an unsed ISO's final char for a charset of DIMENISION and CHARS.
+Return an unsed ISO final char for a charset of DIMENISION and CHARS.
 DIMENSION is the number of bytes to represent a character: 1 or 2.
 CHARS is the number of characters in a dimension: 94 or 96.
 
 This final char is for private use, thus the range is `0' (48) .. `?' (63).
-If there's no unused final char for the attrified kind of charset,
+If there's no unused final char for the specified kind of charset,
 return nil.  */)
      (dimension, chars)
      Lisp_Object dimension, chars;
@@ -1479,7 +1480,7 @@ DEFUN ("make-char", Fmake_char, Smake_char, 1, 5, 0,
 
 CODE1 through CODE4 are optional, but if you don't supply sufficient
 position codes, it is assumed that the minimum code in each dimension
-are specified.  */)
+is specified.  */)
      (charset, code1, code2, code3, code4)
      Lisp_Object charset, code1, code2, code3, code4;
 {
@@ -1491,56 +1492,55 @@ are specified.  */)
   CHECK_CHARSET_GET_ID (charset, id);
   charsetp = CHARSET_FROM_ID (id);
 
-  if (NILP (code))
-    return make_number (CHARSET_MIN_CHAR (charsetp));
-
   dimension = CHARSET_DIMENSION (charsetp);
   if (NILP (code1))
-    code = charsetp->code_space[(dimension - 1) * 4];
+    code = (CHARSET_ASCII_COMPATIBLE_P (charsetp)
+           ? 0 : CHARSET_MIN_CODE (charsetp));
   else
     {
       CHECK_NATNUM (code1);
       if (XFASTINT (code1) >= 0x100)
        args_out_of_range (make_number (0xFF), code1);
       code = XFASTINT (code1);
-    }
-  if (dimension > 1)
-    {
-      code <<= 8;
-      if (NILP (code2))
-       code |= charsetp->code_space[(dimension - 2) * 4];
-      else
-       {
-         CHECK_NATNUM (code2);
-         if (XFASTINT (code2) >= 0x100)
-           args_out_of_range (make_number (0xFF), code2);
-         code |= XFASTINT (code2);
-       }
 
-      if (dimension > 2)
+      if (dimension > 1)
        {
          code <<= 8;
-         if (NILP (code3))
-           code |= charsetp->code_space[(dimension - 3) * 4];
+         if (NILP (code2))
+           code |= charsetp->code_space[(dimension - 2) * 4];
          else
            {
-             CHECK_NATNUM (code3);
-             if (XFASTINT (code3) >= 0x100)
-               args_out_of_range (make_number (0xFF), code3);
-             code |= XFASTINT (code3);
+             CHECK_NATNUM (code2);
+             if (XFASTINT (code2) >= 0x100)
+               args_out_of_range (make_number (0xFF), code2);
+             code |= XFASTINT (code2);
            }
 
-         if (dimension > 3)
+         if (dimension > 2)
            {
              code <<= 8;
-             if (NILP (code4))
-               code |= charsetp->code_space[0];
+             if (NILP (code3))
+               code |= charsetp->code_space[(dimension - 3) * 4];
              else
                {
-                 CHECK_NATNUM (code4);
-                 if (XFASTINT (code4) >= 0x100)
-                   args_out_of_range (make_number (0xFF), code4);
-                 code |= XFASTINT (code4);
+                 CHECK_NATNUM (code3);
+                 if (XFASTINT (code3) >= 0x100)
+                   args_out_of_range (make_number (0xFF), code3);
+                 code |= XFASTINT (code3);
+               }
+
+             if (dimension > 3)
+               {
+                 code <<= 8;
+                 if (NILP (code4))
+                   code |= charsetp->code_space[0];
+                 else
+                   {
+                     CHECK_NATNUM (code4);
+                     if (XFASTINT (code4) >= 0x100)
+                       args_out_of_range (make_number (0xFF), code4);
+                     code |= XFASTINT (code4);
+                   }
                }
            }
        }
@@ -1586,7 +1586,7 @@ char_charset (c, charset_list, code_return)
 
 
 DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
-       doc: /*Return list of charset and one or two position-codes of CHAR.
+       doc: /*Return list of charset and one to three position-codes of CHAR.
 If CHAR is invalid as a character code,
 return a list of symbol `unknown' and CHAR.  */)
      (ch)
@@ -1706,6 +1706,49 @@ Clear encoder and decoder of charsets that are loaded from mapfiles.  */)
   return Qnil;
 }
 
+DEFUN ("charset-priority-list", Fcharset_priority_list,
+       Scharset_priority_list, 0, 1, 0,
+       doc: /* Return the list of charsets ordered by priority.
+HIGHESTP non-nil means just return the highest priority one.  */)
+     (highestp)
+     Lisp_Object highestp;
+{
+  Lisp_Object val = Qnil, list = Vcharset_ordered_list;
+
+  if (!NILP (highestp))
+    return CHARSET_NAME (CHARSET_FROM_ID (Fcar (list)));
+
+  while (!NILP (list))
+    {
+      val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XCAR (list))), val);
+      list = XCDR (list);
+    }
+  return Fnreverse (val);
+}
+
+DEFUN ("set-charset-priority", Fset_charset_priority, Sset_charset_priority,
+       1, MANY, 0,
+       doc: /* Assign higher priority to the charsets given as arguments.
+usage: (set-charset-priority &rest charsets)  */)
+       (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  Lisp_Object new_head = Qnil, old_list, id, arglist[2];
+  int i;
+
+  old_list = Fcopy_sequence (Vcharset_ordered_list);
+  for (i = 0; i < nargs; i++)
+    {
+      CHECK_CHARSET_GET_ID (args[i], id);
+      old_list = Fdelq (id, old_list);
+      new_head = Fcons (id, new_head);
+    }
+  arglist[0] = Fnreverse (new_head);
+  arglist[1] = old_list;
+  Vcharset_ordered_list = Fnconc (2, arglist);
+  return Qnil;
+}
 \f
 void
 init_charset ()
@@ -1805,15 +1848,17 @@ syms_of_charset ()
   defsubr (&Scharset_after);
   defsubr (&Siso_charset);
   defsubr (&Sclear_charset_maps);
+  defsubr (&Scharset_priority_list);
+  defsubr (&Sset_charset_priority);
 
   DEFVAR_LISP ("charset-map-directory", &Vcharset_map_directory,
               doc: /* Directory of charset map files that come with GNU Emacs.
-The default value is \"\\[data-directory]/charsets\".  */);
+The default value is sub-directory "charsets" of `data-directory'.  */);
   Vcharset_map_directory = Fexpand_file_name (build_string ("charsets"),
                                              Vdata_directory);
 
   DEFVAR_LISP ("charset-list", &Vcharset_list,
-              doc: /* List of charsets ever defined.  */);
+              doc: /* List of all charsets ever defined.  */);
   Vcharset_list = Qnil;
 
   /* Make the prerequisite charset `ascii' and `unicode'.  */