diff options
author | Neil Jerram <neil@ossau.uklinux.net> | 2002-10-09 19:07:23 +0000 |
---|---|---|
committer | Neil Jerram <neil@ossau.uklinux.net> | 2002-10-09 19:07:23 +0000 |
commit | 34010f56945e872f003a3702df1c347320eeeb4e (patch) | |
tree | 95abd27167d97ea44c7f278cd46baf9f7da32954 | |
parent | 66894177486be0ac1f5fdff6f6cff92b1c1e3a51 (diff) | |
download | guile-34010f56945e872f003a3702df1c347320eeeb4e.tar.gz |
Extend soft ports to use input-waiting thunks.
-rw-r--r-- | ice-9/ChangeLog | 5 | ||||
-rw-r--r-- | ice-9/buffered-input.scm | 7 | ||||
-rw-r--r-- | libguile/ChangeLog | 6 | ||||
-rw-r--r-- | libguile/vports.c | 28 |
4 files changed, 43 insertions, 3 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index badbb5337..ef37fda7e 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2002-10-09 Neil Jerram <neil@ossau.uklinux.net> + + * buffered-input.scm (make-buffered-input-port): Build an + input-waiting thunk for just extended version of make-soft-port. + 2002-10-04 Rob Browning <rlb@defaultvalue.org> * boot-9.scm (expt): switch if sense and use negative? rather than diff --git a/ice-9/buffered-input.scm b/ice-9/buffered-input.scm index 1cfc2ea76..19182d199 100644 --- a/ice-9/buffered-input.scm +++ b/ice-9/buffered-input.scm @@ -105,8 +105,13 @@ with @var{continuation?} set to @code{#t}." (if (not (char-whitespace? res)) (set! (buffered-input-continuation? port) #t)) res))))) + (input-waiting + (lambda () + (if (eof-object? read-string) + 1 + (- (string-length read-string) string-index)))) (port #f)) - (set! port (make-soft-port (vector #f #f #f get-character #f) "r")) + (set! port (make-soft-port (vector #f #f #f get-character #f input-waiting) "r")) (set! (buffered-input-continuation? port) #f) port))) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 264bfed5f..794115fb9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2002-10-09 Neil Jerram <neil@ossau.uklinux.net> + + * vports.c (scm_make_soft_port): Allow vector argument to carry a + 6th element: an input waiting thunk. + (sf_input_waiting): New. + 2002-10-05 Marius Vollmer <mvo@zagadka.ping.de> * root.c (root_mark): Mark active_asyncs slot. diff --git a/libguile/vports.c b/libguile/vports.c index 94e44976c..53f37ac91 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -139,12 +139,28 @@ sf_close (SCM port) } +static int +sf_input_waiting (SCM port) +{ + SCM p = SCM_PACK (SCM_STREAM (port)); + if (SCM_VECTOR_LENGTH (p) >= 6) + { + SCM f = SCM_VELTS (p)[5]; + if (SCM_NFALSEP (f)) + return SCM_INUM (scm_call_0 (f)); + } + /* Default is such that char-ready? for soft ports returns #t, as it + did before this extension was implemented. */ + return 1; +} + + SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, (SCM pv, SCM modes), "Return a port capable of receiving or delivering characters as\n" "specified by the @var{modes} string (@pxref{File Ports,\n" - "open-file}). @var{pv} must be a vector of length 5. Its\n" + "open-file}). @var{pv} must be a vector of length 5 or 6. Its\n" "components are as follows:\n" "\n" "@enumerate 0\n" @@ -158,6 +174,9 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, "thunk for getting one character\n" "@item\n" "thunk for closing port (not by garbage collection)\n" + "@item\n" + "(if present and not @code{#f}) thunk for computing the number of\n" + "characters that can be read from the port without blocking.\n" "@end enumerate\n" "\n" "For an output-only port only elements 0, 1, 2, and 4 need be\n" @@ -185,9 +204,13 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_make_soft_port { + int vlen; scm_t_port *pt; SCM z; - SCM_VALIDATE_VECTOR_LEN (1, pv,5); + + SCM_VALIDATE_VECTOR (1, pv); + vlen = SCM_VECTOR_LENGTH (pv); + SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME); SCM_VALIDATE_STRING (2, modes); SCM_DEFER_INTS; @@ -211,6 +234,7 @@ scm_make_sfptob () scm_set_port_mark (tc, scm_markstream); scm_set_port_flush (tc, sf_flush); scm_set_port_close (tc, sf_close); + scm_set_port_input_waiting (tc, sf_input_waiting); return tc; } |