[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