source: project/release/4/vandusen/trunk/vandusen-doc.scm @ 21508

Last change on this file since 21508 was 18853, checked in by Moritz Heidkamp, 10 years ago

vandusen: add VERSION file

File size: 2.1 KB
Line 
1(module vandusen-doc ()
2
3(import chicken scheme data-structures srfi-1)
4(require-extension regex)
5(import irregex)
6(use vandusen chicken-doc uri-common srfi-18)
7
8(verify-repository)
9
10(define base-uri (uri-reference "http://3e8.org/chickadee"))
11
12(define (format-results results)
13  (let* ((display-results (take results (min (length results) (or ($ 'doc-max-results) 5))))
14         (display-results (map (lambda (signature path)
15                                 (conc signature "  "
16                                       (uri->string (update-uri base-uri
17                                                                path: (append (uri-path base-uri)
18                                                                              (map symbol->string path))))))
19                               (map node-signature display-results)
20                               (map node-path display-results))))
21    (conc (string-intersperse display-results "\n")
22          (if (< (length display-results) (length results))
23              (format "\n(showing the first ~A of ~A results)"
24                      (length display-results)
25                      (length results))
26              ""))))
27
28(define (safe-call timeout thunk)
29  (let ((mutex (make-mutex))
30        (result (make-condition-variable)))
31    (mutex-lock! mutex)
32    (condition-case
33     (let ((thread (thread-start! 
34                    (lambda ()
35                      (thread-sleep! 10)
36                      (condition-variable-specific-set! result '())
37                      (condition-variable-signal! result)))))
38
39       (if (mutex-unlock! mutex result timeout)
40           (condition-variable-specific result)
41           (begin
42             (thread-terminate! thread)
43             (error "operation timed out"))))
44     (exn () exn))))
45
46(define (search-command search)
47  (lambda (message term)
48    (let ((results (safe-call (or ($ 'doc-search-timeout) 3) (cut search term))))
49      (reply-to message
50                (cond ((condition? results)
51                       (format "error: ~A" (get-condition-property results 'exn 'message)))
52                      ((null? results)
53                       (format "sorry, I couldn't find docs matching ~S" term))
54                      (else (format-results results)))
55                prefixed: #f))))
56
57(plugin 'doc
58        (lambda ()
59          (command 'doc
60                   '(: "doc" (+ space) (submatch (+ any)))
61                   (search-command (lambda (term) (match-nodes term)))
62                   public: #t)
63
64          (command 'wtf
65                   '(: "wtf" (+ space) (submatch (+ any)))
66                   (search-command (lambda (term) (match-nodes (irregex term))))
67                   public: #t))))
Note: See TracBrowser for help on using the repository browser.