bleh again

1 files changed, 88 insertions, 3 deletions

@@ -1,7 +1,9 @@
 ;;; (boudin types) --- pages, indeces, and static files
-
+;;
 ;; All paths are relative to the site directory unless otherwise noted
 
+;;; Pages
+
 (define-record-type page
   (make-page path                       ; Input path
              dest                       ; Output path (rel. to output directory)
@@ -17,14 +19,33 @@
   (meta page-meta set-page-meta!))
 
 (define (page-ref pg key)
-  (assoc-ref key (page-meta pg) (identity #f)))
+  (assoc-ref key (page-meta pg) (lambda _ #f)))
 
 (define (page-set! pg key val)
   (set-page-meta! pg (cons (cons key val)
                            (page-meta pg))))
 
 (define (extract-metadata sxml)
-  #f)
+  (let loop ((tree sxml)
+             (acc '()))
+    (cond
+     ((not (pair? tree))
+      (reverse acc))
+     ((and (list? (car tree))
+           (eq? (caar tree) '*COMMENT*))
+      (loop (cdr tree)
+            (map (lambda (ln)
+                   (let ((kv (string-split ln ":" 'infix 1)))
+                     (cons (string-trim-both (car kv))
+                           (string-trim (cdr kv)))))
+                 (string-split (cadar tree) "\n"))))
+     ((list? (car tree))
+      (loop (cdr tree)
+            (let ((subtree (loop (car tree) '())))
+              (if (null? subtree)
+                  acc
+                  (cons subtree acc)))))
+     (else (loop (cdr tree) acc)))))
 
 (define (*urlify path)
   (normalize-pathname
@@ -53,6 +74,20 @@
         (page-set! pg "slug" slug)
         slug)))
 
+(define (*page-mtime pg)
+  (let ((file (page-path pg)))
+    (and file
+         (file-exists? file)
+         (time->string (seconds->utc-time (file-modification-time file))))))
+
+(define (page-updated pg)
+  (let ((meta-date (page-ref pg "date")))
+    (or (and meta-date
+             (find (lambda (fmt) (string->time meta-date fmt))
+                   (page-date-formats)))
+        (*page-mtime pg)
+        (build-time))))
+
 (define (read-page path)
   (let ((pg (make-page path #f #f #f #f)))
     (set-page-dest! pg ((apply o (page-path-transformers)) path))
@@ -69,4 +104,54 @@
      (sxml-display-as-html ((eval/q (page-template)) pg) port))))
 
 
+;;; Indeces
+;; These are generated pages from collections of other pages.  Think index.html,
+;; feed.xml, possibly tag indeces and the like.  These pages don't have a source
+;; file, but they have a destination and a template.  Because there are
+;; different file formats here and ... stuff, there's also a slot for the index
+;; writer function.  Finally, pages and meta are the pages and various other
+;; metadata of the index.
+
+(define-record-type index
+  (make-index dest                      ; Relative to (site-dest)
+              template                  ; Template to put pages in
+              writer                    ; Proc to write sxml out to a file
+              pages                     ; Input pages
+              meta                      ; Various other metadata
+              )
+  index?
+  (dest index-dest set-index-dest!)
+  (template index-template set-index-template!)
+  (writer index-writer set-index-writer!)
+  (pages index-pages set-index-pages!)
+  (meta index-meta set-index-meta!))
+
+(define (index-ref idx key)
+  (assoc-ref key (index-meta idx) (lambda _ #f)))
+
+(define (index-set! idx key val)
+  (set-index-meta! idx (cons (cons key val)
+                             (index-meta idx))))
+
+(define (index-push! idx pg)
+  (set-index-pages! idx (cons pg (index-pages idx))))
+
+(define (index-for-each idx proc)
+  (for-each proc (index-pages idx)))
+
+(define write-index
+  (case-lambda
+    ((idx) (call-with-output-file (index-dest idx)
+             (lambda (port) (write-index idx (current-output-port)))))
+    ((idx port)
+     ((index-writer idx) ((index-template idx) (index-pages idx)) port))))
+
+
+;;; Static files
+;; These are simply copied from the input to the output, possibly with a changed
+;; path.  Because these are just files, we don't need a record type.
 
+(define (static-copy path)
+  (copy-file path
+              (make-pathname (site-dest) path)
+              'clobber))