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)
|
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)
|
||||||
|
|
|
@ -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!)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue