diff --git a/collects/help/help.ss b/collects/help/help.ss new file mode 100644 index 00000000..491087dd --- /dev/null +++ b/collects/help/help.ss @@ -0,0 +1,156 @@ + +(require-library "browser.ss" "browser") + +(define f (make-object frame% "PLT Help" #f 400 400)) +(define top (make-object vertical-pane% f)) +(define results (make-object editor-canvas% f)) + +(define t (make-object text-field% "Help on:" top void)) +(define search-pane (make-object horizontal-pane% top)) +(define button (make-object button% "Search" search-pane (lambda (b e) (start-search)) '(border))) +(define where (make-object choice% #f '("for Keyword" + "for Keyword or Index Entry" + "for Keyword, Index Entry, or Text") + search-pane + void)) +(define exact (make-object check-box% "Exact" search-pane void)) + +(define editor (make-object text%)) +(send results set-editor editor) + +(send top stretchable-height #f) + +(send t focus) + +(send f show #t) + +(define link-delta (make-object style-delta% 'change-underline #t)) +(let ([mult (send link-delta get-foreground-mult)] + [add (send link-delta get-foreground-add)]) + (send mult set 0 0 0) + (send add set 0 0 255)) + +(define (add-choice type name title page label) + (send editor insert (format "~a " type) (send editor last-position)) + (let ([start (send editor last-position)]) + (send editor begin-edit-sequence) + (send editor insert (format "~a in ~s~n" name title) start) + (let ([end (sub1 (send editor last-position))]) + (send editor change-style link-delta start end) + (send editor set-clickback start end + (lambda (edit start end) + (open-url (make-url + "file" + #f ; host + #f ; port + page + #f ; params + #f ; query + label))))) + (send editor end-edit-sequence))) + +(define re:iname "A HREF=\"(node[0-9]*[.]htm)\"><IMG SRC=\"../icons/index.gif") +(define re:ientry "<DT><TT>([^<]*)</TT>") +(define re:ilink "<A HREF=\"(node[0-9]*[.]htm)#([0-9]*)\">([^<]*)</A>(.*)") + +(define indices (make-hash-table)) + +(define (load-index doc) + (hash-table-get + indices + (string->symbol doc) + (lambda () + (let ([index-file (with-handlers ([(lambda (x) #t) (lambda (x) #f)]) + (with-input-from-file (build-path doc "index.htm") + (lambda () + (let loop () + (let ([r (read-line)]) + (cond + [(eof-object? r) #f] + [(regexp-match re:iname r) + => + (lambda (m) (cadr m))] + [else (loop)]))))))]) + (let ([index + (and index-file + (with-handlers ([(lambda (x) #f) (lambda (x) #f)]) + (with-input-from-file (build-path doc index-file) + (lambda () + (let loop () + (let ([r (read-line)]) + (if (eof-object? r) + null + (let ([m (regexp-match re:ientry r)]) + (if m + (cons (cons (cadr m) r) (loop)) + (loop))))))))))]) + (hash-table-put! indices (string->symbol doc) index) + index))))) + +(define (start-search) + (let ([find (send t get-value)] + [search-level (send where get-selection)] + [exact? (send exact get-value)]) + (dynamic-wind + (lambda () + (send button enable #f) + (send where enable #f) + (send exact enable #f)) + (lambda () + (send editor erase) + (let* ([path (collection-path "doc")] + [docs (map (lambda (x) (build-path path x)) (directory-list path))]) + ;; Keyword searches + (for-each + (lambda (doc) + (let ([keywords (build-path doc "keywords")]) + (when (file-exists? keywords) + (let ([keys (with-input-from-file keywords read)] + [add-key-choice (lambda (v) + (add-choice + "key" (cadr v) (list-ref v 4) + (build-path doc (list-ref v 2)) + (list-ref v 3)))]) + (let ([v (assoc find keys)]) + (when v (add-key-choice v))) + (unless exact? + (for-each + (lambda (v) + (when (regexp-match find (car v)) + (unless (string=? find (car v)) + (add-key-choice v)))) + keys)))))) + docs) + ;; Index searches + (unless (< search-level 1) + (for-each + (lambda (doc) + (let ([index (load-index doc)] + [add-index-choice (lambda (name desc) + (let loop ([desc desc]) + (let ([m (regexp-match re:ilink desc)]) + (when m + (add-choice "idx" name + (list-ref m 3) + (build-path doc (list-ref m 1)) + (list-ref m 2)) + (loop (list-ref m 4))))))]) + (when index + (let ([v (assoc find index)]) + (when v (add-index-choice (car v) (cdr v)))) + (unless exact? + (for-each + (lambda (v) + (when (regexp-match find (car v)) + (unless (string=? find (car v)) + (add-index-choice (car v) (cdr v))))) + index))))) + docs))) + (when (zero? (send editor last-position)) + (send editor insert (format "Found nothing for ~a." find)))) + (lambda () + (send button enable #t) + (send where enable #t) + (send exact enable #t))))) + +(yield (make-semaphore 0)) diff --git a/collects/launcher/sh b/collects/launcher/sh new file mode 100755 index 00000000..e69de29b diff --git a/src/mzscheme/gc/makefile.depend b/src/mzscheme/gc/makefile.depend new file mode 100644 index 00000000..e69de29b