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