(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!)