Switch over to table renderer with listing.
This commit is contained in:
parent
0e230ec7a2
commit
f37006ab09
2 changed files with 52 additions and 40 deletions
|
@ -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)
|
||||
|
|
|
@ -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!)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue