Changeset 14287 in project


Ignore:
Timestamp:
04/18/09 02:55:44 (11 years ago)
Author:
Jim Ursetto
Message:

make-egg-index: HTML and CSS updates

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/scripts/make-egg-index.scm

    r14256 r14287  
    33(load-relative "tools.scm")
    44
    5 (use setup-download matchable htmlprag data-structures regex)
     5(use setup-download matchable sxml-transforms data-structures regex)
    66
    77(import irregex)
     
    1010
    1111(define +link-regexp+
    12   '(: #\[ #\[ (submatch (* (~ #\] #\|))) #\] #\]))
    13 
    14 (define +stylesheet+ #<<EOF
    15 /* table mods by zb */
    16 table {
    17   background: #f6f6ff;
    18   padding: 0.2em;
    19   margin: 1.2em 2.0em;
    20   border: 1px solid #aac;
    21   border-collapse: collapse;
    22   font-size: 100%;
    23 }
    24 th {
    25   text-align: left;
    26   border-bottom: 1px solid #aac;
    27   border-left: 1px solid #aac;
    28   padding: 0.25em 1.0em 0.25em 1.0em;
    29 }
    30 td {
    31   padding: 0.25em 1.0em 0.25em 1.0em;
    32   border-left: 1px solid #aac;
    33 }
    34 blockquote, pre {
    35   background-color: #fafaff;
    36   display: block;
    37   border: 1px dashed gray;
    38   margin: 1.0em 0em;
    39   padding: 0.5em 1.0em;
    40   overflow: auto;
    41 }
    42 pre {
    43   line-height: 1.3;
    44 }
    45 h2, h3, h4, h5, h6 {
    46    color: #226;
    47    padding-top: 1em;
    48 }
    49 
    50 h1 {
    51     background-color: #336;
    52         color: #fff;
    53         width: 100%;
    54         padding: 0;
    55     padding: 0.25em 16px 0.25em 0.5em;
    56         margin: 0 0 0em 0;
    57         font-size: 160%;
    58 }
    59 
    60 EOF
    61 )
     12  (irregex '(: #\[ #\[ (submatch (* (~ #\] #\|))) #\] #\])))
    6213
    6314(define +categories+
     
    7122    (os "OS interface")
    7223    (ffi "Interfacing to other languages")
    73     (web "Web programing")
     24    (web "Web programming")
    7425    (xml "XML processing")
    7526    (doc-tools "Documentation tools")
     
    8839    (misc "Miscellaneous")
    8940    (hell "Concurrency and parallelism")
    90     (uncategorized "Not categorized")
     41    (uncategorized "Uncategorized")
    9142    (obsolete "Unsupported or redundant") ) )
    9243
     
    9849  (exit code))
    9950
     51(define (sxml->html doc)
     52  (SRV:send-reply
     53   (pre-post-order
     54    doc
     55    ;; LITERAL tag contents are used as raw HTML.
     56    `((literal *preorder* . ,(lambda (tag . body) (map ->string body)))
     57      ,@universal-conversion-rules))))
     58
    10059(define (make-egg-index dir)
    10160  (let ((title (sprintf "Eggs Unlimited (release branch ~a)" *major-version*))
    10261        (eggs (gather-egg-information dir)))
    103     (write-shtml-as-html
    104      `(html
    105        ,(header title)
    106        (body
    107         ,@(prelude title)
    108         ,@(emit-egg-information eggs)
    109         ,@(trailer))))))
     62    (sxml->html
     63     `((literal "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
     64       (literal "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">")
     65       (html
     66        ,(header title)
     67        (body
     68         ,(titlebar title)
     69         ,(sidebar)
     70         ,(content (prelude title)
     71                   (emit-egg-information eggs))
     72         ,(trailer)))))))
     73
     74(define (wiki-link path desc)
     75  `(a (@ (href "http://chicken.wiki.br/" ,path))
     76      ,desc))
     77
     78(define (sidebar)
     79  `(div (@ (id "toc-links"))
     80        (div (@ (id "toc"))
     81             (p ,(wiki-link "" "Home") (br)
     82                ,(wiki-link "manual/index" "Manual") (br)
     83                ,(wiki-link "eggs" "Eggs") (br)
     84                ,(wiki-link "users" "Users") (br)
     85                ))))
     86
     87(define (content . body)
     88  `(div (@ (id "content-box"))
     89        (div (@ (class "content"))
     90             ,body)))
    11091
    11192(define (header title)
    11293  `(head
    113     (style (@ (type "text/css"))
    114       ,+stylesheet+)
     94;;     (style (@ (type "text/css"))
     95;;       ,+stylesheet+)
     96    (link (@ (rel "stylesheet")
     97             (type "text/css")
     98             (href "http://chicken.wiki.br/common-css")))
    11599    (title ,title)))
    116100
     101(define (titlebar title)
     102  `(div (@ (id "header"))
     103        (h1 (a (@ (href "http://chicken.wiki.br/eggs"))
     104               ,title))))
     105
    117106(define (prelude title)
    118   `((h1 ,title)
    119     (p (center
    120         (img (@ (src "http://www.call-with-current-continuation.org/eggs/3/egg.jpg")))))
     107  `((p (img (@
     108             (style "float: right;")
     109             (src "http://www.call-with-current-continuation.org/eggs/3/egg.jpg"))))
    121110    (p (b "Last updated: " ,(seconds->string (current-seconds))))
    122111    (p "A library of extensions for the Chicken Scheme system.")
    123     (h3 "Installation")
     112    (h2 "Installation")
    124113    (p "Just enter")
    125114    (pre "  chicken-install EXTENSIONNAME\n")
     
    141130    (p "If you would like to access the subversion repository, see "
    142131       (a (@ (href "http://chicken.wiki.br/eggs tutorial")) "the "
    143           (i "Egg tutorial")) ".")
     132          (i "Egg tutorial")) ".")
    144133    (p "If you are looking for 3rd party libraries used by one the extensions, "
    145134       "check out the CHICKEN "
    146135       (a (@ (href "http://www.call-with-current-continuation.org/tarballs/") )
    147           (i "tarball repository")))
    148     (h3 "List of available eggs")))
     136          (i "tarball repository")))
     137    (h2 "List of available eggs")
     138    (a (@ (name "category-list")))
     139    (h3 "Categories")
     140    ,(category-link-list)
     141    ))
     142
     143;; information on empty categories not available yet; link all possible categories
     144(define (category-link-list)
     145  `(ul (@ (style "list-style-type: none; padding-left: 2em;"))
     146       ,@(map
     147          (match-lambda
     148           ((cat catname)
     149            `(li (a (@ (href "#" ,cat))
     150                    ,catname))))
     151          +categories+)))
    149152
    150153(define (trailer)
    151   '())
     154  `(div (@ (id "credits"))
     155        (p "Generated with Chicken " ,(chicken-version))))
    152156
    153157(define (emit-egg-information eggs)
     
    169173            (begin
    170174              (d "category: ~a" catname)
    171               `((h3 ,catname)
     175              `((a (@ (name ,cat)))
     176                (h3 (a (@ (href "#category-list"))
     177                       ,catname))
    172178                (table
    173179                 (tr (th "Name") (th "Description") (th "License") (th "author") (th "maintainer") (th "version"))
     
    195201           (td ,(prop 'version "" version?)))))))
    196202
     203;; Names are either raw HTML, or [[user name]] denoting a wiki link.
    197204(define (linkify-names str)
    198   ;; silly
    199   (html->shtml
    200    (open-input-string
    201     (irregex-replace/all
    202      +link-regexp+
    203      str
    204      (lambda (m)
    205        (let ((name (irregex-match-substring m 1)))
    206          (string-append "<a href=\"http://chicken.wiki.br/users/" name "\">" name "</a>")))))))
     205  ;; Call MATCHED on (sub)matches and DID-NOT-MATCH on non-matches in STR,
     206  ;; and collect into a list.
     207  (define (transform irx str matched did-not-match)
     208    ;; IRREGEX-FOLD is exported for SVN trunk >= r14283, delete this if
     209    ;; installed Chicken is new enough.
     210    (define (irregex-fold irx kons knil str . o)
     211      (let* ((irx (irregex irx))
     212             (finish (if (pair? o) (car o) (lambda (i acc) acc)))
     213             (start (if (and (pair? o) (pair? (cdr o))) (cadr o) 0))
     214             (end (if (and (pair? o) (pair? (cdr o)) (pair? (cddr o)))
     215                      (caddr o)
     216                      (string-length str))))
     217        (let lp ((i start) (acc knil))
     218          (if (>= i end)
     219              (finish i acc)
     220              (let ((m (irregex-search irx str i end)))
     221                (if (not m)
     222                    (finish i acc)
     223                    (let* ((end (irregex-match-end m 0))
     224                           (acc (kons i m acc)))
     225                      (lp end acc))))))))
     226    (let ((irregex-match-start-index irregex-match-start)) ;; upcoming API change in irregex 0.7
     227      (irregex-fold irx
     228                    (lambda (i m s)
     229                      (cons (matched (irregex-match-substring m 1))
     230                            (cons (did-not-match
     231                                   (substring str i (irregex-match-start-index m 0)))
     232                                  s)))
     233                    '()
     234                    str
     235                    (lambda (i s)
     236                      (reverse (cons (did-not-match (substring str i))
     237                                     s))))))
     238  (transform
     239   +link-regexp+
     240   str
     241   (lambda (name)  ;; wiki username
     242     `(a (@ (href ,(string-append "http://chicken.wiki.br/users/"
     243                                  (string-substitute " " "-" name 'global))))
     244         ,name))
     245   (lambda (x)     ;; raw HTML chunk
     246     `(literal ,x))))
    207247
    208248(define name?
     
    221261
    222262(main (simple-args (command-line-arguments)))
     263
Note: See TracChangeset for help on using the changeset viewer.