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

Make the scribble/html' layout mimic the one for scribble/text'.

Browse Source 
Ie, the difference between using it as a language and as a module is now
the same in both.  Also, improve `scribble/html' (and
`scribble/html/htmllang') by reproviding most of the corresponding text
modules.

Change `meta/web' accordingly, and improve code by making a new langugae
(`#lang meta/web').  This language is similar to `scribble/html' except
that it uses the plain scribble reader (not the `-inside' one), it
doesn't use the customized module-begin feature (that uses
`output-xml'), and it adds all the relevant bits of `meta/web/common'.
(Also, "meta/web/common.rkt" is gone, since it's used only as a language
now.)

This commit has lots of details and binding games, so it's tricky, and
potentially caused some problems.  (Took me a while to track many
breakages, so I won't be surprised if there are more.)
This commit is contained in:
Eli Barzilay 2010-10-26 15:36:29 -04:00
parent ca040ea42a
commit 82221a51db
46 changed files with 130 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/meta/web/common.rkt
View File

@ -1,4 +0,0 @@
#lang racket/base
(require "common/main.rkt")
(provide (all-from-out "common/main.rkt"))

4
collects/meta/web/common/extras.rkt
View File

@ -1,4 +1,6 @@
#lang at-exp s-exp scribble/html
#lang at-exp racket/base
(require scribble/html (only-in scribble/html/htmllang #%top))
;; list of a header paragraphs and sub paragraphs (don't use `p' since it looks
;; like they should not be nested)

8
collects/meta/web/common/layout.rkt
View File

@ -1,6 +1,8 @@
#lang at-exp s-exp scribble/html
#lang at-exp racket/base
(require (for-syntax racket/base syntax/name) "utils.rkt" "resources.rkt")
(require scribble/html (only-in scribble/html/htmllang #%top)
(for-syntax racket/base syntax/name)
"utils.rkt" "resources.rkt")
(define-for-syntax (process-contents who layouter stx xs)
(let loop ([xs xs] [kws '()] [id? #f])
@ -16,7 +18,7 @@
(syntax-local-name))])
(if name (list '#:id `',name) '())))]
;; delay body, allow definitions
[body #`(lambda () (text #,@xs))])
[body #`(lambda () (begin/text #,@xs))])
#'(layouter id ... x ... body))])))
(define (get-path who id file sfx dir)

4
collects/meta/web/common/links.rkt
View File

@ -1,4 +1,6 @@
#lang at-exp s-exp scribble/html
#lang at-exp racket/base
(require scribble/html (only-in scribble/html/htmllang #%top))
(define-syntax-rule (define* id E) (begin (define id E) (provide id)))

4
collects/meta/web/common/main.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require scribble/html
(require scribble/html/htmllang
"layout.rkt" "resources.rkt" "extras.rkt" "links.rkt" "utils.rkt")
(provide (all-from-out scribble/html
(provide (all-from-out scribble/html/htmllang
"layout.rkt" "resources.rkt" "extras.rkt" "links.rkt"
"utils.rkt"))

12
collects/meta/web/common/resources.rkt
View File

@ -1,4 +1,6 @@
#lang at-exp s-exp scribble/html
#lang at-exp racket/base
(require scribble/html (only-in scribble/html/htmllang #%top))
;; These are some resources that are shared across different toplevel
;; sites. They could be included from a single place, but then when one
@ -24,20 +26,20 @@
href: url title: "default"))))
(define page-sizes
@text{
@list{
margin-left: auto;
margin-right: auto;
width: 45em;
})
(define font-family
@text{
@list{
font-family: Optima, Arial, Verdana, Helvetica, sans-serif;
})
(define navbar-style
;; All of these are made to apply only inside `racketnav', so the styles can
;; be used in places with their own CSS (eg, blog.racket-lang.org)
@text{
@list{
.racketnav {
background-color: #000;
color: #fff;
@ -86,7 +88,7 @@
})
(define racket-style
@text{
@list{
@; ---- generic styles ----
html {
overflow-y: scroll;

4
collects/meta/web/common/utils.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp scribble/html
#lang at-exp racket/base
(require (for-syntax scheme/base))
(require scribble/html (for-syntax scheme/base))
(provide in-here)
(define-syntax (in-here stx)

5
collects/meta/web/download/download-pages.rkt
View File

@ -1,6 +1,7 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "data.rkt" "installer-pages.rkt" (prefix-in pre: "../stubs/pre.rkt"))
(require "shared.rkt" "data.rkt" "installer-pages.rkt"
(prefix-in pre: "../stubs/pre.rkt"))
(provide render-download-page)

4
collects/meta/web/download/index.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "data.rkt" "../www/download.rkt")
(require "shared.rkt" "data.rkt" "../www/download.rkt")
(define (in-ftp . paths)
(string-join (cons "/var/ftp/pub/racket" paths) "/"))

4
collects/meta/web/download/installer-pages.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "data.rkt")
(require "shared.rkt" "data.rkt")
(define (render-installer-page installer)
(define path (installer-path installer))

4
collects/meta/web/download/main.rkt
View File

@ -1,3 +1,3 @@
#lang at-exp s-exp "shared.rkt"
#lang racket/base
(require "index.rkt" "version.rkt")
(require "shared.rkt" "index.rkt" "version.rkt")

4
collects/meta/web/download/shared.rkt
View File

@ -1,5 +1,3 @@
#lang at-exp s-exp "../common.rkt"
(provide (all-from-out "../common.rkt"))
#lang meta/web
(define+provide-context "download")

4
collects/meta/web/download/version.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "data.rkt")
(require "shared.rkt" "data.rkt")
(define version.txt
(plain (format "~s" `((recent ,current-version) (stable ,current-version)))))

13
collects/meta/web/lang/reader.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang s-exp syntax/module-reader
meta/web/common/main
;; Similar to `#lang scribble/html', but with a plain scribble reader
;; (not the inside one).
#:read scribble:read
#:read-syntax scribble:read-syntax
#:info (scribble-base-reader-info)
(require (prefix-in scribble: scribble/reader)
(only-in scribble/base/reader scribble-base-reader-info))

2
collects/meta/web/minis/bugs.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(define-context "bugs")

2
collects/meta/web/minis/drracket.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(define-context "drracket")

2
collects/meta/web/minis/lists.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(provide mailing-lists-quick)

2
collects/meta/web/minis/main.rkt
View File

@ -1,3 +1,3 @@
#lang at-exp s-exp "../common.rkt"
#lang racket/base
(require "lists.rkt" "bugs.rkt" "drracket.rkt")

2
collects/meta/web/navbar.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "common.rkt"
#lang meta/web
(require "www/main.rkt" "download/main.rkt" "minis/main.rkt" "stubs/main.rkt")
(set-navbar! (list main download -docs planet community learning)

5
collects/meta/web/stubs/blog.rkt
View File

@ -1,7 +1,6 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(require "../common/resources.rkt"
(prefix-in www: (only-in "../www/shared.rkt" the-resources))
(require (prefix-in www: (only-in "../www/shared.rkt" the-resources))
racket/port)
(define-context "stubs/blog" #:resources www:the-resources)

2
collects/meta/web/stubs/dirlist.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
;; This stub is to generate fancy directory listings with the Racket style

2
collects/meta/web/stubs/git.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(define-context "stubs/git")

2
collects/meta/web/stubs/mailman.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(define-context "stubs/mailman")

2
collects/meta/web/stubs/main.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang racket/base
(provide planet)

2
collects/meta/web/stubs/planet.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(define-context "stubs/planet")

2
collects/meta/web/stubs/pre.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(require "git.rkt")

2
collects/meta/web/stubs/wiki.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "../common.rkt"
#lang meta/web
(require (prefix-in www: (only-in "../www/shared.rkt" the-resources)))

4
collects/meta/web/www/bib.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require scheme/list scheme/string scheme/dict scheme/promise scheme/function)
(require "shared.rkt")
;; bib values are hash tables mapping field names (symbols) to strings.
;; Keywords can also be used for the field names, which makes them meta-fields

7
collects/meta/web/www/code.rkt
View File

@ -1,8 +1,7 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require syntax-color/module-lexer
setup/xref
scribble/xref)
(require "shared.rkt"
syntax-color/module-lexer setup/xref scribble/xref)
(provide code)

4
collects/meta/web/www/community.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "people.rkt" "irc.rkt"
(require "shared.rkt" "people.rkt" "irc.rkt"
"../minis/lists.rkt"
"../stubs/blog.rkt" "../stubs/git.rkt"
(prefix-in pre: "../stubs/pre.rkt"))

4
collects/meta/web/www/download.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "../download/download-pages.rkt")
(require "shared.rkt" "../download/download-pages.rkt")
(provide download-button download)

6
collects/meta/web/www/guidelines.rkt
View File

@ -1,8 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(define name i)
(define (url str) (tt (a href: str str)))
(require "shared.rkt")
(define styles
@style/inline{

4
collects/meta/web/www/help.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "community.rkt")
(require "shared.rkt" "community.rkt")
(provide help)
(define help

4
collects/meta/web/www/index.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "code.rkt" "download.rkt" "learning.rkt")
(require "shared.rkt" "code.rkt" "download.rkt" "learning.rkt")
(define (doc s)
(string-append "http://docs.racket-lang.org/" s))

4
collects/meta/web/www/irc.rkt
View File

@ -1,4 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "shared.rkt")
(provide irc-quick)

4
collects/meta/web/www/learning.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "people.rkt" "techreports.rkt")
(require "shared.rkt" "people.rkt" "techreports.rkt")
(provide learning)
(define learning

2
collects/meta/web/www/main.rkt
View File

@ -1,4 +1,4 @@
#lang at-exp s-exp "shared.rkt"
#lang racket/base
(require "index.rkt" "download.rkt" "community.rkt" "learning.rkt" "help.rkt"
"new-name.rkt" "guidelines.rkt")

4
collects/meta/web/www/new-name.rkt
View File

@ -1,4 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "shared.rkt")
(define name i)

4
collects/meta/web/www/people.rkt
View File

@ -1,4 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "shared.rkt")
(define (make-all place person)
;; The first person in a place is the one responsible for it

4
collects/meta/web/www/shared.rkt
View File

@ -1,5 +1,3 @@
#lang at-exp s-exp "../common.rkt"
(provide (all-from-out "../common.rkt"))
#lang meta/web
(define+provide-context "www")

4
collects/meta/web/www/techreports.rkt
View File

@ -1,6 +1,6 @@
#lang at-exp s-exp "shared.rkt"
#lang meta/web
(require "people.rkt" "../download/data.rkt"
(require "shared.rkt" "people.rkt" "../download/data.rkt"
"bib.rkt" (prefix-in - version/utils))
;; New style TR entries -------------------------------------------------------

22
collects/scribble/html/htmllang.rkt Normal file
View File

@ -0,0 +1,22 @@
#lang racket/base
(require "main.rkt" scribble/text/textlang scribble/text/syntax-utils
(for-syntax racket/base))
(provide (except-out (all-from-out scribble/text/textlang)
#%top #%module-begin)
(rename-out [top #%top] [module-begin #%module-begin])
(all-from-out "main.rkt"))
(define-syntax (top stx)
(syntax-case stx ()
[(_ . x)
(let ([x* (syntax-e #'x)])
(if (and (symbol? x*) (regexp-match? #rx":$" (symbol->string x*)))
#''x
#'(#%top . x)))]))
(define-syntax-rule (module-begin expr ...)
(#%plain-module-begin
(port-count-lines! (current-output-port))
(process-begin/text begin output-xml expr ...)))

28
collects/scribble/html/main.rkt
View File

@ -1,27 +1,7 @@
#lang racket/base
(provide (except-out (all-from-out racket/base) #%top #%module-begin)
(rename-out [top #%top] [module-begin #%module-begin])
;; to be used as a text language (output via `output-xml')
(all-from-out scribble/text)
;; provide a `text' alias and an `include' alias
(rename-out [begin/text text] [include/text include])
;; main functionality
(all-from-out "xml.rkt" "html.rkt" "resource.rkt"
racket/list racket/string))
(require "xml.rkt" "html.rkt" "resource.rkt"
;; includes all of the scribble/text utilities
scribble/text)
(require "xml.rkt" "html.rkt" "resource.rkt" racket/list racket/string
scribble/text scribble/text/syntax-utils (for-syntax racket/base))
(define-syntax (top stx)
(syntax-case stx ()
[(_ . x)
(let ([x* (syntax-e #'x)])
(if (and (symbol? x*) (regexp-match? #rx":$" (symbol->string x*)))
#''x
#'(#%top . x)))]))
(define-syntax-rule (module-begin expr ...)
(#%plain-module-begin
(port-count-lines! (current-output-port))
(process-begin/text begin output-xml expr ...)))
(provide (all-from-out "xml.rkt" "html.rkt" "resource.rkt" scribble/text))

5
collects/scribble/text.rkt
View File

@ -1,5 +1,4 @@
#lang racket/base
(require racket/promise "text/output.ss" "text/syntax-utils.ss")
(provide (all-from-out racket/promise "text/output.ss")
begin/text include/text)
(require "text/main.rkt")
(provide (all-from-out "text/main.rkt"))

7
collects/scribble/text/main.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
(require "output.ss" "syntax-utils.ss"
racket/promise racket/list racket/string)
(provide (all-from-out "output.ss" racket/promise racket/list racket/string)
begin/text include/text)

8
collects/scribble/text/textlang.rkt
View File

@ -1,9 +1,9 @@
#lang racket/base
(require "syntax-utils.ss" "output.ss" racket/promise)
(require "syntax-utils.ss" "output.ss"
racket/promise racket/list racket/string)
(provide (except-out (all-from-out racket/base) #%module-begin)
(all-from-out "output.ss" racket/promise)
begin/text
(all-from-out "output.ss" racket/promise racket/list racket/string)
(rename-out [module-begin/text #%module-begin]
[include/text include]))
[begin/text text] [include/text include]))