From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 26 Jun 2000 18:59:53 +0000 (+0000)
Subject: Add additional procedures for searching through the space of text
X-Git-Tag: 20090517-FFI~3446
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b188be8a4c89ae1c9f0733244e79320d9a25ea9a;p=mit-scheme.git

Add additional procedures for searching through the space of text
properties.
---

diff --git a/v7/src/edwin/simple.scm b/v7/src/edwin/simple.scm
index e88f5eab4..b0fe00e8b 100644
--- a/v7/src/edwin/simple.scm
+++ b/v7/src/edwin/simple.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: simple.scm,v 1.51 2000/06/26 16:22:43 cph Exp $
+;;; $Id: simple.scm,v 1.52 2000/06/26 18:59:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1985, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -307,13 +307,22 @@
 	 (make-mark (mark-group start) index))))
 
 (define (specific-property-region mark key)
-  (and (not (let ((default (list 'DEFAULT)))
-	      (eq? (region-get mark key default)
-		   default)))
-       (make-region
-	(let ((start (group-start mark)))
-	  (or (find-previous-specific-property-change start mark key)
-	      start))
-	(let ((end (group-end mark)))
-	  (or (find-next-specific-property-change mark end key)
-	      end)))))
\ No newline at end of file
+  (let ((default (list 'DEFAULT)))
+    (let ((datum (region-get mark key default)))
+      (and (not (eq? datum default))
+	   (make-region
+	    (let ((start (group-start mark)))
+	      (if (mark< start mark)
+		  (if (eq? (region-get (mark-1+ mark) key default) datum)
+		      (or (find-previous-specific-property-change start mark
+								  key)
+			  start)
+		      mark)
+		  start))
+	    (let ((end (group-end mark)))
+	      (if (mark< mark end)
+		  (if (eq? (region-get (mark1+ mark) key default) datum)
+		      (or (find-next-specific-property-change mark end key)
+			  end)
+		      mark)
+		  end)))))))
\ No newline at end of file