;; create the index:
;;  guile -l index.scm -c '(make-software-page)'
;; create the module pages:
;;  guile -l index.scm -c '(make-module-docs)'

(define page
  `(page
    (p (link "http://home.gna.org/guile-lib/" (code "guile-lib")) " is an
attempt to provide a repository for useful code written in Guile Scheme.
It imposes a taxonomic module hierarchy on the unruly mass of code
floating around, and packages it up nicely so that developers can use it
and distributors can package it. It's already in "
       (link "http://packages.debian.org/guile-lib/" "Debian") ".")

    (p "Development on " (code "guile-lib") " wouldn't happen without "
       (link (rurl "software/arch/") (code "arch")) ", a
development tool that allows multiple people to work effectively on the
same project. I'm not the maintainer of the project, but I can hack on
my tree, writing and aggregating new things, moving things around, and
in the end there's no conflict. It's a beautiful thing.")

    (h3 "Modules I wrote")

    (modules
     (module (container nodal-tree)
             "A tree consisting of nodes with attributes. Implemented as
a tagged alist.")

     (module (container delay-tree)
             "A nodal tree whose fields can be promises created by the "
             (code "delay") " operator.")

     (module (debugging time)
             "A simple macro to time the execution of an expression.")

     (module (scheme documentation)
             "Some macros to define different kinds of variables with
documentation.")
    
     (module (texinfo)
             "Routines for parsing texinfo files or fragments into an
SXML representation.")

     (module (texinfo html)
             "Code to transform " (code "stexi") ", the SXML
representation of texinfo, into HTML.")

     (module (texinfo indexing)
             "Code to extract an index from a piece of " (code "stexi") ".")

     (module (texinfo nodal-tree)
             "Code to chunk a " (code "stexi") " document into pieces,
suitable for integrating with a custom GtkTreeModel.")

     (module (texinfo plain-text)
             "Code to render " (code "stexi") " as plain text.")

     (module (texinfo reflection)
             "Integrates texinfo into guile's help via "
             (code "(scheme session)") ". See my post on "
             (link (rurl "archives/2004/07/24/literate-programming-with-guile-lib")
                   "literate programming with guile-lib") ".")

     (module (sxml simple)
             "Some convenience routines built on top of SSAX."))

    (h3 "Modules I packaged")

    (modules
     (lmodule (htmlprag) "http://neilvandyke.org/htmlprag/"
              "A permissive (\"pragmatic\") HTML parser.")

     (lmodule (sxml ssax) "http://ssax.sourceforge.net/"
              "A functional-style XML parser for Scheme.")

     (lmodule (sxml xpath) "http://ssax.sourceforge.net/"
              "An implementation of XPath for SXML.")

     (lmodule (sxml transform) "http://ssax.sourceforge.net/"
              "A higher-order SXML transformation operator, " (code
                                                               "pre-post-order") ".")
    
     (lmodule (sxml apply-templates) "http://ssax.sourceforge.net/"
              "A more XSLT-like approach to SXML transformations.")

     (module (sxml ssax input-parse)
             "Oleg's " (code "input-parse.scm") ", but with some routines
sped up by use of " (code "(ice-9 rdelim)") ".")

     (module (debugging assert)
             "Oleg's assert macro that will print out values of variables
referenced in the assert expression.")

     (module (statprof)
             "A statistical profiler for Guile. I hacked on it a bit,
though.")

     (module (io string)
             "IO routines dealing with strings, stolen from SLIB.")

     (module (scheme session)
             "The original " (code "(ice-9 session)") ", but with some
hooks I wrote to make the help system extensible."))))

(use-modules (sxml simple)
             (sxml transform)
             (sxml xpath)
             (texinfo reflection)
             (texinfo html)
             (srfi srfi-13))

(define xhtml-doctype
  (string-append
   "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
   "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n"))

(define (module->str scm)
  (call-with-output-string (lambda (p) (display scm p))))
(define (module->ustr scm)
  (string-append (string-join (map symbol->string scm) "-") "/"))

(load "../../template.scm")

(define (preprocess page)
  (pre-post-order
   page
   `((page . ,(lambda (tag . body)
                body))
     (module* . ,(lambda (tag header . body)
                   `((dt ,@header)
                     (dd ,@body))))
     (module *macro* . ,(lambda (tag module . body)
                          `(module*
                            ((a (@ (href ,(module->ustr module))
                                   (name ,(module->ustr module)))
                                ,(module->str module)))
                            ,@body)))
     (lmodule *macro* . ,(lambda (tag module link . body)
                           `(module*
                             ((a (@ (href ,(module->ustr module))
                                    (name ,(module->ustr module)))
                                 ,(module->str module))
                              " "
                              (a (@ (href ,link)) "(source)"))
                             ,@body)))
     (link . ,(lambda (tag href name)
                `(a (@ (href ,href)) ,name)))
     (rurl . ,(lambda (tag url)
                (string-append "../../" url)))
     (*text* . ,(lambda (tag text) text))
     (*default* . ,(lambda args args)))))

(define (make-index)
  (make-module-docs)
  (with-output-to-file "index.html"
    (lambda ()
      (display xhtml-doctype)
      (sxml->xml
       (templatize (preprocess page)
                   "guile-lib"
                   "software"
                   "../../")))))

;; dunno why the ssax one is broken -- need to update to newest
;; sxml-tools, instead of oleg's sxpath
(define (my-select-kids test-pred?)
  (lambda (node)
    (cond 
     ((null? node) node)
     ((not (pair? node)) '())
     ;;((symbol? (car node))
     ;; ((filter test-pred?) (cdr node)))
     (else (map-union (select-kids test-pred?) node)))))

(define (make-module-list)
  (map cadr
       (apply append
              (map (lambda (type)
                     ((my-select-kids (node-typeof? type)) page))
                   '(module lmodule)))))

(define (maybe-mkdir path)
  (if (or (not (file-exists? path)) (not (file-is-directory? path)))
      (mkdir path)))

(define (make-module-docs . program-args)
  (let ((modules (make-module-list)))
    (for-each
     (lambda (module)
       (let* ((ustr (module->ustr module))
              (port (begin
                      (maybe-mkdir ustr)
                      (open-output-file (string-append ustr "index.html")))))
         (display xhtml-doctype port)
         (sxml->xml
          (templatize
           (pre-post-order
            (stexi->shtml (module-stexi-documentation module))
            `((html . ,(lambda (tag attrs head body)
                         (cdr body))) ;; cdr past the 'body tag
              (*text* . ,(lambda (tag text) text))
              (*default* . ,(lambda args args))))
           (string-append "guile-lib: " (module->str module))
           "software"
           "../../../"
           #:scm-path "../index.scm")
          port)))
     modules)))