Mercurial > hg > xemacs-beta
annotate src/database.c @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | b5df3737028a |
| children | f965e31a35f0 |
| rev | line source |
|---|---|
| 428 | 1 /* Database access routines |
| 2 Copyright (C) 1996, William M. Perry | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3 Copyright (C) 2001, 2002, 2005, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 /* Written by Bill Perry */ | |
| 25 /* Substantially rewritten by Martin Buchholz */ | |
| 26 /* db 2.x support added by Andreas Jaeger */ | |
| 771 | 27 /* Mule-ized 6-22-00 Ben Wing */ |
| 428 | 28 |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 771 | 31 |
| 428 | 32 #include "sysfile.h" |
| 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 | 35 |
| 36 #ifndef HAVE_DATABASE | |
| 37 #error HAVE_DATABASE not defined!! | |
| 38 #endif | |
| 39 | |
| 40 #include "database.h" /* Our include file */ | |
| 41 | |
| 42 #ifdef HAVE_BERKELEY_DB | |
| 43 /* Work around Berkeley DB's use of int types which are defined | |
| 44 slightly differently in the not quite yet standard <inttypes.h>. | |
| 45 See db.h for details of why we're resorting to this... */ | |
| 46 /* glibc 2.1 doesn't have this problem with DB 2.x */ | |
| 47 #if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) | |
| 48 #ifdef HAVE_INTTYPES_H | |
| 3739 | 49 #ifndef __BIT_TYPES_DEFINED__ |
| 428 | 50 #define __BIT_TYPES_DEFINED__ |
| 3739 | 51 #endif |
| 428 | 52 #include <inttypes.h> |
| 3739 | 53 #if !HAVE_U_INT8_T |
| 428 | 54 typedef uint8_t u_int8_t; |
| 3739 | 55 #endif |
| 56 #if !HAVE_U_INT16_T | |
| 428 | 57 typedef uint16_t u_int16_t; |
| 3739 | 58 #endif |
| 59 #if !HAVE_U_INT32_T | |
| 428 | 60 typedef uint32_t u_int32_t; |
| 3739 | 61 #endif |
| 428 | 62 #ifdef WE_DONT_NEED_QUADS |
| 3739 | 63 #if !HAVE_U_INT64_T |
| 428 | 64 typedef uint64_t u_int64_t; |
| 3739 | 65 #endif |
| 428 | 66 #endif /* WE_DONT_NEED_QUADS */ |
| 67 #endif /* HAVE_INTTYPES_H */ | |
| 68 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */ | |
| 1460 | 69 /* Berkeley DB wants __STDC__ to be defined; else if does `#define const' */ |
| 70 #if ! defined (__STDC__) && ! defined(__cplusplus) | |
| 71 #define __STDC__ 0 | |
| 72 #endif | |
| 442 | 73 #include DB_H_FILE /* Berkeley db's header file */ |
| 428 | 74 #ifndef DB_VERSION_MAJOR |
| 75 # define DB_VERSION_MAJOR 1 | |
| 76 #endif /* DB_VERSION_MAJOR */ | |
| 1141 | 77 #ifndef DB_VERSION_MINOR |
| 78 # define DB_VERSION_MINOR 0 | |
| 79 #endif /* DB_VERSION_MINOR */ | |
| 428 | 80 Lisp_Object Qberkeley_db; |
| 81 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown; | |
| 448 | 82 #if DB_VERSION_MAJOR > 2 |
| 83 Lisp_Object Qqueue; | |
| 84 #endif | |
| 428 | 85 #endif /* HAVE_BERKELEY_DB */ |
| 86 | |
| 87 #ifdef HAVE_DBM | |
|
4991
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
88 # ifdef TRUST_NDBM_H_PROTOTYPES |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
89 # include NDBM_H_FILE |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
90 # else /* not TRUST_NDBM_H_PROTOTYPES */ |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
91 |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
92 /* The prototypes in gdbm/ndbm.h currently are broken when compiling |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
93 using C++, since they are of the form `datum dbm_firstkey()', without any |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
94 args given. */ |
|
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
95 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
96 #if defined(__cplusplus) || defined(c_plusplus) |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
97 extern "C" { |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
98 #endif |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
99 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
100 /* Parameters to dbm_store for simple insertion or replacement. */ |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
101 #define DBM_INSERT 0 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
102 #define DBM_REPLACE 1 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
103 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
104 /* The data and key structure. This structure is defined for compatibility. */ |
|
4991
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
105 typedef struct |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
106 { |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
107 char *dptr; |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
108 int dsize; |
|
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
109 } datum; |
|
4824
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
110 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
111 /* The file information header. This is good enough for most applications. */ |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
112 typedef struct {int dummy[10];} DBM; |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
113 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
114 int dbm_clearerr(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
115 void dbm_close(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
116 int dbm_delete(DBM *, datum); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
117 int dbm_error(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
118 datum dbm_fetch(DBM *, datum); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
119 datum dbm_firstkey(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
120 datum dbm_nextkey(DBM *); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
121 DBM *dbm_open(const char *, int, mode_t); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
122 int dbm_store(DBM *, datum, datum, int); |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
123 |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
124 #if defined(__cplusplus) || defined(c_plusplus) |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
125 } |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
126 #endif |
|
c12b646d84ee
changes to get things to compile under latest cygwin
Ben Wing <ben@xemacs.org>
parents:
4699
diff
changeset
|
127 |
|
4991
97c45e3ad810
implement configure test for whether ndbm.h prototypes are broken
Ben Wing <ben@xemacs.org>
parents:
4981
diff
changeset
|
128 # endif /* (not) TRUST_NDBM_H_PROTOTYPES */ |
| 428 | 129 Lisp_Object Qdbm; |
| 130 #endif /* HAVE_DBM */ | |
| 131 | |
| 132 Lisp_Object Vdatabase_coding_system; | |
| 133 | |
| 134 Lisp_Object Qdatabasep; | |
| 135 | |
| 136 typedef struct | |
| 137 { | |
| 138 Lisp_Object (*get_subtype) (Lisp_Database *); | |
| 139 Lisp_Object (*get_type) (Lisp_Database *); | |
| 140 Lisp_Object (*get) (Lisp_Database *, Lisp_Object); | |
| 141 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object); | |
| 142 int (*rem) (Lisp_Database *, Lisp_Object); | |
| 143 void (*map) (Lisp_Database *, Lisp_Object); | |
| 144 void (*close) (Lisp_Database *); | |
| 145 Lisp_Object (*last_error) (Lisp_Database *); | |
| 146 } DB_FUNCS; | |
| 147 | |
| 148 struct Lisp_Database | |
| 149 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
150 NORMAL_LISP_OBJECT_HEADER header; |
| 428 | 151 Lisp_Object fname; |
| 152 int mode; | |
| 153 int access_; | |
| 154 int dberrno; | |
| 155 int live_p; | |
| 156 #ifdef HAVE_DBM | |
| 157 DBM *dbm_handle; | |
| 158 #endif | |
| 159 #ifdef HAVE_BERKELEY_DB | |
| 160 DB *db_handle; | |
| 161 #endif | |
| 162 DB_FUNCS *funcs; | |
| 163 Lisp_Object coding_system; | |
| 164 }; | |
| 165 | |
| 166 #define XDATABASE(x) XRECORD (x, database, Lisp_Database) | |
| 617 | 167 #define wrap_database(p) wrap_record (p, database) |
| 428 | 168 #define DATABASEP(x) RECORDP (x, database) |
| 169 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) | |
| 170 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) | |
| 171 #define DATABASE_LIVE_P(x) (x->live_p) | |
| 172 | |
| 173 #define CHECK_LIVE_DATABASE(db) do { \ | |
| 174 CHECK_DATABASE (db); \ | |
| 175 if (!DATABASE_LIVE_P (XDATABASE(db))) \ | |
| 563 | 176 invalid_operation ("Attempting to access closed database", db); \ |
| 428 | 177 } while (0) |
| 178 | |
| 179 | |
| 180 static Lisp_Database * | |
| 181 allocate_database (void) | |
| 182 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
183 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (database); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3072
diff
changeset
|
184 Lisp_Database *db = XDATABASE (obj); |
| 428 | 185 |
| 186 db->fname = Qnil; | |
| 187 db->live_p = 0; | |
| 188 #ifdef HAVE_BERKELEY_DB | |
| 189 db->db_handle = NULL; | |
| 190 #endif | |
| 191 #ifdef HAVE_DBM | |
| 192 db->dbm_handle = NULL; | |
| 193 #endif | |
| 194 db->access_ = 0; | |
| 195 db->mode = 0; | |
| 196 db->dberrno = 0; | |
| 771 | 197 db->coding_system = Qnil; |
| 428 | 198 return db; |
| 199 } | |
| 200 | |
| 1204 | 201 static const struct memory_description database_description[] = { |
| 934 | 202 { XD_LISP_OBJECT, offsetof (struct Lisp_Database, fname) }, |
| 203 { XD_END} | |
| 204 }; | |
| 205 | |
| 428 | 206 static Lisp_Object |
| 444 | 207 mark_database (Lisp_Object object) |
| 428 | 208 { |
| 444 | 209 Lisp_Database *db = XDATABASE (object); |
| 428 | 210 return db->fname; |
| 211 } | |
| 212 | |
| 213 static void | |
| 2286 | 214 print_database (Lisp_Object obj, Lisp_Object printcharfun, |
| 215 int UNUSED (escapeflag)) | |
| 428 | 216 { |
| 217 Lisp_Database *db = XDATABASE (obj); | |
| 218 | |
| 219 if (print_readably) | |
| 4846 | 220 printing_unreadable_lcrecord (obj, 0); |
| 428 | 221 |
| 793 | 222 write_fmt_string_lisp (printcharfun, "#<database \"%s\" (%s/%s/", |
| 223 3, db->fname, db->funcs->get_type (db), | |
| 224 db->funcs->get_subtype (db)); | |
| 225 | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
226 write_fmt_string (printcharfun, "%s) ", |
| 793 | 227 (!DATABASE_LIVE_P (db) ? "closed" : |
| 228 (db->access_ & O_WRONLY) ? "writeonly" : | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
229 (db->access_ & O_RDWR) ? "readwrite" : "readonly")); |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
230 |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
231 write_fmt_string_lisp (printcharfun, "coding: %s ", 1, |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
232 XSYMBOL_NAME (XCODING_SYSTEM_NAME |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
233 (db->coding_system))); |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
234 |
|
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
235 write_fmt_string (printcharfun, "0x%x>", db->header.uid); |
| 428 | 236 } |
| 237 | |
| 238 static void | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
239 finalize_database (Lisp_Object obj) |
| 428 | 240 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
241 Lisp_Database *db = XDATABASE (obj); |
| 428 | 242 |
| 243 db->funcs->close (db); | |
| 244 } | |
| 245 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
246 DEFINE_NODUMP_LISP_OBJECT ("database", database, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
247 mark_database, print_database, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
248 finalize_database, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
249 database_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
250 Lisp_Database); |
| 428 | 251 |
| 252 DEFUN ("close-database", Fclose_database, 1, 1, 0, /* | |
| 253 Close database DATABASE. | |
| 254 */ | |
| 255 (database)) | |
| 256 { | |
| 257 Lisp_Database *db; | |
| 258 CHECK_LIVE_DATABASE (database); | |
| 259 db = XDATABASE (database); | |
| 260 db->funcs->close (db); | |
| 261 db->live_p = 0; | |
| 262 return Qnil; | |
| 263 } | |
| 264 | |
| 265 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /* | |
| 266 Return the type of database DATABASE. | |
| 267 */ | |
| 268 (database)) | |
| 269 { | |
| 270 CHECK_DATABASE (database); | |
| 271 | |
| 272 return XDATABASE (database)->funcs->get_type (XDATABASE (database)); | |
| 273 } | |
| 274 | |
| 275 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* | |
| 276 Return the subtype of database DATABASE, if any. | |
| 277 */ | |
| 278 (database)) | |
| 279 { | |
| 280 CHECK_DATABASE (database); | |
| 281 | |
| 282 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database)); | |
| 283 } | |
| 284 | |
| 285 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* | |
| 444 | 286 Return t if OBJECT is an active database. |
| 428 | 287 */ |
| 444 | 288 (object)) |
| 428 | 289 { |
| 444 | 290 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ? |
| 291 Qt : Qnil; | |
| 428 | 292 } |
| 293 | |
| 294 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* | |
| 295 Return the filename associated with the database DATABASE. | |
| 296 */ | |
| 297 (database)) | |
| 298 { | |
| 299 CHECK_DATABASE (database); | |
| 300 | |
| 301 return XDATABASE (database)->fname; | |
| 302 } | |
| 303 | |
| 304 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* | |
| 444 | 305 Return t if OBJECT is a database. |
| 428 | 306 */ |
| 444 | 307 (object)) |
| 428 | 308 { |
| 444 | 309 return DATABASEP (object) ? Qt : Qnil; |
| 428 | 310 } |
| 311 | |
| 312 #ifdef HAVE_DBM | |
| 313 static void | |
| 314 dbm_map (Lisp_Database *db, Lisp_Object func) | |
| 315 { | |
| 316 datum keydatum, valdatum; | |
| 317 Lisp_Object key, val; | |
| 318 | |
| 319 for (keydatum = dbm_firstkey (db->dbm_handle); | |
| 320 keydatum.dptr != NULL; | |
| 321 keydatum = dbm_nextkey (db->dbm_handle)) | |
| 322 { | |
| 323 valdatum = dbm_fetch (db->dbm_handle, keydatum); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
324 key = make_extstring ((Extbyte *) keydatum.dptr, keydatum.dsize, |
| 771 | 325 db->coding_system); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
326 val = make_extstring ((Extbyte *) valdatum.dptr, valdatum.dsize, |
| 771 | 327 db->coding_system); |
| 428 | 328 call2 (func, key, val); |
| 329 } | |
| 330 } | |
| 331 | |
| 332 static Lisp_Object | |
| 333 dbm_get (Lisp_Database *db, Lisp_Object key) | |
| 334 { | |
| 335 datum keydatum, valdatum; | |
| 336 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
337 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
338 db->coding_system); |
| 428 | 339 valdatum = dbm_fetch (db->dbm_handle, keydatum); |
| 340 | |
| 341 return (valdatum.dptr | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
342 ? make_extstring ((Extbyte *) valdatum.dptr, valdatum.dsize, |
| 771 | 343 db->coding_system) |
| 428 | 344 : Qnil); |
| 345 } | |
| 346 | |
| 347 static int | |
| 348 dbm_put (Lisp_Database *db, | |
| 349 Lisp_Object key, Lisp_Object val, Lisp_Object replace) | |
| 350 { | |
| 351 datum keydatum, valdatum; | |
| 352 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
353 LISP_STRING_TO_SIZED_EXTERNAL (val, valdatum.dptr, valdatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
354 db->coding_system); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
355 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
356 db->coding_system); |
| 428 | 357 |
| 358 return !dbm_store (db->dbm_handle, keydatum, valdatum, | |
| 359 NILP (replace) ? DBM_INSERT : DBM_REPLACE); | |
| 360 } | |
| 361 | |
| 362 static int | |
| 363 dbm_remove (Lisp_Database *db, Lisp_Object key) | |
| 364 { | |
| 365 datum keydatum; | |
| 366 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
367 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.dptr, keydatum.dsize, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
368 db->coding_system); |
| 428 | 369 |
| 370 return dbm_delete (db->dbm_handle, keydatum); | |
| 371 } | |
| 372 | |
| 373 static Lisp_Object | |
| 2494 | 374 dbm_type (Lisp_Database *UNUSED (db)) |
| 428 | 375 { |
| 376 return Qdbm; | |
| 377 } | |
| 378 | |
| 379 static Lisp_Object | |
| 2494 | 380 dbm_subtype (Lisp_Database *UNUSED (db)) |
| 428 | 381 { |
| 382 return Qnil; | |
| 383 } | |
| 384 | |
| 385 static Lisp_Object | |
| 386 dbm_lasterr (Lisp_Database *db) | |
| 387 { | |
| 388 return lisp_strerror (db->dberrno); | |
| 389 } | |
| 390 | |
| 391 static void | |
| 392 dbm_closeit (Lisp_Database *db) | |
| 393 { | |
| 394 if (db->dbm_handle) | |
| 395 { | |
| 396 dbm_close (db->dbm_handle); | |
| 397 db->dbm_handle = NULL; | |
| 398 } | |
| 399 } | |
| 400 | |
| 401 static DB_FUNCS ndbm_func_block = | |
| 402 { | |
| 403 dbm_subtype, | |
| 404 dbm_type, | |
| 405 dbm_get, | |
| 406 dbm_put, | |
| 407 dbm_remove, | |
| 408 dbm_map, | |
| 409 dbm_closeit, | |
| 410 dbm_lasterr | |
| 411 }; | |
| 412 #endif /* HAVE_DBM */ | |
| 413 | |
| 414 #ifdef HAVE_BERKELEY_DB | |
| 415 static Lisp_Object | |
| 2286 | 416 berkdb_type (Lisp_Database *UNUSED (db)) |
| 428 | 417 { |
| 418 return Qberkeley_db; | |
| 419 } | |
| 420 | |
| 421 static Lisp_Object | |
| 422 berkdb_subtype (Lisp_Database *db) | |
| 423 { | |
| 424 if (!db->db_handle) | |
| 425 return Qnil; | |
| 426 | |
| 427 switch (db->db_handle->type) | |
| 428 { | |
| 429 case DB_BTREE: return Qbtree; | |
| 430 case DB_HASH: return Qhash; | |
| 431 case DB_RECNO: return Qrecno; | |
| 448 | 432 #if DB_VERSION_MAJOR > 2 |
| 433 case DB_QUEUE: return Qqueue; | |
| 434 #endif | |
| 428 | 435 default: return Qunknown; |
| 436 } | |
| 437 } | |
| 438 | |
| 439 static Lisp_Object | |
| 440 berkdb_lasterr (Lisp_Database *db) | |
| 441 { | |
| 442 return lisp_strerror (db->dberrno); | |
| 443 } | |
| 444 | |
| 445 static Lisp_Object | |
| 446 berkdb_get (Lisp_Database *db, Lisp_Object key) | |
| 447 { | |
| 448 DBT keydatum, valdatum; | |
| 449 int status = 0; | |
| 450 | |
| 451 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
| 452 xzero (keydatum); | |
| 453 xzero (valdatum); | |
| 454 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
455 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
456 db->coding_system); |
| 428 | 457 |
| 458 #if DB_VERSION_MAJOR == 1 | |
| 459 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0); | |
| 460 #else | |
| 461 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); | |
| 462 #endif /* DB_VERSION_MAJOR */ | |
| 463 | |
| 464 if (!status) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
465 return make_extstring ((const Extbyte *) valdatum.data, valdatum.size, |
| 771 | 466 db->coding_system); |
| 428 | 467 |
| 468 #if DB_VERSION_MAJOR == 1 | |
| 469 db->dberrno = (status == 1) ? -1 : errno; | |
| 470 #else | |
| 471 db->dberrno = (status < 0) ? -1 : errno; | |
| 472 #endif /* DB_VERSION_MAJOR */ | |
| 473 | |
| 474 return Qnil; | |
| 475 } | |
| 476 | |
| 477 static int | |
| 478 berkdb_put (Lisp_Database *db, | |
| 479 Lisp_Object key, | |
| 480 Lisp_Object val, | |
| 481 Lisp_Object replace) | |
| 482 { | |
| 483 DBT keydatum, valdatum; | |
| 484 int status = 0; | |
| 485 | |
| 486 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
| 487 xzero (keydatum); | |
| 488 xzero (valdatum); | |
| 489 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
490 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
491 db->coding_system); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
492 LISP_STRING_TO_SIZED_EXTERNAL (val, valdatum.data, valdatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
493 db->coding_system); |
| 428 | 494 #if DB_VERSION_MAJOR == 1 |
| 495 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum, | |
| 496 NILP (replace) ? R_NOOVERWRITE : 0); | |
| 497 db->dberrno = (status == 1) ? -1 : errno; | |
| 498 #else | |
| 499 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum, | |
| 500 NILP (replace) ? DB_NOOVERWRITE : 0); | |
| 501 db->dberrno = (status < 0) ? -1 : errno; | |
| 502 #endif/* DV_VERSION_MAJOR = 2 */ | |
| 503 | |
| 504 return status; | |
| 505 } | |
| 506 | |
| 507 static int | |
| 508 berkdb_remove (Lisp_Database *db, Lisp_Object key) | |
| 509 { | |
| 510 DBT keydatum; | |
| 511 int status; | |
| 512 | |
| 513 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
| 514 xzero (keydatum); | |
| 515 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
516 LISP_STRING_TO_SIZED_EXTERNAL (key, keydatum.data, keydatum.size, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
517 db->coding_system); |
| 428 | 518 |
| 519 #if DB_VERSION_MAJOR == 1 | |
| 520 status = db->db_handle->del (db->db_handle, &keydatum, 0); | |
| 521 #else | |
| 522 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0); | |
| 523 #endif /* DB_VERSION_MAJOR */ | |
| 524 | |
| 525 if (!status) | |
| 526 return 0; | |
| 527 | |
| 528 #if DB_VERSION_MAJOR == 1 | |
| 529 db->dberrno = (status == 1) ? -1 : errno; | |
| 530 #else | |
| 531 db->dberrno = (status < 0) ? -1 : errno; | |
| 532 #endif /* DB_VERSION_MAJOR */ | |
| 533 | |
| 534 return 1; | |
| 535 } | |
| 536 | |
| 537 static void | |
| 538 berkdb_map (Lisp_Database *db, Lisp_Object func) | |
| 539 { | |
| 540 DBT keydatum, valdatum; | |
| 541 Lisp_Object key, val; | |
| 542 DB *dbp = db->db_handle; | |
| 543 int status; | |
| 544 | |
| 545 xzero (keydatum); | |
| 546 xzero (valdatum); | |
| 547 | |
| 548 #if DB_VERSION_MAJOR == 1 | |
| 549 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); | |
| 550 status == 0; | |
| 551 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) | |
| 552 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
553 key = make_extstring ((const Extbyte *) keydatum.data, keydatum.size, |
| 771 | 554 db->coding_system); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
555 val = make_extstring ((const Extbyte *) valdatum.data, valdatum.size, |
| 771 | 556 db->coding_system); |
| 428 | 557 call2 (func, key, val); |
| 558 } | |
| 559 #else | |
| 560 { | |
| 561 DBC *dbcp; | |
| 562 | |
| 563 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6 | |
| 564 status = dbp->cursor (dbp, NULL, &dbcp, 0); | |
| 565 #else | |
| 566 status = dbp->cursor (dbp, NULL, &dbcp); | |
| 440 | 567 #endif |
| 428 | 568 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); |
| 569 status == 0; | |
| 570 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) | |
| 571 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
572 key = make_extstring ((const Extbyte *) keydatum.data, keydatum.size, |
| 771 | 573 db->coding_system); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
574 val = make_extstring ((const Extbyte *) valdatum.data, valdatum.size, |
| 771 | 575 db->coding_system); |
| 428 | 576 call2 (func, key, val); |
| 577 } | |
| 578 dbcp->c_close (dbcp); | |
| 579 } | |
| 580 #endif /* DB_VERSION_MAJOR */ | |
| 581 } | |
| 582 | |
| 583 static void | |
| 584 berkdb_close (Lisp_Database *db) | |
| 585 { | |
| 586 if (db->db_handle) | |
| 587 { | |
| 588 #if DB_VERSION_MAJOR == 1 | |
| 589 db->db_handle->sync (db->db_handle, 0); | |
| 590 db->db_handle->close (db->db_handle); | |
| 591 #else | |
| 592 db->db_handle->sync (db->db_handle, 0); | |
| 593 db->db_handle->close (db->db_handle, 0); | |
| 594 #endif /* DB_VERSION_MAJOR */ | |
| 595 db->db_handle = NULL; | |
| 596 } | |
| 597 } | |
| 598 | |
| 599 static DB_FUNCS berk_func_block = | |
| 600 { | |
| 601 berkdb_subtype, | |
| 602 berkdb_type, | |
| 603 berkdb_get, | |
| 604 berkdb_put, | |
| 605 berkdb_remove, | |
| 606 berkdb_map, | |
| 607 berkdb_close, | |
| 608 berkdb_lasterr | |
| 609 }; | |
| 610 #endif /* HAVE_BERKELEY_DB */ | |
| 611 | |
| 612 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /* | |
| 613 Return the last error associated with DATABASE. | |
| 614 */ | |
| 615 (database)) | |
| 616 { | |
| 617 if (NILP (database)) | |
| 618 return lisp_strerror (errno); | |
| 619 | |
| 620 CHECK_DATABASE (database); | |
| 621 | |
| 622 return XDATABASE (database)->funcs->last_error (XDATABASE (database)); | |
| 623 } | |
| 624 | |
| 771 | 625 DEFUN ("open-database", Fopen_database, 1, 6, 0, /* |
| 428 | 626 Return a new database object opened on FILE. |
| 627 Optional arguments TYPE and SUBTYPE specify the database type. | |
| 628 Optional argument ACCESS specifies the access rights, which may be any | |
| 629 combination of 'r' 'w' and '+', for read, write, and creation flags. | |
| 630 Optional argument MODE gives the permissions to use when opening FILE, | |
| 631 and defaults to 0755. | |
| 771 | 632 Optional argument CODESYS specifies the coding system used to encode/decode |
| 633 data passed to/from the database, and defaults to the value of the | |
| 634 variable `database-coding-system'. | |
| 428 | 635 */ |
| 771 | 636 (file, type, subtype, access_, mode, codesys)) |
| 428 | 637 { |
| 638 /* This function can GC */ | |
| 639 int modemask; | |
| 640 int accessmask = 0; | |
| 641 Lisp_Database *db = NULL; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
642 Extbyte *filename; |
| 428 | 643 struct gcpro gcpro1, gcpro2; |
| 644 | |
| 645 CHECK_STRING (file); | |
| 646 GCPRO2 (file, access_); | |
| 647 file = Fexpand_file_name (file, Qnil); | |
| 648 UNGCPRO; | |
| 649 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
650 LISP_PATHNAME_CONVERT_OUT (file, filename); |
| 428 | 651 |
| 652 if (NILP (access_)) | |
| 653 { | |
| 654 accessmask = O_RDWR | O_CREAT; | |
| 655 } | |
| 656 else | |
| 657 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
658 Ibyte *acc; |
| 428 | 659 CHECK_STRING (access_); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
660 acc = XSTRING_DATA (access_); |
| 428 | 661 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
662 if (qxestrchr (acc, '+')) |
| 428 | 663 accessmask |= O_CREAT; |
| 664 | |
| 665 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
666 int rp = !!qxestrchr (acc, 'r'); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
667 int wp = !!qxestrchr (acc, 'w'); |
| 428 | 668 if (rp && wp) accessmask |= O_RDWR; |
| 669 else if (wp) accessmask |= O_WRONLY; | |
| 670 else accessmask |= O_RDONLY; | |
| 671 } | |
| 672 } | |
| 673 | |
| 674 if (NILP (mode)) | |
| 675 { | |
| 676 modemask = 0755; /* rwxr-xr-x */ | |
| 677 } | |
| 678 else | |
| 679 { | |
| 680 CHECK_INT (mode); | |
| 681 modemask = XINT (mode); | |
| 682 } | |
| 683 | |
| 771 | 684 if (NILP (codesys)) |
| 685 codesys = Vdatabase_coding_system; | |
| 686 | |
|
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
687 codesys = get_coding_system_for_text_file (codesys, 0); |
| 771 | 688 |
| 428 | 689 #ifdef HAVE_DBM |
| 690 if (NILP (type) || EQ (type, Qdbm)) | |
| 691 { | |
| 692 DBM *dbase = dbm_open (filename, accessmask, modemask); | |
| 693 if (!dbase) | |
| 694 return Qnil; | |
| 695 | |
| 696 db = allocate_database (); | |
| 697 db->dbm_handle = dbase; | |
| 698 db->funcs = &ndbm_func_block; | |
| 771 | 699 db->coding_system = codesys; |
| 428 | 700 goto db_done; |
| 701 } | |
| 702 #endif /* HAVE_DBM */ | |
| 703 | |
| 704 #ifdef HAVE_BERKELEY_DB | |
| 705 if (NILP (type) || EQ (type, Qberkeley_db)) | |
| 706 { | |
| 707 DBTYPE real_subtype; | |
| 708 DB *dbase; | |
| 709 #if DB_VERSION_MAJOR != 1 | |
| 710 int status; | |
| 711 #endif | |
| 712 | |
| 713 if (EQ (subtype, Qhash) || NILP (subtype)) | |
| 714 real_subtype = DB_HASH; | |
| 715 else if (EQ (subtype, Qbtree)) | |
| 716 real_subtype = DB_BTREE; | |
| 717 else if (EQ (subtype, Qrecno)) | |
| 718 real_subtype = DB_RECNO; | |
| 448 | 719 #if DB_VERSION_MAJOR > 2 |
| 720 else if (EQ (subtype, Qqueue)) | |
| 721 real_subtype = DB_QUEUE; | |
| 722 #endif | |
| 428 | 723 else |
| 563 | 724 invalid_constant ("Unsupported subtype", subtype); |
| 428 | 725 |
| 726 #if DB_VERSION_MAJOR == 1 | |
| 727 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL); | |
| 728 if (!dbase) | |
| 729 return Qnil; | |
| 730 #else | |
| 731 /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY, | |
| 732 other flags shouldn't be set */ | |
| 733 if (NILP (access_)) | |
| 734 accessmask = DB_CREATE; | |
| 735 else | |
| 736 { | |
| 737 char *acc; | |
| 738 CHECK_STRING (access_); | |
| 739 acc = (char *) XSTRING_DATA (access_); | |
| 740 accessmask = 0; | |
| 741 | |
| 742 if (strchr (acc, '+')) | |
| 743 accessmask |= DB_CREATE; | |
| 744 | |
| 745 if (strchr (acc, 'r') && !strchr (acc, 'w')) | |
| 746 accessmask |= DB_RDONLY; | |
| 747 } | |
| 448 | 748 #if DB_VERSION_MAJOR == 2 |
| 428 | 749 status = db_open (filename, real_subtype, accessmask, |
| 750 modemask, NULL , NULL, &dbase); | |
| 751 if (status) | |
| 752 return Qnil; | |
| 448 | 753 #else |
| 754 status = db_create (&dbase, NULL, 0); | |
| 755 if (status) | |
| 756 return Qnil; | |
| 1141 | 757 #if DB_VERSION_MAJOR < 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR < 1) |
| 448 | 758 status = dbase->open (dbase, filename, NULL, |
| 759 real_subtype, accessmask, modemask); | |
| 1141 | 760 #else /* DB_VERSION >= 4.1 */ |
| 1377 | 761 /* You can't use DB_AUTO_COMMIT unless you have a txn environment. */ |
| 1141 | 762 status = dbase->open (dbase, NULL, filename, NULL, real_subtype, |
| 1377 | 763 accessmask, modemask); |
| 1141 | 764 #endif /* DB_VERSION < 4.1 */ |
| 448 | 765 if (status) |
| 766 { | |
| 767 dbase->close (dbase, 0); | |
| 768 return Qnil; | |
| 769 } | |
| 770 #endif /* DB_VERSION_MAJOR > 2 */ | |
| 771 /* Normalize into system specific file modes. Only for printing */ | |
| 772 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR; | |
| 428 | 773 #endif /* DB_VERSION_MAJOR */ |
| 774 | |
| 775 db = allocate_database (); | |
| 776 db->db_handle = dbase; | |
| 777 db->funcs = &berk_func_block; | |
| 771 | 778 db->coding_system = codesys; |
| 428 | 779 goto db_done; |
| 780 } | |
| 781 #endif /* HAVE_BERKELEY_DB */ | |
| 782 | |
| 563 | 783 invalid_constant ("Unsupported database type", type); |
| 428 | 784 return Qnil; |
| 785 | |
| 786 db_done: | |
| 787 db->live_p = 1; | |
| 788 db->fname = file; | |
| 789 db->mode = modemask; | |
| 790 db->access_ = accessmask; | |
| 791 | |
| 793 | 792 return wrap_database (db); |
| 428 | 793 } |
| 794 | |
| 795 DEFUN ("put-database", Fput_database, 3, 4, 0, /* | |
| 796 Store KEY and VALUE in DATABASE. | |
| 797 If optional fourth arg REPLACE is non-nil, | |
| 798 replace any existing entry in the database. | |
| 799 */ | |
| 800 (key, value, database, replace)) | |
| 801 { | |
| 802 CHECK_LIVE_DATABASE (database); | |
| 803 CHECK_STRING (key); | |
| 804 CHECK_STRING (value); | |
| 805 { | |
| 806 Lisp_Database *db = XDATABASE (database); | |
| 807 int status = db->funcs->put (db, key, value, replace); | |
| 808 return status ? Qt : Qnil; | |
| 809 } | |
| 810 } | |
| 811 | |
| 812 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /* | |
| 813 Remove KEY from DATABASE. | |
| 814 */ | |
| 815 (key, database)) | |
| 816 { | |
| 817 CHECK_LIVE_DATABASE (database); | |
| 818 CHECK_STRING (key); | |
| 819 { | |
| 820 Lisp_Database *db = XDATABASE (database); | |
| 821 int status = db->funcs->rem (db, key); | |
| 822 return status ? Qt : Qnil; | |
| 823 } | |
| 824 } | |
| 825 | |
| 826 DEFUN ("get-database", Fget_database, 2, 3, 0, /* | |
| 827 Return value for KEY in DATABASE. | |
| 828 If there is no corresponding value, return DEFAULT (defaults to nil). | |
| 829 */ | |
| 830 (key, database, default_)) | |
| 831 { | |
| 832 CHECK_LIVE_DATABASE (database); | |
| 833 CHECK_STRING (key); | |
| 834 { | |
| 835 Lisp_Database *db = XDATABASE (database); | |
| 836 Lisp_Object retval = db->funcs->get (db, key); | |
| 837 return NILP (retval) ? default_ : retval; | |
| 838 } | |
| 839 } | |
| 840 | |
| 841 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* | |
| 842 Map FUNCTION over entries in DATABASE, calling it with two args, | |
| 843 each key and value in the database. | |
| 844 */ | |
| 845 (function, database)) | |
| 846 { | |
| 847 CHECK_LIVE_DATABASE (database); | |
| 848 | |
| 849 XDATABASE (database)->funcs->map (XDATABASE (database), function); | |
| 850 | |
| 851 return Qnil; | |
| 852 } | |
| 853 | |
| 854 void | |
| 855 syms_of_database (void) | |
| 856 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3072
diff
changeset
|
857 INIT_LISP_OBJECT (database); |
| 442 | 858 |
| 563 | 859 DEFSYMBOL (Qdatabasep); |
| 428 | 860 #ifdef HAVE_DBM |
| 563 | 861 DEFSYMBOL (Qdbm); |
| 428 | 862 #endif |
| 863 #ifdef HAVE_BERKELEY_DB | |
| 563 | 864 DEFSYMBOL (Qberkeley_db); |
| 865 DEFSYMBOL (Qhash); | |
| 866 DEFSYMBOL (Qbtree); | |
| 867 DEFSYMBOL (Qrecno); | |
| 448 | 868 #if DB_VERSION_MAJOR > 2 |
| 563 | 869 DEFSYMBOL (Qqueue); |
| 448 | 870 #endif |
| 563 | 871 DEFSYMBOL (Qunknown); |
| 428 | 872 #endif |
| 873 | |
| 874 DEFSUBR (Fopen_database); | |
| 875 DEFSUBR (Fdatabasep); | |
| 876 DEFSUBR (Fmapdatabase); | |
| 877 DEFSUBR (Fput_database); | |
| 878 DEFSUBR (Fget_database); | |
| 879 DEFSUBR (Fremove_database); | |
| 880 DEFSUBR (Fdatabase_type); | |
| 881 DEFSUBR (Fdatabase_subtype); | |
| 882 DEFSUBR (Fdatabase_last_error); | |
| 883 DEFSUBR (Fdatabase_live_p); | |
| 884 DEFSUBR (Fdatabase_file_name); | |
| 885 DEFSUBR (Fclose_database); | |
| 886 } | |
| 887 | |
| 888 void | |
| 889 vars_of_database (void) | |
| 890 { | |
| 891 #ifdef HAVE_DBM | |
| 892 Fprovide (Qdbm); | |
| 893 #endif | |
| 894 #ifdef HAVE_BERKELEY_DB | |
| 895 Fprovide (Qberkeley_db); | |
| 896 #endif | |
| 897 | |
| 898 DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /* | |
| 771 | 899 Default coding system used to convert data in database files. |
| 428 | 900 */ ); |
| 771 | 901 Vdatabase_coding_system = Qnative; |
| 428 | 902 } |