Artifact 1ae10ecaa1766cc39c1a4753f014a4236cdac3b5:
- File fmt/fmt-column.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 15871)
0000: 3b 3b 3b 3b 20 66 6d 74 2d 62 6c 6f 63 6b 2e 73 ;;;; fmt-block.s 0010: 63 6d 20 2d 2d 20 63 6f 6c 75 6d 6e 61 72 20 66 cm -- columnar f 0020: 6f 72 6d 61 74 74 69 6e 67 0a 3b 3b 0a 3b 3b 20 ormatting.;;.;; 0030: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 32 30 Copyright (c) 20 0040: 30 36 2d 32 30 31 31 20 41 6c 65 78 20 53 68 69 06-2011 Alex Shi 0050: 6e 6e 2e 20 20 41 6c 6c 20 72 69 67 68 74 73 20 nn. All rights 0060: 72 65 73 65 72 76 65 64 2e 0a 3b 3b 20 42 53 44 reserved..;; BSD 0070: 2d 73 74 79 6c 65 20 6c 69 63 65 6e 73 65 3a 20 -style license: 0080: 68 74 74 70 3a 2f 2f 73 79 6e 74 68 63 6f 64 65 http://synthcode 0090: 2e 63 6f 6d 2f 6c 69 63 65 6e 73 65 2e 74 78 74 .com/license.txt 00a0: 0a 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ...;;;;;;;;;;;;; 00b0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 00c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 00d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 00e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 20 ;;;;;;;;;;;.;;; 00f0: 43 6f 6c 75 6d 6e 61 72 20 66 6f 72 6d 61 74 74 Columnar formatt 0100: 69 6e 67 0a 3b 3b 0a 3b 3b 20 41 20 6c 69 6e 65 ing.;;.;; A line 0110: 2d 6f 72 69 65 6e 74 65 64 20 66 6f 72 6d 61 74 -oriented format 0120: 74 65 72 2e 20 20 54 61 6b 65 73 20 61 20 6c 69 ter. Takes a li 0130: 73 74 20 6f 66 0a 3b 3b 20 20 20 28 6c 69 6e 65 st of.;; (line 0140: 2d 66 6d 74 31 20 67 65 6e 2d 66 6d 74 31 20 6c -fmt1 gen-fmt1 l 0150: 69 6e 65 2d 66 6d 74 32 20 67 65 6e 2d 66 6d 74 ine-fmt2 gen-fmt 0160: 32 20 2e 2e 2e 29 0a 3b 3b 20 61 6e 64 20 66 6f 2 ...).;; and fo 0170: 72 6d 61 74 73 20 65 61 63 68 20 6f 66 20 74 68 rmats each of th 0180: 65 20 67 65 6e 2d 66 6d 74 31 20 66 6f 72 6d 61 e gen-fmt1 forma 0190: 74 73 20 61 73 20 63 6f 6c 75 6d 6e 73 2c 20 70 ts as columns, p 01a0: 72 69 6e 74 65 64 0a 3b 3b 20 73 69 64 65 2d 62 rinted.;; side-b 01b0: 79 2d 73 69 64 65 2c 20 65 61 63 68 20 6c 69 6e y-side, each lin 01c0: 65 20 61 6c 6c 6f 77 69 6e 67 20 70 6f 73 74 2d e allowing post- 01d0: 70 72 6f 63 65 73 73 69 6e 67 20 64 6f 6e 65 20 processing done 01e0: 62 79 20 6c 69 6e 65 2d 66 6d 74 31 0a 3b 3b 20 by line-fmt1.;; 01f0: 28 6a 75 73 74 20 75 73 65 20 64 73 70 20 69 66 (just use dsp if 0200: 20 79 6f 75 20 77 61 6e 74 20 74 6f 20 64 69 73 you want to dis 0210: 70 6c 61 79 20 74 68 65 20 6c 69 6e 65 73 20 76 play the lines v 0220: 65 72 62 61 74 69 6d 29 2e 0a 0a 3b 3b 20 43 6f erbatim)...;; Co 0230: 6e 74 69 6e 75 61 74 69 6f 6e 73 20 63 6f 6d 65 ntinuations come 0240: 20 74 6f 20 74 68 65 20 72 65 73 63 75 65 20 74 to the rescue t 0250: 6f 20 6d 61 6b 65 20 74 68 69 73 20 77 6f 72 6b o make this work 0260: 20 70 72 6f 70 65 72 6c 79 2c 0a 3b 3b 20 6c 65 properly,.;; le 0270: 74 74 69 6e 67 20 75 73 20 77 65 61 76 65 20 74 tting us weave t 0280: 68 65 20 6f 75 74 70 75 74 20 62 65 74 77 65 65 he output betwee 0290: 6e 20 64 69 66 66 65 72 65 6e 74 20 63 6f 6c 75 n different colu 02a0: 6d 6e 73 20 77 69 74 68 6f 75 74 0a 3b 3b 20 6e mns without.;; n 02b0: 65 65 64 69 6e 67 20 74 6f 20 62 75 69 6c 64 20 eeding to build 02c0: 75 70 20 69 6e 74 65 72 6d 65 64 69 61 74 65 20 up intermediate 02d0: 73 74 72 69 6e 67 73 2e 0a 0a 28 64 65 66 69 6e strings...(defin 02e0: 65 20 28 66 6d 74 2d 63 6f 6c 75 6d 6e 73 20 2e e (fmt-columns . 02f0: 20 6c 73 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 ls). (lambda ( 0300: 6f 72 69 67 2d 73 74 29 0a 20 20 20 20 28 63 61 orig-st). (ca 0310: 6c 6c 2d 77 69 74 68 2d 63 75 72 72 65 6e 74 2d ll-with-current- 0320: 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 0a 20 20 20 continuation. 0330: 20 20 28 6c 61 6d 62 64 61 20 28 72 65 74 75 72 (lambda (retur 0340: 6e 29 0a 20 20 20 20 20 20 20 28 64 65 66 69 6e n). (defin 0350: 65 20 28 69 6e 66 69 6e 69 74 65 3f 20 78 29 0a e (infinite? x). 0360: 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 (and (p 0370: 61 69 72 3f 20 78 29 20 28 70 61 69 72 3f 20 28 air? x) (pair? ( 0380: 63 64 72 20 78 29 29 20 28 70 61 69 72 3f 20 28 cdr x)) (pair? ( 0390: 63 64 64 72 20 78 29 29 20 28 63 61 64 64 72 20 cddr x)) (caddr 03a0: 78 29 29 29 0a 20 20 20 20 20 20 20 28 6c 65 74 x))). (let 03b0: 20 28 28 71 31 20 27 28 29 29 0a 20 20 20 20 20 ((q1 '()). 03c0: 20 20 20 20 20 20 20 20 28 71 32 20 27 28 29 29 (q2 '()) 03d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 . (r 03e0: 65 6d 61 69 6e 69 6e 67 20 28 6c 65 6e 67 74 68 emaining (length 03f0: 20 28 72 65 6d 6f 76 65 20 69 6e 66 69 6e 69 74 (remove infinit 0400: 65 3f 20 6c 73 29 29 29 29 0a 20 20 20 20 20 20 e? ls)))). 0410: 20 20 20 28 64 65 66 69 6e 65 20 28 65 6e 71 21 (define (enq! 0420: 20 70 72 6f 63 29 20 28 73 65 74 21 20 71 32 20 proc) (set! q2 0430: 28 63 6f 6e 73 20 70 72 6f 63 20 71 32 29 29 29 (cons proc q2))) 0440: 0a 20 20 20 20 20 20 20 20 20 28 64 65 66 69 6e . (defin 0450: 65 20 28 64 65 71 21 29 20 28 6c 65 74 20 28 28 e (deq!) (let (( 0460: 70 72 6f 63 20 28 63 61 72 20 71 31 29 29 29 20 proc (car q1))) 0470: 28 73 65 74 21 20 71 31 20 28 63 64 72 20 71 31 (set! q1 (cdr q1 0480: 29 29 20 70 72 6f 63 29 29 0a 20 20 20 20 20 20 )) proc)). 0490: 20 20 20 28 64 65 66 69 6e 65 20 28 6c 69 6e 65 (define (line 04a0: 2d 69 6e 69 74 21 29 20 28 73 65 74 21 20 71 31 -init!) (set! q1 04b0: 20 28 72 65 76 65 72 73 65 20 71 32 29 29 20 28 (reverse q2)) ( 04c0: 73 65 74 21 20 71 32 20 27 28 29 29 29 0a 20 20 set! q2 '())). 04d0: 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 (define ( 04e0: 6c 69 6e 65 2d 64 6f 6e 65 3f 29 20 28 6e 75 6c line-done?) (nul 04f0: 6c 3f 20 71 31 29 29 0a 20 20 20 20 20 20 20 20 l? q1)). 0500: 20 28 64 65 66 69 6e 65 20 6c 69 6e 65 2d 62 75 (define line-bu 0510: 66 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 f '()). 0520: 28 64 65 66 69 6e 65 20 6c 69 6e 65 2d 6e 6f 6e (define line-non 0530: 2d 65 6d 70 74 79 3f 20 23 66 29 0a 20 20 20 20 -empty? #f). 0540: 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 77 72 (define (wr 0550: 69 74 65 2d 63 6f 6c 75 6d 6e 20 66 6d 74 20 73 ite-column fmt s 0560: 74 72 20 66 69 6e 69 74 65 3f 29 0a 20 20 20 20 tr finite?). 0570: 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 69 6e (set! lin 0580: 65 2d 62 75 66 20 28 63 6f 6e 73 20 28 63 6f 6e e-buf (cons (con 0590: 73 20 66 6d 74 20 73 74 72 29 20 6c 69 6e 65 2d s fmt str) line- 05a0: 62 75 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 buf)). 05b0: 20 28 69 66 20 66 69 6e 69 74 65 3f 20 28 73 65 (if finite? (se 05c0: 74 21 20 6c 69 6e 65 2d 6e 6f 6e 2d 65 6d 70 74 t! line-non-empt 05d0: 79 3f 20 23 74 29 29 29 0a 20 20 20 20 20 20 20 y? #t))). 05e0: 20 20 28 64 65 66 69 6e 65 20 28 77 72 69 74 65 (define (write 05f0: 2d 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 20 20 -line). 0600: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond. 0610: 20 20 20 20 28 6c 69 6e 65 2d 6e 6f 6e 2d 65 6d (line-non-em 0620: 70 74 79 3f 0a 20 20 20 20 20 20 20 20 20 20 20 pty?. 0630: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each. 0640: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd 0650: 61 20 28 78 29 20 28 73 65 74 21 20 6f 72 69 67 a (x) (set! orig 0660: 2d 73 74 20 28 28 28 63 61 72 20 78 29 20 28 63 -st (((car x) (c 0670: 64 72 20 78 29 29 20 6f 72 69 67 2d 73 74 29 29 dr x)) orig-st)) 0680: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 0690: 28 72 65 76 65 72 73 65 20 6c 69 6e 65 2d 62 75 (reverse line-bu 06a0: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f)). 06b0: 20 28 73 65 74 21 20 6f 72 69 67 2d 73 74 20 28 (set! orig-st ( 06c0: 6e 6c 20 6f 72 69 67 2d 73 74 29 29 29 29 0a 20 nl orig-st)))). 06d0: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set! 06e0: 6c 69 6e 65 2d 62 75 66 20 27 28 29 29 0a 20 20 line-buf '()). 06f0: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 6c (set! l 0700: 69 6e 65 2d 6e 6f 6e 2d 65 6d 70 74 79 3f 20 23 ine-non-empty? # 0710: 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c f). (l 0720: 69 6e 65 2d 69 6e 69 74 21 29 29 0a 20 20 20 20 ine-init!)). 0730: 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 6e 65 (define (ne 0740: 78 74 20 63 6f 6e 74 29 0a 20 20 20 20 20 20 20 xt cont). 0750: 20 20 20 20 28 65 6e 71 21 20 63 6f 6e 74 29 0a (enq! cont). 0760: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond 0770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c . ((l 0780: 69 6e 65 2d 64 6f 6e 65 3f 29 20 0a 20 20 20 20 ine-done?) . 0790: 20 20 20 20 20 20 20 20 20 28 77 72 69 74 65 2d (write- 07a0: 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 20 20 20 line). 07b0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 70 6f 73 (if (not (pos 07c0: 69 74 69 76 65 3f 20 72 65 6d 61 69 6e 69 6e 67 itive? remaining 07d0: 29 29 20 28 66 69 6e 69 73 68 29 20 28 28 64 65 )) (finish) ((de 07e0: 71 21 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 q!) #f))). 07f0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 28 64 65 (else ((de 0800: 71 21 29 20 23 66 29 29 29 29 0a 20 20 20 20 20 q!) #f)))). 0810: 20 20 20 20 28 64 65 66 69 6e 65 20 28 66 69 6e (define (fin 0820: 69 73 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 ish). 0830: 28 77 72 69 74 65 2d 6c 69 6e 65 29 0a 20 20 20 (write-line). 0840: 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 (return 0850: 6f 72 69 67 2d 73 74 29 29 0a 20 20 20 20 20 20 orig-st)). 0860: 20 20 20 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 (define (make 0870: 2d 65 6d 70 74 79 2d 63 6f 6c 20 66 6d 74 29 0a -empty-col fmt). 0880: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 66 69 (defi 0890: 6e 65 20 28 62 6c 61 6e 6b 20 2a 69 67 6e 6f 72 ne (blank *ignor 08a0: 65 64 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 ed*). 08b0: 20 20 28 77 72 69 74 65 2d 63 6f 6c 75 6d 6e 20 (write-column 08c0: 66 6d 74 20 22 22 20 23 66 29 0a 20 20 20 20 20 fmt "" #f). 08d0: 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 62 6c (next bl 08e0: 61 6e 6b 29 29 20 20 20 20 3b 20 69 6e 66 69 6e ank)) ; infin 08f0: 69 74 65 20 6c 6f 6f 70 2c 20 6e 65 78 74 20 74 ite loop, next t 0900: 65 72 6d 69 6e 61 74 65 73 20 66 6f 72 20 75 73 erminates for us 0910: 0a 20 20 20 20 20 20 20 20 20 20 20 62 6c 61 6e . blan 0920: 6b 29 0a 20 20 20 20 20 20 20 20 20 28 64 65 66 k). (def 0930: 69 6e 65 20 28 6d 61 6b 65 2d 63 6f 6c 20 73 74 ine (make-col st 0940: 20 66 6d 74 20 67 65 6e 20 66 69 6e 69 74 65 3f fmt gen finite? 0950: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 ). (le 0960: 74 20 28 28 61 63 63 20 27 28 29 29 29 20 20 20 t ((acc '())) 0970: 20 20 20 20 20 20 20 20 20 3b 20 62 75 66 66 65 ; buffe 0980: 72 20 69 6e 63 6f 6d 70 6c 65 74 65 20 6c 69 6e r incomplete lin 0990: 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 es. 09a0: 28 6c 61 6d 62 64 61 20 28 2a 69 67 6e 6f 72 65 (lambda (*ignore 09b0: 64 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 d*). 09c0: 20 20 20 28 64 65 66 69 6e 65 20 28 6f 75 74 70 (define (outp 09d0: 75 74 2a 20 73 74 72 20 73 74 29 0a 20 20 20 20 ut* str st). 09e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le 09f0: 74 20 6c 70 20 28 28 69 20 30 29 29 0a 20 20 20 t lp ((i 0)). 0a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a10: 28 6c 65 74 20 28 28 6e 6c 69 20 28 73 74 72 69 (let ((nli (stri 0a20: 6e 67 2d 69 6e 64 65 78 20 73 74 72 20 23 5c 6e ng-index str #\n 0a30: 65 77 6c 69 6e 65 20 69 29 29 29 0a 20 20 20 20 ewline i))). 0a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a50: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond. 0a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6c (nl 0a70: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i. 0a80: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let (( 0a90: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 line. 0aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0ab0: 20 20 20 28 73 74 72 69 6e 67 2d 63 6f 6e 63 61 (string-conca 0ac0: 74 65 6e 61 74 65 2d 72 65 76 65 72 73 65 0a 20 tenate-reverse. 0ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c 0af0: 6f 6e 73 20 28 73 75 62 73 74 72 69 6e 67 2f 73 ons (substring/s 0b00: 68 61 72 65 64 20 73 74 72 20 69 20 6e 6c 69 29 hared str i nli) 0b10: 20 61 63 63 29 29 29 29 0a 20 20 20 20 20 20 20 acc)))). 0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0b30: 20 20 28 73 65 74 21 20 61 63 63 20 27 28 29 29 (set! acc '()) 0b40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 0b50: 20 20 20 20 20 20 20 20 20 20 28 77 72 69 74 65 (write 0b60: 2d 63 6f 6c 75 6d 6e 20 66 6d 74 20 6c 69 6e 65 -column fmt line 0b70: 20 66 69 6e 69 74 65 3f 29 0a 20 20 20 20 20 20 finite?). 0b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0b90: 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 63 75 (call-with-cu 0ba0: 72 72 65 6e 74 2d 63 6f 6e 74 69 6e 75 61 74 69 rrent-continuati 0bb0: 6f 6e 20 6e 65 78 74 29 20 0a 20 20 20 20 20 20 on next) . 0bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0bd0: 20 20 20 28 6c 70 20 28 2b 20 6e 6c 69 20 31 29 (lp (+ nli 1) 0be0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 0bf0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else. 0c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0c10: 20 20 20 20 20 20 20 28 73 65 74 21 20 61 63 63 (set! acc 0c20: 20 28 63 6f 6e 73 20 28 73 75 62 73 74 72 69 6e (cons (substrin 0c30: 67 2f 73 68 61 72 65 64 20 73 74 72 20 69 29 20 g/shared str i) 0c40: 61 63 63 29 29 29 29 29 29 0a 20 20 20 20 20 20 acc)))))). 0c50: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 75 70 ;; up 0c60: 64 61 74 65 20 2d 20 64 6f 6e 27 74 20 6f 75 74 date - don't out 0c70: 70 75 74 20 6f 72 20 74 68 65 20 73 74 72 69 6e put or the strin 0c80: 67 20 70 6f 72 74 20 77 69 6c 6c 20 66 69 6c 6c g port will fill 0c90: 20 75 70 0a 20 20 20 20 20 20 20 20 20 20 20 20 up. 0ca0: 20 20 20 20 20 28 66 6d 74 2d 75 70 64 61 74 65 (fmt-update 0cb0: 20 73 74 72 20 73 74 29 29 0a 20 20 20 20 20 20 str st)). 0cc0: 20 20 20 20 20 20 20 20 20 3b 3b 20 67 65 6e 20 ;; gen 0cd0: 74 68 72 65 61 64 73 20 74 68 72 6f 75 67 68 20 threads through 0ce0: 69 74 27 73 20 6f 77 6e 20 73 74 61 74 65 2c 20 it's own state, 0cf0: 69 67 6e 6f 72 65 20 72 65 73 75 6c 74 0a 20 20 ignore result. 0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 65 (ge 0d10: 6e 20 28 66 6d 74 2d 73 65 74 2d 77 72 69 74 65 n (fmt-set-write 0d20: 72 21 20 28 63 6f 70 79 2d 66 6d 74 2d 73 74 61 r! (copy-fmt-sta 0d30: 74 65 20 73 74 29 20 6f 75 74 70 75 74 2a 29 29 te st) output*)) 0d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 0d50: 3b 3b 20 72 65 64 75 63 65 20 23 20 6f 66 20 72 ;; reduce # of r 0d60: 65 6d 61 69 6e 69 6e 67 20 66 69 6e 69 74 65 20 emaining finite 0d70: 63 6f 6c 75 6d 6e 73 0a 20 20 20 20 20 20 20 20 columns. 0d80: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 6d (set! rem 0d90: 61 69 6e 69 6e 67 20 28 2d 20 72 65 6d 61 69 6e aining (- remain 0da0: 69 6e 67 20 31 29 29 0a 20 20 20 20 20 20 20 20 ing 1)). 0db0: 20 20 20 20 20 20 20 3b 3b 20 77 72 69 74 65 20 ;; write 0dc0: 61 6e 79 20 72 65 6d 61 69 6e 69 6e 67 20 61 63 any remaining ac 0dd0: 63 75 6d 75 6c 61 74 65 64 20 6f 75 74 70 75 74 cumulated output 0de0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 0df0: 28 69 66 20 28 70 61 69 72 3f 20 61 63 63 29 0a (if (pair? acc). 0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0e10: 20 20 20 28 6c 65 74 20 28 28 73 20 28 73 74 72 (let ((s (str 0e20: 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2d ing-concatenate- 0e30: 72 65 76 65 72 73 65 20 61 63 63 29 29 29 0a 20 reverse acc))). 0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0e50: 20 20 20 20 28 77 72 69 74 65 2d 63 6f 6c 75 6d (write-colum 0e60: 6e 20 66 6d 74 20 73 20 28 61 6e 64 20 66 69 6e n fmt s (and fin 0e70: 69 74 65 3f 20 28 6e 6f 74 20 28 65 71 75 61 6c ite? (not (equal 0e80: 3f 20 73 20 22 22 29 29 29 29 29 29 0a 20 20 20 ? s "")))))). 0e90: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 ;; ( 0ea0: 6d 61 79 62 65 29 20 6c 6f 6f 70 20 77 69 74 68 maybe) loop with 0eb0: 20 61 6e 20 65 6d 70 74 79 20 63 6f 6c 75 6d 6e an empty column 0ec0: 20 69 6e 20 70 6c 61 63 65 0a 20 20 20 20 20 20 in place. 0ed0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f (if (no 0ee0: 74 20 28 70 6f 73 69 74 69 76 65 3f 20 72 65 6d t (positive? rem 0ef0: 61 69 6e 69 6e 67 29 29 0a 20 20 20 20 20 20 20 aining)). 0f00: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6e (fin 0f10: 69 73 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 ish). 0f20: 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 28 6d (next (m 0f30: 61 6b 65 2d 65 6d 70 74 79 2d 63 6f 6c 20 66 6d ake-empty-col fm 0f40: 74 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 t)))))). 0f50: 20 3b 3b 20 71 75 65 75 65 20 75 70 20 74 68 65 ;; queue up the 0f60: 20 69 6e 69 74 69 61 6c 20 66 6f 72 6d 61 74 74 initial formatt 0f70: 65 72 73 0a 20 20 20 20 20 20 20 20 20 28 66 6f ers. (fo 0f80: 72 2d 65 61 63 68 0a 20 20 20 20 20 20 20 20 20 r-each. 0f90: 20 28 6c 61 6d 62 64 61 20 28 63 6f 6c 29 0a 20 (lambda (col). 0fa0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let 0fb0: 28 28 73 74 20 28 66 6d 74 2d 73 65 74 2d 70 6f ((st (fmt-set-po 0fc0: 72 74 21 20 28 63 6f 70 79 2d 66 6d 74 2d 73 74 rt! (copy-fmt-st 0fd0: 61 74 65 20 6f 72 69 67 2d 73 74 29 0a 20 20 20 ate orig-st). 0fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1000: 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 73 (open-output-s 1010: 74 72 69 6e 67 29 29 29 29 0a 20 20 20 20 20 20 tring)))). 1020: 20 20 20 20 20 20 20 20 28 65 6e 71 21 20 28 6d (enq! (m 1030: 61 6b 65 2d 63 6f 6c 20 73 74 20 28 63 61 72 20 ake-col st (car 1040: 63 6f 6c 29 20 28 64 73 70 20 28 63 61 64 72 20 col) (dsp (cadr 1050: 63 6f 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 col)). 1060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1070: 20 20 20 20 28 6e 6f 74 20 28 69 6e 66 69 6e 69 (not (infini 1080: 74 65 3f 20 63 6f 6c 29 29 29 29 29 29 0a 20 20 te? col)))))). 1090: 20 20 20 20 20 20 20 20 6c 73 29 0a 20 20 20 20 ls). 10a0: 20 20 20 20 20 28 6c 69 6e 65 2d 69 6e 69 74 21 (line-init! 10b0: 29 0a 20 20 20 20 20 20 20 20 20 3b 3b 20 73 74 ). ;; st 10c0: 61 72 74 0a 20 20 20 20 20 20 20 20 20 28 28 64 art. ((d 10d0: 65 71 21 29 20 23 66 29 29 29 29 29 29 0a 0a 28 eq!) #f))))))..( 10e0: 64 65 66 69 6e 65 20 28 63 6f 6c 75 6d 6e 61 72 define (columnar 10f0: 20 2e 20 6c 73 29 0a 20 20 28 64 65 66 69 6e 65 . ls). (define 1100: 20 28 70 72 6f 70 6f 72 74 69 6f 6e 61 6c 2d 77 (proportional-w 1110: 69 64 74 68 3f 20 77 29 0a 20 20 20 20 28 61 6e idth? w). (an 1120: 64 20 28 6e 75 6d 62 65 72 3f 20 77 29 0a 20 20 d (number? w). 1130: 20 20 20 20 20 20 20 28 6f 72 20 28 3c 20 30 20 (or (< 0 1140: 77 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 w 1). 1150: 20 20 28 61 6e 64 20 28 69 6e 65 78 61 63 74 3f (and (inexact? 1160: 20 77 29 20 28 3d 20 77 20 31 2e 30 29 29 29 29 w) (= w 1.0)))) 1170: 29 0a 20 20 28 64 65 66 69 6e 65 20 28 77 68 69 ). (define (whi 1180: 74 65 73 70 61 63 65 2d 70 61 64 3f 20 73 74 29 tespace-pad? st) 1190: 0a 20 20 20 20 28 63 68 61 72 2d 77 68 69 74 65 . (char-white 11a0: 73 70 61 63 65 3f 20 28 6f 72 20 28 66 6d 74 2d space? (or (fmt- 11b0: 70 61 64 2d 63 68 61 72 20 73 74 29 20 23 5c 73 pad-char st) #\s 11c0: 70 61 63 65 29 29 29 0a 20 20 28 64 65 66 69 6e pace))). (defin 11d0: 65 20 28 62 75 69 6c 64 2d 63 6f 6c 75 6d 6e 20 e (build-column 11e0: 6c 73 29 0a 20 20 20 20 28 6c 65 74 2d 6f 70 74 ls). (let-opt 11f0: 69 6f 6e 61 6c 73 2a 20 6c 73 20 28 28 66 69 78 ionals* ls ((fix 1200: 65 64 2d 77 69 64 74 68 20 23 66 29 0a 20 20 20 ed-width #f). 1210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1220: 20 20 20 20 20 28 77 69 64 74 68 20 23 66 29 0a (width #f). 1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1240: 20 20 20 20 20 20 20 20 28 6c 61 73 74 3f 20 23 (last? # 1250: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t). 1260: 20 20 20 20 20 20 20 20 20 20 20 28 74 61 69 6c (tail 1270: 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 '()). 1280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 (g 1290: 65 6e 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 en #f). 12a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 12b0: 70 72 65 66 69 78 20 27 28 29 29 0a 20 20 20 20 prefix '()). 12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 12d0: 20 20 20 20 28 61 6c 69 67 6e 20 27 6c 65 66 74 (align 'left 12e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 12f0: 20 20 20 20 20 20 20 20 20 20 28 69 6e 66 69 6e (infin 1300: 69 74 65 3f 20 23 66 29 29 0a 20 20 20 20 20 20 ite? #f)). 1310: 28 64 65 66 69 6e 65 20 28 73 63 61 6c 65 2d 77 (define (scale-w 1320: 69 64 74 68 20 73 74 29 0a 20 20 20 20 20 20 20 idth st). 1330: 20 28 6d 61 78 20 31 20 28 69 6e 65 78 61 63 74 (max 1 (inexact 1340: 2d 3e 65 78 61 63 74 0a 20 20 20 20 20 20 20 20 ->exact. 1350: 20 20 20 20 20 20 20 20 28 74 72 75 6e 63 61 74 (truncat 1360: 65 20 28 2a 20 77 69 64 74 68 20 28 2d 20 28 66 e (* width (- (f 1370: 6d 74 2d 77 69 64 74 68 20 73 74 29 20 66 69 78 mt-width st) fix 1380: 65 64 2d 77 69 64 74 68 29 29 29 29 29 29 0a 20 ed-width)))))). 1390: 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 70 61 (define (pa 13a0: 64 64 65 72 29 0a 20 20 20 20 20 20 20 20 28 69 dder). (i 13b0: 66 20 28 70 72 6f 70 6f 72 74 69 6f 6e 61 6c 2d f (proportional- 13c0: 77 69 64 74 68 3f 20 77 69 64 74 68 29 0a 20 20 width? width). 13d0: 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 20 (case 13e0: 61 6c 69 67 6e 0a 20 20 20 20 20 20 20 20 20 20 align. 13f0: 20 20 20 20 28 28 72 69 67 68 74 29 0a 20 20 20 ((right). 1400: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam 1410: 62 64 61 20 28 73 74 72 29 20 28 6c 61 6d 62 64 bda (str) (lambd 1420: 61 20 28 73 74 29 20 28 28 70 61 64 2f 6c 65 66 a (st) ((pad/lef 1430: 74 20 28 73 63 61 6c 65 2d 77 69 64 74 68 20 73 t (scale-width s 1440: 74 29 20 73 74 72 29 20 73 74 29 29 29 29 0a 20 t) str) st)))). 1450: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 ((c 1460: 65 6e 74 65 72 29 0a 20 20 20 20 20 20 20 20 20 enter). 1470: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 (lambda (s 1480: 74 72 29 20 28 6c 61 6d 62 64 61 20 28 73 74 29 tr) (lambda (st) 1490: 20 28 28 70 61 64 2f 62 6f 74 68 20 28 73 63 61 ((pad/both (sca 14a0: 6c 65 2d 77 69 64 74 68 20 73 74 29 20 73 74 72 le-width st) str 14b0: 29 20 73 74 29 29 29 29 0a 20 20 20 20 20 20 20 ) st)))). 14c0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else. 14d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam 14e0: 62 64 61 20 28 73 74 72 29 20 28 6c 61 6d 62 64 bda (str) (lambd 14f0: 61 20 28 73 74 29 20 28 28 70 61 64 2f 72 69 67 a (st) ((pad/rig 1500: 68 74 20 28 73 63 61 6c 65 2d 77 69 64 74 68 20 ht (scale-width 1510: 73 74 29 20 73 74 72 29 20 73 74 29 29 29 29 29 st) str) st))))) 1520: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 . (ca 1530: 73 65 20 61 6c 69 67 6e 0a 20 20 20 20 20 20 20 se align. 1540: 20 20 20 20 20 20 20 28 28 72 69 67 68 74 29 20 ((right) 1550: 28 6c 61 6d 62 64 61 20 28 73 74 72 29 20 28 70 (lambda (str) (p 1560: 61 64 2f 6c 65 66 74 20 77 69 64 74 68 20 73 74 ad/left width st 1570: 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 r))). 1580: 20 20 20 28 28 63 65 6e 74 65 72 29 20 28 6c 61 ((center) (la 1590: 6d 62 64 61 20 28 73 74 72 29 20 28 70 61 64 2f mbda (str) (pad/ 15a0: 62 6f 74 68 20 77 69 64 74 68 20 73 74 72 29 29 both width str)) 15b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 15c0: 28 65 6c 73 65 20 28 6c 61 6d 62 64 61 20 28 73 (else (lambda (s 15d0: 74 72 29 20 28 70 61 64 2f 72 69 67 68 74 20 77 tr) (pad/right w 15e0: 69 64 74 68 20 73 74 72 29 29 29 29 29 29 0a 20 idth str)))))). 15f0: 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 61 66 (define (af 1600: 66 69 78 20 78 29 0a 20 20 20 20 20 20 20 20 28 fix x). ( 1610: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 28 28 cond. (( 1620: 70 61 69 72 3f 20 74 61 69 6c 29 0a 20 20 20 20 pair? tail). 1630: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 (lambda (s 1640: 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 tr). 1650: 28 63 61 74 20 28 73 74 72 69 6e 67 2d 63 6f 6e (cat (string-con 1660: 63 61 74 65 6e 61 74 65 20 70 72 65 66 69 78 29 catenate prefix) 1670: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 1680: 20 20 28 78 20 73 74 72 29 0a 20 20 20 20 20 20 (x str). 1690: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 (stri 16a0: 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 20 74 ng-concatenate t 16b0: 61 69 6c 29 29 29 29 0a 20 20 20 20 20 20 20 20 ail)))). 16c0: 20 28 28 70 61 69 72 3f 20 70 72 65 66 69 78 29 ((pair? prefix) 16d0: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 . (lamb 16e0: 64 61 20 28 73 74 72 29 20 28 63 61 74 20 28 73 da (str) (cat (s 16f0: 74 72 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 tring-concatenat 1700: 65 20 70 72 65 66 69 78 29 20 28 78 20 73 74 72 e prefix) (x str 1710: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 )))). (e 1720: 6c 73 65 20 78 29 29 29 0a 20 20 20 20 20 20 28 lse x))). ( 1730: 6c 69 73 74 0a 20 20 20 20 20 20 20 3b 3b 20 6c list. ;; l 1740: 69 6e 65 20 66 6f 72 6d 61 74 74 65 72 0a 20 20 ine formatter. 1750: 20 20 20 20 20 28 61 66 66 69 78 0a 20 20 20 20 (affix. 1760: 20 20 20 20 28 6c 65 74 20 28 28 70 61 64 20 28 (let ((pad ( 1770: 70 61 64 64 65 72 29 29 29 0a 20 20 20 20 20 20 padder))). 1780: 20 20 20 20 28 69 66 20 28 61 6e 64 20 6c 61 73 (if (and las 1790: 74 3f 20 28 6e 6f 74 20 28 70 61 69 72 3f 20 74 t? (not (pair? t 17a0: 61 69 6c 29 29 20 28 65 71 3f 20 61 6c 69 67 6e ail)) (eq? align 17b0: 20 27 6c 65 66 74 29 29 0a 20 20 20 20 20 20 20 'left)). 17c0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda ( 17d0: 73 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 str). 17e0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 (lambda (st 17f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 1800: 20 20 20 20 28 28 28 69 66 20 28 77 68 69 74 65 (((if (white 1810: 73 70 61 63 65 2d 70 61 64 3f 20 73 74 29 20 64 space-pad? st) d 1820: 73 70 20 70 61 64 29 20 73 74 72 29 20 73 74 29 sp pad) str) st) 1830: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 1840: 20 70 61 64 29 29 29 0a 20 20 20 20 20 20 20 3b pad))). ; 1850: 3b 20 67 65 6e 65 72 61 74 6f 72 0a 20 20 20 20 ; generator. 1860: 20 20 20 28 69 66 20 28 70 72 6f 70 6f 72 74 69 (if (proporti 1870: 6f 6e 61 6c 2d 77 69 64 74 68 3f 20 77 69 64 74 onal-width? widt 1880: 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c h). (l 1890: 61 6d 62 64 61 20 28 73 74 29 20 28 28 77 69 74 ambda (st) ((wit 18a0: 68 2d 77 69 64 74 68 20 28 73 63 61 6c 65 2d 77 h-width (scale-w 18b0: 69 64 74 68 20 73 74 29 20 67 65 6e 29 20 73 74 idth st) gen) st 18c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 77 )). (w 18d0: 69 74 68 2d 77 69 64 74 68 20 77 69 64 74 68 20 ith-width width 18e0: 67 65 6e 29 29 0a 20 20 20 20 20 20 20 69 6e 66 gen)). inf 18f0: 69 6e 69 74 65 3f 0a 20 20 20 20 20 20 20 29 29 inite?. )) 1900: 29 0a 20 20 28 64 65 66 69 6e 65 20 28 61 64 6a ). (define (adj 1910: 75 73 74 2d 77 69 64 74 68 73 20 6c 73 20 62 6f ust-widths ls bo 1920: 72 64 65 72 2d 77 69 64 74 68 29 0a 20 20 20 20 rder-width). 1930: 28 6c 65 74 2a 20 28 28 66 69 78 65 64 2d 6c 73 (let* ((fixed-ls 1940: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 66 69 . (fi 1950: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x) 1960: 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 28 (and (number? ( 1970: 63 61 72 20 78 29 29 20 28 3e 3d 20 28 63 61 72 car x)) (>= (car 1980: 20 78 29 20 31 29 29 29 20 6c 73 29 29 0a 20 20 x) 1))) ls)). 1990: 20 20 20 20 20 20 20 20 20 28 66 69 78 65 64 2d (fixed- 19a0: 74 6f 74 61 6c 20 28 66 6f 6c 64 20 2b 20 62 6f total (fold + bo 19b0: 72 64 65 72 2d 77 69 64 74 68 20 28 6d 61 70 20 rder-width (map 19c0: 63 61 72 20 66 69 78 65 64 2d 6c 73 29 29 29 0a car fixed-ls))). 19d0: 20 20 20 20 20 20 20 20 20 20 20 28 73 63 61 6c (scal 19e0: 65 64 2d 6c 73 20 28 66 69 6c 74 65 72 20 28 6c ed-ls (filter (l 19f0: 61 6d 62 64 61 20 28 78 29 20 28 70 72 6f 70 6f ambda (x) (propo 1a00: 72 74 69 6f 6e 61 6c 2d 77 69 64 74 68 3f 20 28 rtional-width? ( 1a10: 63 61 72 20 78 29 29 29 20 6c 73 29 29 0a 20 20 car x))) ls)). 1a20: 20 20 20 20 20 20 20 20 20 28 64 65 6e 6f 6d 20 (denom 1a30: 28 2d 20 28 6c 65 6e 67 74 68 20 6c 73 29 20 28 (- (length ls) ( 1a40: 2b 20 28 6c 65 6e 67 74 68 20 66 69 78 65 64 2d + (length fixed- 1a50: 6c 73 29 20 28 6c 65 6e 67 74 68 20 73 63 61 6c ls) (length scal 1a60: 65 64 2d 6c 73 29 29 29 29 0a 20 20 20 20 20 20 ed-ls)))). 1a70: 20 20 20 20 20 28 72 65 73 74 20 28 69 66 20 28 (rest (if ( 1a80: 7a 65 72 6f 3f 20 64 65 6e 6f 6d 29 0a 20 20 20 zero? denom). 1a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1aa0: 20 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 0. 1ab0: 20 20 20 20 20 20 20 20 20 28 65 78 61 63 74 2d (exact- 1ac0: 3e 69 6e 65 78 61 63 74 0a 20 20 20 20 20 20 20 >inexact. 1ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 1ae0: 2f 20 28 2d 20 31 20 28 66 6f 6c 64 20 2b 20 30 / (- 1 (fold + 0 1af0: 20 28 6d 61 70 20 63 61 72 20 73 63 61 6c 65 64 (map car scaled 1b00: 2d 6c 73 29 29 29 20 64 65 6e 6f 6d 29 29 29 29 -ls))) denom)))) 1b10: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 65 67 ). (if (neg 1b20: 61 74 69 76 65 3f 20 72 65 73 74 29 0a 20 20 20 ative? rest). 1b30: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 63 (error 'c 1b40: 6f 6c 75 6d 6e 61 72 20 22 66 72 61 63 74 69 6f olumnar "fractio 1b50: 6e 61 6c 20 77 69 64 74 68 73 20 6d 75 73 74 20 nal widths must 1b60: 73 75 6d 20 74 6f 20 6c 65 73 73 20 74 68 61 6e sum to less than 1b70: 20 31 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 1". 1b80: 20 20 20 20 20 28 6d 61 70 20 63 61 72 20 73 63 (map car sc 1b90: 61 6c 65 64 2d 6c 73 29 29 29 0a 20 20 20 20 20 aled-ls))). 1ba0: 20 28 6d 61 70 0a 20 20 20 20 20 20 20 28 6c 61 (map. (la 1bb0: 6d 62 64 61 20 28 63 6f 6c 29 0a 20 20 20 20 20 mbda (col). 1bc0: 20 20 20 20 28 63 6f 6e 73 20 66 69 78 65 64 2d (cons fixed- 1bd0: 74 6f 74 61 6c 0a 20 20 20 20 20 20 20 20 20 20 total. 1be0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e (if (not (n 1bf0: 75 6d 62 65 72 3f 20 28 63 61 72 20 63 6f 6c 29 umber? (car col) 1c00: 29 29 20 28 63 6f 6e 73 20 72 65 73 74 20 28 63 )) (cons rest (c 1c10: 64 72 20 63 6f 6c 29 29 20 63 6f 6c 29 29 29 0a dr col)) col))). 1c20: 20 20 20 20 20 20 20 6c 73 29 29 29 0a 20 20 28 ls))). ( 1c30: 64 65 66 69 6e 65 20 28 66 69 6e 69 73 68 20 6c define (finish l 1c40: 73 20 62 6f 72 64 65 72 2d 77 69 64 74 68 29 0a s border-width). 1c50: 20 20 20 20 28 61 70 70 6c 79 20 66 6d 74 2d 63 (apply fmt-c 1c60: 6f 6c 75 6d 6e 73 0a 20 20 20 20 20 20 20 20 20 olumns. 1c70: 20 20 28 6d 61 70 20 62 75 69 6c 64 2d 63 6f 6c (map build-col 1c80: 75 6d 6e 20 28 61 64 6a 75 73 74 2d 77 69 64 74 umn (adjust-widt 1c90: 68 73 20 28 72 65 76 65 72 73 65 20 6c 73 29 20 hs (reverse ls) 1ca0: 62 6f 72 64 65 72 2d 77 69 64 74 68 29 29 29 29 border-width)))) 1cb0: 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 20 . (let lp ((ls 1cc0: 6c 73 29 20 28 73 74 72 73 20 27 28 29 29 20 28 ls) (strs '()) ( 1cd0: 61 6c 69 67 6e 20 27 6c 65 66 74 29 20 28 69 6e align 'left) (in 1ce0: 66 69 6e 69 74 65 3f 20 23 66 29 0a 20 20 20 20 finite? #f). 1cf0: 20 20 20 20 20 20 20 28 77 69 64 74 68 20 23 74 (width #t 1d00: 29 20 28 62 6f 72 64 65 72 2d 77 69 64 74 68 20 ) (border-width 1d10: 30 29 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 0) (res '())). 1d20: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 6e (cond. ((n 1d30: 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 28 ull? ls). ( 1d40: 69 66 20 28 70 61 69 72 3f 20 73 74 72 73 29 0a if (pair? strs). 1d50: 20 20 20 20 20 20 20 20 20 20 28 66 69 6e 69 73 (finis 1d60: 68 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 28 63 h (cons (cons (c 1d70: 61 61 72 20 72 65 73 29 0a 20 20 20 20 20 20 20 aar res). 1d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1d90: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 23 74 20 (cons #t 1da0: 28 63 6f 6e 73 20 28 61 70 70 65 6e 64 20 28 72 (cons (append (r 1db0: 65 76 65 72 73 65 20 73 74 72 73 29 0a 20 20 20 everse strs). 1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1df0: 20 20 28 63 61 64 64 61 72 20 72 65 73 29 29 0a (caddar res)). 1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 (cd 1e30: 64 64 61 72 20 72 65 73 29 29 29 29 0a 20 20 20 ddar res)))). 1e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1e50: 20 20 20 20 20 28 63 64 72 20 72 65 73 29 29 0a (cdr res)). 1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1e70: 20 20 62 6f 72 64 65 72 2d 77 69 64 74 68 29 0a border-width). 1e80: 20 20 20 20 20 20 20 20 20 20 28 66 69 6e 69 73 (finis 1e90: 68 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 28 63 h (cons (cons (c 1ea0: 61 61 72 20 72 65 73 29 20 28 63 6f 6e 73 20 23 aar res) (cons # 1eb0: 74 20 28 63 64 64 61 72 20 72 65 73 29 29 29 20 t (cddar res))) 1ec0: 28 63 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 (cdr res)). 1ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 62 6f 72 bor 1ee0: 64 65 72 2d 77 69 64 74 68 29 29 29 0a 20 20 20 der-width))). 1ef0: 20 20 28 28 73 74 72 69 6e 67 3f 20 28 63 61 72 ((string? (car 1f00: 20 6c 73 29 29 0a 20 20 20 20 20 20 28 69 66 20 ls)). (if 1f10: 28 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 28 63 (string-index (c 1f20: 61 72 20 6c 73 29 20 23 5c 6e 65 77 6c 69 6e 65 ar ls) #\newline 1f30: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 72 72 ). (err 1f40: 6f 72 20 27 63 6f 6c 75 6d 6e 61 72 20 22 63 6f or 'columnar "co 1f50: 6c 75 6d 6e 20 73 74 72 69 6e 67 20 6c 69 74 65 lumn string lite 1f60: 72 61 6c 73 20 63 61 6e 27 74 20 63 6f 6e 74 61 rals can't conta 1f70: 69 6e 20 6e 65 77 6c 69 6e 65 73 22 29 0a 20 20 in newlines"). 1f80: 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 (lp (cdr 1f90: 20 6c 73 29 20 28 63 6f 6e 73 20 28 63 61 72 20 ls) (cons (car 1fa0: 6c 73 29 20 73 74 72 73 29 20 61 6c 69 67 6e 20 ls) strs) align 1fb0: 69 6e 66 69 6e 69 74 65 3f 0a 20 20 20 20 20 20 infinite?. 1fc0: 20 20 20 20 20 20 20 20 77 69 64 74 68 20 28 2b width (+ 1fd0: 20 62 6f 72 64 65 72 2d 77 69 64 74 68 20 28 73 border-width (s 1fe0: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 63 61 tring-length (ca 1ff0: 72 20 6c 73 29 29 29 20 72 65 73 29 29 29 0a 20 r ls))) res))). 2000: 20 20 20 20 28 28 6e 75 6d 62 65 72 3f 20 28 63 ((number? (c 2010: 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 28 6c ar ls)). (l 2020: 70 20 28 63 64 72 20 6c 73 29 20 73 74 72 73 20 p (cdr ls) strs 2030: 61 6c 69 67 6e 20 69 6e 66 69 6e 69 74 65 3f 20 align infinite? 2040: 28 63 61 72 20 6c 73 29 20 62 6f 72 64 65 72 2d (car ls) border- 2050: 77 69 64 74 68 20 72 65 73 29 29 0a 20 20 20 20 width res)). 2060: 20 28 28 65 71 3f 20 28 63 61 72 20 6c 73 29 20 ((eq? (car ls) 2070: 27 69 6e 66 69 6e 69 74 65 29 0a 20 20 20 20 20 'infinite). 2080: 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 73 74 (lp (cdr ls) st 2090: 72 73 20 61 6c 69 67 6e 20 23 74 20 77 69 64 74 rs align #t widt 20a0: 68 20 62 6f 72 64 65 72 2d 77 69 64 74 68 20 72 h border-width r 20b0: 65 73 29 29 0a 20 20 20 20 20 28 28 73 79 6d 62 es)). ((symb 20c0: 6f 6c 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 ol? (car ls)). 20d0: 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 (lp (cdr ls) 20e0: 20 73 74 72 73 20 28 63 61 72 20 6c 73 29 20 69 strs (car ls) i 20f0: 6e 66 69 6e 69 74 65 3f 20 77 69 64 74 68 20 62 nfinite? width b 2100: 6f 72 64 65 72 2d 77 69 64 74 68 20 72 65 73 29 order-width res) 2110: 29 0a 20 20 20 20 20 28 28 70 72 6f 63 65 64 75 ). ((procedu 2120: 72 65 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 re? (car ls)). 2130: 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 (lp (cdr ls) 2140: 20 27 28 29 20 27 6c 65 66 74 20 23 66 20 23 74 '() 'left #f #t 2150: 20 62 6f 72 64 65 72 2d 77 69 64 74 68 0a 20 20 border-width. 2160: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 6c (cons (l 2170: 69 73 74 20 77 69 64 74 68 20 23 66 20 27 28 29 ist width #f '() 2180: 20 28 63 61 72 20 6c 73 29 20 28 72 65 76 65 72 (car ls) (rever 2190: 73 65 20 73 74 72 73 29 20 61 6c 69 67 6e 20 69 se strs) align i 21a0: 6e 66 69 6e 69 74 65 3f 29 0a 20 20 20 20 20 20 nfinite?). 21b0: 20 20 20 20 20 20 20 20 20 20 72 65 73 29 29 29 res))) 21c0: 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 . (else. 21d0: 20 20 28 65 72 72 6f 72 20 27 63 6f 6c 75 6d 6e (error 'column 21e0: 61 72 20 22 69 6e 76 61 6c 69 64 20 63 6f 6c 75 ar "invalid colu 21f0: 6d 6e 22 20 28 63 61 72 20 6c 73 29 29 29 29 29 mn" (car ls))))) 2200: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 78 2d )..(define (max- 2210: 6c 69 6e 65 2d 77 69 64 74 68 20 73 74 72 69 6e line-width strin 2220: 67 2d 77 69 64 74 68 20 73 74 72 29 0a 20 20 28 g-width str). ( 2230: 6c 65 74 20 6c 70 20 28 28 69 20 30 29 20 28 68 let lp ((i 0) (h 2240: 69 20 30 29 29 0a 20 20 20 20 28 6c 65 74 20 28 i 0)). (let ( 2250: 28 6a 20 28 73 74 72 69 6e 67 2d 69 6e 64 65 78 (j (string-index 2260: 20 73 74 72 20 23 5c 6e 65 77 6c 69 6e 65 20 69 str #\newline i 2270: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 6a 0a ))). (if j. 2280: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+ 2290: 20 6a 20 31 29 20 28 6d 61 78 20 68 69 20 28 73 j 1) (max hi (s 22a0: 74 72 69 6e 67 2d 77 69 64 74 68 20 28 73 75 62 tring-width (sub 22b0: 73 74 72 69 6e 67 20 73 74 72 20 69 20 6a 29 29 string str i j)) 22c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6d 61 )). (ma 22d0: 78 20 68 69 20 28 73 74 72 69 6e 67 2d 77 69 64 x hi (string-wid 22e0: 74 68 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 th (substring st 22f0: 72 20 69 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 r i (string-leng 2300: 74 68 20 73 74 72 29 29 29 29 29 29 29 29 0a 0a th str)))))))).. 2310: 28 64 65 66 69 6e 65 20 28 70 61 64 2d 66 69 6e (define (pad-fin 2320: 69 74 65 20 73 74 20 70 72 6f 63 20 77 69 64 74 ite st proc widt 2330: 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 72 h). (let* ((str 2340: 20 28 28 66 6d 74 2d 74 6f 2d 73 74 72 69 6e 67 ((fmt-to-string 2350: 20 70 72 6f 63 29 20 28 63 6f 70 79 2d 66 6d 74 proc) (copy-fmt 2360: 2d 73 74 61 74 65 20 73 74 29 29 29 0a 20 20 20 -state st))). 2370: 20 20 20 20 20 20 28 77 20 28 6d 61 78 2d 6c 69 (w (max-li 2380: 6e 65 2d 77 69 64 74 68 20 28 6f 72 20 28 66 6d ne-width (or (fm 2390: 74 2d 73 74 72 69 6e 67 2d 77 69 64 74 68 20 73 t-string-width s 23a0: 74 29 20 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 t) string-length 23b0: 29 20 73 74 72 29 29 29 0a 20 20 20 20 28 6c 69 ) str))). (li 23c0: 73 74 20 28 63 61 74 20 73 74 72 29 0a 20 20 20 st (cat str). 23d0: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and 23e0: 28 69 6e 74 65 67 65 72 3f 20 77 69 64 74 68 29 (integer? width) 23f0: 20 28 65 78 61 63 74 3f 20 77 69 64 74 68 29 29 (exact? width)) 2400: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . ( 2410: 6d 61 78 20 77 69 64 74 68 20 77 29 0a 20 20 20 max width w). 2420: 20 20 20 20 20 20 20 20 20 20 20 77 29 29 29 29 w)))) 2430: 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 62 75 6c ..(define (tabul 2440: 61 72 20 2e 20 6c 73 29 0a 20 20 28 6c 61 6d 62 ar . ls). (lamb 2450: 64 61 20 28 73 74 29 0a 20 20 20 20 28 6c 65 74 da (st). (let 2460: 20 6c 70 20 28 28 6c 73 20 6c 73 29 20 28 69 6e lp ((ls ls) (in 2470: 66 69 6e 69 74 65 3f 20 23 66 29 20 28 77 69 64 finite? #f) (wid 2480: 74 68 20 23 74 29 20 28 72 65 73 20 27 28 29 29 th #t) (res '()) 2490: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond. 24a0: 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 ((null? ls) 24b0: 0a 20 20 20 20 20 20 20 20 28 28 61 70 70 6c 79 . ((apply 24c0: 20 63 6f 6c 75 6d 6e 61 72 20 28 72 65 76 65 72 columnar (rever 24d0: 73 65 20 72 65 73 29 29 20 73 74 29 29 0a 20 20 se res)) st)). 24e0: 20 20 20 20 20 28 28 6e 75 6d 62 65 72 3f 20 28 ((number? ( 24f0: 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 car ls)). 2500: 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 69 6e (lp (cdr ls) in 2510: 66 69 6e 69 74 65 3f 20 28 63 61 72 20 6c 73 29 finite? (car ls) 2520: 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 28 28 res)). (( 2530: 65 71 3f 20 27 69 6e 66 69 6e 69 74 65 20 28 63 eq? 'infinite (c 2540: 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 ar ls)). 2550: 28 6c 70 20 28 63 64 72 20 6c 73 29 20 23 74 20 (lp (cdr ls) #t 2560: 77 69 64 74 68 20 28 63 6f 6e 73 20 28 63 61 72 width (cons (car 2570: 20 6c 73 29 20 72 65 73 29 29 29 0a 20 20 20 20 ls) res))). 2580: 20 20 20 28 28 70 72 6f 63 65 64 75 72 65 3f 20 ((procedure? 2590: 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 (car ls)). 25a0: 20 20 28 69 66 20 69 6e 66 69 6e 69 74 65 3f 0a (if infinite?. 25b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if 25c0: 77 69 64 74 68 0a 20 20 20 20 20 20 20 20 20 20 width. 25d0: 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c (lp (cdr l 25e0: 73 29 20 23 66 20 23 74 20 28 63 6f 6e 73 20 28 s) #f #t (cons ( 25f0: 63 61 72 20 6c 73 29 20 28 63 6f 6e 73 20 77 69 car ls) (cons wi 2600: 64 74 68 20 72 65 73 29 29 29 0a 20 20 20 20 20 dth res))). 2610: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp ( 2620: 63 64 72 20 6c 73 29 20 23 66 20 23 74 20 28 63 cdr ls) #f #t (c 2630: 6f 6e 73 20 28 63 61 72 20 6c 73 29 20 72 65 73 ons (car ls) res 2640: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 2650: 28 6c 65 74 20 28 28 67 65 6e 2b 77 69 64 74 68 (let ((gen+width 2660: 20 28 70 61 64 2d 66 69 6e 69 74 65 20 73 74 20 (pad-finite st 2670: 28 63 61 72 20 6c 73 29 20 77 69 64 74 68 29 29 (car ls) width)) 2680: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 2690: 28 6c 70 20 28 63 64 72 20 6c 73 29 20 23 66 20 (lp (cdr ls) #f 26a0: 23 74 20 28 61 70 70 65 6e 64 20 67 65 6e 2b 77 #t (append gen+w 26b0: 69 64 74 68 20 72 65 73 29 29 29 29 29 0a 20 20 idth res))))). 26c0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else. 26d0: 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 (lp (cdr ls) 26e0: 69 6e 66 69 6e 69 74 65 3f 20 77 69 64 74 68 20 infinite? width 26f0: 28 63 6f 6e 73 20 28 63 61 72 20 6c 73 29 20 72 (cons (car ls) r 2700: 65 73 29 29 29 29 29 29 29 0a 0a 3b 3b 20 62 72 es)))))))..;; br 2710: 65 61 6b 20 6c 69 6e 65 73 20 6f 6e 6c 79 2c 20 eak lines only, 2720: 64 6f 6e 27 74 20 66 6d 74 2d 6a 6f 69 6e 20 73 don't fmt-join s 2730: 68 6f 72 74 20 6c 69 6e 65 73 20 6f 72 20 6a 75 hort lines or ju 2740: 73 74 69 66 79 0a 28 64 65 66 69 6e 65 20 28 66 stify.(define (f 2750: 6f 6c 64 2d 6c 69 6e 65 73 20 2e 20 6c 73 29 0a old-lines . ls). 2760: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 0a 20 (lambda (st). 2770: 20 20 20 28 64 65 66 69 6e 65 20 6f 75 74 70 75 (define outpu 2780: 74 20 28 66 6d 74 2d 77 72 69 74 65 72 20 73 74 t (fmt-writer st 2790: 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 )). (define ( 27a0: 6b 6f 6e 73 2d 69 6e 2d 6c 69 6e 65 20 73 74 72 kons-in-line str 27b0: 20 73 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 st). (let 27c0: 28 28 6c 65 6e 20 28 28 6f 72 20 28 66 6d 74 2d ((len ((or (fmt- 27d0: 73 74 72 69 6e 67 2d 77 69 64 74 68 20 73 74 29 string-width st) 27e0: 20 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 29 20 string-length) 27f0: 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 str)). 2800: 20 20 28 73 70 61 63 65 20 28 2d 20 28 66 6d 74 (space (- (fmt 2810: 2d 77 69 64 74 68 20 73 74 29 20 28 66 6d 74 2d -width st) (fmt- 2820: 63 6f 6c 20 73 74 29 29 29 29 0a 20 20 20 20 20 col st)))). 2830: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond. 2840: 20 20 20 28 28 6f 72 20 28 3c 3d 20 6c 65 6e 20 ((or (<= len 2850: 73 70 61 63 65 29 20 28 6e 6f 74 20 28 70 6f 73 space) (not (pos 2860: 69 74 69 76 65 3f 20 73 70 61 63 65 29 29 29 0a itive? space))). 2870: 20 20 20 20 20 20 20 20 20 20 20 28 6f 75 74 70 (outp 2880: 75 74 20 73 74 72 20 73 74 29 29 0a 20 20 20 20 ut str st)). 2890: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else. 28a0: 20 20 20 20 20 20 20 28 6b 6f 6e 73 2d 69 6e 2d (kons-in- 28b0: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 line. 28c0: 20 28 73 75 62 73 74 72 69 6e 67 2f 73 68 61 72 (substring/shar 28d0: 65 64 20 73 74 72 20 73 70 61 63 65 20 6c 65 6e ed str space len 28e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6f ). (o 28f0: 75 74 70 75 74 20 6e 6c 2d 73 74 72 0a 20 20 20 utput nl-str. 2900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2910: 20 28 6f 75 74 70 75 74 20 28 73 75 62 73 74 72 (output (substr 2920: 69 6e 67 2f 73 68 61 72 65 64 20 73 74 72 20 30 ing/shared str 0 2930: 20 73 70 61 63 65 29 20 73 74 29 29 29 29 29 29 space) st)))))) 2940: 29 0a 20 20 20 20 28 28 66 6d 74 2d 6c 65 74 0a ). ((fmt-let. 2950: 20 20 20 20 20 20 27 77 72 69 74 65 72 0a 20 20 'writer. 2960: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 72 (lambda (str 2970: 20 73 74 29 0a 20 20 20 20 20 20 20 20 28 6c 65 st). (le 2980: 74 20 6c 70 20 28 28 73 74 72 20 73 74 72 29 20 t lp ((str str) 2990: 28 73 74 20 73 74 29 29 0a 20 20 20 20 20 20 20 (st st)). 29a0: 20 20 20 28 6c 65 74 20 28 28 6e 6c 69 20 28 73 (let ((nli (s 29b0: 74 72 69 6e 67 2d 69 6e 64 65 78 20 73 74 72 20 tring-index str 29c0: 23 5c 6e 65 77 6c 69 6e 65 29 29 29 0a 20 20 20 #\newline))). 29d0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond. 29e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e ((n 29f0: 6f 74 20 6e 6c 69 29 0a 20 20 20 20 20 20 20 20 ot nli). 2a00: 20 20 20 20 20 20 20 28 6b 6f 6e 73 2d 69 6e 2d (kons-in- 2a10: 6c 69 6e 65 20 73 74 72 20 73 74 29 29 0a 20 20 line str st)). 2a20: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els 2a30: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e. 2a40: 20 28 6c 70 20 28 73 75 62 73 74 72 69 6e 67 2f (lp (substring/ 2a50: 73 68 61 72 65 64 20 73 74 72 20 28 2b 20 6e 6c shared str (+ nl 2a60: 69 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 i 1)). 2a70: 20 20 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 (output 2a80: 20 6e 6c 2d 73 74 72 0a 20 20 20 20 20 20 20 20 nl-str. 2a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2aa0: 20 20 20 28 6b 6f 6e 73 2d 69 6e 2d 6c 69 6e 65 (kons-in-line 2ab0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 (su 2ad0: 62 73 74 72 69 6e 67 2f 73 68 61 72 65 64 20 73 bstring/shared s 2ae0: 74 72 20 30 20 6e 6c 69 29 0a 20 20 20 20 20 20 tr 0 nli). 2af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2b00: 20 20 20 20 20 20 73 74 29 29 29 29 29 29 29 29 st)))))))) 2b10: 0a 20 20 20 20 20 20 28 61 70 70 6c 79 2d 63 61 . (apply-ca 2b20: 74 20 6c 73 29 29 0a 20 20 20 20 20 73 74 29 29 t ls)). st)) 2b30: 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 72 61 70 )..(define (wrap 2b40: 2d 66 6f 6c 64 2d 77 6f 72 64 73 20 73 65 71 20 -fold-words seq 2b50: 6b 6e 69 6c 20 6d 61 78 2d 77 69 64 74 68 20 67 knil max-width g 2b60: 65 74 2d 77 69 64 74 68 20 6c 69 6e 65 20 2e 20 et-width line . 2b70: 6f 29 0a 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 o). (let* ((las 2b80: 74 2d 6c 69 6e 65 20 28 69 66 20 28 70 61 69 72 t-line (if (pair 2b90: 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 6c 69 6e ? o) (car o) lin 2ba0: 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 76 65 e)). (ve 2bb0: 63 20 28 69 66 20 28 6c 69 73 74 3f 20 73 65 71 c (if (list? seq 2bc0: 29 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 ) (list->vector 2bd0: 73 65 71 29 20 73 65 71 29 29 0a 20 20 20 20 20 seq) seq)). 2be0: 20 20 20 20 28 6c 65 6e 20 28 76 65 63 74 6f 72 (len (vector 2bf0: 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 0a 20 20 -length vec)). 2c00: 20 20 20 20 20 20 20 28 6c 65 6e 2d 31 20 28 2d (len-1 (- 2c10: 20 6c 65 6e 20 31 29 29 0a 20 20 20 20 20 20 20 len 1)). 2c20: 20 20 28 62 72 65 61 6b 73 20 28 6d 61 6b 65 2d (breaks (make- 2c30: 76 65 63 74 6f 72 20 6c 65 6e 20 23 66 29 29 0a vector len #f)). 2c40: 20 20 20 20 20 20 20 20 20 28 70 65 6e 61 6c 74 (penalt 2c50: 69 65 73 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ies (make-vector 2c60: 20 6c 65 6e 20 23 66 29 29 0a 20 20 20 20 20 20 len #f)). 2c70: 20 20 20 28 77 69 64 74 68 73 0a 20 20 20 20 20 (widths. 2c80: 20 20 20 20 20 28 6c 69 73 74 2d 3e 76 65 63 74 (list->vect 2c90: 6f 72 0a 20 20 20 20 20 20 20 20 20 20 20 28 6d or. (m 2ca0: 61 70 20 67 65 74 2d 77 69 64 74 68 20 28 69 66 ap get-width (if 2cb0: 20 28 6c 69 73 74 3f 20 73 65 71 29 20 73 65 71 (list? seq) seq 2cc0: 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 (vector->list v 2cd0: 65 63 29 29 29 29 29 29 0a 20 20 20 20 28 64 65 ec)))))). (de 2ce0: 66 69 6e 65 20 28 6c 61 72 67 65 73 74 2d 66 69 fine (largest-fi 2cf0: 74 20 69 29 0a 20 20 20 20 20 20 28 6c 65 74 20 t i). (let 2d00: 6c 70 20 28 28 6a 20 28 2b 20 69 20 31 29 29 20 lp ((j (+ i 1)) 2d10: 28 77 69 64 74 68 20 28 76 65 63 74 6f 72 2d 72 (width (vector-r 2d20: 65 66 20 77 69 64 74 68 73 20 69 29 29 29 0a 20 ef widths i))). 2d30: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 77 69 (let ((wi 2d40: 64 74 68 20 28 2b 20 77 69 64 74 68 20 31 20 28 dth (+ width 1 ( 2d50: 76 65 63 74 6f 72 2d 72 65 66 20 77 69 64 74 68 vector-ref width 2d60: 73 20 6a 29 29 29 29 0a 20 20 20 20 20 20 20 20 s j)))). 2d70: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond. 2d80: 20 20 20 20 28 28 3e 3d 20 77 69 64 74 68 20 6d ((>= width m 2d90: 61 78 2d 77 69 64 74 68 29 20 28 2d 20 6a 20 31 ax-width) (- j 1 2da0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). ( 2db0: 28 3e 3d 20 6a 20 6c 65 6e 2d 31 29 20 6c 65 6e (>= j len-1) len 2dc0: 2d 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 -1). 2dd0: 28 65 6c 73 65 20 28 6c 70 20 28 2b 20 6a 20 31 (else (lp (+ j 1 2de0: 29 20 77 69 64 74 68 29 29 29 29 29 29 0a 20 20 ) width)))))). 2df0: 20 20 28 64 65 66 69 6e 65 20 28 6d 69 6e 2d 70 (define (min-p 2e00: 65 6e 61 6c 74 79 21 20 69 29 0a 20 20 20 20 20 enalty! i). 2e10: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 28 (cond. ( 2e20: 28 3e 3d 20 69 20 6c 65 6e 2d 31 29 20 30 29 0a (>= i len-1) 0). 2e30: 20 20 20 20 20 20 20 20 28 28 76 65 63 74 6f 72 ((vector 2e40: 2d 72 65 66 20 70 65 6e 61 6c 74 69 65 73 20 69 -ref penalties i 2e50: 29 29 0a 20 20 20 20 20 20 20 20 28 65 6c 73 65 )). (else 2e60: 0a 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f . (vecto 2e70: 72 2d 73 65 74 21 20 70 65 6e 61 6c 74 69 65 73 r-set! penalties 2e80: 20 69 20 28 65 78 70 74 20 28 2b 20 6d 61 78 2d i (expt (+ max- 2e90: 77 69 64 74 68 20 31 29 20 33 29 29 0a 20 20 20 width 1) 3)). 2ea0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se 2eb0: 74 21 20 62 72 65 61 6b 73 20 69 20 69 29 0a 20 t! breaks i i). 2ec0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6b (let ((k 2ed0: 20 28 6c 61 72 67 65 73 74 2d 66 69 74 20 69 29 (largest-fit i) 2ee0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c )). (l 2ef0: 65 74 20 6c 70 20 28 28 6a 20 69 29 20 28 77 69 et lp ((j i) (wi 2f00: 64 74 68 20 30 29 29 0a 20 20 20 20 20 20 20 20 dth 0)). 2f10: 20 20 20 20 20 28 69 66 20 28 3c 3d 20 6a 20 6b (if (<= j k 2f20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 2f30: 20 20 20 28 6c 65 74 2a 20 28 28 77 69 64 74 68 (let* ((width 2f40: 20 28 2b 20 77 69 64 74 68 20 28 76 65 63 74 6f (+ width (vecto 2f50: 72 2d 72 65 66 20 77 69 64 74 68 73 20 6a 29 29 r-ref widths j)) 2f60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 2f70: 20 20 20 20 20 20 20 20 20 20 28 62 72 65 61 6b (break 2f80: 2d 70 65 6e 61 6c 74 79 0a 20 20 20 20 20 20 20 -penalty. 2f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2fa0: 20 20 28 2b 20 28 6d 61 78 20 30 20 28 65 78 70 (+ (max 0 (exp 2fb0: 74 20 28 2d 20 6d 61 78 2d 77 69 64 74 68 20 28 t (- max-width ( 2fc0: 2b 20 77 69 64 74 68 20 28 2d 20 6a 20 69 29 29 + width (- j i)) 2fd0: 29 20 33 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) 3)). 2fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2ff0: 20 20 28 6d 69 6e 2d 70 65 6e 61 6c 74 79 21 20 (min-penalty! 3000: 28 2b 20 6a 20 31 29 29 29 29 29 0a 20 20 20 20 (+ j 1))))). 3010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 3020: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond. 3030: 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 62 72 ((< br 3040: 65 61 6b 2d 70 65 6e 61 6c 74 79 20 28 76 65 63 eak-penalty (vec 3050: 74 6f 72 2d 72 65 66 20 70 65 6e 61 6c 74 69 65 tor-ref penaltie 3060: 73 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 s i)). 3070: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec 3080: 74 6f 72 2d 73 65 74 21 20 62 72 65 61 6b 73 20 tor-set! breaks 3090: 69 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 i j). 30a0: 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect 30b0: 6f 72 2d 73 65 74 21 20 70 65 6e 61 6c 74 69 65 or-set! penaltie 30c0: 73 20 69 20 62 72 65 61 6b 2d 70 65 6e 61 6c 74 s i break-penalt 30d0: 79 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 y))). 30e0: 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 6a (lp (+ j 30f0: 20 31 29 20 77 69 64 74 68 29 29 29 29 29 0a 20 1) width))))). 3100: 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 (if (>= 3110: 28 76 65 63 74 6f 72 2d 72 65 66 20 62 72 65 61 (vector-ref brea 3120: 6b 73 20 69 29 20 6c 65 6e 2d 31 29 0a 20 20 20 ks i) len-1). 3130: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto 3140: 72 2d 73 65 74 21 20 70 65 6e 61 6c 74 69 65 73 r-set! penalties 3150: 20 69 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 i 0)). 3160: 28 76 65 63 74 6f 72 2d 72 65 66 20 70 65 6e 61 (vector-ref pena 3170: 6c 74 69 65 73 20 69 29 29 29 29 0a 20 20 20 20 lties i)))). 3180: 28 64 65 66 69 6e 65 20 28 73 75 62 2d 6c 69 73 (define (sub-lis 3190: 74 20 69 20 6a 29 0a 20 20 20 20 20 20 28 6c 65 t i j). (le 31a0: 74 20 6c 70 20 28 28 69 20 69 29 20 28 72 65 73 t lp ((i i) (res 31b0: 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 28 '())). ( 31c0: 69 66 20 28 3e 20 69 20 6a 29 0a 20 20 20 20 20 if (> i j). 31d0: 20 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 (reverse 31e0: 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 res). 31f0: 20 28 6c 70 20 28 2b 20 69 20 31 29 20 28 63 6f (lp (+ i 1) (co 3200: 6e 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 ns (vector-ref v 3210: 65 63 20 69 29 20 72 65 73 29 29 29 29 29 0a 20 ec i) res))))). 3220: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. (( 3230: 7a 65 72 6f 3f 20 6c 65 6e 29 0a 20 20 20 20 20 zero? len). 3240: 20 3b 3b 20 64 65 67 65 6e 65 72 61 74 65 20 63 ;; degenerate c 3250: 61 73 65 0a 20 20 20 20 20 20 28 6c 61 73 74 2d ase. (last- 3260: 6c 69 6e 65 20 27 28 29 20 6b 6e 69 6c 29 29 0a line '() knil)). 3270: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else. 3280: 20 3b 3b 20 63 6f 6d 70 75 74 65 20 6f 70 74 69 ;; compute opti 3290: 6d 75 6d 20 62 72 65 61 6b 73 0a 20 20 20 20 20 mum breaks. 32a0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 72 (vector-set! br 32b0: 65 61 6b 73 20 6c 65 6e 2d 31 20 6c 65 6e 2d 31 eaks len-1 len-1 32c0: 29 0a 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d ). (vector- 32d0: 73 65 74 21 20 70 65 6e 61 6c 74 69 65 73 20 6c set! penalties l 32e0: 65 6e 2d 31 20 30 29 0a 20 20 20 20 20 20 28 6d en-1 0). (m 32f0: 69 6e 2d 70 65 6e 61 6c 74 79 21 20 30 29 0a 20 in-penalty! 0). 3300: 20 20 20 20 20 3b 3b 20 66 6f 6c 64 0a 20 20 20 ;; fold. 3310: 20 20 20 28 6c 65 74 20 6c 70 20 28 28 69 20 30 (let lp ((i 0 3320: 29 20 28 61 63 63 20 6b 6e 69 6c 29 29 0a 20 20 ) (acc knil)). 3330: 20 20 20 20 20 20 28 6c 65 74 20 28 28 62 72 65 (let ((bre 3340: 61 6b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 ak (vector-ref b 3350: 72 65 61 6b 73 20 69 29 29 29 0a 20 20 20 20 20 reaks i))). 3360: 20 20 20 20 20 28 69 66 20 28 3e 3d 20 62 72 65 (if (>= bre 3370: 61 6b 20 6c 65 6e 2d 31 29 0a 20 20 20 20 20 20 ak len-1). 3380: 20 20 20 20 20 20 20 20 28 6c 61 73 74 2d 6c 69 (last-li 3390: 6e 65 20 28 73 75 62 2d 6c 69 73 74 20 69 20 6c ne (sub-list i l 33a0: 65 6e 2d 31 29 20 61 63 63 29 0a 20 20 20 20 20 en-1) acc). 33b0: 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 (lp (+ 33c0: 62 72 65 61 6b 20 31 29 20 28 6c 69 6e 65 20 28 break 1) (line ( 33d0: 73 75 62 2d 6c 69 73 74 20 69 20 62 72 65 61 6b sub-list i break 33e0: 29 20 61 63 63 29 29 29 29 29 29 29 29 29 0a 0a ) acc))))))))).. 33f0: 3b 3b 20 58 58 58 58 20 64 6f 6e 27 74 20 73 70 ;; XXXX don't sp 3400: 6c 69 74 2c 20 74 72 61 76 65 72 73 65 20 74 68 lit, traverse th 3410: 65 20 73 74 72 69 6e 67 20 6d 61 6e 75 61 6c 6c e string manuall 3420: 79 20 61 6e 64 20 6b 65 65 70 20 74 72 61 63 6b y and keep track 3430: 20 6f 66 0a 3b 3b 20 73 65 6e 74 65 6e 63 65 20 of.;; sentence 3440: 65 6e 64 69 6e 67 73 20 73 6f 20 77 65 20 63 61 endings so we ca 3450: 6e 20 69 6e 73 65 72 74 20 74 77 6f 20 73 70 61 n insert two spa 3460: 63 65 73 0a 28 64 65 66 69 6e 65 20 28 77 72 61 ces.(define (wra 3470: 70 2d 66 6f 6c 64 20 73 74 72 20 2e 20 6f 29 0a p-fold str . o). 3480: 20 20 28 61 70 70 6c 79 20 77 72 61 70 2d 66 6f (apply wrap-fo 3490: 6c 64 2d 77 6f 72 64 73 20 28 73 74 72 69 6e 67 ld-words (string 34a0: 2d 74 6f 6b 65 6e 69 7a 65 20 73 74 72 29 20 6f -tokenize str) o 34b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 72 61 ))..(define (wra 34c0: 70 2d 6c 69 6e 65 73 20 2e 20 6c 73 29 0a 20 20 p-lines . ls). 34d0: 28 64 65 66 69 6e 65 20 28 70 72 69 6e 74 2d 6c (define (print-l 34e0: 69 6e 65 20 6c 73 20 73 74 29 0a 20 20 20 20 28 ine ls st). ( 34f0: 6e 6c 20 28 28 66 6d 74 2d 6a 6f 69 6e 20 64 73 nl ((fmt-join ds 3500: 70 20 6c 73 20 22 20 22 29 20 73 74 29 29 29 0a p ls " ") st))). 3510: 20 20 28 64 65 66 69 6e 65 20 62 75 66 66 65 72 (define buffer 3520: 20 27 28 29 29 0a 20 20 28 6c 61 6d 62 64 61 20 '()). (lambda 3530: 28 73 74 29 0a 20 20 20 20 28 28 66 6d 74 2d 6c (st). ((fmt-l 3540: 65 74 0a 20 20 20 20 20 20 27 77 72 69 74 65 72 et. 'writer 3550: 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda ( 3560: 73 74 72 20 73 74 29 20 28 73 65 74 21 20 62 75 str st) (set! bu 3570: 66 66 65 72 20 28 63 6f 6e 73 20 73 74 72 20 62 ffer (cons str b 3580: 75 66 66 65 72 29 29 20 73 74 29 0a 20 20 20 20 uffer)) st). 3590: 20 20 28 61 70 70 6c 79 2d 63 61 74 20 6c 73 29 (apply-cat ls) 35a0: 29 0a 20 20 20 20 20 73 74 29 0a 20 20 20 20 28 ). st). ( 35b0: 77 72 61 70 2d 66 6f 6c 64 20 28 73 74 72 69 6e wrap-fold (strin 35c0: 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2d 72 65 g-concatenate-re 35d0: 76 65 72 73 65 20 62 75 66 66 65 72 29 0a 20 20 verse buffer). 35e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 20 st 35f0: 28 66 6d 74 2d 77 69 64 74 68 20 73 74 29 0a 20 (fmt-width st). 3600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o 3610: 72 20 28 66 6d 74 2d 73 74 72 69 6e 67 2d 77 69 r (fmt-string-wi 3620: 64 74 68 20 73 74 29 20 73 74 72 69 6e 67 2d 6c dth st) string-l 3630: 65 6e 67 74 68 29 0a 20 20 20 20 20 20 20 20 20 ength). 3640: 20 20 20 20 20 20 70 72 69 6e 74 2d 6c 69 6e 65 print-line 3650: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6a 75 )))..(define (ju 3660: 73 74 69 66 79 20 2e 20 6c 73 29 0a 20 20 28 6c stify . ls). (l 3670: 61 6d 62 64 61 20 28 73 74 29 0a 20 20 20 20 28 ambda (st). ( 3680: 6c 65 74 20 28 28 77 69 64 74 68 20 28 66 6d 74 let ((width (fmt 3690: 2d 77 69 64 74 68 20 73 74 29 29 0a 20 20 20 20 -width st)). 36a0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 77 69 (string-wi 36b0: 64 74 68 20 28 6f 72 20 28 66 6d 74 2d 73 74 72 dth (or (fmt-str 36c0: 69 6e 67 2d 77 69 64 74 68 20 73 74 29 20 73 74 ing-width st) st 36d0: 72 69 6e 67 2d 6c 65 6e 67 74 68 29 29 0a 20 20 ring-length)). 36e0: 20 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 20 (output 36f0: 28 66 6d 74 2d 77 72 69 74 65 72 20 73 74 29 29 (fmt-writer st)) 3700: 0a 20 20 20 20 20 20 20 20 20 20 28 62 75 66 66 . (buff 3710: 65 72 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 er '())). ( 3720: 64 65 66 69 6e 65 20 28 6a 75 73 74 69 66 79 2d define (justify- 3730: 6c 69 6e 65 20 6c 73 20 73 74 29 0a 20 20 20 20 line ls st). 3740: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c (if (null? l 3750: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 s). ( 3760: 6e 6c 20 73 74 29 0a 20 20 20 20 20 20 20 20 20 nl st). 3770: 20 20 20 28 6c 65 74 2a 20 28 28 73 75 6d 20 28 (let* ((sum ( 3780: 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 73 20 fold (lambda (s 3790: 6e 29 20 28 2b 20 6e 20 28 73 74 72 69 6e 67 2d n) (+ n (string- 37a0: 77 69 64 74 68 20 73 29 29 29 20 30 20 6c 73 29 width s))) 0 ls) 37b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 37c0: 20 20 20 20 20 28 6c 65 6e 20 28 6c 65 6e 67 74 (len (lengt 37d0: 68 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 h ls)). 37e0: 20 20 20 20 20 20 20 20 20 20 28 64 69 66 66 20 (diff 37f0: 28 6d 61 78 20 30 20 28 2d 20 77 69 64 74 68 20 (max 0 (- width 3800: 73 75 6d 29 29 29 0a 20 20 20 20 20 20 20 20 20 sum))). 3810: 20 20 20 20 20 20 20 20 20 20 28 73 65 70 20 28 (sep ( 3820: 6d 61 6b 65 2d 73 74 72 69 6e 67 20 28 69 66 20 make-string (if 3830: 28 3d 20 6c 65 6e 20 31 29 0a 20 20 20 20 20 20 (= len 1). 3840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3860: 20 20 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 0. 3870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 71 (q 3890: 75 6f 74 69 65 6e 74 20 64 69 66 66 20 28 2d 20 uotient diff (- 38a0: 6c 65 6e 20 31 29 29 29 0a 20 20 20 20 20 20 20 len 1))). 38b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 5c #\ 38d0: 73 70 61 63 65 29 29 0a 20 20 20 20 20 20 20 20 space)). 38e0: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 6d 20 (rem 38f0: 28 69 66 20 28 3d 20 6c 65 6e 20 31 29 0a 20 20 (if (= len 1). 3900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3910: 20 20 20 20 20 20 20 20 20 20 64 69 66 66 0a 20 diff. 3920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3930: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 6d 61 (rema 3940: 69 6e 64 65 72 20 64 69 66 66 20 28 2d 20 6c 65 inder diff (- le 3950: 6e 20 31 29 29 29 29 29 0a 20 20 20 20 20 20 20 n 1))))). 3960: 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 0a 20 (output. 3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c 3980: 61 6c 6c 2d 77 69 74 68 2d 6f 75 74 70 75 74 2d all-with-output- 3990: 73 74 72 69 6e 67 0a 20 20 20 20 20 20 20 20 20 string. 39a0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda 39b0: 28 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 (p). 39c0: 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 (display 39d0: 28 63 61 72 20 6c 73 29 20 70 29 0a 20 20 20 20 (car ls) p). 39e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 39f0: 6c 65 74 20 6c 70 20 28 28 6c 73 20 28 63 64 72 let lp ((ls (cdr 3a00: 20 6c 73 29 29 20 28 69 20 31 29 29 0a 20 20 20 ls)) (i 1)). 3a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a20: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond. 3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 3a40: 28 70 61 69 72 3f 20 6c 73 29 0a 20 20 20 20 20 (pair? ls). 3a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a60: 20 20 20 28 64 69 73 70 6c 61 79 20 73 65 70 20 (display sep 3a70: 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 p). 3a80: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if ( 3a90: 3c 3d 20 69 20 72 65 6d 29 20 28 77 72 69 74 65 <= i rem) (write 3aa0: 2d 63 68 61 72 20 23 5c 73 70 61 63 65 20 70 29 -char #\space p) 3ab0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 3ac0: 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c (displ 3ad0: 61 79 20 28 63 61 72 20 6c 73 29 20 70 29 0a 20 ay (car ls) p). 3ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3af0: 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 (lp (cdr 3b00: 6c 73 29 20 28 2b 20 69 20 31 29 29 29 29 29 0a ls) (+ i 1))))). 3b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b20: 20 20 20 28 6e 65 77 6c 69 6e 65 20 70 29 29 29 (newline p))) 3b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3b40: 73 74 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 st)))). (de 3b50: 66 69 6e 65 20 28 6a 75 73 74 69 66 79 2d 6c 61 fine (justify-la 3b60: 73 74 20 6c 73 20 73 74 29 0a 20 20 20 20 20 20 st ls st). 3b70: 20 20 28 6e 6c 20 28 28 66 6d 74 2d 6a 6f 69 6e (nl ((fmt-join 3b80: 20 64 73 70 20 6c 73 20 22 20 22 29 20 73 74 29 dsp ls " ") st) 3b90: 29 29 0a 20 20 20 20 20 20 28 28 66 6d 74 2d 6c )). ((fmt-l 3ba0: 65 74 0a 20 20 20 20 20 20 20 20 27 77 72 69 74 et. 'writ 3bb0: 65 72 0a 20 20 20 20 20 20 20 20 28 6c 61 6d 62 er. (lamb 3bc0: 64 61 20 28 73 74 72 20 73 74 29 20 28 73 65 74 da (str st) (set 3bd0: 21 20 62 75 66 66 65 72 20 28 63 6f 6e 73 20 73 ! buffer (cons s 3be0: 74 72 20 62 75 66 66 65 72 29 29 20 73 74 29 0a tr buffer)) st). 3bf0: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 2d 63 (apply-c 3c00: 61 74 20 6c 73 29 29 0a 20 20 20 20 20 20 20 73 at ls)). s 3c10: 74 29 0a 20 20 20 20 20 20 28 77 72 61 70 2d 66 t). (wrap-f 3c20: 6f 6c 64 20 28 73 74 72 69 6e 67 2d 63 6f 6e 63 old (string-conc 3c30: 61 74 65 6e 61 74 65 2d 72 65 76 65 72 73 65 20 atenate-reverse 3c40: 62 75 66 66 65 72 29 0a 20 20 20 20 20 20 20 20 buffer). 3c50: 20 20 20 20 20 20 20 20 20 73 74 20 77 69 64 74 st widt 3c60: 68 20 73 74 72 69 6e 67 2d 77 69 64 74 68 20 6a h string-width j 3c70: 75 73 74 69 66 79 2d 6c 69 6e 65 20 6a 75 73 74 ustify-line just 3c80: 69 66 79 2d 6c 61 73 74 29 29 29 29 0a 0a 28 64 ify-last))))..(d 3c90: 65 66 69 6e 65 20 28 66 6d 74 2d 66 69 6c 65 20 efine (fmt-file 3ca0: 70 61 74 68 29 0a 20 20 28 6c 61 6d 62 64 61 20 path). (lambda 3cb0: 28 73 74 29 0a 20 20 20 20 28 63 61 6c 6c 2d 77 (st). (call-w 3cc0: 69 74 68 2d 69 6e 70 75 74 2d 66 69 6c 65 20 70 ith-input-file p 3cd0: 61 74 68 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 ath. (lambd 3ce0: 61 20 28 70 29 0a 20 20 20 20 20 20 20 20 28 6c a (p). (l 3cf0: 65 74 20 6c 70 20 28 28 73 74 20 73 74 29 29 0a et lp ((st st)). 3d00: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let ( 3d10: 28 6c 69 6e 65 20 28 72 65 61 64 2d 6c 69 6e 65 (line (read-line 3d20: 20 70 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 p))). 3d30: 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 (if (eof-objec 3d40: 74 3f 20 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 t? line). 3d50: 20 20 20 20 20 20 20 20 20 73 74 0a 20 20 20 20 st. 3d60: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp 3d70: 28 6e 6c 20 28 28 64 73 70 20 6c 69 6e 65 29 20 (nl ((dsp line) 3d80: 73 74 29 29 29 29 29 29 29 29 29 29 0a 0a 28 64 st))))))))))..(d 3d90: 65 66 69 6e 65 20 28 6c 69 6e 65 2d 6e 75 6d 62 efine (line-numb 3da0: 65 72 73 20 2e 20 6f 29 0a 20 20 28 6c 65 74 20 ers . o). (let 3db0: 28 28 73 74 61 72 74 20 28 69 66 20 28 70 61 69 ((start (if (pai 3dc0: 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 31 29 r? o) (car o) 1) 3dd0: 29 29 0a 20 20 20 20 28 66 6d 74 2d 6a 6f 69 6e )). (fmt-join 3de0: 2f 72 61 6e 67 65 20 64 73 70 20 73 74 61 72 74 /range dsp start 3df0: 20 23 66 20 6e 6c 2d 73 74 72 29 29 29 0a 0a #f nl-str)))..