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) testing.import.scm: $(TESTING-SOURCES)
LISTING-SOURCES=listing.scm testing.import.scm ansi.import.scm \ 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.o: listing.import.scm
listing.import.scm: $(LISTING-SOURCES) listing.import.scm: $(LISTING-SOURCES)

View file

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