[climacs-cvs] CVS update: climacs/base.lisp climacs/buffer-test.lisp climacs/buffer.lisp climacs/gui.lisp

[Aleksandar Bakic]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv32053

Modified Files:
	base.lisp buffer-test.lisp buffer.lisp gui.lisp 
Log Message:
Rudi's change to delete-region (the relative order of marks should not
matter) and one more related to insertions at the end of buffer.

Date: Tue Jan 18 10:59:52 2005
Author: abakic

Index: climacs/base.lisp
diff -u climacs/base.lisp:1.20 climacs/base.lisp:1.21
--- climacs/base.lisp:1.20	Tue Jan 18 05:53:28 2005
+++ climacs/base.lisp	Tue Jan 18 10:59:51 2005
@@ -182,13 +182,13 @@
   "Delete until the end of the word"
   (let ((mark2 (clone-mark mark)))
     (forward-word mark2)
-    (delete-range mark (- (offset mark2) (offset mark)))))
+    (delete-region mark mark2)))
 
 (defun backward-delete-word (mark)
   "Delete until the beginning of the word"
   (let ((mark2 (clone-mark mark)))
     (backward-word mark2)
-    (delete-range mark (- (offset mark2) (offset mark)))))
+    (delete-region mark mark2)))
 
 (defun previous-word (mark)
   "Return a freshly allocated sequence, that is word before the mark"


Index: climacs/buffer-test.lisp
diff -u climacs/buffer-test.lisp:1.5 climacs/buffer-test.lisp:1.6
--- climacs/buffer-test.lisp:1.5	Sun Jan 16 09:58:13 2005
+++ climacs/buffer-test.lisp	Tue Jan 18 10:59:51 2005
@@ -4,9 +4,9 @@
 ;;; 
 
 (cl:defpackage :climacs-tests
-  (:use :rtest :climacs-buffer #+cmu :cl))
+  (:use :rtest :climacs-buffer :cl))
 
-(in-package :climacs-tests)
+(cl:in-package :climacs-tests)
 
 (deftest standard-buffer-make-instance.test-1
   (let* ((buffer (make-instance 'standard-buffer))
@@ -302,13 +302,13 @@
 	  (m2 (make-instance 'standard-left-sticky-mark
 			     :buffer buffer :offset 5)))
       (delete-region m2 m)
-      (and (= (size buffer) 7)
+      (and (= (size buffer) 5)
 	   (eq (buffer m) buffer)
 	   (eq (buffer m2) buffer)
 	   (= (offset m) 3)
-	   (= (offset m2) 5)
-	   (buffer-sequence buffer 0 7))))
-  "climacs")
+	   (= (offset m2) 3)
+	   (buffer-sequence buffer 0 5))))
+  "clics")
 
 (deftest standard-buffer-delete-region.test-4
   (let ((buffer (make-instance 'standard-buffer)))
@@ -318,13 +318,13 @@
 	  (m2 (make-instance 'standard-right-sticky-mark
 			     :buffer buffer :offset 5)))
       (delete-region m2 m)
-      (and (= (size buffer) 7)
+      (and (= (size buffer) 5)
 	   (eq (buffer m) buffer)
 	   (eq (buffer m2) buffer)
 	   (= (offset m) 3)
-	   (= (offset m2) 5)
-	   (buffer-sequence buffer 0 7))))
-  "climacs")
+	   (= (offset m2) 3)
+	   (buffer-sequence buffer 0 5))))
+  "clics")
 
 (deftest standard-buffer-delete-region.test-5
   (handler-case


Index: climacs/buffer.lisp
diff -u climacs/buffer.lisp:1.22 climacs/buffer.lisp:1.23
--- climacs/buffer.lisp:1.22	Tue Jan 18 02:11:29 2005
+++ climacs/buffer.lisp	Tue Jan 18 10:59:51 2005
@@ -124,15 +124,9 @@
 returned.  Otherwise type is the name of a class (subclass of the mark
 class) to be used as a class of the clone."))
 
-(defmethod clone-mark ((mark standard-left-sticky-mark) &optional type)
-  (unless type
-    (setf type 'standard-left-sticky-mark))
-  (make-instance type :buffer (buffer mark) :offset (offset mark)))
-
-(defmethod clone-mark ((mark standard-right-sticky-mark) &optional type)
-  (unless type
-    (setf type 'standard-right-sticky-mark))
-  (make-instance type :buffer (buffer mark) :offset (offset mark)))
+(defmethod clone-mark ((mark mark) &optional type)
+  (make-instance (or type (class-of mark))
+                 :buffer (buffer mark) :offset (offset mark)))
 
 (define-condition no-such-offset (simple-error)
   ((offset :reader condition-offset :initarg :offset))
@@ -392,32 +386,30 @@
 	(t nil)))
 
 (defgeneric delete-region (mark1 mark2)
-  (:documentation "Delete the objects in the buffer that are after mark1 and before
-mark2.  An error is signaled if the two marks are positioned in
-different buffers.  If mark1 is positioned at an offset equal to or
-greater than that of mark2, no objects are deleted.  If objects are
-to be deleted, this function calls delete-buffer-range with the
-appropriate arguments.  It is acceptable to pass an offset in place
-of one of the marks."))
+  (:documentation "Delete the objects in the buffer that are
+between mark1 and mark2.  An error is signaled if the two marks
+are positioned in different buffers.  It is acceptable to pass an
+offset in place of one of the marks."))
 
 (defmethod delete-region ((mark1 mark-mixin) (mark2 mark-mixin))
   (assert (eq (buffer mark1) (buffer mark2)))
-  (when (> (offset mark2) (offset mark1))
-    (delete-buffer-range (buffer mark1)
-			 (offset mark1)
-			 (- (offset mark2) (offset mark1)))))
+  (let ((offset1 (offset mark1))
+        (offset2 (offset mark2)))
+    (when (> offset1 offset2)
+      (rotatef offset1 offset2))
+    (delete-buffer-range (buffer mark1) offset1 (- offset2 offset1))))
 
 (defmethod delete-region ((mark1 mark-mixin) offset2)
-  (when (> offset2 (offset mark1))
-    (delete-buffer-range (buffer mark1)
-			 (offset mark1)
-			 (- offset2 (offset mark1)))))
+  (let ((offset1 (offset mark1)))
+    (when (> offset1 offset2)
+      (rotatef offset1 offset2))
+    (delete-buffer-range (buffer mark1) offset1 (- offset2 offset1))))
 
 (defmethod delete-region (offset1 (mark2 mark-mixin))
-  (when (> (offset mark2) offset1)
-    (delete-buffer-range (buffer mark2)
-			 offset1
-			 (- (offset mark2) offset1))))
+  (let ((offset2 (offset mark2)))
+    (when (> offset1 offset2)
+      (rotatef offset1 offset2))
+    (delete-buffer-range (buffer mark2) offset1 (- offset2 offset1))))
 
 (defgeneric buffer-object (buffer offset)
   (:documentation "Return the object at the offset in the buffer.  The first object


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.81 climacs/gui.lisp:1.82
--- climacs/gui.lisp:1.81	Mon Jan 17 22:55:47 2005
+++ climacs/gui.lisp	Tue Jan 18 10:59:51 2005
@@ -340,10 +340,10 @@
       ;; If the current line is at the end of the buffer, we want to
       ;; be able to insert past it, so we need to get an extra line
       ;; at the end.
-      (when (progn (end-of-line point)
-                   (end-of-buffer-p point))
+      (end-of-line point)
+      (when (end-of-buffer-p point)
         (insert-object point #\Newline))
-      (next-line point)
+      (next-line point 0)
       (insert-sequence point line)
       (insert-object point #\Newline))))