From c32cf43f5382d184e144e1953cb68b4785d0e22a Mon Sep 17 00:00:00 2001
From: Jason Wilson <edu/mit/csail/zurich/jawilson>
Date: Mon, 9 Aug 1993 19:11:49 +0000
Subject: [PATCH] Changes to undo so that text property changes could be undone
 using undo.

---
 v7/src/edwin/undo.scm | 95 ++++++++++++++++++++++++++++---------------
 1 file changed, 63 insertions(+), 32 deletions(-)

diff --git a/v7/src/edwin/undo.scm b/v7/src/edwin/undo.scm
index 743e0b6bc..951ffa7d2 100644
--- a/v7/src/edwin/undo.scm
+++ b/v7/src/edwin/undo.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: undo.scm,v 1.54 1993/01/24 07:06:43 cph Exp $
+;;;	$Id: undo.scm,v 1.55 1993/08/09 19:11:49 jawilson Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -124,6 +124,13 @@
       (begin
 	(if (not (group-modified? group))
 	    (undo-record-first-change! group))
+	(if (group-text-properties group)
+	    (set-group-undo-data!
+	     group
+	     (cons (cons 'REINSERT-PROPERTIES
+			 (vector start end
+				 (group-extract-properties group start end)))
+		   (group-undo-data group))))
 	(set-group-undo-data!
 	 group
 	 (let ((text (group-extract-string group start end))
@@ -139,6 +146,16 @@
 			 point
 			 (group-undo-data group)))))))))
 
+(define (undo-record-property-changes! group properties)
+    (if (not (eq? #t (group-undo-data group)))
+	(begin
+	  (if (not (group-modified? group))
+	      (undo-record-first-change! group))
+	  (set-group-undo-data!
+	   group
+	   (cons (cons 'SET-TEXT-PROPERTIES properties)
+		 (group-undo-data group))))))
+
 (define (undo-record-first-change! group)
   (let ((buffer (group-buffer group)))
     (if buffer
@@ -289,37 +306,51 @@ A numeric argument serves as a repeat count."
 		  ;; #F means boundary: this step is done.
 		  (finish data)
 		  (begin
-		    (if (fix:fixnum? element)
-			;; Fixnum is a point position.
-			(set-mark-index! point element)
-			(let ((a (car element))
-			      (b (cdr element)))
-			  (cond ((eq? #t a)
-				 ;; (#t . MOD-TIME) means first modification
-				 (if (eqv? b (buffer-modification-time buffer))
-				     (buffer-not-modified! buffer)))
-				((fix:fixnum? a)
-				 ;; (START . END) means insertion
-				 (if (or (fix:< a (group-start-index group))
-					 (fix:> a (group-end-index group))
-					 (fix:> b (group-end-index group)))
-				     (outside-visible-range))
-				 (set-mark-index! point a)
-				 (group-delete! group a b))
-				;; (STRING . START) means deletion
-				((fix:< b 0)
-				 ;; negative START means set point at end
-				 (let ((b (fix:- 0 b)))
-				   (if (or (fix:< b (group-start-index group))
-					   (fix:> b (group-end-index group)))
-				       (outside-visible-range))
-				   (set-mark-index! point b)
-				   (group-insert-string! group b a)))
-				(else
-				 ;; nonnegative START means set point at start
+		    (cond
+		     ;; Fixnum is a point position.
+		     ((fix:fixnum? element)
+		      (set-mark-index! point element))
+		     (else
+		      (let ((a (car element))
+			    (b (cdr element)))
+			(cond ((eq? #t a)
+			       ;; (#t . MOD-TIME) means first modification
+			       (if (eqv? b (buffer-modification-time buffer))
+				   (buffer-not-modified! buffer)))
+			      ((eq? 'SET-TEXT-PROPERTIES a)
+			       (for-each (lambda (entry)
+					   (set-text-properties group
+								(car entry)
+								(cadr entry)
+								(caddr entry)))
+					 b))
+			      ((eq? 'REINSERT-PROPERTIES a)
+			       (group-reinsert-properties! group
+							   (vector-ref b 0)
+							   (vector-ref b 1)
+							   (vector-ref b 2)))
+			      ((fix:fixnum? a)
+			       ;; (START . END) means insertion
+			       (if (or (fix:< a (group-start-index group))
+				       (fix:> a (group-end-index group))
+				       (fix:> b (group-end-index group)))
+				   (outside-visible-range))
+			       (set-mark-index! point a)
+			       (group-delete! group a b))
+			      ;; (STRING . START) means deletion
+			      ((fix:< b 0)
+			       ;; negative START means set point at end
+			       (let ((b (fix:- 0 b)))
 				 (if (or (fix:< b (group-start-index group))
 					 (fix:> b (group-end-index group)))
 				     (outside-visible-range))
-				 (group-insert-string! group b a)
-				 (set-mark-index! point b)))))
-		    (loop data)))))))))
\ No newline at end of file
+				 (set-mark-index! point b)
+				 (group-insert-string! group b a)))
+			      (else
+			       ;; nonnegative START means set point at start
+			       (if (or (fix:< b (group-start-index group))
+				       (fix:> b (group-end-index group)))
+				   (outside-visible-range))
+			       (group-insert-string! group b a)
+			       (set-mark-index! point b))))))
+		    (loop data)))))))))
-- 
2.25.1