(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 "<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))))) </cadre> Et le texte AsciiDoc de l'article (moins le programme...) : <cadre> :source-highlighter: coderay :asciidoctor: :author:    Laurent Bloch :email:     lb@laurentbloch.org :revdate:   30 septembre 2020 :lang:            fr :numbered: :toc: = Un seul logiciel pour tous mes textes ! Et aussi pour mon site Web. Souvent j'écris un texte en LaTeX pour avoir une sortie PDF présentable, puis on me demande une copie au formatdocxde Word, par exemple pour une publication. Traduire à la main du LaTeX endocx` est fastidieux, et on oublie toujours quelque chose. Les logiciels censés faire cela ne m'ont jamais convaincu, et ceux qui le font en sens inverse sont pires. ... L'article que vous lisez a été écrit en AsciiDoc et traduit en Spip par AsciiDoc-Spip. Voici le programme : [source, scheme] ---- (module AsciiDoc-Spip (main analyse-fichier)) (define (analyse-fichier args) (let ((un-fichier (cadr args))) (call-with-input-file un-fichier lire-des-lignes))) ... ----