diff --git a/scsh/fdports1.c b/scsh/fdports1.c index 95e4a28..1956c9c 100644 --- a/scsh/fdports1.c +++ b/scsh/fdports1.c @@ -431,7 +431,7 @@ scheme_value read_delim(const char *delims, char *buf, int gobble, clearerr(f); - do { + while( 1 ) { int c = getc(f); if( EOF == c ) { /* Terminal case: EOF or error. */ @@ -454,5 +454,56 @@ scheme_value read_delim(const char *delims, char *buf, int gobble, else *++cptr = c; } - while (1); } + + +scheme_value skip_chars(const char *skipchars, scheme_value port, int *nread) +{ + + scheme_value data = *Port_PortData(port); + scheme_value peekc = *PortData_Peek(data); + int fd = EXTRACT_FIXNUM(*PortData_Fd(data)); + FILE *f = fstar_cache[fd]; + int nr = 0; /* Number of skip chars read. */ + + /* This chunk of code is necessary because we have to check + ** the port's one-char pushback slot before going to the port's + ** stdio FILE*. Yech. + */ + if( IsChar(peekc) ) { + char c = EXTRACT_CHAR(peekc); + if( skipchars[c] ) { /* Is c in cset? */ + *PortData_Peek(data) = SCHFALSE; + nr = 1; + } + else { + *nread = 0; + return SCHFALSE; + } + } + + clearerr(f); + + while( 1 ) { + int c = getc(f); + + if( EOF == c ) { /* Terminal case: EOF or error. */ + *nread = nr; + return ferror(f) ? ENTER_FIXNUM(errno) : SCHFALSE; + } + + else if( !skipchars[c] ) { /* Terminal case: non-skip char. */ + *PortData_Peek(data) = ENTER_CHAR(c); + *nread = nr; + return SCHFALSE; + } + nr++; + } + } + +/* Why, you might ask, do I push back the final char using the Scheme port +** instead of using ungetc()? Because ungetc() isn't guaranteed to work for +** unbuffered ports. This is regrettable, because it causes C stdio clients +** that are ignorant of the Scheme port machinery to miss this char. No +** real help for it. +*/ diff --git a/scsh/fdports1.h b/scsh/fdports1.h index 5bc22a3..961b4d7 100644 --- a/scsh/fdports1.h +++ b/scsh/fdports1.h @@ -39,3 +39,5 @@ int write_fdport_substring(scheme_value buf, int start, int end, scheme_value da scheme_value read_delim(const char *delims, char *buf, int gobble, scheme_value port, int start, int end, int *nread); + +scheme_value skip_chars(const char *skipchars, scheme_value port, int *nread); diff --git a/scsh/rdelim.c b/scsh/rdelim.c index 5fef311..7b7964e 100644 --- a/scsh/rdelim.c +++ b/scsh/rdelim.c @@ -25,3 +25,17 @@ scheme_value df_read_delim(long nargs, scheme_value *args) return ret1; } +scheme_value df_skip_chars(long nargs, scheme_value *args) +{ + extern scheme_value skip_chars(const char *, scheme_value , int *); + scheme_value ret1; + scheme_value r1; + int r2; + + cig_check_nargs(3, nargs, "skip_chars"); + r1 = skip_chars(cig_string_body(args[2]), args[1], &r2); + ret1 = r1; + VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); + return ret1; + } + diff --git a/scsh/rdelim.scm b/scsh/rdelim.scm index 8a73fc7..cbf6e9e 100644 --- a/scsh/rdelim.scm +++ b/scsh/rdelim.scm @@ -212,18 +212,35 @@ fixnum) ; number of chars read into BUF. -;;; This is probably a hell of lot slower than actually reading the string -;;; into a buffer and throwing it away, due to the painful slowness of -;;; the current char-at-a-time Scheme input. +(define-foreign %skip-char-set-fdport/errno (skip_chars (string skip-set) + (desc port)) + desc ; int => errno; #f => win. + fixnum) ; number of chars skipped. + + +(define (skip-char-set skip-chars . maybe-port) + (let ((port (optional-arg maybe-port (current-input-port))) + (cset (->char-set skip-chars))) + + (cond ((not (input-port? port)) + (error "Illegal value -- not an input port." port)) + + ;; Direct C support for Unix file ports -- zippy quick. + ((fdport? port) + (receive (err num-read) (%skip-char-set-fdport/errno cset port) + (if err (errno-error err skip-char-set cset port num-read) + num-read))) + + ;; This is the code for other kinds of ports. + ;; Mighty slow -- we read each char twice (peek first, then read). + (else (let lp ((i 0)) + (let ((c (peek-char port))) + (cond ((and (char? c) (char-set-contains? cset c)) + (read-char port) + (lp (+ i 1))) + (else i)))))))) + -(define (skip-char-set cset . maybe-port) - (let ((port (optional-arg maybe-port (current-input-port)))) - (let lp () - (let ((c (peek-char port))) - (cond ((and (char? c) (char-set-contains? cset c)) - (read-char port) - (lp)) - (else c)))))) ;;; (read-line [port delim-action])