| 1 | (use hyde hyde-atom environments regex) |
|---|
| 2 | (require-library regex) |
|---|
| 3 | (import irregex) |
|---|
| 4 | |
|---|
| 5 | (define-hyde-environment live |
|---|
| 6 | (clean-before-build #f) |
|---|
| 7 | (output-dir "/var/www/spiffy/gazette")) |
|---|
| 8 | |
|---|
| 9 | (default-page-vars '(((: bos "issues/" (+ any) ".wiki") |
|---|
| 10 | (layouts "article.sxml" "default.sxml")))) |
|---|
| 11 | |
|---|
| 12 | (link-shortcuts '((user . "http://wiki.call-cc.org/users/~A") |
|---|
| 13 | (egg . "http://wiki.call-cc.org/egg/~A") |
|---|
| 14 | (wiki . "http://wiki.call-cc.org/~A") |
|---|
| 15 | (ticket . "http://bugs.call-cc.org/ticket/~A") |
|---|
| 16 | (manual . "http://wiki.call-cc.org/manual/~A"))) |
|---|
| 17 | |
|---|
| 18 | (define $ (environment-ref (page-eval-env) '$)) |
|---|
| 19 | |
|---|
| 20 | (define (page-updated page) |
|---|
| 21 | (or ($ 'updated page) ($ 'date page))) |
|---|
| 22 | |
|---|
| 23 | (define (sort-by pages accessor) |
|---|
| 24 | (sort pages (lambda (p1 p2) (> (accessor p1) (accessor p2))))) |
|---|
| 25 | |
|---|
| 26 | (define (pages-matching regex) |
|---|
| 27 | (map cdr (filter (lambda (p) (irregex-match regex (car p))) |
|---|
| 28 | ((environment-ref (page-eval-env) 'pages))))) |
|---|
| 29 | |
|---|
| 30 | (define (format-seconds seconds) |
|---|
| 31 | (time->string (seconds->utc-time seconds) "%Y-%m-%d %z")) |
|---|
| 32 | |
|---|
| 33 | (define (authors->sxml authors) |
|---|
| 34 | `(,(car authors) |
|---|
| 35 | ,@(if (null? (cdr authors)) |
|---|
| 36 | '() |
|---|
| 37 | (map (lambda (author) |
|---|
| 38 | `(,(car author) (span (@ (class "author")) ,(cdr author)))) |
|---|
| 39 | (append (map (cut cons ", " <>) (butlast (cdr authors))) |
|---|
| 40 | `((" and " . ,(last authors)))))))) |
|---|
| 41 | |
|---|
| 42 | (for-each (lambda (binding) |
|---|
| 43 | (apply environment-extend! (cons (page-eval-env) binding))) |
|---|
| 44 | `((page-updated ,page-updated) |
|---|
| 45 | (format-seconds ,format-seconds) |
|---|
| 46 | (authors->sxml ,authors->sxml) |
|---|
| 47 | (all-issues ,(lambda () |
|---|
| 48 | (sort-by (pages-matching '(: "issues/" (+ num) ".wiki")) page-updated))))) |
|---|