diff options
| -rw-r--r-- | .guix/guile-xapian-package.scm | 57 | ||||
| -rw-r--r-- | Makefile.am | 7 | ||||
| -rw-r--r-- | NEWS | 14 | ||||
| -rw-r--r-- | README.org | 18 | ||||
| -rw-r--r-- | configure.ac | 4 | ||||
| -rw-r--r-- | website/releases/guile-xapian-0.4.0.tar.lz | bin | 0 -> 304667 bytes | |||
| -rw-r--r-- | website/releases/guile-xapian-0.4.0.tar.lz.asc | 11 | ||||
| -rw-r--r-- | xapian.i.in | 67 | ||||
| -rw-r--r-- | xapian/xapian.scm | 133 |
9 files changed, 298 insertions, 13 deletions
diff --git a/.guix/guile-xapian-package.scm b/.guix/guile-xapian-package.scm index a6fa505..7016c30 100644 --- a/.guix/guile-xapian-package.scm +++ b/.guix/guile-xapian-package.scm @@ -1,5 +1,5 @@ ;;; guile-xapian --- Guile bindings for Xapian -;;; Copyright © 2021–2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021–2024 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guile-xapian. ;;; @@ -18,10 +18,14 @@ ;;; <https://www.gnu.org/licenses/>. (define-module (guile-xapian-package) + #:use-module ((gnu packages autotools) #:select (autoconf autoconf-archive automake libtool)) + #:use-module ((gnu packages emacs) #:select (emacs-minimal)) #:use-module ((gnu packages guile-xyz) #:prefix guix:) + #:use-module ((guix build-system guile) #:select (%guile-build-system-modules)) #:use-module (guix gexp) #:use-module (guix git-download) #:use-module (guix packages) + #:use-module (guix profiles) #:use-module (guix utils)) (define-public guile-xapian @@ -31,7 +35,10 @@ "guile-xapian-checkout" #:recursive? #t #:select? (or (git-predicate (dirname (current-source-directory))) - (const #t)))))) + (const #t)))) + (native-inputs + (modify-inputs (package-native-inputs guix:guile-xapian) + (prepend autoconf autoconf-archive automake libtool))))) (define-public guile2.2-xapian (package @@ -40,6 +47,50 @@ "guile-xapian-checkout" #:recursive? #t #:select? (or (git-predicate (dirname (current-source-directory))) - (const #t)))))) + (const #t)))) + (native-inputs + (modify-inputs (package-native-inputs guix:guile2.2-xapian) + (prepend autoconf autoconf-archive automake libtool))))) + +(define guile-xapian-website-gexp + (let ((development-profile + (profile + (content (package->development-manifest guile-xapian))))) + (with-imported-modules %guile-build-system-modules + #~(begin + (use-modules (guix build guile-build-system) + (guix build utils)) + + (copy-recursively #$(package-source guile-xapian) + (getcwd)) + (set-path-environment-variable + "PATH" (list "/bin") (list #$emacs-minimal #$development-profile)) + (set-path-environment-variable + "C_INCLUDE_PATH" (list "/include") (list #$development-profile)) + (set-path-environment-variable + "CPLUS_INCLUDE_PATH" (list "/include") (list #$development-profile)) + (set-path-environment-variable + "LIBRARY_PATH" (list "/lib") (list #$development-profile)) + (set-path-environment-variable + "ACLOCAL_PATH" (list "/share/aclocal") (list #$development-profile)) + (set-path-environment-variable + "PKG_CONFIG_PATH" (list "/lib/pkgconfig") (list #$development-profile)) + (set-path-environment-variable + "GUILE_LOAD_PATH" + (list (string-append "/share/guile/site/" + (target-guile-effective-version))) + (list #$development-profile)) + (set-path-environment-variable + "GUILE_LOAD_COMPILED_PATH" + (list (string-append "/lib/guile/" (target-guile-effective-version) "/site-ccache")) + (list #$development-profile)) + (invoke "autoreconf" "--verbose" "--install" "--force") + (patch-shebang "configure") + (invoke "./configure" "CONFIG_SHELL=sh" "SHELL=sh") + (invoke "make" "website") + (copy-recursively "website" #$output))))) + +(define-public guile-xapian-website + (computed-file "guile-xapian-website" guile-xapian-website-gexp)) guile-xapian diff --git a/Makefile.am b/Makefile.am index 5d717ca..625f270 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # guile-xapian --- Guile bindings for Xapian -# Copyright © 2020, 2021, 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> +# Copyright © 2020–2024 Arun Isaac <arunisaac@systemreboot.net> # Copyright © 2022 Bob131 <bob@bob131.so> # # This file is part of guile-xapian. @@ -18,6 +18,8 @@ # along with guile-xapian. If not, see # <https://www.gnu.org/licenses/>. +GPG = gpg + # Prefix variables for silencing various commands. See "(automake) # Automake Silent Rules" for details. @@ -90,6 +92,9 @@ SCM_LOG_DRIVER = \ EXTRA_DIST = $(TESTS) $(SOURCES) except.i xapian.i.in xapian-head.i xapian-headers.i +%.asc: % + $(GPG) --detach-sign --armor $< + # Build website website: website/index.html diff --git a/NEWS b/NEWS index 37d1d26..9f6efa5 100644 --- a/NEWS +++ b/NEWS @@ -1,10 +1,22 @@ -*- org -*- #+TITLE: guile-xapian NEWS – History of user-visible changes -Copyright © 2022–2023 Arun Isaac <arunisaac@systemreboot.net> +Copyright © 2022–2024 Arun Isaac <arunisaac@systemreboot.net> Please send guile-xapian bug reports to arunisaac@systemreboot.net +* Changes in 0.4.0 (since 0.3.1) +** Features +*** New higher level field processors +New higher level field processors that wrap FieldProcessor, +RangeProcessor and DateRangeProcessor are now available. You can now +write these field processors conveniently in Scheme. +*** parse-query accepts boolean prefixes, range processors and a few common query parser flags +*** New query function +new-Query is now exposed as the more Scheme-like query function. +** Noteworthy bug fixes +*** mset-snippet and mset-sxml-snippet now actually work + * Changes in 0.3.1 (since 0.3.0) ** Noteworthy bug fixes *** Catch C++ xapian exceptions and raise them as scheme exceptions diff --git a/README.org b/README.org index bf0aa25..82e5870 100644 --- a/README.org +++ b/README.org @@ -5,13 +5,14 @@ {{{ci-badge(guile-xapian-with-guile-2.2)}}} {{{ci-badge(guile-xapian-with-guile-3.0)}}} {{{ci-badge(guile-xapian-with-guile-3.0-latest)}}} {{{ci-badge(guile-xapian-website)}}} guile-xapian provides Guile bindings for [[https://xapian.org][Xapian]], a search engine -library. Xapian is a highly adaptable toolkit which allows developers +library used in popular applications such as the [[https://notmuchmail.org/][notmuch]] email +system. Xapian is a highly adaptable toolkit which allows developers to easily add advanced indexing and search facilities to their own applications. It has built-in support for several families of weighting models and also supports a rich set of boolean query operators. -Once these bindings are sufficiently mature, they will be merged with +Once these bindings are sufficiently mature, they may be merged with [[https://github.com/xapian/xapian/tree/master/xapian-bindings][xapian-bindings]]. This will involve creating more complete Scheme-friendly wrapping of the Xapian library, writing test cases and documentation. When we are done, the user should not ever have to call @@ -62,6 +63,19 @@ example searches. ./pre-inst-env guile examples/search.scm /tmp/db description:\"leather case\" AND title:sundial #+END_SRC +* Download + +[[https://repology.org/project/guile-xapian/versions][https://repology.org/badge/vertical-allrepos/guile-xapian.svg]] + +Download release tarballs. + +- 2024-05-10 [[./releases/guile-xapian-0.4.0.tar.lz][guile-xapian-0.4.0.tar.lz]] [[./releases/guile-xapian-0.4.0.tar.lz.asc][GPG Signature]] + +Download [[https://systemreboot.net/about/arunisaac.pub][public signing key]]. + +Browse the [[https://git.systemreboot.net/guile-xapian][development version]] of guile-xapian hosted in a git +repository. + * Contributing Feedback, suggestions, feature requests and bug reports are all diff --git a/configure.ac b/configure.ac index f953339..5a458e2 100644 --- a/configure.ac +++ b/configure.ac @@ -1,5 +1,5 @@ dnl guile-xapian --- Guile bindings for Xapian -dnl Copyright © 2020, 2021, 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> +dnl Copyright © 2020–2024 Arun Isaac <arunisaac@systemreboot.net> dnl dnl This file is part of guile-xapian. dnl @@ -17,7 +17,7 @@ dnl You should have received a copy of the GNU General Public License dnl along with guile-xapian. If not, see dnl <https://www.gnu.org/licenses/>. -AC_INIT([guile-xapian], [0.3.1]) +AC_INIT([guile-xapian], [0.4.0]) AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign check-news no-dist-gzip dist-lzip]) AM_SILENT_RULES([yes]) LT_INIT diff --git a/website/releases/guile-xapian-0.4.0.tar.lz b/website/releases/guile-xapian-0.4.0.tar.lz new file mode 100644 index 0000000..90bc498 --- /dev/null +++ b/website/releases/guile-xapian-0.4.0.tar.lz Binary files differdiff --git a/website/releases/guile-xapian-0.4.0.tar.lz.asc b/website/releases/guile-xapian-0.4.0.tar.lz.asc new file mode 100644 index 0000000..0f841d8 --- /dev/null +++ b/website/releases/guile-xapian-0.4.0.tar.lz.asc @@ -0,0 +1,11 @@ +-----BEGIN PGP SIGNATURE----- + +iQEzBAABCAAdFiEEf3MDQ/Lwnzx3v3nTLiXui2GAK7MFAmY+K9sACgkQLiXui2GA +K7O/HQgAqOwIuIVufN7psmLx/+hPm/PC7H+Q4bvhrpP35chbsxLfhxtv7kuhldBZ +Lkyqbx5zPsqDILUQYVudAff43crakXfbBkjNP/5zG0TgRmDT2ANgKZjEmc3dxtir +Ysnc2+KIuwJMB2n+xs7QIzQyuY0R+A2GvyLq9ZiTQ4TuUvA4bfeY+YWmtuMY1b6C +FblD2CySNCotzfLlY2cn5KUWt2bVneSneItHO3aVwE+73+0RfnQvjb6PBqYlCwWz +wlNo5H75uijD4bx0fI9MaQI9cKHRre3XlkAWZKwoCGMtl9oOubfotmOQe/GqU82q +5x3DmPyegxj4ONK9nTHUu4G6oCcalg== +=WmP/ +-----END PGP SIGNATURE----- diff --git a/xapian.i.in b/xapian.i.in index ff4ce80..84695e9 100644 --- a/xapian.i.in +++ b/xapian.i.in @@ -1,5 +1,5 @@ /* guile-xapian --- Guile bindings for Xapian - * Copyright © 2020, 2023 Arun Isaac <arunisaac@systemreboot.net> + * Copyright © 2020, 2023–2024 Arun Isaac <arunisaac@systemreboot.net> * Copyright © 2021, 2022 Bob131 <bob@bob131.so> * * This file is part of guile-xapian. @@ -141,3 +141,68 @@ return new Xapian::Query (op_, slot, range_lower, range_upper); } } + +// 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. +%{ + class GuileXapianFieldProcessorWrapper + : public Xapian::FieldProcessor { + private: + SCM proc; + public: + GuileXapianFieldProcessorWrapper(SCM _proc) { + proc = _proc; + } + Xapian::Query operator()(const std::string &str) { + void *ptr; + int res = SWIG_ConvertPtr(scm_call_1(proc, scm_from_utf8_string(str.c_str())), + &ptr, + SWIGTYPE_p_Xapian__Query, + 0); + return *((Xapian::Query*)ptr); + } + }; +%} + +class GuileXapianFieldProcessorWrapper +: public Xapian::FieldProcessor +{ + public: + GuileXapianFieldProcessorWrapper(SCM); + ~GuileXapianFieldProcessorWrapper(); + Xapian::Query operator()(std::string const&); +}; diff --git a/xapian/xapian.scm b/xapian/xapian.scm index 80b4b9b..64042a2 100644 --- a/xapian/xapian.scm +++ b/xapian/xapian.scm @@ -1,5 +1,5 @@ ;;; guile-xapian --- Guile bindings for Xapian -;;; Copyright © 2020, 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2020, 2022, 2024 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2021 Bob131 <bob@bob131.so> ;;; ;;; This file is part of guile-xapian. @@ -50,9 +50,15 @@ index-text! increase-termpos! parse-query + query query-and query-or query-filter + prefixed-range-processor + suffixed-range-processor + prefixed-date-range-processor + suffixed-date-range-processor + field-processor enquire enquire-mset mset-item-docid @@ -160,7 +166,37 @@ generated." (define increase-termpos! TermGenerator-increase-termpos) -(define* (parse-query querystring #:key stemmer stemming-strategy (prefixes '())) +(define* (parse-query querystring + #:key + stemmer + stemming-strategy + (prefixes '()) + (boolean-prefixes '()) + (range-processors '()) + (boolean? #t) + (phrases? #t) + (love-hate? #t) + any-case-boolean? + wildcard?) + "Parse @var{querystring} and return a @code{Query} object. + +@var{prefixes} and @var{boolean-prefixes} must be association lists +mapping fields to prefixes or @code{FieldProcessor} +objects. @var{range-processors} is a list of @code{RangeProcessor} +objects. + +When @var{boolean?} is @code{#t}, boolean operators (AND, OR, etc.) +and bracketed subexpressions are supported. + +When @var{phrases?} is @code{#t}, quoted phrases are supported. + +When @var{love-hate?} is @code{#t}, @samp{+} and @samp{-} are +supported. + +When @var{any-case-boolean?} is @code{#t}, boolean operators are +supported even if they are not in capitals. + +When @var{wildcard?} is @code{#t}, wildcards are supported." (let ((queryparser (new-QueryParser))) (QueryParser-set-stemmer queryparser stemmer) (when stemming-strategy @@ -169,7 +205,19 @@ generated." ((field . prefix) (QueryParser-add-prefix queryparser field prefix))) prefixes) - (let ((query (QueryParser-parse-query queryparser querystring))) + (for-each (match-lambda + ((field . prefix) + (QueryParser-add-boolean-prefix queryparser field prefix))) + boolean-prefixes) + (for-each (cut QueryParser-add-rangeprocessor queryparser <>) + range-processors) + (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))) @@ -206,6 +254,10 @@ on the database object." (MSetIterator-next head) (loop head result)))))) +(define (query term) + "Return a @code{Query} object for @var{term}." + (new-Query term)) + (define (query-combine combine-operator default . queries) (reduce (cut new-Query combine-operator <> <>) default @@ -234,6 +286,81 @@ 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* (prefixed-date-range-processor slot #:key (prefix "") repeated? prefer-mdy? (epoch-year 1970)) + "Return a @code{DateRangeProcessor} object that handles date ranges on +@var{slot}. + +@var{prefix} and @var{repeated?} are the same as in +@code{prefixed-range-processor}. + +When @var{prefer-mdy?} is @code{#t}, interpret ambiguous dates as +month/day/year rather than day/month/year. + +@var{epoch-year} is the year to use as the epoch for dates with +two-digit years." + (new-DateRangeProcessor slot + prefix + (bitwise-ior (get-flag (RP-REPEATED) repeated?) + (get-flag (RP-DATE-PREFER-MDY) prefer-mdy?)) + epoch-year)) + +(define* (suffixed-date-range-processor slot #:key suffix repeated? prefer-mdy? (epoch-year 1970)) + "Return a @code{DateRangeProcessor} object that handles date ranges on +@var{slot}. + +@var{suffix} and @var{repeated?} are the same as in +@code{suffixed-range-processor}. + +@var{prefer-mdy?} and @var{epoch-year} are the same as in +@code{prefixed-date-range-processor}." + (new-DateRangeProcessor slot + suffix + (bitwise-ior (RP-SUFFIX) + (get-flag (RP-REPEATED) repeated?) + (get-flag (RP-DATE-PREFER-MDY) prefer-mdy?)) + epoch-year)) + +(define (field-processor proc) + "Return a @code{FieldProcessor} object that calls +@var{proc} to process its field. @var{proc} is a procedure that, given +a string, must return a @code{Query} object." + (new-GuileXapianFieldProcessorWrapper proc)) + (define (get-flag flag-thunk value) (if value (flag-thunk) 0)) |