Ticket #978: 0002-Also-add-column-row-counting-to-read-string.patch

File 0002-Also-add-column-row-counting-to-read-string.patch, 1.5 KB (added by Jim Ursetto, 11 years ago)
  • extras.scm

    From ebd31da92f9ab66d7d4b2a37b5d4e1a317fe3442 Mon Sep 17 00:00:00 2001
    From: Peter Bex <peter.bex@xs4all.nl>
    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 b  
    155155           (if rdstring
    156156               (let loop ((start start) (n n) (m 0))
    157157                 (let ((n2 (rdstring port n dest start)))
    158                    (##sys#setislot port 5 ; update port-position
    159                                    (fx+ (##sys#slot port 5) n2))
    160                    (cond ((eq? n2 0) m)
    161                          ((or (not n) (fx< n2 n))
    162                           (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)))
    163                          (else (fx+ n2 m)))))
     158                   (if (and (fx> m 0) (or (not n) (fx< n2 n)))
     159                       (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2))
     160                       ;; Calculate port position
     161                       (let scan ((pos 0)
     162                                  (line (##sys#slot port 4))
     163                                  (col (##sys#slot port 5))
     164                                  (stop (fx+ n2 m)))
     165                         (cond ((eq? pos stop)
     166                                (##sys#setislot port 4 line)
     167                                (##sys#setislot port 5 col)
     168                                stop)
     169                               ((eq? (##core#inline "C_subchar" dest pos)
     170                                     #\newline)
     171                                (scan (fx+ pos 1) (fx+ line 1) 0 stop))
     172                               (else
     173                                (scan (fx+ pos 1) line (fx+ col 1) stop)))))))
    164174               (let loop ((start start) (n n) (m 0))
    165175                 (let ((n2 (let ((c (##sys#read-char-0 port)))
    166176                             (if (eof-object? c)