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))))