(Fsave_charset_mapping_table): Open database as "w+" mode.

[chise/xemacs-chise.git-] / src / chartab.c

diff --git a/src/chartab.c b/src/chartab.c
index 66ff5bc..618ed11 100644 (file)
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -64,6 +64,11 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories;
 \f
 #ifdef UTF2000
 
+#if defined(HAVE_DATABASE)
+EXFUN (Fload_char_attribute_table, 1);
+EXFUN (Fmap_char_attribute, 3);
+#endif
+
 #define BT_UINT8_MIN           0
 #define BT_UINT8_MAX           (UCHAR_MAX - 4)
 #define BT_UINT8_t             (UCHAR_MAX - 3)
@@ -1270,6 +1275,7 @@ mark_char_table (Lisp_Object obj)
 
   mark_object (ct->table);
   mark_object (ct->name);
+  mark_object (ct->db);
 #else
   int i;
 
@@ -1599,6 +1605,7 @@ static const struct lrecord_description char_table_description[] = {
   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
   { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
+  { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
 #else
   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
 #ifdef MULE
@@ -1800,6 +1807,7 @@ and 'syntax.  See `valid-char-table-type-p'.
     ct->mirror_table = Qnil;
 #else
   ct->name = Qnil;
+  ct->db = Qnil;
 #endif
   ct->next_table = Qnil;
   XSETCHAR_TABLE (obj, ct);
@@ -1874,6 +1882,7 @@ as CHAR-TABLE.  The values will not themselves be copied.
   ctnew->default_value = ct->default_value;
   /* [tomo:2002-01-21] Perhaps this code seems wrong */
   ctnew->name = ct->name;
+  ctnew->db = ct->db;
 
   if (UINT8_BYTE_TABLE_P (ct->table))
     {
@@ -2721,10 +2730,6 @@ map_char_table_for_charset_fun (struct chartab_range *range,
   return 0;
 }
 
-#if defined(HAVE_DATABASE)
-EXFUN (Fload_char_attribute_table, 1);
-#endif
-
 #endif
 
 /* Map FN (with client data ARG) over range RANGE in char table CT.
@@ -3367,16 +3372,16 @@ Save values of ATTRIBUTE into database file.
   Lisp_Object table = Fgethash (attribute,
                                Vchar_attribute_hash_table, Qunbound);
   Lisp_Char_Table *ct;
-  Lisp_Object db;
   Lisp_Object db_file;
+  Lisp_Object db;
 
   if (CHAR_TABLEP (table))
     ct = XCHAR_TABLE (table);
   else
     return Qnil;
-  
+
   db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
-  db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
+  db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
   if (!NILP (db))
     {
       if (UINT8_BYTE_TABLE_P (ct->table))
@@ -3395,6 +3400,31 @@ Save values of ATTRIBUTE into database file.
 #endif
 }
 
+DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
+Close database of ATTRIBUTE.
+*/
+       (attribute))
+{
+#ifdef HAVE_DATABASE
+  Lisp_Object table = Fgethash (attribute,
+                               Vchar_attribute_hash_table, Qunbound);
+  Lisp_Char_Table *ct;
+
+  if (CHAR_TABLEP (table))
+    ct = XCHAR_TABLE (table);
+  else
+    return Qnil;
+
+  if (!NILP (ct->db))
+    {
+      if (!NILP (Fdatabase_live_p (ct->db)))
+       Fclose_database (ct->db);
+      ct->db = Qnil;
+    }
+#endif
+  return Qnil;
+}
+
 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
 Reset values of ATTRIBUTE with database file.
 */
@@ -3417,6 +3447,9 @@ Reset values of ATTRIBUTE with database file.
        }
       ct = XCHAR_TABLE (table);
       ct->table = Qunloaded;
+      if (!NILP (Fdatabase_live_p (ct->db)))
+       Fclose_database (ct->db);
+      ct->db = Qnil;
       XCHAR_TABLE_UNLOADED(table) = 1;
       return Qt;
     }
@@ -3426,27 +3459,32 @@ Reset values of ATTRIBUTE with database file.
 
 #ifdef HAVE_DATABASE
 Lisp_Object
-load_char_attribute_maybe (Emchar ch, Lisp_Object attribute)
+load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
 {
-  Lisp_Object db;
-  Lisp_Object db_file
-    = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+  Lisp_Object attribute = CHAR_TABLE_NAME (cit);
 
-  db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
-  if (!NILP (db))
+  if (!NILP (attribute))
     {
-      Lisp_Object val
-       = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
-                        db, Qunbound);
-      if (!UNBOUNDP (val))
-       val = Fread (val);
-      else
-       val = Qunbound;
-      Fclose_database (db);
-      return val;
+      if (NILP (Fdatabase_live_p (cit->db)))
+       {
+         Lisp_Object db_file
+           = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+
+         cit->db = Fopen_database (db_file, Qnil, Qnil, build_string ("r"), Qnil);
+       }
+      if (!NILP (cit->db))
+       {
+         Lisp_Object val
+           = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
+                            cit->db, Qunbound);
+         if (!UNBOUNDP (val))
+           val = Fread (val);
+         else
+           val = Qunbound;
+         return val;
+       }
     }
-  else
-    return Qunbound;
+  return Qunbound;
 }
 
 Lisp_Char_Table* char_attribute_table_to_load;
@@ -3475,34 +3513,35 @@ Load values of ATTRIBUTE into database file.
        (attribute))
 {
 #ifdef HAVE_DATABASE
-  Lisp_Object db;
-  Lisp_Object db_file
-    = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
-
-  db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
-  if (!NILP (db))
+  Lisp_Object table = Fgethash (attribute,
+                               Vchar_attribute_hash_table,
+                               Qunbound);
+  if (CHAR_TABLEP (table))
     {
-      Lisp_Object table = Fgethash (attribute,
-                                   Vchar_attribute_hash_table,
-                                   Qunbound);
-      struct gcpro gcpro1, gcpro2;
+      Lisp_Char_Table *ct = XCHAR_TABLE (table);
 
-      if (CHAR_TABLEP (table))
-       char_attribute_table_to_load = XCHAR_TABLE (table);
-      else
+      if (NILP (Fdatabase_live_p (ct->db)))
+       {
+         Lisp_Object db_file
+             = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+
+         ct->db = Fopen_database (db_file, Qnil, Qnil, build_string ("r"), Qnil);
+       }
+      if (!NILP (ct->db))
        {
-         Fclose_database (db);
-         return Qnil;
+         struct gcpro gcpro1;
+
+         char_attribute_table_to_load = XCHAR_TABLE (table);
+         GCPRO1 (table);
+         Fmap_database (Qload_char_attribute_table_map_function, ct->db);
+         UNGCPRO;
+         Fclose_database (ct->db);
+         ct->db = Qnil;
+         XCHAR_TABLE_UNLOADED(table) = 0;
+         return Qt;
        }
-      GCPRO2 (db, table);
-      Fmap_database (Qload_char_attribute_table_map_function, db);
-      UNGCPRO;
-      Fclose_database (db);
-      XCHAR_TABLE_UNLOADED(table) = 0;
-      return Qt;
     }
-  else
-    return Qnil;
+  return Qnil;
 #endif
 }
 
@@ -4029,6 +4068,7 @@ syms_of_chartab (void)
   DEFSUBR (Fput_char_table_map_function);
   DEFSUBR (Fsave_char_attribute_table);
   DEFSUBR (Freset_char_attribute_table);
+  DEFSUBR (Fclose_char_attribute_table);
 #ifdef HAVE_DATABASE
   defsymbol (&Qload_char_attribute_table_map_function,
             "load-char-attribute-table-map-function");