From: Chris Hanson Date: Fri, 27 Jan 2017 00:53:37 +0000 (-0800) Subject: Eliminate use of xstring in Edwin. X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~71 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8bc1931c1db88cb3329381742de93be8fdbeb22b;p=mit-scheme.git Eliminate use of xstring in Edwin. --- diff --git a/src/edwin/bufwin.scm b/src/edwin/bufwin.scm index 676444878..111d5c22e 100644 --- a/src/edwin/bufwin.scm +++ b/src/edwin/bufwin.scm @@ -630,21 +630,21 @@ USA. (define (%window-line-start-index? window index) (or (%window-group-start-index? window index) - (char=? (xstring-ref (group-text (%window-group window)) - (fix:- (group-index->position-integrable - (%window-group window) - index - #f) - 1)) + (char=? (string-ref (group-text (%window-group window)) + (fix:- (group-index->position-integrable + (%window-group window) + index + #f) + 1)) #\newline))) (define (%window-line-end-index? window index) (or (%window-group-end-index? window index) - (char=? (xstring-ref (group-text (%window-group window)) - (group-index->position-integrable - (%window-group window) - index - #t)) + (char=? (string-ref (group-text (%window-group window)) + (group-index->position-integrable + (%window-group window) + index + #t)) #\newline))) (define (clip-mark-to-display window mark) diff --git a/src/edwin/grpops.scm b/src/edwin/grpops.scm index e17e00648..53e76663c 100644 --- a/src/edwin/grpops.scm +++ b/src/edwin/grpops.scm @@ -77,12 +77,12 @@ USA. (fix:+ start* (fix:- gap-start start))))))) (define (group-left-char group index) - (xstring-ref (group-text group) - (fix:- (group-index->position-integrable group index #f) 1))) + (string-ref (group-text group) + (fix:- (group-index->position-integrable group index #f) 1))) (define (group-right-char group index) - (xstring-ref (group-text group) - (group-index->position-integrable group index #t))) + (string-ref (group-text group) + (group-index->position-integrable group index #t))) (define (group-extract-and-delete-string! group start end) (let ((string (group-extract-string group start end))) @@ -99,7 +99,7 @@ USA. (error:bad-range-argument n 'GROUP-INSERT-CHARS!)) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) (prepare-gap-for-insert! group index n) - (xsubstring-fill! (group-text group) index (fix:+ index n) char) + (substring-fill! (group-text group) index (fix:+ index n) char) (finish-group-insert! group index n) (set-interrupt-enables! interrupt-mask) unspecific)) @@ -217,7 +217,7 @@ USA. (set-group-gap-end! group gap-end) (set-group-gap-length! group (fix:- gap-end start)) (if (and (group-shrink-length group) - (fix:<= (fix:- (xstring-length text) + (fix:<= (fix:- (string-length text) (fix:- gap-end start)) (group-shrink-length group))) (shrink-group! group)))) @@ -261,9 +261,9 @@ USA. (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)) (end-index (fix:+ index 1))) (prepare-gap-for-replace! group index end-index) - (xstring-set! (group-text group) - (group-index->position-integrable group index #t) - char) + (string-set! (group-text group) + (group-index->position-integrable group index #t) + char) (finish-group-replace! group index end-index) (set-interrupt-enables! interrupt-mask) unspecific)) @@ -328,7 +328,7 @@ USA. (gap-start (group-gap-start group)) (gap-end (group-gap-end group)) (realloc-factor (group-reallocation-factor group))) - (let ((text-length (xstring-length text)) + (let ((text-length (string-length text)) (gap-delta (- new-gap-start gap-start))) (let ((n-chars (- text-length (group-gap-length group)))) (let ((new-text-length @@ -368,7 +368,7 @@ USA. (gap-start (group-gap-start group)) (gap-length (group-gap-length group)) (realloc-factor (group-reallocation-factor group))) - (let ((text-length (xstring-length text))) + (let ((text-length (string-length text))) (let ((n-chars (- text-length gap-length))) (let ((new-text-length (if (= n-chars 0) @@ -394,7 +394,7 @@ USA. (define (memoize-shrink-length! group realloc-factor) (set-group-shrink-length! group - (compute-shrink-length (xstring-length (group-text group)) realloc-factor))) + (compute-shrink-length (string-length (group-text group)) realloc-factor))) (define (compute-shrink-length length realloc-factor) (floor (/ (floor (/ length realloc-factor)) realloc-factor))) diff --git a/src/edwin/image.scm b/src/edwin/image.scm index 5e526dad0..e1dd33c75 100644 --- a/src/edwin/image.scm +++ b/src/edwin/image.scm @@ -63,7 +63,7 @@ USA. (do ((index start (fix:+ index 1)) (column column (fix:+ column - (let ((char (xstring-ref string index))) + (let ((char (string-ref string index))) (if (char=? char #\tab) (fix:- tab-width (fix:remainder column tab-width)) @@ -77,7 +77,7 @@ USA. (string-length (vector-ref char-image-strings (char->integer - (xstring-ref string index))))))) + (string-ref string index))))))) ((fix:= index end) column)))) (define default-char-image-strings/original-emacs @@ -169,7 +169,7 @@ USA. (let loop ((index start) (column column)) (if (fix:= index end) (cons index column) - (let ((char (xstring-ref string index))) + (let ((char (string-ref string index))) (if (char=? char #\newline) (cons index column) (loop (fix:+ index 1) @@ -183,7 +183,7 @@ USA. (let loop ((index start) (column column)) (if (fix:= index end) (cons index column) - (let ((char (xstring-ref string index))) + (let ((char (string-ref string index))) (if (char=? char #\newline) (cons index column) (loop (fix:+ index 1) @@ -245,11 +245,11 @@ USA. (let loop ((index start) (c start-column)) (if (or (fix:= c column) (fix:= index end) - (char=? #\newline (xstring-ref string index))) + (char=? #\newline (string-ref string index))) (vector index c 0) (let ((c (fix:+ c - (let ((char (xstring-ref string index))) + (let ((char (string-ref string index))) (if (char=? char #\tab) (fix:- tab-width (fix:remainder c tab-width)) (string-length @@ -261,14 +261,14 @@ USA. (let loop ((index start) (c start-column)) (if (or (fix:= c column) (fix:= index end) - (char=? #\newline (xstring-ref string index))) + (char=? #\newline (string-ref string index))) (vector index c 0) (let ((c (fix:+ c (string-length (vector-ref char-image-strings (char->integer - (xstring-ref string index))))))) + (string-ref string index))))))) (if (fix:> c column) (vector index column (fix:- c column)) (loop (fix:+ index 1) c))))))) @@ -284,7 +284,7 @@ USA. (vector-set! results 0 string-index) (vector-set! results 1 image-index) (vector-set! results 2 0)) - (let ((char (xstring-ref string string-index)) + (let ((char (string-ref string string-index)) (partial (lambda (partial) (vector-set! results 0 string-index) diff --git a/src/edwin/search.scm b/src/edwin/search.scm index feca7f873..a44c8b285 100644 --- a/src/edwin/search.scm +++ b/src/edwin/search.scm @@ -63,11 +63,11 @@ USA. (GROUP-GAP-LENGTH GROUP)))))))))))) (define-next-char-search group-find-next-char - xsubstring-find-next-char) + substring-find-next-char) (define-next-char-search group-find-next-char-ci - xsubstring-find-next-char-ci) + substring-find-next-char-ci) (define-next-char-search group-find-next-char-in-set - xsubstring-find-next-char-in-set) + substring-find-next-char-in-set) (define-syntax define-prev-char-search (sc-macro-transformer @@ -101,11 +101,11 @@ USA. CHAR))))))))) (define-prev-char-search group-find-previous-char - xsubstring-find-previous-char) + substring-find-previous-char) (define-prev-char-search group-find-previous-char-ci - xsubstring-find-previous-char-ci) + substring-find-previous-char-ci) (define-prev-char-search group-find-previous-char-in-set - xsubstring-find-previous-char-in-set) + substring-find-previous-char-in-set) (define-integrable (%find-next-newline group start end) (group-find-next-char group start end #\newline)) @@ -126,7 +126,7 @@ USA. (let loop ((i1 s1) (i2 s2)) (if (or (fix:= i1 e1) (fix:= i2 string-end) - (not (char=? (xstring-ref text i1) + (not (char=? (string-ref text i1) (string-ref string i2)))) i1 (loop (fix:+ i1 1) (fix:+ i2 1))))))) @@ -154,7 +154,7 @@ USA. (let ((match (lambda (s1 e1 e2) (let loop ((i1 (fix:- e1 1)) (i2 (fix:- e2 1))) - (cond ((not (char=? (xstring-ref text i1) + (cond ((not (char=? (string-ref text i1) (string-ref string i2))) (fix:+ i1 1)) ((or (fix:= i1 s1) (fix:= i2 string-start)) @@ -192,7 +192,7 @@ USA. (let loop ((i1 s1) (i2 s2)) (if (or (fix:= i1 e1) (fix:= i2 string-end) - (not (char-ci=? (xstring-ref text i1) + (not (char-ci=? (string-ref text i1) (string-ref string i2)))) i1 (loop (fix:+ i1 1) (fix:+ i2 1))))))) @@ -220,7 +220,7 @@ USA. (let ((match (lambda (s1 e1 e2) (let loop ((i1 (fix:- e1 1)) (i2 (fix:- e2 1))) - (cond ((not (char-ci=? (xstring-ref text i1) + (cond ((not (char-ci=? (string-ref text i1) (string-ref string i2))) (fix:+ i1 1)) ((or (fix:= i1 s1) (fix:= i2 string-start)) diff --git a/src/edwin/sendmail.scm b/src/edwin/sendmail.scm index e632cb6bd..3dbdafbb6 100644 --- a/src/edwin/sendmail.scm +++ b/src/edwin/sendmail.scm @@ -1347,7 +1347,7 @@ the user from the mailer." (lambda (string start end) (encode-quoted-printable:update context - (xsubstring string 0 (xstring-length string)) + (substring string 0 (string-length string)) start end))) (encode-quoted-printable:finalize context))) diff --git a/src/edwin/struct.scm b/src/edwin/struct.scm index f1dba5bcb..5ba5e7623 100644 --- a/src/edwin/struct.scm +++ b/src/edwin/struct.scm @@ -113,7 +113,7 @@ USA. group)) (define (group-length group) - (fix:- (xstring-length (group-text group)) (group-gap-length group))) + (fix:- (string-length (group-text group)) (group-gap-length group))) (define-integrable (group-start-index group) (mark-index (group-start-mark group)))