climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[climacs-cvs] CVS update: climacs/base-test.lisp
by abakic＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv20755 Modified Files: base-test.lisp Log Message: Test updates. Date: Sat Jan 29 14:23:09 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.3 climacs/base-test.lisp:1.4 --- climacs/base-test.lisp:1.3 Fri Jan 28 10:47:29 2005 +++ climacs/base-test.lisp Sat Jan 29 14:23:08 2005 @@ -577,10 +577,10 @@ (deftest standard-buffer-delete-word.test-2 (let ((buffer (make-instance 'standard-buffer))) - (insert-buffer-sequence buffer 0 " climacs") + (insert-buffer-sequence buffer 0 " climacs climacs") (let ((m (make-instance 'standard-right-sticky-mark :buffer buffer :offset 0))) - (delete-word m) + (delete-word m 2) (values (buffer-sequence buffer 0 (size buffer)) (offset m)))) @@ -599,10 +599,10 @@ (deftest standard-buffer-backward-delete-word.test-2 (let ((buffer (make-instance 'standard-buffer))) - (insert-buffer-sequence buffer 0 "climacs ") + (insert-buffer-sequence buffer 0 "climacs climacs ") (let ((m (make-instance 'standard-right-sticky-mark - :buffer buffer :offset 9))) - (backward-delete-word m) + :buffer buffer :offset 17))) + (backward-delete-word m 2) (values (buffer-sequence buffer 0 (size buffer)) (offset m)))) @@ -625,10 +625,10 @@ (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)) + (insert-buffer-sequence buffer 0 "CLi mac5") + (climacs-base::downcase-buffer-region buffer 1 (size buffer)) (buffer-sequence buffer 0 (size buffer))) - "cli mac5") + "Cli mac5") (deftest standard-buffer-downcase-region.test-1 (let ((buffer (make-instance 'standard-buffer))) @@ -661,21 +661,21 @@ (deftest standard-buffer-downcase-word.test-1 (let ((buffer (make-instance 'standard-buffer))) - (insert-buffer-sequence buffer 0 "CLI MA CS") + (insert-buffer-sequence buffer 0 "CLI MA CS CLIMACS") (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) + "cli ma cs CLIMACS" 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)) + (insert-buffer-sequence buffer 0 "cli mac5") + (climacs-base::upcase-buffer-region buffer 1 (size buffer)) (buffer-sequence buffer 0 (size buffer))) - "CLI MAC5") + "cLI MAC5") (deftest standard-buffer-upcase-region.test-1 (let ((buffer (make-instance 'standard-buffer))) @@ -708,21 +708,21 @@ (deftest standard-buffer-upcase-word.test-1 (let ((buffer (make-instance 'standard-buffer))) - (insert-buffer-sequence buffer 0 "cli ma cs") + (insert-buffer-sequence buffer 0 "cli ma cs climacs") (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) + "CLI MA CS climacs" 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") + "cLi Ma Cs") (deftest standard-buffer-capitalize-buffer-region.test-2 (let ((buffer (make-instance 'standard-buffer))) @@ -762,11 +762,11 @@ (deftest standard-buffer-capitalize-word.test-1 (let ((buffer (make-instance 'standard-buffer))) - (insert-buffer-sequence buffer 0 "cli ma cs") + (insert-buffer-sequence buffer 0 "cli ma cs climacs") (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) + "Cli Ma Cs climacs" 9)

1 0

[climacs-cvs] CVS update: climacs/base.lisp
by mvilleneuve＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25515 Modified Files: base.lisp Log Message: Fixed capitalize-buffer-region's behavior Date: Sat Jan 29 05:16:25 2005 Author: mvilleneuve Index: climacs/base.lisp diff -u climacs/base.lisp:1.28 climacs/base.lisp:1.29 --- climacs/base.lisp:1.28 Fri Jan 28 23:05:42 2005 +++ climacs/base.lisp Sat Jan 29 05:16:25 2005 @@ -298,9 +298,7 @@ (upcase-region offset mark)))) (defun capitalize-buffer-region (buffer offset1 offset2) - (let ((previous-char-constituent-p - (and (plusp offset1) - (constituentp (buffer-object buffer (1- offset1)))))) + (let ((previous-char-constituent-p nil)) (do-buffer-region (object offset buffer offset1 offset2) (when (constituentp object) (if previous-char-constituent-p

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp
by rstrandh＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv6295 Modified Files: base.lisp gui.lisp Log Message: The functions delete-word and backward-delete-word now take an optional count argument. The corresponding Climacs commands now accept numeric arguments. Date: Fri Jan 28 23:05:42 2005 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.27 climacs/base.lisp:1.28 --- climacs/base.lisp:1.27 Fri Jan 28 22:53:44 2005 +++ climacs/base.lisp Fri Jan 28 23:05:42 2005 @@ -194,16 +194,16 @@ while (constituentp (object-before mark)) do (decf (offset mark))))) -(defun delete-word (mark) +(defun delete-word (mark &optional (count 1)) "Delete until the end of the word" (let ((mark2 (clone-mark mark))) - (forward-word mark2) + (forward-word mark2 count) (delete-region mark mark2))) -(defun backward-delete-word (mark) +(defun backward-delete-word (mark &optional (count 1)) "Delete until the beginning of the word" (let ((mark2 (clone-mark mark))) - (backward-word mark2) + (backward-word mark2 count) (delete-region mark mark2))) (defun previous-word (mark) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.102 climacs/gui.lisp:1.103 --- climacs/gui.lisp:1.102 Fri Jan 28 22:53:44 2005 +++ climacs/gui.lisp Fri Jan 28 23:05:42 2005 @@ -471,11 +471,11 @@ (define-named-command com-backward-word ((count 'integer :prompt "Number of words")) (backward-word (point (current-window)) count)) -(define-named-command com-delete-word () - (delete-word (point (current-window)))) +(define-named-command com-delete-word ((count 'integer :prompt "Number of words")) + (delete-word (point (current-window)) count)) -(define-named-command com-backward-delete-word () - (backward-delete-word (point (current-window)))) +(define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words")) + (backward-delete-word (point (current-window)) count)) (define-named-command com-upcase-region () (let ((cw (current-window))) @@ -1284,8 +1284,8 @@ (global-set-key '(#\m :meta) 'com-back-to-indentation) (global-set-key '(#\^ :shift :meta) 'com-delete-indentation) (global-set-key '(#\q :meta) 'com-fill-paragraph) -(global-set-key '(#\d :meta) 'com-delete-word) -(global-set-key '(#\Backspace :meta) 'com-backward-delete-word) +(global-set-key '(#\d :meta) `(com-delete-word ,*numeric-argument-marker*)) +(global-set-key '(#\Backspace :meta) `(com-backward-delete-word ,*numeric-argument-marker*)) (global-set-key '(#\/ :meta) 'com-dabbrev-expand) (global-set-key '(#\a :control :meta) 'com-beginning-of-paragraph) (global-set-key '(#\e :control :meta) 'com-end-of-paragraph)

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp
by rstrandh＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5499 Modified Files: base.lisp gui.lisp Log Message: The functions forward-word and backward-word now thake an optional count argument. The corresponding Climacs command now accept numeric arguments. Date: Fri Jan 28 22:53:45 2005 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.26 climacs/base.lisp:1.27 --- climacs/base.lisp:1.26 Fri Jan 28 10:47:29 2005 +++ climacs/base.lisp Fri Jan 28 22:53:44 2005 @@ -178,19 +178,21 @@ until (constituentp (object-before mark)) do (decf (offset mark)))) -(defun forward-word (mark) +(defun forward-word (mark &optional (count 1)) "Forward the mark to the next word." - (forward-to-word-boundary mark) - (loop until (end-of-buffer-p mark) - while (constituentp (object-after mark)) - do (incf (offset mark)))) + (loop repeat count + do (forward-to-word-boundary mark) + (loop until (end-of-buffer-p mark) + while (constituentp (object-after mark)) + do (incf (offset mark))))) -(defun backward-word (mark) +(defun backward-word (mark &optional (count 1)) "Shuttle the mark to the start of the previous word." - (backward-to-word-boundary mark) - (loop until (beginning-of-buffer-p mark) - while (constituentp (object-before mark)) - do (decf (offset mark)))) + (loop repeat count + do (backward-to-word-boundary mark) + (loop until (beginning-of-buffer-p mark) + while (constituentp (object-before mark)) + do (decf (offset mark))))) (defun delete-word (mark) "Delete until the end of the word" Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.101 climacs/gui.lisp:1.102 --- climacs/gui.lisp:1.101 Fri Jan 28 10:47:29 2005 +++ climacs/gui.lisp Fri Jan 28 22:53:44 2005 @@ -465,11 +465,11 @@ (region-to-sequence mark point))) (delete-region mark point))) -(define-named-command com-forward-word () - (forward-word (point (current-window)))) +(define-named-command com-forward-word ((count 'integer :prompt "Number of words")) + (forward-word (point (current-window)) count)) -(define-named-command com-backward-word () - (backward-word (point (current-window)))) +(define-named-command com-backward-word ((count 'integer :prompt "Number of words")) + (backward-word (point (current-window)) count)) (define-named-command com-delete-word () (delete-word (point (current-window)))) @@ -1268,8 +1268,8 @@ (global-set-key '(#\Space :control) 'com-set-mark) (global-set-key '(#\y :control) 'com-yank) (global-set-key '(#\w :control) 'com-cut-out) -(global-set-key '(#\f :meta) 'com-forward-word) -(global-set-key '(#\b :meta) 'com-backward-word) +(global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*)) +(global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*)) (global-set-key '(#\t :meta) 'com-transpose-words) (global-set-key '(#\u :meta) 'com-upcase-word) (global-set-key '(#\l :meta) 'com-downcase-word) @@ -1297,8 +1297,8 @@ (global-set-key '(:down) 'com-next-line) (global-set-key '(:left) `(com-backward-object ,*numeric-argument-marker*)) (global-set-key '(:right) `(com-forward-object ,*numeric-argument-marker*)) -(global-set-key '(:left :control) 'com-backward-word) -(global-set-key '(:right :control) 'com-forward-word) +(global-set-key '(:left :control) `(com-backward-word ,*numeric-argument-marker*)) +(global-set-key '(:right :control) `(com-forward-word ,*numeric-argument-marker*)) (global-set-key '(:home) 'com-beginning-of-line) (global-set-key '(:end) 'com-end-of-line) (global-set-key '(:prior) 'com-page-up)

1 0

[climacs-cvs] CVS update: climacs/Persistent/README climacs/Persistent/persistent-base-test.lisp climacs/Persistent/persistent-buffer-test.lisp climacs/Persistent/persistent-buffer.lisp
by abakic＠common-lisp.net 28 Jan '05

28 Jan '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv31513/Persistent Modified Files: README persistent-base-test.lisp persistent-buffer-test.lisp persistent-buffer.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:37 2005 Author: abakic Index: climacs/Persistent/README diff -u climacs/Persistent/README:1.1 climacs/Persistent/README:1.2 --- climacs/Persistent/README:1.1 Wed Jan 26 08:10:45 2005 +++ climacs/Persistent/README Fri Jan 28 10:47:34 2005 @@ -20,8 +20,8 @@ (setf (offset mark) offset))) (It is currently "broken" for performance reasons.) Until then, -(o)binseq-end-of-line and (o)binseq-next-line tests will fail (20 of -them). +(o)binseq-end-of-line, (o)binseq-next-line and (o)binseq-kill-line +tests will fail (20 of them). NOTE: There is a dependency of Persistent/persistent-buffer.lisp on Flexichain/utilities.lisp (the weak pointer handling). Index: climacs/Persistent/persistent-base-test.lisp diff -u climacs/Persistent/persistent-base-test.lisp:1.2 climacs/Persistent/persistent-base-test.lisp:1.3 --- climacs/Persistent/persistent-base-test.lisp:1.2 Wed Jan 26 10:28:56 2005 +++ climacs/Persistent/persistent-base-test.lisp Fri Jan 28 10:47:34 2005 @@ -620,6 +620,154 @@ (climacs-base::previous-word m2)))) "climacs" #() "cl") +(deftest binseq-buffer-downcase-buffer-region.test-1 + (let ((buffer (make-instance 'binseq-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 binseq-buffer-downcase-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 8))) + (downcase-region m2 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_cli mac5_") + +(deftest binseq-buffer-downcase-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 1))) + (downcase-region 8 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_cli mac5_") + +(deftest binseq-buffer-downcase-region.test-3 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 8))) + (downcase-region 1 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_cli mac5_") + +(deftest binseq-buffer-downcase-word.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "CLI MA CS") + (let ((m (make-instance 'persistent-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 binseq-buffer-upcase-buffer-region.test-1 + (let ((buffer (make-instance 'binseq-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 binseq-buffer-upcase-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 8))) + (upcase-region m2 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_CLI MAC5_") + +(deftest binseq-buffer-upcase-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 1))) + (upcase-region 8 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_CLI MAC5_") + +(deftest binseq-buffer-upcase-region.test-3 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 8))) + (upcase-region 1 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_CLI MAC5_") + +(deftest binseq-buffer-upcase-word.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "cli ma cs") + (let ((m (make-instance 'persistent-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 binseq-buffer-capitalize-buffer-region.test-1 + (let ((buffer (make-instance 'binseq-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 binseq-buffer-capitalize-buffer-region.test-2 + (let ((buffer (make-instance 'binseq-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 binseq-buffer-capitalize-region.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 8))) + (capitalize-region m2 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_Cli Mac5_") + +(deftest binseq-buffer-capitalize-region.test-2 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 1))) + (capitalize-region 8 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_Cli Mac5_") + +(deftest binseq-buffer-capitalize-region.test-3 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 8))) + (capitalize-region 1 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_Cli Mac5_") + +(deftest binseq-buffer-capitalize-word.test-1 + (let ((buffer (make-instance 'binseq-buffer))) + (insert-buffer-sequence buffer 0 "cli ma cs") + (let ((m (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 0))) + (capitalize-word m 3) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + "Cli Ma Cs" 9) + ;;; obinseq tests (deftest obinseq-buffer-previous-line.test-1 @@ -1219,3 +1367,151 @@ (climacs-base::previous-word m1) (climacs-base::previous-word m2)))) "climacs" #() "cl") + +(deftest obinseq-buffer-downcase-buffer-region.test-1 + (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-downcase-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 8))) + (downcase-region m2 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_cli mac5_") + +(deftest obinseq-buffer-downcase-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 1))) + (downcase-region 8 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_cli mac5_") + +(deftest obinseq-buffer-downcase-region.test-3 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 8))) + (downcase-region 1 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_cli mac5_") + +(deftest obinseq-buffer-downcase-word.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "CLI MA CS") + (let ((m (make-instance 'persistent-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 obinseq-buffer-upcase-buffer-region.test-1 + (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-upcase-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 8))) + (upcase-region m2 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_CLI MAC5_") + +(deftest obinseq-buffer-upcase-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 1))) + (upcase-region 8 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_CLI MAC5_") + +(deftest obinseq-buffer-upcase-region.test-3 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 8))) + (upcase-region 1 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_CLI MAC5_") + +(deftest obinseq-buffer-upcase-word.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "cli ma cs") + (let ((m (make-instance 'persistent-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 obinseq-buffer-capitalize-buffer-region.test-1 + (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-capitalize-buffer-region.test-2 + (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-capitalize-region.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 8))) + (capitalize-region m2 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_Cli Mac5_") + +(deftest obinseq-buffer-capitalize-region.test-2 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 1))) + (capitalize-region 8 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_Cli Mac5_") + +(deftest obinseq-buffer-capitalize-region.test-3 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "_Cli mac5_") + (let ((m1 (make-instance 'persistent-left-sticky-mark + :buffer buffer :offset 8))) + (capitalize-region 1 m1) + (buffer-sequence buffer 0 (size buffer)))) + "_Cli Mac5_") + +(deftest obinseq-buffer-capitalize-word.test-1 + (let ((buffer (make-instance 'obinseq-buffer))) + (insert-buffer-sequence buffer 0 "cli ma cs") + (let ((m (make-instance 'persistent-right-sticky-mark + :buffer buffer :offset 0))) + (capitalize-word m 3) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + "Cli Ma Cs" 9) \ No newline at end of file Index: climacs/Persistent/persistent-buffer-test.lisp diff -u climacs/Persistent/persistent-buffer-test.lisp:1.2 climacs/Persistent/persistent-buffer-test.lisp:1.3 --- climacs/Persistent/persistent-buffer-test.lisp:1.2 Wed Jan 26 10:28:56 2005 +++ climacs/Persistent/persistent-buffer-test.lisp Fri Jan 28 10:47:34 2005 @@ -75,22 +75,37 @@ (deftest binseq-buffer-insert-buffer-object.test-1 (let ((buffer (make-instance 'binseq-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 binseq-buffer-insert-buffer-object.test-2 (let ((buffer (make-instance 'binseq-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 binseq-buffer-insert-buffer-object.test-3 (let ((buffer (make-instance 'binseq-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 binseq-buffer-insert-buffer-object.test-4 (handler-case @@ -154,15 +169,24 @@ (let ((buffer (make-instance 'binseq-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 binseq-buffer-delete-buffer-range.test-2 (let ((buffer (make-instance 'binseq-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 binseq-buffer-delete-buffer-range.test-3 (let ((buffer (make-instance 'binseq-buffer))) @@ -780,22 +804,37 @@ (deftest obinseq-buffer-insert-buffer-object.test-1 (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-insert-buffer-object.test-2 (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-insert-buffer-object.test-3 (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-insert-buffer-object.test-4 (handler-case @@ -859,15 +898,24 @@ (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-delete-buffer-range.test-2 (let ((buffer (make-instance 'obinseq-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 obinseq-buffer-delete-buffer-range.test-3 (let ((buffer (make-instance 'obinseq-buffer))) Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.2 climacs/Persistent/persistent-buffer.lisp:1.3 --- climacs/Persistent/persistent-buffer.lisp:1.2 Wed Jan 26 10:28:56 2005 +++ climacs/Persistent/persistent-buffer.lisp Fri Jan 28 10:47:36 2005 @@ -197,10 +197,22 @@ (make-condition 'no-such-offset :offset offset)) (binseq-get (slot-value buffer 'contents) offset)) +(defmethod (setf buffer-object) (object (buffer binseq-buffer) offset) + (assert (<= 0 offset (1- (size buffer))) () + (make-condition 'no-such-offset :offset offset)) + (setf (slot-value buffer 'contents) + (binseq-set (slot-value buffer 'contents) offset object))) + (defmethod buffer-object ((buffer obinseq-buffer) offset) (assert (<= 0 offset (1- (size buffer))) () (make-condition 'no-such-offset :offset offset)) (obinseq-get (slot-value buffer 'contents) offset)) + +(defmethod (setf buffer-object) (object (buffer obinseq-buffer) offset) + (assert (<= 0 offset (1- (size buffer))) () + (make-condition 'no-such-offset :offset offset)) + (setf (slot-value buffer 'contents) + (obinseq-set (slot-value buffer 'contents) offset object))) (defmethod buffer-sequence ((buffer binseq-buffer) offset1 offset2) (assert (<= 0 offset1 (size buffer)) ()

1 0

[climacs-cvs] CVS update: climacs/base-test.lisp climacs/base.lisp climacs/buffer-test.lisp climacs/gui.lisp
by abakic＠common-lisp.net 28 Jan '05

28 Jan '05

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

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp
by mvilleneuve＠common-lisp.net 26 Jan '05

26 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23005 Modified Files: gui.lisp packages.lisp pane.lisp Log Message: Added basic query-replace support. First humble try at command loop factoring Date: Wed Jan 26 14:49:47 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.99 climacs/gui.lisp:1.100 --- climacs/gui.lisp:1.99 Wed Jan 26 08:10:40 2005 +++ climacs/gui.lisp Wed Jan 26 14:49:46 2005 @@ -280,6 +280,32 @@ (setf (executingp *application-frame*) nil) (redisplay-frame-panes frame)))))) +(defmacro simple-command-loop (command-table loop-condition end-clauses) + (let ((gesture (gensym)) + (item (gensym)) + (command (gensym)) + (condition (gensym))) + `(progn + (redisplay-frame-panes *application-frame*) + (loop while ,loop-condition + as ,gesture = (climacs-read-gesture) + as ,item = (find-gestures (list ,gesture) ,command-table) + do (cond ((and ,item (eq (command-menu-item-type ,item) :command)) + (setf *current-gesture* ,gesture) + (let ((,command (command-menu-item-value ,item))) + (unless (consp ,command) + (setf ,command (list ,command))) + (handler-case + (execute-frame-command *application-frame* + ,command) + (error (,condition) + (beep) + (format *error-output* "~a~%" ,condition))))) + (t + (unread-gesture ,gesture) + ,@end-clauses)) + (redisplay-frame-panes *application-frame*))))) + (defun region-limits (pane) (if (mark< (mark pane) (point pane)) (values (mark pane) (point pane)) @@ -1006,24 +1032,9 @@ :search-string "" :search-mark (clone-mark point) :search-forward-p forwardp))) - (redisplay-frame-panes *application-frame*) - (loop while (isearch-mode pane) - as gesture = (climacs-read-gesture) - as item = (find-gestures (list gesture) 'isearch-climacs-table) - do (cond ((and item (eq (command-menu-item-type item) :command)) - (setf *current-gesture* gesture) - (let ((command (command-menu-item-value item))) - (unless (consp command) - (setf command (list command))) - (handler-case - (execute-frame-command *application-frame* command) - (error (condition) - (beep) - (format *error-output* "~a~%" condition))))) - (t - (unread-gesture gesture) - (setf (isearch-mode pane) nil))) - (redisplay-frame-panes *application-frame*)))) + (simple-command-loop 'isearch-climacs-table + (isearch-mode pane) + ((setf (isearch-mode pane) nil))))) (defun isearch-from-mark (pane mark string forwardp) (flet ((object-equal (x y) @@ -1104,6 +1115,56 @@ (define-named-command com-isearch-exit () (setf (isearch-mode (current-window)) nil)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Query replace + +(defun query-replace-find-next-match (mark string) + (let ((offset-before (offset mark))) + (search-forward mark string) + (/= (offset mark) offset-before))) + +(define-named-command com-query-replace () + (let* ((string1 (accept 'string :prompt "Query replace")) + (string2 (accept 'string + :prompt (format nil "Query replace ~A with" + string1))) + (pane (current-window)) + (point (point pane))) + (when (query-replace-find-next-match point string1) + (setf (query-replace-state pane) (make-instance 'query-replace-state + :string1 string1 + :string2 string2) + (query-replace-mode pane) t) + (simple-command-loop 'query-replace-climacs-table + (query-replace-mode pane) + ((setf (query-replace-mode pane) nil)))))) + +(define-named-command com-query-replace-replace () + (let* ((pane (current-window)) + (point (point pane)) + (state (query-replace-state pane)) + (string1-length (length (string1 state)))) + (backward-object point string1-length) + (delete-range point string1-length) + (insert-sequence point (string2 state)) + (unless (query-replace-find-next-match point (string1 state)) + (setf (query-replace-mode pane) nil)))) + +(define-named-command com-query-replace-skip () + (let* ((pane (current-window)) + (point (point pane)) + (state (query-replace-state pane))) + (unless (query-replace-find-next-match point (string1 state)) + (setf (query-replace-mode pane) nil)))) + +(define-named-command com-query-replace-exit () + (setf (query-replace-mode (current-window)) nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Undo/redo + (define-named-command com-undo () (undo (undo-tree (buffer (current-window))))) @@ -1230,6 +1291,7 @@ (global-set-key '(#\e :control :meta) 'com-end-of-paragraph) (global-set-key '(#\s :control) 'com-isearch-mode-forward) (global-set-key '(#\r :control) 'com-isearch-mode-backward) +(global-set-key '(#\% :shift :meta) 'com-query-replace) (global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line) @@ -1457,3 +1519,21 @@ (isearch-set-key '(#\Backspace) 'com-isearch-delete-char) (isearch-set-key '(#\s :control) 'com-isearch-forward) (isearch-set-key '(#\r :control) 'com-isearch-backward) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Query replace command table + +(make-command-table 'query-replace-climacs-table :errorp nil) + +(defun query-replace-set-key (gesture command) + (add-command-to-command-table command 'query-replace-climacs-table + :keystroke gesture :errorp nil)) + +(query-replace-set-key '(#\Newline) 'com-query-replace-exit) +(query-replace-set-key '(#\Space) 'com-query-replace-replace) +(query-replace-set-key '(#\Backspace) 'com-query-replace-skip) +(query-replace-set-key '(#\Rubout) 'com-query-replace-skip) +(query-replace-set-key '(#\q) 'com-query-replace-exit) +(query-replace-set-key '(#\y) 'com-query-replace-replace) +(query-replace-set-key '(#\n) 'com-query-replace-skip) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.41 climacs/packages.lisp:1.42 --- climacs/packages.lisp:1.41 Wed Jan 26 08:10:40 2005 +++ climacs/packages.lisp Wed Jan 26 14:49:47 2005 @@ -110,6 +110,8 @@ #:auto-fill-mode #:auto-fill-column #:isearch-state #:search-string #:search-mark #:search-forward-p #:isearch-mode #:isearch-states #:isearch-previous-string + #:query-replace-state #:string1 #:string2 + #:query-replace-mode #:with-undo #:url)) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.14 climacs/pane.lisp:1.15 --- climacs/pane.lisp:1.14 Wed Jan 26 08:10:41 2005 +++ climacs/pane.lisp Wed Jan 26 14:49:47 2005 @@ -146,6 +146,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Query replace + +(defclass query-replace-state () + ((string1 :initarg :string1 :accessor string1) + (string2 :initarg :string2 :accessor string2))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; View (defclass climacs-textual-view (textual-view tabify-mixin) @@ -180,6 +188,8 @@ (isearch-mode :initform nil :accessor isearch-mode) (isearch-states :initform '() :accessor isearch-states) (isearch-previous-string :initform nil :accessor isearch-previous-string) + (query-replace-mode :initform nil :accessor query-replace-mode) + (query-replace-state :initform nil :accessor query-replace-state) (full-redisplay-p :initform nil :accessor full-redisplay-p) (cache :initform (let ((cache (make-instance 'standard-flexichain))) (insert* cache 0 nil)

1 0

[climacs-cvs] CVS update: climacs/Persistent/persistent-base-test.lisp climacs/Persistent/persistent-buffer.lisp climacs/Persistent/persistent-buffer-test.lisp
by abakic＠common-lisp.net 26 Jan '05

26 Jan '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv9143 Modified Files: persistent-base-test.lisp persistent-buffer.lisp persistent-buffer-test.lisp Log Message: Cleanup and some more info. Date: Wed Jan 26 10:28:57 2005 Author: abakic Index: climacs/Persistent/persistent-base-test.lisp diff -u climacs/Persistent/persistent-base-test.lisp:1.1 climacs/Persistent/persistent-base-test.lisp:1.2 --- climacs/Persistent/persistent-base-test.lisp:1.1 Wed Jan 26 08:10:45 2005 +++ climacs/Persistent/persistent-base-test.lisp Wed Jan 26 10:28:56 2005 @@ -461,26 +461,6 @@ (number-of-lines-in-region 10 m2r)))) 1 1 1 1 0 0 0 1 1) -(deftest constituentp.test-1 ; NOTE: more tests may be needed for sbcl - (values - (constituentp #\a) - (constituentp #\Newline) - (constituentp #\Space) - (constituentp #\Tab) - (constituentp "a") - (constituentp #\Null)) - t nil nil nil nil nil) - -(deftest whitespacep.test-1 - (values - (not (null (whitespacep #\a))) - (not (null (whitespacep #\Newline))) - (not (null (whitespacep #\Space))) - (not (null (whitespacep #\Tab))) - (not (null (whitespacep " "))) - (not (null (whitespacep #\Null)))) - nil nil t t nil nil) - (deftest binseq-buffer-forward-to-word-boundary.test-1 (let ((buffer (make-instance 'binseq-buffer))) (insert-buffer-sequence buffer 0 " climacs @@ -1080,26 +1060,6 @@ (number-of-lines-in-region m2l 10) (number-of-lines-in-region 10 m2r)))) 1 1 1 1 0 0 0 1 1) - -(deftest constituentp.test-1 ; NOTE: more tests may be needed for sbcl - (values - (constituentp #\a) - (constituentp #\Newline) - (constituentp #\Space) - (constituentp #\Tab) - (constituentp "a") - (constituentp #\Null)) - t nil nil nil nil nil) - -(deftest whitespacep.test-1 - (values - (not (null (whitespacep #\a))) - (not (null (whitespacep #\Newline))) - (not (null (whitespacep #\Space))) - (not (null (whitespacep #\Tab))) - (not (null (whitespacep " "))) - (not (null (whitespacep #\Null)))) - nil nil t t nil nil) (deftest obinseq-buffer-forward-to-word-boundary.test-1 (let ((buffer (make-instance 'obinseq-buffer))) Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.1 climacs/Persistent/persistent-buffer.lisp:1.2 --- climacs/Persistent/persistent-buffer.lisp:1.1 Wed Jan 26 08:10:45 2005 +++ climacs/Persistent/persistent-buffer.lisp Wed Jan 26 10:28:56 2005 @@ -24,6 +24,9 @@ (in-package :climacs-buffer) +;;; For now, pos contains just an integer, while it might contain a cons +;;; of two adjacent buffer elements for higher performance (with the help +;;; of buffer implementation, especially the rebalancing part). (defclass persistent-cursor () ((buffer :reader buffer :initarg :buffer) ; TODO: fix overlap with mark? (pos :accessor cursor-pos)) @@ -151,6 +154,9 @@ while (> i 0) until (eql (buffer-object buffer (1- i)) #\Newline) count t)) + +;;; the old value of the CONTENTS slot is dropped upon modification +;;; it can be saved for UNDO purposes in a history tree, by an UNDOABLE-BUFFER (defmethod insert-buffer-object ((buffer binseq-buffer) offset object) (assert (<= 0 offset (size buffer)) () Index: climacs/Persistent/persistent-buffer-test.lisp diff -u climacs/Persistent/persistent-buffer-test.lisp:1.1 climacs/Persistent/persistent-buffer-test.lisp:1.2 --- climacs/Persistent/persistent-buffer-test.lisp:1.1 Wed Jan 26 08:10:45 2005 +++ climacs/Persistent/persistent-buffer-test.lisp Wed Jan 26 10:28:56 2005 @@ -53,11 +53,7 @@ (flet ((%all-eq (&optional x y) (cond ((null x) nil) - (t (when (eq x y) y)))) - (%all-= (&optional x y) - (cond - ((null x) nil) - (t (when (= x y) y))))) + (t (when (eq x y) y))))) (let* ((buffer (make-instance 'binseq-buffer)) (low (slot-value buffer 'low-mark)) (high (slot-value buffer 'high-mark)) @@ -762,11 +758,7 @@ (flet ((%all-eq (&optional x y) (cond ((null x) nil) - (t (when (eq x y) y)))) - (%all-= (&optional x y) - (cond - ((null x) nil) - (t (when (= x y) y))))) + (t (when (eq x y) y))))) (let* ((buffer (make-instance 'obinseq-buffer)) (low (slot-value buffer 'low-mark)) (high (slot-value buffer 'high-mark))

1 0

[climacs-cvs] CVS update: climacs/Persistent/README climacs/Persistent/binseq-package.lisp climacs/Persistent/binseq.lisp climacs/Persistent/obinseq.lisp climacs/Persistent/persistent-base-test.lisp climacs/Persistent/persistent-buffer-test.lisp climacs/Persistent/persistent-buffer.lisp
by abakic＠common-lisp.net 26 Jan '05

26 Jan '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv1821/Persistent Added Files: README binseq-package.lisp binseq.lisp obinseq.lisp persistent-base-test.lisp persistent-buffer-test.lisp persistent-buffer.lisp Log Message: Persistent/balanced-tree buffer implementations with tests. Date: Wed Jan 26 08:10:45 2005 Author: abakic

1 0

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/climacs.asd climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp
by abakic＠common-lisp.net 26 Jan '05

26 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1821 Modified Files: buffer.lisp climacs.asd gui.lisp packages.lisp pane.lisp Log Message: Persistent/balanced-tree buffer implementations with tests. Date: Wed Jan 26 08:10:41 2005 Author: abakic Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.23 climacs/buffer.lisp:1.24 --- climacs/buffer.lisp:1.23 Tue Jan 18 10:59:51 2005 +++ climacs/buffer.lisp Wed Jan 26 08:10:40 2005 @@ -92,7 +92,7 @@ (defclass standard-right-sticky-mark (right-sticky-mark mark-mixin) () (:documentation "A right-sticky-mark subclass suitable for use in a standard-buffer")) -(defmethod initialize-instance :after ((mark left-sticky-mark) &rest args &key (offset 0)) +(defmethod initialize-instance :after ((mark standard-left-sticky-mark) &rest args &key (offset 0)) "Associates a created mark with the buffer it was created for." (declare (ignore args)) (assert (<= 0 offset (size (buffer mark))) () @@ -102,7 +102,7 @@ :chain (slot-value (buffer mark) 'contents) :position offset))) -(defmethod initialize-instance :after ((mark right-sticky-mark) &rest args &key (offset 0)) +(defmethod initialize-instance :after ((mark standard-right-sticky-mark) &rest args &key (offset 0)) "Associates a created mark with the buffer it was created for." (declare (ignore args)) (assert (<= 0 offset (size (buffer mark))) () @@ -287,7 +287,7 @@ either immediately before the closest following newline character, or at the end of the buffer if no following newline character exists.")) -(defmethod end-of-line ((mark mark-mixin)) +(defmethod end-of-line ((mark mark-mixin)) ;PB (let* ((offset (offset mark)) (buffer (buffer mark)) (chain (slot-value buffer 'contents)) Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.15 climacs/climacs.asd:1.16 --- climacs/climacs.asd:1.15 Mon Jan 24 15:01:37 2005 +++ climacs/climacs.asd Wed Jan 26 08:10:40 2005 @@ -49,9 +49,13 @@ "Flexichain/utilities" "Flexichain/flexichain" "Flexichain/flexicursor" + "Persistent/binseq-package" + "Persistent/binseq" + "Persistent/obinseq" "translate" "packages" "buffer" + "Persistent/persistent-buffer" "base" "io" "abbrev" @@ -64,7 +68,9 @@ ;;---- optional ---- "testing/rt" "buffer-test" - "base-test") + "base-test" + "Persistent/persistent-buffer-test" + "Persistent/persistent-base-test") #+asdf (defmethod asdf:perform :around ((o asdf:compile-op) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.98 climacs/gui.lisp:1.99 --- climacs/gui.lisp:1.98 Mon Jan 24 04:49:09 2005 +++ climacs/gui.lisp Wed Jan 26 08:10:40 2005 @@ -747,7 +747,7 @@ (accept 'integer :prompt "Goto Position"))) (define-named-command com-goto-line () - (loop with mark = (make-instance 'standard-right-sticky-mark + (loop with mark = (make-instance 'standard-right-sticky-mark ;PB :buffer (buffer (current-window))) do (end-of-line mark) until (end-of-buffer-p mark) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.40 climacs/packages.lisp:1.41 --- climacs/packages.lisp:1.40 Mon Jan 24 04:49:09 2005 +++ climacs/packages.lisp Wed Jan 26 08:10:40 2005 @@ -23,7 +23,7 @@ ;;; Package definitions for the Climacs editor. (defpackage :climacs-buffer - (:use :clim-lisp :flexichain) + (:use :clim-lisp :flexichain :binseq) (:export #:buffer #:standard-buffer #:mark #:left-sticky-mark #:right-sticky-mark #:standard-left-sticky-mark #:standard-right-sticky-mark @@ -41,7 +41,10 @@ #:delete-region #:buffer-object #:buffer-sequence #:object-before #:object-after #:region-to-sequence - #:low-mark #:high-mark #:modified-p #:clear-modify)) + #:low-mark #:high-mark #:modified-p #:clear-modify + + #:binseq-buffer #:obinseq-buffer + #:persistent-left-sticky-mark #:persistent-right-sticky-mark)) (defpackage :climacs-base (:use :clim-lisp :climacs-buffer) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.13 climacs/pane.lisp:1.14 --- climacs/pane.lisp:1.13 Mon Jan 24 04:49:09 2005 +++ climacs/pane.lisp Wed Jan 26 08:10:41 2005 @@ -156,7 +156,7 @@ ;(defgeneric indent-tabs-mode (climacs-buffer)) -(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin undo-mixin) +(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin undo-mixin) ;PB ((needs-saving :initform nil :accessor needs-saving) (syntax :initarg :syntax :initform (make-instance 'basic-syntax) :accessor syntax) (indent-tabs-mode :initarg indent-tabs-mode :initform t @@ -195,14 +195,14 @@ (declare (ignore args)) (with-slots (buffer point mark) pane (when (null point) - (setf point (make-instance 'standard-right-sticky-mark + (setf point (make-instance 'standard-right-sticky-mark ;PB :buffer buffer))) (when (null mark) - (setf mark (make-instance 'standard-right-sticky-mark + (setf mark (make-instance 'standard-right-sticky-mark ;PB :buffer buffer)))) (with-slots (buffer top bot scan) pane - (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) - bot (make-instance 'standard-right-sticky-mark :buffer buffer))) + (setf top (make-instance 'standard-left-sticky-mark :buffer buffer) ;PB + bot (make-instance 'standard-right-sticky-mark :buffer buffer))) ;PB (setf (stream-default-view pane) (make-instance 'climacs-textual-view)) (with-slots (space-width tab-width) (stream-default-view pane) (let* ((medium (sheet-medium pane)) @@ -212,12 +212,12 @@ (defmethod (setf buffer) :after (buffer (pane climacs-pane)) (with-slots (point mark top bot) pane - (setf point (make-instance 'standard-right-sticky-mark + (setf point (make-instance 'standard-right-sticky-mark ;PB :buffer buffer) - mark (make-instance 'standard-right-sticky-mark + mark (make-instance 'standard-right-sticky-mark ;PB :buffer buffer) - top (make-instance 'standard-left-sticky-mark :buffer buffer) - bot (make-instance 'standard-right-sticky-mark :buffer buffer)))) + top (make-instance 'standard-left-sticky-mark :buffer buffer) ;PB + bot (make-instance 'standard-right-sticky-mark :buffer buffer)))) ;PB (define-presentation-type url () :inherit-from 'string)

1 0

← Newer
1
...
68
69
70
71
72
73
74
...
85
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs