initial-value #f)
(file-modification-count define standard
initial-value #f)
- (xstring define standard))
+ (string define standard))
(define (file-folder-messages folder)
(if (eq? 'UNKNOWN (%file-folder-messages folder))
(set-file-folder-messages! folder 'UNKNOWN)
(for-each-vector-element messages detach-message!)))))))
-(define (discard-file-folder-xstring folder)
+(define (discard-file-folder-string folder)
(without-interrupts
(lambda ()
- (set-file-folder-xstring! folder #f)
+ (set-file-folder-string! folder #f)
(set-file-folder-file-modification-time! folder #f)
(set-file-folder-file-modification-count! folder #f))))
(pathname (file-folder-pathname folder)))
(if (not (and t (= t (file-modification-time pathname))))
(begin
- (if t (discard-file-folder-xstring folder))
+ (if t (discard-file-folder-string folder))
(let loop ()
(let ((t (file-modification-time pathname)))
((imail-ui:message-wrapper "Reading file "
(->namestring pathname))
(lambda ()
- (set-file-folder-xstring! folder
- (read-file-into-xstring pathname))))
+ (set-file-folder-string! folder
+ (read-file-into-string pathname))))
(if (= t (file-modification-time pathname))
(begin
(set-file-folder-file-modification-time! folder t)
folder
((imail-ui:message-wrapper "Parsing messages")
(lambda ()
- (call-with-input-xstring (file-folder-xstring folder) 0 reader)))))
+ (call-with-input-string (file-folder-string folder) 0 reader)))))
\f
(define-method discard-folder-cache ((folder <file-folder>))
(discard-file-folder-messages folder)
- (discard-file-folder-xstring folder))
+ (discard-file-folder-string folder))
(define-method probe-folder ((folder <file-folder>))
folder
(define-class <file-message> (<message>)
body)
-(define (file-message-xstring message)
- (file-folder-xstring (message-folder message)))
+(define (file-message-string message)
+ (file-folder-string (message-folder message)))
(define (file-external-ref? object)
(and (pair? object)
(let ((item (accessor message)))
(if (file-external-ref? item)
(operator
- (xsubstring (file-message-xstring message)
- (file-external-ref/start item)
- (file-external-ref/end item)))
+ (substring (file-message-string message)
+ (file-external-ref/start item)
+ (file-external-ref/end item)))
item)))))
(define-file-external-message-method message-header-fields
(define (file-folder-internal-headers folder ref)
(filter! internal-header-field?
(string->header-fields
- (xsubstring (file-folder-xstring folder)
- (file-external-ref/start ref)
- (file-external-ref/end ref)))))
\ No newline at end of file
+ (substring (file-folder-string folder)
+ (file-external-ref/start ref)
+ (file-external-ref/end ref)))))
\ No newline at end of file
(cons "seen" (reverse! flags)))))))))
(define (read-rmail-alternate-headers port)
- (let ((start (xstring-port/position port)))
+ (let ((start (string-port/position port)))
(make-file-external-ref
start
(let* ((separator rmail-message:headers-separator)
(let loop ()
(let ((char (read-required-char port)))
(cond ((char=? char #\newline)
- (let ((end (- (xstring-port/position port) 1)))
+ (let ((end (- (string-port/position port) 1)))
(if (not (string=? separator (read-required-line port)))
(error "Missing RMAIL headers-separator string:" port))
end))
(let ((line (read-required-line port)))
(if (substring=? line 0 (string-length line)
separator 1 sl)
- (- (xstring-port/position port)
+ (- (string-port/position port)
(+ (string-length line) 1))
(loop))))
(else
(loop)))))))))
(define (read-rmail-displayed-headers port)
- (let ((start (xstring-port/position port)))
+ (let ((start (string-port/position port)))
(skip-past-blank-line port)
- (make-file-external-ref start (- (xstring-port/position port) 1))))
+ (make-file-external-ref start (- (string-port/position port) 1))))
(define (read-rmail-body port)
- (let ((start (xstring-port/position port)))
+ (let ((start (string-port/position port)))
(input-port/discard-chars port rmail-message:end-char-set)
(input-port/discard-char port)
- (make-file-external-ref start (- (xstring-port/position port) 1))))
+ (make-file-external-ref start (- (string-port/position port) 1))))
(define (rmail-internal-time folder ref)
(let ((v
(list->vector (reverse! messages)))))))))))))
(define (read-umail-message folder from-line port delimiter?)
- (let ((h-start (xstring-port/position port)))
+ (let ((h-start (string-port/position port)))
(skip-past-blank-line port)
- (let ((b-start (xstring-port/position port)))
+ (let ((b-start (string-port/position port)))
(let ((finish
(lambda (b-end line)
(values
(let loop ()
(let ((line (read-line port)))
(cond ((eof-object? line)
- (finish (xstring-port/position port) #f))
+ (finish (string-port/position port) #f))
((delimiter? line)
- (finish (- (xstring-port/position port)
+ (finish (- (string-port/position port)
(+ (string-length line) 1))
line))
(else
\f
;;;; Extended-string input port
-(define (read-file-into-xstring pathname)
+(define (read-file-into-string pathname)
(call-with-legacy-binary-input-file pathname
(lambda (port)
(let ((n-bytes ((port/operation port 'LENGTH) port)))
- (let ((xstring (make-string n-bytes)))
+ (let ((string (make-string n-bytes)))
(let loop ((start 0))
(if (< start n-bytes)
- (let ((n-read (read-string! xstring port)))
+ (let ((n-read (read-string! string port)))
(if (= n-read 0)
(error "Failed to read complete file:"
(+ start n-read) n-bytes pathname))
(loop (+ start n-read)))))
- xstring)))))
+ string)))))
-(define (call-with-input-xstring xstring position receiver)
- (let ((port (open-xstring-input-port xstring position)))
+(define (call-with-input-string string position receiver)
+ (let ((port (open-string-input-port string position)))
(let ((value (receiver port)))
(close-port port)
value)))
-(define (open-xstring-input-port xstring position)
- (if (not (<= 0 position (string-length xstring)))
- (error:bad-range-argument position 'OPEN-XSTRING-INPUT-PORT))
- (let ((state (make-istate xstring position position position)))
- (read-xstring-buffer state)
- (make-port xstring-input-type state)))
+(define (open-string-input-port string position)
+ (if (not (<= 0 position (string-length string)))
+ (error:bad-range-argument position 'OPEN-STRING-INPUT-PORT))
+ (let ((state (make-istate string position position position)))
+ (read-string-buffer state)
+ (make-port string-input-type state)))
(define-structure (istate
(constructor make-istate
- (xstring position buffer-start buffer-end))
+ (string position buffer-start buffer-end))
(conc-name istate-))
- xstring
+ string
position
(buffer (make-string #x10000) read-only #t)
buffer-start
buffer-end)
-(define (xstring-port/xstring port)
- (istate-xstring (port/state port)))
+(define (string-port/string port)
+ (istate-string (port/state port)))
-(define (xstring-port/position port)
+(define (string-port/position port)
(istate-position (port/state port)))
-(define (read-xstring-buffer state)
- (let ((xstring (istate-xstring state))
+(define (read-string-buffer state)
+ (let ((string (istate-string state))
(start (istate-position state)))
- (let ((xend (string-length xstring)))
+ (let ((xend (string-length string)))
(and (< start xend)
(let* ((buffer (istate-buffer state))
(end (min (+ start (string-length buffer)) xend)))
(lambda ()
(set-istate-buffer-start! state start)
(set-istate-buffer-end! state end)
- (xsubstring-move! xstring start end buffer 0)))
+ (substring-move! string start end buffer 0)))
#t)))))
\f
-(define (xstring-input-port/discard-chars port delimiters)
+(define (string-input-port/discard-chars port delimiters)
(let ((state (port/state port)))
(if (or (< (istate-position state) (istate-buffer-end state))
- (read-xstring-buffer state))
+ (read-string-buffer state))
(let loop ()
(let* ((start (istate-buffer-start state))
(index
(set-istate-position! state (+ start index))
(begin
(set-istate-position! state (istate-buffer-end state))
- (if (read-xstring-buffer state)
+ (if (read-string-buffer state)
(loop)))))))))
-(define (xstring-input-port/read-string port delimiters)
+(define (string-input-port/read-string port delimiters)
(let ((state (port/state port)))
(if (or (< (istate-position state) (istate-buffer-end state))
- (read-xstring-buffer state))
+ (read-string-buffer state))
(let loop ((prefix #f))
(let* ((start (istate-buffer-start state))
(b (istate-buffer state))
(if prefix
(string-append prefix s)
s)))
- (if (read-xstring-buffer state)
+ (if (read-string-buffer state)
(loop p)
p)))))))
(eof-object))))
\f
-(define xstring-input-type
+(define string-input-type
(make-port-type
`((PEEK-CHAR
,(lambda (port)
(let ((state (port/state port)))
(let ((position (istate-position state)))
(if (or (< position (istate-buffer-end state))
- (read-xstring-buffer state))
+ (read-string-buffer state))
(string-ref (istate-buffer state)
(- position (istate-buffer-start state)))
(eof-object))))))
(let ((state (port/state port)))
(let ((position (istate-position state)))
(if (or (< position (istate-buffer-end state))
- (read-xstring-buffer state))
+ (read-string-buffer state))
(let ((char
(string-ref (istate-buffer state)
(- position (istate-buffer-start state)))))
,(lambda (port)
(let ((state (port/state port)))
(>= (istate-position state)
- (string-length (istate-xstring state))))))
+ (string-length (istate-string state))))))
(CLOSE
,(lambda (port)
(let ((state (port/state port)))
(without-interrupts
(lambda ()
- (set-istate-xstring! state #f)
+ (set-istate-string! state #f)
(set-istate-position! state 0)
(set-istate-buffer-start! state 0)
(set-istate-buffer-end! state 0)))))))
'()))
((NEWNAME)
(discard-known-char #\space port)
- (let ((old (read-xstring port)))
+ (let ((old (read-string port)))
(discard-known-char #\space port)
- (list old (read-xstring port))))
+ (list old (read-string port))))
((UIDNEXT UIDVALIDITY UNSEEN)
(discard-known-char #\space port)
(list (read-nz-number port)))
((imap:atom-char? char) (read-atom port))
(else (error "Illegal astring syntax:" char)))))
-(define (read-xstring port)
+(define (read-string port)
(let ((char (peek-char-no-eof port)))
(cond ((char=? #\" char) (read-quoted port))
((char=? #\{ char) (read-literal port))
projects / mit-scheme.git / commitdiff