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

removed some unnecessary old autoloading, reformat some stuff

Browse Source 
svn: r11886
This commit is contained in:
Eli Barzilay 2008-09-27 02:12:02 +00:00
parent 59b1eea0bc
commit 4efab4f12f
1 changed files with 27 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/scheme/private/help-autoload.ss
View File

@ -3,6 +3,7 @@
(require setup/xref
scribble/xref
scribble/manual-struct
help/search
net/uri-codec
net/sendurl
scheme/path
@ -13,16 +14,13 @@
(define-namespace-anchor anchor)
(define (find-help/lib sym lib)
(let ([id (parameterize ([current-namespace (namespace-anchor->empty-namespace
anchor)])
(let ([id (parameterize ([current-namespace
(namespace-anchor->empty-namespace anchor)])
(namespace-require `(for-label ,lib))
(namespace-syntax-introduce (datum->syntax #f sym)))])
(if (identifier-label-binding id)
(find-help id)
(error 'help
"no binding for identifier: ~a from module: ~a"
sym
lib))))
(find-help id)
(error 'help "no binding for identifier: ~a from module: ~a" sym lib))))
(define (find-help id)
(let* ([lb (identifier-label-binding id)]
@ -31,35 +29,32 @@
(lambda ()
(printf "Loading help index...\n")))])
(if (or lb b)
(let ([tag (xref-binding->definition-tag
xref
(or lb b)
(if lb #f 0))])
(if tag
(go-to-tag xref tag)
(error 'help
"no documentation found for: ~e provided by: ~a"
(syntax-e id)
(module-path-index-resolve (caddr (or lb b))))))
(search-for-exports xref (syntax-e id)))))
(let ([tag (xref-binding->definition-tag xref (or lb b) (if lb #f 0))])
(if tag
(go-to-tag xref tag)
(error 'help
"no documentation found for: ~e provided by: ~a"
(syntax-e id)
(module-path-index-resolve (caddr (or lb b))))))
(search-for-exports xref (syntax-e id)))))
(define (search-for-exports xref sym)
(let ([idx (xref-index xref)]
[libs null])
(for-each (lambda (entry)
(when (exported-index-desc? (entry-desc entry))
(when (eq? sym (exported-index-desc-name (entry-desc entry)))
(set! libs (append libs (exported-index-desc-from-libs (entry-desc entry)))))))
idx)
(for ([entry (in-list idx)])
(when (and (exported-index-desc? (entry-desc entry))
(eq? sym (exported-index-desc-name (entry-desc entry))))
(set! libs (append libs (exported-index-desc-from-libs
(entry-desc entry))))))
(if (null? libs)
(printf "Not found in any library's documentation: ~a\n" sym)
(begin
(printf "No documentation for current binding, but provided by:\n")
(let loop ([libs libs])
(unless (null? libs)
(unless (member (car libs) (cdr libs))
(printf " ~a\n" (car libs)))
(loop (cdr libs))))))))
(printf "Not found in any library's documentation: ~a\n" sym)
(begin
(printf "No documentation for current binding, but provided by:\n")
(let loop ([libs libs])
(unless (null? libs)
(unless (member (car libs) (cdr libs))
(printf " ~a\n" (car libs)))
(loop (cdr libs))))))))
(define (go-to-tag xref t)
(let-values ([(file anchor) (xref-tag->path+anchor xref t)])
@ -68,15 +63,5 @@
(unless (send-url/file file #:fragment (and anchor (uri-encode anchor)))
(error 'help "browser launch failed"))))
(define generate-search-results #f)
(define (search-for strs)
(printf "Generating and opening search page...\n")
(unless generate-search-results
(parameterize ([current-namespace (namespace-anchor->empty-namespace
anchor)])
(set! generate-search-results
(dynamic-require 'help/search 'perform-search))))
(generate-search-results (apply string-append
(add-between strs " "))))
(perform-search (apply string-append (add-between strs " "))))