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

General links module, ability to specify extra html <head> material.

Browse Source
This commit is contained in:
Eli Barzilay 2010-06-05 11:57:42 -04:00
parent 69b5c55508
commit e09d6567c8
3 changed files with 57 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -57,15 +57,18 @@
#:link-title [linktitle label]
#:window-title [wintitle @list{Racket: @label}]
#:full-width [full-width #f]
#:extra-headers [headers #f]
#:extra-body-attrs [body-attrs #f]
#:resources resources ; see below
#:referrer [referrer
(lambda (url . more)
(a href: url (if (null? more) linktitle more)))]
;; will be used instead of `this' to determine navbar highlights
#:part-of [part-of #f]
content)
(define (page)
(let* ([head (resources 'head wintitle)]
[navbar (resources 'navbar this)]
(let* ([head (resources 'head wintitle headers)]
[navbar (resources 'navbar (or part-of this))]
[content (list navbar (if full-width
content
(div class: 'bodycontent content)))])
@ -136,7 +139,7 @@
@link[rel: "icon" href: icon type: "image/ico"]
@link[rel: "shortcut icon" href: icon]
style))
(lambda (title*) (head @title[title*] headers)))
(lambda (title* more-headers) (head @title[title*] headers more-headers)))
(define (make-resources icon logo style)
(let ([make-head (html-head-maker icon style)]
@ -155,4 +158,4 @@
(begin (define resources
(make-resources (make-icon dir) (make-logo dir) (make-style dir)))
(define-syntax-rule (page-id . xs)
(page #:resources resources #:dir "www" . xs))))
(page #:resources resources #:dir dir . xs))))

46
collects/meta/web/common/links.rkt Normal file
View File

@ -0,0 +1,46 @@
#lang at-exp s-exp meta/web/html
(define-syntax-rule (define* id E) (begin (define id E) (provide id)))
;; ----------------------------------------------------------------------------
;; Pages that are made outside of this system
(define* -planet @a[href: "http://planet.racket-lang.org/"]{PLaneT})
(define doc-url "http://docs.racket-lang.org/")
(define* -docs @a[href: doc-url]{Documentation})
(define-syntax-rule (define-doc-link id desc)
(define* id @a[href: `(,doc-url id "/")]{
@strong{@(string-titlecase (symbol->string 'id))}: @desc}))
@define-doc-link[quick]{An Introduction to Racket with Pictures}
@define-doc-link[more ]{Systems Programming with Racket}
@define-doc-link[guide]{Racket}
(define* intros (list quick more guide))
;; ----------------------------------------------------------------------------
;; External links
(define* -htdp
@a[href: "http://www.htdp.org/"]{@i{How to Design Programs}})
(define* -teachscheme
@a[href: "http://www.teach-scheme.org/"]{TeachScheme!})
(define* -cookbook
@a[href: "http://schemecookbook.org/"]{Schematics Scheme Cookbook})
(define* -schematics
@a[href: "http://sourceforge.net/projects/schematics/"]{Schematics})
(define* -schemers
@a[href: "http://schemers.org/"]{@tt{schemers.org}})
(define* -plai
@a[href: "http://www.plai.org/"]{
@i{Programming Languages: Application and Interpretation}})
(define* -bootstrap @a[href: "http://www.bootstrapworld.org/"]{Bootstrap})

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

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