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

add up-links to documents in the main doc dir; add plain-install makefile targets

Browse Source 
svn: r8466
This commit is contained in:
Matthew Flatt 2008-01-29 21:27:34 +00:00
parent 6e2e7d9447
commit 6ddbaba736
5 changed files with 173 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/help/installer.ss
View File

@ -19,9 +19,9 @@
(lambda (variant)
(parameterize ([current-launcher-variant variant])
(make-mred-launcher '("-l" "help/help")
(mred-program-launcher-path "PLT Help")
(mred-program-launcher-path "plt-help")
(append
'((exe-name . "PLT Help")
'((exe-name . "plt-help")
(relative? . #t))
(build-aux-from-path
(build-path (collection-path "help") "help"))))))

264
collects/scribble/html-render.ss
View File

@ -39,6 +39,9 @@
p
(main-collects-relative->path p))))
(define (toc-part? d)
(part-style? d 'toc))
;; HTML anchors are case-insenstive. To make them
;; distinct, add a "." in front of capital letters.
;; Also clean up characters that give browers trouble
@ -76,7 +79,8 @@
format-number
quiet-table-of-contents)
(init-field [css-path #f])
(init-field [css-path #f]
[up-path #f])
(define/override (get-suffix) #".html")
@ -330,12 +334,137 @@
(div ((class "maincolumn"))
(div ((class "main"))
,@(render-version d ri)
,@(render-part d ri)))))])
,@(navigation d ri)
,@(render-part d ri)
,@(navigation d ri)))))])
(unless css-path
(install-file scribble-css))
(printf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n")
(xml:write-xml/content (xml:xexpr->xml xpr)))))
(define/private (part-parent d ri)
(collected-info-parent (part-collected-info d ri)))
(define/private (find-siblings d ri)
(let ([parent (collected-info-parent (part-collected-info d ri))])
(let loop ([l (if parent
(part-parts parent)
(if (or (null? (part-parts d))
(not (part-whole-page? (car (part-parts d)) ri)))
(list d)
(list d (car (part-parts d)))))]
[prev #f])
(cond
[(eq? (car l) d) (values prev
(and (pair? (cdr l))
(cadr l)))]
[else (loop (cdr l) (car l))]))))
(define contents-content '("contents"))
(define index-content '("index"))
(define prev-content '(larr " prev"))
(define up-content '("up"))
(define next-content '("next " rarr))
(define no-next-content next-content)
(define sep-element (make-element #f '(nbsp nbsp)))
(define/public (derive-filename d) "bad.html")
(define/private (navigation d ri)
(let ([parent (part-parent d ri)])
(let*-values ([(prev next) (find-siblings d ri)]
[(prev) (if prev
(let loop ([prev prev])
(if (and (toc-part? prev)
(pair? (part-parts prev)))
(loop (car (last-pair (part-parts prev))))
prev))
(and parent
(toc-part? parent)
parent))]
[(next) (cond
[(and (toc-part? d)
(pair? (part-parts d)))
(car (part-parts d))]
[(and (not next)
parent
(toc-part? parent))
(let-values ([(prev next)
(find-siblings parent ri)])
next)]
[else next])]
[(index) (let loop ([d d])
(let ([p (part-parent d ri)])
(if p
(loop p)
(let ([subs (part-parts d)])
(and (pair? subs)
(let ([d (car (last-pair subs))])
(and (part-style? d 'index)
d)))))))])
(if (and (not prev)
(not next)
(not parent)
(not index)
(not up-path))
null
`((div ([class "navleft"])
,@(render-content
(append
(list
(make-element
(if parent
(make-target-url "index.html" #f)
"nonavigation")
contents-content))
(if index
(list
'nbsp
(if (eq? d index)
(make-element
"nonavigation"
index-content)
(make-link-element
#f
index-content
(car (part-tags index)))))
null))
d
ri))
(div ([class "navright"])
,@(render-content
(list
(make-element
(if parent
(make-target-url (if prev
(derive-filename prev)
"index.html")
#f)
"nonavigation")
prev-content)
sep-element
(make-element
(if (or parent
up-path)
(make-target-url
(if parent
(if (toc-part? parent)
(derive-filename parent)
"index.html")
up-path)
#f)
"nonavigation")
up-content)
sep-element
(make-element
(if next
(make-target-url (derive-filename next) #f)
"nonavigation")
next-content))
d
ri))
(p nbsp))))))
(define/override (render-one d ri fn)
(render-one-part d ri fn null))
@ -636,7 +765,7 @@
(current-subdirectory))
(super get-dest-directory)))
(define/private (derive-filename d)
(define/override (derive-filename d)
(let ([fn (format "~a.html" (regexp-replace*
"[^-a-zA-Z0-9_=]"
(let ([s (cadr (car (part-tags d)))])
@ -659,9 +788,6 @@
(define/override (current-part-whole-page? d)
((collecting-sub) . <= . 2))
(define/private (toc-part? d)
(part-style? d 'toc))
(define/override (collect-part d parent ci number)
(let ([prev-sub (collecting-sub)])
(parameterize ([collecting-sub (if (toc-part? d)
@ -699,122 +825,9 @@
(define/override (toc-wrap p)
(list p))
(define contents-content '("contents"))
(define index-content '("index"))
(define prev-content '(larr " prev"))
(define up-content '("up"))
(define next-content '("next " rarr))
(define no-next-content next-content)
(define sep-element (make-element #f '(nbsp nbsp)))
(inherit render-table
render-paragraph)
(define/override (render-version r i)
null)
(define/private (find-siblings d ri)
(let ([parent (collected-info-parent (part-collected-info d ri))])
(let loop ([l (if parent
(part-parts parent)
(if (null? (part-parts d))
(list d)
(list d (car (part-parts d)))))]
[prev #f])
(cond
[(eq? (car l) d) (values prev
(and (pair? (cdr l))
(cadr l)))]
[else (loop (cdr l) (car l))]))))
(define/private (part-parent d ri)
(collected-info-parent (part-collected-info d ri)))
(define/private (navigation d ri)
(let ([parent (part-parent d ri)])
(let*-values ([(prev next) (find-siblings d ri)]
[(prev) (if prev
(let loop ([prev prev])
(if (and (toc-part? prev)
(pair? (part-parts prev)))
(loop (car (last-pair (part-parts prev))))
prev))
(and parent
(toc-part? parent)
parent))]
[(next) (cond
[(and (toc-part? d)
(pair? (part-parts d)))
(car (part-parts d))]
[(and (not next)
parent
(toc-part? parent))
(let-values ([(prev next)
(find-siblings parent ri)])
next)]
[else next])]
[(index) (let loop ([d d])
(let ([p (part-parent d ri)])
(if p
(loop p)
(let ([subs (part-parts d)])
(and (pair? subs)
(let ([d (car (last-pair subs))])
(and (part-style? d 'index)
d)))))))])
`((div ([class "navleft"])
,@(render-content
(append
(list
(make-element
(if parent
(make-target-url "index.html" #f)
"nonavigation")
contents-content))
(if index
(list
'nbsp
(if (eq? d index)
(make-element
"nonavigation"
index-content)
(make-link-element
#f
index-content
(car (part-tags index)))))
null))
d
ri))
(div ([class "navright"])
,@(render-content
(list
(make-element
(if parent
(make-target-url (if prev
(derive-filename prev)
"index.html")
#f)
"nonavigation")
prev-content)
sep-element
(make-element
(if parent
(make-target-url
(if (toc-part? parent)
(derive-filename parent)
"index.html")
#f)
"nonavigation")
up-content)
sep-element
(make-element
(if next
(make-target-url (derive-filename next) #f)
"nonavigation")
next-content))
d
ri))))))
(define/override (render-part d ri)
(parameterize ([current-version
(if (and (versioned-part? d)
@ -841,17 +854,8 @@
(let ([sep? (on-separate-page)])
(parameterize ([next-separate-page (toc-part? d)]
[on-separate-page #f])
(if sep?
;; Navigation bars;
`(,@(super render-version d ri)
,@(navigation d ri)
(p nbsp)
,@(super render-part d ri)
(p nbsp)
,@(navigation d ri)
(p nbsp))
;; Normal section render
(super render-part d ri))))]))))
;; Normal section render
(super render-part d ri)))]))))
(super-new)))

4
collects/scribblings/more/more.scrbl
View File

@ -38,7 +38,7 @@
" in plain text: "
(link file "step " which) ".")))
@title{@bold{More}: Systems Programming with PLT Scheme (in Plain Text)}
@title{@bold{More}: Systems Programming with PLT Scheme}
In contrast to the impression that @|quick| may give, PLT Scheme is
not just another pretty face. Underneath the graphical facade of
@ -50,7 +50,7 @@ servlet-extensible, continuation-based web server. We use much more of
the language than in @|quick|, and we expect you to click on syntax or
function names that you don't recognize (which will take you to the
relevant documentation). Beware that the last couple of sections
present material that is normally considered difficult, so if you're
present material that is normally considered difficult. If you're
still new to Scheme and have relatively little programming experience,
you may want to skip to @|guide|.

5
collects/setup/scribble.ss
View File

@ -245,7 +245,10 @@
(doc-dest-dir doc))]
[css-path (if (doc-under-main? doc)
"../scribble.css"
#f)])))
#f)]
[up-path (if (doc-under-main? doc)
"../index.html"
#f)])))
(define (pick-dest latex-dest doc)
(if latex-dest

35
src/Makefile.in
View File

@ -57,6 +57,12 @@ SETUP_ARGS = -X "$(DESTDIR)$(collectsdir)" -l setup
install:
$(MAKE) install-@MAIN_VARIANT@
plain-install:
if [ "$(DESTDIR)" != "" ]; then \
echo "cannot use plain-install with DESTDIR=$(DESTDIR)"; exit 1; \
fi
$(MAKE) plain-install-@MAIN_VARIANT@
install-common-first:
mkdir -p $(ALLDIRINFO)
@ -88,7 +94,7 @@ install-no-post-collects:
fix-paths:
if [ "$(DESTDIR)" != "" ]; then \
mzscheme/mzscheme@CGC@ -mvxqu \
mzscheme/mzscheme@CGC@ -u \
"$(srcdir)/../collects/setup/unixstyle-install.ss" \
make-install-destdir-fix "$(srcdir)/.." \
$(ALLDIRINFO) "@INSTALL_ORIG_TREE@"; \
@ -96,14 +102,21 @@ fix-paths:
# 3m install ----------------------------------------
install-3m:
install-3m-common:
$(MAKE) install-common-first
cd mzscheme; $(MAKE) install-3m
$(MAKE) install-@MAKE_MRED@-3m
$(MAKE) install-common-middle
install-3m:
$(MAKE) install-3m-common
mzscheme/mzscheme@MMM@ $(SETUP_ARGS)
$(MAKE) install-common-last
plain-install-3m:
$(MAKE) install-3m-common
$(MAKE) install-common-last
install-no-3m:
cd .
@ -112,14 +125,21 @@ install-mred-3m:
# CGC install ----------------------------------------
install-cgc:
install-cgc-common:
$(MAKE) install-common-first
cd mzscheme; $(MAKE) install-cgc
$(MAKE) install-@MAKE_MRED@-cgc
$(MAKE) install-common-middle
install-cgc:
$(MAKE) install-cgc-common
mzscheme/mzscheme@CGC@ $(SETUP_ARGS)
$(MAKE) install-common-last
plain-install-cgc:
$(MAKE) install-cgc-common
$(MAKE) install-common-last
install-no-cgc:
cd .
@ -128,14 +148,21 @@ install-mred-cgc:
# Both install ----------------------------------------
install-both:
install-both-common:
$(MAKE) install-common-first
cd mzscheme; $(MAKE) install-both
$(MAKE) install-@MAKE_MRED@-both
$(MAKE) install-common-middle
install-both:
$(MAKE) install-both-common
mzscheme/mzscheme@MAIN_VARIANT@ $(SETUP_ARGS)
$(MAKE) install-common-last
plain-install-both:
$(MAKE) install-both-common
$(MAKE) install-common-last
install-no-both:
cd .