From 20058a1f7b67bdbfbc393f08cd968112f0f1c2a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 15 Nov 2018 16:39:33 +0100 Subject: Add preliminary parse code. --- script.scm | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/script.scm b/script.scm index c2027b1..b43428d 100755 --- a/script.scm +++ b/script.scm @@ -51,6 +51,11 @@ ("DH" bold) (_ identity))) +(define (push item stack) (cons item stack)) +(define (pop stack) (unless (null? stack) + (car+cdr stack))) +(define (peek stack) (if (null? stack) '() (car stack))) + (define (class-handlers class-str) (fold compose identity (map classmap (string-split class-str #\space)))) @@ -58,6 +63,28 @@ (define (fmt-sub nodes) (string-concatenate (map fmt-tag nodes))) +(define (fmt-tag tag) + (sxml-match tag + [(a #; (@ (class ,class)) ,text) + (underline text)] + + [(h1 (@ (class ,class)) ,nodes ...) + ((class-handlers class) + (bold (fmt-sub nodes)))] + + [(span (@ (class ,class)) ,nodes ...) + ((class-handlers class) + (fmt-sub nodes))] + + [,str (guard (string? str)) str] + + [,default (format #f "[|~a|]" default)] + )) + +;;; +;;; +;;; + (define (fmt-tag tag) (sxml-match tag [(a #; (@ (class ,class)) ,text) @@ -83,6 +110,26 @@ spans ])) +'(span (@ (class "B")) + "A" + (span (@ (class "G")) + "B") + "C") + +;; => (blue A (green B) C) +;; => set-blue A set-green B unset-green/set-blue C unset-blue + +;; push blue : print-esc +;; print A +;; push green : print-esc +;; print B +;; pop : print-esc +;; print C +;; pop : print-esc + + + + (define (main args) (define d (call-with-input-file "100-2.html" xml->sxml)) (display (string-concatenate (map fmt-tag (parse-doc d)))) -- cgit v1.2.3