From: Chris Hanson Date: Sun, 18 Mar 2001 06:27:49 +0000 (+0000) Subject: Change implementation of Rmail folders to keep a copy of the Rmail X-Git-Tag: 20090517-FFI~2896 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=08a658349ecac1de75fa4e6c0a450889eee0326e;p=mit-scheme.git Change implementation of Rmail folders to keep a copy of the Rmail file in an external string, and to refer to the message bodies using index pairs into the string. This change should allow Scheme to handle much larger Rmail folders. --- diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index 1ce0b79bf..f5b2bebca 100644 --- a/v7/src/imail/imail-rmail.scm +++ b/v7/src/imail/imail-rmail.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-rmail.scm,v 1.53 2001/03/18 06:26:13 cph Exp $ +;;; $Id: imail-rmail.scm,v 1.54 2001/03/18 06:27:44 cph Exp $ ;;; -;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology +;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -16,7 +16,8 @@ ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. ;;;; IMAIL mail reader: RMAIL back end diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm index be731eed7..1bfa96460 100644 --- a/v7/src/imail/imail-util.scm +++ b/v7/src/imail/imail-util.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-util.scm,v 1.31 2001/01/06 05:50:05 cph Exp $ +;;; $Id: imail-util.scm,v 1.32 2001/03/18 06:27:47 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -16,7 +16,8 @@ ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. ;;;; IMAIL mail reader: utilities @@ -367,81 +368,83 @@ ;;;; Extended-string input port -(define (open-xstring-input-port xstring) - (make-port xstring-input-type - (let ((state (make-xstring-input-state xstring))) - (read-xstring-buffer state 0) - state))) - (define (call-with-input-xstring xstring receiver) (let ((port (open-xstring-input-port xstring))) (let ((value (receiver port))) (close-port port) value))) -(define (xstring-input/read-char port) - (without-interrupts - (lambda () - (let ((char (xstring-input/peek-char port)) - (state (port/state port))) - (if (char? char) - (set-xstring-input-state/position! - state - (+ (xstring-input-state/position state) 1))) - char)))) - -(define (xstring-input/peek-char port) - (let ((state (port/state port))) - (let ((position (xstring-input-state/position state))) - (if (>= position (xstring-input-state/buffer-end state)) - (read-xstring-buffer state)) - (if (< position (xstring-input-state/buffer-end state)) - (string-ref (xstring-input-state/buffer state) - (- position (xstring-input-state/buffer-start state))) - (make-eof-object port))))) - -(define (xstring-input/length port) - (external-string-length (xstring-input-state/xstring (port/state port)))) - -(define (xstring-input/position port) - (xstring-input-state/position (port/state port))) - -(define (xstring-input/eof? port) - (let ((state (port/state port))) - (= (xstring-input-state/buffer-start state) - (xstring-input-state/buffer-end state)))) - -(define (xstring-input/close port) - (set-xstring-input-state/xstring! (port/state port) #f)) - -(define xstring-input-type - (make-port-type `((READ-CHAR ,xstring-input/read-char) - (PEEK-CHAR ,xstring-input/peek-char) - (LENGTH ,xstring-input/length) - (POSITION ,xstring-input/position) - (EOF? ,xstring-input/eof?) - (CLOSE ,xstring-input/close)) - #f)) +(define (open-xstring-input-port xstring) + (let ((state (make-xstring-input-state xstring))) + (read-xstring-buffer state) + (make-port xstring-input-type state))) (define-structure (xstring-input-state (constructor make-xstring-input-state (xstring)) (conc-name xstring-input-state/)) (xstring #f) (position 0) - (buffer (make-string 512)) - (buffer-start #f) + (buffer (make-string 512) read-only #t) + (buffer-start 0) (buffer-end 0)) +(define (xstring-port/xstring port) + (xstring-input-state/xstring (port/state port))) + +(define (xstring-port/position port) + (xstring-input-state/position (port/state port))) + (define (read-xstring-buffer state) (let ((xstring (xstring-input-state/xstring state)) - (buffer (xstring-input-state/buffer state)) (start (xstring-input-state/buffer-end state))) (let ((xend (external-string-length xstring))) - (if (< start xend) - (let ((end (max (+ start (string-length buffer)) xend))) - (without-interrupts - (lambda () - (set-xstring-input-state/buffer-start! state start) - (set-xstring-input-state/buffer-end! state end) - (substring-move-left! xstring start end buffer 0)))) - (set-xstring-input-state/buffer-start! state xend))))) \ No newline at end of file + (and (< start xend) + (let* ((buffer (xstring-input-state/buffer state)) + (end (min (+ start (string-length buffer)) xend))) + (without-interrupts + (lambda () + (set-xstring-input-state/buffer-start! state start) + (set-xstring-input-state/buffer-end! state end) + (xsubstring-move! xstring start end buffer 0))) + #t))))) + +(define xstring-input-type + (make-port-type + (let ((peek + (lambda (port) + (let ((state (port/state port))) + (let ((position (xstring-input-state/position state))) + (if (or (< position (xstring-input-state/buffer-end state)) + (read-xstring-buffer state)) + (string-ref (xstring-input-state/buffer state) + (- position + (xstring-input-state/buffer-start state))) + (make-eof-object port)))))) + (xlength + (lambda (state) + (external-string-length (xstring-input-state/xstring state))))) + `((READ-CHAR + ,(lambda (port) + (let ((char (peek port)) + (state (port/state port))) + (if (char? char) + (set-xstring-input-state/position! + state + (+ (xstring-input-state/position state) 1))) + char))) + (PEEK-CHAR ,peek) + (LENGTH ,(lambda (port) (xlength (port/state port)))) + (EOF? + ,(lambda (port) + (let ((state (port/state port))) + (< (xstring-input-state/position state) (xlength state))))) + (CLOSE + ,(lambda (port) + (let ((state (port/state port))) + (without-interrupts + (lambda () + (set-xstring-input-state/xstring! state #f) + (set-xstring-input-state/position! state 0) + (set-xstring-input-state/buffer-start! state 0) + (set-xstring-input-state/buffer-end! state 0)))))))) + #f)) \ No newline at end of file diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm index 9cd85e258..f92303438 100644 --- a/v7/src/imail/load.scm +++ b/v7/src/imail/load.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: load.scm,v 1.25 2001/01/06 05:49:52 cph Exp $ +;;; $Id: load.scm,v 1.26 2001/03/18 06:27:49 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -16,7 +16,8 @@ ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. ;;;; IMAIL mail reader: loader @@ -27,4 +28,4 @@ (lambda () (fluid-let ((*allow-package-redefinition?* #t)) (package/system-loader "imail" '() 'QUERY)))) -(add-subsystem-identification! "IMAIL" '(1 9)) \ No newline at end of file +(add-subsystem-identification! "IMAIL" '(1 10)) \ No newline at end of file