XEmacs 21.2.5
[chise/xemacs-chise.git-] / 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, void (*markobj) (Lisp_Object))
152 {
153   Lisp_Database *db = XDATABASE (obj);
154
155   markobj (db->fname);
156   return Qnil;
157 }
158
159 static void
160 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
161 {
162   char buf[64];
163   Lisp_Database *db = XDATABASE (obj);
164
165   if (print_readably)
166     error ("printing unreadable object #<database 0x%x>", db->header.uid);
167
168   write_c_string ("#<database \"", printcharfun);
169   print_internal (db->fname, printcharfun, 0);
170   sprintf (buf, "\" (%s/%s/%s) 0x%x>",
171            (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
172            (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
173            (!DATABASE_LIVE_P (db)    ? "closed"    :
174             (db->access_ & O_WRONLY) ? "writeonly" :
175             (db->access_ & O_RDWR)   ? "readwrite" : "readonly"),
176            db->header.uid);
177   write_c_string (buf, printcharfun);
178 }
179
180 static void
181 finalize_database (void *header, int for_disksave)
182 {
183   Lisp_Database *db = (Lisp_Database *) header;
184
185   if (for_disksave)
186     {
187       Lisp_Object obj;
188       XSETDATABASE (obj, db);
189
190       signal_simple_error
191         ("Can't dump an emacs containing database objects", obj);
192     }
193   db->funcs->close (db);
194 }
195
196 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
197                                mark_database, print_database,
198                                finalize_database, 0, 0,
199                                Lisp_Database);
200
201 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
202 Close database DATABASE.
203 */
204        (database))
205 {
206   Lisp_Database *db;
207   CHECK_LIVE_DATABASE (database);
208   db = XDATABASE (database);
209   db->funcs->close (db);
210   db->live_p = 0;
211   return Qnil;
212 }
213
214 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
215 Return the type of database DATABASE.
216 */
217        (database))
218 {
219   CHECK_DATABASE (database);
220
221   return XDATABASE (database)->funcs->get_type (XDATABASE (database));
222 }
223
224 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
225 Return the subtype of database DATABASE, if any.
226 */
227        (database))
228 {
229   CHECK_DATABASE (database);
230
231   return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
232 }
233
234 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
235 Return t if OBJ is an active database.
236 */
237        (obj))
238 {
239   return DATABASEP (obj) && DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
240 }
241
242 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
243 Return the filename associated with the database DATABASE.
244 */
245        (database))
246 {
247   CHECK_DATABASE (database);
248
249   return XDATABASE (database)->fname;
250 }
251
252 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
253 Return t if OBJ is a database.
254 */
255        (obj))
256 {
257   return DATABASEP (obj) ? Qt : Qnil;
258 }
259
260 #ifdef HAVE_DBM
261 static void
262 dbm_map (Lisp_Database *db, Lisp_Object func)
263 {
264   datum keydatum, valdatum;
265   Lisp_Object key, val;
266
267   for (keydatum = dbm_firstkey (db->dbm_handle);
268        keydatum.dptr != NULL;
269        keydatum = dbm_nextkey (db->dbm_handle))
270     {
271       valdatum = dbm_fetch (db->dbm_handle, keydatum);
272       key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize);
273       val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize);
274       call2 (func, key, val);
275     }
276 }
277
278 static Lisp_Object
279 dbm_get (Lisp_Database *db, Lisp_Object key)
280 {
281   datum keydatum, valdatum;
282
283   keydatum.dptr = (char *) XSTRING_DATA (key);
284   keydatum.dsize = XSTRING_LENGTH (key);
285   valdatum = dbm_fetch (db->dbm_handle, keydatum);
286
287   return (valdatum.dptr
288           ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize)
289           : Qnil);
290 }
291
292 static int
293 dbm_put (Lisp_Database *db,
294          Lisp_Object key, Lisp_Object val, Lisp_Object replace)
295 {
296   datum keydatum, valdatum;
297
298   valdatum.dptr = (char *) XSTRING_DATA (val);
299   valdatum.dsize = XSTRING_LENGTH (val);
300   keydatum.dptr = (char *) XSTRING_DATA (key);
301   keydatum.dsize = XSTRING_LENGTH (key);
302
303   return !dbm_store (db->dbm_handle, keydatum, valdatum,
304                      NILP (replace) ? DBM_INSERT : DBM_REPLACE);
305 }
306
307 static int
308 dbm_remove (Lisp_Database *db, Lisp_Object key)
309 {
310   datum keydatum;
311
312   keydatum.dptr = (char *) XSTRING_DATA (key);
313   keydatum.dsize = XSTRING_LENGTH (key);
314
315   return dbm_delete (db->dbm_handle, keydatum);
316 }
317
318 static Lisp_Object
319 dbm_type (Lisp_Database *db)
320 {
321   return Qdbm;
322 }
323
324 static Lisp_Object
325 dbm_subtype (Lisp_Database *db)
326 {
327   return Qnil;
328 }
329
330 static Lisp_Object
331 dbm_lasterr (Lisp_Database *db)
332 {
333   return lisp_strerror (db->dberrno);
334 }
335
336 static void
337 dbm_closeit (Lisp_Database *db)
338 {
339   if (db->dbm_handle)
340     {
341       dbm_close (db->dbm_handle);
342       db->dbm_handle = NULL;
343     }
344 }
345
346 static DB_FUNCS ndbm_func_block =
347 {
348   dbm_subtype,
349   dbm_type,
350   dbm_get,
351   dbm_put,
352   dbm_remove,
353   dbm_map,
354   dbm_closeit,
355   dbm_lasterr
356 };
357 #endif /* HAVE_DBM */
358
359 #ifdef HAVE_BERKELEY_DB
360 static Lisp_Object
361 berkdb_type (Lisp_Database *db)
362 {
363   return Qberkeley_db;
364 }
365
366 static Lisp_Object
367 berkdb_subtype (Lisp_Database *db)
368 {
369   if (!db->db_handle)
370     return Qnil;
371
372   switch (db->db_handle->type)
373     {
374     case DB_BTREE: return Qbtree;
375     case DB_HASH:  return Qhash;
376     case DB_RECNO: return Qrecno;
377     default:       return Qunknown;
378     }
379 }
380
381 static Lisp_Object
382 berkdb_lasterr (Lisp_Database *db)
383 {
384   return lisp_strerror (db->dberrno);
385 }
386
387 static Lisp_Object
388 berkdb_get (Lisp_Database *db, Lisp_Object key)
389 {
390   DBT keydatum, valdatum;
391   int status = 0;
392
393   /* DB Version 2 requires DBT's to be zeroed before use. */
394   xzero (keydatum);
395   xzero (valdatum);
396
397   keydatum.data = XSTRING_DATA (key);
398   keydatum.size = XSTRING_LENGTH (key);
399
400 #if DB_VERSION_MAJOR == 1
401   status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
402 #else
403   status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
404 #endif /* DB_VERSION_MAJOR */
405
406   if (!status)
407     /* #### Not mule-ized! will crash! */
408     return make_string ((Bufbyte *) valdatum.data, valdatum.size);
409
410 #if DB_VERSION_MAJOR == 1
411   db->dberrno = (status == 1) ? -1 : errno;
412 #else
413   db->dberrno = (status < 0) ? -1 : errno;
414 #endif /* DB_VERSION_MAJOR */
415
416   return Qnil;
417 }
418
419 static int
420 berkdb_put (Lisp_Database *db,
421             Lisp_Object key,
422             Lisp_Object val,
423             Lisp_Object replace)
424 {
425   DBT keydatum, valdatum;
426   int status = 0;
427
428   /* DB Version 2 requires DBT's to be zeroed before use. */
429   xzero (keydatum);
430   xzero (valdatum);
431
432   keydatum.data = XSTRING_DATA   (key);
433   keydatum.size = XSTRING_LENGTH (key);
434   valdatum.data = XSTRING_DATA   (val);
435   valdatum.size = XSTRING_LENGTH (val);
436 #if DB_VERSION_MAJOR == 1
437   status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
438                                NILP (replace) ? R_NOOVERWRITE : 0);
439   db->dberrno = (status == 1) ? -1 : errno;
440 #else
441   status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
442                                NILP (replace) ? DB_NOOVERWRITE : 0);
443   db->dberrno = (status < 0) ? -1 : errno;
444 #endif/* DV_VERSION_MAJOR = 2 */
445
446   return status;
447 }
448
449 static int
450 berkdb_remove (Lisp_Database *db, Lisp_Object key)
451 {
452   DBT keydatum;
453   int status;
454
455   /* DB Version 2 requires DBT's to be zeroed before use. */
456   xzero (keydatum);
457
458   keydatum.data = XSTRING_DATA   (key);
459   keydatum.size = XSTRING_LENGTH (key);
460
461 #if DB_VERSION_MAJOR == 1
462   status = db->db_handle->del (db->db_handle, &keydatum, 0);
463 #else
464   status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
465 #endif /* DB_VERSION_MAJOR */
466
467   if (!status)
468     return 0;
469
470 #if DB_VERSION_MAJOR == 1
471   db->dberrno = (status == 1) ? -1 : errno;
472 #else
473   db->dberrno = (status < 0) ? -1 : errno;
474 #endif /* DB_VERSION_MAJOR */
475
476   return 1;
477 }
478
479 static void
480 berkdb_map (Lisp_Database *db, Lisp_Object func)
481 {
482   DBT keydatum, valdatum;
483   Lisp_Object key, val;
484   DB *dbp = db->db_handle;
485   int status;
486
487   xzero (keydatum);
488   xzero (valdatum);
489
490 #if DB_VERSION_MAJOR == 1
491   for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
492        status == 0;
493        status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
494     {
495       /* ### Needs mule-izing */
496       key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
497       val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
498       call2 (func, key, val);
499     }
500 #else
501   DBC *dbcp;
502
503   status = dbp->cursor (dbp, NULL, &dbcp);
504   for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
505        status == 0;
506        status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
507     {
508       /* ### Needs mule-izing */
509       key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
510       val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
511       call2 (func, key, val);
512     }
513   dbcp->c_close (dbcp);
514 #endif /* DB_VERSION_MAJOR */
515 }
516
517 static void
518 berkdb_close (Lisp_Database *db)
519 {
520   if (db->db_handle)
521     {
522 #if DB_VERSION_MAJOR == 1
523       db->db_handle->sync  (db->db_handle, 0);
524       db->db_handle->close (db->db_handle);
525 #else
526       db->db_handle->sync  (db->db_handle, 0);
527       db->db_handle->close (db->db_handle, 0);
528 #endif /* DB_VERSION_MAJOR */
529       db->db_handle = NULL;
530     }
531 }
532
533 static DB_FUNCS berk_func_block =
534 {
535   berkdb_subtype,
536   berkdb_type,
537   berkdb_get,
538   berkdb_put,
539   berkdb_remove,
540   berkdb_map,
541   berkdb_close,
542   berkdb_lasterr
543 };
544 #endif /* HAVE_BERKELEY_DB */
545
546 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
547 Return the last error associated with DATABASE.
548 */
549        (database))
550 {
551   if (NILP (database))
552     return lisp_strerror (errno);
553
554   CHECK_DATABASE (database);
555
556   return XDATABASE (database)->funcs->last_error (XDATABASE (database));
557 }
558
559 DEFUN ("open-database", Fopen_database, 1, 5, 0, /*
560 Return a new database object opened on FILE.
561 Optional arguments TYPE and SUBTYPE specify the database type.
562 Optional argument ACCESS specifies the access rights, which may be any
563 combination of 'r' 'w' and '+', for read, write, and creation flags.
564 Optional argument MODE gives the permissions to use when opening FILE,
565 and defaults to 0755.
566 */
567        (file, type, subtype, access_, mode))
568 {
569   /* This function can GC */
570   int modemask;
571   int accessmask = 0;
572   Lisp_Database *db = NULL;
573   char *filename;
574   struct gcpro gcpro1, gcpro2;
575
576   CHECK_STRING (file);
577   GCPRO2 (file, access_);
578   file = Fexpand_file_name (file, Qnil);
579   UNGCPRO;
580
581   GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename);
582
583   if (NILP (access_))
584     {
585       accessmask = O_RDWR | O_CREAT;
586     }
587   else
588     {
589       char *acc;
590       CHECK_STRING (access_);
591       acc = (char *) XSTRING_DATA (access_);
592
593       if (strchr (acc, '+'))
594         accessmask |= O_CREAT;
595
596       {
597         char *rp = strchr (acc, 'r');
598         char *wp = strchr (acc, 'w');
599         if (rp && wp) accessmask |= O_RDWR;
600         else if (wp)  accessmask |= O_WRONLY;
601         else          accessmask |= O_RDONLY;
602       }
603     }
604
605   if (NILP (mode))
606     {
607       modemask = 0755;          /* rwxr-xr-x */
608     }
609   else
610     {
611       CHECK_INT (mode);
612       modemask = XINT (mode);
613     }
614
615 #ifdef HAVE_DBM
616   if (NILP (type) || EQ (type, Qdbm))
617     {
618       DBM *dbase = dbm_open (filename, accessmask, modemask);
619       if (!dbase)
620         return Qnil;
621
622       db = allocate_database ();
623       db->dbm_handle = dbase;
624       db->funcs = &ndbm_func_block;
625       goto db_done;
626     }
627 #endif /* HAVE_DBM */
628
629 #ifdef HAVE_BERKELEY_DB
630   if (NILP (type) || EQ (type, Qberkeley_db))
631     {
632       DBTYPE real_subtype;
633       DB *dbase;
634 #if DB_VERSION_MAJOR != 1
635       int status;
636 #endif
637
638       if (EQ (subtype, Qhash) || NILP (subtype))
639         real_subtype = DB_HASH;
640       else if (EQ (subtype, Qbtree))
641         real_subtype = DB_BTREE;
642       else if (EQ (subtype, Qrecno))
643         real_subtype = DB_RECNO;
644       else
645         signal_simple_error ("Unsupported subtype", subtype);
646
647 #if DB_VERSION_MAJOR == 1
648       dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
649       if (!dbase)
650         return Qnil;
651 #else
652       /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
653          other flags shouldn't be set */
654       if (NILP (access_))
655         accessmask = DB_CREATE;
656       else
657         {
658           char *acc;
659           CHECK_STRING (access_);
660           acc = (char *) XSTRING_DATA (access_);
661           accessmask = 0;
662
663           if (strchr (acc, '+'))
664             accessmask |= DB_CREATE;
665
666           if (strchr (acc, 'r') && !strchr (acc, 'w'))
667             accessmask |= DB_RDONLY;
668         }
669       status = db_open (filename, real_subtype, accessmask,
670                         modemask, NULL , NULL, &dbase);
671       if (status)
672         return Qnil;
673 #endif /* DB_VERSION_MAJOR */
674
675       db = allocate_database ();
676       db->db_handle = dbase;
677       db->funcs = &berk_func_block;
678       goto db_done;
679     }
680 #endif /* HAVE_BERKELEY_DB */
681
682   signal_simple_error ("Unsupported database type", type);
683   return Qnil;
684
685  db_done:
686   db->live_p = 1;
687   db->fname = file;
688   db->mode = modemask;
689   db->access_ = accessmask;
690
691   {
692     Lisp_Object retval;
693     XSETDATABASE (retval, db);
694     return retval;
695   }
696 }
697
698 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
699 Store KEY and VALUE in DATABASE.
700 If optional fourth arg REPLACE is non-nil,
701 replace any existing entry in the database.
702 */
703        (key, value, database, replace))
704 {
705   CHECK_LIVE_DATABASE (database);
706   CHECK_STRING (key);
707   CHECK_STRING (value);
708   {
709     Lisp_Database *db = XDATABASE (database);
710     int status = db->funcs->put (db, key, value, replace);
711     return status ? Qt : Qnil;
712   }
713 }
714
715 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
716 Remove KEY from DATABASE.
717 */
718        (key, database))
719 {
720   CHECK_LIVE_DATABASE (database);
721   CHECK_STRING (key);
722   {
723     Lisp_Database *db = XDATABASE (database);
724     int status = db->funcs->rem (db, key);
725     return status ? Qt : Qnil;
726   }
727 }
728
729 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
730 Return value for KEY in DATABASE.
731 If there is no corresponding value, return DEFAULT (defaults to nil).
732 */
733        (key, database, default_))
734 {
735   CHECK_LIVE_DATABASE (database);
736   CHECK_STRING (key);
737   {
738     Lisp_Database *db = XDATABASE (database);
739     Lisp_Object retval = db->funcs->get (db, key);
740     return NILP (retval) ? default_ : retval;
741   }
742 }
743
744 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
745 Map FUNCTION over entries in DATABASE, calling it with two args,
746 each key and value in the database.
747 */
748        (function, database))
749 {
750   CHECK_LIVE_DATABASE (database);
751
752   XDATABASE (database)->funcs->map (XDATABASE (database), function);
753
754   return Qnil;
755 }
756
757 void
758 syms_of_database (void)
759 {
760   defsymbol (&Qdatabasep, "databasep");
761 #ifdef HAVE_DBM
762   defsymbol (&Qdbm, "dbm");
763 #endif
764 #ifdef HAVE_BERKELEY_DB
765   defsymbol (&Qberkeley_db, "berkeley-db");
766   defsymbol (&Qhash, "hash");
767   defsymbol (&Qbtree, "btree");
768   defsymbol (&Qrecno, "recno");
769   defsymbol (&Qunknown, "unknown");
770 #endif
771
772   DEFSUBR (Fopen_database);
773   DEFSUBR (Fdatabasep);
774   DEFSUBR (Fmapdatabase);
775   DEFSUBR (Fput_database);
776   DEFSUBR (Fget_database);
777   DEFSUBR (Fremove_database);
778   DEFSUBR (Fdatabase_type);
779   DEFSUBR (Fdatabase_subtype);
780   DEFSUBR (Fdatabase_last_error);
781   DEFSUBR (Fdatabase_live_p);
782   DEFSUBR (Fdatabase_file_name);
783   DEFSUBR (Fclose_database);
784 }
785
786 void
787 vars_of_database (void)
788 {
789 #ifdef HAVE_DBM
790   Fprovide (Qdbm);
791 #endif
792 #ifdef HAVE_BERKELEY_DB
793   Fprovide (Qberkeley_db);
794 #endif
795
796 #if 0 /* #### implement me! */
797 #ifdef MULE
798   DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /*
799 Coding system used to convert data in database files.
800 */ );
801   Vdatabase_coding_system = Qnil;
802 #endif
803 #endif /* 0 */
804 }