diff --git a/collects/meta/web/minis/lists.rkt b/collects/meta/web/minis/lists.rkt index 4d71069eec..1b75ab918d 100644 --- a/collects/meta/web/minis/lists.rkt +++ b/collects/meta/web/minis/lists.rkt @@ -21,11 +21,12 @@ (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.} + @p{This is the Racket mailing list server. We have several public mailing + lists, some are listed below with several mirrors for each one. The + complete list of public mailing lists is available on + @a[href: "listinfo"]{this page}.} @(define gap1 (tr (map (lambda (_) @td{@div[style: "height: 1ex;"]{}}) MLs))) @(define gap2 @@ -87,8 +88,7 @@ @span[style: "font-size: small;"]{@at-domain}}}] [(description) @td{@description}] [(main-page-cell) - @td{@big{@b{@TT{@name}}} - @a[href: (list name "/")]{page} + @td{@a[href: (list name "/")]{@big{@b{@TT{@name}}} page} @bull @a[href: (list name "/archive/")]{archive}}] [(graph-cell) diff --git a/collects/meta/web/stubs/dirlist.rkt b/collects/meta/web/stubs/dirlist.rkt index e4a9faa81e..19fe2a14b4 100644 --- a/collects/meta/web/stubs/dirlist.rkt +++ b/collects/meta/web/stubs/dirlist.rkt @@ -13,5 +13,7 @@ #:part-of 'download "{{{BODY}}}"])))) -(define header @plain[#:file "header.html" (car (force header+footer))]) -(define footer @plain[#:file "footer.html" (cadr (force header+footer))]) +(define header + @plain[#:file "header.html" #:newline #f (car (force header+footer))]) +(define footer + @plain[#:file "footer.html" #:newline #f (cadr (force header+footer))]) diff --git a/collects/meta/web/stubs/mailman.rkt b/collects/meta/web/stubs/mailman.rkt index 0efee963a8..ceee446077 100644 --- a/collects/meta/web/stubs/mailman.rkt +++ b/collects/meta/web/stubs/mailman.rkt @@ -30,41 +30,69 @@ (define (subp . body) (apply div class: 'subp body)) (define (graytd . body) (apply td bgcolor: "#dddddd" body)) -(define listinfo - @page[#:title @list{Mailing lists: @MM{List-Name}} - #:extra-headers style-header #:part-of 'community]{ +;; this should move to common +(define HOLE (literal "<<>>")) +(define (split-template template #:encoder [encoder values] . files) + (define p + ;; use `xml->string' only if the input is not a string, since `page%%' + ;; below hacks up a string, so this avoids doing double-html encoding (this + ;; won't be necessary if `page%%' is done properly) + (lazy (let* ([t (force template)] + [t (if (string? t) t (xml->string t))] + [t (regexp-split #rx"<<>>" t)]) + (unless (= (length t) (length files)) + (error 'split-template "got ~e parts, but expected ~e" + (length t) (length files))) + (map encoder t)))) + (for/list ([f (in-list files)] [i (in-naturals)]) + (plain #:file f #:newline #f (list-ref (force p) i)))) + +(define generic-templates + (split-template @page[#:html-only #t #:title HOLE + #:extra-headers style-header #:part-of 'community + HOLE] + "header1.html" "header2.html" "footer.html")) + +(define (make-listinfo archive?) + @page[#:title @list{Mailing lists: @MM{List-Name}} #:part-of 'community + #:extra-headers style-header + #:file (if archive? "listinfo+archive.html" "listinfo.html")]{ @; -------------------- @comment{@|| Based on the Mailman file "listinfo.html", revision: 5865 - Modified to fit the racket pages, add a mail-archive searchbox + Modified to fit the racket pages, add a mail-archive searchbox for + public lists. @||} @; -------------------- @h1{@MM{List-Name}: @MM{List-Description}} @; -------------------- - @h2{About @MM{List-Name} + @h2{About the @MM{List-Name} list @span[style: '("float: right; font-weight: normal; font-size: 80%;" " margin-top: 4px;")]{ @MMform['Lang]{@MM{displang-box} @MM{list-langs}}}} @subp{@MM{List-Info}} + @subp{To post a message to the list, send email to + @a[href: @list{mailto:@MM{Posting-Addr}}]{@MM{Posting-Addr}}. + You can subscribe to the list or change your existing subscription + options in the sections below.} @subp{To see the collection of prior postings to the list, visit the - @MM{Archive}@MM{List-Name} Archives@MM/{Archive}. + @MM{Archive}@MM{List-Name} archives@MM/{Archive}. @MM{Restricted-List-Message}} - @; This is the mail-archive search box - @form[action: "http://www.mail-archive.com/search" method: 'get]{@subp{ - @input[type: 'hidden name: 'l value: @MM{Posting-Addr}] - Archives are also available at - @a[href: @list{http://www.mail-archive.com/@MM{Posting-Addr}/}]{ - mail-archive.com}, - search it here: - @input[type: 'text name: 'q value: "" size: 16]}} - @subp{(@a[href: "/"]{More information} on other ways to use this list and - other public Racket lists.)} + @when[archive?]{ + @; This is the mail-archive search box + @form[action: "http://www.mail-archive.com/search" method: 'get]{@subp{ + @input[type: 'hidden name: 'l value: @MM{Posting-Addr}] + Archives are also available at + @a[href: @list{http://www.mail-archive.com/@MM{Posting-Addr}/}]{ + mail-archive.com}, + search it here: + @input[type: 'text name: 'q value: "" size: 16]} + @subp{(@a[href: "/"]{More information} on other ways to use this list + and other public Racket lists.)}}} @; -------------------- - @h2{Using @MM{List-Name}} - @subp{To post a message to all the list members, send email to - @a[href: @list{mailto:@MM{Posting-Addr}}]{@MM{Posting-Addr}}.} - @subp{You can subscribe to the list, or change your existing subscription, - in the sections below.} + @h2{@a[name: 'subscribers]{@MM{List-Name} subscribers}} + @subp{@MMform['Options]{@MM{Editing-Options}}} + @; not needed: @subp{@MMform['Roster]{@MM{Roster-Option}}} @; -------------------- @h2{Subscribing to @MM{List-Name}} @subp{Subscribe to @MM{List-Name} by filling out the following form. @@ -110,15 +138,13 @@ @p[style: "text-align: center;"]{ @MM{Subscribe-Button}}}}}}} @; -------------------- - @h2{@a[name: 'subscribers]{@MM{List-Name} Subscribers}} - @subp{@MMform['Options]{@MM{Editing-Options}}} - @; not needed: @subp{@MMform['Roster]{@MM{Roster-Option}}} - @; -------------------- @h2{@nbsp} @MM{Mailman-Footer}}) +(define listinfos (map make-listinfo '(#t #f))) + (define subscribe - @page[#:title @list{@MM{List-Name} Subscription results} + @page[#:title @list{@MM{List-Name} Subscription results} #:part-of 'community #:extra-headers style-header]{ @; -------------------- @comment{@|| @@ -133,6 +159,7 @@ (define options @page[#:title @list{@MM{Presentable-User} membership configuration for @MM{List-Name}} + #:part-of 'community #:extra-headers style-header]{ @; -------------------- @comment{@|| @@ -326,3 +353,258 @@ @global-checkbox{nodupes}}} @tr{@td[colspan: 2 align: 'center]{@MM{options-Submit-button}}}}} @MM{Mailman-Footer}}) + +(define roster + @page[#:title @list{@MM{List-Name} subscribers} + #:part-of 'community + #:extra-headers style-header]{ + @; -------------------- + @comment{@|| + Based on the Mailman file "roster.html", revision 3394 + Modified to fit the racket pages + @||} + @; -------------------- + @h1{@MM{List-Name} subscribers} + @; @p[align: 'right]{ + @; @MM{lang-form-start}@MM{displang-box} @MM{list-langs}@MM{form-end}} + @p{Click on your address to visit your subscription options page. + @br + @i{(Parenthesized entries have list delivery disabled.)}} + @table[cellspacing: 4 cellpadding: 5 width: "80%" align: 'center]{ + @thead{ + @tr[valign: 'top]{ + @graytd[width: "50%" align: 'center]{ + @MM{Num-Reg-Users} Non-digested Members:} + @graytd[width: "50%" align: 'center]{ + @MM{Num-Digesters} Digested Members:}}} + @tr[valign: 'top]{ + @td{@MM{Regular-Users}} + @td{@MM{Digest-Users}}}} + @MM{Mailman-Footer}}) + +;; Files below go through "%(...)s" substitutions, so "%"s should be doubled to +;; avoid python errors -- hack this with regexps below. A proper solution +;; would be to use the improved feature that `with-writer' is not, then have +;; this code use it to add another substitution. +(define (encode-%s content) + (regexp-replace* + #rx"%[^(]" + (let ([c (force content)]) (if (string? c) c (xml->string c))) + "%\\0")) +(require (for-syntax racket/base)) +(define-syntax (page%% stx) + (syntax-case stx () + [(page%% #:html-only #t x ...) + #`(lazy (encode-%s (page #:html-only #t x ...)))] + [(page%% x ...) + (let ([id (or (syntax-property stx 'inferred-name) + (syntax-local-name))]) + #`(plain #,@(if id #`(#:id '#,id) #`()) #:suffix "html" #:newline #f + (page%% #:html-only #t x ...)))])) + +(define private + @page%%[#:title @list{%(realname)s private archives authentication} + #:part-of 'community + #:extra-headers style-header]{ + @; -------------------- + @comment{@|| + Based on the Mailman file "private.html" (no revision specified) + Modified to fit the racket pages + @||} + @; -------------------- + %(message)s + @form[method: 'post action: "%(action)s"]{ + @h1{%(realname)s private archives authentication} + @table[cellspacing: 4 cellpadding: 5 width: "80%" align: 'center]{ + @tr{@td[align: 'right]{Email address:} + @td{@input[type: 'text name: 'username size: 30]}} + @tr{@td[align: 'right]{Password:} + @td{@input[type: 'password name: 'password size: 30]}} + @tr{@td[colspan: 2 align: 'middle]{ + @input[type: 'submit name: 'submit value: "Let me in..."]}}}} + @p{@strong{Important:} From this point on, you must have cookies enabled in + your browser, otherwise you will have to re-authenticate with every + operation.} + @p{Session cookies are used in Mailman's private archive interface so that + you don't need to re-authenticate with every operation. This cookie will + expire automatically when you exit your browser, or you can explicitly + expire the cookie by visiting your member options page and clicking the + @em{Log out} button.}}) + +(define admlogin + @page%%[#:title @list{%(listname)s %(who)s Authentication} + #:part-of 'community + #:extra-headers style-header]{ + @; -------------------- + @comment{@|| + Based on the Mailman file "admlogin.html" (no revision specified) + Modified to fit the racket pages + @||} + @; -------------------- + %(message)s + @form[method: 'post action: "%(path)s"]{ + @h1{%(listname)s %(who)s authentication} + @table[cellspacing: 4 cellpadding: 5 width: "80%" align: 'center]{ + @tr{@td[align: 'right]{List %(who)s Password:} + @td{@input[type: 'password name: 'adminpw size: 30]}} + @tr{@td[colspan: 2 align: 'middle]{ + @input[type: 'submit name: 'admlogin value: "Let me in..."]}}}} + @p{@strong{Important:} From this point on, you must have cookies enabled in + your browser, otherwise no administrative changes will take effect.} + @p{Session cookies are used in Mailman's administrative interface so that + you don't need to re-authenticate with every administrative operation. + This cookie will expire automatically when you exit your browser, or you + can explicitly expire the cookie by hitting the @em{Logout} link under + @em{Other Administrative Activities} (which you'll see once you + successfully log in).}}) + +;; Archive templates + +(define emptyarchive + @page%%[#:title @list{%(listname)s archives} #:part-of 'community + #:extra-headers style-header]{ + @; -------------------- + @comment{@|| + Based on the Mailman file "emptyarchive.html" (no revision specified) + Modified to fit the racket pages + @||} + @; -------------------- + @h1{%(listname)s archives} + @p{No messages have been posted to this list yet, so the archives are + currently empty. You can get @a[href: "%(listinfo)s"]{more information + about this list}.}}) + +(define archtocs + (let ([title @list{%(listname)s archives}] + [headers @list{@style-header + @meta[name: 'robots content: "noindex,follow"] + %(meta)s}]) + (define (content mbox?) + @list{ + @; -------------------- + @comment{@|| + Based on the Mailman file "archtoc.html" and "archtocnombox.html" + (no revision specified) + Modified to fit the racket pages + @||} + @; -------------------- + @h1{%(listname)s archives} + @p{You can get @; + @a[href: "%(listinfo)s"]{more information about this list}@; + @(when mbox? + @list{ or you can @; + @a[href: "%(fullarch)s"]{download the full raw archive} @; + (%(size)s)}).} + %(noarchive_msg)s + %(archive_listing_start)s + %(archive_listing)s + %(archive_listing_end)s}) + (define archtoc.html + (@page%% #:title title #:part-of 'community #:extra-headers headers + (content #t))) + (define archtocnombox.html + (@page%% #:title title #:part-of 'community #:extra-headers headers + (content #f))) + (list archtoc.html archtocnombox.html))) + +(define archlist-templates + (split-template + #:encoder encode-%s + @table[border: 2 bordercolor: "#888" cellspacing: 0 cellpadding: 5 + align: 'center]{ + @tr{@td{Archive} + @td{View by:} + @td{Downloadable version}} + @HOLE + @tr{@td[align: 'right]{%(archivelabel)s:} + @td{@a[href: "%(archive)s/thread.html"]{[Thread]} @; + @a[href: "%(archive)s/subject.html"]{[Subject]} @; + @a[href: "%(archive)s/author.html"]{[Author]} @; + @a[href: "%(archive)s/date.html"]{[Date]}} + %(textlink)s} + @HOLE} + "archliststart.html" "archtocentry.html" "archlistend.html")) + +(define archiveidx-templates + (split-template + @page%%[#:html-only #t + #:title "%(listname)s %(archive)s archives by %(archtype)s" + #:part-of 'community + #:extra-headers @list{@style-header + @meta[name: 'robots content: "noindex,follow"] + %(encoding)s}]{ + @(define sorted-info + @ul{@li{@b{Messages sorted by:} + %(thread_ref)s %(subject_ref)s %(author_ref)s %(date_ref)s} + @li{@a[href: "%(listinfo)s"]{More info on this list...}}}) + @a[name: "start"] + @h1{%(archive)s archives by %(archtype)s} + @sorted-info + @p{@b{Starting:} @i{%(firstdate)s}@br + @b{Ending:} @i{%(lastdate)s}@br + @b{Messages:} %(size)s} + @ul{ + @|HOLE|@; + @li{@a[href: "%(filename)s" name: "%(sequence)i"]{%(subject)s}, + @i{%(author)s}} + @HOLE} + @p{@a[name: "end"]{@b{Last message date:}} @i{%(lastdate)s}@br + @b{Archived on:} @i{%(archivedate)s}} + @sorted-info + @hr + @p[style: "text-align: right; font-size: x-small; font-style: italic;"]{ + (This archive was generated by Pipermail %(version)s.)}} + "archidxhead.html" "archidxentry.html" "archidxfoot.html")) + +(define article + @page%%[#:title @list{%(title)s} + #:part-of 'community + #:extra-headers + @list{@style-header + @link[rel: 'index href: "index.html"] + @link[rel: 'made + href: '@{mailto:%(email_url)s?Subject=%(subject_url)s&@; + In-Reply-To=%(in_reply_to_url)s}] + @meta[name: 'robots content: "index,nofollow"] + %(encoding)s + %(prev)s + %(next)s}]{ + @(define sorted-by + @list{Messages sorted by: @; + @a[href: "date.html#%(sequence)s"]{[date]} + @a[href: "thread.html#%(sequence)s"]{[thread]} + @a[href: "subject.html#%(sequence)s"]{[subject]} + @a[href: "author.html#%(sequence)s"]{[author]}}) + @(define navcell + (let ([n 0]) + (lambda () + (set! n (add1 n)) + @td{@ul[style: "font-size: x-small;"]{ + @; need only one of these things, at the end + @(when (= n 2) (list "\n" @comment{threads} "\n"))@; + %(prev_wsubj)s + %(next_wsubj)s + @li{@sorted-by}}}))) + @; -------------------- + @; Based on the Mailman file "article.html" (no revision specified) + @; Modified to fit the racket pages + @; (This comment is not included on actual archive message pages) + @; -------------------- + @h1{%(subject_html)s} + @table{@tr{@td{ + From: @b{%(author_html)s} @; + (@a[href: '@{mailto:%(email_url)s?Subject=%(subject_url)s&@; + In-Reply-To=%(in_reply_to_url)s} + title: "%(subject_html)s"]{ + %(email_html)s})@; + @br + Date: @i{%(datestr_html)s}} + @navcell}} + @hr + @comment{beginarticle} + %(body)s + @comment{endarticle} + @hr + @table{@tr{@td{Posted on the @; + @a[href: "%(listurl)s"]{%(listname)s mailing list}.} + @navcell}}})