From 9a82c0ceb9824960ec8f9c560af8dad67afb0517 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sat, 4 May 2024 00:07:31 +0100
Subject: xapian: Wrap RangeProcessor.

* xapian.i.in (GuileXapianRangeProcessorWrapper): New class.
* xapian/xapian.scm (prefixed-range-processor,
suffixed-range-processor): New public functions.
---
 xapian.i.in       | 34 ++++++++++++++++++++++++++++++++++
 xapian/xapian.scm | 37 +++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+)

diff --git a/xapian.i.in b/xapian.i.in
index bc9991c..84695e9 100644
--- a/xapian.i.in
+++ b/xapian.i.in
@@ -142,6 +142,40 @@
   }
 }
 
+// Child class of Xapian::RangeProcessor that calls back to a
+// user-specified Scheme procedure to process fields.
+%{
+  class GuileXapianRangeProcessorWrapper
+    : public Xapian::RangeProcessor {
+  private:
+    SCM proc;
+  public:
+    GuileXapianRangeProcessorWrapper(Xapian::valueno slot, const std::string &str, unsigned flags, SCM _proc)
+      : Xapian::RangeProcessor(slot, str, flags) {
+      proc = _proc;
+    }
+    Xapian::Query operator()(const std::string &begin, const std::string &end) {
+      void *ptr;
+      int res = SWIG_ConvertPtr(scm_call_2(proc,
+                                           begin.empty() ? SCM_BOOL_F : scm_from_utf8_string(begin.c_str()),
+                                           end.empty() ? SCM_BOOL_F : scm_from_utf8_string(end.c_str())),
+                                &ptr,
+                                SWIGTYPE_p_Xapian__Query,
+                                0);
+      return *((Xapian::Query*)ptr);
+    }
+  };
+%}
+
+class GuileXapianRangeProcessorWrapper
+: public Xapian::RangeProcessor
+{
+ public:
+  GuileXapianRangeProcessorWrapper(Xapian::valueno, std::string const&, unsigned, SCM);
+  ~GuileXapianRangeProcessorWrapper();
+  Xapian::Query operator()(std::string const&, std::string const&);
+};
+
 // Child class of Xapian::FieldProcessor that calls back to a
 // user-specified Scheme procedure to process fields.
 %{
diff --git a/xapian/xapian.scm b/xapian/xapian.scm
index 9ca5df6..15690aa 100644
--- a/xapian/xapian.scm
+++ b/xapian/xapian.scm
@@ -54,6 +54,8 @@
             query-and
             query-or
             query-filter
+            prefixed-range-processor
+            suffixed-range-processor
             field-processor
             enquire
             enquire-mset
@@ -240,6 +242,41 @@ In a non-weighted context, @code{query-filter} and @code{query-and}
 are equivalent."
   (apply query-combine (Query-OP-FILTER) (Query-MatchAll) queries))
 
+(define* (prefixed-range-processor slot proc #:key (prefix "") repeated?)
+  "Return a @code{RangeProcessor} object that calls @var{proc} to process
+its range over @var{slot}.
+
+@var{proc} is a procedure that, given a begin string and an end
+string, must return a @code{Query} object. For open-ended ranges,
+either the begin string or the end string will be @code{#f}.
+
+@var{prefix} is a prefix to look for to recognize values as belonging
+to this range. When @var{repeated?} is @code{#t}, allow @var{prefix}
+on both ends of the range—@samp{$1..$10}."
+  (new-GuileXapianRangeProcessorWrapper
+   slot
+   prefix
+   (get-flag RP-REPEATED repeated?)
+   proc))
+
+(define* (suffixed-range-processor slot proc #:key suffix repeated?)
+  "Return a @code{RangeProcessor} object that calls @var{proc} to process
+its range over @var{slot}.
+
+@var{proc} is a procedure that, given a begin string and an end
+string, must return a @code{Query} object. For open-ended ranges,
+either the begin string or the end string will be @code{#f}.
+
+@var{suffix} is a suffix to look for to recognize values as belonging
+to this range. When @var{repeated?} is @code{#t}, allow @var{suffix}
+on both ends of the range—@samp{2kg..12kg}."
+  (new-GuileXapianRangeProcessorWrapper
+   slot
+   suffix
+   (bitwise-ior (RP-SUFFIX)
+                (get-flag RP-REPEATED repeated?))
+   proc))
+
 (define (field-processor proc)
   "Return a @code{FieldProcessor} object that calls
 @var{proc} to process its field. @var{proc} is a procedure that, given
-- 
cgit v1.2.3