#!/usr/bin/env dfsch-repl

(define *last-release* "0.3.0")
(define *last-release-file* "dfsch-0.3.0.tar.gz")
(define *last-release-news* 
  "-----------------------------------------------------------------------------
version 0.3.0                2009-07-03              
-----------------------------------------------------------------------------

        * Major performance enhancements
        * More included modules
          - Subprocess support
          - Command line processing
          - PRNG
        * XML support in core tree
        * Better introspection capabilities
        * More string manipulation primitives
        * Documentation slots + autogenerated documentation
        * Support for location annotated lists
        * Replaced stack traces by more general execution tracing mechanism
")

(require 'sxml)
(require 'unix)

(define (page->filename page)
  (string-append (symbol->string page) ".html"))
(define (page->uri page)
  (if (defined? *base-path*)
      (string-append *base-path* "/" (page->filename page))
      (page->filename page)))

(define (emit-page name template . args)
  (sxml:emit-file (apply template args)
                  (page->filename name)))

(define (normal-page title menu content)
  `(html 
    (@ (xmlns "http://www.w3.org/1999/xhtml"))
    (head (title ,(if (null? title)
                      "dfsch - Scheme-like dialect of LISP"
                      (string-append title 
                                     " - dfsch - Scheme-like dialect of LISP"))) 
          (meta (@ (content "application/xhtml+xml; charset=utf-8") 
                   (http-equiv "Content-Type")))
          (link (@ (href "data/style.css") 
                   (rel "Stylesheet"))))
    (body (div (@ (id "header")) 
               (h1 "dfsch")
               (h2 "Scheme-like dialect of LISP")) 
          (div (@ (class "colmask leftmenu"))
               (div (@ (class "colright"))
                    (div (@ (class "col1wrap"))
                         (div (@ (class "col1"))
                              ,@(unless (null? title) `((h1 ,title)))
                              ,@content))
                    (div (@ (class "col2")) 
                         ,@menu)))
          (div (@ (id "footer")) 
;               (img (@ (alt "LGPL v.3") (src "data/lgplv3-88x31.png")))
;               (img (@ (alt "GPL v.3") (src "data/gplv3-88x31.png")))
               (p (a (@ (href "http://hakl.net"))"Aleš Hakl") 
                  " < ales at hakl dot net >" (br)
                  "Generated by site.scm running on dfsch " 
                  ,*dfsch-version* 
                  " (" 
                  ,*dfsch-platform* 
                  ") on " ,(iso-format-time (get-decoded-time 'utc)) " UTC")))))

(define (internal-link page text)
  `(a (@ (href ,(page->uri page))) ,@text))
(define (link uri text)
  `(a (@ (href ,uri)) ,@text))

(define (make-menu list)
  `((ul (@ (class "menu"))
        ,@(map (lambda (item)
                 `(li ,(if (symbol? (car item))
                           (internal-link (car item) (cdr item))
                           (link (car item) (cdr item)))))
                 list))))


(define site-menu (make-menu '((index "About dfsch")
                               (download "Download")
                               ("doc/" "Documentation")
                               ("http://github.com/adh/dfsch/" "Github")
                               (examples "Examples")
                               (modules "Modules"))))

(define (read-directory directory)
  (let ((dd (unix:opendir directory)))
    (let loop ((list ()))
      (let ((dirent (unix:readdir dd)))
        (if (null? dirent)
            list
            (if (eq? (string-ref dirent 0) #\.)
                (loop list)
                (loop (cons dirent list))))))))

(define (gen-dir-list directory)
  `(ul ,@(map (lambda (fname)
                `(li (a (@ (href ,(string-append directory "/" fname)))
                        ,fname)))
              (sort-list! (read-directory directory) string>?))))


(emit-page 
 'index normal-page () site-menu 
 '((p "dfsch is implementation of simple language similar to Scheme.")
   (h2 "Features")
   (ul (li "Portable ANSI C implementation")
       (li "Easy interfacing of C code")
       (li "Simple module system (require/provide)")
       (li "Uniform handling of syntactic constructs")
       (li "Unlimited precision numeric types")
       (li "Unicode support (all strings are UTF-8)")
       (li "Multi-threading support")
       (li "Regular expression support (based on platform regcomp/regexec)")
       (li "Interactive REPL")
       (li "Message passing object system"))))
(emit-page
 'download normal-page "Download" site-menu
 `((h2 "Latest release")
   (p "Latest release is " ,*last-release* ", you can download it "
      (a (@ (href ,(string-append "files/" *last-release-file*))) "here")
      "(" (a (@ (href ,(string-append "files/" *last-release-file* ".asc"))) "GPG signature")
      ").")
   (pre ,*last-release-news*)
   (h2 "All downloads")
   ,(gen-dir-list "files")))
(emit-page
 'documentation normal-page "Documentation" site-menu
 '((p "Currently, dfsch documentation is not exactly complete or useful.")))
(emit-page
 'examples normal-page "Examples" site-menu
 '((p "This page should in future contain some short demonstrations of dfsch")
   (p "For now, "
      (a (@ (href "site.scm")) "link to script")
      " that generates this website must suffice.")))
(emit-page
 'modules normal-page "Modules" site-menu
 `((p "dfsch can load various extensions at runtime, apart from modules"
      "included in distribution, there are also some axternal (usually "
      "due to dependency on some aditional C libraries).")
   (ul (li "XML")
       (li "PostgreSQL client")
       (li "SQLite")
       (li "Tcl/Tk bridge")
       (li "Cairo vector graphics library"))
   (p "Download from " ,(internal-link 'download '("downloads page")) ".")))