A newerer beginning

1 files changed, 0 insertions, 103 deletions

@@ -1,103 +0,0 @@
-;;; (boudin schmaltz) --- transform almost-html plus scheme into html
-
-;;; Embedded scheme code
-
-(define (->string x)
-  (call-with-port (open-output-string)
-    (lambda (port)
-      (display x port)
-      (get-output-string port))))
-
-(define render-string
-  (case-lambda
-    ((s) (render-string s (interaction-environment)))
-    ((s env)
-     (call-with-port (open-input-string s)
-       (lambda (port)
-         (render port env))))))
-
-(define (render port env)
-  ;; A few rough edges:
-  ;; #, x will try to render x
-  (define (burn-char)
-    ;; Throw a character away.  I've defined this for clarity below.
-    (read-char port))
-
-  (let loop ((ch (read-char port))
-             (acc '()))
-    (define (proceed) (loop (read-char port) (cons ch acc)))
-    (cond
-     ((not ch)
-      (loop (read-char port) acc))
-     ((eof-object? ch)
-      (list->string (reverse acc)))
-     ((eq? ch #\#)                      ; special processing to come
-      (case (peek-char port)
-        ((#\\)                          ; inhibit processing of the next char
-         (burn-char)
-         (loop (read-char port) (cons ch acc)))
-        ((#\,)                          ; scheme eval expansion
-         (burn-char)
-         (loop #f
-               (append (let ((s (->string
-                                 (eval (read port)
-                                       env))))
-                         (cond
-                          ((equal? s "#<unspecified>") ; XXX NOT PORTABLE
-                           '())
-                          ((equal? s "#!eof") ; XXX NOT PORTABLE
-                           '(#\, #\#))
-                          (else (reverse (string->list s)))))
-                       acc)))
-        ((#\@)                          ; embedded sxml
-         (burn-char)
-         (loop #f
-               (append (let ((h (eval `(sxml->html ,(list 'quasiquote
-                                                          (read port)))
-                                      env)))
-                         (cond
-                          ((equal? h "#!eof") ; XXX NOT PORTABLE
-                           '(#\@ #\#))
-                          (else (reverse (string->list h)))))
-                       acc)))
-        (else (proceed))))
-     (else (proceed)))))
-
-;;; Wrap paragraphs
-
-(define (split-paragraphs str)
-  (let loop ((lines (string-split str "\n"))
-             (par '())
-             (acc '()))
-    (cond
-     ((and (null? lines)                ; base case: no more lines
-           (null? par))                 ; ... or pending paragraph
-      (reverse acc))
-     ((null? lines)                     ; add the final paragraph
-      (loop '() '() (cons (apply string-append (reverse par)) acc)))
-     ((equal? (car lines) "")           ; paragraph break
-      (loop (cdr lines)
-            '()
-            (cons (apply string-append (reverse par)) acc)))
-     (else                              ; line break
-      (loop (cdr lines)
-            (cons (string-append (car lines) "\n") par)
-            acc)))))
-
-(define (wrap-paragraphs str)
-  (let loop ((pars (split-paragraphs str))
-             (acc '()))
-    (cond
-     ((null? pars)
-      (apply string-append (reverse acc)))
-     ((zero? (string-length (car pars)))
-      (loop (cdr pars)
-            acc))
-     ((eq? #\< (string-ref (string-trim (car pars)) 0))
-      (loop (cdr pars)
-            (cons (car pars)
-                  acc)))
-     (else
-      (loop (cdr pars)
-            (cons (string-append "<p>" (car pars) "</p>\n")
-                  acc))))))