From ebd31da92f9ab66d7d4b2a37b5d4e1a317fe3442 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sat, 16 Feb 2013 15:41:45 +0100 Subject: [PATCH 2/2] Also add column/row counting to read-string --- extras.scm | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/extras.scm b/extras.scm index 0e8b144..510dabb 100644 --- a/extras.scm +++ b/extras.scm @@ -155,12 +155,22 @@ (if rdstring (let loop ((start start) (n n) (m 0)) (let ((n2 (rdstring port n dest start))) - (##sys#setislot port 5 ; update port-position - (fx+ (##sys#slot port 5) n2)) - (cond ((eq? n2 0) m) - ((or (not n) (fx< n2 n)) - (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2))) - (else (fx+ n2 m))))) + (if (and (fx> m 0) (or (not n) (fx< n2 n))) + (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)) + ;; Calculate port position + (let scan ((pos 0) + (line (##sys#slot port 4)) + (col (##sys#slot port 5)) + (stop (fx+ n2 m))) + (cond ((eq? pos stop) + (##sys#setislot port 4 line) + (##sys#setislot port 5 col) + stop) + ((eq? (##core#inline "C_subchar" dest pos) + #\newline) + (scan (fx+ pos 1) (fx+ line 1) 0 stop)) + (else + (scan (fx+ pos 1) line (fx+ col 1) stop))))))) (let loop ((start start) (n n) (m 0)) (let ((n2 (let ((c (##sys#read-char-0 port))) (if (eof-object? c) -- 1.8.0.1