#!/bin/sh --login
string=? ; exec /usr/bin/env mzscheme -gfmv- $0 `dirname $0` "$@"

(current-directory (vector-ref argv 0))

(require (lib "ssax.ss" "ssax")
         (lib "myenv.ss" "ssax")
         (lib "util.ss" "ssax")
         (lib "sxml-tools.ss" "sxml")
         (lib "list.ss")
         (lib "file.ss")
         (lib "pregexp.ss"))

;; TODO: how to turn these into MzScheme modules?
(load (find-library "SXML-tree-trans.scm" "ssax/sourceforge/lib"))
(load "SXML-to-XML.scm")

;; ============================================================================
;; Utility functions and file manipulations
;; ============================================================================

(define month-names
  (vector "January" "February" "March" "April" "May" "June" "July"
          "August" "September" "October" "November" "December"))

;; modified-string : string -> string
;; creates a readable string for the last modified date of a given file
(define (modified-string filename)
  (let ([modified (seconds->date (file-or-directory-modify-seconds filename))])
    (format "~a ~a, ~a"
            (vector-ref month-names (sub1 (date-month modified)))
            (date-day modified)
            (date-year modified))))

;; save-xhtml-file : string string -> void
;; saves an XHTML file, overwriting the file if it exists
(define (save-xhtml-file filename contents)
  (with-output-to-file filename
    (lambda ()
      (display "<!-- This page was automatically generated from a stylesheet. ")
      (display "Please see the \"view source\" links for details. -->\n")
      (display "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" ")
      (display "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n")
      (display contents))
    'replace))

;; transform : string string -> void
;; applies the stylesheet to an input file and writes it to an output file
(define (transform in out)
  (let ([input-data (read (open-input-file in))])
    (save-xhtml-file out
     (SXML->XML (pictures-stylesheet
                 (number-contents input-data)
                 "/source.php"
                 (modified-string in))))))

;; ============================================================================
;; Preprocessing functions for the SXML tree
;; ============================================================================

;; TODO: name these three functions better

(define (number-contents doc)
  (pre-post-order
   doc
   `((contents
      . ,(lambda (tag . contents)
           `(contents ,(number-images contents 0))))
     (*default* . ,(lambda x x))
     (*text* . ,(lambda (tag str) str)))))

(define (number-images contents count)
  (if (null? contents)
      null
      (let ([elt (car contents)])
        (cond
          [(eq? (car elt) 'paragraph)
           (cons elt (number-images (cdr contents) count))]
          [(eq? (car elt) 'gallery)
           (let ([len (length (cdr elt))])
             (cons (cons 'gallery (number-gallery (cdr elt) count))
                   (number-images (cdr contents) (+ count len))))]))))

(define (number-gallery images last-index)
  (if (null? images)
      null
      (let ([image (car images)]
            [index (add1 last-index)])
        (cons (list 'image
                    (list (caadr image) (number->string index))
                    (caddr image))
              (number-gallery (cdr images) index)))))

;; ============================================================================
;; Stylesheets
;; ============================================================================

;; pictures-stylesheet : sxml string string -> sxhtml
;; main stylesheet that produces sxhtml
(define (pictures-stylesheet doc source modified)
  (pre-post-order
   doc
   `((pictures *preorder*
      . ,(lambda (tag title file created contents . rest)
           `(html
             (@ (xmlns "http://www.w3.org/1999/xhtml")
                (xml:lang "en")
                (lang "en"))
             (head
              (title "timshel.org - pictures (" ,(sxml:content title) ")")
              (meta
               (@ (http-equiv "Content-type")
                  (content "text/html; charset='ISO-8859-1'")))
              (link (@ (rel "stylesheet")
                       (type "text/css")
                       (href "../../general.css")))
              (link (@ (rel "stylesheet")
                       (type "text/css")
                       (href "../../header.css")))
              (link (@ (rel "stylesheet")
                       (type "text/css")
                       (href "../../pictures.css"))))
             (body
              (script (@ (language "php"))
               "readHeader();")
              (div (@ (class "contents"))
               (div (@ (class "padded"))
                (div (@ (class "title")) ,(sxml:content title))
                 ,(pictures-contents-stylesheet (sxml:content file)
                                                contents)
                 (hr)
                 (p
                  (a (@ (href "http://validator.w3.org/check/referer"))
                   (img (@ (src "../../valid-xhtml10.png")
                           (height "31")
                           (width "88")
                           (id "validatorImage")
                           (alt "Valid XHTML 1.0")
                           (title ""))))
                  "created " ,(sxml:content created) (br)
                  "last modified " ,modified (br)
                  (span (@ (class "source"))
                   "view source ("
                   (a (@ (href ,source
                               "?/pictures/"
                               ,(sxml:content file)
                               "/index.php"))
                      "PHP") ", "
                   (a (@ (href ,source "?/data/pictures/pictures.scm"))
                      "SXSLT") ", "
                   (a (@ (href ,source
                               "?/data/pictures/"
                               ,(sxml:content file)
                               ".sxml"))
                      "SXML") ")"))))))))
     (*default* *preorder*
      . ,(lambda x x))
     (*text*
      . ,(lambda (tag str) str)))))

;; TODO: simplify this with post-order

;; pictures-contents-stylesheet : string string string sxml -> sxml
;; stylesheet for the body of the SXML tree (the "contents" section)
(define (pictures-contents-stylesheet file contents)
  (pre-post-order
   contents
   `((contents
      . ,(lambda (tag . rest) rest))
     (paragraph
      . ,(lambda (tag . contents)
           `(p ,contents)))
     (gallery
      . ,(lambda (tag . contents)
           `(p (@ (class "gallery"))
              ,contents)))
     (image
      . ,(lambda (tag attrs filename)
           `((a (@ (href "/pictures/" ,file "/" ,filename ".jpg"))
              (img (@ (class ,(car attrs))
                      (alt "[" ,(cadr attrs) "]")
                      (title "")
                      (src "/pictures/" ,file "/" ,filename "_sm.jpg"))))
             " ")))
     (&
      . ,(lambda (esc . contents)
           (string-append "&" (apply string-append contents) ";")))
     (*default*
      . ,(lambda x x))
     (*text*
      . ,(lambda (tag str)
           (escape-string str)))
     )))

;; escape-string : string -> string
;; LaTeX-izes quotes and escapes special XML characters
(define (escape-string str)
  (pregexp-replace* "'"
    (pregexp-replace* "`"
      (pregexp-replace* "''"
        (pregexp-replace* "``"
          (string->goodXML str)
          "&ldquo;")
        "&rdquo;")
      "&lsquo;")
    "&rsquo;")
  )

;; ============================================================================
;; Run the script on the command-line arguments.
;; ============================================================================

(define (print-usage)
  (parameterize ((current-output-port (current-error-port)))
    (display "usage: pictures.scm sxml html\n")
    (display "    sxml   SXML input file\n")
    (display "    html   XHTML output file\n")))

(if (not (= (vector-length argv) 3))
    (begin
      (print-usage)
      (exit 1))
    (transform (vector-ref argv 1) (vector-ref argv 2)))