*** xemacs-21.2.8.orig/src/config.h.in	Sun Dec  6 01:55:24 1998
--- xemacs-21.2.8/src/config.h.in	Sat Jan  2 08:49:48 1999
***************
*** 340,345 ****
--- 340,346 ----
  
  /* Compile in support for DBM databases?  May require libgdbm or libdbm. */
  #undef HAVE_DBM
+ #undef HAVE_GDBM
  
  /* Compile in support for Berkeley DB style databases?  May require libdb. */
  #undef HAVE_BERKELEY_DB

*** xemacs-21.2.8.orig/configure.in	Sun Dec 27 13:13:14 1998
--- xemacs-21.2.8/configure.in	Mon Jan  4 17:47:08 1999
***************
*** 3491,3517 ****
  test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \
    != "no no no" && AC_CHECKING(for database support)
  
  dnl Check for ndbm.h, required for either kind of DBM support.
! if test "$with_database_gnudbm $with_database_dbm" != "no no"; then
    AC_CHECK_HEADER(ndbm.h, [:], [
!     test "$with_database_gnudbm" = "yes" -o \
!          "$with_database_dbm"    = "yes" && \
        XE_DIE("Required DBM support cannot be provided.")
!     with_database_gnudbm=no with_database_dbm=no])
  fi
  
! dnl Check for DBM support in libgdbm.
  if test "$with_database_gnudbm" != "no"; then
!   AC_CHECK_LIB(gdbm, dbm_open, [
!    with_database_gnudbm=yes with_database_dbm=no libdbm=-lgdbm], [
!    if test "$with_database_gnudbm" = "yes"; then
       XE_DIE("Required GNU DBM support cannot be provided.")
-    fi
     with_database_gnudbm=no])
  fi
  
  dnl Check for DBM support in libc and libdbm.
! if test "$with_database_dbm" != "no"; then
    AC_CHECK_FUNC(dbm_open, [with_database_dbm=yes libdbm=], [
      AC_CHECK_LIB(dbm, dbm_open, [with_database_dbm=yes libdbm=-ldbm], [
        test "$with_database_dbm" = "yes" && \
--- 3491,3526 ----
  test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \
    != "no no no" && AC_CHECKING(for database support)
  
+ dnl Check for gdbm.h, required for GDBM support.
+ if test "$with_database_gnudbm" != "no"; then
+   AC_CHECK_HEADER(gdbm.h, [:], [
+     test "$with_database_gnudbm" = "yes" && \
+       XE_DIE("Required GNU DBM support cannot be provided.")
+     with_database_gnudbm=no])
+ fi
+ 
  dnl Check for ndbm.h, required for either kind of DBM support.
! dnl if test "$with_database_dbm" != "no" -a "$with_database_gnudbm" != "yes" ; then
! if test "$with_database_dbm" != "no" ; then
    AC_CHECK_HEADER(ndbm.h, [:], [
!     test "$with_database_dbm" = "yes" && \
        XE_DIE("Required DBM support cannot be provided.")
!     with_database_dbm=no])
  fi
  
! dnl Check for GDBM support in libgdbm.
  if test "$with_database_gnudbm" != "no"; then
!   AC_CHECK_LIB(gdbm, dbm_open, [with_database_gnudbm=yes libdbm=-lgdbm], [
!    test "$with_database_gnudbm" = "yes" && \
       XE_DIE("Required GNU DBM support cannot be provided.")
     with_database_gnudbm=no])
  fi
  
+ 
+ if test "$with_database_gnudbm" == "yes" -a "$with_database_dbm" != "no"; then
+      with_database_dbm=yes
  dnl Check for DBM support in libc and libdbm.
! elif test "$with_database_dbm" != "no"; then
    AC_CHECK_FUNC(dbm_open, [with_database_dbm=yes libdbm=], [
      AC_CHECK_LIB(dbm, dbm_open, [with_database_dbm=yes libdbm=-ldbm], [
        test "$with_database_dbm" = "yes" && \
***************
*** 3519,3528 ****
        with_database_dbm=no])])
  fi
  
! dnl Tell make about the DBM support we detected.
  test -n "$libdbm" && XE_PREPEND("$libdbm", LIBS)
! test "$with_database_gnudbm" = "yes" -o \
!      "$with_database_dbm"    = "yes" && \
    AC_DEFINE(HAVE_DBM)
  
  dnl Check for Berkeley DB.
--- 3528,3543 ----
        with_database_dbm=no])])
  fi
  
! 
! dnl Tell make about the GDBM support we detected.
  test -n "$libdbm" && XE_PREPEND("$libdbm", LIBS)
! test "$with_database_gnudbm" = "yes" && \
!   AC_DEFINE(HAVE_GDBM)
! 
! dnl Tell make about the DBM support we detected.
! test -n "$libdbm" && test "$with_database_gnudbm" != "yes" && \
! 	XE_PREPEND("$libdbm", LIBS)
! test "$with_database_dbm" = "yes" && \
    AC_DEFINE(HAVE_DBM)
  
  dnl Check for Berkeley DB.

*** xemacs-21.2.8.orig/src/database.c	Sun Dec 27 13:13:00 1998
--- xemacs-21.2.8/src/database.c	Mon Jan  4 17:40:06 1999
***************
*** 61,66 ****
--- 61,73 ----
  Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
  #endif /* HAVE_BERKELEY_DB */
  
+ #ifdef HAVE_GDBM
+ #include <gdbm.h>
+ Lisp_Object Qgdbm;
+ Lisp_Object Qcachesize;
+ Lisp_Object Qfastmode;
+ #endif /* HAVE_GDBM */
+ 
  #ifdef HAVE_DBM
  #include <ndbm.h>
  Lisp_Object Qdbm;
***************
*** 98,103 ****
--- 105,114 ----
    int access_;
    int dberrno;
    int live_p;
+ #ifdef HAVE_GDBM
+   GDBM_FILE gdbm_handle;
+   int access_mark;
+ #endif
  #ifdef HAVE_DBM
    DBM *dbm_handle;
  #endif
***************
*** 137,142 ****
--- 148,157 ----
  #endif
  #ifdef HAVE_DBM
    db->dbm_handle = NULL;
+   db->access_mark = 0;
+ #endif
+ #ifdef HAVE_GDBM
+   db->gdbm_handle = NULL;
  #endif
    db->access_ = 0;
    db->mode = 0;
***************
*** 161,172 ****
  {
    char buf[64];
    Lisp_Database *db = XDATABASE (obj);
! 
    if (print_readably)
      error ("printing unreadable object #<database 0x%x>", db->header.uid);
  
    write_c_string ("#<database \"", printcharfun);
    print_internal (db->fname, printcharfun, 0);
    sprintf (buf, "\" (%s/%s/%s) 0x%x>",
  	   (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
  	   (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
--- 176,214 ----
  {
    char buf[64];
    Lisp_Database *db = XDATABASE (obj);
! #ifdef HAVE_GDBM
!   Lisp_Object type;
! #endif
    if (print_readably)
      error ("printing unreadable object #<database 0x%x>", db->header.uid);
  
    write_c_string ("#<database \"", printcharfun);
    print_internal (db->fname, printcharfun, 0);
+ #ifdef HAVE_GDBM
+   type = db->funcs->get_type (db);
+   if (NILP (type) ||EQ (type, Qgdbm)) 
+     sprintf (buf, "\" (%s/%s/%s) 0x%x>",
+ 	     (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
+ 	     (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
+ 	     (!DATABASE_LIVE_P (db)    ? "closed"    :
+ 	      (db->access_ == GDBM_READER) ? "readonly" :
+ 	      (db->access_ == (GDBM_WRITER|GDBM_FAST)) ? "readwrite(fastmode)" :
+ 	      (db->access_ == GDBM_WRITER) ? "readwrite" :
+ 	      (db->access_ == (GDBM_WRCREAT|GDBM_FAST)) ? "readwrite(create, fastmode)" :
+ 	      (db->access_ == GDBM_WRCREAT) ? "readwrite(create)" :
+ 	      (db->access_ == (GDBM_NEWDB|GDBM_FAST)) ? "create(force, fastmode)" :
+ 	      /* (db->access_ == GDBM_NEWDB) ? "create(force)" ), */
+ 	      "create(force)" ),
+ 	     db->header.uid);
+   else
+     sprintf (buf, "\" (%s/%s/%s) 0x%x>",
+ 	     (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
+ 	     (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
+ 	     (!DATABASE_LIVE_P (db)    ? "closed"    :
+ 	      (db->access_ & O_WRONLY) ? "writeonly" :
+ 	      (db->access_ & O_RDWR)   ? "readwrite" : "readonly"),
+ 	     db->header.uid);
+ #else
    sprintf (buf, "\" (%s/%s/%s) 0x%x>",
  	   (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
  	   (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
***************
*** 174,179 ****
--- 216,224 ----
  	    (db->access_ & O_WRONLY) ? "writeonly" :
  	    (db->access_ & O_RDWR)   ? "readwrite" : "readonly"),
  	   db->header.uid);
+ 
+ #endif /* HAVE_GDBM */
+ 
    write_c_string (buf, printcharfun);
  }
  
***************
*** 354,361 ****
--- 399,659 ----
    dbm_closeit,
    dbm_lasterr
  };
+ 
+ static Lisp_Object
+ dbm_open_database (Lisp_Object file, Lisp_Object access_, Lisp_Object mode)
+ {
+   int modemask;
+   int accessmask = 0;
+   char *filename;
+   Lisp_Database *db = NULL;
+   Lisp_Object retval;
+   DBM *dbase;
+ 
+   GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
+ 
+   if (NILP (access_))
+     accessmask = O_RDWR | O_CREAT;
+   else
+     {
+       char *acc;
+       CHECK_STRING (access_);
+       acc = (char *) XSTRING_DATA (access_);
+ 
+       if (strchr (acc, '+'))
+ 	accessmask |= O_CREAT;
+ 
+       {
+ 	char *rp = strchr (acc, 'r');
+ 	char *wp = strchr (acc, 'w');
+ 	if (rp && wp) accessmask |= O_RDWR;
+ 	else if (wp)  accessmask |= O_WRONLY;
+ 	else          accessmask |= O_RDONLY;
+       }
+     }
+ 
+   if (NILP (mode))
+     modemask = 0755;		/* rwxr-xr-x */
+   else
+     {
+       CHECK_INT (mode);
+       modemask = XINT (mode);
+     }
+ 
+   /* Should check directory is writeable or not in case O_RDWR or
+      O_WRONLY and/or O_CREAT is set.  */
+ 
+   dbase = dbm_open (file, accessmask, modemask);
+   if (!dbase)
+     return Qnil;
+ 
+   db = allocate_database ();
+   db->dbm_handle = dbase;
+   db->funcs = &ndbm_func_block;
+   db->live_p = 1;
+   db->fname = file;
+   db->mode = modemask;
+   db->access_ = accessmask;
+ 
+   XSETDATABASE (retval, db);
+   return retval;
+ }
+ 
  #endif /* HAVE_DBM */
  
+ #ifdef HAVE_GDBM
+ static void
+ gdbm_map (Lisp_Database *db, Lisp_Object func)
+ {
+   datum keydatum, valdatum;
+   Lisp_Object key, val;
+ 
+   for (keydatum = gdbm_firstkey (db->gdbm_handle);
+        keydatum.dptr != NULL;
+        keydatum = gdbm_nextkey (db->gdbm_handle, keydatum))
+     {
+       valdatum = gdbm_fetch (db->gdbm_handle, keydatum);
+       key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize);
+       val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize);
+       call2 (func, key, val);
+     }
+   db->access_mark = 1;
+ }
+ 
+ static Lisp_Object
+ gdbm_get (Lisp_Database *db, Lisp_Object key)
+ {
+   datum keydatum, valdatum;
+ 
+   keydatum.dptr = (char *) XSTRING_DATA (key);
+   keydatum.dsize = XSTRING_LENGTH (key);
+   valdatum = gdbm_fetch (db->gdbm_handle, keydatum);
+   db->access_mark = 1;
+ 
+   return (valdatum.dptr
+ 	  ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize)
+ 	  : Qnil);
+ }
+ 
+ static int
+ gdbm_put (Lisp_Database *db,
+ 	 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
+ {
+   int ret = 0;
+   datum keydatum, valdatum;
+ 
+   valdatum.dptr = (char *) XSTRING_DATA (val);
+   valdatum.dsize = XSTRING_LENGTH (val);
+   keydatum.dptr = (char *) XSTRING_DATA (key);
+   keydatum.dsize = XSTRING_LENGTH (key);
+   db->access_mark = 1;
+   ret = gdbm_store (db->gdbm_handle, keydatum, valdatum,
+ 		    NILP (replace) ? GDBM_INSERT : GDBM_REPLACE);
+   return ((ret == -1) || (ret == 1)) ? 0 : 1;
+ }
+ 
+ static int
+ gdbm_remove (Lisp_Database *db, Lisp_Object key)
+ {
+   datum keydatum;
+ 
+   keydatum.dptr = (char *) XSTRING_DATA (key);
+   keydatum.dsize = XSTRING_LENGTH (key);
+   db->access_mark = 1;
+   return gdbm_delete (db->gdbm_handle, keydatum);
+ }
+ 
+ static Lisp_Object
+ gdbm_type (Lisp_Database *db)
+ {
+   return Qgdbm;
+ }
+ 
+ static Lisp_Object
+ gdbm_subtype (Lisp_Database *db)
+ {
+   return Qnil;
+ }
+ 
+ static Lisp_Object
+ gdbm_lasterr (Lisp_Database *db)
+ {
+   return build_ext_string (gdbm_strerror(gdbm_errno), FORMAT_NATIVE);
+ }
+ 
+ static void
+ gdbm_closeit (Lisp_Database *db)
+ {
+   if (db->gdbm_handle)
+     {
+       gdbm_close (db->gdbm_handle);
+       db->gdbm_handle = NULL;
+     }
+ }
+ 
+ static DB_FUNCS gdbm_func_block =
+ {
+   gdbm_subtype,
+   gdbm_type,
+   gdbm_get,
+   gdbm_put,
+   gdbm_remove,
+   gdbm_map,
+   gdbm_closeit,
+   gdbm_lasterr
+ };
+ 
+ static Lisp_Object
+ gdbm_open_database (Lisp_Object file, Lisp_Object access_, Lisp_Object mode)
+ {
+   /* GDBM flags (from gdbm info),
+      if `flags' is set to;
+ 
+      GDBM_READER,  the user wants to just read the database and any
+      call to `gdbm_store' or `gdbm_delete' will fail.
+      Many readers can access the database at the same
+      time.
+ 
+      GDBM_WRITER,  the user wants both read and write access to the
+      database and requires exclusive access.
+ 
+      GDBM_WRCREAT, the user wants both read and write access to the
+      database and if the database does not exist,
+      create a new one.
+ 
+      GDBM_NEWDB,   the user want a new database created, regardless
+      of whether one existed, and wants read and write
+      access to the new database.
+ 
+      For all writers (GDBM_WRITER, GDBM_WRCREAT and GDBM_NEWDB) the
+      value GDBM_FAST can be added to the `flags' field using logical
+      or.  This option causes `gdbm' to write the database without
+      any disk file synchronization.  This allows faster writes, but
+      may produce an inconsistent database in the event of abnormal
+      termination of the writer.  Any error detected will cause a
+      return value of NULL and an appropriate value will be in
+      `gdbm_errno' (see Variables). If no errors occur, a pointer to
+      the `gdbm' file descriptor will be returned.
+   */
+   int modemask;
+   int accessmask = 0;
+   int block_size = 512;
+   char *filename;
+   char *acc;
+   char *rp;
+   char *wp;
+   Lisp_Database *db = NULL;
+   Lisp_Object retval;
+   GDBM_FILE dbase;
+ 
+   GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
+ 
+   if (NILP (access_))
+     accessmask = GDBM_WRCREAT;
+   else
+     {
+       CHECK_STRING (access_);
+       acc = (char *) XSTRING_DATA (access_);
+ 
+       rp = strchr (acc, 'r');
+       wp = strchr (acc, 'w');
+ 
+       if (rp && wp) {
+ 	if (strchr (acc, '+')) accessmask = GDBM_WRCREAT;
+ 	else accessmask = GDBM_WRITER;
+       }
+       else if (rp) accessmask = GDBM_READER;
+       else accessmask = GDBM_NEWDB;
+     }
+ 
+   if (NILP (mode))
+     modemask = 0755;		/* rwxr-xr-x */
+   else {
+     CHECK_INT (mode);
+     modemask = XINT (mode);
+   }
+ 
+   /* Should check directory is writeable or not in case 
+      GDBM_WRITER, GDBM_WRCREAT or GDBM_NEWDB flag is set. */
+ 
+   dbase = gdbm_open (filename, block_size, accessmask, modemask, NULL);
+ 
+   if (!dbase)
+     return Qnil;
+ 
+   db = allocate_database ();
+   db->gdbm_handle = dbase;
+   db->funcs = &gdbm_func_block;
+   db->live_p = 1;
+   db->fname = file;
+   db->mode = modemask;
+   db->access_ = accessmask;
+ 
+   XSETDATABASE (retval, db);
+   return retval;
+ }
+ #endif /* HAVE_GDBM */
+ 
  #ifdef HAVE_BERKELEY_DB
  static Lisp_Object
  berkdb_type (Lisp_Database *db)
***************
*** 543,591 ****
    berkdb_close,
    berkdb_lasterr
  };
- #endif /* HAVE_BERKELEY_DB */
- 
- DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
- Return the last error associated with DATABASE.
- */
-        (database))
- {
-   if (NILP (database))
-     return lisp_strerror (errno);
- 
-   CHECK_DATABASE (database);
  
!   return XDATABASE (database)->funcs->last_error (XDATABASE (database));
! }
! 
! DEFUN ("open-database", Fopen_database, 1, 5, 0, /*
! Return a new database object opened on FILE.
! Optional arguments TYPE and SUBTYPE specify the database type.
! Optional argument ACCESS specifies the access rights, which may be any
! combination of 'r' 'w' and '+', for read, write, and creation flags.
! Optional argument MODE gives the permissions to use when opening FILE,
! and defaults to 0755.
! */
!        (file, type, subtype, access_, mode))
  {
-   /* This function can GC */
    int modemask;
    int accessmask = 0;
-   Lisp_Database *db = NULL;
    char *filename;
!   struct gcpro gcpro1, gcpro2;
! 
!   CHECK_STRING (file);
!   GCPRO2 (file, access_);
!   file = Fexpand_file_name (file, Qnil);
!   UNGCPRO;
  
    GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
  
    if (NILP (access_))
!     {
!       accessmask = O_RDWR | O_CREAT;
!     }
    else
      {
        char *acc;
--- 841,861 ----
    berkdb_close,
    berkdb_lasterr
  };
  
! static Lisp_Object
! berkdb_open_database (Lisp_Object file, Lisp_Object type, Lisp_Object subtype,
! 		      Lisp_Object access_, Lisp_Object mode )
  {
    int modemask;
    int accessmask = 0;
    char *filename;
!   Lisp_Database *db = NULL;
!   Lisp_Object retval;
  
    GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
  
    if (NILP (access_))
!     accessmask = O_RDWR | O_CREAT;
    else
      {
        char *acc;
***************
*** 605,706 ****
      }
  
    if (NILP (mode))
!     {
!       modemask = 0755;		/* rwxr-xr-x */
!     }
    else
      {
        CHECK_INT (mode);
        modemask = XINT (mode);
      }
  
! #ifdef HAVE_DBM
!   if (NILP (type) || EQ (type, Qdbm))
!     {
!       DBM *dbase = dbm_open (filename, accessmask, modemask);
!       if (!dbase)
! 	return Qnil;
! 
!       db = allocate_database ();
!       db->dbm_handle = dbase;
!       db->funcs = &ndbm_func_block;
!       goto db_done;
!     }
! #endif /* HAVE_DBM */
! 
! #ifdef HAVE_BERKELEY_DB
!   if (NILP (type) || EQ (type, Qberkeley_db))
!     {
!       DBTYPE real_subtype;
!       DB *dbase;
  #if DB_VERSION_MAJOR != 1
!       int status;
  #endif
  
!       if (EQ (subtype, Qhash) || NILP (subtype))
! 	real_subtype = DB_HASH;
!       else if (EQ (subtype, Qbtree))
! 	real_subtype = DB_BTREE;
!       else if (EQ (subtype, Qrecno))
! 	real_subtype = DB_RECNO;
!       else
! 	signal_simple_error ("Unsupported subtype", subtype);
  
  #if DB_VERSION_MAJOR == 1
!       dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
!       if (!dbase)
! 	return Qnil;
  #else
!       /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
! 	 other flags shouldn't be set */
!       if (NILP (access_))
! 	accessmask = DB_CREATE;
!       else
! 	{
! 	  char *acc;
! 	  CHECK_STRING (access_);
! 	  acc = (char *) XSTRING_DATA (access_);
! 	  accessmask = 0;
! 
! 	  if (strchr (acc, '+'))
! 	    accessmask |= DB_CREATE;
! 
! 	  if (strchr (acc, 'r') && !strchr (acc, 'w'))
! 	    accessmask |= DB_RDONLY;
! 	}
!       status = db_open (filename, real_subtype, accessmask,
! 			modemask, NULL , NULL, &dbase);
!       if (status)
! 	return Qnil;
! #endif /* DB_VERSION_MAJOR */
  
!       db = allocate_database ();
!       db->db_handle = dbase;
!       db->funcs = &berk_func_block;
!       goto db_done;
      }
- #endif /* HAVE_BERKELEY_DB */
  
!   signal_simple_error ("Unsupported database type", type);
!   return Qnil;
  
!  db_done:
    db->live_p = 1;
    db->fname = file;
    db->mode = modemask;
    db->access_ = accessmask;
  
    {
!     Lisp_Object retval;
!     XSETDATABASE (retval, db);
!     return retval;
    }
  }
  
  DEFUN ("put-database", Fput_database, 3, 4, 0, /*
  Store KEY and VALUE in DATABASE.
! If optional fourth arg REPLACE is non-nil,
! replace any existing entry in the database.
  */
         (key, value, database, replace))
  {
--- 875,1134 ----
      }
  
    if (NILP (mode))
!     modemask = 0755;		/* rwxr-xr-x */
    else
      {
        CHECK_INT (mode);
        modemask = XINT (mode);
      }
  
!   DBTYPE real_subtype;
!   DB *dbase;
  #if DB_VERSION_MAJOR != 1
!   int status;
  #endif
  
!   if (EQ (subtype, Qhash) || NILP (subtype))
!     real_subtype = DB_HASH;
!   else if (EQ (subtype, Qbtree))
!     real_subtype = DB_BTREE;
!   else if (EQ (subtype, Qrecno))
!     real_subtype = DB_RECNO;
!   else
!     signal_simple_error ("Unsupported subtype", subtype);
  
  #if DB_VERSION_MAJOR == 1
!   dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
!   if (!dbase)
!     return Qnil;
  #else
!   /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
!      other flags shouldn't be set */
!   if (NILP (access_))
!     accessmask = DB_CREATE;
!   else
!     {
!       char *acc;
!       CHECK_STRING (access_);
!       acc = (char *) XSTRING_DATA (access_);
!       accessmask = 0;
  
!       if (strchr (acc, '+'))
! 	accessmask |= DB_CREATE;
! 
!       if (strchr (acc, 'r') && !strchr (acc, 'w'))
! 	accessmask |= DB_RDONLY;
      }
  
!   /* Should check directory is writeable or not in case O_RDWR or
!      O_WRONLY and/or O_CREAT is set. */
  
!   status = db_open (filename, real_subtype, accessmask,
! 		    modemask, NULL , NULL, &dbase);
!   if (status)
!     return Qnil;
! #endif /* DB_VERSION_MAJOR */
! 
!   db = allocate_database ();
!   db->db_handle = dbase;
!   db->funcs = &berk_func_block;
    db->live_p = 1;
    db->fname = file;
    db->mode = modemask;
    db->access_ = accessmask;
  
+   XSETDATABASE (retval, db);
+   return retval;
+ }
+ #endif /* HAVE_BERKELEY_DB */
+ 
+ #ifdef HAVE_GDBM
+ DEFUN ("reorganize-database", Freorganize_database, 1, 1, 0, /*
+ Reorganize database DATABASE (gdbm specific function).
+ Shrink the space used by the `gdbm' file.
+ Always return nil.
+ */
+        (database))
+ {
+   if (!(EQ (Fdatabase_type(database), Qgdbm)))
+     signal_simple_error ("Can't reorganize a non-gdbm database", database);
+   CHECK_LIVE_DATABASE (database);
+   {
+     Lisp_Database *db = XDATABASE (database);
+     int ret = gdbm_reorganize(db->gdbm_handle);
+     db->access_mark = 1;
+ 
+     if (0 > ret)
+       signal_simple_error (gdbm_strerror(gdbm_errno), database);
+ 
+     return Qnil;
+   }
+ }
+ 
+ DEFUN ("synchronize-database", Fsynchronize_database, 1, 1, 0, /*
+ Synchronize database DATABASE (gdbm specific function).
+ Always return nil.
+ 
+ If you set GDBM_FAST flag to DATABASE, `gdbm' does not wait for writes
+ to the disk to complete before continuing.  This allows faster writing
+ of DATABASE at the risk of having a corrupted DATABASE if the
+ application terminates in an abnormal fashion.  This function allows
+ the programmer to make sure the disk version of DATABASE has been
+ completely updated with all changes to the current time.
+ 
+ This would usually be called after a complete set of changes have been
+ made to DATABASE and before some long waiting time.
+ 
+ `close-database' automatically calls the equivalent of
+ `synchronize-database' so no call is needed if DATABASE is to be
+ closed immediately after the set of changes have been made.
+ */
+        (database))
+ {
+ 
+   if (!(EQ (Fdatabase_type(database), Qgdbm)))
+     signal_simple_error ("Can't synchronize a non-gdbm database", database);
+   CHECK_LIVE_DATABASE (database);
    {
!     Lisp_Database *db = XDATABASE (database);
!     gdbm_sync(db->gdbm_handle);
!     db->access_mark = 1;
!     return Qnil;
    }
  }
  
+ DEFUN ("set-database-property", Fset_database_property, 3, 3, 0, /*
+ Set property PROP to VALUE on DATABASE (gdbm specific function).
+ Always return nil.
+ 
+ The valid properties are currently:
+    cachesize - Set the size of the internal bucket cache.
+ VALUE should be integer.
+ This property may only be set once on each DATABASE, and is set
+ automatically to 100 when DATABASE is opened.
+ 
+    fastmode - Set fast mode to either on or off.
+ VALUE should be set to either nil or non-nil.
+ This allows fast mode to be toggled on an already open and active
+ DATABASE.
+ */
+        (database, prop, value))
+ {
+   int opt = 0;
+   int var = 0;
+   int ret = 0;
+   Lisp_Database *db;
+ 
+   CHECK_LIVE_DATABASE (database);
+ 
+   if (!(EQ (Fdatabase_type(database), Qgdbm)))
+     signal_simple_error ("Can't set property on a non-gdbm database", database);
+ 
+   db = XDATABASE (database);
+ 
+   CHECK_SYMBOL (prop);
+   if (EQ (prop, Qcachesize)){
+ 
+     if (db->access_mark == 1)
+       /* This option can set only once prior to accessing DATABASE */
+       signal_simple_error ("Can't change cachesize of DATABASE already accessed", database);
+ 
+     if (INTP(value))
+       var = XINT(value);
+     else
+       signal_simple_error ("VALUE should be integer", value);
+ 
+     opt = GDBM_CACHESIZE; /* initial value set automatically is 100 */
+ 
+   }
+   else if (EQ (prop, Qfastmode)) {
+ 
+     if (SYMBOLP(value)) {
+       var = (EQ (value, Qnil)) ? 0 : 1;
+       opt = GDBM_FASTMODE;  /* TRUE or FALSE */
+ 
+     } else
+       signal_simple_error ("VALUE should be symbol", value);
+ 
+   }
+ 
+   ret = gdbm_setopt(db->gdbm_handle, opt, &var, sizeof(int));
+ 
+   if (0 > ret)
+     signal_simple_error (gdbm_strerror(gdbm_errno), database);
+ 
+   if (EQ (prop, Qfastmode))
+ 
+     if (var == 0)
+       db->access_ &= ~GDBM_FAST;
+     else 
+       db->access_ |= GDBM_FAST;
+ 
+   return Qnil;
+ }
+ #endif /* HAVE_GDBM */
+ 
+ DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
+ Return the last error associated with DATABASE.
+ */
+        (database))
+ {
+   if (NILP (database))
+     return lisp_strerror (errno);
+ 
+   CHECK_DATABASE (database);
+ 
+   return XDATABASE (database)->funcs->last_error (XDATABASE (database));
+ }
+ 
+ DEFUN ("open-database", Fopen_database, 1, 5, 0, /*
+ Return a new database object opened on FILE.
+ 
+ Optional arguments TYPE and SUBTYPE specify the database type.
+ TYPE is one of `berkeley-db', `dbm' and `gdbm' symbol (which depends
+ on compile option of XEmacs).  SUBTYPE is only valid for berkeley-db.
+ 
+ Optional argument ACCESS specifies the access rights, which may be any
+ combination string of 'r' 'w' and '+', for read, write, and creation
+ flags.  If nil, full access (and create if FILE does not exist) is
+ granted.
+ 
+ Optional argument MODE gives the permissions to use when opening FILE,
+ and defaults to 0755.
+ */
+        (file, type, subtype, access_, mode))
+ {
+   /* This function can GC */
+   struct gcpro gcpro1, gcpro2;
+ 
+   CHECK_STRING (file);
+   GCPRO2 (file, access_);
+   file = Fexpand_file_name (file, Qnil);
+   UNGCPRO;
+ 
+ #ifdef HAVE_GDBM
+   if (NILP (type) ||EQ (type, Qgdbm)) {
+     return gdbm_open_database (file, access_, mode);
+   }
+ #endif
+ #ifdef HAVE_DBM
+   if (NILP (type) ||EQ (type, Qdbm)) {
+     return dbm_open_database (file, access_, mode);
+   }
+ #endif
+ #ifdef HAVE_BERKELEY_DB
+   if (NILP (type) ||EQ (type, Qberkeley_db)) {
+     return berkdb_open_database (file, type, subtype, access_, mode);
+   }
+ #endif
+   signal_simple_error ("Unsupported database type", type);
+ }
+ 
  DEFUN ("put-database", Fput_database, 3, 4, 0, /*
  Store KEY and VALUE in DATABASE.
! Return t if success, otherwise nil.
! If optional fourth arg REPLACE is non-nil, replace any existing
! entry in the database.
  */
         (key, value, database, replace))
  {
***************
*** 716,721 ****
--- 1144,1150 ----
  
  DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
  Remove KEY from DATABASE.
+ Return t if success, otherwise nil.
  */
         (key, database))
  {
***************
*** 746,751 ****
--- 1175,1181 ----
  DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
  Map FUNCTION over entries in DATABASE, calling it with two args,
  each key and value in the database.
+ Always return nil.
  */
         (function, database))
  {
***************
*** 763,768 ****
--- 1193,1203 ----
  #ifdef HAVE_DBM
    defsymbol (&Qdbm, "dbm");
  #endif
+ #ifdef HAVE_GDBM
+   defsymbol (&Qgdbm, "gdbm");
+   defsymbol (&Qcachesize, "cachesize");
+   defsymbol (&Qfastmode, "fastmode");
+ #endif
  #ifdef HAVE_BERKELEY_DB
    defsymbol (&Qberkeley_db, "berkeley-db");
    defsymbol (&Qhash, "hash");
***************
*** 771,776 ****
--- 1206,1216 ----
    defsymbol (&Qunknown, "unknown");
  #endif
  
+ #ifdef HAVE_GDBM
+   DEFSUBR (Freorganize_database);
+   DEFSUBR (Fsynchronize_database);
+   DEFSUBR (Fset_database_property);
+ #endif /* HAVE_GDBM */
    DEFSUBR (Fopen_database);
    DEFSUBR (Fdatabasep);
    DEFSUBR (Fmapdatabase);
***************
*** 791,796 ****
--- 1231,1239 ----
  #ifdef HAVE_DBM
    Fprovide (Qdbm);
  #endif
+ #ifdef HAVE_GDBM
+   Fprovide (Qgdbm);
+ #endif
  #ifdef HAVE_BERKELEY_DB
    Fprovide (Qberkeley_db);
  #endif
***************
*** 804,806 ****
--- 1247,1250 ----
  #endif
  #endif /* 0 */
  }
+ /* end of database.c */
