(lmdb low-level): Allow passing of flags to mdb-env-open

1 files changed, 28 insertions, 2 deletions

diff --git a/lmdb/low-level.scm b/lmdb/low-level.scm
index 7cb14d2..ee6c684 100644
--- a/lmdb/low-level.scm
+++ b/lmdb/low-level.scm
@@ -43,6 +43,18 @@
             mdb-env-open
             mdb-env-close
 
+            MDB_FIXEDMAP
+            MDB_NOSUBDIR
+            MDB_NOSYNC
+            MDB_RDONLY
+            MDB_NOMETASYNC
+            MDB_WRITEMAP
+            MDB_MAPASYNC
+            MDB_NOTLS
+            MDB_NOLOCK
+            MDB_NORDAHEAD
+            MDB_NOMEMINIT
+
             <mdb-txn>
             mdb-txn?
             mdb-txn-begin
@@ -140,7 +152,7 @@
         (wrap-mdb-env (dereference-pointer mdb-env-ptr))
         return-value)))
 
-(define (mdb-env-open mdb-env path)
+(define* (mdb-env-open mdb-env path #:key (flags 0) (mode #o644))
   "Open an environment handle"
   (let ((proc (liblmdb-func "mdb_env_open"
                             (list
@@ -152,13 +164,27 @@
                              unsigned-int
                              ;; mdb_mode_t mode (int)
                              int))))
-    (proc (unwrap-mdb-env mdb-env) (string->pointer path) 0 #o644)))
+    (proc (unwrap-mdb-env mdb-env) (string->pointer path) flags mode)))
 
 (define (mdb-env-close mdb-env)
   "Close the environment and release the memory map"
   (let ((proc (liblmdb-void-func "mdb_env_close" (list '*))))
     (proc (unwrap-mdb-env mdb-env))))
 
+;; Environment Flags
+
+(define MDB_FIXEDMAP #x01)
+(define MDB_NOSUBDIR #x4000)
+(define MDB_NOSYNC #x10000)
+(define MDB_RDONLY #x20000)
+(define MDB_NOMETASYNC #x40000)
+(define MDB_WRITEMAP #x80000)
+(define MDB_MAPASYNC #x100000)
+(define MDB_NOTLS #x200000)
+(define MDB_NOLOCK #x400000)
+(define MDB_NORDAHEAD #x800000)
+(define MDB_NOMEMINIT #x1000000)
+
 ;; MDB_txn
 
 (define-wrapped-pointer-type <mdb-txn>