From b9aadb5dc6ae20d3618f0510884d20a477da0632 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 8 Feb 2008 04:32:49 +0000 Subject: [PATCH] much improved search, extended and fixed sendurl, string-based rendering for xrefs svn: r8577 original commit: 7539945a3dd567b0dae31b824af751b0ef4ff2a5 --- collects/help/search.ss | 46 ++++++++++++------------ collects/scribble/base-render.ss | 10 ++++-- collects/scribble/xref.ss | 34 ++++++++++-------- collects/scribblings/scribble/xref.scrbl | 4 +-- 4 files changed, 51 insertions(+), 43 deletions(-) diff --git a/collects/help/search.ss b/collects/help/search.ss index 03e369ab..ab47d774 100644 --- a/collects/help/search.ss +++ b/collects/help/search.ss @@ -26,12 +26,12 @@ (define exact-score 1000) (define exact-word-score 600) (define words1-score 400) -(define words2-score 200) -(define prefix-score 100) +(define words2-score 100) +(define prefix-score 200) (define suffix-score 20) (define contain-score 10) -(define exported-entry-bonus 200) ; prefer bindings and modules -(define regexp-score-factor 1.25) ; regexps get higher score +(define exported-entry-factor 1.1) ; prefer bindings and modules +(define regexp-score-factor 1.1) ; regexps get higher score (define nomatch-score -1) ; prefer less irrelevant terms (define (perform-search terms #:exact? [exact? #f] #:go-if-one? [go-if-one? #t]) @@ -47,13 +47,15 @@ (loop (cdr es) (let* ([e (car es)] [score (scorer e)]) (if (score . > . 0) (cons (cons score e) r) r)))))] + ;; use to debug weird search results + ;; [_ (for ([x (sort entries scored-entrypath+anchor xref tag)]) - (send-url/file path #:fragment (uri-encode tag))) - (let* ([file (next-search-results-file)] - [term->label + (send-url/file path #:fragment (and tag (uri-encode tag)))) + (let* ([term->label (λ (t) (format "``~a''" (if (regexp? t) (object-name t) t)))] [search-title ; note: terms is not null at this point (see above) (apply string-append (term->label (car terms)) @@ -65,8 +67,8 @@ (list (make-element "schemeerror" (list "No results found."))) (build-itemization entries))] [contents (cons (title search-title) contents)]) - (xref-render xref (decode contents) file) - (send-url/file file)))))) + (send-url/contents (xref-render xref (decode contents) #f) + #:delete-at (* 60 10))))))) ;; converts a list of search terms to a scoring function (define (terms->scorer terms exact?) @@ -108,13 +110,16 @@ sc)))) terms)) (lambda (entry) - (foldl (lambda (word acc) - (+ acc (foldl (lambda (sc acc) (+ acc (sc word))) 0 scorers))) - ;; give some bonus for bindings and modules - (let ([desc (entry-desc entry)]) - (if (or (exported-index-desc? desc) (module-path-index-desc? desc)) - exported-entry-bonus 0)) - (entry-words entry)))) + (let ([sc (foldl (lambda (word acc) + (+ acc (foldl (lambda (sc acc) (+ acc (sc word))) + 0 scorers))) + 0 + (entry-words entry))]) + ;; give some bonus for bindings and modules + (let ([desc (entry-desc entry)]) + (if (or (exported-index-desc? desc) (module-path-index-desc? desc)) + (* sc exported-entry-factor) + sc))))) (define (scored-entry (listof ) (define (build-itemization entries) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 8fa4444c..a23cd160 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -279,9 +279,15 @@ (define/public (render ds fns ri) (map (lambda (d fn) + (define (one) (render-one d ri fn)) (when report-output? (printf " [Output to ~a]\n" fn)) - (with-output-to-file fn #:exists 'truncate/replace - (lambda () (render-one d ri fn)))) + (if fn + (with-output-to-file fn #:exists 'truncate/replace one) + ;; a #f filename means return the contents as a string + (let ([o (open-output-string)]) + (parameterize ([current-output-port o]) + (one) + (get-output-string o))))) ds fns)) diff --git a/collects/scribble/xref.ss b/collects/scribble/xref.ss index 9c367120..d773cfca 100644 --- a/collects/scribble/xref.ss +++ b/collects/scribble/xref.ss @@ -53,23 +53,27 @@ (define (xref-index xrefs) (filter values - (hash-table-map (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs))) - (lambda (k v) - (and (pair? k) - (eq? (car k) 'index-entry) - (make-entry (car v) - (cadr v) - (cadr k) - (caddr v))))))) + (hash-table-map + (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs))) + (lambda (k v) + (and (pair? k) + (eq? (car k) 'index-entry) + (make-entry (car v) (cadr v) (cadr k) (caddr v))))))) -(define (xref-render xrefs doc dest-file #:render% [render% (html:render-mixin render%)]) +;; dest-file can be #f, which will make it return a string holding the +;; resulting html +(define (xref-render xrefs doc dest-file + #:render% [render% (html:render-mixin render%)]) (let* ([dest-file (if (string? dest-file) (string->path dest-file) dest-file)] - [renderer (new render% [dest-dir (path-only dest-file)])] - [ci (send renderer collect (list doc) (list dest-file))]) - (send renderer transfer-info ci (resolve-info-ci (xrefs-ri xrefs))) - (let ([ri (send renderer resolve (list doc) (list dest-file) ci)]) - (send renderer render (list doc) (list dest-file) ri) - (void)))) + [renderer (new render% [dest-dir (and dest-file (path-only dest-file))] + [css-path 'inline])] + [ci (send renderer collect (list doc) (list dest-file))] + [_ (send renderer transfer-info ci (resolve-info-ci (xrefs-ri xrefs)))] + [ri (send renderer resolve (list doc) (list dest-file) ci)] + [xs (send renderer render (list doc) (list dest-file) ri)]) + (if dest-file + (void) + (car xs)))) ;; Returns (values ) (define xref-binding-tag diff --git a/collects/scribblings/scribble/xref.scrbl b/collects/scribblings/scribble/xref.scrbl index 00e6eeda..bd923a2b 100644 --- a/collects/scribblings/scribble/xref.scrbl +++ b/collects/scribblings/scribble/xref.scrbl @@ -106,7 +106,7 @@ which might be used with @scheme[xref-tag->path+anchor] or embedded in a document rendered via @scheme[xref-render]. If no definition point is found in @scheme[xref], the result is @scheme[#f].} - + @defproc[(xref-tag->path+anchor [xref xref?] [tag tag?] [#:render% using-render% (subclass?/c render%) @@ -123,7 +123,7 @@ point in a page. The optional @scheme[using-render%] argument is as for @scheme[load-xref].} - + @defproc[(xref-tag->index-entry [xref xref?] [tag tag?])