[climacs-cvs] CVS update: climacs/base-test.lisp climacs/base.lisp climacs/buffer-test.lisp climacs/gui.lisp
Aleksandar Bakic
abakic at common-lisp.net
Fri Jan 28 18:47:36 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv31513
Modified Files:
base-test.lisp base.lisp buffer-test.lisp gui.lisp
Log Message:
Changed downcase, upcase and capitalize methods to be symmetrical wrt. marks.
Added (setf buffer-object) methods to binseq-buffer and obinseq-buffer.
More tests and comments.
Date: Fri Jan 28 10:47:31 2005
Author: abakic
Index: climacs/base-test.lisp
diff -u climacs/base-test.lisp:1.2 climacs/base-test.lisp:1.3
--- climacs/base-test.lisp:1.2 Mon Jan 24 15:53:52 2005
+++ climacs/base-test.lisp Fri Jan 28 10:47:29 2005
@@ -621,4 +621,152 @@
(climacs-base::previous-word m0)
(climacs-base::previous-word m1)
(climacs-base::previous-word m2))))
- "climacs" #() "cl")
\ No newline at end of file
+ "climacs" #() "cl")
+
+(deftest standard-buffer-downcase-buffer-region.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "Cli mac5")
+ (climacs-base::downcase-buffer-region buffer 0 (size buffer))
+ (buffer-sequence buffer 0 (size buffer)))
+ "cli mac5")
+
+(deftest standard-buffer-downcase-region.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-left-sticky-mark
+ :buffer buffer :offset 1))
+ (m2 (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 8)))
+ (downcase-region m2 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_cli mac5_")
+
+(deftest standard-buffer-downcase-region.test-2
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 1)))
+ (downcase-region 8 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_cli mac5_")
+
+(deftest standard-buffer-downcase-region.test-3
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-left-sticky-mark
+ :buffer buffer :offset 8)))
+ (downcase-region 1 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_cli mac5_")
+
+(deftest standard-buffer-downcase-word.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "CLI MA CS")
+ (let ((m (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 0)))
+ (downcase-word m 3)
+ (values
+ (buffer-sequence buffer 0 (size buffer))
+ (offset m))))
+ "cli ma cs" 9)
+
+(deftest standard-buffer-upcase-buffer-region.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "Cli mac5")
+ (climacs-base::upcase-buffer-region buffer 0 (size buffer))
+ (buffer-sequence buffer 0 (size buffer)))
+ "CLI MAC5")
+
+(deftest standard-buffer-upcase-region.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-left-sticky-mark
+ :buffer buffer :offset 1))
+ (m2 (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 8)))
+ (upcase-region m2 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_CLI MAC5_")
+
+(deftest standard-buffer-upcase-region.test-2
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 1)))
+ (upcase-region 8 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_CLI MAC5_")
+
+(deftest standard-buffer-upcase-region.test-3
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-left-sticky-mark
+ :buffer buffer :offset 8)))
+ (upcase-region 1 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_CLI MAC5_")
+
+(deftest standard-buffer-upcase-word.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "cli ma cs")
+ (let ((m (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 0)))
+ (upcase-word m 3)
+ (values
+ (buffer-sequence buffer 0 (size buffer))
+ (offset m))))
+ "CLI MA CS" 9)
+
+(deftest standard-buffer-capitalize-buffer-region.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "cli ma cs")
+ (climacs-base::capitalize-buffer-region buffer 1 (size buffer))
+ (buffer-sequence buffer 0 (size buffer)))
+ "cli Ma Cs")
+
+(deftest standard-buffer-capitalize-buffer-region.test-2
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "CLI mA Cs")
+ (climacs-base::capitalize-buffer-region buffer 0 (size buffer))
+ (buffer-sequence buffer 0 (size buffer)))
+ "Cli Ma Cs")
+
+(deftest standard-buffer-capitalize-region.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-left-sticky-mark
+ :buffer buffer :offset 1))
+ (m2 (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 8)))
+ (capitalize-region m2 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_Cli Mac5_")
+
+(deftest standard-buffer-capitalize-region.test-2
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 1)))
+ (capitalize-region 8 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_Cli Mac5_")
+
+(deftest standard-buffer-capitalize-region.test-3
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "_Cli mac5_")
+ (let ((m1 (make-instance 'standard-left-sticky-mark
+ :buffer buffer :offset 8)))
+ (capitalize-region 1 m1)
+ (buffer-sequence buffer 0 (size buffer))))
+ "_Cli Mac5_")
+
+(deftest standard-buffer-capitalize-word.test-1
+ (let ((buffer (make-instance 'standard-buffer)))
+ (insert-buffer-sequence buffer 0 "cli ma cs")
+ (let ((m (make-instance 'standard-right-sticky-mark
+ :buffer buffer :offset 0)))
+ (capitalize-word m 3)
+ (values
+ (buffer-sequence buffer 0 (size buffer))
+ (offset m))))
+ "Cli Ma Cs" 9)
Index: climacs/base.lisp
diff -u climacs/base.lisp:1.25 climacs/base.lisp:1.26
--- climacs/base.lisp:1.25 Mon Jan 24 15:53:52 2005
+++ climacs/base.lisp Fri Jan 28 10:47:29 2005
@@ -217,6 +217,8 @@
;;;
;;; Character case
+;;; I'd rather have update-buffer-range methods spec. on buffer for this,
+;;; for performance and history-size reasons --amb
(defun downcase-buffer-region (buffer offset1 offset2)
(do-buffer-region (object offset buffer offset1 offset2)
(when (and (constituentp object) (upper-case-p object))
@@ -229,13 +231,23 @@
(defmethod downcase-region ((mark1 mark) (mark2 mark))
(assert (eq (buffer mark1) (buffer mark2)))
- (downcase-buffer-region (buffer mark1) (offset mark1) (offset mark2)))
-
-(defmethod downcase-region ((offset integer) (mark mark))
- (downcase-buffer-region (buffer mark) offset (offset mark)))
-
-(defmethod downcase-region ((mark mark) (offset integer))
- (downcase-buffer-region (buffer mark) (offset mark) offset))
+ (let ((offset1 (offset mark1))
+ (offset2 (offset mark2)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (downcase-buffer-region (buffer mark1) offset1 offset2)))
+
+(defmethod downcase-region ((offset1 integer) (mark2 mark))
+ (let ((offset2 (offset mark2)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (downcase-buffer-region (buffer mark2) offset1 offset2)))
+
+(defmethod downcase-region ((mark1 mark) (offset2 integer))
+ (let ((offset1 (offset mark1)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (downcase-buffer-region (buffer mark1) offset1 offset2)))
(defun downcase-word (mark &optional (n 1))
"Convert the next N words to lowercase, leaving mark after the last word."
@@ -257,13 +269,23 @@
(defmethod upcase-region ((mark1 mark) (mark2 mark))
(assert (eq (buffer mark1) (buffer mark2)))
- (upcase-buffer-region (buffer mark1) (offset mark1) (offset mark2)))
-
-(defmethod upcase-region ((offset integer) (mark mark))
- (upcase-buffer-region (buffer mark) offset (offset mark)))
-
-(defmethod upcase-region ((mark mark) (offset integer))
- (upcase-buffer-region (buffer mark) (offset mark) offset))
+ (let ((offset1 (offset mark1))
+ (offset2 (offset mark2)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (upcase-buffer-region (buffer mark1) offset1 offset2)))
+
+(defmethod upcase-region ((offset1 integer) (mark2 mark))
+ (let ((offset2 (offset mark2)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (upcase-buffer-region (buffer mark2) offset1 offset2)))
+
+(defmethod upcase-region ((mark1 mark) (offset2 integer))
+ (let ((offset1 (offset mark1)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (upcase-buffer-region (buffer mark1) offset1 offset2)))
(defun upcase-word (mark &optional (n 1))
"Convert the next N words to uppercase, leaving mark after the last word."
@@ -293,13 +315,23 @@
(defmethod capitalize-region ((mark1 mark) (mark2 mark))
(assert (eq (buffer mark1) (buffer mark2)))
- (capitalize-buffer-region (buffer mark1) (offset mark1) (offset mark2)))
-
-(defmethod capitalize-region ((offset integer) (mark mark))
- (capitalize-buffer-region (buffer mark) offset (offset mark)))
-
-(defmethod capitalize-region ((mark mark) (offset integer))
- (capitalize-buffer-region (buffer mark) (offset mark) offset))
+ (let ((offset1 (offset mark1))
+ (offset2 (offset mark2)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (capitalize-buffer-region (buffer mark1) offset1 offset2)))
+
+(defmethod capitalize-region ((offset1 integer) (mark2 mark))
+ (let ((offset2 (offset mark2)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (capitalize-buffer-region (buffer mark2) offset1 offset2)))
+
+(defmethod capitalize-region ((mark1 mark) (offset2 integer))
+ (let ((offset1 (offset mark1)))
+ (when (> offset1 offset2)
+ (rotatef offset1 offset2))
+ (capitalize-buffer-region (buffer mark1) offset1 offset2)))
(defun capitalize-word (mark &optional (n 1))
"Capitalize the next N words, leaving mark after the last word."
Index: climacs/buffer-test.lisp
diff -u climacs/buffer-test.lisp:1.9 climacs/buffer-test.lisp:1.10
--- climacs/buffer-test.lisp:1.9 Mon Jan 24 15:53:52 2005
+++ climacs/buffer-test.lisp Fri Jan 28 10:47:29 2005
@@ -61,22 +61,37 @@
(deftest standard-buffer-insert-buffer-object.test-1
(let ((buffer (make-instance 'standard-buffer)))
(insert-buffer-object buffer 0 #\a)
- (and (= (size buffer) 1) (buffer-sequence buffer 0 1)))
- "a")
+ (values
+ (offset (low-mark buffer))
+ (offset (high-mark buffer))
+ (modified-p buffer)
+ (size buffer)
+ (buffer-sequence buffer 0 1)))
+ 0 1 t 1 "a")
(deftest standard-buffer-insert-buffer-object.test-2
(let ((buffer (make-instance 'standard-buffer)))
(insert-buffer-object buffer 0 #\b)
(insert-buffer-object buffer 0 #\a)
- (and (= (size buffer) 2) (buffer-sequence buffer 0 2)))
- "ab")
+ (values
+ (offset (low-mark buffer))
+ (offset (high-mark buffer))
+ (modified-p buffer)
+ (size buffer)
+ (buffer-sequence buffer 0 2)))
+ 0 2 t 2 "ab")
(deftest standard-buffer-insert-buffer-object.test-3
(let ((buffer (make-instance 'standard-buffer)))
(insert-buffer-object buffer 0 #\b)
(insert-buffer-object buffer 1 #\a)
- (and (= (size buffer) 2) (buffer-sequence buffer 0 2)))
- "ba")
+ (values
+ (offset (low-mark buffer))
+ (offset (high-mark buffer))
+ (modified-p buffer)
+ (size buffer)
+ (buffer-sequence buffer 0 2)))
+ 0 2 t 2 "ba")
(deftest standard-buffer-insert-buffer-object.test-4
(handler-case
@@ -140,15 +155,24 @@
(let ((buffer (make-instance 'standard-buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(delete-buffer-range buffer 0 7)
- (size buffer))
- 0)
+ (values
+ (offset (low-mark buffer))
+ (offset (high-mark buffer))
+ (modified-p buffer)
+ (size buffer)))
+ 0 0 t 0)
(deftest standard-buffer-delete-buffer-range.test-2
(let ((buffer (make-instance 'standard-buffer)))
(insert-buffer-sequence buffer 0 "climacs")
(delete-buffer-range buffer 0 3)
- (and (= (size buffer) 4) (buffer-sequence buffer 0 4)))
- "macs")
+ (values
+ (offset (low-mark buffer))
+ (offset (high-mark buffer))
+ (modified-p buffer)
+ (size buffer)
+ (buffer-sequence buffer 0 4)))
+ 0 4 t 4 "macs")
(deftest standard-buffer-delete-buffer-range.test-3
(let ((buffer (make-instance 'standard-buffer)))
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.100 climacs/gui.lisp:1.101
--- climacs/gui.lisp:1.100 Wed Jan 26 14:49:46 2005
+++ climacs/gui.lisp Fri Jan 28 10:47:29 2005
@@ -478,16 +478,16 @@
(backward-delete-word (point (current-window))))
(define-named-command com-upcase-region ()
- (multiple-value-bind (start end) (region-limits (current-window))
- (upcase-region start end)))
+ (let ((cw (current-window)))
+ (upcase-region (mark cw) (point cw))))
(define-named-command com-downcase-region ()
- (multiple-value-bind (start end) (region-limits (current-window))
- (downcase-region start end)))
+ (let ((cw (current-window)))
+ (downcase-region (mark cw) (point cw))))
(define-named-command com-capitalize-region ()
- (multiple-value-bind (start end) (region-limits (current-window))
- (capitalize-region start end)))
+ (let ((cw (current-window)))
+ (capitalize-region (mark cw) (point cw))))
(define-named-command com-upcase-word ()
(upcase-word (point (current-window))))
More information about the Climacs-cvs
mailing list