From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 19 Apr 1995 01:40:24 +0000 (+0000)
Subject: Add basic text property procedures that accept marks instead of
X-Git-Tag: 20090517-FFI~6435
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=15e9d637b5899604ea44c25eba5ebb12c6b76b0a;p=mit-scheme.git

Add basic text property procedures that accept marks instead of
indexes.
---

diff --git a/v7/src/edwin/simple.scm b/v7/src/edwin/simple.scm
index ba6eb6d6c..6a788f32d 100644
--- a/v7/src/edwin/simple.scm
+++ b/v7/src/edwin/simple.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: simple.scm,v 1.45 1995/04/17 21:47:40 cph Exp $
+;;;	$Id: simple.scm,v 1.46 1995/04/19 01:40:24 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -275,7 +275,7 @@
 (define (reposition-window-top mark)
   (if (not (and mark (set-window-start-mark! (current-window) mark false)))
       (editor-beep)))
-
+
 (define (narrow-to-region mark #!optional point)
   (let ((point (if (default-object? point) (current-point) point)))
     (let ((group (mark-group mark))
@@ -289,4 +289,27 @@
 
 (define (widen #!optional point)
   (let ((point (if (default-object? point) (current-point) point)))
-    (group-widen! (mark-group point))))
\ No newline at end of file
+    (group-widen! (mark-group point))))
+
+(define (region-put! start end key datum)
+  (if (not (mark<= start end))
+      (error "Marks incorrectly related:" start end))
+  (add-text-property (mark-group start)
+		     (mark-index start)
+		     (mark-index end)
+		     key
+		     datum))
+
+(define (region-remove! start end key)
+  (if (not (mark<= start end))
+      (error "Marks incorrectly related:" start end))
+  (remove-text-property (mark-group start)
+			(mark-index start)
+			(mark-index end)
+			key))
+
+(define (region-get mark key)
+  (get-text-property (mark-group mark)
+		     (mark-index mark)
+		     key
+		     default))
\ No newline at end of file