diff options
| -rw-r--r-- | xapian/xapian.scm | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/xapian/xapian.scm b/xapian/xapian.scm index f13365e..650c401 100644 --- a/xapian/xapian.scm +++ b/xapian/xapian.scm @@ -23,6 +23,7 @@ #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (srfi srfi-26) + #:use-module (htmlprag) #:use-module (xapian wrap) #:export (xapian-open xapian-close @@ -55,7 +56,8 @@ mset-item-rank mset-item-weight mset-fold - mset-snippet)) + mset-snippet + mset-sxml-snippet)) (define xapian-open new-Database) (define xapian-close delete-Database) @@ -241,3 +243,33 @@ for more details." (get-flag MSet-SNIPPET-EMPTY-WITHOUT-MATCH empty-without-match?) (get-flag MSet-SNIPPET-CJK-NGRAM cjk-ngram?)) highlight-start highlight-end omit)) + +(define* (mset-sxml-snippet mset text #:key (length 500) (stemmer (make-stem "none")) + (highlight-proc (lambda (text) + `(b ,text))) + (omit "...") (background-model? #t) (exhaustive? #t) + (empty-without-match? #t) (cjk-ngram? #t)) + "Generate a snippet in SXML form from @var{text}. + +@var{highlight-proc} is a function that is passed the highlit text. It +should return a SXML tree highlighting that text. + +Arguments @var{mset}, @var{length}, @var{stemmer}, @var{omit}, +@var{background-model?}, @var{exhaustive?}, @var{empty-without-match?} +and @var{cjk-ngram?} are the same as in the @code{mset-snippet} +function." + ;; mset-snippet returns serialized HTML. So, we reverse it with + ;; html->sxml. + (match (html->sxml (mset-snippet text mset)) + (('*TOP* children ...) + (append-map (match-lambda + ;; Apply highlight-proc if highlit text. + (('b text) + (highlight-proc text)) + ;; Add (br) if end of line. + ((? (cut string-suffix? "\n" <>) text) + (list (string-trim-right text #\newline) + '(br))) + ;; Else, return verbatim. + (text text)) + children)))) |