XEmacs 21.2.20 "Yoko".
[chise/xemacs-chise.git.1] / src / database.c
1 /* Database access routines
2    Copyright (C) 1996, William M. Perry
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING.  If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA.  */
20
21 /* Synched up with: Not in FSF. */
22
23 /* Written by Bill Perry */
24 /* Substantially rewritten by Martin Buchholz */
25 /* db 2.x support added by Andreas Jaeger */
26
27 #include <config.h>
28 #include "lisp.h"
29 #include "sysfile.h"
30 #include "buffer.h"
31 #include <errno.h>
32
33 #ifndef HAVE_DATABASE
34 #error HAVE_DATABASE not defined!!
35 #endif
36
37 #include "database.h"         /* Our include file */
38
39 #ifdef HAVE_BERKELEY_DB
40 /* Work around Berkeley DB's use of int types which are defined
41    slightly differently in the not quite yet standard <inttypes.h>.
42    See db.h for details of why we're resorting to this... */
43 /* glibc 2.1 doesn't have this problem with DB 2.x */
44 #if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1)
45 #ifdef HAVE_INTTYPES_H
46 #define __BIT_TYPES_DEFINED__
47 #include <inttypes.h>
48 typedef uint8_t  u_int8_t;
49 typedef uint16_t u_int16_t;
50 typedef uint32_t u_int32_t;
51 #ifdef WE_DONT_NEED_QUADS
52 typedef uint64_t u_int64_t;
53 #endif /* WE_DONT_NEED_QUADS */
54 #endif /* HAVE_INTTYPES_H */
55 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */
56 #include DB_H_PATH              /* Berkeley db's header file */
57 #ifndef DB_VERSION_MAJOR
58 # define DB_VERSION_MAJOR 1
59 #endif /* DB_VERSION_MAJOR */
60 Lisp_Object Qberkeley_db;
61 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
62 #endif /* HAVE_BERKELEY_DB */
63
64 #ifdef HAVE_DBM
65 #include <ndbm.h>
66 Lisp_Object Qdbm;
67 #endif /* HAVE_DBM */
68
69 #ifdef MULE
70 /* #### The following should be settable on a per-database level.
71    But the whole coding-system infrastructure should be rewritten someday.
72    We really need coding-system aliases. -- martin */
73 Lisp_Object Vdatabase_coding_system;
74 #endif
75
76 Lisp_Object Qdatabasep;
77
78 struct Lisp_Database;
79 typedef struct Lisp_Database Lisp_Database;
80
81 typedef struct
82 {
83   Lisp_Object (*get_subtype) (Lisp_Database *);
84   Lisp_Object (*get_type) (Lisp_Database *);
85   Lisp_Object (*get) (Lisp_Database *, Lisp_Object);
86   int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object);
87   int (*rem) (Lisp_Database *, Lisp_Object);
88   void (*map) (Lisp_Database *, Lisp_Object);
89   void (*close) (Lisp_Database *);
90   Lisp_Object (*last_error) (Lisp_Database *);
91 } DB_FUNCS;
92
93 struct Lisp_Database
94 {
95   struct lcrecord_header header;
96   Lisp_Object fname;
97   int mode;
98   int access_;
99   int dberrno;
100   int live_p;
101 #ifdef HAVE_DBM
102   DBM *dbm_handle;
103 #endif
104 #ifdef HAVE_BERKELEY_DB
105   DB *db_handle;
106 #endif
107   DB_FUNCS *funcs;
108 #ifdef MULE
109   Lisp_Object coding_system;
110 #endif
111 };
112
113 #define XDATABASE(x) XRECORD (x, database, Lisp_Database)
114 #define XSETDATABASE(x, p) XSETRECORD (x, p, database)
115 #define DATABASEP(x) RECORDP (x, database)
116 #define GC_DATABASEP(x) GC_RECORDP (x, database)
117 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
118 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database)
119 #define DATABASE_LIVE_P(x) (x->live_p)
120
121 #define CHECK_LIVE_DATABASE(db) do {                                    \
122   CHECK_DATABASE (db);                                                  \
123   if (!DATABASE_LIVE_P (XDATABASE(db)))                                 \
124     signal_simple_error ("Attempting to access closed database", db);   \
125 } while (0)
126
127
128 static Lisp_Database *
129 allocate_database (void)
130 {
131   Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, &lrecord_database);
132
133   db->fname = Qnil;
134   db->live_p = 0;
135 #ifdef HAVE_BERKELEY_DB
136   db->db_handle = NULL;
137 #endif
138 #ifdef HAVE_DBM
139   db->dbm_handle = NULL;
140 #endif
141   db->access_ = 0;
142   db->mode = 0;
143   db->dberrno = 0;
144 #ifdef MULE
145   db->coding_system = Fget_coding_system (Qbinary);
146 #endif
147   return db;
148 }
149
150 static Lisp_Object
151 mark_database (Lisp_Object obj)
152 {
153   Lisp_Database *db = XDATABASE (obj);
154   return db->fname;
155 }
156
157 static void
158 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
159 {
160   char buf[64];
161   Lisp_Database *db = XDATABASE (obj);
162
163   if (print_readably)
164     error ("printing unreadable object #<database 0x%x>", db->header.uid);
165
166   write_c_string ("#<database \"", printcharfun);
167   print_internal (db->fname, printcharfun, 0);
168   sprintf (buf, "\" (%s/%s/%s) 0x%x>",
169            (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
170            (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
171            (!DATABASE_LIVE_P (db)    ? "closed"    :
172             (db->access_ & O_WRONLY) ? "writeonly" :
173             (db->access_ & O_RDWR)   ? "readwrite" : "readonly"),
174            db->header.uid);
175   write_c_string (buf, printcharfun);
176 }
177
178 static void
179 finalize_database (void *header, int for_disksave)
180 {
181   Lisp_Database *db = (Lisp_Database *) header;
182
183   if (for_disksave)
184     {
185       Lisp_Object obj;
186       XSETDATABASE (obj, db);
187
188       signal_simple_error
189         ("Can't dump an emacs containing database objects", obj);
190     }
191   db->funcs->close (db);
192 }
193
194 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
195                                mark_database, print_database,
196                                finalize_database, 0, 0, 0,
197                                Lisp_Database);
198
199 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
200 Close database DATABASE.
201 */
202        (database))
203 {
204   Lisp_Database *db;
205   CHECK_LIVE_DATABASE (database);
206   db = XDATABASE (database);
207   db->funcs->close (db);
208   db->live_p = 0;
209   return Qnil;
210 }
211
212 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
213 Return the type of database DATABASE.
214 */
215        (database))
216 {
217   CHECK_DATABASE (database);
218
219   return XDATABASE (database)->funcs->get_type (XDATABASE (database));
220 }
221
222 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
223 Return the subtype of database DATABASE, if any.
224 */
225        (database))
226 {
227   CHECK_DATABASE (database);
228
229   return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
230 }
231
232 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
233 Return t if OBJ is an active database.
234 */
235        (obj))
236 {
237   return DATABASEP (obj) && DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
238 }
239
240 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
241 Return the filename associated with the database DATABASE.
242 */
243        (database))
244 {
245   CHECK_DATABASE (database);
246
247   return XDATABASE (database)->fname;
248 }
249
250 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
251 Return t if OBJ is a database.
252 */
253        (obj))
254 {
255   return DATABASEP (obj) ? Qt : Qnil;
256 }
257
258 #ifdef HAVE_DBM
259 static void
260 dbm_map (Lisp_Database *db, Lisp_Object func)
261 {
262   datum keydatum, valdatum;
263   Lisp_Object key, val;
264
265   for (keydatum = dbm_firstkey (db->dbm_handle);
266        keydatum.dptr != NULL;
267        keydatum = dbm_nextkey (db->dbm_handle))
268     {
269       valdatum = dbm_fetch (db->dbm_handle, keydatum);
270       key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize);
271       val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize);
272       call2 (func, key, val);
273     }
274 }
275
276 static Lisp_Object
277 dbm_get (Lisp_Database *db, Lisp_Object key)
278 {
279   datum keydatum, valdatum;
280
281   keydatum.dptr = (char *) XSTRING_DATA (key);
282   keydatum.dsize = XSTRING_LENGTH (key);
283   valdatum = dbm_fetch (db->dbm_handle, keydatum);
284
285   return (valdatum.dptr
286           ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize)
287           : Qnil);
288 }
289
290 static int
291 dbm_put (Lisp_Database *db,
292          Lisp_Object key, Lisp_Object val, Lisp_Object replace)
293 {
294   datum keydatum, valdatum;
295
296   valdatum.dptr = (char *) XSTRING_DATA (val);
297   valdatum.dsize = XSTRING_LENGTH (val);
298   keydatum.dptr = (char *) XSTRING_DATA (key);
299   keydatum.dsize = XSTRING_LENGTH (key);
300
301   return !dbm_store (db->dbm_handle, keydatum, valdatum,
302                      NILP (replace) ? DBM_INSERT : DBM_REPLACE);
303 }
304
305 static int
306 dbm_remove (Lisp_Database *db, Lisp_Object key)
307 {
308   datum keydatum;
309
310   keydatum.dptr = (char *) XSTRING_DATA (key);
311   keydatum.dsize = XSTRING_LENGTH (key);
312
313   return dbm_delete (db->dbm_handle, keydatum);
314 }
315
316 static Lisp_Object
317 dbm_type (Lisp_Database *db)
318 {
319   return Qdbm;
320 }
321
322 static Lisp_Object
323 dbm_subtype (Lisp_Database *db)
324 {
325   return Qnil;
326 }
327
328 static Lisp_Object
329 dbm_lasterr (Lisp_Database *db)
330 {
331   return lisp_strerror (db->dberrno);
332 }
333
334 static void
335 dbm_closeit (Lisp_Database *db)
336 {
337   if (db->dbm_handle)
338     {
339       dbm_close (db->dbm_handle);
340       db->dbm_handle = NULL;
341     }
342 }
343
344 static DB_FUNCS ndbm_func_block =
345 {
346   dbm_subtype,
347   dbm_type,
348   dbm_get,
349   dbm_put,
350   dbm_remove,
351   dbm_map,
352   dbm_closeit,
353   dbm_lasterr
354 };
355 #endif /* HAVE_DBM */
356
357 #ifdef HAVE_BERKELEY_DB
358 static Lisp_Object
359 berkdb_type (Lisp_Database *db)
360 {
361   return Qberkeley_db;
362 }
363
364 static Lisp_Object
365 berkdb_subtype (Lisp_Database *db)
366 {
367   if (!db->db_handle)
368     return Qnil;
369
370   switch (db->db_handle->type)
371     {
372     case DB_BTREE: return Qbtree;
373     case DB_HASH:  return Qhash;
374     case DB_RECNO: return Qrecno;
375     default:       return Qunknown;
376     }
377 }
378
379 static Lisp_Object
380 berkdb_lasterr (Lisp_Database *db)
381 {
382   return lisp_strerror (db->dberrno);
383 }
384
385 static Lisp_Object
386 berkdb_get (Lisp_Database *db, Lisp_Object key)
387 {
388   DBT keydatum, valdatum;
389   int status = 0;
390
391   /* DB Version 2 requires DBT's to be zeroed before use. */
392   xzero (keydatum);
393   xzero (valdatum);
394
395   keydatum.data = XSTRING_DATA (key);
396   keydatum.size = XSTRING_LENGTH (key);
397
398 #if DB_VERSION_MAJOR == 1
399   status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
400 #else
401   status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
402 #endif /* DB_VERSION_MAJOR */
403
404   if (!status)
405     /* #### Not mule-ized! will crash! */
406     return make_string ((Bufbyte *) valdatum.data, valdatum.size);
407
408 #if DB_VERSION_MAJOR == 1
409   db->dberrno = (status == 1) ? -1 : errno;
410 #else
411   db->dberrno = (status < 0) ? -1 : errno;
412 #endif /* DB_VERSION_MAJOR */
413
414   return Qnil;
415 }
416
417 static int
418 berkdb_put (Lisp_Database *db,
419             Lisp_Object key,
420             Lisp_Object val,
421             Lisp_Object replace)
422 {
423   DBT keydatum, valdatum;
424   int status = 0;
425
426   /* DB Version 2 requires DBT's to be zeroed before use. */
427   xzero (keydatum);
428   xzero (valdatum);
429
430   keydatum.data = XSTRING_DATA   (key);
431   keydatum.size = XSTRING_LENGTH (key);
432   valdatum.data = XSTRING_DATA   (val);
433   valdatum.size = XSTRING_LENGTH (val);
434 #if DB_VERSION_MAJOR == 1
435   status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
436                                NILP (replace) ? R_NOOVERWRITE : 0);
437   db->dberrno = (status == 1) ? -1 : errno;
438 #else
439   status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
440                                NILP (replace) ? DB_NOOVERWRITE : 0);
441   db->dberrno = (status < 0) ? -1 : errno;
442 #endif/* DV_VERSION_MAJOR = 2 */
443
444   return status;
445 }
446
447 static int
448 berkdb_remove (Lisp_Database *db, Lisp_Object key)
449 {
450   DBT keydatum;
451   int status;
452
453   /* DB Version 2 requires DBT's to be zeroed before use. */
454   xzero (keydatum);
455
456   keydatum.data = XSTRING_DATA   (key);
457   keydatum.size = XSTRING_LENGTH (key);
458
459 #if DB_VERSION_MAJOR == 1
460   status = db->db_handle->del (db->db_handle, &keydatum, 0);
461 #else
462   status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
463 #endif /* DB_VERSION_MAJOR */
464
465   if (!status)
466     return 0;
467
468 #if DB_VERSION_MAJOR == 1
469   db->dberrno = (status == 1) ? -1 : errno;
470 #else
471   db->dberrno = (status < 0) ? -1 : errno;
472 #endif /* DB_VERSION_MAJOR */
473
474   return 1;
475 }
476
477 static void
478 berkdb_map (Lisp_Database *db, Lisp_Object func)
479 {
480   DBT keydatum, valdatum;
481   Lisp_Object key, val;
482   DB *dbp = db->db_handle;
483   int status;
484
485   xzero (keydatum);
486   xzero (valdatum);
487
488 #if DB_VERSION_MAJOR == 1
489   for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
490        status == 0;
491        status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
492     {
493       /* ### Needs mule-izing */
494       key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
495       val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
496       call2 (func, key, val);
497     }
498 #else
499   {
500     DBC *dbcp;
501
502 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6
503     status = dbp->cursor (dbp, NULL, &dbcp, 0);
504 #else
505     status = dbp->cursor (dbp, NULL, &dbcp);
506 #endif   
507     for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
508          status == 0;
509          status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
510       {
511         /* ### Needs mule-izing */
512         key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
513         val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
514         call2 (func, key, val);
515       }
516     dbcp->c_close (dbcp);
517   }
518 #endif /* DB_VERSION_MAJOR */
519 }
520
521 static void
522 berkdb_close (Lisp_Database *db)
523 {
524   if (db->db_handle)
525     {
526 #if DB_VERSION_MAJOR == 1
527       db->db_handle->sync  (db->db_handle, 0);
528       db->db_handle->close (db->db_handle);
529 #else
530       db->db_handle->sync  (db->db_handle, 0);
531       db->db_handle->close (db->db_handle, 0);
532 #endif /* DB_VERSION_MAJOR */
533       db->db_handle = NULL;
534     }
535 }
536
537 static DB_FUNCS berk_func_block =
538 {
539   berkdb_subtype,
540   berkdb_type,
541   berkdb_get,
542   berkdb_put,
543   berkdb_remove,
544   berkdb_map,
545   berkdb_close,
546   berkdb_lasterr
547 };
548 #endif /* HAVE_BERKELEY_DB */
549
550 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
551 Return the last error associated with DATABASE.
552 */
553        (database))
554 {
555   if (NILP (database))
556     return lisp_strerror (errno);
557
558   CHECK_DATABASE (database);
559
560   return XDATABASE (database)->funcs->last_error (XDATABASE (database));
561 }
562
563 DEFUN ("open-database", Fopen_database, 1, 5, 0, /*
564 Return a new database object opened on FILE.
565 Optional arguments TYPE and SUBTYPE specify the database type.
566 Optional argument ACCESS specifies the access rights, which may be any
567 combination of 'r' 'w' and '+', for read, write, and creation flags.
568 Optional argument MODE gives the permissions to use when opening FILE,
569 and defaults to 0755.
570 */
571        (file, type, subtype, access_, mode))
572 {
573   /* This function can GC */
574   int modemask;
575   int accessmask = 0;
576   Lisp_Database *db = NULL;
577   char *filename;
578   struct gcpro gcpro1, gcpro2;
579
580   CHECK_STRING (file);
581   GCPRO2 (file, access_);
582   file = Fexpand_file_name (file, Qnil);
583   UNGCPRO;
584
585   GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
586
587   if (NILP (access_))
588     {
589       accessmask = O_RDWR | O_CREAT;
590     }
591   else
592     {
593       char *acc;
594       CHECK_STRING (access_);
595       acc = (char *) XSTRING_DATA (access_);
596
597       if (strchr (acc, '+'))
598         accessmask |= O_CREAT;
599
600       {
601         char *rp = strchr (acc, 'r');
602         char *wp = strchr (acc, 'w');
603         if (rp && wp) accessmask |= O_RDWR;
604         else if (wp)  accessmask |= O_WRONLY;
605         else          accessmask |= O_RDONLY;
606       }
607     }
608
609   if (NILP (mode))
610     {
611       modemask = 0755;          /* rwxr-xr-x */
612     }
613   else
614     {
615       CHECK_INT (mode);
616       modemask = XINT (mode);
617     }
618
619 #ifdef HAVE_DBM
620   if (NILP (type) || EQ (type, Qdbm))
621     {
622       DBM *dbase = dbm_open (filename, accessmask, modemask);
623       if (!dbase)
624         return Qnil;
625
626       db = allocate_database ();
627       db->dbm_handle = dbase;
628       db->funcs = &ndbm_func_block;
629       goto db_done;
630     }
631 #endif /* HAVE_DBM */
632
633 #ifdef HAVE_BERKELEY_DB
634   if (NILP (type) || EQ (type, Qberkeley_db))
635     {
636       DBTYPE real_subtype;
637       DB *dbase;
638 #if DB_VERSION_MAJOR != 1
639       int status;
640 #endif
641
642       if (EQ (subtype, Qhash) || NILP (subtype))
643         real_subtype = DB_HASH;
644       else if (EQ (subtype, Qbtree))
645         real_subtype = DB_BTREE;
646       else if (EQ (subtype, Qrecno))
647         real_subtype = DB_RECNO;
648       else
649         signal_simple_error ("Unsupported subtype", subtype);
650
651 #if DB_VERSION_MAJOR == 1
652       dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
653       if (!dbase)
654         return Qnil;
655 #else
656       /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
657          other flags shouldn't be set */
658       if (NILP (access_))
659         accessmask = DB_CREATE;
660       else
661         {
662           char *acc;
663           CHECK_STRING (access_);
664           acc = (char *) XSTRING_DATA (access_);
665           accessmask = 0;
666
667           if (strchr (acc, '+'))
668             accessmask |= DB_CREATE;
669
670           if (strchr (acc, 'r') && !strchr (acc, 'w'))
671             accessmask |= DB_RDONLY;
672         }
673       status = db_open (filename, real_subtype, accessmask,
674                         modemask, NULL , NULL, &dbase);
675       if (status)
676         return Qnil;
677 #endif /* DB_VERSION_MAJOR */
678
679       db = allocate_database ();
680       db->db_handle = dbase;
681       db->funcs = &berk_func_block;
682       goto db_done;
683     }
684 #endif /* HAVE_BERKELEY_DB */
685
686   signal_simple_error ("Unsupported database type", type);
687   return Qnil;
688
689  db_done:
690   db->live_p = 1;
691   db->fname = file;
692   db->mode = modemask;
693   db->access_ = accessmask;
694
695   {
696     Lisp_Object retval;
697     XSETDATABASE (retval, db);
698     return retval;
699   }
700 }
701
702 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
703 Store KEY and VALUE in DATABASE.
704 If optional fourth arg REPLACE is non-nil,
705 replace any existing entry in the database.
706 */
707        (key, value, database, replace))
708 {
709   CHECK_LIVE_DATABASE (database);
710   CHECK_STRING (key);
711   CHECK_STRING (value);
712   {
713     Lisp_Database *db = XDATABASE (database);
714     int status = db->funcs->put (db, key, value, replace);
715     return status ? Qt : Qnil;
716   }
717 }
718
719 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
720 Remove KEY from DATABASE.
721 */
722        (key, database))
723 {
724   CHECK_LIVE_DATABASE (database);
725   CHECK_STRING (key);
726   {
727     Lisp_Database *db = XDATABASE (database);
728     int status = db->funcs->rem (db, key);
729     return status ? Qt : Qnil;
730   }
731 }
732
733 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
734 Return value for KEY in DATABASE.
735 If there is no corresponding value, return DEFAULT (defaults to nil).
736 */
737        (key, database, default_))
738 {
739   CHECK_LIVE_DATABASE (database);
740   CHECK_STRING (key);
741   {
742     Lisp_Database *db = XDATABASE (database);
743     Lisp_Object retval = db->funcs->get (db, key);
744     return NILP (retval) ? default_ : retval;
745   }
746 }
747
748 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
749 Map FUNCTION over entries in DATABASE, calling it with two args,
750 each key and value in the database.
751 */
752        (function, database))
753 {
754   CHECK_LIVE_DATABASE (database);
755
756   XDATABASE (database)->funcs->map (XDATABASE (database), function);
757
758   return Qnil;
759 }
760
761 void
762 syms_of_database (void)
763 {
764   defsymbol (&Qdatabasep, "databasep");
765 #ifdef HAVE_DBM
766   defsymbol (&Qdbm, "dbm");
767 #endif
768 #ifdef HAVE_BERKELEY_DB
769   defsymbol (&Qberkeley_db, "berkeley-db");
770   defsymbol (&Qhash, "hash");
771   defsymbol (&Qbtree, "btree");
772   defsymbol (&Qrecno, "recno");
773   defsymbol (&Qunknown, "unknown");
774 #endif
775
776   DEFSUBR (Fopen_database);
777   DEFSUBR (Fdatabasep);
778   DEFSUBR (Fmapdatabase);
779   DEFSUBR (Fput_database);
780   DEFSUBR (Fget_database);
781   DEFSUBR (Fremove_database);
782   DEFSUBR (Fdatabase_type);
783   DEFSUBR (Fdatabase_subtype);
784   DEFSUBR (Fdatabase_last_error);
785   DEFSUBR (Fdatabase_live_p);
786   DEFSUBR (Fdatabase_file_name);
787   DEFSUBR (Fclose_database);
788 }
789
790 void
791 vars_of_database (void)
792 {
793 #ifdef HAVE_DBM
794   Fprovide (Qdbm);
795 #endif
796 #ifdef HAVE_BERKELEY_DB
797   Fprovide (Qberkeley_db);
798 #endif
799
800 #if 0 /* #### implement me! */
801 #ifdef MULE
802   DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /*
803 Coding system used to convert data in database files.
804 */ );
805   Vdatabase_coding_system = Qnil;
806 #endif
807 #endif /* 0 */
808 }