Convert print-source-listings to use keywords.
This commit is contained in:
parent
7a0db40062
commit
ffc5442c17
3 changed files with 57 additions and 46 deletions
2
Makefile
2
Makefile
|
@ -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
|
||||||
|
|
20
listing.scm
20
listing.scm
|
@ -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!)
|
||||||
|
|
|
@ -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
|
|
||||||
)))
|
)))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue