diff --git a/collects/meta/web/common/layout.rkt b/collects/meta/web/common/layout.rkt index 66093763f3..2334a3a285 100644 --- a/collects/meta/web/common/layout.rkt +++ b/collects/meta/web/common/layout.rkt @@ -19,6 +19,15 @@ [body #`(lambda () (text #,@xs))]) #'(layouter id ... x ... body))]))) +(define (id->file who id sfx dir) + (let* ([f (and id (symbol->string (force id)))] + [f (cond [(and f (regexp-match #rx"[.]" f)) f] + [(and f sfx) + (string-append f (regexp-replace #rx"^[.]?" sfx "."))] + [else (error 'who "missing `#:file', or `#:id'~a" + (if sfx "" " and `#:suffix'"))])]) + (if dir (web-path dir f) f))) + ;; The following are not intended for direct use, see ;; `define+provide-context' below (it could be used with #f for the ;; directory if this ever gets used for a flat single directory web @@ -28,12 +37,7 @@ (define-syntax (plain stx) (syntax-case stx () [(_ . xs) (process-contents 'plain #'plain* stx #'xs)])) (define (plain* #:id [id #f] #:suffix [suffix #f] #:dir [dir #f] - #:file - [file (if (and id suffix) - (let ([f (format "~a.~a" (force id) suffix)]) - (if dir (web-path dir f) f)) - (error 'plain - "missing `#:file', or `#:id' and `#:suffix'"))] + #:file [file (id->file 'plain id suffix dir)] #:referrer [referrer (lambda (url) (error 'plain "no referrer for ~e" file))] @@ -48,15 +52,13 @@ (syntax-case stx () [(_ . xs) (process-contents 'page #'page* stx #'xs)])) (define (page* #:id [id #f] #:dir [dir #f] - #:file [file (if id - (format "~a.html" (force id)) - (error 'page "missing `#:file' or `#:id'"))] + #:file [file (id->file 'page id "html" dir)] #:title [label (if id (let* ([id (->string (force id))] [id (regexp-replace #rx"^.*/" id "")] [id (regexp-replace #rx"-" id " ")]) (string-titlecase id)) - (error 'page "missing `#:file' or `#:title'"))] + (error 'page "missing `#:id' or `#:title'"))] #:link-title [linktitle label] #:window-title [wintitle @list{Racket: @label}] #:full-width [full-width #f] @@ -79,9 +81,7 @@ @(if body-attrs (apply body `(,@body-attrs ,content)) (body content))})) - (define this - (resource (if dir (web-path dir file) file) - (file-writer output-xml page) referrer)) + (define this (resource file (file-writer output-xml page) referrer)) this) (provide set-navbar!) diff --git a/collects/meta/web/common/links.rkt b/collects/meta/web/common/links.rkt index 048c9e66af..6136312853 100644 --- a/collects/meta/web/common/links.rkt +++ b/collects/meta/web/common/links.rkt @@ -2,22 +2,26 @@ (define-syntax-rule (define* id E) (begin (define id E) (provide id))) +(define ((make-link url . text) . alternate) + (a href: url (if (null? alternate) text alternate))) + ;; ---------------------------------------------------------------------------- ;; Pages that are made outside of this system -(define* -planet @a[href: "http://planet.racket-lang.org/"]{PLaneT}) +(define* -planet @make-link["http://planet.racket-lang.org/"]{PLaneT}) (define doc-url "http://docs.racket-lang.org/") -(define* -docs @a[href: doc-url]{Documentation}) +(define* -docs @make-link[doc-url]{Documentation}) (define-syntax-rule (define-doc-link id desc) - (define* id @a[href: `(,doc-url id "/")]{ + (define* id @make-link[`(,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-doc-link[continue]{Continue} (define* intros (list quick more guide)) @@ -25,22 +29,25 @@ ;; External links (define* -htdp - @a[href: "http://www.htdp.org/"]{@i{How to Design Programs}}) + @make-link["http://www.htdp.org/"]{@i{How to Design Programs}}) + +(define* -redex + @make-link["http://redex.plt-scheme.org/"]{Redex}) (define* -teachscheme - @a[href: "http://www.teach-scheme.org/"]{TeachScheme!}) + @make-link["http://www.teach-scheme.org/"]{TeachScheme!}) (define* -cookbook - @a[href: "http://schemecookbook.org/"]{Schematics Scheme Cookbook}) + @make-link["http://schemecookbook.org/"]{Schematics Scheme Cookbook}) (define* -schematics - @a[href: "http://sourceforge.net/projects/schematics/"]{Schematics}) + @make-link["http://sourceforge.net/projects/schematics/"]{Schematics}) (define* -schemers - @a[href: "http://schemers.org/"]{@tt{schemers.org}}) + @make-link["http://schemers.org/"]{@tt{schemers.org}}) (define* -plai - @a[href: "http://www.plai.org/"]{ + @make-link["http://www.plai.org/"]{ @i{Programming Languages: Application and Interpretation}}) -(define* -bootstrap @a[href: "http://www.bootstrapworld.org/"]{Bootstrap}) +(define* -bootstrap @make-link["http://www.bootstrapworld.org/"]{Bootstrap}) diff --git a/collects/meta/web/www/code.rkt b/collects/meta/web/www/code.rkt new file mode 100644 index 0000000000..af387bc0de --- /dev/null +++ b/collects/meta/web/www/code.rkt @@ -0,0 +1,134 @@ +#lang at-exp s-exp "shared.rkt" + +(require syntax-color/module-lexer + setup/xref + scribble/xref) + +(provide code) + +(define doc-root "http://docs.racket-lang.org/") + +(define expand-namespace (make-base-namespace)) +(define xref (load-collections-xref)) + +(define (code . strs) + (let* ([str (apply string-append strs)] + [bstr (string->bytes/utf-8 + (regexp-replace* #rx"(?m:^$)" str "\xA0"))] + [in (open-input-bytes bstr)]) + (let* ([tokens + (let loop ([mode #f]) + (let-values ([(lexeme type data start end backup-delta mode) + (module-lexer in 0 mode)]) + (if (eof-object? lexeme) + null + (cons (list type (sub1 start) (sub1 end) 0) + (loop mode)))))] + [substring* (lambda (bstr start [end (bytes-length bstr)]) + (bytes->string/utf-8 (subbytes bstr start end)))] + [e (parameterize ([read-accept-reader #t] + [current-namespace expand-namespace]) + (expand (read-syntax 'prog (open-input-bytes bstr))))] + [ids (let loop ([e e]) + (cond + [(and (identifier? e) + (syntax-original? e)) + (let ([pos (sub1 (syntax-position e))] + [b (identifier-binding e)]) + (list (list (if (and (list? b) + (let-values ([(name base) (module-path-index-split (car b))]) + (or name base))) + (let ([tag (xref-binding->definition-tag xref e 0)]) + (if tag + (cons (if (eq? (car tag) 'form) + 'linkimportform + 'linkimportid) + (let-values ([(p a) (xref-tag->path+anchor + xref tag + #:external-root-url doc-root)]) + (format "~a#~a" p a))) + 'importid)) + 'id) + pos + (+ pos (syntax-span e)) + 1)))] + [(syntax? e) (append (loop (syntax-e e)) + (loop (or (syntax-property e 'origin) + null)) + (loop (or (syntax-property e 'disappeared-use) + null)))] + [(pair? e) (append (loop (car e)) (loop (cdr e)))] + [else null]))] + [link-mod (lambda (mp-stx priority #:orig? [always-orig? #f]) + (if (or always-orig? + (syntax-original? mp-stx)) + (let ([mp (syntax->datum mp-stx)]) + (let-values ([(p a) + (xref-tag->path+anchor + xref + `(mod-path ,(format "~s" mp)) + #:external-root-url doc-root)]) + (if p + (list (let ([pos (sub1 (syntax-position mp-stx))]) + (list (cons 'modpath (format "~a#~a" p a)) + pos + (+ pos (syntax-span mp-stx)) + priority))) + null))) + null))] + [mods (let loop ([e e]) + (syntax-case e (module require begin) + [(module name lang (mod-beg form ...)) + (apply append + (link-mod #'lang 2) + (map loop (syntax->list #'(form ...))))] + [(#%require spec ...) + (apply append + (map (lambda (spec) + ;; Need to add support for renaming forms, etc.: + (if (module-path? (syntax->datum spec)) + (link-mod spec 2) + null)) + (syntax->list #'(spec ...))))] + [(begin form ...) + (apply append + (map loop (syntax->list #'(form ...))))] + [else null]))] + [language (if (regexp-match? #rx"^#lang " bstr) + (let ([m (regexp-match #rx"^#lang ([-a-zA-Z/._+]+)" bstr)]) + (if m + (link-mod + #:orig? #t + (datum->syntax #f + (string->symbol (bytes->string/utf-8 (cadr m))) + (vector 'in 1 6 7 (bytes-length (cadr m)))) + 3) + null)) + null)] + [tokens (sort (append ids + mods + language + (filter (lambda (x) (not (eq? (car x) 'symbol))) + ;; Drop #lang entry: + (cdr tokens))) + (lambda (a b) + (or (< (cadr a) (cadr b)) + (and (= (cadr a) (cadr b)) + (> (cadddr a) (cadddr b))))))]) + (apply pre (let loop ([pos 0] + [tokens tokens]) + (cond + [(null? tokens) (list (substring* bstr pos))] + [(eq? (caar tokens) 'white-space) (loop pos (cdr tokens))] + [(= pos (cadar tokens)) + (cons (let ([style (caar tokens)] + [s (substring* bstr (cadar tokens) (caddar tokens))]) + (if (pair? style) + (a href: (cdr style) class: (format "code~a" (car style)) s) + (span class: (format "code~a" style) s))) + (loop (caddar tokens) (cdr tokens)))] + [(> pos (cadar tokens)) + (loop pos (cdr tokens))] + [else (cons + (substring* bstr pos (cadar tokens)) + (loop (cadar tokens) tokens))])))))) diff --git a/collects/meta/web/www/download-dark.png b/collects/meta/web/www/download-dark.png new file mode 100644 index 0000000000..d73b9d6e63 Binary files /dev/null and b/collects/meta/web/www/download-dark.png differ diff --git a/collects/meta/web/www/download.png b/collects/meta/web/www/download.png new file mode 100644 index 0000000000..56d925bfe9 Binary files /dev/null and b/collects/meta/web/www/download.png differ diff --git a/collects/meta/web/www/index.rkt b/collects/meta/web/www/index.rkt index de62d4b04e..bd9b8607e8 100644 --- a/collects/meta/web/www/index.rkt +++ b/collects/meta/web/www/index.rkt @@ -1,6 +1,593 @@ #lang at-exp s-exp "shared.rkt" +(require "code.rkt" "outreach+research.rkt" racket/string) + +(define (doc s) + (string-append "http://docs.racket-lang.org/" s)) + +(define-struct example (code desc)) +(define-struct (cmdline-example example) ()) +(define-struct (scribble-example example) ()) +(define-struct (graphical-example example) ()) + +(define (desc . strs) (apply div strs)) +(define (elemcode . strs) (apply tt strs)) + (provide index) (define index (page #:link-title "About" #:window-title "Racket" - "TODO")) + #:extra-headers (delay more.css) + (div class: 'whatpane + @span{@span[class: 'whatb]{Racket} is a programming language.}) + (div class: 'aboutpane + (div class: 'panetitle "Start Quickly") + (div class: 'downloadbutton download-plt) + (alts-panel + @; --- Each example here should be exactly 7 lines long --- + @; Candidates for initial example: ------------------------ + (list + (example + @code{ + #lang racket + ;; Finds Racket sources in all subdirs + (for ([path (in-directory)]) + (when (regexp-match? #rx"[.]rkt$" path) + (printf "source file: ~a\n" path))) + + + } + @desc{ + The @elemcode{in-directory} function constructs + a sequence that walks a directory tree (starting with + the current directory, by default) and generates + paths in the tree. The @elemcode{for} + form binds @elemcode{p} to each path in the sequence, + and @elemcode{regexp-match?} applies a pattern to + the path.}) + (example + @code{ + #lang web-server/insta + ;; A "hello world" web server + (define (start request) + '(html + (body "Hello World"))) + + + } + @desc{ + This example implements a web server using the + @elemcode{web-server/insta} language. Each time a connection + is made to the server, the @elemcode{start} function is + called to get the HTML to send back to the client. + }) + (example + @code{ + #lang racket ; An echo server + (define listener (tcp-listen 12345)) + (let echo-server () + (define-values (in out) (tcp-accept listener)) + (thread (lambda () (copy-port in out) + (close-output-port out))) + (echo-server)) + } + @desc{ + Racket makes it easy to use TCP sockets and spawn + threads to handle them. This program starts a server + at TCP port 12345 that echos anything a client sends + back to the client. + }) + (example + @code{ + #lang racket + ;; Report each unique line from stdin + (let ([saw (make-hash)]) + (for ([line (in-lines)]) + (unless (hash-ref saw line #f) + (displayln line)) + (hash-set! saw line #t))) + } + @desc{ + Uses a hash table to record previously seen lines. + You can run this program in DrRacket, but it makes more + sense from the command line. + }) + ) + @; Additional examples: -------------------------- + (list + (graphical-example + @code{ + #lang racket ; A picture + (require 2htdp/image) + (let sierpinski ([n 6]) + (if (zero? n) + (triangle 2 'solid 'red) + (let ([next (sierpinski (- n 1))]) + (above next (beside next next))))) + } + @desc{ + The @elemcode{2htdp/image} library provides easy-to-use + functions for constructing images, and DrRacket can display + an image result as easily as it can display a number result. + In this case, a @elemcode{sierpinski} function is defined and + called (at the same time) to generate a Sierpinski triangle + of depth 6. + }) + (graphical-example + @code{ + #lang racket/gui ; A GUI guessing game + (define f (new frame% [label "Guess"])) + (define n (random 5)) (send f show #t) + (define ((check i) btn evt) + (message-box "." (if (= i n) "Yes" "No"))) + (for ([i (in-range 5)]) + (make-object button% (format "~a" i) f (check i))) + } + @desc{ + This simple guesing game demonstates Racket's + class-based GUI toolkit. The + @elemcode{frame%} class implements a + top-level window, and @elemcode{button%} obviously + implements a button. The @elemcode{check} function + defined here produces an function that is used + for the button's callback action. + }) + (example + @code{ + #lang racket ; Simple web scraper + (require net/url net/uri-codec) + (define (let-me-google-that-for-you str) + (let* ([g "http://www.google.com/search?q="] + [u (string-append g (uri-encode str))] + [rx #rx"(?<=