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

svn: r9442

Browse Source
This commit is contained in:
Matthias Felleisen 2008-04-23 23:24:10 +00:00
parent ca3e7cb8c7
commit dad2ce6c03
4 changed files with 2 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/teachpack/htdc/Docs/foot.tinc
View File

@ -1,4 +0,0 @@
<br>
<br>
</body>
</html>

12
collects/teachpack/htdc/Docs/head.tinc
View File

@ -1,12 +0,0 @@
<html>
<head>
<title>Teachpack : {LIBNAME}</title>
</head>
<body bgcolor="#ffffff" text="#000000"
link="#009900" vlink="#007700" alink="#cc0000">
<a href="index.html">Teachpacks for How to Design Classes</a>
<h1>{LIBNAME}</h1>
<hr> <h3>{(idx ,FILENAME)}</h3> <!-- DOCNOTE="teach={FILENAME}" -->

117
collects/teachpack/htdc/Docs/mkdocs
View File

@ -1,117 +0,0 @@
#!/bin/sh
#|
if [ -x "$PLTHOME/bin/mzscheme" ]; then
exec "$PLTHOME/bin/mzscheme" -qgr "$0" "$@"
else
exec "mzscheme" -qgr "$0" "$@"
fi
|#
(require (lib "etc.ss") (lib "dirs.ss" "setup"))
(current-directory (this-expression-source-directory))
; for john?
;; This list determines the order of libraries in the index file:
(define libraries*
'(#"A Functional Drawing Library (HtDC)"
#"An Imperative Drawing Library (HtDC)"
#"A Geometry Library (HtDC)"
#"A Colors Library (HtDC)"
))
(define dest-dir (build-path (find-doc-dir) "teachpack-htdc"))
(printf "writing docs to ~s\n" (path->string dest-dir))
(require (lib "list.ss"))
(define thtml-files
(filter (lambda (x) (regexp-match #rx#"[.]thtml$" (path->bytes x)))
(directory-list)))
(unless (directory-exists? dest-dir) (make-directory dest-dir))
;; Get list of (list name file-basename) for library names
;; (assuming that foo.thtml is always the documentation for ../foo.ss)
(define lib-names
(let ([rx (regexp (string-append "\\(define +LIBNAME +\"(.*?)\"\\)"))])
(map (lambda (s)
(let* ([m (or (regexp-match rx (open-input-file s))
(error 'mkdocs "LIBNAME+FILENAME not found in ~s" s))]
[basename (regexp-replace #rx#"[.]thtml$" (path->bytes s) #"")]
[ss-name (bytes->path (bytes-append basename #".ss"))])
(unless (file-exists? (build-path 'up ss-name))
(error 'mkdocs "Found ~s but no ~s teachpack found" s ss-name))
(list (cadr m) (bytes->path basename))))
(filter (lambda (f) (not (equal? (path->bytes f) #"index.thtml")))
thtml-files))))
;; Check that `lib-names' exactly match `libraires':
(let ([file-libs (map car lib-names)])
(define (test x) (and (pair? x) x))
(cond
[(test (remove* libraries* lib-names (lambda (x y) (equal? x (car y))))) =>
(lambda (libs)
(error 'mkdocs "found libraries unlisted in mkdocs: ~s" libs))]
[(test (remove* file-libs libraries*)) =>
(lambda (libs)
(error 'mkdocs "non-existent libraries listed in mkdocs: ~s" libs))])
(let loop ([libs lib-names])
(cond [(null? libs) 'ok]
[(assoc (caar libs) (cdr libs)) =>
(lambda (m)
(error 'mkdocs "library ~s has two .thtml files: ~s and ~s"
(caar libs) (cdar libs) (cdr m)))]
[else (loop (cdr libs))])))
;; Just like lib-names, but ordered according to libraries*
(define libraries (map (lambda (l) (assoc l lib-names)) libraries*))
(define LIBLINKS
(map (lambda (lib)
(format "<li><a href=~s>~a</a></li>\n"
(string-append (bytes->string/utf-8 (path->bytes (cadr lib))) ".html")
(car lib)
#;(string-append (bytes->string/utf-8 (path->bytes (cadr lib))) ".ss")))
libraries))
;; Stuff for the preprocessed files
(require (lib "mzpp.ss" "preprocessor"))
(beg-mark "{") (end-mark "}")
(define index-entries '())
(define FILENAME #f)
(define LIBNAME #f)
(define HTMLNAME #f)
(define-syntax idx
(syntax-rules ()
[(_ x)
(begin (set! index-entries (cons (list FILENAME LIBNAME HTMLNAME `x)
index-entries))
(list "<a name=\""`x"\">"`x"</a>"))]))
;; Make html files
(for-each (lambda (thtml)
(define html (bytes->path (regexp-replace #rx#"[.]thtml" (path->bytes thtml) #".html")))
(printf "Processing ~a...\n" thtml)
(set! HTMLNAME html)
#;(set! FILENAME (bytes->path (regexp-replace #rx#"[.]thtml" (path->bytes thtml) #".ss")))
(with-output-to-file (build-path dest-dir html)
(lambda () (preprocess thtml))
'replace))
thtml-files)
;; Make hdindex file:
(let ([ifile (build-path dest-dir "hdindex")])
(printf "Writing hdindex...\n")
(with-output-to-file ifile
(lambda ()
(define (writeln x) (printf "~s\n" x))
(define (do-entry filename libname html entry)
(let ([entry (format "~a" entry)]
[title (format "~a teachpack" libname)])
(writeln `(,entry ,(bytes->string/utf-8 (path->bytes html)) ,entry ,title))))
(printf "(\n")
(let ([title "Teachpacks for \"How to Design Classes\""])
(writeln `(,title "index.html" "HtDC" ,title)))
(for-each (lambda (x) (apply do-entry x)) (reverse index-entries))
(printf ")\n"))
'truncate))

2
collects/teachpack/teachpacks.scrbl
View File

@ -22,3 +22,5 @@ This chapter covers the teachpacks for ``How to Design Programs'' and ``How
to Design Classes.'' to Design Classes.''
@include-section["htdp/Docs/htdp.scrbl"] @include-section["htdp/Docs/htdp.scrbl"]
@include-section["htdc/Docs/htdc.scrbl"]