racket/collects/meta/web/minis/lists.rkt
2011-06-16 21:37:47 -04:00

164 lines
6.4 KiB
Racket

#lang meta/web
(provide mailing-lists-quick)
(define-context "lists")
(struct ML (name gmane-name google-name description))
(define MLs
(list (ML "users" "user" "racket-users"
@text{A discussion list for all things related to Racket.
Ask your questions here!})
(ML "announce" "announce" #f
@text{A low-volume, moderated list for announcements, only.
@small{(These are posted on the @TT{users} list too, no need
to subscribe to both.)}})
(ML "dev" "devel" #f
@text{A mailing list for Racket development.
@small{(For people who want to see how the sausages are made
and help make them.)}})))
(define lists
@page[#:title "Mailing Lists" #:file "" #:part-of 'community
#:referrer values
(define (list-cells what) (map (lambda (r) (r what)) list-renderers))
]{
@p{This is the Racket mailing list server. We have three public mailing
lists listed below, with several mirrors for each one.}
@(define gap1
(tr (map (lambda (_) @td{@div[style: "height: 1ex;"]{}}) MLs)))
@(define gap2
(tr (map (lambda (_) @td{}) MLs)))
@(define (sec . text)
@list{@gap1
@tr{@td[style: '("background-color: #dddddd; font-weight: bold;"
" padding: 0;")
colspan: (length MLs)]{@text}}
@gap2})
@table[style: "width: 100%; margin: auto; text-align: center;"
frame: 'box rules: 'cols cellpadding: 5]{
@tr[style: "border-bottom: 1px solid; background-color: #ccccff;"]{
@(list-cells 'header-cell)}
@tr[valign: 'top style: "text-align: left;"]{@(list-cells 'description)}
@tr{@(list-cells 'main-page-cell)}
@tr{@(list-cells 'graph-cell)}
@sec{Subscription: enter your email here to subscribe to a mailing list}
@tr{@(list-cells 'subscribe-cell)}
@sec{Gmane Mirror}
@tr{@(list-cells 'gmane-cell)}
@sec{Archive at mail-archive.com}
@tr{@(list-cells 'mail-archive-cell)}
@sec{Google group mirror}
@tr{@(list-cells 'google-cell)}}})
(define (list-renderer ml)
(define name (ML-name ml))
(define at-domain "@racket-lang.org")
(define email (list name at-domain))
(define description (ML-description ml))
(define gmane
(let ([gm (ML-gmane-name ml)])
(and gm @list{gmane.comp.lang.racket.@(ML-gmane-name ml)})))
(define (gmane-link base . body)
(unless gmane
(error 'list-renderer "internal error: no gmane info for ~a" name))
(let* ([path (if (pair? base) (list "/" (cdr base) "/") "/")]
[base (if (pair? base) (car base) base)]
[pfx (if (regexp-match? #rx"://" base) base (list "http://" base))])
@a[href: (list pfx ".gmane.org" path gmane)]{@body}))
(define (mail-archive-link suffix . body)
@a[href: (list "http://www.mail-archive.com/" email "/" suffix)]{@body})
(define google-groups-url
(let ([g (ML-google-name ml)])
(and g (list "http://groups.google.com/group/" g "/"))))
(define (form-cell url #:method [method 'get] . body)
@td{@form[action: url method: method
style: "display: inline; clear: none;"]{
@div{@body}}})
(lambda (what)
(case what
[(header-cell)
@th[style: "width: 33%;"]{
@; the mixed styles will help against some spam harvesting too
@span[style: '("font-size: x-large;"
" font-family: monospace; font-weight: bold;")]{
@TT{@name}@;
@span[style: "font-size: small;"]{@at-domain}}}]
[(description) @td{@description}]
[(main-page-cell)
@td{@big{@b{@TT{@name}}}
@a[href: (list name "/")]{page}
@bull
@a[href: (list name "/archive/")]{archive}}]
[(graph-cell)
@td{@img[src: (list "http://gmane.org/plot-rate.php?group=" gmane)
style: "width: 80%;"]}]
[(subscribe-cell)
@form-cell[(list name "/subscribe") #:method 'post]{
@input[type: 'text name: 'email size: 20 value: ""]}]
[(google-cell)
(if google-groups-url
@form-cell[(list google-groups-url "search")]{
@a[href: google-groups-url]{
@(string-titlecase
(regexp-replace* #rx"-" (ML-google-name ml) " "))}
@br
@span[style: "white-space: nowrap;"]{
Search: @input[type: 'text name: 'q value: "" size: 20].}}
@td{@small{—none—}})]
[(mail-archive-cell)
@form-cell["http://www.mail-archive.com/search"]{
@input[type: 'hidden name: 'l value: email]
@mail-archive-link["info.html"]{Archive}
@bull
@mail-archive-link[""]{Browse}
@bull
@mail-archive-link["maillist.xml"]{RSS}
@br
@span[style: "white-space: nowrap;"]{
Search: @input[type: 'text name: 'q value: "" size: 20].}}]
[(gmane-cell)
@form-cell["http://search.gmane.org/"]{
@input[type: 'hidden name: 'group value: gmane]
@gmane-link["dir"]{@TT{@gmane}}
@br
@gmane-link["news"]{threaded}
@bull
@gmane-link["blog"]{blog}
@bull
@gmane-link["nntp://news"]{newsgroup}
@br
Feed:
@gmane-link['("rss" "messages/complete")]{messages}
@bull
@gmane-link['("rss" "topics/complete")]{topics}
@br
@;Excerpt feed:
@;@gmane-link['("rss" "messages/excerpts")]{messages}
@;@bull
@;@gmane-link['("rss" "topics/excerpts")]{topics}
@;@br
@span[style: "white-space: nowrap;"]{
Search: @input[type: 'text name: 'query value: "" size: 20].}}]
[(quick)
@text{
@big{@TT{@b{@name}}@small{@tt{@at-domain}}}
@div[style: "margin-left: 2em;"]{
@description
@br
[@a[href: (list lists name "/")]{list page},
@gmane-link["dir"]{gmane mirror},
@mail-archive-link[""]{mail-archive}@;
@(and google-groups-url
@text{,
@a[href: google-groups-url]{google group mirror}})]}}]
[else (error 'list-cell "internal error")])))
(define list-renderers (map list-renderer MLs))
(define (mailing-lists-quick)
@text{@(apply parlist @strong{Mailing Lists}
(map (lambda (r) (r 'quick)) list-renderers))
@p{See the @a[href: lists]{mailing list server} for more details.}})