From 2ede8897145380722b060b4b7774b45b260566ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Mon, 15 May 2023 11:27:24 +0200
Subject: [PATCH] Switch listings to use util-kwargs.

---
 src/Makefile    |   3 +-
 src/listing.scm | 117 ++++++++++++++++++++++++------------------------
 2 files changed, 61 insertions(+), 59 deletions(-)

diff --git a/src/Makefile b/src/Makefile
index 53f8c2b..84117ba 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -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)
diff --git a/src/listing.scm b/src/listing.scm
index 0299d33..151ef73 100644
--- a/src/listing.scm
+++ b/src/listing.scm
@@ -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,62 +125,63 @@
 
  ;; 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 ()
-					 `((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 loop ((lines lines)
-		  (number 1)
-		  (printed-something #f)
-		  (was-printing #f))
-	 (when (not (null? lines))
-	   (let* ((highlight (match-highlight number highlights))
-		  (hl-type (if highlight (cadddr highlight) #f))
-		  (hl-def (assq hl-type highlight-rules))
-		  (hl-pre-real (if hl-def (cadr hl-def) hl-pre))
-		  (hl-post-real (if hl-def (caddr hl-def) hl-post))
-		  (context? (and (not highlight)
-				 (line-near-targets? number highlights context)))
-		  (print? (or highlight context?)))
-	     (cond (print?
-		    (when (and printed-something
-			       (not was-printing))
-		      (print ellipsis))
-		    (if highlight
-			(display hl-pre-real)
-			(when context?
-			  (display ctx-pre)))
-		    (display (sprintf "~A~A~A"
-				      (format-line-number number digits)
-				      (car lines)
-				      (let ((comment (highlight-comment number highlights)))
-					(if comment
-					    (sprintf "  # <<< ~A" comment)
-					    ""))))
-		    (if highlight
-			(display hl-post-real)
-			(when context?
-			  (display ctx-post)))
-		    (newline)
-		    (loop (cdr lines)
-			  (+ number 1)
-			  #t
-			  #t))
-		   (else
-		    (loop (cdr lines)
-			  (+ number 1)
-			  printed-something
-			  #f)))))))))
+ (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 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)
+		(printed-something #f)
+		(was-printing #f))
+       (when (not (null? lines))
+	 (let* ((highlight (match-highlight number highlights))
+		(hl-type (if highlight (cadddr highlight) #f))
+		(hl-def (assq hl-type highlight-rules))
+		(hl-pre-real (if hl-def (cadr hl-def) hl-pre))
+		(hl-post-real (if hl-def (caddr hl-def) hl-post))
+		(context? (and (not highlight)
+			       (line-near-targets? number highlights context)))
+		(print? (or highlight context?)))
+	   (cond (print?
+		  (when (and printed-something
+			     (not was-printing))
+		    (print ellipsis))
+		  (if highlight
+		      (display hl-pre-real)
+		      (when context?
+			(display ctx-pre)))
+		  (display (sprintf "~A~A~A"
+				    (format-line-number number digits)
+				    (car lines)
+				    (let ((comment (highlight-comment number highlights)))
+				      (if comment
+					  (sprintf "  # <<< ~A" comment)
+					  ""))))
+		  (if highlight
+		      (display hl-post-real)
+		      (when context?
+			(display ctx-post)))
+		  (newline)
+		  (loop (cdr lines)
+			(+ number 1)
+			#t
+			#t))
+		 (else
+		  (loop (cdr lines)
+			(+ number 1)
+			printed-something
+			#f))))))))
 
  ;; Performs self-tests of the listing module.
  (define (listing-tests!)