From: Chris Hanson Date: Fri, 27 Jan 2017 01:00:18 +0000 (-0800) Subject: Eliminate use of xstring in IMAIL. X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~70 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=59b3489c53872259659e516f1d8910e2d39b7043;p=mit-scheme.git Eliminate use of xstring in IMAIL. --- diff --git a/src/imail/imail-file.scm b/src/imail/imail-file.scm index 7ccbf6f51..95b337fd2 100644 --- a/src/imail/imail-file.scm +++ b/src/imail/imail-file.scm @@ -252,7 +252,7 @@ USA. 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)) @@ -287,10 +287,10 @@ USA. (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)))) @@ -428,14 +428,14 @@ USA. (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) @@ -447,11 +447,11 @@ USA. 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))))) (define-method discard-folder-cache ((folder )) (discard-file-folder-messages folder) - (discard-file-folder-xstring folder)) + (discard-file-folder-string folder)) (define-method probe-folder ((folder )) folder @@ -494,8 +494,8 @@ USA. (define-class () 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) @@ -512,9 +512,9 @@ USA. (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 @@ -593,6 +593,6 @@ USA. (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 diff --git a/src/imail/imail-rmail.scm b/src/imail/imail-rmail.scm index 81ebbaa8c..9b62e424a 100644 --- a/src/imail/imail-rmail.scm +++ b/src/imail/imail-rmail.scm @@ -188,7 +188,7 @@ USA. (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) @@ -197,7 +197,7 @@ USA. (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)) @@ -205,7 +205,7 @@ USA. (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 @@ -213,15 +213,15 @@ USA. (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 diff --git a/src/imail/imail-umail.scm b/src/imail/imail-umail.scm index f5906cb99..3f4280476 100644 --- a/src/imail/imail-umail.scm +++ b/src/imail/imail-umail.scm @@ -108,9 +108,9 @@ USA. (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 @@ -123,9 +123,9 @@ USA. (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 diff --git a/src/imail/imail-util.scm b/src/imail/imail-util.scm index b14762007..516f43f38 100644 --- a/src/imail/imail-util.scm +++ b/src/imail/imail-util.scm @@ -422,53 +422,53 @@ USA. ;;;; 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))) @@ -476,13 +476,13 @@ USA. (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))))) -(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 @@ -495,13 +495,13 @@ USA. (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)) @@ -524,19 +524,19 @@ USA. (if prefix (string-append prefix s) s))) - (if (read-xstring-buffer state) + (if (read-string-buffer state) (loop p) p))))))) (eof-object)))) -(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)))))) @@ -545,7 +545,7 @@ USA. (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))))) @@ -563,13 +563,13 @@ USA. ,(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))))))) diff --git a/src/imail/imap-response.scm b/src/imail/imap-response.scm index fdf79964c..757e22a3e 100644 --- a/src/imail/imap-response.scm +++ b/src/imail/imap-response.scm @@ -144,9 +144,9 @@ USA. '())) ((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))) @@ -261,7 +261,7 @@ USA. ((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))