XEmacs 21.4.11 "Native Windows TTY Support".

[chise/xemacs-chise.git.1] / src / database.c

diff --git a/src/database.c b/src/database.c
index c42d41f..57e3925 100644 (file)
--- a/src/database.c
+++ b/src/database.c
@@ -53,12 +53,18 @@ typedef uint64_t u_int64_t;
 #endif /* WE_DONT_NEED_QUADS */
 #endif /* HAVE_INTTYPES_H */
 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */
-#include DB_H_PATH              /* Berkeley db's header file */
+#include DB_H_FILE              /* Berkeley db's header file */
 #ifndef DB_VERSION_MAJOR
 # define DB_VERSION_MAJOR 1
 #endif /* DB_VERSION_MAJOR */
+#ifndef DB_VERSION_MINOR
+# define DB_VERSION_MINOR 0
+#endif /* DB_VERSION_MINOR */
 Lisp_Object Qberkeley_db;
 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
+#if DB_VERSION_MAJOR > 2
+Lisp_Object Qqueue;
+#endif 
 #endif /* HAVE_BERKELEY_DB */
 
 #ifdef HAVE_DBM
@@ -75,9 +81,6 @@ Lisp_Object Vdatabase_coding_system;
 
 Lisp_Object Qdatabasep;
 
-struct Lisp_Database;
-typedef struct Lisp_Database Lisp_Database;
-
 typedef struct
 {
   Lisp_Object (*get_subtype) (Lisp_Database *);
@@ -113,7 +116,6 @@ struct Lisp_Database
 #define XDATABASE(x) XRECORD (x, database, Lisp_Database)
 #define XSETDATABASE(x, p) XSETRECORD (x, p, database)
 #define DATABASEP(x) RECORDP (x, database)
-#define GC_DATABASEP(x) GC_RECORDP (x, database)
 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database)
 #define DATABASE_LIVE_P(x) (x->live_p)
@@ -128,7 +130,7 @@ struct Lisp_Database
 static Lisp_Database *
 allocate_database (void)
 {
-  Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, lrecord_database);
+  Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, &lrecord_database);
 
   db->fname = Qnil;
   db->live_p = 0;
@@ -148,12 +150,10 @@ allocate_database (void)
 }
 
 static Lisp_Object
-mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_database (Lisp_Object object)
 {
-  Lisp_Database *db = XDATABASE (obj);
-
-  markobj (db->fname);
-  return Qnil;
+  Lisp_Database *db = XDATABASE (object);
+  return db->fname;
 }
 
 static void
@@ -184,18 +184,18 @@ finalize_database (void *header, int for_disksave)
 
   if (for_disksave)
     {
-      Lisp_Object obj;
-      XSETDATABASE (obj, db);
+      Lisp_Object object;
+      XSETDATABASE (object, db);
 
       signal_simple_error
-       ("Can't dump an emacs containing database objects", obj);
+       ("Can't dump an emacs containing database objects", object);
     }
   db->funcs->close (db);
 }
 
 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
                                mark_database, print_database,
-                              finalize_database, 0, 0,
+                              finalize_database, 0, 0, 0,
                               Lisp_Database);
 
 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
@@ -232,11 +232,12 @@ Return the subtype of database DATABASE, if any.
 }
 
 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
-Return t if OBJ is an active database.
+Return t if OBJECT is an active database.
 */
-       (obj))
+       (object))
 {
-  return DATABASEP (obj) && DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
+  return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ?
+    Qt : Qnil;
 }
 
 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
@@ -250,11 +251,11 @@ Return the filename associated with the database DATABASE.
 }
 
 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
-Return t if OBJ is a database.
+Return t if OBJECT is a database.
 */
-       (obj))
+       (object))
 {
-  return DATABASEP (obj) ? Qt : Qnil;
+  return DATABASEP (object) ? Qt : Qnil;
 }
 
 #ifdef HAVE_DBM
@@ -374,6 +375,9 @@ berkdb_subtype (Lisp_Database *db)
     case DB_BTREE: return Qbtree;
     case DB_HASH:  return Qhash;
     case DB_RECNO: return Qrecno;
+#if DB_VERSION_MAJOR > 2
+    case DB_QUEUE: return Qqueue;
+#endif
     default:       return Qunknown;
     }
 }
@@ -492,25 +496,31 @@ berkdb_map (Lisp_Database *db, Lisp_Object func)
        status == 0;
        status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
     {
-      /* ### Needs mule-izing */
+      /* #### Needs mule-izing */
       key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
       val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
       call2 (func, key, val);
     }
 #else
-  DBC *dbcp;
+  {
+    DBC *dbcp;
 
-  status = dbp->cursor (dbp, NULL, &dbcp);
-  for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
-       status == 0;
-       status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
-    {
-      /* ### Needs mule-izing */
-      key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
-      val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
-      call2 (func, key, val);
-    }
-  dbcp->c_close (dbcp);
+#if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6
+    status = dbp->cursor (dbp, NULL, &dbcp, 0);
+#else
+    status = dbp->cursor (dbp, NULL, &dbcp);
+#endif
+    for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
+        status == 0;
+        status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
+      {
+       /* #### Needs mule-izing */
+       key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
+       val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
+       call2 (func, key, val);
+      }
+    dbcp->c_close (dbcp);
+  }
 #endif /* DB_VERSION_MAJOR */
 }
 
@@ -578,7 +588,9 @@ and defaults to 0755.
   file = Fexpand_file_name (file, Qnil);
   UNGCPRO;
 
-  GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
+  TO_EXTERNAL_FORMAT (LISP_STRING, file,
+                     C_STRING_ALLOCA, filename,
+                     Qfile_name);
 
   if (NILP (access_))
     {
@@ -641,6 +653,10 @@ and defaults to 0755.
        real_subtype = DB_BTREE;
       else if (EQ (subtype, Qrecno))
        real_subtype = DB_RECNO;
+#if DB_VERSION_MAJOR > 2
+      else if (EQ (subtype, Qqueue))
+       real_subtype = DB_QUEUE;
+#endif
       else
        signal_simple_error ("Unsupported subtype", subtype);
 
@@ -666,10 +682,30 @@ and defaults to 0755.
          if (strchr (acc, 'r') && !strchr (acc, 'w'))
            accessmask |= DB_RDONLY;
        }
+#if DB_VERSION_MAJOR == 2
       status = db_open (filename, real_subtype, accessmask,
                        modemask, NULL , NULL, &dbase);
       if (status)
        return Qnil;
+#else
+      status = db_create (&dbase, NULL, 0);
+      if (status)
+        return Qnil;
+#if DB_VERSION_MAJOR < 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR < 1)
+      status = dbase->open (dbase, filename, NULL,
+                            real_subtype, accessmask, modemask);
+#else /* DB_VERSION >= 4.1 */
+      status = dbase->open (dbase, NULL, filename, NULL, real_subtype,
+                           accessmask | DB_AUTO_COMMIT, modemask);
+#endif /* DB_VERSION < 4.1 */
+      if (status)
+        {
+          dbase->close (dbase, 0);
+          return Qnil;
+        }
+#endif /* DB_VERSION_MAJOR > 2 */
+      /* Normalize into system specific file modes. Only for printing */
+      accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR;
 #endif /* DB_VERSION_MAJOR */
 
       db = allocate_database ();
@@ -757,6 +793,8 @@ each key and value in the database.
 void
 syms_of_database (void)
 {
+  INIT_LRECORD_IMPLEMENTATION (database);
+
   defsymbol (&Qdatabasep, "databasep");
 #ifdef HAVE_DBM
   defsymbol (&Qdbm, "dbm");
@@ -766,6 +804,9 @@ syms_of_database (void)
   defsymbol (&Qhash, "hash");
   defsymbol (&Qbtree, "btree");
   defsymbol (&Qrecno, "recno");
+#if DB_VERSION_MAJOR > 2
+  defsymbol (&Qqueue, "queue");
+#endif
   defsymbol (&Qunknown, "unknown");
 #endif