Changeset 13810 in project for chicken


Ignore:
Timestamp:
03/18/09 10:21:57 (11 years ago)
Author:
felix winkelmann
Message:

make-egg-index usable now

File:
1 edited

Legend:

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

    r13800 r13810  
    33(load-relative "tools.scm")
    44
    5 (use setup-download matchable htmlprag data-structures)
     5(use setup-download matchable htmlprag data-structures regex)
     6
     7(import irregex)
    68
    79(define *major-version* (##sys#fudge 41))
    810
    9 (define +stylesheet+ "")
     11(define +link-regexp+
     12  '(: #\[ #\[ (submatch (* (~ #\] #\|))) #\] #\]))
     13
     14(define +stylesheet+ #<<EOF
     15/* table mods by zb */
     16table {
     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}
     24th {
     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}
     30td {
     31  padding: 0.25em 1.0em 0.25em 1.0em;
     32  border-left: 1px solid #aac;
     33}
     34blockquote, 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}
     42pre {
     43  line-height: 1.3;
     44}
     45h2, h3, h4, h5, h6 {
     46   color: #226;
     47   padding-top: 1em;
     48}
     49
     50h1 {
     51    background-color: #336;
     52        color: #aab;
     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
     60EOF
     61)
    1062
    1163(define +categories+
     
    4799
    48100(define (make-egg-index dir)
    49   (let ((title
    50          (sprintf "Eggs Unlimited (release branch ~a, updated ~a)"
    51                   *major-version*
    52                   (string-chomp (seconds->string (current-seconds)))))
     101  (let ((title (sprintf "Eggs Unlimited (release branch ~a)" *major-version*))
    53102        (eggs (gather-egg-information dir)))
    54103    (write-shtml-as-html
     
    68117(define (prelude title)
    69118  `((h1 ,title)
     119    (p (b "Last updated: " ,(seconds->string (current-seconds))))
    70120    (p "A library of extensions for the Chicken Scheme system.")
    71121    (h3 "Installation")
     
    103153   (match-lambda
    104154     ((cat catname)
    105       (d "category: ~a" catname)
    106       `((h3 ,catname)
    107         (table
    108          (tr (th "Name") (th "Description") (th "License") (th "author") (th "maintainer") (th "version"))
    109          ,@(append-map
    110             make-egg-entry
    111             (sort
    112              (filter (lambda (info)
    113                        (and (eq? cat (cadr (or (assq 'category (cdr info))
    114                                                '(#f uncategorized))))
    115                             (not (assq 'hidden (cdr info)))))
    116                      eggs)
    117              (lambda (e1 e2)
    118                (string<? (symbol->string (car e1)) (symbol->string (car e2))))))))))
     155      (let ((eggs (append-map
     156                   make-egg-entry
     157                   (sort
     158                    (filter (lambda (info)
     159                              (and (eq? cat (cadr (or (assq 'category (cdr info))
     160                                                      '(#f uncategorized))))
     161                                   (not (assq 'hidden (cdr info)))))
     162                            eggs)
     163                    (lambda (e1 e2)
     164                      (string<? (symbol->string (car e1)) (symbol->string (car e2))))))))
     165        (if (null? eggs)
     166            '()
     167            (begin
     168              (d "category: ~a" catname)
     169              `((h3 ,catname)
     170                (table
     171                 (tr (th "Name") (th "Description") (th "License") (th "author") (th "maintainer") (th "version"))
     172                 ,@eggs)))))))
    119173   +categories+))
    120174
     
    134188           (td ,(prop 'synopsis "unknown" string?))
    135189           (td ,(prop 'license "unknown" name?))
    136            (td ,(prop 'author "unknown" name?))
    137            (td ,(prop 'maintainer "" name?))
     190           (td ,(linkify-names (prop 'author "unknown" name?)))
     191           (td ,(linkify-names (prop 'maintainer "" name?)))
    138192           (td ,(prop 'version "" version?)))))))
     193
     194(define (linkify-names str)
     195  ;; silly
     196  (html->shtml
     197   (open-input-string
     198    (irregex-replace/all
     199     +link-regexp+
     200     str
     201     (lambda (m)
     202       (let ((name (irregex-match-substring m 1)))
     203         (string-append "<a href=\"http://chicken.wiki.br/" name "\">" name "</a>")))))))
    139204
    140205(define name?
Note: See TracChangeset for help on using the changeset viewer.