[climacs-cvs] CVS update: climacs/base.lisp climacs/buffer-test.lisp climacs/buffer.lisp climacs/gui.lisp
Aleksandar Bakic
abakic at common-lisp.net
Tue Jan 18 18:59:55 UTC 2005
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))))
More information about the Climacs-cvs
mailing list