mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

put-string in Scheme

Browse source 
* module/ice-9/ports.scm: Export port-encode-chars and
  port-clear-stream-start-for-bom-write via the internals module.
* module/ice-9/sports.scm (put-string): New function.
This commit is contained in:
Andy Wingo 2016-06-01 12:01:16 +02:00
parent 5bec3261b4
commit 9454068a54
2 changed files with 26 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/ice-9/ports.scm
View file

@ -182,10 +182,12 @@ interpret its input and output."
port-read
port-write
port-clear-stream-start-for-bom-read
port-clear-stream-start-for-bom-write
%port-encoding
specialize-port-encoding!
port-random-access?
port-decode-char
port-encode-chars
port-read-buffering
port-poll
port-read-wait-fd
@ -227,9 +229,11 @@ interpret its input and output."
port-read
port-write
port-clear-stream-start-for-bom-read
port-clear-stream-start-for-bom-write
%port-encoding
specialize-port-encoding!
port-decode-char
port-encode-chars
port-random-access?
port-read-buffering
port-poll

22
module/ice-9/sports.scm
View file

@ -64,6 +64,7 @@
get-bytevector-n
put-u8
put-bytevector
put-string
%read-line
read-line
@ -653,6 +654,27 @@
(define* (%read-line port)
(read-line port 'split))
(define* (put-string port str #:optional (start 0)
(count (- (string-length str) start)))
(let* ((aux (port-auxiliary-write-buffer port))
(pos (port-buffer-position aux))
(line (port-position-line pos)))
(set-port-buffer-cur! aux 0)
(port-clear-stream-start-for-bom-write port aux)
(let lp ((encoded 0))
(when (< encoded count)
(let ((encoded (+ encoded
(port-encode-chars port aux str
(+ start encoded)
(- count encoded)))))
(let ((end (port-buffer-end aux)))
(set-port-buffer-end! aux 0)
(put-bytevector port (port-buffer-bytevector aux) 0 end)
(lp encoded)))))
(when (and (not (eqv? line (port-position-line pos)))
(port-line-buffered? port))
(flush-output port))))
(define saved-port-bindings #f)
(define port-bindings
'(((guile) read-char peek-char force-output close-port)