#!/usr/local/bin/guile \
-e main --debug -s

Speakhtml (c) 2002 Niklas Olmes <niklas@noxa.de> <niklas.olmes@web.de>
http://faith.eu.org

$Id: speakhtml.scm,v 2.9 2002/12/15 03:49:17 niklas Exp $

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

!#

;;; Load HTML4 loose.dtd definitions by default
(load "html4-loose.scm")

(define FILE "")

(define (comment lis)
  (let ((cmt (if (string? lis)
                 lis
                 (cadr lis))))
    (display (string-append "<!-- "
                            (convert cmt)
                            " -->"))
    (newline)
    (if (not (string? lis))
        (if (not (null? (cddr lis)))
            (parse (cddr lis))))))

(define (type1 lis tag . no-etag)
  "Simple tags"
  (display (string-append " <" (convert tag) ">"))
  (if (not (null? (cdr lis)))
      (parse (cdr lis)))
  (if (null? no-etag)
    (display (string-append "</" (convert tag) ">"))))

(define (type2 lis tag . no-etag)
  "Tags with attributes"
  (display (string-append " <" (convert tag)))
  (cond
   ((not (null? (cdr lis)))
    (cond
     ((vector? (cadr lis))
      (display (string-append ""
                              (parse-list
                               (vector->list (cadr lis)))
                              ">"))
      (if (not (null? (cddr lis)))
          (parse (cddr lis))))
     (else
      (display ">")
      (parse (cdr lis)))))
   (else
    (display ">")))
  (if (null? no-etag)
      (display (string-append "</" (convert tag) ">"))))

(define (convert x)
  (cond
   ((symbol? x)
    (symbol->string x))
   ((number? x)
    (number->string x))
   ((string? x)
    x)
   (else
    (error "Unable to convert.  -- CONVERT"))))

(define (parse-pair pair)
  (cond
   ((null? pair)
    "")
   (else
    (string-append " "
                   (convert (car pair))
                   "=\""
                   (convert (cadr pair))
                   "\""))))

(define (parse-list lis)
  (cond
   ((null? lis)
    "")
   ((symbol? (car lis))
    (string-append (parse-pair lis)))
   ((list? (car lis))
    (string-append (parse-pair (car lis))
                   (parse-list (cdr lis))))))

(define (parse lis)
  (cond
    ((null? lis)
     '())
    ((string? (car lis))
     (newline)
     (display (convert (car lis)))
     (parse (cdr lis)))
    ((symbol? (car lis))
     (case (car lis)
       ((@cmt)
        (comment lis))
       ((!nl)
	(newline))
       ((!ch)
        (display (convert (cadr lis))))
       ((@p)
        (parse (eval (cadr lis))))
       ((@e)
        (display (convert (eval (cadr lis)))))
       ((@d)
        (eval (cadr lis)))
       ((@use @load)
        (load (cadr lis)))
       ((@input)
        (let ((port (open-input-file (cadr lis))))
              (parse (read port))))
       (else
        (let ((e (assq (car lis) elements)))
	  (if e
            (cond ((equal? (cadr e) 1)
   	           (if (null? (cdddr e))
	             (type1 lis (caddr e))
		     (type1 lis (caddr e) #t)))
		  ((equal? (cadr e) 2)
   		   (if (null? (cdddr e))
		     (type2 lis (caddr e))
		     (type2 lis (caddr e) #t)))
	         (else
	          (error "Error in elements definition.  -- PARSE")))
            (error (string-append "Unknown tag ``"
		                           (convert (car lis))
		                           "''.  -- PARSE")))))))
    ((list? lis)
     (parse (car lis))
     (parse (cdr lis)))
    (else
     (error (string-append "Unable to identify ``"
			   (convert (car lis))
			   "''.  -- PARSE")))))

(define (for-each1 lis)
  (cond
   ((null? (cdr lis))
    (parse (car lis)))
   (else
    (parse (car lis))
    (for-each1 (cdr lis)))))

(define (main argv)
  (cond
   ((null? (cdr argv))
    (error "No filename given.  -- MAIN"))
   (else
    (head)
    (comment "$Id: speakhtml.scm,v 2.9 2002/12/15 03:49:17 niklas Exp $")
    (set! FILE (cadr argv))
    (for-each1 (read (open-input-file FILE))))))