$ more Markdown.scm 
(module Markdown
 (*
  Markdown)

(import scheme)
(import chicken)
(use extras)
(use md5)
(use matchable)
(use srfi-13) ; string-downcase
(require-extension regex)
(import irregex)

(define *tab-width* 4)
(define *less-than-tab* (- *tab-width* 1))

(define *escape-table*
  (let gen ((t '(#\\ #\` #\* #\_ #\{ #\} #\[ #\] #\( #\) #\# #\+ #\- #\. #\!)))
    (if (null? t) '()
      (cons `(,(car t) . ,(md5-digest (string (car t)))) (gen (cdr t))))))

;(define cons-and-carry-on begin)

(define (is-blank? str)
  (irregex-match "^[[:space:]]*$" str))

(define (generator lst)
 (let ((lst lst))
  (lambda ()
   (if (null? lst) #f
     (let ((item (car lst)))
       (set! lst (cdr lst))
       item)))))


; Main procedure
; The order in which other procs are called here is essential. Link and image
; substitutions need to happen before _EscapeSpecialChars, so that any *'s or
; _'s in the <a> and <img> tags get encoded.
;
; We read from current-input-port and return sxml in a list.
;
(define (Markdown)
 ; Standardize the line endings
 ; read-line returns the lines without newline characters

 (let* ((lines
          ; Here we read every line of the file converting tabs to aligned spaces
          ; (_Detab regex) as we go. We also transform consecutive blank lines
          ; (i.e. lines with no characers or consisting of whitespace only) into a
          ; single blank line (i.e. lines with no characters).
          ; Canonicalising blank lines makes subsequent regexes easier to write, because
          ; we can match consecutive blank lines with /\n+/ instead of something
          ; contorted like /[ \t]*\n+/ . Of course, in this version there are no
          ; I'm not sure in which situations it's dangerous to change tabs to spaces but
          ; it's what the original Perl version does.
          (read-file (current-input-port)
            (let ((prev-line '()))
             (lambda (port)
              (let loop ((str (read-line port)))
               (cond
                ((eof-object? str) str)
                ((and (is-blank? str) (is-blank? prev-line)) (loop (read-line port))) ; Strip consecutive blank lines
                (else
                  (set! prev-line str)
                  (if (is-blank? str) ""                        ; Return empty lines as blank
                     (irregex-replace/all "(.*?)\t" str         ; _Detab : Convert all tabs to spaces
                      (lambda (match)                           ; Regex from http://www.nntp.perl.org/group/perl.macperl.anyperl/2002/03/msg154.html
                       (let ((match (irregex-match-substring match 1)))
                        (string-append
                         match
                         (make-string (- *tab-width* (modulo (string-length match) *tab-width*)) #\ )))))))))))))
        (next-line (generator lines))
        ; TODO: Pull out all the preformed HTML sections as we don't render them. See _HashHTMLBlocks, pg.6.
        ; We can put them back into the list as sxml lists and we can ignore them later because they won't be strings.
        (lines
          ; We only want to do this for block-level HTML tags, such as headers,
          ; lists, and tables. That's because we still want to wrap <p>s around
          ; "paragraphs" that are wrapped in non-block-level tags, such as anchors,
          ; phrase emphasis, and spans. The list of tags we're looking for is
          ; hard-coded:
          (let ((block-tags-a (string->sre "p|div|h[1-6]|blockquote|pre|table|dl|ol|ul|script|noscript|form|fieldset|iframe|math|ins|del"))
                (block-tags-b "p|div|h[1-6]|blockquote|pre|table|dl|ol|ul|script|noscript|form|fieldset|iframe|math")
                (lines (make-parameter '())))
            ; First, look for nested blocks, e.g.:
            ;   <div>
            ;     <div>
            ;     tags for inner block must be indented.
            ;     </div>
            ;   </div>
            ;
            ; The outermost tags must start at the left margin for this to match, and
            ; the inner nested divs must be indented.
            ; We need to do this before the next, more liberal match, because the next
            ; match will start at the first `<div>` and stop at the first `</div>`.
            (let loop ((line (next-line))
                      (prev-line '()))
             (if line
              (if (not (string? line))
               ;(cons-and-carry-on ; Already processed
               (begin ; Already processed
                (lines (cons line (lines)))
                (loop (next-line) line))
               (let ((irmatch (irregex-match (irregex
                                              `(: bos "<" (submatch ,block-tags-a) eow (* nonl))
                                              'i
                                              ) line)))
                (if irmatch
                 (let* ((tag (irregex-match-substring irmatch 1)))
                  ; TODO: This bit
                   (display (format "found starting tag~A\n" tag))))


                (lines (cons line (lines))) (loop (next-line) line)
                ))))
            (lines)))
        (lines (reverse lines))
        (next-line (generator lines))


        ; Here we loop through every line and try to decide if there's a link
        ; to strip. If we find one then we strip it. We are careful to not
        ; leave consecutive blank lines in the file. _StripLinkDefinitions
        ; We must strip links before anything else to have the same "re-use id"
        ; semantics as the original parser.
        (link-refs (make-parameter '()))
        (lines
           (let ((lines (make-parameter '())))
             (let loop ((line (next-line))
                        (prev-line '()))
              (if line
               ; TODO: (if !string (cons-and-carry-on) (else...
               ; Is it a link reference?
               (let ((irmatch (irregex-match (string-append
                                               "^[ ]{0," (format "~A" *less-than-tab*) "}" ; Up to "3" spaces.
                                               "\\[(.+)\\]:"                               ; Then the link id in square brackets followed by a colon.
                                               "[ ]*"                                      ; Maybe some space.
                                               "(<?[^[:space:]]+>?)?"                      ; Then maybe the URL itself, possibly enclosed between <>.
                                               "[ ]*"                                      ; Maybe some more space.
                                               "([\"(](.+)[\")])?"                         ; Then maybe an optional title maybe enclosed in " or ( or possibly a mixture.
                                               "[ ]*"                                      ; Possibly some trailing space.
                                               ) line)))
                 (if irmatch
                   (let* ((id    (irregex-match-substring irmatch 1))
                          (url   (irregex-match-substring irmatch 2))
                          (url   (if url (irregex-replace "^<?(.*?)>?$" url 1) #f))
                          (title (irregex-match-substring irmatch 4))
                          (stow-and-continue  (lambda (id url title next)
                                                ; stow the id, url and title in the dictionary
                                                (link-refs (cons (list (string-downcase id) url title) (link-refs)))
                                                ; Preserve "no consecutive blank lines".
                                                ; If the previous line was blank, strip the next line if it's also blank and pass on a blank "prev-line"
                                                ; otherwise pass on the next line and the previous line, not the current line as we're stripping it.
                                                (if (and (is-blank? prev-line) (is-blank? next)) (loop (next-line) prev-line) (loop next prev-line))))
                          (find-title (lambda (id url)
                                        ; There's a chance that the title will be on the next line.
                                        (let* ((next (next-line))
                                               (irmatch (irregex-match (string-append
                                                                         "[ ]*"               ; Always allowing the blank space.
                                                                         "([\"(](.+)[\")])"   ; If we're lucky there will be a title, maybe enclosed in " or ( or possibly a mixture.
                                                                         "[ ]*"               ; Nothing else to be found on this line except maybe those whitespaces.
                                                                         ) next)))
                                          (if irmatch
                                            (let ((title (irregex-match-substring irmatch 1)))
                                              (stow-and-continue id url title (next-line)))
                                            (stow-and-continue id url #f next)))))) ; This next line wasn't a title so stow this link without one.
                     (match (list id url title)
                            ((#f #f #f) ; Something went horribly wrong: just cons up the line and carry on.
                             ;(cons-and-carry-on
                             (begin
                              (lines (cons line (lines)))
                              (loop (next-line) line)))
                            ((_  #f #f) ; We might have found a link, provided the URL (and maybe also title) are on the next line.
                             (let* ((next (next-line))
                                    (irmatch (irregex-match (string-append
                                                              "[ ]*"                ; Maybe some space.
                                                              "(<?[^[:space:]]+>?)" ; Then definitely the URL itself, possibly enclosed between <>.
                                                              "[ ]*"                ; Maybe a bit more space.
                                                              "([\"(](.+)[\")])?"   ; Then maybe an optional title maybe enclosed in " or ( or possibly a mixture.
                                                              "[ ]*"                ; Of course, space is allowed.
                                                              ) next))) ; This will match unless the line is blank. The original parser can produce all sorts of bogus URLS.
                               (if irmatch
                                 (let ((url   (irregex-replace "^<?(.*?)>?$" (irregex-match-substring irmatch 1) 1))
                                       (title (irregex-match-substring irmatch 2)))
                                   (match (list id url title)
                                          ((_  _  #f) ; We found a URL but not a title.
                                           (find-title id url))
                                          ((_  _  _ ) ; We've got everything.
                                           (stow-and-continue id url title (next-line)))))
                                 ;(cons-and-carry-on   ; Oops.. we didn't really find a link.
                                 (begin   ; Oops.. we didn't really find a link.
                                   (lines (cons line (lines)))
                                   (loop next line)))))
                            ((_  _  #f) ; We got an ID and URL but not a title.
                             (find-title id url))
                            ((_  _  _ ) ; Everything all on one line: super!
                             (stow-and-continue id url title (next-line)))))
                   ;(cons-and-carry-on   ; This doesn't look like a link reference.
                   (begin   ; This doesn't look like a link reference.
                     (lines (cons line (lines)))
                     (loop (next-line) line))))))
             (lines)))
        (lines (reverse lines))
        (next-line (generator lines)))

   ; Work out the type of that line and enclose it in the
   ; correct sxml forms, escaping and converting as we go...
   ;
   ; Write something that just returns the line prefixed by the type we think it is?
   ; that's virtually the whole thing anyway...



   ; This clause needs to evaluate to the sxml document
   ; The document will probably need a final processing step to render all the
   ; links.
   (let loop ((line (next-line)))
     (if line
       (begin
         (display line)
         (newline)
         (loop (next-line)))))

;(link-refs))
   "done")


  ; From the syntax document:
  ; Inline HTML: *blocks* are in their own paragraph and the first tag starts
  ; in column 1.

 ; Make sure that the input ends with a couple of newlines
 ; Why??

 ; Turn block-level HTML blocks into hash entries

 ; Strip link definitions, store in hashes.
 ;  -- strip these as we go and store them somewhere.
 ;  Whenever we generate a link, generate a procedure that we can evaluate
 ;  later and pass in the store of definitions.


 ; Converting inline html to sxml: use irregex to find the start of the tag
 ; match. emit the text until that point, then emit an sxml form containing the
 ; substring from the match. This will need to be recursive.  

)

)