75 lines
2.1 KiB
Scheme
75 lines
2.1 KiB
Scheme
(module show-help mzscheme
|
|
(require mzlib/class
|
|
mred
|
|
mzlib/etc)
|
|
|
|
(provide show-help)
|
|
|
|
(define show-help
|
|
(opt-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)))))
|
|
'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))))))))
|