From 551f6bea36c0f3f4f44667998f29ebdd0c3bb1bf Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 7 May 2024 23:29:58 +0100
Subject: xapian: Support common query parser flags.

* xapian/xapian.scm (parse-query): Add boolean?, phrases?, love-hate?,
any-case-boolean?, wildcard? flags.
---
 xapian/xapian.scm | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

(limited to 'xapian')

diff --git a/xapian/xapian.scm b/xapian/xapian.scm
index 6ab879c..d219c30 100644
--- a/xapian/xapian.scm
+++ b/xapian/xapian.scm
@@ -166,7 +166,18 @@ generated."
 
 (define increase-termpos! TermGenerator-increase-termpos)
 
-(define* (parse-query querystring #:key stemmer stemming-strategy (prefixes '()) (boolean-prefixes '()) (range-processors '()))
+(define* (parse-query querystring
+                      #:key
+                      stemmer
+                      stemming-strategy
+                      (prefixes '())
+                      (boolean-prefixes '())
+                      (range-processors '())
+                      (boolean? #t)
+                      (phrases? #t)
+                      (love-hate? #t)
+                      any-case-boolean?
+                      wildcard?)
   (let ((queryparser (new-QueryParser)))
     (QueryParser-set-stemmer queryparser stemmer)
     (when stemming-strategy
@@ -181,7 +192,13 @@ generated."
               boolean-prefixes)
     (for-each (cut QueryParser-add-rangeprocessor queryparser <>)
               range-processors)
-    (let ((query (QueryParser-parse-query queryparser querystring)))
+    (let ((query (QueryParser-parse-query queryparser
+                                          querystring
+                                          (bitwise-ior (get-flag QueryParser-FLAG-BOOLEAN boolean?)
+                                                       (get-flag QueryParser-FLAG-PHRASE phrases?)
+                                                       (get-flag QueryParser-FLAG-LOVEHATE love-hate?)
+                                                       (get-flag QueryParser-FLAG-BOOLEAN-ANY-CASE any-case-boolean?)
+                                                       (get-flag QueryParser-FLAG-WILDCARD wildcard?)))))
       (delete-QueryParser queryparser)
       query)))
 
-- 
cgit v1.2.3