annotate src/database.c @ 5142:f965e31a35f0

reduce lcrecord headers to 2 words, rename printing_unreadable_object -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-03-13 Ben Wing <ben@xemacs.org> * internals/internals.texi (Working with Lisp Objects): * internals/internals.texi (Writing Macros): * internals/internals.texi (lrecords): More rewriting to correspond with changes from *LRECORD* to *LISP_OBJECT*. modules/ChangeLog addition: 2010-03-13 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c (print_pgconn): * postgresql/postgresql.c (print_pgresult): printing_unreadable_object -> printing_unreadable_object_fmt. 2010-03-13 Ben Wing <ben@xemacs.org> * ldap/eldap.c (print_ldap): printing_unreadable_object -> printing_unreadable_object_fmt. src/ChangeLog addition: 2010-03-13 Ben Wing <ben@xemacs.org> * alloc.c (alloc_sized_lrecord_1): * alloc.c (alloc_sized_lrecord_array): * alloc.c (old_alloc_sized_lcrecord): * alloc.c (disksave_object_finalization_1): * alloc.c (mark_lcrecord_list): * alloc.c (alloc_managed_lcrecord): * alloc.c (free_managed_lcrecord): * alloc.c (tick_lcrecord_stats): * alloc.c (sweep_lcrecords_1): * buffer.c (print_buffer): * buffer.c (DEFVAR_BUFFER_LOCAL_1): * casetab.c: * casetab.c (print_case_table): * console.c (print_console): * console.c (DEFVAR_CONSOLE_LOCAL_1): * data.c (print_weak_list): * data.c (print_weak_box): * data.c (print_ephemeron): * data.c (ephemeron_equal): * database.c (print_database): * database.c (finalize_database): * device-msw.c (sync_printer_with_devmode): * device-msw.c (print_devmode): * device-msw.c (finalize_devmode): * device.c: * device.c (print_device): * elhash.c: * elhash.c (print_hash_table): * eval.c (print_subr): * eval.c (print_multiple_value): * event-stream.c (event_stream_resignal_wakeup): * events.c (clear_event_resource): * events.c (zero_event): * events.c (print_event): * extents.c: * extents.c (print_extent): * file-coding.c (print_coding_system): * font-mgr.c: * font-mgr.c (Ffc_init): * frame.c: * frame.c (print_frame): * gc.c: * gc.c (GC_CHECK_NOT_FREE): * glyphs.c: * glyphs.c (print_image_instance): * glyphs.c (print_glyph): * gui.c (print_gui_item): * gui.c (copy_gui_item): * keymap.c (print_keymap): * keymap.c (MARKED_SLOT): * lisp.h: * lisp.h (struct Lisp_String): * lisp.h (DEFUN): * lisp.h (DEFUN_NORETURN): * lrecord.h: * lrecord.h (NORMAL_LISP_OBJECT_UID): * lrecord.h (struct lrecord_header): * lrecord.h (set_lheader_implementation): * lrecord.h (struct old_lcrecord_header): * lrecord.h (struct free_lcrecord_header): * marker.c (print_marker): * mule-charset.c: * mule-charset.c (print_charset): * objects.c (print_color_instance): * objects.c (print_font_instance): * objects.c (finalize_font_instance): * print.c (print_cons): * print.c (printing_unreadable_object_fmt): * print.c (printing_unreadable_lisp_object): * print.c (external_object_printer): * print.c (internal_object_printer): * print.c (debug_p4): * print.c (ext_print_begin): * process.c (print_process): * rangetab.c (print_range_table): * rangetab.c (range_table_equal): * scrollbar.c (free_scrollbar_instance): * specifier.c (print_specifier): * specifier.c (finalize_specifier): * symbols.c (guts_of_unbound_marker): * symeval.h: * symeval.h (DEFVAR_SYMVAL_FWD): * tooltalk.c: * tooltalk.c (print_tooltalk_message): * tooltalk.c (print_tooltalk_pattern): * ui-gtk.c (ffi_object_printer): * ui-gtk.c (emacs_gtk_object_printer): * ui-gtk.c (emacs_gtk_boxed_printer): * window.c (print_window): * window.c (free_window_mirror): * window.c (debug_print_window): * xemacs.def.in.in: (1) printing_unreadable_object -> printing_unreadable_object_fmt. (2) printing_unreadable_lcrecord -> printing_unreadable_lisp_object and fix up so it no longer requires an lcrecord. These previous changes eliminate most of the remaining places where the terms `lcrecord' and `lrecord' occurred outside of specialized code. (3) Fairly major change: Reduce the number of words in an lcrecord from 3 to 2. The third word consisted of a uid that duplicated the lrecord uid, and a single free bit, which was moved into the lrecord structure. This reduces the size of the `uid' slot from 21 bits to 20 bits. Arguably this isn't enough -- we could easily have more than 1,000,000 or so objects created in a session. The answer is (a) It doesn't really matter if we overflow the uid field because it's only used for debugging, to identify an object uniquely (or pretty much so). (b) If we cared about it overflowing and wanted to reduce this, we could make it so that cons, string, float and certain other frob-block types that never print out the uid simply don't store a uid in them and don't increment the lrecord_uid_counter. (4) In conjunction with (3), create new macro NORMAL_LISP_OBJECT_UID() and use it to abstract out the differences between NEWGC and old-GC in accessing the `uid' value from a "normal Lisp Object pointer". (5) In events.c, use zero_nonsized_lisp_object() in place of custom- written equivalent. In font-mgr.c use external_object_printer() in place of custom-written equivalents.
author Ben Wing <ben@xemacs.org>
date Sat, 13 Mar 2010 05:38:08 -0600
parents a9c41067dd88
children 88bd4f3ef8e4
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Database access routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1996, William M. Perry
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
3 Copyright (C) 2001, 2002, 2005, 2010 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Written by Bill Perry */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* Substantially rewritten by Martin Buchholz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 /* db 2.x support added by Andreas Jaeger */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
27 /* Mule-ized 6-22-00 Ben Wing */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "lisp.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
31
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "buffer.h"
4351
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
34 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #ifndef HAVE_DATABASE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #error HAVE_DATABASE not defined!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "database.h" /* Our include file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 /* Work around Berkeley DB's use of int types which are defined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 slightly differently in the not quite yet standard <inttypes.h>.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 See db.h for details of why we're resorting to this... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 /* glibc 2.1 doesn't have this problem with DB 2.x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #ifdef HAVE_INTTYPES_H
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
49 #ifndef __BIT_TYPES_DEFINED__
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #define __BIT_TYPES_DEFINED__
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
51 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include <inttypes.h>
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
53 #if !HAVE_U_INT8_T
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 typedef uint8_t u_int8_t;
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
55 #endif
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
56 #if !HAVE_U_INT16_T
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 typedef uint16_t u_int16_t;
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
58 #endif
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
59 #if !HAVE_U_INT32_T
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 typedef uint32_t u_int32_t;
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
61 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 #ifdef WE_DONT_NEED_QUADS
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
63 #if !HAVE_U_INT64_T
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 typedef uint64_t u_int64_t;
3739
6d4dc9ec7240 [xemacs-hg @ 2006-12-11 19:43:57 by aidan]
aidan
parents: 3072
diff changeset
65 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 #endif /* WE_DONT_NEED_QUADS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 #endif /* HAVE_INTTYPES_H */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */
1460
df0effd42264 [xemacs-hg @ 2003-05-06 04:54:18 by youngs]
youngs
parents: 1453
diff changeset
69 /* Berkeley DB wants __STDC__ to be defined; else if does `#define const' */
df0effd42264 [xemacs-hg @ 2003-05-06 04:54:18 by youngs]
youngs
parents: 1453
diff changeset
70 #if ! defined (__STDC__) && ! defined(__cplusplus)
df0effd42264 [xemacs-hg @ 2003-05-06 04:54:18 by youngs]
youngs
parents: 1453
diff changeset
71 #define __STDC__ 0
df0effd42264 [xemacs-hg @ 2003-05-06 04:54:18 by youngs]
youngs
parents: 1453
diff changeset
72 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
73 #include DB_H_FILE /* Berkeley db's header file */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 #ifndef DB_VERSION_MAJOR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 # define DB_VERSION_MAJOR 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 #endif /* DB_VERSION_MAJOR */
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
77 #ifndef DB_VERSION_MINOR
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
78 # define DB_VERSION_MINOR 0
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
79 #endif /* DB_VERSION_MINOR */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Lisp_Object Qberkeley_db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
82 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
83 Lisp_Object Qqueue;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
84 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 #ifdef HAVE_DBM
4991
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
88 # ifdef TRUST_NDBM_H_PROTOTYPES
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
89 # include NDBM_H_FILE
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
90 # else /* not TRUST_NDBM_H_PROTOTYPES */
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
91
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
92 /* The prototypes in gdbm/ndbm.h currently are broken when compiling
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
93 using C++, since they are of the form `datum dbm_firstkey()', without any
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
94 args given. */
4824
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
95
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
96 #if defined(__cplusplus) || defined(c_plusplus)
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
97 extern "C" {
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
98 #endif
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
99
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
100 /* Parameters to dbm_store for simple insertion or replacement. */
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
101 #define DBM_INSERT 0
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
102 #define DBM_REPLACE 1
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
103
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
104 /* The data and key structure. This structure is defined for compatibility. */
4991
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
105 typedef struct
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
106 {
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
107 char *dptr;
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
108 int dsize;
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
109 } datum;
4824
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
110
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
111 /* The file information header. This is good enough for most applications. */
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
112 typedef struct {int dummy[10];} DBM;
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
113
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
114 int dbm_clearerr(DBM *);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
115 void dbm_close(DBM *);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
116 int dbm_delete(DBM *, datum);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
117 int dbm_error(DBM *);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
118 datum dbm_fetch(DBM *, datum);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
119 datum dbm_firstkey(DBM *);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
120 datum dbm_nextkey(DBM *);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
121 DBM *dbm_open(const char *, int, mode_t);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
122 int dbm_store(DBM *, datum, datum, int);
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
123
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
124 #if defined(__cplusplus) || defined(c_plusplus)
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
125 }
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
126 #endif
c12b646d84ee changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents: 4699
diff changeset
127
4991
97c45e3ad810 implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents: 4981
diff changeset
128 # endif /* (not) TRUST_NDBM_H_PROTOTYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Lisp_Object Qdbm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Lisp_Object Vdatabase_coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Lisp_Object Qdatabasep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 Lisp_Object (*get_subtype) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 Lisp_Object (*get_type) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Lisp_Object (*get) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 int (*rem) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 void (*map) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 void (*close) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 Lisp_Object (*last_error) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 } DB_FUNCS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 struct Lisp_Database
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
150 NORMAL_LISP_OBJECT_HEADER header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Lisp_Object fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 int access_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 int dberrno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 int live_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 DBM *dbm_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 DB *db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 DB_FUNCS *funcs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 Lisp_Object coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 #define XDATABASE(x) XRECORD (x, database, Lisp_Database)
617
af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben]
ben
parents: 563
diff changeset
167 #define wrap_database(p) wrap_record (p, database)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 #define DATABASEP(x) RECORDP (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 #define DATABASE_LIVE_P(x) (x->live_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 #define CHECK_LIVE_DATABASE(db) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 CHECK_DATABASE (db); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (!DATABASE_LIVE_P (XDATABASE(db))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
176 invalid_operation ("Attempting to access closed database", db); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 static Lisp_Database *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 allocate_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
183 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (database);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3072
diff changeset
184 Lisp_Database *db = XDATABASE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 db->fname = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 db->dbm_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 db->access_ = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 db->mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 db->dberrno = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
197 db->coding_system = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 return db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1141
diff changeset
201 static const struct memory_description database_description[] = {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
202 { XD_LISP_OBJECT, offsetof (struct Lisp_Database, fname) },
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
203 { XD_END}
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
204 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
205
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 static Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
207 mark_database (Lisp_Object object)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
209 Lisp_Database *db = XDATABASE (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 return db->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1645
diff changeset
214 print_database (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1645
diff changeset
215 int UNUSED (escapeflag))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Lisp_Database *db = XDATABASE (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 if (print_readably)
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
220 printing_unreadable_lisp_object (obj, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
222 write_fmt_string_lisp (printcharfun, "#<database \"%s\" (%s/%s/",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
223 3, db->fname, db->funcs->get_type (db),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
224 db->funcs->get_subtype (db));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
225
4351
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
226 write_fmt_string (printcharfun, "%s) ",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
227 (!DATABASE_LIVE_P (db) ? "closed" :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
228 (db->access_ & O_WRONLY) ? "writeonly" :
4351
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
229 (db->access_ & O_RDWR) ? "readwrite" : "readonly"));
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
230
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
231 write_fmt_string_lisp (printcharfun, "coding: %s ", 1,
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
232 XSYMBOL_NAME (XCODING_SYSTEM_NAME
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
233 (db->coding_system)));
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
234
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
235 write_fmt_string (printcharfun, "0x%x>", NORMAL_LISP_OBJECT_UID (db));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 static void
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
239 finalize_database (Lisp_Object obj)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
241 Lisp_Database *db = XDATABASE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4699
diff changeset
246 DEFINE_NODUMP_LISP_OBJECT ("database", database,
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
247 mark_database, print_database,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
248 finalize_database, 0, 0,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
249 database_description,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
250 Lisp_Database);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 Close database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 Lisp_Database *db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 Return the type of database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 return XDATABASE (database)->funcs->get_type (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 Return the subtype of database DATABASE, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
286 Return t if OBJECT is an active database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
288 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
290 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
291 Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 Return the filename associated with the database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 return XDATABASE (database)->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
305 Return t if OBJECT is a database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
307 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
309 return DATABASEP (object) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 dbm_map (Lisp_Database *db, Lisp_Object func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 for (keydatum = dbm_firstkey (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 keydatum.dptr != NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 keydatum = dbm_nextkey (db->dbm_handle))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 valdatum = dbm_fetch (db->dbm_handle, keydatum);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
324 key = make_extstring ((Extbyte *) keydatum.dptr, keydatum.dsize,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
325 db->coding_system);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
326 val = make_extstring ((Extbyte *) valdatum.dptr, valdatum.dsize,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
327 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 dbm_get (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
337 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
338 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 valdatum = dbm_fetch (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 return (valdatum.dptr
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
342 ? make_extstring ((Extbyte *) valdatum.dptr, valdatum.dsize,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
343 db->coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 dbm_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
353 LISP_STRING_TO_SIZED_EXTERNAL (val, valdatum.dptr, valdatum.dsize,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
354 db->coding_system);
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
355 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
356 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 return !dbm_store (db->dbm_handle, keydatum, valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 dbm_remove (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 datum keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
367 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
368 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 return dbm_delete (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 static Lisp_Object
2494
bd98c3f9e578 [xemacs-hg @ 2005-01-21 12:09:17 by malcolmp]
malcolmp
parents: 2493
diff changeset
374 dbm_type (Lisp_Database *UNUSED (db))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 return Qdbm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 static Lisp_Object
2494
bd98c3f9e578 [xemacs-hg @ 2005-01-21 12:09:17 by malcolmp]
malcolmp
parents: 2493
diff changeset
380 dbm_subtype (Lisp_Database *UNUSED (db))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 dbm_lasterr (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 return lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 dbm_closeit (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 if (db->dbm_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 dbm_close (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 db->dbm_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 static DB_FUNCS ndbm_func_block =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 dbm_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 dbm_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 dbm_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 dbm_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 dbm_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 dbm_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 dbm_closeit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 dbm_lasterr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1645
diff changeset
416 berkdb_type (Lisp_Database *UNUSED (db))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 return Qberkeley_db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 berkdb_subtype (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 if (!db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 switch (db->db_handle->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 case DB_BTREE: return Qbtree;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 case DB_HASH: return Qhash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 case DB_RECNO: return Qrecno;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
432 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
433 case DB_QUEUE: return Qqueue;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
434 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 default: return Qunknown;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 berkdb_lasterr (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 return lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 berkdb_get (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 int status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
455 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
456 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 if (!status)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
465 return make_extstring ((const Extbyte *) valdatum.data, valdatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
466 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 berkdb_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 Lisp_Object key,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 Lisp_Object val,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 int status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
490 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
491 db->coding_system);
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
492 LISP_STRING_TO_SIZED_EXTERNAL (val, valdatum.data, valdatum.size,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
493 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 NILP (replace) ? R_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 NILP (replace) ? DB_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 #endif/* DV_VERSION_MAJOR = 2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 return status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 berkdb_remove (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 DBT keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
516 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size,
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
517 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 status = db->db_handle->del (db->db_handle, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 if (!status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 berkdb_map (Lisp_Database *db, Lisp_Object func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 DB *dbp = db->db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
553 key = make_extstring ((const Extbyte *) keydatum.data, keydatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
554 db->coding_system);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
555 val = make_extstring ((const Extbyte *) valdatum.data, valdatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
556 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 DBC *dbcp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 status = dbp->cursor (dbp, NULL, &dbcp, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 status = dbp->cursor (dbp, NULL, &dbcp);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
567 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
572 key = make_extstring ((const Extbyte *) keydatum.data, keydatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
573 db->coding_system);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
574 val = make_extstring ((const Extbyte *) valdatum.data, valdatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
575 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 dbcp->c_close (dbcp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 berkdb_close (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 if (db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 db->db_handle->close (db->db_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 db->db_handle->close (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 static DB_FUNCS berk_func_block =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 berkdb_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 berkdb_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 berkdb_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 berkdb_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 berkdb_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 berkdb_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 berkdb_close,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 berkdb_lasterr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 Return the last error associated with DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 if (NILP (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 return lisp_strerror (errno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 return XDATABASE (database)->funcs->last_error (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
625 DEFUN ("open-database", Fopen_database, 1, 6, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 Return a new database object opened on FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 Optional arguments TYPE and SUBTYPE specify the database type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 Optional argument ACCESS specifies the access rights, which may be any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 combination of 'r' 'w' and '+', for read, write, and creation flags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 Optional argument MODE gives the permissions to use when opening FILE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 and defaults to 0755.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
632 Optional argument CODESYS specifies the coding system used to encode/decode
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
633 data passed to/from the database, and defaults to the value of the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
634 variable `database-coding-system'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
636 (file, type, subtype, access_, mode, codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 int modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 int accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 Lisp_Database *db = NULL;
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
642 Extbyte *filename;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 GCPRO2 (file, access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 file = Fexpand_file_name (file, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
650 LISP_PATHNAME_CONVERT_OUT (file, filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 accessmask = O_RDWR | O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 {
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
658 Ibyte *acc;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 CHECK_STRING (access_);
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
660 acc = XSTRING_DATA (access_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
662 if (qxestrchr (acc, '+'))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 accessmask |= O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 {
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
666 int rp = !!qxestrchr (acc, 'r');
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4953
diff changeset
667 int wp = !!qxestrchr (acc, 'w');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 if (rp && wp) accessmask |= O_RDWR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 else if (wp) accessmask |= O_WRONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 else accessmask |= O_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 modemask = 0755; /* rwxr-xr-x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 modemask = XINT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
684 if (NILP (codesys))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
685 codesys = Vdatabase_coding_system;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
686
4351
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
687 codesys = get_coding_system_for_text_file (codesys, 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
688
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 if (NILP (type) || EQ (type, Qdbm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 DBM *dbase = dbm_open (filename, accessmask, modemask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 db->dbm_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 db->funcs = &ndbm_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
699 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 if (NILP (type) || EQ (type, Qberkeley_db))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 DBTYPE real_subtype;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 DB *dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 #if DB_VERSION_MAJOR != 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 if (EQ (subtype, Qhash) || NILP (subtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 real_subtype = DB_HASH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 else if (EQ (subtype, Qbtree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 real_subtype = DB_BTREE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 else if (EQ (subtype, Qrecno))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 real_subtype = DB_RECNO;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
719 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
720 else if (EQ (subtype, Qqueue))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
721 real_subtype = DB_QUEUE;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
722 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
724 invalid_constant ("Unsupported subtype", subtype);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 other flags shouldn't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 accessmask = DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 acc = (char *) XSTRING_DATA (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 if (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 accessmask |= DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 if (strchr (acc, 'r') && !strchr (acc, 'w'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 accessmask |= DB_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
748 #if DB_VERSION_MAJOR == 2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 status = db_open (filename, real_subtype, accessmask,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 modemask, NULL , NULL, &dbase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 if (status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 return Qnil;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
753 #else
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
754 status = db_create (&dbase, NULL, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
755 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
756 return Qnil;
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
757 #if DB_VERSION_MAJOR < 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR < 1)
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
758 status = dbase->open (dbase, filename, NULL,
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
759 real_subtype, accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
760 #else /* DB_VERSION >= 4.1 */
1377
19738a2a5138 [xemacs-hg @ 2003-03-24 15:01:47 by stephent]
stephent
parents: 1204
diff changeset
761 /* You can't use DB_AUTO_COMMIT unless you have a txn environment. */
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
762 status = dbase->open (dbase, NULL, filename, NULL, real_subtype,
1377
19738a2a5138 [xemacs-hg @ 2003-03-24 15:01:47 by stephent]
stephent
parents: 1204
diff changeset
763 accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
764 #endif /* DB_VERSION < 4.1 */
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
765 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
766 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
767 dbase->close (dbase, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
768 return Qnil;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
769 }
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
770 #endif /* DB_VERSION_MAJOR > 2 */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
771 /* Normalize into system specific file modes. Only for printing */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
772 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 db->db_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 db->funcs = &berk_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
778 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
783 invalid_constant ("Unsupported database type", type);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 db_done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 db->live_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 db->fname = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 db->mode = modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 db->access_ = accessmask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
792 return wrap_database (db);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Store KEY and VALUE in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 If optional fourth arg REPLACE is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 replace any existing entry in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 (key, value, database, replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 CHECK_STRING (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 int status = db->funcs->put (db, key, value, replace);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 return status ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 Remove KEY from DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (key, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 int status = db->funcs->rem (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 return status ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 Return value for KEY in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 If there is no corresponding value, return DEFAULT (defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 (key, database, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 Lisp_Object retval = db->funcs->get (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 return NILP (retval) ? default_ : retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 Map FUNCTION over entries in DATABASE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 each key and value in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (function, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 XDATABASE (database)->funcs->map (XDATABASE (database), function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 syms_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 {
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3072
diff changeset
857 INIT_LISP_OBJECT (database);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
858
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
859 DEFSYMBOL (Qdatabasep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 #ifdef HAVE_DBM
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
861 DEFSYMBOL (Qdbm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 #ifdef HAVE_BERKELEY_DB
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
864 DEFSYMBOL (Qberkeley_db);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
865 DEFSYMBOL (Qhash);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
866 DEFSYMBOL (Qbtree);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
867 DEFSYMBOL (Qrecno);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
868 #if DB_VERSION_MAJOR > 2
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
869 DEFSYMBOL (Qqueue);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
870 #endif
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
871 DEFSYMBOL (Qunknown);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 DEFSUBR (Fopen_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 DEFSUBR (Fdatabasep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 DEFSUBR (Fmapdatabase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 DEFSUBR (Fput_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 DEFSUBR (Fget_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 DEFSUBR (Fremove_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 DEFSUBR (Fdatabase_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 DEFSUBR (Fdatabase_subtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 DEFSUBR (Fdatabase_last_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 DEFSUBR (Fdatabase_live_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 DEFSUBR (Fdatabase_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 DEFSUBR (Fclose_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 vars_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 Fprovide (Qdbm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 Fprovide (Qberkeley_db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /*
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
899 Default coding system used to convert data in database files.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
901 Vdatabase_coding_system = Qnative;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 }