Complete set of mailman template files.

This covers all of the html files in mailman's template directory, and
we should have a consistent look for all pages.  (Including archived
messages.)  Also tweak the front page to have a link to the mailman
"listinfo" page with the complete list of the hosted mailing lists.

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
+    @p{This is the Racket mailing list server.  We have several public mailing
-       lists listed below, with several mirrors for each one.}
+       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}}}
+       @td{@a[href: (list name "/")]{@big{@b{@TT{@name}}} page}
-           @a[href: (list name "/")]{page}
            @bull
            @a[href: (list name "/archive/")]{archive}}]
       [(graph-cell)

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 header
-(define footer @plain[#:file "footer.html" (cadr (force header+footer))])
+  @plain[#:file "header.html" #:newline #f (car  (force header+footer))])
+(define footer
+  @plain[#:file "footer.html" #:newline #f (cadr (force header+footer))])

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
+;; this should move to common
-  @page[#:title @list{Mailing lists: @MM{List-Name}}
+(define HOLE (literal "<<<HOLE>>>"))
-        #:extra-headers style-header #:part-of 'community]{
+(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"<<<HOLE>>>" 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
+    @when[archive?]{
-    @form[action: "http://www.mail-archive.com/search" method: 'get]{@subp{
+      @; This is the mail-archive search box
-      @input[type: 'hidden name: 'l value: @MM{Posting-Addr}]
+      @form[action: "http://www.mail-archive.com/search" method: 'get]{@subp{
-      Archives are also available at
+        @input[type: 'hidden name: 'l value: @MM{Posting-Addr}]
-      @a[href: @list{http://www.mail-archive.com/@MM{Posting-Addr}/}]{
+        Archives are also available at
-        mail-archive.com},
+        @a[href: @list{http://www.mail-archive.com/@MM{Posting-Addr}/}]{
-      search it here:
+          mail-archive.com},
-      @input[type: 'text name: 'q value: "" size: 16]}}
+        search it here:
-    @subp{(@a[href: "/"]{More information} on other ways to use this list and
+        @input[type: 'text name: 'q value: "" size: 16]}
-      other public Racket lists.)}
+        @subp{(@a[href: "/"]{More information} on other ways to use this list
+          and other public Racket lists.)}}}
     @; --------------------
-    @h2{Using @MM{List-Name}}
+    @h2{@a[name: 'subscribers]{@MM{List-Name} subscribers}}
-    @subp{To post a message to all the list members, send email to
+    @subp{@MMform['Options]{@MM{Editing-Options}}}
-      @a[href: @list{mailto:@MM{Posting-Addr}}]{@MM{Posting-Addr}}.}
+    @; not needed: @subp{@MMform['Roster]{@MM{Roster-Option}}}
-    @subp{You can subscribe to the list, or change your existing subscription,
-      in the sections below.}
     @; --------------------
     @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}}})