Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

better text display

Browse source
This commit is contained in:
Alex Shinn 2021-04-08 22:59:34 +09:00
parent e3078a7c4c
commit 8c45c3fb19
1 changed files with 7 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
lib/chibi/sxml.scm
View file

@ -141,16 +141,17 @@
;;> Render \var{sxml} as text for viewing in a terminal. ;;> Render \var{sxml} as text for viewing in a terminal.
(define (sxml-display-as-text sxml . o) (define (sxml-display-as-text sxml . o)
(let ((out (if (pair? o) (car o) (current-output-port)))) (let ((out (if (pair? o) (car o) (current-output-port)))
(let lp ((sxml (if (and (pair? sxml) (eq? '*TOP* (car sxml))) (sxml (if (and (pair? sxml) (null? (cddr sxml)) (eq? '*TOP* (car sxml)))
(cdr sxml) (cadr sxml)
sxml))) sxml)))
(let lp ((sxml sxml))
(cond (cond
((pair? sxml) ((pair? sxml)
(let ((tag (car sxml))) (let ((tag (car sxml)))
(cond (cond
;; skip headers and the menu ;; skip headers and the menu
((or (memq tag '(head style script)) ((or (memq tag '(head style script !DOCTYPE))
(and (eq? 'div tag) (and (eq? 'div tag)
(pair? (cdr sxml)) (pair? (cdr sxml))
(pair? (cadr sxml)) (pair? (cadr sxml))
@ -158,6 +159,8 @@
(equal? '(id . "menu") (assq 'id (cdr (cadr sxml))))))) (equal? '(id . "menu") (assq 'id (cdr (cadr sxml)))))))
;; recurse other tags, appending newlines for new sections ;; recurse other tags, appending newlines for new sections
((symbol? tag) ((symbol? tag)
(if (memq tag '(h1 h2 h3 h4 h5 h6))
(newline out))
(for-each (for-each
lp lp
(if (and (pair? (cdr sxml)) (eq? '@ (cadr sxml))) (if (and (pair? (cdr sxml)) (eq? '@ (cadr sxml)))