From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 10 Aug 1993 09:44:18 +0000 (+0000)
Subject: Implement INTERVAL-PROPERTIES-EQUAL?.
X-Git-Tag: 20090517-FFI~8097
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7d09ba9dbdacd9f2c202b075cb5200003818d176;p=mit-scheme.git

Implement INTERVAL-PROPERTIES-EQUAL?.
---

diff --git a/v7/src/edwin/txtprp.scm b/v7/src/edwin/txtprp.scm
index 0d0bb177f..707878cc9 100644
--- a/v7/src/edwin/txtprp.scm
+++ b/v7/src/edwin/txtprp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: txtprp.scm,v 1.2 1993/08/10 06:35:54 cph Exp $
+;;;	$Id: txtprp.scm,v 1.3 1993/08/10 09:44:18 cph Exp $
 ;;;
 ;;;	Copyright (c) 1993 Massachusetts Institute of Technology
 ;;;
@@ -178,6 +178,17 @@
 		  (if (equal? p (assq prop (interval-properties prev)))
 		      (loop (previous-interval prev))
 		      (interval-start prev))))))))
+
+(define (interval-properties-equal? p1 p2)
+  ;; Slow but effective.
+  (let ((subset?
+	 (lambda (p1 p2)
+	   (let loop ((p1 p1))
+	     (or (null? p1)
+		 (and (assq (caar p1) p2)
+		      (loop (cdr p1))))))))
+    (and (subset? p1 p2)
+	 (subset? p2 p1))))
 
 ;;; The READ-ONLY property is applied to a contiguous region of
 ;;; characters.  No insertions are allowed within that region, and no