brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Switch listings to use util-kwargs.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-15 11:27:24 +02:00
parent 7bd4c7d222
commit 2ede889714
2 changed files with 61 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/Makefile
View file

@ -96,7 +96,8 @@ TESTING-SOURCES=testing.scm
testing.o: testing.import.scm
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
listing.o: listing.import.scm
listing.import.scm: $(LISTING-SOURCES)

27
src/listing.scm
View file

@ -37,9 +37,9 @@
(chicken base)
(chicken string)
(chicken format)
(chicken keyword)
testing
ansi)
ansi
util-kwargs)
;; Returns the number of digits required to represent a given number
;; in decimal format.
@ -125,19 +125,20 @@
;; Prints and highlights a selection of source listing lines and
;; their optional context.
(define (print-source-listing lines highlights . args)
(let ((highlight-rules (get-keyword #:highlight-rules args
(lambda ()
(define-kwproc (print-source-listing
lines
highlights
(#:highlight-rules highlight-rules
`((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))))
))
(#:ellipsis ellipsis "...")
(#:context-pre ctx-pre "")
(#:context-post ctx-post "")
(#: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)
@ -180,7 +181,7 @@
(loop (cdr lines)
(+ number 1)
printed-something
#f)))))))))
#f))))))))
;; Performs self-tests of the listing module.
(define (listing-tests!)