annotate src/database.c @ 4407:4ee73bbe4f8e

Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings. 2007-12-26 Aidan Kehoe <kehoea@parhasard.net> * casetab.c: Extend and correct some case table documentation. * search.c (search_buffer): Correct a bug where only the first entry for a character in the case equivalence table was examined in determining if the Boyer-Moore search algorithm is appropriate. If there are case mappings outside of the charset and row of the characters specified in the search string, those case mappings can be safely ignored (and Boyer-Moore search can be used) if we know from the buffer statistics that the corresponding characters cannot occur. * search.c (boyer_moore): Assert that we haven't been passed a string with varying characters sets or rows within character sets. That's what simple_search is for. In the very rare event that a character in the search string has a canonical case mapping that is not in the same character set and row, don't try to search for the canonical character, search for some other character that is in the the desired character set and row. Assert that the case table isn't corrupt. Do not search for any character case mappings that cannot possibly occur in the buffer, given the buffer metadata about its contents.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 26 Dec 2007 17:30:16 +0100
parents bc3b9f61018e
children 0e1461b592ce
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
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
3 Copyright (C) 2001, 2002, 2005 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 #include <ndbm.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Lisp_Object Qdbm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Lisp_Object Vdatabase_coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Lisp_Object Qdatabasep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Lisp_Object (*get_subtype) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Lisp_Object (*get_type) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Lisp_Object (*get) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 int (*rem) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 void (*map) (Lisp_Database *, Lisp_Object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 void (*close) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 Lisp_Object (*last_error) (Lisp_Database *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 } DB_FUNCS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 struct Lisp_Database
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 {
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2720
diff changeset
110 struct LCRECORD_HEADER header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 Lisp_Object fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 int mode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 int access_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 int dberrno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 int live_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 DBM *dbm_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 DB *db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 DB_FUNCS *funcs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Lisp_Object coding_system;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 #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
127 #define wrap_database(p) wrap_record (p, database)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 #define DATABASEP(x) RECORDP (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 #define DATABASE_LIVE_P(x) (x->live_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 #define CHECK_LIVE_DATABASE(db) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 CHECK_DATABASE (db); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 if (!DATABASE_LIVE_P (XDATABASE(db))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
136 invalid_operation ("Attempting to access closed database", db); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 static Lisp_Database *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 allocate_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 {
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2720
diff changeset
143 Lisp_Database *db = ALLOC_LCRECORD_TYPE (Lisp_Database, &lrecord_database);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 db->fname = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 db->dbm_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 db->access_ = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 db->mode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 db->dberrno = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
156 db->coding_system = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 return db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1141
diff changeset
160 static const struct memory_description database_description[] = {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
161 { XD_LISP_OBJECT, offsetof (struct Lisp_Database, fname) },
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
162 { XD_END}
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
163 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
164
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 static Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
166 mark_database (Lisp_Object object)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
168 Lisp_Database *db = XDATABASE (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 return db->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1645
diff changeset
173 print_database (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1645
diff changeset
174 int UNUSED (escapeflag))
428
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 Lisp_Database *db = XDATABASE (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
179 printing_unreadable_object ("#<database 0x%x>", db->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
181 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
182 3, db->fname, db->funcs->get_type (db),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
183 db->funcs->get_subtype (db));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
184
4351
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
185 write_fmt_string (printcharfun, "%s) ",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
186 (!DATABASE_LIVE_P (db) ? "closed" :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
187 (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
188 (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
189
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
190 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
191 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
192 (db->coding_system)));
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
193
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
194 write_fmt_string (printcharfun, "0x%x>", db->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 finalize_database (void *header, int for_disksave)
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 Lisp_Database *db = (Lisp_Database *) header;
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 if (for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
204 invalid_operation
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
205 ("Can't dump an emacs containing database objects",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
206 wrap_database (db));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 db->funcs->close (db);
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
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
211 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
212 0, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
213 mark_database, print_database,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
214 finalize_database, 0, 0,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
215 database_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
216 Lisp_Database);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Close database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (database))
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 Lisp_Database *db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 Return the type of database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 CHECK_DATABASE (database);
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 return XDATABASE (database)->funcs->get_type (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Return the subtype of database DATABASE, if any.
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 (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 CHECK_DATABASE (database);
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 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
252 Return t if OBJECT is an active database.
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 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
256 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
257 Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 Return the filename associated with the database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (database))
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 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 return XDATABASE (database)->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 }
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 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
271 Return t if OBJECT is a database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
273 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
275 return DATABASEP (object) ? Qt : Qnil;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 dbm_map (Lisp_Database *db, Lisp_Object func)
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 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Lisp_Object key, val;
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 for (keydatum = dbm_firstkey (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 keydatum.dptr != NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 keydatum = dbm_nextkey (db->dbm_handle))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 valdatum = dbm_fetch (db->dbm_handle, keydatum);
4124
9a633a00c3f2 [xemacs-hg @ 2007-08-17 08:08:05 by crestani]
crestani
parents: 3739
diff changeset
290 key = make_ext_string ((Extbyte *) keydatum.dptr, keydatum.dsize,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
291 db->coding_system);
4124
9a633a00c3f2 [xemacs-hg @ 2007-08-17 08:08:05 by crestani]
crestani
parents: 3739
diff changeset
292 val = make_ext_string ((Extbyte *) valdatum.dptr, valdatum.dsize,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
293 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 dbm_get (Lisp_Database *db, Lisp_Object key)
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 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
303 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
304 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
305 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 valdatum = dbm_fetch (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 return (valdatum.dptr
4124
9a633a00c3f2 [xemacs-hg @ 2007-08-17 08:08:05 by crestani]
crestani
parents: 3739
diff changeset
309 ? make_ext_string ((Extbyte *) valdatum.dptr, valdatum.dsize,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
310 db->coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 : Qnil);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 dbm_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
320 TO_EXTERNAL_FORMAT (LISP_STRING, val,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
321 ALLOCA, (valdatum.dptr, valdatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
322 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
323 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
324 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
325 db->coding_system);
428
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 return !dbm_store (db->dbm_handle, keydatum, valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 dbm_remove (Lisp_Database *db, Lisp_Object key)
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 datum keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
336 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
337 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
338 db->coding_system);
428
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 return dbm_delete (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 }
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 static Lisp_Object
2494
bd98c3f9e578 [xemacs-hg @ 2005-01-21 12:09:17 by malcolmp]
malcolmp
parents: 2493
diff changeset
344 dbm_type (Lisp_Database *UNUSED (db))
428
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 return Qdbm;
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 static Lisp_Object
2494
bd98c3f9e578 [xemacs-hg @ 2005-01-21 12:09:17 by malcolmp]
malcolmp
parents: 2493
diff changeset
350 dbm_subtype (Lisp_Database *UNUSED (db))
428
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 dbm_lasterr (Lisp_Database *db)
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 lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 dbm_closeit (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 if (db->dbm_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 dbm_close (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 db->dbm_handle = NULL;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 static DB_FUNCS ndbm_func_block =
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 dbm_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 dbm_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 dbm_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 dbm_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 dbm_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 dbm_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 dbm_closeit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 dbm_lasterr
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 #endif /* HAVE_DBM */
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 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1645
diff changeset
386 berkdb_type (Lisp_Database *UNUSED (db))
428
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 Qberkeley_db;
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 berkdb_subtype (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->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 return Qnil;
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 switch (db->db_handle->type)
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 case DB_BTREE: return Qbtree;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 case DB_HASH: return Qhash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 case DB_RECNO: return Qrecno;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
402 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
403 case DB_QUEUE: return Qqueue;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
404 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 default: return Qunknown;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 berkdb_lasterr (Lisp_Database *db)
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 return lisp_strerror (db->dberrno);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 berkdb_get (Lisp_Database *db, Lisp_Object key)
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 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 int status = 0;
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 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
425 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
426 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
427 db->coding_system);
428
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 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 if (!status)
1645
080d479edd32 [xemacs-hg @ 2003-08-26 14:03:57 by james]
james
parents: 1460
diff changeset
436 return make_ext_string ((const Extbyte *) valdatum.data, valdatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
437 db->coding_system);
428
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 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 #endif /* DB_VERSION_MAJOR */
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 berkdb_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 Lisp_Object key,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Lisp_Object val,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 int status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
461 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
462 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
463 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
464 TO_EXTERNAL_FORMAT (LISP_STRING, val,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
465 ALLOCA, (valdatum.data, valdatum.size),
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 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 NILP (replace) ? R_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 NILP (replace) ? DB_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 #endif/* DV_VERSION_MAJOR = 2 */
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 return status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 berkdb_remove (Lisp_Database *db, Lisp_Object key)
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;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 int status;
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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
489 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
490 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
491 db->coding_system);
428
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 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 status = db->db_handle->del (db->db_handle, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 if (!status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 berkdb_map (Lisp_Database *db, Lisp_Object func)
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 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 DB *dbp = db->db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 int status;
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 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 {
2646
5e4893b16f7c [xemacs-hg @ 2005-03-10 09:19:14 by crestani]
crestani
parents: 2495
diff changeset
527 key = make_ext_string ((const Extbyte *) keydatum.data, keydatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
528 db->coding_system);
2646
5e4893b16f7c [xemacs-hg @ 2005-03-10 09:19:14 by crestani]
crestani
parents: 2495
diff changeset
529 val = make_ext_string ((const Extbyte *) valdatum.data, valdatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
530 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 call2 (func, key, val);
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 #else
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 DBC *dbcp;
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 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 status = dbp->cursor (dbp, NULL, &dbcp, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 status = dbp->cursor (dbp, NULL, &dbcp);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
541 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 {
1645
080d479edd32 [xemacs-hg @ 2003-08-26 14:03:57 by james]
james
parents: 1460
diff changeset
546 key = make_ext_string ((const Extbyte *) keydatum.data, keydatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
547 db->coding_system);
1645
080d479edd32 [xemacs-hg @ 2003-08-26 14:03:57 by james]
james
parents: 1460
diff changeset
548 val = make_ext_string ((const Extbyte *) valdatum.data, valdatum.size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
549 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 call2 (func, key, val);
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 dbcp->c_close (dbcp);
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 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 berkdb_close (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 if (db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 db->db_handle->close (db->db_handle);
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 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 db->db_handle->close (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 }
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 static DB_FUNCS berk_func_block =
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 berkdb_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 berkdb_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 berkdb_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 berkdb_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 berkdb_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 berkdb_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 berkdb_close,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 berkdb_lasterr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 #endif /* HAVE_BERKELEY_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 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 Return the last error associated with DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (database))
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 if (NILP (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 return lisp_strerror (errno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 return XDATABASE (database)->funcs->last_error (XDATABASE (database));
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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
599 DEFUN ("open-database", Fopen_database, 1, 6, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 Return a new database object opened on FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 Optional arguments TYPE and SUBTYPE specify the database type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 Optional argument ACCESS specifies the access rights, which may be any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 combination of 'r' 'w' and '+', for read, write, and creation flags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 Optional argument MODE gives the permissions to use when opening FILE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 and defaults to 0755.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
606 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
607 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
608 variable `database-coding-system'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
610 (file, type, subtype, access_, mode, codesys))
428
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 int modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 int accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 Lisp_Database *db = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 char *filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 GCPRO2 (file, access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 file = Fexpand_file_name (file, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
624 TO_EXTERNAL_FORMAT (LISP_STRING, file,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
625 C_STRING_ALLOCA, filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
626 Qfile_name);
428
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 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 accessmask = O_RDWR | O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 acc = (char *) XSTRING_DATA (access_);
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 if (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 accessmask |= O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 char *rp = strchr (acc, 'r');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 char *wp = strchr (acc, 'w');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 if (rp && wp) accessmask |= O_RDWR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 else if (wp) accessmask |= O_WRONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 else accessmask |= O_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 if (NILP (mode))
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 modemask = 0755; /* rwxr-xr-x */
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 else
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 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 modemask = XINT (mode);
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
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
660 if (NILP (codesys))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
661 codesys = Vdatabase_coding_system;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
662
4351
bc3b9f61018e Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4124
diff changeset
663 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
664
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 if (NILP (type) || EQ (type, Qdbm))
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 DBM *dbase = dbm_open (filename, accessmask, modemask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 return Qnil;
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 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 db->dbm_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 db->funcs = &ndbm_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
675 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 goto db_done;
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 #endif /* HAVE_DBM */
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 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 if (NILP (type) || EQ (type, Qberkeley_db))
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 DBTYPE real_subtype;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 DB *dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 #if DB_VERSION_MAJOR != 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 if (EQ (subtype, Qhash) || NILP (subtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 real_subtype = DB_HASH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 else if (EQ (subtype, Qbtree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 real_subtype = DB_BTREE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 else if (EQ (subtype, Qrecno))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 real_subtype = DB_RECNO;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
695 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
696 else if (EQ (subtype, Qqueue))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
697 real_subtype = DB_QUEUE;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
698 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
700 invalid_constant ("Unsupported subtype", subtype);
428
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 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 /* 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
708 other flags shouldn't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 accessmask = DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 else
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 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 acc = (char *) XSTRING_DATA (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 if (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 accessmask |= DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 if (strchr (acc, 'r') && !strchr (acc, 'w'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 accessmask |= DB_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 }
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
724 #if DB_VERSION_MAJOR == 2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 status = db_open (filename, real_subtype, accessmask,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 modemask, NULL , NULL, &dbase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 if (status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 return Qnil;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
729 #else
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
730 status = db_create (&dbase, NULL, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
731 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
732 return Qnil;
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
733 #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
734 status = dbase->open (dbase, filename, NULL,
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
735 real_subtype, accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
736 #else /* DB_VERSION >= 4.1 */
1377
19738a2a5138 [xemacs-hg @ 2003-03-24 15:01:47 by stephent]
stephent
parents: 1204
diff changeset
737 /* 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
738 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
739 accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
740 #endif /* DB_VERSION < 4.1 */
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
741 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
742 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
743 dbase->close (dbase, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
744 return Qnil;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
745 }
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
746 #endif /* DB_VERSION_MAJOR > 2 */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
747 /* Normalize into system specific file modes. Only for printing */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
748 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 db->db_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 db->funcs = &berk_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
754 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
759 invalid_constant ("Unsupported database type", type);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 db_done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 db->live_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 db->fname = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 db->mode = modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 db->access_ = accessmask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
768 return wrap_database (db);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 }
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 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 Store KEY and VALUE in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 If optional fourth arg REPLACE is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 replace any existing entry in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (key, value, database, replace))
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 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 CHECK_STRING (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 int status = db->funcs->put (db, key, value, replace);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 return status ? Qt : 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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 Remove KEY from DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (key, database))
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 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 int status = db->funcs->rem (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 return status ? Qt : Qnil;
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 }
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 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 Return value for KEY in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 If there is no corresponding value, return DEFAULT (defaults to nil).
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 (key, database, default_))
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 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 CHECK_STRING (key);
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 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 Lisp_Object retval = db->funcs->get (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 return NILP (retval) ? default_ : retval;
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 }
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 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 Map FUNCTION over entries in DATABASE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 each key and value in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 (function, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 CHECK_LIVE_DATABASE (database);
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 XDATABASE (database)->funcs->map (XDATABASE (database), function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 syms_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
833 INIT_LRECORD_IMPLEMENTATION (database);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
834
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
835 DEFSYMBOL (Qdatabasep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 #ifdef HAVE_DBM
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
837 DEFSYMBOL (Qdbm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 #ifdef HAVE_BERKELEY_DB
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
840 DEFSYMBOL (Qberkeley_db);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
841 DEFSYMBOL (Qhash);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
842 DEFSYMBOL (Qbtree);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
843 DEFSYMBOL (Qrecno);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
844 #if DB_VERSION_MAJOR > 2
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
845 DEFSYMBOL (Qqueue);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
846 #endif
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
847 DEFSYMBOL (Qunknown);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 DEFSUBR (Fopen_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 DEFSUBR (Fdatabasep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 DEFSUBR (Fmapdatabase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 DEFSUBR (Fput_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 DEFSUBR (Fget_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 DEFSUBR (Fremove_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 DEFSUBR (Fdatabase_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 DEFSUBR (Fdatabase_subtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 DEFSUBR (Fdatabase_last_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 DEFSUBR (Fdatabase_live_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 DEFSUBR (Fdatabase_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 DEFSUBR (Fclose_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 vars_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 Fprovide (Qdbm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 Fprovide (Qberkeley_db);
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 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
875 Default coding system used to convert data in database files.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
877 Vdatabase_coding_system = Qnative;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 }