76 lines
2.1 KiB
Scheme
76 lines
2.1 KiB
Scheme
|
|
(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!)
|