Also change all the references to the SRFI-6 names.
#| -*-Scheme-*-
-$Id: nodefs.scm,v 1.13 2002/11/20 19:45:46 cph Exp $
+$Id: nodefs.scm,v 1.14 2003/02/13 19:56:06 cph Exp $
-Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology
+Copyright 1991,1992,1993,1995,2001,2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
expression)))
(define (write-definition-value name #!optional value)
- (with-string-output-port
+ (call-with-output-string
(lambda (port)
(write name port)
(if (not (default-object? value))
-;;; -*-Scheme-*-
-;;;
-;;; $Id: hlpcom.scm,v 1.124 2002/11/20 19:46:00 cph Exp $
-;;;
-;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: hlpcom.scm,v 1.125 2003/02/13 19:53:57 cph Exp $
+
+Copyright 1986,1989,1990,1991,1993,1998 Massachusetts Institute of Technology
+Copyright 2000,2002,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; Help Commands
(show-bindings
(lambda (argument next comtabs)
comtabs
- (cons (let ((port (make-accumulator-output-port)))
- (describe-bindings
- (mode-comtabs (name->mode argument 'ERROR))
- #f
- port)
- (newline port)
- (get-output-from-accumulator port))
+ (cons (call-with-output-string
+ (lambda (port)
+ (describe-bindings
+ (mode-comtabs (name->mode argument 'ERROR))
+ #f
+ port)
+ (newline port)))
(find-escape next comtabs))))
(new-mode
(lambda (argument next comtabs)
-;;; -*-Scheme-*-
-;;;
-;;; $Id: nntp.scm,v 1.25 2002/11/20 19:46:01 cph Exp $
-;;;
-;;; Copyright (c) 1995-1999 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: nntp.scm,v 1.26 2003/02/13 19:54:04 cph Exp $
+
+Copyright 1995,1996,1997,1998,1999,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; NNTP Interface
(caddr tokens)
(if prune?
(header-lines->text (nntp-read-text-lines connection))
- (with-string-output-port
- (lambda (port)
- (nntp-read-text connection port #f)))))))
+ (call-with-output-string
+ (lambda (port)
+ (nntp-read-text connection port #f)))))))
((423 430)
'NO-SUCH-ARTICLE)
(else
(define (pre-read-body group key)
(let ((valid?))
(let ((datum
- (with-string-output-port
- (lambda (port)
- (maybe-switch-groups group)
- (set! valid?
- (nntp-body-command (news-group:connection group)
- key
- port))
- unspecific))))
+ (call-with-output-string
+ (lambda (port)
+ (maybe-switch-groups group)
+ (set! valid?
+ (nntp-body-command (news-group:connection group)
+ key
+ port))
+ unspecific))))
(and valid?
(begin
(gdbm-store (news-group:body-gdbf group #t) key datum
-;;; -*-Scheme-*-
-;;;
-;;; $Id: rfc822.scm,v 3.4 2002/11/20 19:46:02 cph Exp $
-;;;
-;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: rfc822.scm,v 3.5 2003/02/13 19:54:10 cph Exp $
+
+Copyright 1999,2000,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; IMAIL mail reader: RFC-822 support
;;;; Token-stream filters
(define (rfc822:tokens->string tokens)
- (let ((port (make-accumulator-output-port)))
- (do ((tokens tokens (cdr tokens)))
- ((not (pair? tokens)))
- (cond ((char? (car tokens))
- (write-char (car tokens) port))
- ((string? (car tokens))
- (write-string (car tokens) port))
- ((and (pair? (car tokens))
- (eq? 'ILLEGAL (caar tokens)))
- (write-char (cdar tokens) port))
- (else
- (error "Malformed RFC-822 token stream:" tokens))))
- (get-output-from-accumulator port)))
+ (call-with-output-string
+ (lambda (port)
+ (do ((tokens tokens (cdr tokens)))
+ ((not (pair? tokens)))
+ (cond ((char? (car tokens))
+ (write-char (car tokens) port))
+ ((string? (car tokens))
+ (write-string (car tokens) port))
+ ((and (pair? (car tokens))
+ (eq? 'ILLEGAL (caar tokens)))
+ (write-char (cdar tokens) port))
+ (else
+ (error "Malformed RFC-822 token stream:" tokens)))))))
(define rfc822:strip-whitespace!
(list-deletor!
(and (not (eof-object? char))
(char-lwsp? char))))))
(lambda (input-string)
- (let ((port (string->input-port input-string)))
+ (let ((port (open-input-string input-string)))
(define (dispatch)
(let ((char (input-port/read-char port)))
(cond ((eof-object? char)
#| -*-Scheme-*-
-$Id: schmod.scm,v 1.61 2003/01/15 04:52:25 cph Exp $
+$Id: schmod.scm,v 1.62 2003/02/13 19:58:30 cph Exp $
Copyright 1986,1989,1990,1991,1992,1998 Massachusetts Institute of Technology
Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology
NAMED-LAMBDA)
;; MIT Scheme procedures:
- (0 WITH-OUTPUT-TO-STRING)
+ (0 CALL-WITH-OUTPUT-STRING WITH-OUTPUT-TO-STRING)
(1 CALL-WITH-APPEND-FILE CALL-WITH-BINARY-APPEND-FILE
CALL-WITH-BINARY-INPUT-FILE CALL-WITH-BINARY-OUTPUT-FILE
WITH-INPUT-FROM-PORT WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-PORT
-;;; -*-Scheme-*-
-;;;
-;;; $Id: sendmail.scm,v 1.79 2002/11/20 19:46:03 cph Exp $
-;;;
-;;; Copyright (c) 1991-2001 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: sendmail.scm,v 1.80 2003/02/13 19:54:17 cph Exp $
+
+Copyright 1991,1992,1993,1994,1995,1996 Massachusetts Institute of Technology
+Copyright 1997,1998,2000,2001,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; Mail Sending
(if (not (<= 1 length (- 70 plen)))
(error:bad-range-argument length 'RANDOM-MIME-BOUNDARY-STRING))
(let ((s
- (with-string-output-port
- (lambda (port)
- (write-string prefix port)
- (let ((context (encode-base64:initialize port #f)))
- (let ((n (* (integer-ceiling (- length 2) 4) 3)))
- (encode-base64:update context (random-byte-vector n) 0 n))
- (encode-base64:finalize context)))))
+ (call-with-output-string
+ (lambda (port)
+ (write-string prefix port)
+ (let ((context (encode-base64:initialize port #f)))
+ (let ((n (* (integer-ceiling (- length 2) 4) 3)))
+ (encode-base64:update context (random-byte-vector n) 0 n))
+ (encode-base64:finalize context)))))
(n (+ plen length)))
(if (fix:> (string-length s) n)
(set-string-maximum-length! s n))
-;;; -*-Scheme-*-
-;;;
-;;; $Id: imail-core.scm,v 1.147 2002/11/20 19:46:05 cph Exp $
-;;;
-;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: imail-core.scm,v 1.148 2003/02/13 19:54:36 cph Exp $
+
+Copyright 1999,2000,2001,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; IMAIL mail reader: core definitions
(set-message-folder! message #f))
(define (message->string message)
- (with-string-output-port
- (lambda (port)
- (write-header-fields (message-header-fields message) port)
- (write-message-body message port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-header-fields (message-header-fields message) port)
+ (write-message-body message port))))
(define (message-time message)
(let ((date (get-first-header-field-value message "date" #f)))
(write-substring string start end port))))
(define (header-fields->string headers)
- (with-string-output-port
- (lambda (port)
- (write-header-fields headers port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-header-fields headers port))))
(define (header-field->string header)
- (with-string-output-port
- (lambda (port)
- (write-header-field header port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-header-field header port))))
(define (header-field-value->string value)
- (with-string-output-port
- (lambda (port)
- (encode-header-field-value value
- (lambda (string start end)
- (write-substring string start end port))))))
+ (call-with-output-string
+ (lambda (port)
+ (encode-header-field-value value
+ (lambda (string start end)
+ (write-substring string start end port))))))
\f
(define (get-first-header-field headers name error?)
(let loop ((headers (->header-fields headers)))
-;;; -*-Scheme-*-
-;;;
-;;; $Id: imail-file.scm,v 1.82 2002/11/20 19:46:05 cph Exp $
-;;;
-;;; Copyright (c) 1999-2002 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: imail-file.scm,v 1.83 2003/02/13 19:54:43 cph Exp $
+
+Copyright 1999,2000,2001,2002,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; IMAIL mail reader: file-based folder support
(lambda (s) s))
(define-method file-message-body ((message <message>))
- (with-string-output-port
- (lambda (port)
- (write-message-body message port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-message-body message port))))
(define-method write-message-body ((message <file-message>) port)
(write-string (file-message-body message) port))
-;;; -*-Scheme-*-
-;;;
-;;; $Id: imail-imap.scm,v 1.196 2002/11/20 19:46:05 cph Exp $
-;;;
-;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: imail-imap.scm,v 1.197 2003/02/13 19:54:50 cph Exp $
+
+Copyright 1999,2000,2001,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; IMAIL mail reader: IMAP back end
(encode-cache-namestring (imap-url-mailbox url)))))
(define (encode-cache-namestring string)
- (with-string-output-port
- (lambda (port)
- (let ((n (string-length string)))
- (do ((i 0 (fix:+ i 1)))
- ((fix:= i n))
- (let ((char (string-ref string i)))
- (cond ((char-set-member? char-set:cache-namestring-safe char)
- (write-char char port))
- ((char=? char #\/)
- (write-char #\# port))
- (else
- (write-char #\% port)
- (let ((n (char->integer char)))
- (if (fix:< n #x10)
- (write-char #\0 port))
- (write-string (number->string n 16) port))))))))))
+ (call-with-output-string
+ (lambda (port)
+ (let ((n (string-length string)))
+ (do ((i 0 (fix:+ i 1)))
+ ((fix:= i n))
+ (let ((char (string-ref string i)))
+ (cond ((char-set-member? char-set:cache-namestring-safe char)
+ (write-char char port))
+ ((char=? char #\/)
+ (write-char #\# port))
+ (else
+ (write-char #\% port)
+ (let ((n (char->integer char)))
+ (if (fix:< n #x10)
+ (write-char #\0 port))
+ (write-string (number->string n 16) port))))))))))
(define char-set:cache-namestring-safe
(char-set-union char-set:alphanumeric (string->char-set "-_.")))
#| -*-Scheme-*-
-$Id: imail-top.scm,v 1.285 2003/01/15 21:26:02 cph Exp $
+$Id: imail-top.scm,v 1.286 2003/02/13 19:54:57 cph Exp $
Copyright 1999,2000,2001,2002,2003 Massachusetts Institute of Technology
\f
(define-major-mode imail read-only "IMAIL"
(lambda ()
- (with-string-output-port
- (lambda (port)
- (write-string imail-mode-description port)
- (newline port)
- (newline port)
- (write-string (make-string 70 #\-) port)
- (newline port)
- (write-string "These variables customize the behavior of IMAIL:" port)
- (newline port)
- (newline port)
- (for-each
- (let ((buffer (selected-buffer)))
- (lambda (variable)
- (let ((name (variable-name-string variable)))
- (if (not (string-prefix-ci? "imail-summary-" name))
- (begin
- (write-string name port)
- (newline port)
- (write-string " " port)
- (write-description
- (description-first-line (variable-description variable))
- port)
- (newline port)
- (write-string " Value: " port)
- (write (variable-local-value buffer variable) port)
- (newline port)
- (newline port))))))
- (string-table-apropos editor-variables "^imail-"))
- (write-string (make-string 70 #\-) port)
- (newline port)
- (write-string "These are all the key bindings for IMAIL mode:" port)
- (newline port)
- (newline port)
- (write-string "\\{imail}" port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-string imail-mode-description port)
+ (newline port)
+ (newline port)
+ (write-string (make-string 70 #\-) port)
+ (newline port)
+ (write-string "These variables customize the behavior of IMAIL:" port)
+ (newline port)
+ (newline port)
+ (for-each
+ (let ((buffer (selected-buffer)))
+ (lambda (variable)
+ (let ((name (variable-name-string variable)))
+ (if (not (string-prefix-ci? "imail-summary-" name))
+ (begin
+ (write-string name port)
+ (newline port)
+ (write-string " " port)
+ (write-description
+ (description-first-line (variable-description variable))
+ port)
+ (newline port)
+ (write-string " Value: " port)
+ (write (variable-local-value buffer variable) port)
+ (newline port)
+ (newline port))))))
+ (string-table-apropos editor-variables "^imail-"))
+ (write-string (make-string 70 #\-) port)
+ (newline port)
+ (write-string "These are all the key bindings for IMAIL mode:" port)
+ (newline port)
+ (newline port)
+ (write-string "\\{imail}" port))))
(lambda (buffer)
(buffer-put! buffer 'REVERT-BUFFER-METHOD imail-revert-buffer)
(add-kill-buffer-hook buffer imail-kill-buffer)
(define-method insert-mime-message-inline*
(message (body <mime-body-message>) selector context mark)
- (insert-header-fields (with-string-output-port
- (lambda (port)
- (write-mime-message-body-part message
- `(,@selector HEADER)
- #t
- port)))
+ (insert-header-fields (call-with-output-string
+ (lambda (port)
+ (write-mime-message-body-part message
+ `(,@selector HEADER)
+ #t
+ port)))
#f
mark)
(walk-mime-message-part message
-;;; -*-Scheme-*-
-;;;
-;;; $Id: imap-response.scm,v 1.46 2002/11/20 19:46:06 cph Exp $
-;;;
-;;; Copyright (c) 2000-2002 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: imap-response.scm,v 1.47 2003/02/13 19:55:04 cph Exp $
+
+Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; IMAP Server Response Reader
(else (error "Illegal astring syntax:" char)))))
(define (read-nstring input)
- (let ((output (make-accumulator-output-port)))
+ (let ((output (open-output-string)))
(and (read-nstring-to-port input output)
- (get-output-from-accumulator output))))
+ (get-output-string output))))
(define (read-nstring-to-port input output)
(let ((char (peek-char-no-eof input)))
(else (error "Illegal astring syntax:" char)))))
\f
(define (read-quoted input)
- (with-string-output-port
- (lambda (output)
- (read-quoted-to-port input output))))
+ (call-with-output-string
+ (lambda (output)
+ (read-quoted-to-port input output))))
(define (read-quoted-to-port input output)
(discard-known-char #\" input)
(lose)))))))
(define (read-literal input)
- (with-string-output-port
- (lambda (output)
- (read-literal-to-port input output))))
+ (call-with-output-string
+ (lambda (output)
+ (read-literal-to-port input output))))
(define (read-literal-to-port input output)
(discard-known-char #\{ input)
#| -*-Scheme-*-
-$Id: makegen.scm,v 1.4 2002/11/20 19:46:17 cph Exp $
+$Id: makegen.scm,v 1.5 2003/02/13 19:56:29 cph Exp $
-Copyright (c) 2000, 2001 Massachusetts Institute of Technology
+Copyright 2000,2001,2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
(define (generate-rule filename)
(parse-rule
(unbreak-lines
- (with-string-output-port
- (lambda (port)
- (run-shell-command (string-append "gcc -M -DMIT_SCHEME " filename)
- 'OUTPUT port))))))
+ (call-with-output-string
+ (lambda (port)
+ (run-shell-command (string-append "gcc -M -DMIT_SCHEME " filename)
+ 'OUTPUT port))))))
(define (unbreak-lines string)
(let ((indexes (string-search-all "\\\n" string)))
#| -*-Scheme-*-
-$Id: error.scm,v 14.59 2003/01/01 02:26:37 cph Exp $
+$Id: error.scm,v 14.60 2003/02/13 19:52:29 cph Exp $
-Copyright (c) 1988-2002 Massachusetts Institute of Technology
+Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
+Copyright 1992,1993,1995,2000,2001,2002 Massachusetts Institute of Technology
+Copyright 2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
(reporter condition port))))
(define (condition/report-string condition)
- (with-string-output-port
- (lambda (port)
- (write-condition-report condition port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-condition-report condition port))))
\f
;;;; Restarts
#| -*-Scheme-*-
-$Id: mit-syntax.scm,v 14.12 2003/02/13 02:46:41 cph Exp $
+$Id: mit-syntax.scm,v 14.13 2003/02/13 19:52:35 cph Exp $
Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
(if-error)
(loop (cdr clauses))))))
(cond ((identifier? req)
- (if (there-exists? supported-features
+ (if (there-exists? supported-srfi-features
(lambda (feature)
(compare (rename feature) req)))
(if-true)
(if-error)))))))
(if-error)))))
-(define supported-features
+(define supported-srfi-features
'(SRFI-0
+ SRFI-6
SRFI-8
SRFI-9
SRFI-23
#| -*-Scheme-*-
-$Id: parse.scm,v 14.38 2002/11/20 19:46:21 cph Exp $
+$Id: parse.scm,v 14.39 2003/02/13 19:52:43 cph Exp $
-Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
+Copyright 1992,1993,1994,1997,1998,1999 Massachusetts Institute of Technology
+Copyright 2001,2002,2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
(let ((head (read-string char-set/string-delimiters)))
(if (char=? #\" (read-char))
head
- (with-string-output-port
+ (call-with-output-string
(lambda (port)
(write-string head port)
(let loop ()
#| -*-Scheme-*-
-$Id: pp.scm,v 14.44 2002/11/20 19:46:22 cph Exp $
+$Id: pp.scm,v 14.45 2003/02/13 19:52:50 cph Exp $
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
+Copyright 1992,1993,1994,1995,1996,1999 Massachusetts Institute of Technology
+Copyright 2001,2002,2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
(numerical-walk-no-auto-highlight object list-depth))))
(define (walk-custom unparser object list-depth)
- (with-string-output-port
+ (call-with-output-string
(lambda (port)
(unparser (make-unparser-state port
list-depth
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.425 2003/02/10 01:54:05 cph Exp $
+$Id: runtime.pkg,v 14.426 2003/02/13 19:52:58 cph Exp $
Copyright (c) 1988,1989,1990,1991,1992 Massachusetts Institute of Technology
Copyright (c) 1993,1994,1995,1996,1997 Massachusetts Institute of Technology
(files "strnin")
(parent (runtime))
(export ()
- string->input-port
+ open-input-string
+ (string->input-port open-input-string)
with-input-from-string)
(initialization (initialize-package!)))
(files "strout")
(parent (runtime))
(export ()
- get-output-from-accumulator
- make-accumulator-output-port
- with-string-output-port
+ call-with-output-string
+ (get-output-from-accumulator get-output-string)
+ get-output-string
+ (make-accumulator-output-port open-output-string)
+ open-output-string
+ (with-string-output-port call-with-output-string)
with-output-to-string)
(initialization (initialize-package!)))
reverse-syntactic-environments
rsc-macro-transformer->expander
strip-syntactic-closures
+ supported-srfi-features
syntactic-closure-rtd
syntactic-closure/environment
syntactic-closure/free-names
#| -*-Scheme-*-
-$Id: strnin.scm,v 14.9 2002/11/20 19:46:23 cph Exp $
+$Id: strnin.scm,v 14.10 2003/02/13 19:53:05 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright 1988,1990,1993,1999,2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
|#
-;;;; String I/O Ports
+;;;; String Input Ports (SRFI-6)
;;; package: (runtime string-input)
(declare (usual-integrations))
unspecific)
(define (with-input-from-string string thunk)
- (with-input-from-port (string->input-port string) thunk))
+ (with-input-from-port (open-input-string string) thunk))
-(define (string->input-port string #!optional start end)
+(define (open-input-string string #!optional start end)
(let ((end
(if (default-object? end)
(string-length string)
- (check-index end (string-length string) 'STRING->INPUT-PORT))))
+ (check-index end (string-length string) 'OPEN-INPUT-STRING))))
(make-port
input-string-port-type
(make-input-string-state string
(if (default-object? start)
0
- (check-index start end 'STRING->INPUT-PORT))
+ (check-index start end 'OPEN-INPUT-STRING))
end))))
(define (check-index index limit procedure)
#| -*-Scheme-*-
-$Id: strout.scm,v 14.16 2002/11/20 19:46:23 cph Exp $
+$Id: strout.scm,v 14.17 2003/02/13 19:53:12 cph Exp $
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright 1988,1990,1993,1999,2000,2001 Massachusetts Institute of Technology
+Copyright 2003 Massachusetts Institute of Technology
This file is part of MIT Scheme.
|#
-;;;; String Output Ports
+;;;; String Output Ports (SRFI-6)
;;; package: (runtime string-output)
(declare (usual-integrations))
\f
-(define (make-accumulator-output-port)
+(define (open-output-string)
(make-port accumulator-output-port-type
(make-accumulator-state (make-string 16) 0)))
-(define (get-output-from-accumulator port)
+(define (get-output-string port)
((port/operation port 'EXTRACT-OUTPUT!) port))
(define (with-output-to-string thunk)
- (with-string-output-port (lambda (port) (with-output-to-port port thunk))))
+ (call-with-output-string (lambda (port) (with-output-to-port port thunk))))
-(define (with-string-output-port generator)
- (let ((port (make-accumulator-output-port)))
+(define (call-with-output-string generator)
+ (let ((port (open-output-string)))
(generator port)
- (operation/extract-output! port)))
+ (get-output-string port)))
(define accumulator-output-port-type)
(define (initialize-package!)
-;;; -*-Scheme-*-
-;;;
-;;; $Id: unicode.scm,v 1.3 2002/11/20 19:46:23 cph Exp $
-;;;
-;;; Copyright (c) 2001 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: unicode.scm,v 1.4 2003/02/13 19:53:19 cph Exp $
+
+Copyright 2001,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
;;;; Unicode support
(error "Illegal initial UTF-8 char:" c0)))))
(define (utf8-string->code-point string)
- (read-utf8-code-point (string->input-port string)))
+ (read-utf8-code-point (open-input-string string)))
\f
(define (read-utf8-code-point-from-source source)
;; This is separately implemented to speed up the parser buffer.
(output-8b (subsequent-char 0)))))
(define (code-point->utf8-string n)
- (with-string-output-port
+ (call-with-output-string
(lambda (port)
(write-utf8-code-point n port))))
#| -*-Scheme-*-
-$Id: xml-output.scm,v 1.12 2003/02/07 20:01:59 cph Exp $
+$Id: xml-output.scm,v 1.13 2003/02/13 19:58:54 cph Exp $
Copyright 2001,2002,2003 Massachusetts Institute of Technology
(write-xml xml port))))
(define (xml->string xml)
- (with-string-output-port
+ (call-with-output-string
(lambda (port)
(write-xml xml port))))
#| -*-Scheme-*-
-$Id: xml-parser.scm,v 1.19 2003/02/07 20:02:14 cph Exp $
+$Id: xml-parser.scm,v 1.20 2003/02/13 19:59:00 cph Exp $
Copyright 2001,2002,2003 Massachusetts Institute of Technology
;;;; Normalization
(define (normalize-attribute-value value p)
- (with-string-output-port
- (lambda (port)
- (let normalize-value ((value value))
- (if (string? value)
- (let ((buffer
- (string->parser-buffer (normalize-line-endings value))))
- (let loop ()
- (let ((char (peek-parser-buffer-char buffer)))
- (cond ((not char)
- unspecific)
- ((or (char=? char #\tab)
- (char=? char #\newline))
- (write-char #\space port)
- (read-parser-buffer-char buffer)
- (loop))
- ((char=? char #\&)
- (normalize-value
- (vector-ref (parse-reference buffer)
- 0))
- (loop))
- (else
- (write-char char port)
- (read-parser-buffer-char buffer)
- (loop))))))
- (perror p "Reference to external entity in attribute"))))))
+ (call-with-output-string
+ (lambda (port)
+ (let normalize-value ((value value))
+ (if (string? value)
+ (let ((buffer
+ (string->parser-buffer (normalize-line-endings value))))
+ (let loop ()
+ (let ((char (peek-parser-buffer-char buffer)))
+ (cond ((not char)
+ unspecific)
+ ((or (char=? char #\tab)
+ (char=? char #\newline))
+ (write-char #\space port)
+ (read-parser-buffer-char buffer)
+ (loop))
+ ((char=? char #\&)
+ (normalize-value
+ (vector-ref (parse-reference buffer)
+ 0))
+ (loop))
+ (else
+ (write-char char port)
+ (read-parser-buffer-char buffer)
+ (loop))))))
+ (perror p "Reference to external entity in attribute"))))))
(define (trim-attribute-whitespace string)
- (with-string-output-port
- (lambda (port)
- (let ((string (string-trim string)))
- (let ((end (string-length string)))
- (let loop ((start 0))
- (if (fix:< start end)
- (let ((regs
- (re-substring-search-forward " +" string start end)))
- (if regs
- (begin
- (write-substring string
- start
- (re-match-start-index 0 regs)
- port)
- (write-char #\space port)
- (loop (re-match-end-index 0 regs)))
- (write-substring string start end port))))))))))
+ (call-with-output-string
+ (lambda (port)
+ (let ((string (string-trim string)))
+ (let ((end (string-length string)))
+ (let loop ((start 0))
+ (if (fix:< start end)
+ (let ((regs
+ (re-substring-search-forward " +" string start end)))
+ (if regs
+ (begin
+ (write-substring string
+ start
+ (re-match-start-index 0 regs)
+ port)
+ (write-char #\space port)
+ (loop (re-match-end-index 0 regs)))
+ (write-substring string start end port))))))))))
\f
(define (normalize-line-endings string #!optional always-copy?)
(if (string-find-next-char string #\return)
projects / mit-scheme.git / commitdiff