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

reformat a little

Browse Source 
svn: r4987
This commit is contained in:
Eli Barzilay 2006-11-30 21:10:32 +00:00
parent ebaaa91038
commit f00b68a872
1 changed files with 55 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
collects/help/installer.ss
View File

@ -1,70 +1,65 @@
(module installer mzscheme
(provide installer)
(require (lib "match.ss")
(lib "file.ss")
(lib "list.ss")
(lib "dirs.ss" "setup"))
(define installer
(lambda (path)
(create-index-file)))
(lib "file.ss")
(lib "list.ss")
(lib "dirs.ss" "setup"))
(define (installer path)
(create-index-file))
(define index-file "hdindex")
;; assume that "help" is in the main doc directory
(define dest-dir (build-path (find-doc-dir) "help"))
(define (create-index-file)
(when (file-exists? index-file)
(delete-file index-file))
(gen-index servlet-dir)
(with-output-to-file )
(let ([output-port (open-output-file (build-path dest-dir index-file))])
(fprintf output-port "(~n")
(let loop ([index index])
(if (null? index)
(begin
(fprintf output-port ")~n")
(close-output-port output-port))
(begin
(fprintf output-port "~s~n" (car index))
(loop (cdr index)))))))
(define servlet-dir (normalize-path
(build-path (collection-path "help") "servlets")))
(fprintf output-port "(\n")
(for-each (lambda (x) (fprintf output-port "~s\n" x)) index)
(close-output-port output-port)
(fprintf output-port ")\n")))
(define servlet-dir (normalize-path
(build-path (collection-path "help") "servlets")))
(define exploded-servlet-dir-len (length (explode-path servlet-dir)))
;; assume that "help" is in the main doc directory
(define dest-dir (build-path (find-doc-dir) "help"))
(unless (directory-exists? dest-dir)
(make-directory* dest-dir))
(current-directory dest-dir)
(define index-file "hdindex")
(define (get-servlet-files dir)
(let* ([all-files
(map (lambda (f) (build-path dir f))
(directory-list dir))]
[servlet-files
(filter
(lambda (s)
(regexp-match #rx#"[.]ss$" (path->bytes s)))
all-files)]
[dirs
(filter directory-exists? all-files)])
(let* ([all-files
(map (lambda (f) (build-path dir f))
(directory-list dir))]
[servlet-files
(filter
(lambda (s)
(regexp-match #rx#"[.]ss$" (path->bytes s)))
all-files)]
[dirs
(filter directory-exists? all-files)])
(apply append servlet-files
(map get-servlet-files dirs))))
; path is absolute, and has the servlet dir as a prefix
(map get-servlet-files dirs))))
; path is absolute, and has the servlet dir as a prefix
(define (relativize-and-slashify path)
(let* ([exp-path (explode-path path)]
[prefix-len (sub1 exploded-servlet-dir-len)]
[relative-exp-path
(let loop ([p exp-path]
[n 0])
; leave off prefix up to servlet dir
(if (>= n prefix-len)
p
(loop (cdr p) (add1 n))))])
[prefix-len (sub1 exploded-servlet-dir-len)]
[relative-exp-path
(let loop ([p exp-path]
[n 0])
; leave off prefix up to servlet dir
(if (>= n prefix-len)
p
(loop (cdr p) (add1 n))))])
(fold-into-web-path relative-exp-path)))
; (listof string) -> string
; result is forward-slashed web path
; e.g. ("foo" "bar") -> "foo/bar"
@ -75,18 +70,17 @@
(path->bytes s)))
#f
lst))
(define index '())
(define (add-index-entry! val file name title)
(set! index
(cons
(list val
(bytes-append #"/" (relativize-and-slashify file))
name
title)
index)))
(set! index
(cons (list val
(bytes-append #"/" (relativize-and-slashify file))
name
title)
index)))
(define (gen-index dir)
(let* ([all-files (directory-list)]
[servlet-files (get-servlet-files dir)])
@ -96,7 +90,7 @@
[title-value file])
(let loop ()
(let ([sexp (with-handlers ([exn:fail:read?
(lambda (x)
(lambda (x)
(fprintf (current-error-port)
"couldn't read ~a: ~a\n"
file