chickadee » mistie » mistie-def-char

A typical intent of a format file is to cause certain characters in the input document to trigger non-trivial changes in the output document. E.g., if the output is to be HTML, we'd like the characters <, >, &, and " in the input to come out as &lt;, &gt;, &amp;, and &quot;, respectively.

The Mistie procedure mistie-def-char can be used for this:

(mistie-def-char #\< 
  (lambda ()
    (display "&lt;")))

(mistie-def-char #\> 
  (lambda ()
    (display "&gt;")))

(mistie-def-char #\& 
  (lambda ()
    (display "&amp;")))

(mistie-def-char #\" 
  (lambda ()
    (display "&quot;")))

mistie-def-char takes two arguments: The first is the character that is defined, and the second is the procedure associated with it. Here, the procedure writes the HTML encoded version of the character.

Suppose we want a contiguous sequence of blank lines to be come out as the paragraph separator, <p>. We could mistie-def-char the newline character as follows:

(mistie-def-char #\newline
  (lambda ()
    (newline)
    (let* ((s (h-read-whitespace))
           (n (h-number-of-newlines s)))
      (if (> n 0)
          (begin (display "<p>")
            (newline) (newline))
          (display s)))))

This will cause newline to read up all the following whitespace, and then check to see how many further newlines it picked up. If there was at least one, it outputs the paragraph separator, viz., <p> followed by two newlines (added for human readability). Otherwise, it merely prints the picked up whitespace as is.

The help procedures h-read-whitespace and h-number-of-newlines in the code above are ordinary Scheme procedures:

(define h-read-whitespace
  (lambda ()
    (let loop ((r '()))
      (let ((c (peek-char)))
        (if (or (eof-object? c) (not (char-whitespace? c)))
            (list->string (reverse r))
            (loop (cons (read-char) r)))))))

(define h-number-of-newlines
  (lambda (ws)
    (let ((n (string-length ws)))
      (let loop ((i 0) (k 0))
        (if (>= i n) k
            (loop (+ i 1)
              (if (char=? (string-ref ws i) #\newline)
                  (+ k 1) k)))))))