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)
(when (not (null? lines)) (rtbl '()))
(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))
(rtbl (if (and printed-something
(not was-printing)) (not was-printing))
(print ellipsis)) (cons (list "" ellipsis)
(if highlight rtbl)
(display hl-pre-real) rtbl))
(when context? (pre-str (if highlight
(display ctx-pre))) hl-pre-real
(display (sprintf "~A~A~A" (if context?
(format-line-number number digits) ctx-pre
(let ((line (car lines))) "")))
(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) (if (ldict? line)
(ldict-ref line 'line) (ldict-ref line 'line)
line)) line)
(let ((comment (highlight-comment number highlights))) post-str)
(if comment (if comment
(sprintf " # <<< ~A" comment) (format "~A # <<< ~A~A"
"")))) pre-str
(if highlight comment
(display hl-post-real) post-str)
(when context? "")
(display ctx-post))) )
(newline) rtbl)))
(loop (cdr lines)
(+ number 1)
#t
#t))
(else
(loop (cdr lines) (loop (cdr lines)
(+ number 1) (+ number 1)
printed-something printed-something
#f)))))))) #f))))))
;; Performs self-tests of the listing module. ;; Performs self-tests of the listing module.
(define (listing-tests!) (define (listing-tests!)