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.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
listing.o: listing.import.scm listing.o: listing.import.scm
listing.import.scm: $(LISTING-SOURCES) listing.import.scm: $(LISTING-SOURCES)

27
src/listing.scm
View file

@ -37,9 +37,9 @@
(chicken base) (chicken base)
(chicken string) (chicken string)
(chicken format) (chicken format)
(chicken keyword)
testing testing
ansi) ansi
util-kwargs)
;; 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.
@ -125,19 +125,20 @@
;; 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 . args) (define-kwproc (print-source-listing
(let ((highlight-rules (get-keyword #:highlight-rules args lines
(lambda () highlights
(#:highlight-rules highlight-rules
`((error ,(ansi #:bold #:red) ,(ansi #:default)) `((error ,(ansi #:bold #:red) ,(ansi #:default))
(warning ,(ansi #:yellow) ,(ansi #:default)) (warning ,(ansi #:yellow) ,(ansi #:default))
(info ,(ansi #:cyan) ,(ansi #:default)) (info ,(ansi #:cyan) ,(ansi #:default))
)))) ))
(ellipsis (get-keyword #:ellipsis args (lambda () "..."))) (#:ellipsis ellipsis "...")
(ctx-pre (get-keyword #:context-pre args (lambda () ""))) (#:context-pre ctx-pre "")
(ctx-post (get-keyword #:context-post args (lambda () ""))) (#:context-post ctx-post "")
(hl-pre (get-keyword #:highlight-pre args (lambda () a:error))) (#:highlight-pre hl-pre a:error)
(hl-post (get-keyword #:highlight-post args (lambda () a:default))) (#:highlight-post hl-post a:default)
(context (get-keyword #:context args (lambda () 3)))) (#:context context 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)
@ -180,7 +181,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!)