From 8096a3c3ef2ac7241db94912770a1dda70fa9a35 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Jan 2001 20:06:57 +0000
Subject: [PATCH] Add operations for XSTRING (extended string) objects.

---
 v7/src/runtime/runtime.pkg |  8 ++++++--
 v7/src/runtime/string.scm  | 28 +++++++++++++++++++++++++---
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 4b1aaba53..132fdc7bd 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.356 2001/01/04 22:25:46 cph Exp $
+$Id: runtime.pkg,v 14.357 2001/01/05 20:06:57 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -196,7 +196,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	  vector-8b-find-previous-char
 	  vector-8b-find-previous-char-ci
 	  vector-8b-ref
-	  vector-8b-set!)
+	  vector-8b-set!
+	  xstring-length
+	  xstring-move!
+	  xstring?
+	  xsubstring-move!)
   (export (runtime char-syntax)
 	  guarantee-substring)
   (initialization (initialize-package!)))
diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm
index 35eb8db38..5c04f73a9 100644
--- a/v7/src/runtime/string.scm
+++ b/v7/src/runtime/string.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: string.scm,v 14.36 2001/01/04 22:25:49 cph Exp $
+$Id: string.scm,v 14.37 2001/01/05 20:06:52 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -989,8 +989,30 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (if (not (external-string? xstring))
       (error:wrong-type-argument xstring "external string"
 				 'EXTERNAL-STRING-LENGTH))
-  ((ucode-primitive extended-string-length)
-   (external-string-descriptor xstring)))
+   ((ucode-primitive extended-string-length)
+    (external-string-descriptor xstring)))
+
+(define (xstring? object)
+  (or (string? object)
+      (external-string? object)))
+
+(define (xstring-length xstring)
+  (cond ((string? xstring)
+	 (string-length xstring))
+	((external-string? xstring)
+	 ((ucode-primitive extended-string-length)
+	  (external-string-descriptor xstring)))
+	(else
+	 (error:wrong-type-argument xstring "xstring" 'XSTRING-LENGTH))))
+
+(define (xstring-move! xstring1 xstring2 start2)
+  (xsubstring-move! xstring1 0 (xstring-length xstring1) xstring2 start2))
+
+(define (xsubstring-move! xstring1 start1 end1 xstring2 start2)
+  (cond ((or (not (eq? xstring2 xstring1)) (< start2 start1))
+	 (substring-move-left! xstring1 start1 end1 xstring2 start2))
+	((> start2 start1)
+	 (substring-move-right! xstring1 0 end1 xstring2 start2))))
 
 ;;;; Guarantors
 ;;
-- 
2.25.1