suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Factored out MrEd deps

Browse Source 
original commit: ce0919821999ded657ad5338db774b52ea328119
This commit is contained in:
Paul Steckler 2002-07-16 16:58:34 +00:00
parent 6086973b8b
commit 6e18cdd287
2 changed files with 67 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/help/help.ss
View File

@ -1,11 +1,7 @@
(module help mzscheme (module help mzscheme
(require (lib "web-server.ss" "web-server") (require (lib "class.ss")
(lib "util.ss" "web-server")
(lib "class.ss")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "cmdline.ss") (lib "cmdline.ss")
(lib "configuration.ss" "web-server")
(lib "configuration-structures.ss" "web-server")
"private/server.ss" "private/server.ss"
"private/browser.ss") "private/browser.ss")
@ -40,14 +36,7 @@
(define help-desk-port (hd-cookie->port hd-cookie)) (define help-desk-port (hd-cookie->port hd-cookie))
; allow server startup time ; allow server startup time
(let loop () (wait-for-connection help-desk-port)
(with-handlers
([void (lambda _ (sleep 1) (loop))])
(let-values
([(iport oport) (tcp-connect "127.0.0.1" help-desk-port)])
(sleep 1)
(close-output-port oport)
(close-input-port iport))))
(when launch-browser? (when launch-browser?
(help-desk-browser hd-cookie) (help-desk-browser hd-cookie)
@ -77,13 +66,15 @@
[sd-button (instantiate button% () [sd-button (instantiate button% ()
(label "Shutdown") (label "Shutdown")
(parent hpanel) (parent hpanel)
(callback (lambda (b ev) (callback
(lambda (b ev)
(send cb-frame show #f) (send cb-frame show #f)
(send this show #f))))] (send this show #f))))]
[no-sd-button (instantiate button% () [no-sd-button (instantiate button% ()
(label "Cancel") (label "Cancel")
(parent hpanel) (parent hpanel)
(callback (lambda (b ev) (callback
(lambda (b ev)
(send main-sd-button (send main-sd-button
enable #t) enable #t)
(send cb-frame show #f))))]) (send cb-frame show #f))))])
@ -135,3 +126,4 @@

30
collects/help/private/search.ss
View File

@ -3,40 +3,12 @@
"docpos.ss" "docpos.ss"
"colldocs.ss" "colldocs.ss"
"server.ss" "server.ss"
"browser.ss"
(lib "list.ss") (lib "list.ss")
(lib "util.ss" "help" "servlets" "private") (lib "util.ss" "help" "servlets" "private"))
(lib "specs.ss" "framework"))
(provide do-search (provide do-search
doc-collections-changed) doc-collections-changed)
(provide/contract
(search-for-docs
(hd-cookie? string?
(lambda (s)
(member s
'("keyword" "keyword-index" "keyword-index-text")))
(lambda (s)
(member s
'("exact-match" "containing-match" "regexp-match")))
any?
. -> . any?)))
; hd-cookie string string string any -> void
; shows search result in default browser
(define (search-for-docs cookie search-string search-type match-type lucky?)
(let* ([port (hd-cookie->port cookie)]
[url (format
(string-append "http://127.0.0.1:~a/servlets/index.ss?"
"search-string=~a&"
"search-type=~a&"
"match-type=~a&"
"lucky=~a")
port (hexify-string search-string) search-type match-type
(if lucky? "true" "false"))])
(help-desk-navigate url)))
(define (html-doc-position x) (define (html-doc-position x)
(or (user-defined-doc-position x) (or (user-defined-doc-position x)
(standard-html-doc-position x))) (standard-html-doc-position x)))