(module AsciiDoc-Spip
   (main analyse-fichier))

(define (analyse-fichier args)
   (let ((un-fichier (cadr args)))
      (call-with-input-file un-fichier lire-des-lignes)))

(define (lire-des-lignes flux)
   (let boucle ((ligne (read-line flux)))
      (if (eof-object? ligne)
          ligne
          (begin
;; Tableaux
	     (if (substring=? ligne "|===" 4)
		 (traite-tableau ligne flux))
;; Textes de programmes encadrés
	     (let ((regexp-code "\\[source, ([a-zA-Z0-9-]+)\\]"))
		(if (pregexp-match regexp-code ligne)
		    (traite-code regexp-code ligne flux)))
             (analyse ligne)
             (boucle (read-line flux))))))

(define (traite-tableau ligne flux)
   (do ((ligne (read-line flux) (read-line flux)))
       ((substring=? ligne "|===" 4))
       (if (not (substring=? ligne "|===" 4))
	   (analyse (string-append ligne " |")))))

(define (traite-code regexp-code ligne flux)
   (let ((langage (dernier (pregexp-match regexp-code ligne))))
      (set! ligne (string-append "<cadre class=\"" langage "\">"))
      (print ligne)
      (do ((ligne (read-line flux) (read-line flux))
	   (debut #t #f))
	  ((and (substring=? ligne "----" 4)
		(not debut)))
	  (if (not (substring=? ligne "----" 4))
	      (print ligne))
	  )
      (print "</ cadre>") ;; espace après / pour éviter que Spip ne traite
;; la balise... Pour l'utiliser en vrai, il faut supprimer l'espace.
      ))

(define (dernier L)
   (if (list? L)
       (if (null? (cdr L))
	   (car L)
	   (dernier (cdr L)))))

(define (traite-lien ligne regexp-lien)
   (let boucle
	 ((debut-ligne "")
	  (fin-ligne ligne)
	  (chaine
	     (string-append
		"[" (dernier (pregexp-match regexp-lien ligne))
		"->" (cadr (pregexp-match regexp-lien ligne)) "]"))
	  (suite 0))
      (set! ligne
	 (string-append debut-ligne
	    (pregexp-replace regexp-lien fin-ligne chaine)))
      (set! suite (+ (string-contains ligne chaine)
		     (string-length chaine)))
      (set! debut-ligne (substring ligne 0 suite))
      (set! fin-ligne (substring ligne suite))
      (if (pregexp-match regexp-lien fin-ligne)
	  (boucle
	     debut-ligne
	     fin-ligne
	     (string-append
		"[" (dernier (pregexp-match regexp-lien fin-ligne))
		"->" (cadr (pregexp-match regexp-lien fin-ligne)) "]")
	     suite)
	  (set! ligne (string-append debut-ligne fin-ligne)))
      ligne))

(define (analyse ligne)
   (let* ((carcomp "éèàùçêîâÀÊÎÂÏïëËÇüôäö!-\\?,'’")
	  (regexp1 "^(====)(.*)$")
	  (regexp2 "^(===)(.*)$")
	  (regexp3 "^(==)(.*)$")
;; Espaces insécables
	  (regexp-nbsp "{nbsp}")
	  (regexp-ital (string-append
		      "_([^_]*)_"))
	  (regexp-gras (string-append
		      "\\*([^\\*]*)\\*"))
;; Exposants
	  (regexp-sup (string-append
		      "\\^([^\\^]*)\\^"))
;; Indices
	  (regexp-sub (string-append
		      "~([^~]*)~"))
;; Code, chasse fixe
	  (regexp-tt (string-append
		      "`([^`]*)`"))
	  (regexp-appelref (string-append
			      "<<([\\w " carcomp "]*)>>"))
	  (regexp-ref (string-append
			 "\\[\\[\\[([\\w " carcomp "]*)\\]\\]\\]"))
;; URL
	  (regexp-url (string-append
			 "(http(s)?://"
			 "([a-zA-Z0-9-]+\\.){1,5}"
			 "[a-zA-Z]{2,4}(:\\d+)?(/([^[]*)?)?)"))
;; Annotation d'un URL
	  (regexp-txturl "\\[([^\\]]*)\\]")
;; Lien annoté
	  (regexp-lien (string-append
			  regexp-url regexp-txturl))
;; Texte de programme
	  (regexp-code "\\[source, ([a-zA-Z0-9-]+)\\]")
	  )
;; Liste
      (if (substring=? ligne "* " 2)
	  (string-set! ligne 0 #\-))
;; Exposants
      (if (pregexp-match regexp-sup ligne)
	  (set! ligne
	     (pregexp-replace*
		regexp-sup ligne "<sup>\\1</sup>")))
;; Indices
      (if (pregexp-match regexp-sub ligne)
	  (set! ligne
	     (pregexp-replace*
		regexp-sub ligne "<sub>\\1</sub>")))
;; Code, chasse fixe
      (if (pregexp-match regexp-tt ligne)
	  (set! ligne
	     (pregexp-replace*
		regexp-tt ligne "<code>\\1</code>")))
      (if (pregexp-match regexp-appelref ligne)
	  (set! ligne
	     (pregexp-replace*
		regexp-appelref ligne "[\\1]")))
      (if (pregexp-match regexp-ref ligne)
	  (set! ligne
	     (pregexp-replace*
		regexp-ref ligne "[\\1]")))
;; Espaces insécables
      (if (pregexp-match regexp-nbsp ligne)
	  (set! ligne
	     (pregexp-replace*
		regexp-nbsp ligne " ")))
;; Lien annoté
      (if (pregexp-match regexp-lien ligne)
	  (set! ligne (traite-lien ligne regexp-lien))
	  )
      (if (pregexp-match regexp-ital ligne)
	  (set! ligne (pregexp-replace*
			 regexp-ital ligne "{\\1}")))
      (if (pregexp-match regexp-gras ligne)
	  (set! ligne (pregexp-replace*
			 regexp-gras ligne "{{\\1}}")))
      (cond ((pregexp-match regexp1 ligne)
	     (print (pregexp-replace
		       regexp1 ligne "{{{***\\2}}}")))
	    ((pregexp-match regexp2 ligne)
	     (print (pregexp-replace
		       regexp2 ligne "{{{**\\2}}}")))
	    ((pregexp-match regexp3 ligne)
	     (print (pregexp-replace
		       regexp3 ligne "{{{*\\2}}}")))
	    ((zero? (string-length ligne))
	     (newline))
;; Pour sauter les lignes de commandes AsciiDoc
	    ((char=? (string-ref ligne 0) #\:))
	    ((substring=? ligne "[." 2))
	    ((substring=? ligne "|===" 4))
	    ((pregexp-match regexp-code ligne))
	    (else
	     (print ligne)))))