/
show-help.rkt
72 lines (70 loc) · 3.21 KB
/
show-help.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#lang racket
(require racket/gui)
(provide show-help)
(define show-help
(lambda (collections frame-title [verbatim? #f])
(let* ([f #f]
[f%
(class frame%
(define/augment (on-close)
(set! f #f))
(super-instantiate () (label frame-title)))])
(lambda ()
(if f
(send f show #t)
(let* ([frame (make-object f%)]
[t (make-object text%)]
[c (new editor-canvas% [parent frame] [editor t] [style '(auto-hscroll)])])
(send c min-width 500)
(send c min-height 300)
(send t auto-wrap (not verbatim?))
(call-with-input-file (build-path
(apply collection-path collections)
"doc.txt")
(lambda (p)
(let loop ()
(let ([l (read-line p)])
(unless (eof-object? l)
(cond
[verbatim?
(send t insert l)
(send t insert #\newline)]
[(regexp-match #rx"^[*][*].*[*][*]$" l)
;; Skip
(void)]
[(string=? l "")
(unless (zero? (send t last-position))
(send t insert #\newline)
(send t insert #\newline))]
[(and (regexp-match #rx"^-+$" l)
(= (string-length l)
(- (send t last-position)
(send t paragraph-start-position (send t last-paragraph))
1)))
;; Change previous line style to title
(let ([end (send t last-position)])
(send t change-style
(send (make-object style-delta% 'change-weight 'bold)
set-delta-foreground
"blue")
(- end 1 (string-length l)) (- end 1)))]
[else
(let ([l (regexp-replace #rx" +$"
(regexp-replace #rx"^ +" l "")
"")])
(send t insert l)
(when (regexp-match #rx"^[*]" l)
(send t set-paragraph-margins
(send t position-paragraph (send t last-position))
16 32 0))
(send t insert #\space))])
(loop)))))
#:mode 'text)
(when verbatim?
(send t change-style
(make-object style-delta% 'change-family 'modern)
0 (send t last-position)))
(send t lock #t)
(send t set-position 0 0)
(send frame show #t)
(set! f frame)))))))