Start tracking the listing module.

listing.scm

@@ -0,0 +1,76 @@
+
+(module
+ listing (print-source-listing listing-tests!)
+
+ (import scheme
+	 testing
+	 (chicken base)
+	 (chicken string)
+	 (chicken format))
+
+ ;; Returns the number of digits required to represent a given number
+ ;; in decimal format.
+ (define (number-digits number)
+   (let loop ((number (abs number))
+	      (digits 0))
+     (if (= number 0)
+	 (if (= digits 0)
+	     1
+	     digits)
+	 (loop (quotient number 10)
+	       (+ digits 1)))))
+
+ ;; Formats line number padding it with spaces from the left for
+ ;; alignment with number of given maximum number of digits and
+ ;; appends ordinal dot and space.
+ (define (format-line-number number digits)
+   (let loop ((args (list (sprintf "~A. " number)))
+	      (spaces (- digits (number-digits number))))
+     (if (<= spaces 0)
+	 (string-intersperse args "")
+	 (loop (cons " " args)
+	       (- spaces 1)))))
+
+ ;; Returns true if given line is near the target line.
+ (define (line-near-target? line target context)
+   (or (< context 0)
+       (<= (abs (- line target)) context)))
+
+ (define (print-source-listing lines highlights context hl-pre hl-post ctx-pre ctx-pre ellipsis)
+   (let ((digits (number-digits (length lines))))
+     (let loop ((lines lines)
+		(number 1))
+       (when (not (null? lines))
+	 (print (format-line-number number digits) (car lines))
+	 (loop (cdr lines)
+	       (+ number 1))))))
+
+ ;; Performs self-tests of the listing module.
+ (define (listing-tests!)
+   (run-tests
+    listing
+    (test-eq? number-digits (number-digits 0) 1)
+    (test-eq? number-digits (number-digits 1) 1)
+    (test-eq? number-digits (number-digits 9) 1)
+    (test-eq? number-digits (number-digits 10) 2)
+    (test-eq? number-digits (number-digits 999) 3)
+    (test-equal? format-line-number (format-line-number 5 3) "  5. ")
+    (test-true line-near-target? (line-near-target? 4 5 -1))
+    (test-true line-near-target? (line-near-target? 4 5 1))
+    (test-true line-near-target? (line-near-target? 1 5 10))
+    (test-false line-near-target? (line-near-target? 4 5 0))
+    ))
+
+ )
+
+(import listing)
+
+(print-source-listing
+ '("asdf" "qwer")
+ '(1)
+ 5
+ "\x1b[31;1m" "\x1b[0m"
+ "\x1b[33;1m" "\x1b[0m"
+ "\x1b[30;1m...\x1b[0m")
+
+(listing-tests!)