Switch over to table renderer with listing.

This commit is contained in:
Dominik Pantůček 2023-05-15 18:54:10 +02:00
parent 0e230ec7a2
commit f37006ab09
2 changed files with 52 additions and 40 deletions

View file

@ -97,7 +97,7 @@ testing.o: testing.import.scm
testing.import.scm: $(TESTING-SOURCES)
LISTING-SOURCES=listing.scm testing.import.scm ansi.import.scm \
util-kwargs.import.scm
util-kwargs.import.scm table.import.scm
listing.o: listing.import.scm
listing.import.scm: $(LISTING-SOURCES)

View file

@ -40,7 +40,8 @@
testing
ansi
util-kwargs
util-dict-list)
util-dict-list
table)
;; Returns the number of digits required to represent a given number
;; in decimal format.
@ -140,12 +141,13 @@
(#:highlight-pre hl-pre a:error)
(#:highlight-post hl-post a:default)
(#:context context 3))
(let ((digits (number-digits (length lines))))
(let loop ((lines lines)
(number 1)
(printed-something #f)
(was-printing #f))
(when (not (null? lines))
(let loop ((lines lines)
(number 1)
(printed-something #f)
(was-printing #f)
(rtbl '()))
(if (null? lines)
(print (table->string (reverse rtbl) #:ansi #t))
(let* ((highlight (match-highlight number highlights))
(hl-type (if highlight (cadddr highlight) #f))
(hl-def (assq hl-type highlight-rules))
@ -154,38 +156,48 @@
(context? (and (not highlight)
(line-near-targets? number highlights context)))
(print? (or highlight context?)))
(cond (print?
(when (and printed-something
(not was-printing))
(print ellipsis))
(if highlight
(display hl-pre-real)
(when context?
(display ctx-pre)))
(display (sprintf "~A~A~A"
(format-line-number number digits)
(let ((line (car lines)))
(if (ldict? line)
(ldict-ref line 'line)
line))
(let ((comment (highlight-comment number highlights)))
(if comment
(sprintf " # <<< ~A" comment)
""))))
(if highlight
(display hl-post-real)
(when context?
(display ctx-post)))
(newline)
(loop (cdr lines)
(+ number 1)
#t
#t))
(else
(loop (cdr lines)
(+ number 1)
printed-something
#f))))))))
(if print?
(let ((line (car lines))
(rtbl (if (and printed-something
(not was-printing))
(cons (list "" ellipsis)
rtbl)
rtbl))
(pre-str (if highlight
hl-pre-real
(if context?
ctx-pre
"")))
(post-str (if highlight
hl-post-real
(if context?
ctx-post
"")))
(comment (highlight-comment number highlights))
)
(loop (cdr lines)
(add1 number)
#t
#t
(cons (list (format "\t~A~A. ~A" pre-str number post-str)
(format "~A~A~A"
pre-str
(if (ldict? line)
(ldict-ref line 'line)
line)
post-str)
(if comment
(format "~A # <<< ~A~A"
pre-str
comment
post-str)
"")
)
rtbl)))
(loop (cdr lines)
(+ number 1)
printed-something
#f))))))
;; Performs self-tests of the listing module.
(define (listing-tests!)