Mercurial > hg > xemacs-beta

comparison src/database.c @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 9ee227acff29
children 56c54cf7c5b6
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
69 struct lcrecord_header header; 69 struct lcrecord_header header;
70 Lisp_Object fname; 70 Lisp_Object fname;
71 XEMACS_DB_TYPE type; 71 XEMACS_DB_TYPE type;
72 int mode; 72 int mode;
73 int ackcess; 73 int ackcess;
74 int errno; 74 int dberrno;
75 void *db_handle; 75 void *db_handle;
76 DB_FUNCS *funcs; 76 DB_FUNCS *funcs;
77 }; 77 };
78 78
79 #define XDATABASE(x) XRECORD (x, database, struct database_struct) 79 #define XDATABASE(x) XRECORD (x, database, struct database_struct)
98 98
99 dbase->fname = Qnil; 99 dbase->fname = Qnil;
100 dbase->db_handle = NULL; 100 dbase->db_handle = NULL;
101 dbase->ackcess = 0; 101 dbase->ackcess = 0;
102 dbase->mode = 0; 102 dbase->mode = 0;
103 dbase->errno = 0; 103 dbase->dberrno = 0;
104 dbase->type = DB_UNKNOWN; 104 dbase->type = DB_UNKNOWN;
105 return (dbase); 105 return (dbase);
106 } 106 }
107 107
108 static Lisp_Object 108 static Lisp_Object
158 ("Can't dump an emacs containing window system objects", obj); 158 ("Can't dump an emacs containing window system objects", obj);
159 } 159 }
160 db->funcs->close (db); 160 db->funcs->close (db);
161 } 161 }
162 162
163 DEFUN ("close-database", Fdatabase_close, Sdatabase_close, 1, 1, 0 /* 163 DEFUN ("close-database", Fdatabase_close, 1, 1, 0, /*
164 Close database OBJ. 164 Close database OBJ.
165 */ ) 165 */
166 (obj) 166 (obj))
167 Lisp_Object obj;
168 { 167 {
169 struct database_struct *db; 168 struct database_struct *db;
170 CHECK_DATABASE (obj); 169 CHECK_DATABASE (obj);
171 db = XDATABASE (obj); 170 db = XDATABASE (obj);
172 171
176 signal_simple_error ("Attempting to access closed database", obj); 175 signal_simple_error ("Attempting to access closed database", obj);
177 176
178 return (Qnil); 177 return (Qnil);
179 } 178 }
180 179
181 DEFUN ("database-type", Fdatabase_type, Sdatabase_type, 1, 1, 0 /* 180 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
182 Return the type of database OBJ. 181 Return the type of database OBJ.
183 */) 182 */
184 (obj) 183 (obj))
185 Lisp_Object obj;
186 { 184 {
187 struct database_struct *db; 185 struct database_struct *db;
188 CHECK_DATABASE (obj); 186 CHECK_DATABASE (obj);
189 db = XDATABASE (obj); 187 db = XDATABASE (obj);
190 188
191 return db->funcs->get_lisp_type (db); 189 return db->funcs->get_lisp_type (db);
192 } 190 }
193 191
194 DEFUN ("database-subtype", Fdatabase_subtype, Sdatabase_subtype, 1, 1, 0 /* 192 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
195 Return the subtype of database OBJ, if any. 193 Return the subtype of database OBJ, if any.
196 */ ) 194 */
197 (obj) 195 (obj))
198 Lisp_Object obj;
199 { 196 {
200 struct database_struct *db; 197 struct database_struct *db;
201 198
202 CHECK_DATABASE (obj); 199 CHECK_DATABASE (obj);
203 db = XDATABASE (obj); 200 db = XDATABASE (obj);
204 201
205 return (intern (db->funcs->get_subtype (db))); 202 return (intern (db->funcs->get_subtype (db)));
206 } 203 }
207 204
208 DEFUN ("database-live-p", Fdatabase_live_p, Sdatabase_live_p, 1, 1, 0 /* 205 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
209 Return t iff OBJ is an active database, else nil. 206 Return t iff OBJ is an active database, else nil.
210 */ ) 207 */
211 (obj) 208 (obj))
212 Lisp_Object (obj);
213 { 209 {
214 struct database_struct *db; 210 struct database_struct *db;
215 CHECK_DATABASE (obj); 211 CHECK_DATABASE (obj);
216 db = XDATABASE (obj); 212 db = XDATABASE (obj);
217 213
218 return (DATABASE_LIVE_P (db) ? Qt : Qnil); 214 return (DATABASE_LIVE_P (db) ? Qt : Qnil);
219 } 215 }
220 216
221 DEFUN ("database-file-name", Fdatabase_file_name, Sdatabase_file_name, 217 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
222 1, 1, 0 /*
223 Return the filename associated with the database OBJ. 218 Return the filename associated with the database OBJ.
224 */) 219 */
225 (obj) 220 (obj))
226 Lisp_Object obj;
227 { 221 {
228 struct database_struct *db; 222 struct database_struct *db;
229 CHECK_DATABASE (obj); 223 CHECK_DATABASE (obj);
230 db = XDATABASE (obj); 224 db = XDATABASE (obj);
231 return (db->fname); 225 return (db->fname);
232 } 226 }
233 227
234 DEFUN ("databasep", Fdatabasep, Sdatabasep, 1, 1, 0 /* 228 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
235 Return t iff OBJ is a database, else nil. 229 Return t iff OBJ is a database, else nil.
236 */ ) 230 */
237 (obj) 231 (obj))
238 Lisp_Object obj;
239 { 232 {
240 return ((DATABASEP (obj)) ? Qt : Qnil); 233 return ((DATABASEP (obj)) ? Qt : Qnil);
241 } 234 }
242 235
243 #ifdef HAVE_DBM 236 #ifdef HAVE_DBM
327 } 320 }
328 321
329 static Lisp_Object 322 static Lisp_Object
330 dbm_lasterr (struct database_struct *dbp) 323 dbm_lasterr (struct database_struct *dbp)
331 { 324 {
332 char *temp = strerror (dbp->errno); 325 char *temp = strerror (dbp->dberrno);
333 return (make_string ((unsigned char *) temp, strlen (temp))); 326 return (make_string ((unsigned char *) temp, strlen (temp)));
334 } 327 }
335 328
336 static void 329 static void
337 dbm_closeit (struct database_struct *db) 330 dbm_closeit (struct database_struct *db)
410 } 403 }
411 404
412 static Lisp_Object 405 static Lisp_Object
413 berkdb_lasterr (struct database_struct *dbp) 406 berkdb_lasterr (struct database_struct *dbp)
414 { 407 {
415 char *temp = strerror (dbp->errno); 408 char *temp = strerror (dbp->dberrno);
416 return (make_string ((unsigned char *) temp, strlen (temp))); 409 return (make_string ((unsigned char *) temp, strlen (temp)));
417 } 410 }
418 411
419 static Lisp_Object 412 static Lisp_Object
420 berkdb_get (struct database_struct *db, Lisp_Object key) 413 berkdb_get (struct database_struct *db, Lisp_Object key)
429 status = dbp->get (dbp, &keydatum, &valdatum, 0); 422 status = dbp->get (dbp, &keydatum, &valdatum, 0);
430 423
431 if (!status) 424 if (!status)
432 return (make_string (valdatum.data, valdatum.size)); 425 return (make_string (valdatum.data, valdatum.size));
433 426
434 db->errno = (status == 1) ? -1 : errno; 427 db->dberrno = (status == 1) ? -1 : errno;
435 return (Qnil); 428 return (Qnil);
436 } 429 }
437 430
438 static int 431 static int
439 berkdb_put (struct database_struct *db, 432 berkdb_put (struct database_struct *db,
449 keydatum.size = XSTRING_LENGTH (key); 442 keydatum.size = XSTRING_LENGTH (key);
450 valdatum.data = XSTRING_DATA (val); 443 valdatum.data = XSTRING_DATA (val);
451 valdatum.size = XSTRING_LENGTH (val); 444 valdatum.size = XSTRING_LENGTH (val);
452 status = dbp->put (dbp, &keydatum, &valdatum, NILP (replace) 445 status = dbp->put (dbp, &keydatum, &valdatum, NILP (replace)
453 ? R_NOOVERWRITE : 0); 446 ? R_NOOVERWRITE : 0);
454 db->errno = (status == 1) ? -1 : errno; 447 db->dberrno = (status == 1) ? -1 : errno;
455 return status; 448 return status;
456 } 449 }
457 450
458 static int 451 static int
459 berkdb_remove (struct database_struct *db, Lisp_Object key) 452 berkdb_remove (struct database_struct *db, Lisp_Object key)
467 460
468 status = dbp->del (dbp, &keydatum, 0); 461 status = dbp->del (dbp, &keydatum, 0);
469 if (!status) 462 if (!status)
470 return 0; 463 return 0;
471 464
472 db->errno = (status == 1) ? -1 : errno; 465 db->dberrno = (status == 1) ? -1 : errno;
473 return 1; 466 return 1;
474 } 467 }
475 468
476 static void 469 static void
477 berkdb_map (struct database_struct *db, Lisp_Object func) 470 berkdb_map (struct database_struct *db, Lisp_Object func)
516 berkdb_close, 509 berkdb_close,
517 berkdb_lasterr 510 berkdb_lasterr
518 }; 511 };
519 #endif 512 #endif
520 513
521 DEFUN ("database-last-error", Fdatabase_error, Sdatabase_error, 0, 1, 0 /* 514 DEFUN ("database-last-error", Fdatabase_error, 0, 1, 0, /*
522 Return the last error associated with database OBJ. 515 Return the last error associated with database OBJ.
523 */ ) 516 */
524 (obj) 517 (obj))
525 Lisp_Object obj;
526 { 518 {
527 struct database_struct *db; 519 struct database_struct *db;
528 520
529 if (NILP (obj)) 521 if (NILP (obj))
530 { 522 {
535 CHECK_DATABASE (obj); 527 CHECK_DATABASE (obj);
536 db = XDATABASE (obj); 528 db = XDATABASE (obj);
537 return (db->funcs->last_error (db)); 529 return (db->funcs->last_error (db));
538 } 530 }
539 531
540 DEFUN ("open-database", Fmake_database, Smake_database, 1, 5, 0 /* 532 DEFUN ("open-database", Fmake_database, 1, 5, 0, /*
541 Open database FILE, using database method TYPE and SUBTYPE, with 533 Open database FILE, using database method TYPE and SUBTYPE, with
542 access rights ACCESS and permissions MODE. ACCESS can be any 534 access rights ACCESS and permissions MODE. ACCESS can be any
543 combination of 'r' 'w' and '+', for read, write, and creation flags. 535 combination of 'r' 'w' and '+', for read, write, and creation flags.
544 */ ) 536 */
545 (file, type, subtype, ackcess, mode) 537 (file, type, subtype, ackcess, mode))
546 Lisp_Object file, type, subtype, ackcess, mode;
547 { 538 {
548 Lisp_Object retval = Qnil; 539 Lisp_Object retval = Qnil;
549 int modemask; 540 int modemask;
550 int accessmask = 0; 541 int accessmask = 0;
551 XEMACS_DB_TYPE the_type; 542 XEMACS_DB_TYPE the_type;
633 XSETDATABASE (retval, dbase); 624 XSETDATABASE (retval, dbase);
634 625
635 return (retval); 626 return (retval);
636 } 627 }
637 628
638 DEFUN ("put-database", Fputdatabase, Sputdatabase, 3, 4, 0 /* 629 DEFUN ("put-database", Fputdatabase, 3, 4, 0, /*
639 Store KEY and VAL in DATABASE. If optinal fourth arg REPLACE is 630 Store KEY and VAL in DATABASE. If optinal fourth arg REPLACE is
640 non-nil, replace any existing entry in the database. 631 non-nil, replace any existing entry in the database.
641 */ ) 632 */
642 (key, val, dbase, replace) 633 (key, val, dbase, replace))
643 Lisp_Object key, val, dbase, replace;
644 { 634 {
645 struct database_struct *db; 635 struct database_struct *db;
646 int status; 636 int status;
647 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 637 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
648 638
656 status = db->funcs->put (db, key, val, replace); 646 status = db->funcs->put (db, key, val, replace);
657 UNGCPRO; 647 UNGCPRO;
658 return status ? Qt : Qnil; 648 return status ? Qt : Qnil;
659 } 649 }
660 650
661 DEFUN ("remove-database", Fremdatabase, Sremdatabase, 2, 2, 0 /* 651 DEFUN ("remove-database", Fremdatabase, 2, 2, 0, /*
662 Remove KEY from DATABASE. 652 Remove KEY from DATABASE.
663 */ ) 653 */
664 (key, dbase) 654 (key, dbase))
665 Lisp_Object key, dbase;
666 { 655 {
667 struct database_struct *db; 656 struct database_struct *db;
668 CHECK_DATABASE (dbase); 657 CHECK_DATABASE (dbase);
669 CHECK_STRING (key); 658 CHECK_STRING (key);
670 659
672 if (!DATABASE_LIVE_P (db)) 661 if (!DATABASE_LIVE_P (db))
673 signal_simple_error ("Attempting to access closed database", dbase); 662 signal_simple_error ("Attempting to access closed database", dbase);
674 return db->funcs->rem (db, key) ? Qt : Qnil; 663 return db->funcs->rem (db, key) ? Qt : Qnil;
675 } 664 }
676 665
677 DEFUN ("get-database", Fgetdatabase, Sgetdatabase, 2, 3, 0 /* 666 DEFUN ("get-database", Fgetdatabase, 2, 3, 0, /*
678 Find value for KEY in DATABASE. 667 Find value for KEY in DATABASE.
679 If there is no corresponding value, return DEFAULT (defaults to nil). 668 If there is no corresponding value, return DEFAULT (defaults to nil).
680 */ ) 669 */
681 (key, dbase, defalt) 670 (key, dbase, defalt))
682 Lisp_Object key, dbase, defalt; /* One can't even spell correctly in C */
683 { 671 {
684 Lisp_Object retval; 672 Lisp_Object retval;
685 struct database_struct *db; 673 struct database_struct *db;
686 674
687 CHECK_DATABASE (dbase); 675 CHECK_DATABASE (dbase);
693 retval = db->funcs->get (db, key); 681 retval = db->funcs->get (db, key);
694 682
695 return (NILP (retval) ? defalt : retval); 683 return (NILP (retval) ? defalt : retval);
696 } 684 }
697 685
698 DEFUN ("map-database", Fmapdatabase, Smapdatabase, 2, 2, 0 /* 686 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
699 Map FUNCTION over entries in DATABASE, calling it with two args, 687 Map FUNCTION over entries in DATABASE, calling it with two args,
700 each key and value in the database. 688 each key and value in the database.
701 */ ) 689 */
702 (function, dbase) 690 (function, dbase))
703 Lisp_Object function, dbase;
704 { 691 {
705 struct gcpro gcpro1, gcpro2; 692 struct gcpro gcpro1, gcpro2;
706 struct database_struct *db; 693 struct database_struct *db;
707 694
708 CHECK_DATABASE (dbase); 695 CHECK_DATABASE (dbase);
728 defsymbol (&Qhash, "hash"); 715 defsymbol (&Qhash, "hash");
729 defsymbol (&Qbtree, "btree"); 716 defsymbol (&Qbtree, "btree");
730 defsymbol (&Qrecno, "recno"); 717 defsymbol (&Qrecno, "recno");
731 #endif 718 #endif
732 719
733 defsubr (&Smake_database); 720 DEFSUBR (Fmake_database);
734 defsubr (&Sdatabasep); 721 DEFSUBR (Fdatabasep);
735 defsubr (&Smapdatabase); 722 DEFSUBR (Fmapdatabase);
736 defsubr (&Sputdatabase); 723 DEFSUBR (Fputdatabase);
737 defsubr (&Sgetdatabase); 724 DEFSUBR (Fgetdatabase);
738 defsubr (&Sremdatabase); 725 DEFSUBR (Fremdatabase);
739 defsubr (&Sdatabase_type); 726 DEFSUBR (Fdatabase_type);
740 defsubr (&Sdatabase_subtype); 727 DEFSUBR (Fdatabase_subtype);
741 defsubr (&Sdatabase_error); 728 DEFSUBR (Fdatabase_error);
742 defsubr (&Sdatabase_live_p); 729 DEFSUBR (Fdatabase_live_p);
743 defsubr (&Sdatabase_file_name); 730 DEFSUBR (Fdatabase_file_name);
744 defsubr (&Sdatabase_close); 731 DEFSUBR (Fdatabase_close);
745 } 732 }
746 733
747 void 734 void
748 vars_of_dbm (void) 735 vars_of_dbm (void)
749 { 736 {