ac47e02961
Little Helper contains a full text search engine.
Currently it indexes all html-files in /collects/doc.
A mockup web-interface is present in order to facilitate easy experimentation with searches.
Run run-indexer to generate the index for your documentation dir.
Run launch to start a web-server with the search interface.
Note: Currently assumes w3m is in your path (used to precompute the
preview-snippets shown in the search results.
svn: r8836
103 lines
3.7 KiB
Scheme
103 lines
3.7 KiB
Scheme
(module view mzscheme
|
|
(provide (all-defined))
|
|
|
|
(require mzlib/match
|
|
net/url
|
|
setup/dirs
|
|
web-server/servlet
|
|
(all-except xml/xml
|
|
document document? make-document struct:document)
|
|
"private/html.scm"
|
|
"private/mime.scm"
|
|
"private/request.scm"
|
|
"../../indexer/planet/intersperse.scm"
|
|
"../../indexer/planet/file.scm"
|
|
(prefix home: "home.scm"))
|
|
|
|
(define interface-version 'v1)
|
|
(define timeout 6000)
|
|
(define (start request)
|
|
(current-request request)
|
|
(with-errors-to-browser send/finish
|
|
(λ () (do-view-page request))))
|
|
|
|
;;; VIEW PAGE
|
|
|
|
(define (do-view-page request)
|
|
(begin (write (map path/param-path (url-path (request-uri request)))
|
|
(current-error-port))
|
|
(newline (current-error-port)))
|
|
; extract repository-id and document-id from the url and dispatch
|
|
; index.html and scribble.css is handled specially
|
|
(match (map path/param-path (url-path (request-uri request)))
|
|
[("servlets" "view.scm" "scribble.css")
|
|
(file-verbatim "scribble.css")]
|
|
[("servlets" "view.scm" "index.html")
|
|
(home:do-home-page)]
|
|
[("servlets" "view.scm") ; .../view.scm
|
|
; redirect to .../views.scm/
|
|
(make-response/full
|
|
303 "See Other" (current-seconds) TEXT/HTML-MIME-TYPE
|
|
(list (make-header #"Location" (string->bytes/utf-8 "view.scm/"))
|
|
(make-header #"Cache-Control" #"no-cache")
|
|
(make-header #"Expires" #"Thu, 01 Jan 1970 00:00:00 GMT"))
|
|
(list doctype-HTML-4.01-Transitional ""))]
|
|
[("servlets" "view.scm" "") ; .../view.scm/
|
|
(home:do-home-page)]
|
|
[("servlets" "view.scm" repid . docid-pieces)
|
|
(let ([docid (apply string-append
|
|
(intersperse "/" docid-pieces))]
|
|
[file (apply build-path `(,(find-doc-dir) ,repid ,@docid-pieces))])
|
|
(cond [(not (file-exists? file))
|
|
(html-document-not-found repid docid)]
|
|
[(text-mime-type? file)
|
|
(cond [(not (member repid '("help" "release-notes")))
|
|
(html-view-file file)]
|
|
[else ; txt-files
|
|
(html-view-txt-file file)])]
|
|
[else
|
|
; binary files such as pngs, gifs, etc.
|
|
(file-verbatim file)]))]
|
|
[_ (error "huh - was the file view.scm renamed?")]))
|
|
|
|
(define (html-view-file file)
|
|
(list #"text/html"
|
|
(string-append (xexpr->string
|
|
(html-page
|
|
#:title (title (format "View: ~a" file))
|
|
#:body ""))
|
|
(file->string file))))
|
|
|
|
(define (html-view-txt-file file)
|
|
(html-page
|
|
#:title (title (format "View: ~a" file))
|
|
#:body `(pre ,(file->string file))))
|
|
|
|
|
|
(define (file-verbatim path)
|
|
(list (get-mime-type path)
|
|
(file->bytes path)))
|
|
|
|
(define (html-error-page title-text text)
|
|
(html-page
|
|
#:title (title title-text)
|
|
#:body `(div (h1 ,title-text)
|
|
,text)))
|
|
|
|
(define (html-file-not-found-page file)
|
|
(html-error-page "File Not Found"
|
|
(format "The file '~a' was not found." file)))
|
|
|
|
(define (html-document-not-found rep-name docid)
|
|
(html-error-page
|
|
"Document Not Found"
|
|
(format "The repository '~a' exists, but it does not contain the document: ~a"
|
|
rep-name docid)))
|
|
|
|
(define (html-repository-not-found-page repid docid)
|
|
(html-error-page
|
|
"Repository Not Found"
|
|
(format "No repository has the name '~a' ~a" repid
|
|
" please file a bug report.")))
|
|
|
|
) |