xapian: Wrap MSet-snippet.

* xapian/xapian.scm (get-flag, mset-snippet): New functions.

1 files changed, 20 insertions, 1 deletions

diff --git a/xapian/xapian.scm b/xapian/xapian.scm
index 8c19c80..92bf5d3 100644
--- a/xapian/xapian.scm
+++ b/xapian/xapian.scm
@@ -18,6 +18,7 @@
 ;;; <https://www.gnu.org/licenses/>.
 
 (define-module (xapian xapian)
+  #:use-module (rnrs arithmetic bitwise)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-26)
   #:use-module (xapian wrap)
@@ -44,7 +45,8 @@
             mset-item-document
             mset-item-rank
             mset-item-weight
-            mset-fold))
+            mset-fold
+            mset-snippet))
 
 (define xapian-open new-Database)
 (define xapian-close delete-Database)
@@ -141,3 +143,20 @@ on the database object."
      (else (let ((result (proc head result)))
              (MSetIterator-next head)
              (loop head result))))))
+
+(define (get-flag flag-thunk value)
+  (if value (flag-thunk) 0))
+
+;; TODO: Support cjk-words?
+(define* (mset-snippet mset text
+                       #:key (length 500) (stemmer (make-stem "none"))
+                       (highlight-start "<b>") (highlight-end "</b>") (omit "...")
+                       (background-model? #t) (exhaustive? #t)
+                       (empty-without-match? #t)
+                       (cjk-ngram? #t))
+  (MSet-snippet mset text length stemmer
+                (bitwise-ior (get-flag MSet-SNIPPET-BACKGROUND-MODEL background-model?)
+                             (get-flag MSet-SNIPPET-EXHAUSTIVE exhaustive?)
+                             (get-flag MSet-SNIPPET-EMPTY-WITHOUT-MATCH empty-without-match?)
+                             (get-flag MSet-SNIPPET-CJK-NGRAM cjk-ngram?))
+                highlight-start highlight-end omit))