From 7961405db78b7d6dd726dd91eb60de5d21cfa15a Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Thu, 23 Jul 2009 16:35:05 +0300 Subject: [PATCH] input ports now support "input-port-column-number" and "input-port-row-number". These currently work for string ports, latin-1 ports, and utf-8 ports as long as only ascii chars are read. --- scheme/ikarus.io.ss | 41 +++++++++++++++++++++++++++++++++++------ scheme/last-revision | 2 +- scheme/makefile.ss | 2 ++ 3 files changed, 38 insertions(+), 7 deletions(-) diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss index 20a842f..7985879 100644 --- a/scheme/ikarus.io.ss +++ b/scheme/ikarus.io.ss @@ -63,6 +63,7 @@ reset-output-port! port-id input-port-byte-position + input-port-column-number input-port-row-number process process-nonblocking tcp-connect tcp-connect-nonblocking @@ -133,6 +134,7 @@ close-tcp-server-socket register-callback input-socket-buffer-size output-socket-buffer-size + input-port-column-number input-port-row-number open-directory-stream directory-stream? read-directory-stream close-directory-stream @@ -256,9 +258,9 @@ (import (ikarus system $fx)) ($fxlogand ($port-tag x) fast-attrs-mask)))) - (define-struct cookie (dest mode pos reader)) + (define-struct cookie (dest mode pos row-num newline-pos)) - (define (default-cookie fd) (make-cookie fd 'ikarus-mode 0 #f)) + (define (default-cookie fd) (make-cookie fd 'ikarus-mode 0 0 0)) (define (port-id p) (if (port? p) @@ -271,6 +273,25 @@ (+ (cookie-pos cookie) (fx+ ($port-index p) 1))) (error 'input-port-byte-position "not an input port" p))) + (define (mark/return-newline p) + (let ([cookie ($port-cookie p)]) + (set-cookie-row-num! cookie (+ (cookie-row-num cookie) 1)) + (set-cookie-newline-pos! cookie + (+ (cookie-pos cookie) ($port-index p)))) + #\newline) + + (define (input-port-column-number p) + (if (input-port? p) + (let ([cookie ($port-cookie p)]) + (- (+ (cookie-pos cookie) ($port-index p)) + (cookie-newline-pos cookie))) + (die 'input-port-column-number "not an input port" p))) + + (define (input-port-row-number p) + (if (input-port? p) + (cookie-row-num ($port-cookie p)) + (die 'input-port-row-number "not an input port" p))) + (define (port-position p) (define who 'port-position) (if (port? p) @@ -1310,7 +1331,9 @@ (cond [(fx< b 128) ($set-port-index! p (fx+ i 1)) - (integer->char b)] + (if (eqv? b (char->integer #\newline)) + (mark/return-newline p) + (integer->char b))] [else (get-char-utf8-mode p who)]))] [else (get-char-utf8-mode p who)]))] @@ -1319,15 +1342,20 @@ (cond [(fx< i ($port-size p)) ($set-port-index! p (fx+ i 1)) - (string-ref ($port-buffer p) i)] + (let ([c (string-ref ($port-buffer p) i)]) + (if (eqv? c #\newline) + (mark/return-newline p) + c))] [else (get-char-char-mode p who)]))] [(eq? m fast-get-latin-tag) (let ([i ($port-index p)]) (cond [(fx< i ($port-size p)) ($set-port-index! p (fx+ i 1)) - (integer->char - (bytevector-u8-ref ($port-buffer p) i))] + (let ([b (bytevector-u8-ref ($port-buffer p) i)]) + (if (eqv? b (char->integer #\newline)) + (mark/return-newline p) + (integer->char b)))] [else (get-char-latin-mode p who 1)]))] [(eq? m fast-get-utf16le-tag) (get-utf16 p who 'little)] @@ -1337,6 +1365,7 @@ (eof-object) (do-get-char p who))])))) + ;;; ---------------------------------------------------------- (define (assert-binary-input-port p who) (unless (port? p) (die who "not a port" p)) diff --git a/scheme/last-revision b/scheme/last-revision index 5bcfdd6..a4a445d 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1827 +1828 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 565067d..16177c5 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1204,6 +1204,8 @@ [port-has-port-position? i r ip] [port-has-set-port-position!? i r ip] [port-position i r ip] + [input-port-column-number i] + [input-port-row-number i] [port-transcoder i r ip] [port? i r ip] [put-bytevector i r ip]