suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

add ++xref-in flag to scribble

Browse Source 
svn: r11918

original commit: 1097cb35a66d2acf37edccfd75940070a25192a9
This commit is contained in:
Matthew Flatt 2008-10-01 13:03:06 +00:00
parent c954445908
commit a525409f9b
1 changed files with 50 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
collects/scribble/run.ss
View File

@ -2,6 +2,7 @@
(module run mzscheme (module run mzscheme
(require "struct.ss" (require "struct.ss"
"base-render.ss" "base-render.ss"
"xref.ss"
mzlib/cmdline mzlib/cmdline
mzlib/class mzlib/class
mzlib/file mzlib/file
@ -29,11 +30,21 @@
(make-parameter #f)) (make-parameter #f))
(define current-info-input-files (define current-info-input-files
(make-parameter null)) (make-parameter null))
(define current-xref-input-modules
(make-parameter null))
(define current-style-file (define current-style-file
(make-parameter #f)) (make-parameter #f))
(define current-redirect (define current-redirect
(make-parameter #f)) (make-parameter #f))
(define (read-one str)
(let ([i (open-input-string str)])
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([v (read i)])
(if (eof-object? (read i))
v
#f)))))
(define (get-command-line-files argv) (define (get-command-line-files argv)
(command-line (command-line
"scribble" "scribble"
@ -59,9 +70,23 @@
[("--info-out") file "write format-specific link information to <file>" [("--info-out") file "write format-specific link information to <file>"
(current-info-output-file file)]] (current-info-output-file file)]]
[multi [multi
[("++info-in") file "load format-specific link information form <file>" [("++info-in") file "load format-specific link information from <file>"
(current-info-input-files (current-info-input-files
(cons file (current-info-input-files)))]] (cons file (current-info-input-files)))]
[("++xref-in") module-path proc-id "load format-specific link information by"
"calling <proc-id> as exported by <module-path>"
(let ([mod (read-one module-path)]
[id (read-one proc-id)])
(unless (module-path? mod)
(raise-user-error 'scribble
"bad module path for ++ref-in: ~s"
module-path))
(unless (symbol? id)
(raise-user-error 'scribble
"bad procedure identifier for ++ref-in: ~s"
proc-id))
(current-xref-input-modules
(cons (cons mod id) (current-xref-input-modules))))]]
[args (file . another-file) (cons file another-file)])) [args (file . another-file) (cons file another-file)]))
(define (build-docs-files files) (define (build-docs-files files)
@ -90,19 +115,26 @@
fn)))) fn))))
files)] files)]
[info (send renderer collect docs fns)]) [info (send renderer collect docs fns)])
(let ([info (let loop ([info info] (for-each (lambda (file)
[files (reverse (current-info-input-files))]) (let ([s (with-input-from-file file read)])
(if (null? files) (send renderer deserialize-info s info)))
info (reverse (current-info-input-files)))
(loop (let ([s (with-input-from-file (car files) read)]) (for-each (lambda (mod+id)
(send renderer deserialize-info s info) (let ([get-xref (dynamic-require (car mod+id) (cdr mod+id))])
info) (let ([xr (get-xref)])
(cdr files))))]) (unless (xref? xr)
(let ([r-info (send renderer resolve docs fns info)]) (raise-user-error 'scribble
(send renderer render docs fns r-info) "result from `~s' of `~s' is not an xref: ~e"
(when (current-info-output-file) (cdr mod+id)
(let ([s (send renderer serialize-info r-info)]) (car mod+id)
(with-output-to-file (current-info-output-file) xr))
(lambda () (xref-transfer-info renderer info xr))))
(write s)) (reverse (current-xref-input-modules)))
'truncate/replace)))))))))) (let ([r-info (send renderer resolve docs fns info)])
(send renderer render docs fns r-info)
(when (current-info-output-file)
(let ([s (send renderer serialize-info r-info)])
(with-output-to-file (current-info-output-file)
(lambda ()
(write s))
'truncate/replace)))))))))