annotate src/database.c @ 1314:15a91d7ae2d1

[xemacs-hg @ 2003-02-20 08:16:21 by ben] check in makefile fixes et al Makefile.in.in: Major surgery. Move all stuff related to building anything in the src/ directory into src/. Simplify the dependencies -- everything in src/ is dependent on the single entry `src' in MAKE_SUBDIRS. Remove weirdo targets like `all-elc[s]', dump-elc[s], etc. mule/mule-msw-init.el: Removed. Delete this file. mule/mule-win32-init.el: New file, with stuff from mule-msw-init.el -- not just for MS Windows native, boys and girls! bytecomp.el: Change code inserted to catch trying to load a Mule-only .elc file in a non-Mule XEmacs. Formerly you got the rather cryptic "The required feature `mule' cannot be provided". Now you get "Loading this file requires Mule support". finder.el: Remove dependency on which directory this function is invoked from. update-elc.el: Don't mess around with ../src/BYTECOMPILE_CHANGE. Now that Makefile.in.in and xemacs.mak are in sync, both of them use NEEDTODUMP and the other one isn't used. dumped-lisp.el: Rewrite in terms of `list' and `nconc' instead of assemble-list, so we can have arbitrary forms, not just `when-feature'. very-early-lisp.el: Nuke this file. finder-inf.el, packages.el, update-elc.el, update-elc-2.el, loadup.el, make-docfile.el: Eliminate references to very-early-lisp. msw-glyphs.el: Comment clarification. xemacs.mak: Add macros DO_TEMACS, DO_XEMACS, and a few others; this macro section is now completely in sync with src/Makefile.in.in. Copy check-features, load-shadows, and rebuilding finder-inf.el from src/Makefile.in.in. The main build/dump/recompile process is now synchronized with src/Makefile.in.in. Change `WARNING' to `NOTE' and `error checking' to `error-checking' TO avoid tripping faux warnings and errors in the VC++ IDE. Makefile.in.in: Major surgery. Move all stuff related to building anything in the src/ directory from top-level Makefile.in.in to here. Simplify the dependencies. Rearrange into logical subsections. Synchronize the main compile/dump/build-elcs section with xemacs.mak, which is already clean and in good working order. Remove weirdo targets like `all-elc[s]', dump-elc[s], etc. Add additional levels of macros \(e.g. DO_TEMACS, DO_XEMACS, TEMACS_BATCH, XEMACS_BATCH, XEMACS_BATCH_PACKAGES) to factor out duplicated stuff. Clean up handling of "HEAP_IN_DATA" (Cygwin) so it doesn't need to ignore the return value from dumping. Add .NO_PARALLEL since various aspects of building and dumping must be serialized but do not always have dependencies between them (this is impossible in some cases). Everything related to src/ now gets built in one pass in this directory by just running `make' (except the Makefiles themselves and config.h, paths.h, Emacs.ad.h, and other generated .h files). console.c: Update list of possibly valid console types. emacs.c: Rationalize the specifying and handling of the type of the first frame. This was originally prompted by a workspace in which I got GTK to compile under C++ and in the process fixed it so it could coexist with X in the same build -- hence, a combined TTY/X/MS-Windows/GTK build is now possible under Cygwin. (However, you can't simultaneously *display* more than one kind of device connection -- but getting that to work is not that difficult. Perhaps a project for a bored grad student. I (ben) would do it but don't see the use.) To make sense of this, I added new switches that can be used to specifically indicate the window system: -x [aka --use-x], -tty \[aka --use-tty], -msw [aka --use-ms-windows], -gtk [aka --use-gtk], and -gnome [aka --use-gnome, same as --use-gtk]. -nw continues as an alias for -tty. When none have been given, XEmacs checks for other parameters implying particular device types (-t -> tty, -display -> x [or should it have same treatment as DISPLAY below?]), and has ad-hoc logic afterwards: if env var DISPLAY is set, use x (or gtk? perhaps should check whether gnome is running), else MS Windows if it exsits, else TTY if it exists, else stream, and you must be running in batch mode. This also fixes an existing bug whereby compiling with no x, no mswin, no tty, when running non- interactively (e.g. to dump) I get "sorry, must have TTY support". emacs.c: Turn on Vstack_trace_on_error so that errors are debuggable even when occurring extremely early in reinitialization. emacs.c: Try to make sure that the user can see message output under Windows (i.e. it doesn't just disappear right away) regardless of when it occurs, e.g. in the middle of creating the first frame. emacs.c: Define new function `emacs-run-status', indicating whether XEmacs is noninteractive or interactive, whether raw, post-dump/pdump-load or run-temacs, whether we are dumping, whether pdump is in effect. event-stream.c: It's "mommas are fat", not "momas are fat". Fix other typo. event-stream.c: Conditionalize in_menu_callback check on HAVE_MENUBARS, because it won't exist on w/o menubar support, lisp.h: More hackery on RETURN_NOT_REACHED. Cygwin v3.2 DOES complain here if RETURN_NOT_REACHED() is blank, as it is for GCC 2.5+. So make it blank only for GCC 2.5 through 2.999999999999999. Declare Vstack_trace_on_error. profile.c: Need to include "profile.h" to fix warnings. sheap.c: Don't fatal() when need to rerun Make, just stderr_out() and exit(0). That way we can distinguish between a dumping failing expectedly (due to lack of stack space, triggering another dump) and unexpectedly, in which case, we want to stop building. (or go on, if -K is given) syntax.c, syntax.h: Use ints where they belong, and enum syntaxcode's where they belong, and fix warnings thereby. syntax.h: Fix crash caused by an edge condition in the syntax-cache macros. text.h: Spacing fixes. xmotif.h: New file, to get around shadowing warnings. EmacsManager.c, event-Xt.c, glyphs-x.c, gui-x.c, input-method-motif.c, xmmanagerp.h, xmprimitivep.h: Include xmotif.h. alloc.c: Conditionalize in_malloc on ERROR_CHECK_MALLOC. config.h.in, file-coding.h, fileio.c, getloadavg.c, select-x.c, signal.c, sysdep.c, sysfile.h, systime.h, text.c, unicode.c: Eliminate HAVE_WIN32_CODING_SYSTEMS, use WIN32_ANY instead. Replace defined (WIN32_NATIVE) || defined (CYGWIN) with WIN32_ANY. lisp.h: More futile attempts to walk and chew gum at the same time when dealing with subr's that don't return.
author ben
date Thu, 20 Feb 2003 08:16:21 +0000
parents e22b0213b713
children 19738a2a5138
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
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 2001, 2002 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"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #ifndef HAVE_DATABASE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #error HAVE_DATABASE not defined!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "database.h" /* Our include file */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* Work around Berkeley DB's use of int types which are defined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 slightly differently in the not quite yet standard <inttypes.h>.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 See db.h for details of why we're resorting to this... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 /* glibc 2.1 doesn't have this problem with DB 2.x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #ifdef HAVE_INTTYPES_H
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #define __BIT_TYPES_DEFINED__
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include <inttypes.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 typedef uint8_t u_int8_t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 typedef uint16_t u_int16_t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 typedef uint32_t u_int32_t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #ifdef WE_DONT_NEED_QUADS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 typedef uint64_t u_int64_t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #endif /* WE_DONT_NEED_QUADS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #endif /* HAVE_INTTYPES_H */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
58 #include DB_H_FILE /* Berkeley db's header file */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #ifndef DB_VERSION_MAJOR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 # define DB_VERSION_MAJOR 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #endif /* DB_VERSION_MAJOR */
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
62 #ifndef DB_VERSION_MINOR
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
63 # define DB_VERSION_MINOR 0
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
64 #endif /* DB_VERSION_MINOR */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 Lisp_Object Qberkeley_db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
67 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
68 Lisp_Object Qqueue;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
69 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 #include <ndbm.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Lisp_Object Qdbm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Lisp_Object Vdatabase_coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Lisp_Object Qdatabasep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Lisp_Object (*get_subtype) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Lisp_Object (*get_type) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Lisp_Object (*get) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 int (*rem) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 void (*map) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 void (*close) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Lisp_Object (*last_error) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 } DB_FUNCS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 struct Lisp_Database
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 struct lcrecord_header header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Lisp_Object fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 int access_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 int dberrno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 int live_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 DBM *dbm_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 DB *db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 DB_FUNCS *funcs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Lisp_Object coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 #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
112 #define wrap_database(p) wrap_record (p, database)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 #define DATABASEP(x) RECORDP (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 #define DATABASE_LIVE_P(x) (x->live_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #define CHECK_LIVE_DATABASE(db) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 CHECK_DATABASE (db); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 if (!DATABASE_LIVE_P (XDATABASE(db))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
121 invalid_operation ("Attempting to access closed database", db); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 static Lisp_Database *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 allocate_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, &lrecord_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 db->fname = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 db->dbm_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 db->access_ = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 db->mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 db->dberrno = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
141 db->coding_system = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 return db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1141
diff changeset
145 static const struct memory_description database_description[] = {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
146 { XD_LISP_OBJECT, offsetof (struct Lisp_Database, fname) },
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
147 { XD_END}
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
148 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
149
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 static Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
151 mark_database (Lisp_Object object)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
153 Lisp_Database *db = XDATABASE (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 return db->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 Lisp_Database *db = XDATABASE (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
163 printing_unreadable_object ("#<database 0x%x>", db->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
165 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
166 3, db->fname, db->funcs->get_type (db),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
167 db->funcs->get_subtype (db));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
168
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
169 write_fmt_string (printcharfun, "%s) 0x%x>",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
170 (!DATABASE_LIVE_P (db) ? "closed" :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
171 (db->access_ & O_WRONLY) ? "writeonly" :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
172 (db->access_ & O_RDWR) ? "readwrite" : "readonly"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
173 db->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 finalize_database (void *header, int for_disksave)
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 Lisp_Database *db = (Lisp_Database *) header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 if (for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
183 invalid_operation
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
184 ("Can't dump an emacs containing database objects",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
185 wrap_database (db));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
190 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
191 0, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
192 mark_database, print_database,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
193 finalize_database, 0, 0,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
194 database_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
195 Lisp_Database);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 Close database DATABASE.
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 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 Lisp_Database *db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 Return the type of database DATABASE.
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 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 CHECK_DATABASE (database);
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 return XDATABASE (database)->funcs->get_type (XDATABASE (database));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Return the subtype of database DATABASE, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
231 Return t if OBJECT is an active database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
233 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
235 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
236 Qt : Qnil;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 Return the filename associated with the database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 return XDATABASE (database)->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
250 Return t if OBJECT is a database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
252 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
254 return DATABASEP (object) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 }
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 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 dbm_map (Lisp_Database *db, Lisp_Object func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 Lisp_Object key, val;
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 for (keydatum = dbm_firstkey (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 keydatum.dptr != NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 keydatum = dbm_nextkey (db->dbm_handle))
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 valdatum = dbm_fetch (db->dbm_handle, keydatum);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
269 key = make_ext_string (keydatum.dptr, keydatum.dsize,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
270 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
271 val = make_ext_string (valdatum.dptr, valdatum.dsize,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
272 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 call2 (func, key, val);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 dbm_get (Lisp_Database *db, Lisp_Object key)
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 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
282 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
283 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
284 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 valdatum = dbm_fetch (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return (valdatum.dptr
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
288 ? make_ext_string (valdatum.dptr, valdatum.dsize,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
289 db->coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 dbm_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
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 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
299 TO_EXTERNAL_FORMAT (LISP_STRING, val,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
300 ALLOCA, (valdatum.dptr, valdatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
301 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
302 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
303 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
304 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 return !dbm_store (db->dbm_handle, keydatum, valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 dbm_remove (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 datum keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
315 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
316 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
317 db->coding_system);
428
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 return dbm_delete (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 dbm_type (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 return Qdbm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 dbm_subtype (Lisp_Database *db)
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 dbm_lasterr (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 return lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 dbm_closeit (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 if (db->dbm_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 dbm_close (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 db->dbm_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 static DB_FUNCS ndbm_func_block =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 dbm_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 dbm_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 dbm_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 dbm_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 dbm_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 dbm_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 dbm_closeit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 dbm_lasterr
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 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 berkdb_type (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 return Qberkeley_db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 berkdb_subtype (Lisp_Database *db)
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 if (!db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 return Qnil;
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 switch (db->db_handle->type)
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 case DB_BTREE: return Qbtree;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 case DB_HASH: return Qhash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 case DB_RECNO: return Qrecno;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
381 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
382 case DB_QUEUE: return Qqueue;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
383 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 default: return Qunknown;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 berkdb_lasterr (Lisp_Database *db)
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 return lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 berkdb_get (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 int status = 0;
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 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
404 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
405 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
406 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 #endif /* DB_VERSION_MAJOR */
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 if (!status)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
415 return make_ext_string (valdatum.data, valdatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
416 db->coding_system);
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 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 #endif /* DB_VERSION_MAJOR */
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 berkdb_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 Lisp_Object key,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 Lisp_Object val,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 int status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
440 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
441 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
442 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
443 TO_EXTERNAL_FORMAT (LISP_STRING, val,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
444 ALLOCA, (valdatum.data, valdatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
445 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 NILP (replace) ? R_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 NILP (replace) ? DB_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 #endif/* DV_VERSION_MAJOR = 2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 return status;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 berkdb_remove (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 DBT keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
468 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
469 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
470 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 status = db->db_handle->del (db->db_handle, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 if (!status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 berkdb_map (Lisp_Database *db, Lisp_Object func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 DB *dbp = db->db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
506 key = make_ext_string (keydatum.data, keydatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
507 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
508 val = make_ext_string (valdatum.data, valdatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
509 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 DBC *dbcp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 status = dbp->cursor (dbp, NULL, &dbcp, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 status = dbp->cursor (dbp, NULL, &dbcp);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
520 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
525 key = make_ext_string (keydatum.data, keydatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
526 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
527 val = make_ext_string (valdatum.data, valdatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
528 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 dbcp->c_close (dbcp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 berkdb_close (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 if (db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 db->db_handle->close (db->db_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 db->db_handle->close (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 static DB_FUNCS berk_func_block =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 berkdb_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 berkdb_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 berkdb_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 berkdb_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 berkdb_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 berkdb_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 berkdb_close,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 berkdb_lasterr
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 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 Return the last error associated with DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 if (NILP (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 return lisp_strerror (errno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 return XDATABASE (database)->funcs->last_error (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
578 DEFUN ("open-database", Fopen_database, 1, 6, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 Return a new database object opened on FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 Optional arguments TYPE and SUBTYPE specify the database type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 Optional argument ACCESS specifies the access rights, which may be any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 combination of 'r' 'w' and '+', for read, write, and creation flags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 Optional argument MODE gives the permissions to use when opening FILE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 and defaults to 0755.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
585 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
586 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
587 variable `database-coding-system'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
589 (file, type, subtype, access_, mode, codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 int modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 int accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 Lisp_Database *db = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 char *filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 struct gcpro gcpro1, gcpro2;
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 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 GCPRO2 (file, access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 file = Fexpand_file_name (file, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
603 TO_EXTERNAL_FORMAT (LISP_STRING, file,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
604 C_STRING_ALLOCA, filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
605 Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 accessmask = O_RDWR | O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 acc = (char *) XSTRING_DATA (access_);
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 (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 accessmask |= O_CREAT;
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 char *rp = strchr (acc, 'r');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 char *wp = strchr (acc, 'w');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 if (rp && wp) accessmask |= O_RDWR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 else if (wp) accessmask |= O_WRONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 else accessmask |= O_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 modemask = 0755; /* rwxr-xr-x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 modemask = XINT (mode);
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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
639 if (NILP (codesys))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
640 codesys = Vdatabase_coding_system;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
641
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
642 codesys = get_coding_system_for_text_file (Vdatabase_coding_system, 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
643
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 if (NILP (type) || EQ (type, Qdbm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 DBM *dbase = dbm_open (filename, accessmask, modemask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 db->dbm_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 db->funcs = &ndbm_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
654 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 if (NILP (type) || EQ (type, Qberkeley_db))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 DBTYPE real_subtype;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 DB *dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 #if DB_VERSION_MAJOR != 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 if (EQ (subtype, Qhash) || NILP (subtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 real_subtype = DB_HASH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 else if (EQ (subtype, Qbtree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 real_subtype = DB_BTREE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 else if (EQ (subtype, Qrecno))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 real_subtype = DB_RECNO;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
674 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
675 else if (EQ (subtype, Qqueue))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
676 real_subtype = DB_QUEUE;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
677 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
679 invalid_constant ("Unsupported subtype", subtype);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 /* 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
687 other flags shouldn't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 accessmask = DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 else
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 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 acc = (char *) XSTRING_DATA (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 if (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 accessmask |= DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 if (strchr (acc, 'r') && !strchr (acc, 'w'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 accessmask |= DB_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 }
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
703 #if DB_VERSION_MAJOR == 2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 status = db_open (filename, real_subtype, accessmask,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 modemask, NULL , NULL, &dbase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 if (status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 return Qnil;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
708 #else
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
709 status = db_create (&dbase, NULL, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
710 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
711 return Qnil;
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
712 #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
713 status = dbase->open (dbase, filename, NULL,
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
714 real_subtype, accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
715 #else /* DB_VERSION >= 4.1 */
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
716 status = dbase->open (dbase, NULL, filename, NULL, real_subtype,
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
717 accessmask | DB_AUTO_COMMIT, modemask);
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
718 #endif /* DB_VERSION < 4.1 */
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
719 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
720 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
721 dbase->close (dbase, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
722 return Qnil;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
723 }
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
724 #endif /* DB_VERSION_MAJOR > 2 */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
725 /* Normalize into system specific file modes. Only for printing */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
726 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 db->db_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 db->funcs = &berk_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
732 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
737 invalid_constant ("Unsupported database type", type);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 db_done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 db->live_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 db->fname = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 db->mode = modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 db->access_ = accessmask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
746 return wrap_database (db);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 Store KEY and VALUE in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 If optional fourth arg REPLACE is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 replace any existing entry in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (key, value, database, replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 CHECK_STRING (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 int status = db->funcs->put (db, key, value, replace);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 return status ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 Remove KEY from DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (key, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 int status = db->funcs->rem (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 return status ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 Return value for KEY in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 If there is no corresponding value, return DEFAULT (defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (key, database, default_))
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 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 Lisp_Object retval = db->funcs->get (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 return NILP (retval) ? default_ : retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 }
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 ("map-database", Fmapdatabase, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Map FUNCTION over entries in DATABASE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 each key and value in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (function, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 XDATABASE (database)->funcs->map (XDATABASE (database), function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 syms_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
811 INIT_LRECORD_IMPLEMENTATION (database);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
812
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
813 DEFSYMBOL (Qdatabasep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 #ifdef HAVE_DBM
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
815 DEFSYMBOL (Qdbm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 #ifdef HAVE_BERKELEY_DB
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
818 DEFSYMBOL (Qberkeley_db);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
819 DEFSYMBOL (Qhash);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
820 DEFSYMBOL (Qbtree);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
821 DEFSYMBOL (Qrecno);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
822 #if DB_VERSION_MAJOR > 2
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
823 DEFSYMBOL (Qqueue);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
824 #endif
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
825 DEFSYMBOL (Qunknown);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 DEFSUBR (Fopen_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 DEFSUBR (Fdatabasep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 DEFSUBR (Fmapdatabase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 DEFSUBR (Fput_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 DEFSUBR (Fget_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 DEFSUBR (Fremove_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 DEFSUBR (Fdatabase_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 DEFSUBR (Fdatabase_subtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 DEFSUBR (Fdatabase_last_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 DEFSUBR (Fdatabase_live_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 DEFSUBR (Fdatabase_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 DEFSUBR (Fclose_database);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 vars_of_database (void)
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 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 Fprovide (Qdbm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 Fprovide (Qberkeley_db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 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
853 Default coding system used to convert data in database files.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
855 Vdatabase_coding_system = Qnative;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 }