Convert print-source-listings to use keywords.

This commit is contained in:
Dominik Pantůček 2023-03-28 18:51:13 +02:00
parent 7a0db40062
commit ffc5442c17
3 changed files with 57 additions and 46 deletions

View file

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

View file

@ -36,7 +36,9 @@
(chicken base) (chicken base)
(chicken string) (chicken string)
(chicken format) (chicken format)
testing) (chicken keyword)
testing
ansi)
;; 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.
@ -108,7 +110,19 @@
;; Prints and highlights a selection of source listing lines and ;; Prints and highlights a selection of source listing lines and
;; their optional context. ;; their optional context.
(define (print-source-listing lines highlights context hl-pre hl-post ctx-pre ctx-post ellipsis) (define (print-source-listing lines highlights . args)
(let ((highlight-rules (get-keyword #:highlight-rules args
(lambda ()
'((error (ansi #:bold #:red) (ansi #:default))
(warning (ansi #:yellow) (ansi #:default))
(info (ansi #:cyan) (ansi #:default))
))))
(ellipsis (get-keyword #:ellipsis args (lambda () "...")))
(ctx-pre (get-keyword #:context-pre args (lambda () "")))
(ctx-post (get-keyword #:context-post args (lambda () "")))
(hl-pre (get-keyword #:highlight-pre args (lambda () a:error)))
(hl-post (get-keyword #:highlight-post args (lambda () a:default)))
(context (get-keyword #:context args (lambda () 3))))
(let ((digits (number-digits (length lines)))) (let ((digits (number-digits (length lines))))
(let loop ((lines lines) (let loop ((lines lines)
(number 1) (number 1)
@ -147,7 +161,7 @@
(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!)

View file

@ -139,10 +139,7 @@
(print-source-listing (print-source-listing
lines lines
hls hls
-1 #:context -1
a:error a:default
"" "" ; Not used
"..." ; Not used
))) )))
) )