Mercurial > hg > xemacs-beta
comparison src/database.c @ 380:8626e4521993 r21-2-5
Import from CVS: tag r21-2-5
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:07:10 +0200 |
parents | cc15677e0335 |
children | 064ab7fed2e0 |
comparison
equal
deleted
inserted
replaced
379:76b7d63099ad | 380:8626e4521993 |
---|---|
25 /* db 2.x support added by Andreas Jaeger */ | 25 /* db 2.x support added by Andreas Jaeger */ |
26 | 26 |
27 #include <config.h> | 27 #include <config.h> |
28 #include "lisp.h" | 28 #include "lisp.h" |
29 #include "sysfile.h" | 29 #include "sysfile.h" |
30 #include "buffer.h" | |
30 #include <errno.h> | 31 #include <errno.h> |
31 | 32 |
32 #ifndef HAVE_DATABASE | 33 #ifndef HAVE_DATABASE |
33 #error HAVE_DATABASE not defined!! | 34 #error HAVE_DATABASE not defined!! |
34 #endif | 35 #endif |
63 #ifdef HAVE_DBM | 64 #ifdef HAVE_DBM |
64 #include <ndbm.h> | 65 #include <ndbm.h> |
65 Lisp_Object Qdbm; | 66 Lisp_Object Qdbm; |
66 #endif /* HAVE_DBM */ | 67 #endif /* HAVE_DBM */ |
67 | 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 | |
68 Lisp_Object Qdatabasep; | 76 Lisp_Object Qdatabasep; |
69 | 77 |
70 typedef enum { DB_DBM, DB_BERKELEY, DB_IS_UNKNOWN } XEMACS_DB_TYPE; | |
71 | |
72 struct Lisp_Database; | 78 struct Lisp_Database; |
79 typedef struct Lisp_Database Lisp_Database; | |
73 | 80 |
74 typedef struct | 81 typedef struct |
75 { | 82 { |
76 Lisp_Object (*get_subtype) (struct Lisp_Database *); | 83 Lisp_Object (*get_subtype) (Lisp_Database *); |
77 Lisp_Object (*get_type) (struct Lisp_Database *); | 84 Lisp_Object (*get_type) (Lisp_Database *); |
78 Lisp_Object (*get) (struct Lisp_Database *, Lisp_Object); | 85 Lisp_Object (*get) (Lisp_Database *, Lisp_Object); |
79 int (*put) (struct Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object); | 86 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object); |
80 int (*rem) (struct Lisp_Database *, Lisp_Object); | 87 int (*rem) (Lisp_Database *, Lisp_Object); |
81 void (*map) (struct Lisp_Database *, Lisp_Object); | 88 void (*map) (Lisp_Database *, Lisp_Object); |
82 void (*close) (struct Lisp_Database *); | 89 void (*close) (Lisp_Database *); |
83 Lisp_Object (*last_error) (struct Lisp_Database *); | 90 Lisp_Object (*last_error) (Lisp_Database *); |
84 } DB_FUNCS; | 91 } DB_FUNCS; |
85 | 92 |
86 struct Lisp_Database | 93 struct Lisp_Database |
87 { | 94 { |
88 struct lcrecord_header header; | 95 struct lcrecord_header header; |
89 Lisp_Object fname; | 96 Lisp_Object fname; |
90 XEMACS_DB_TYPE type; | |
91 int mode; | 97 int mode; |
92 int access_; | 98 int access_; |
93 int dberrno; | 99 int dberrno; |
94 int live_p; | 100 int live_p; |
95 #ifdef HAVE_DBM | 101 #ifdef HAVE_DBM |
102 #ifdef MULE | 108 #ifdef MULE |
103 Lisp_Object coding_system; | 109 Lisp_Object coding_system; |
104 #endif | 110 #endif |
105 }; | 111 }; |
106 | 112 |
107 #define XDATABASE(x) XRECORD (x, database, struct Lisp_Database) | 113 #define XDATABASE(x) XRECORD (x, database, Lisp_Database) |
108 #define XSETDATABASE(x, p) XSETRECORD (x, p, database) | 114 #define XSETDATABASE(x, p) XSETRECORD (x, p, database) |
109 #define DATABASEP(x) RECORDP (x, database) | 115 #define DATABASEP(x) RECORDP (x, database) |
110 #define GC_DATABASEP(x) GC_RECORDP (x, database) | 116 #define GC_DATABASEP(x) GC_RECORDP (x, database) |
111 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) | 117 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) |
112 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) | 118 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) |
117 if (!DATABASE_LIVE_P (XDATABASE(db))) \ | 123 if (!DATABASE_LIVE_P (XDATABASE(db))) \ |
118 signal_simple_error ("Attempting to access closed database", db); \ | 124 signal_simple_error ("Attempting to access closed database", db); \ |
119 } while (0) | 125 } while (0) |
120 | 126 |
121 | 127 |
122 static struct Lisp_Database * | 128 static Lisp_Database * |
123 allocate_database (void) | 129 allocate_database (void) |
124 { | 130 { |
125 struct Lisp_Database *db = | 131 Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, lrecord_database); |
126 alloc_lcrecord_type (struct Lisp_Database, lrecord_database); | |
127 | 132 |
128 db->fname = Qnil; | 133 db->fname = Qnil; |
129 db->live_p = 0; | 134 db->live_p = 0; |
130 #ifdef HAVE_BERKELEY_DB | 135 #ifdef HAVE_BERKELEY_DB |
131 db->db_handle = NULL; | 136 db->db_handle = NULL; |
134 db->dbm_handle = NULL; | 139 db->dbm_handle = NULL; |
135 #endif | 140 #endif |
136 db->access_ = 0; | 141 db->access_ = 0; |
137 db->mode = 0; | 142 db->mode = 0; |
138 db->dberrno = 0; | 143 db->dberrno = 0; |
139 db->type = DB_IS_UNKNOWN; | |
140 #ifdef MULE | 144 #ifdef MULE |
141 db->coding_system = Fget_coding_system (Qbinary); | 145 db->coding_system = Fget_coding_system (Qbinary); |
142 #endif | 146 #endif |
143 return db; | 147 return db; |
144 } | 148 } |
145 | 149 |
146 static Lisp_Object | 150 static Lisp_Object |
147 mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object)) | 151 mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
148 { | 152 { |
149 struct Lisp_Database *db = XDATABASE (obj); | 153 Lisp_Database *db = XDATABASE (obj); |
150 | 154 |
151 ((markobj) (db->fname)); | 155 markobj (db->fname); |
152 return Qnil; | 156 return Qnil; |
153 } | 157 } |
154 | 158 |
155 static void | 159 static void |
156 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 160 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
157 { | 161 { |
158 char buf[64]; | 162 char buf[64]; |
159 struct Lisp_Database *db = XDATABASE (obj); | 163 Lisp_Database *db = XDATABASE (obj); |
160 | 164 |
161 if (print_readably) | 165 if (print_readably) |
162 error ("printing unreadable object #<database 0x%x>", db->header.uid); | 166 error ("printing unreadable object #<database 0x%x>", db->header.uid); |
163 | 167 |
164 write_c_string ("#<database \"", printcharfun); | 168 write_c_string ("#<database \"", printcharfun); |
174 } | 178 } |
175 | 179 |
176 static void | 180 static void |
177 finalize_database (void *header, int for_disksave) | 181 finalize_database (void *header, int for_disksave) |
178 { | 182 { |
179 struct Lisp_Database *db = (struct Lisp_Database *) header; | 183 Lisp_Database *db = (Lisp_Database *) header; |
180 | 184 |
181 if (for_disksave) | 185 if (for_disksave) |
182 { | 186 { |
183 Lisp_Object obj; | 187 Lisp_Object obj; |
184 XSETOBJ (obj, Lisp_Type_Record, (void *) db); | 188 XSETDATABASE (obj, db); |
185 | 189 |
186 signal_simple_error | 190 signal_simple_error |
187 ("Can't dump an emacs containing database objects", obj); | 191 ("Can't dump an emacs containing database objects", obj); |
188 } | 192 } |
189 db->funcs->close (db); | 193 db->funcs->close (db); |
190 } | 194 } |
191 | 195 |
192 DEFINE_LRECORD_IMPLEMENTATION ("database", database, | 196 DEFINE_LRECORD_IMPLEMENTATION ("database", database, |
193 mark_database, print_database, | 197 mark_database, print_database, |
194 finalize_database, 0, 0, | 198 finalize_database, 0, 0, |
195 struct Lisp_Database); | 199 Lisp_Database); |
196 | 200 |
197 DEFUN ("close-database", Fclose_database, 1, 1, 0, /* | 201 DEFUN ("close-database", Fclose_database, 1, 1, 0, /* |
198 Close database DATABASE. | 202 Close database DATABASE. |
199 */ | 203 */ |
200 (database)) | 204 (database)) |
201 { | 205 { |
202 struct Lisp_Database *db; | 206 Lisp_Database *db; |
203 CHECK_LIVE_DATABASE (database); | 207 CHECK_LIVE_DATABASE (database); |
204 db = XDATABASE (database); | 208 db = XDATABASE (database); |
205 db->funcs->close (db); | 209 db->funcs->close (db); |
206 db->live_p = 0; | 210 db->live_p = 0; |
207 return Qnil; | 211 return Qnil; |
253 return DATABASEP (obj) ? Qt : Qnil; | 257 return DATABASEP (obj) ? Qt : Qnil; |
254 } | 258 } |
255 | 259 |
256 #ifdef HAVE_DBM | 260 #ifdef HAVE_DBM |
257 static void | 261 static void |
258 dbm_map (struct Lisp_Database *db, Lisp_Object func) | 262 dbm_map (Lisp_Database *db, Lisp_Object func) |
259 { | 263 { |
260 datum keydatum, valdatum; | 264 datum keydatum, valdatum; |
261 Lisp_Object key, val; | 265 Lisp_Object key, val; |
262 | 266 |
263 for (keydatum = dbm_firstkey (db->dbm_handle); | 267 for (keydatum = dbm_firstkey (db->dbm_handle); |
270 call2 (func, key, val); | 274 call2 (func, key, val); |
271 } | 275 } |
272 } | 276 } |
273 | 277 |
274 static Lisp_Object | 278 static Lisp_Object |
275 dbm_get (struct Lisp_Database *db, Lisp_Object key) | 279 dbm_get (Lisp_Database *db, Lisp_Object key) |
276 { | 280 { |
277 datum keydatum, valdatum; | 281 datum keydatum, valdatum; |
278 | 282 |
279 keydatum.dptr = (char *) XSTRING_DATA (key); | 283 keydatum.dptr = (char *) XSTRING_DATA (key); |
280 keydatum.dsize = XSTRING_LENGTH (key); | 284 keydatum.dsize = XSTRING_LENGTH (key); |
284 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) | 288 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) |
285 : Qnil); | 289 : Qnil); |
286 } | 290 } |
287 | 291 |
288 static int | 292 static int |
289 dbm_put (struct Lisp_Database *db, | 293 dbm_put (Lisp_Database *db, |
290 Lisp_Object key, Lisp_Object val, Lisp_Object replace) | 294 Lisp_Object key, Lisp_Object val, Lisp_Object replace) |
291 { | 295 { |
292 datum keydatum, valdatum; | 296 datum keydatum, valdatum; |
293 | 297 |
294 valdatum.dptr = (char *) XSTRING_DATA (val); | 298 valdatum.dptr = (char *) XSTRING_DATA (val); |
299 return !dbm_store (db->dbm_handle, keydatum, valdatum, | 303 return !dbm_store (db->dbm_handle, keydatum, valdatum, |
300 NILP (replace) ? DBM_INSERT : DBM_REPLACE); | 304 NILP (replace) ? DBM_INSERT : DBM_REPLACE); |
301 } | 305 } |
302 | 306 |
303 static int | 307 static int |
304 dbm_remove (struct Lisp_Database *db, Lisp_Object key) | 308 dbm_remove (Lisp_Database *db, Lisp_Object key) |
305 { | 309 { |
306 datum keydatum; | 310 datum keydatum; |
307 | 311 |
308 keydatum.dptr = (char *) XSTRING_DATA (key); | 312 keydatum.dptr = (char *) XSTRING_DATA (key); |
309 keydatum.dsize = XSTRING_LENGTH (key); | 313 keydatum.dsize = XSTRING_LENGTH (key); |
310 | 314 |
311 return dbm_delete (db->dbm_handle, keydatum); | 315 return dbm_delete (db->dbm_handle, keydatum); |
312 } | 316 } |
313 | 317 |
314 static Lisp_Object | 318 static Lisp_Object |
315 dbm_type (struct Lisp_Database *db) | 319 dbm_type (Lisp_Database *db) |
316 { | 320 { |
317 return Qdbm; | 321 return Qdbm; |
318 } | 322 } |
319 | 323 |
320 static Lisp_Object | 324 static Lisp_Object |
321 dbm_subtype (struct Lisp_Database *db) | 325 dbm_subtype (Lisp_Database *db) |
322 { | 326 { |
323 return Qnil; | 327 return Qnil; |
324 } | 328 } |
325 | 329 |
326 static Lisp_Object | 330 static Lisp_Object |
327 dbm_lasterr (struct Lisp_Database *db) | 331 dbm_lasterr (Lisp_Database *db) |
328 { | 332 { |
329 return lisp_strerror (db->dberrno); | 333 return lisp_strerror (db->dberrno); |
330 } | 334 } |
331 | 335 |
332 static void | 336 static void |
333 dbm_closeit (struct Lisp_Database *db) | 337 dbm_closeit (Lisp_Database *db) |
334 { | 338 { |
335 if (db->dbm_handle) | 339 if (db->dbm_handle) |
336 { | 340 { |
337 dbm_close (db->dbm_handle); | 341 dbm_close (db->dbm_handle); |
338 db->dbm_handle = NULL; | 342 db->dbm_handle = NULL; |
352 }; | 356 }; |
353 #endif /* HAVE_DBM */ | 357 #endif /* HAVE_DBM */ |
354 | 358 |
355 #ifdef HAVE_BERKELEY_DB | 359 #ifdef HAVE_BERKELEY_DB |
356 static Lisp_Object | 360 static Lisp_Object |
357 berkdb_type (struct Lisp_Database *db) | 361 berkdb_type (Lisp_Database *db) |
358 { | 362 { |
359 return Qberkeley_db; | 363 return Qberkeley_db; |
360 } | 364 } |
361 | 365 |
362 static Lisp_Object | 366 static Lisp_Object |
363 berkdb_subtype (struct Lisp_Database *db) | 367 berkdb_subtype (Lisp_Database *db) |
364 { | 368 { |
365 if (!db->db_handle) | 369 if (!db->db_handle) |
366 return Qnil; | 370 return Qnil; |
367 | 371 |
368 switch (db->db_handle->type) | 372 switch (db->db_handle->type) |
373 default: return Qunknown; | 377 default: return Qunknown; |
374 } | 378 } |
375 } | 379 } |
376 | 380 |
377 static Lisp_Object | 381 static Lisp_Object |
378 berkdb_lasterr (struct Lisp_Database *db) | 382 berkdb_lasterr (Lisp_Database *db) |
379 { | 383 { |
380 return lisp_strerror (db->dberrno); | 384 return lisp_strerror (db->dberrno); |
381 } | 385 } |
382 | 386 |
383 static Lisp_Object | 387 static Lisp_Object |
384 berkdb_get (struct Lisp_Database *db, Lisp_Object key) | 388 berkdb_get (Lisp_Database *db, Lisp_Object key) |
385 { | 389 { |
386 /* #### Needs mule-izing */ | |
387 DBT keydatum, valdatum; | 390 DBT keydatum, valdatum; |
388 int status = 0; | 391 int status = 0; |
389 | 392 |
390 #if DB_VERSION_MAJOR == 2 | 393 /* DB Version 2 requires DBT's to be zeroed before use. */ |
391 /* Always initialize keydatum, valdatum. */ | |
392 xzero (keydatum); | 394 xzero (keydatum); |
393 xzero (valdatum); | 395 xzero (valdatum); |
394 #endif /* DV_VERSION_MAJOR = 2 */ | |
395 | 396 |
396 keydatum.data = XSTRING_DATA (key); | 397 keydatum.data = XSTRING_DATA (key); |
397 keydatum.size = XSTRING_LENGTH (key); | 398 keydatum.size = XSTRING_LENGTH (key); |
398 | 399 |
399 #if DB_VERSION_MAJOR == 1 | 400 #if DB_VERSION_MAJOR == 1 |
401 #else | 402 #else |
402 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); | 403 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); |
403 #endif /* DB_VERSION_MAJOR */ | 404 #endif /* DB_VERSION_MAJOR */ |
404 | 405 |
405 if (!status) | 406 if (!status) |
407 /* #### Not mule-ized! will crash! */ | |
406 return make_string ((Bufbyte *) valdatum.data, valdatum.size); | 408 return make_string ((Bufbyte *) valdatum.data, valdatum.size); |
407 | 409 |
408 #if DB_VERSION_MAJOR == 1 | 410 #if DB_VERSION_MAJOR == 1 |
409 db->dberrno = (status == 1) ? -1 : errno; | 411 db->dberrno = (status == 1) ? -1 : errno; |
410 #else | 412 #else |
413 | 415 |
414 return Qnil; | 416 return Qnil; |
415 } | 417 } |
416 | 418 |
417 static int | 419 static int |
418 berkdb_put (struct Lisp_Database *db, | 420 berkdb_put (Lisp_Database *db, |
419 Lisp_Object key, | 421 Lisp_Object key, |
420 Lisp_Object val, | 422 Lisp_Object val, |
421 Lisp_Object replace) | 423 Lisp_Object replace) |
422 { | 424 { |
423 DBT keydatum, valdatum; | 425 DBT keydatum, valdatum; |
424 int status = 0; | 426 int status = 0; |
425 | 427 |
426 #if DB_VERSION_MAJOR == 2 | 428 /* DB Version 2 requires DBT's to be zeroed before use. */ |
427 /* Always initalize keydatum, valdatum. */ | |
428 xzero (keydatum); | 429 xzero (keydatum); |
429 xzero (valdatum); | 430 xzero (valdatum); |
430 #endif /* DV_VERSION_MAJOR = 2 */ | |
431 | 431 |
432 keydatum.data = XSTRING_DATA (key); | 432 keydatum.data = XSTRING_DATA (key); |
433 keydatum.size = XSTRING_LENGTH (key); | 433 keydatum.size = XSTRING_LENGTH (key); |
434 valdatum.data = XSTRING_DATA (val); | 434 valdatum.data = XSTRING_DATA (val); |
435 valdatum.size = XSTRING_LENGTH (val); | 435 valdatum.size = XSTRING_LENGTH (val); |
445 | 445 |
446 return status; | 446 return status; |
447 } | 447 } |
448 | 448 |
449 static int | 449 static int |
450 berkdb_remove (struct Lisp_Database *db, Lisp_Object key) | 450 berkdb_remove (Lisp_Database *db, Lisp_Object key) |
451 { | 451 { |
452 DBT keydatum; | 452 DBT keydatum; |
453 int status; | 453 int status; |
454 | 454 |
455 #if DB_VERSION_MAJOR == 2 | 455 /* DB Version 2 requires DBT's to be zeroed before use. */ |
456 /* Always initialize keydatum. */ | |
457 xzero (keydatum); | 456 xzero (keydatum); |
458 #endif /* DV_VERSION_MAJOR = 2 */ | |
459 | 457 |
460 keydatum.data = XSTRING_DATA (key); | 458 keydatum.data = XSTRING_DATA (key); |
461 keydatum.size = XSTRING_LENGTH (key); | 459 keydatum.size = XSTRING_LENGTH (key); |
462 | 460 |
463 #if DB_VERSION_MAJOR == 1 | 461 #if DB_VERSION_MAJOR == 1 |
477 | 475 |
478 return 1; | 476 return 1; |
479 } | 477 } |
480 | 478 |
481 static void | 479 static void |
482 berkdb_map (struct Lisp_Database *db, Lisp_Object func) | 480 berkdb_map (Lisp_Database *db, Lisp_Object func) |
483 { | 481 { |
484 DBT keydatum, valdatum; | 482 DBT keydatum, valdatum; |
485 Lisp_Object key, val; | 483 Lisp_Object key, val; |
486 DB *dbp = db->db_handle; | 484 DB *dbp = db->db_handle; |
487 int status; | 485 int status; |
488 | 486 |
487 xzero (keydatum); | |
488 xzero (valdatum); | |
489 | |
489 #if DB_VERSION_MAJOR == 1 | 490 #if DB_VERSION_MAJOR == 1 |
490 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); | 491 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); |
491 status == 0; | 492 status == 0; |
492 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) | 493 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) |
493 { | 494 { |
496 val = make_string ((Bufbyte *) valdatum.data, valdatum.size); | 497 val = make_string ((Bufbyte *) valdatum.data, valdatum.size); |
497 call2 (func, key, val); | 498 call2 (func, key, val); |
498 } | 499 } |
499 #else | 500 #else |
500 DBC *dbcp; | 501 DBC *dbcp; |
501 /* Initialize the key/data pair so the flags aren't set. */ | |
502 xzero (keydatum); | |
503 xzero (valdatum); | |
504 | 502 |
505 status = dbp->cursor (dbp, NULL, &dbcp); | 503 status = dbp->cursor (dbp, NULL, &dbcp); |
506 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); | 504 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); |
507 status == 0; | 505 status == 0; |
508 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) | 506 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) |
515 dbcp->c_close (dbcp); | 513 dbcp->c_close (dbcp); |
516 #endif /* DB_VERSION_MAJOR */ | 514 #endif /* DB_VERSION_MAJOR */ |
517 } | 515 } |
518 | 516 |
519 static void | 517 static void |
520 berkdb_close (struct Lisp_Database *db) | 518 berkdb_close (Lisp_Database *db) |
521 { | 519 { |
522 if (db->db_handle) | 520 if (db->db_handle) |
523 { | 521 { |
524 #if DB_VERSION_MAJOR == 1 | 522 #if DB_VERSION_MAJOR == 1 |
525 db->db_handle->sync (db->db_handle, 0); | 523 db->db_handle->sync (db->db_handle, 0); |
569 (file, type, subtype, access_, mode)) | 567 (file, type, subtype, access_, mode)) |
570 { | 568 { |
571 /* This function can GC */ | 569 /* This function can GC */ |
572 int modemask; | 570 int modemask; |
573 int accessmask = 0; | 571 int accessmask = 0; |
574 struct Lisp_Database *db = NULL; | 572 Lisp_Database *db = NULL; |
575 char *filename; | 573 char *filename; |
576 struct gcpro gcpro1, gcpro2; | 574 struct gcpro gcpro1, gcpro2; |
577 | 575 |
578 CHECK_STRING (file); | 576 CHECK_STRING (file); |
579 GCPRO2 (file, access_); | 577 GCPRO2 (file, access_); |
580 file = Fexpand_file_name (file, Qnil); | 578 file = Fexpand_file_name (file, Qnil); |
581 UNGCPRO; | 579 UNGCPRO; |
582 filename = (char *) XSTRING_DATA (file); | 580 |
581 GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename); | |
583 | 582 |
584 if (NILP (access_)) | 583 if (NILP (access_)) |
585 { | 584 { |
586 accessmask = O_RDWR | O_CREAT; | 585 accessmask = O_RDWR | O_CREAT; |
587 } | 586 } |
620 if (!dbase) | 619 if (!dbase) |
621 return Qnil; | 620 return Qnil; |
622 | 621 |
623 db = allocate_database (); | 622 db = allocate_database (); |
624 db->dbm_handle = dbase; | 623 db->dbm_handle = dbase; |
625 db->type = DB_DBM; | |
626 db->funcs = &ndbm_func_block; | 624 db->funcs = &ndbm_func_block; |
627 goto db_done; | 625 goto db_done; |
628 } | 626 } |
629 #endif /* HAVE_DBM */ | 627 #endif /* HAVE_DBM */ |
630 | 628 |
674 return Qnil; | 672 return Qnil; |
675 #endif /* DB_VERSION_MAJOR */ | 673 #endif /* DB_VERSION_MAJOR */ |
676 | 674 |
677 db = allocate_database (); | 675 db = allocate_database (); |
678 db->db_handle = dbase; | 676 db->db_handle = dbase; |
679 db->type = DB_BERKELEY; | |
680 db->funcs = &berk_func_block; | 677 db->funcs = &berk_func_block; |
681 goto db_done; | 678 goto db_done; |
682 } | 679 } |
683 #endif /* HAVE_BERKELEY_DB */ | 680 #endif /* HAVE_BERKELEY_DB */ |
684 | 681 |
707 { | 704 { |
708 CHECK_LIVE_DATABASE (database); | 705 CHECK_LIVE_DATABASE (database); |
709 CHECK_STRING (key); | 706 CHECK_STRING (key); |
710 CHECK_STRING (value); | 707 CHECK_STRING (value); |
711 { | 708 { |
712 struct Lisp_Database *db = XDATABASE (database); | 709 Lisp_Database *db = XDATABASE (database); |
713 int status = db->funcs->put (db, key, value, replace); | 710 int status = db->funcs->put (db, key, value, replace); |
714 return status ? Qt : Qnil; | 711 return status ? Qt : Qnil; |
715 } | 712 } |
716 } | 713 } |
717 | 714 |
721 (key, database)) | 718 (key, database)) |
722 { | 719 { |
723 CHECK_LIVE_DATABASE (database); | 720 CHECK_LIVE_DATABASE (database); |
724 CHECK_STRING (key); | 721 CHECK_STRING (key); |
725 { | 722 { |
726 struct Lisp_Database *db = XDATABASE (database); | 723 Lisp_Database *db = XDATABASE (database); |
727 int status = db->funcs->rem (db, key); | 724 int status = db->funcs->rem (db, key); |
728 return status ? Qt : Qnil; | 725 return status ? Qt : Qnil; |
729 } | 726 } |
730 } | 727 } |
731 | 728 |
736 (key, database, default_)) | 733 (key, database, default_)) |
737 { | 734 { |
738 CHECK_LIVE_DATABASE (database); | 735 CHECK_LIVE_DATABASE (database); |
739 CHECK_STRING (key); | 736 CHECK_STRING (key); |
740 { | 737 { |
741 struct Lisp_Database *db = XDATABASE (database); | 738 Lisp_Database *db = XDATABASE (database); |
742 Lisp_Object retval = db->funcs->get (db, key); | 739 Lisp_Object retval = db->funcs->get (db, key); |
743 return NILP (retval) ? default_ : retval; | 740 return NILP (retval) ? default_ : retval; |
744 } | 741 } |
745 } | 742 } |
746 | 743 |
793 Fprovide (Qdbm); | 790 Fprovide (Qdbm); |
794 #endif | 791 #endif |
795 #ifdef HAVE_BERKELEY_DB | 792 #ifdef HAVE_BERKELEY_DB |
796 Fprovide (Qberkeley_db); | 793 Fprovide (Qberkeley_db); |
797 #endif | 794 #endif |
798 } | 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 } |