(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 "")) (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 "") ;; 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 "\\1"))) ;; Indices (if (pregexp-match regexp-sub ligne) (set! ligne (pregexp-replace* regexp-sub ligne "\\1"))) ;; Code, chasse fixe (if (pregexp-match regexp-tt ligne) (set! ligne (pregexp-replace* regexp-tt ligne "\\1"))) (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)))))