climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[climacs-cvs] CVS update: Directory change: climacs/Persistent
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-serv1060/Persistent Log Message: Directory /project/climacs/cvsroot/climacs/Persistent added to the repository Date: Wed Jan 26 07:59:42 2005 Author: abakic New directory climacs/Persistent added

1 0

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

24 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5683 Modified Files: base.lisp base-test.lisp buffer-test.lisp Log Message: Changes in open-line and number-of-lines-in-region, and more tests. Date: Mon Jan 24 15:53:53 2005 Author: abakic Index: climacs/base.lisp diff -u climacs/base.lisp:1.24 climacs/base.lisp:1.25 --- climacs/base.lisp:1.24 Thu Jan 20 15:37:38 2005 +++ climacs/base.lisp Mon Jan 24 15:53:52 2005 @@ -75,8 +75,12 @@ (beginning-of-line mark) (incf (offset mark) column))))) -(defun open-line (mark) - "Create a new line in a buffer." +(defmethod open-line ((mark left-sticky-mark)) + "Create a new line in a buffer after the mark." + (insert-object mark #\Newline)) + +(defmethod open-line ((mark right-sticky-mark)) + "Create a new line in a buffer after the mark." (insert-object mark #\Newline) (decf (offset mark))) @@ -132,13 +136,23 @@ (defmethod number-of-lines-in-region ((mark1 mark) (mark2 mark)) (assert (eq (buffer mark1) (buffer mark2))) - (buffer-number-of-lines-in-region (buffer mark1) (offset mark1) (offset mark2))) - -(defmethod number-of-lines-in-region ((offset integer) (mark mark)) - (buffer-number-of-lines-in-region (buffer mark) offset (offset mark))) - -(defmethod number-of-lines-in-region ((mark mark) (offset integer)) - (buffer-number-of-lines-in-region (buffer mark) (offset mark) offset)) + (let ((offset1 (offset mark1)) + (offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-number-of-lines-in-region (buffer mark1) offset1 offset2))) + +(defmethod number-of-lines-in-region ((offset1 integer) (mark2 mark)) + (let ((offset2 (offset mark2))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-number-of-lines-in-region (buffer mark2) offset1 offset2))) + +(defmethod number-of-lines-in-region ((mark1 mark) (offset2 integer)) + (let ((offset1 (offset mark1))) + (when (> offset1 offset2) + (rotatef offset1 offset2)) + (buffer-number-of-lines-in-region (buffer mark1) offset1 offset2))) (defun constituentp (obj) "A predicate to ensure that an object is a constituent character." @@ -153,7 +167,7 @@ #-sbcl (member obj '(#\Space #\Tab)))) (defun forward-to-word-boundary (mark) - "Forward the mark forward to the beginning of the next word." + "Move the mark forward to the beginning of the next word." (loop until (end-of-buffer-p mark) until (constituentp (object-after mark)) do (incf (offset mark)))) Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.1 climacs/base-test.lisp:1.2 --- climacs/base-test.lisp:1.1 Thu Jan 20 15:21:53 2005 +++ climacs/base-test.lisp Mon Jan 24 15:53:52 2005 @@ -143,4 +143,482 @@ :buffer buffer :offset 0))) (next-line mark) (offset mark))) - 8) \ No newline at end of file + 8) + +(deftest standard-buffer-open-line.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + " +climacs" 0) + +(deftest standard-buffer-open-line.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + " +climacs" 0) + +(deftest standard-buffer-open-line.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs +" 7) + +(deftest standard-buffer-open-line.test-4 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (open-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs +" 7) + +(deftest standard-buffer-kill-line.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + #() 0) + +(deftest standard-buffer-kill-line.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + #() 0) + +(deftest standard-buffer-kill-line.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs" 7) + +(deftest standard-buffer-kill-line.test-4 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacs" 7) + +(deftest standard-buffer-kill-line.test-5 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (let ((mark (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacsclimacs" 7) + +(deftest standard-buffer-kill-line.test-6 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (let ((mark (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (kill-line mark) + (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) + "climacsclimacs" 7) + +(deftest standard-buffer-empty-line-p.test-1 + (let* ((buffer (make-instance 'standard-buffer)) + (m1 (make-instance 'standard-left-sticky-mark :buffer buffer)) + (m2 (make-instance 'standard-right-sticky-mark :buffer buffer))) + (values (empty-line-p m1) (empty-line-p m2))) + t t) + +(deftest standard-buffer-empty-line-p.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-object buffer 0 #\a) + (let ((m1 (make-instance 'standard-left-sticky-mark :buffer buffer)) + (m2 (make-instance 'standard-right-sticky-mark :buffer buffer))) + (values (empty-line-p m1) (empty-line-p m2)))) + nil nil) + +(deftest standard-buffer-empty-line-p.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-object buffer 0 #\a) + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 1))) + (values (empty-line-p m1) (empty-line-p m2)))) + nil nil) + +(deftest standard-buffer-empty-line-p.test-4 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "a +b") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 1))) + (values (empty-line-p m1) (empty-line-p m2)))) + nil nil) + +(deftest standard-buffer-line-indentation.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m3 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 10)) + (m4 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 10))) + (values + (line-indentation m1 8) + (line-indentation m2 8) + (line-indentation m3 8) + (line-indentation m4 8) + (offset m1) + (offset m2) + (offset m3) + (offset m4)))) + 10 10 10 10 0 0 10 10) + +(deftest standard-buffer-line-indentation.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m3 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 11)) + (m4 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 11))) + (values + (line-indentation m1 8) + (line-indentation m2 8) + (line-indentation m3 8) + (line-indentation m4 8) + (offset m1) + (offset m2) + (offset m3) + (offset m4)))) + 18 18 18 18 0 0 11 11) + +(deftest standard-buffer-line-indentation.test-3 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs ") + (let ((m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m3 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 11)) + (m4 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 11))) + (values + (line-indentation m1 8) + (line-indentation m2 8) + (line-indentation m3 8) + (line-indentation m4 8) + (offset m1) + (offset m2) + (offset m3) + (offset m4)))) + 10 10 10 10 0 0 11 11) + +(deftest standard-buffer-buffer-number-of-lines-in-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (values + (climacs-base::buffer-number-of-lines-in-region buffer 0 6) + (climacs-base::buffer-number-of-lines-in-region buffer 0 7) + (climacs-base::buffer-number-of-lines-in-region buffer 0 10) + (climacs-base::buffer-number-of-lines-in-region buffer 0 13) + (climacs-base::buffer-number-of-lines-in-region buffer 0 14) + (climacs-base::buffer-number-of-lines-in-region buffer 7 10) + (climacs-base::buffer-number-of-lines-in-region buffer 8 13) + (climacs-base::buffer-number-of-lines-in-region buffer 8 14))) + 0 0 1 1 1 1 0 0) + +(deftest standard-buffer-buffer-display-column.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " cli macs") + (values + (buffer-display-column buffer 0 8) + (buffer-display-column buffer 1 8) + (buffer-display-column buffer 2 8) + (buffer-display-column buffer 5 8) + (buffer-display-column buffer 6 8))) + 0 8 16 19 24) + +(deftest standard-buffer-number-of-lines-in-region.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " +climacs +climacs +") + (let ((m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m2r (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 1)) + (m3l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3)) + (m3r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 3)) + (m4l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 8)) + (m4r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 8)) + (m5l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 15)) + (m5r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 15)) + (m6l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 16)) + (m6r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 16))) + (values + (number-of-lines-in-region m1l m1r) + (number-of-lines-in-region m1r m1l) + (number-of-lines-in-region m1l m2l) + (number-of-lines-in-region m2r m1r) + (number-of-lines-in-region m1l m2r) + (number-of-lines-in-region m2r m1l) + (number-of-lines-in-region m1r m2l) + (number-of-lines-in-region m1l m3l) + (number-of-lines-in-region m1r m3r) + (number-of-lines-in-region m4r m1l) + (number-of-lines-in-region m4l m1r) + (number-of-lines-in-region m3l m5l) + (number-of-lines-in-region m5r m4r) + (number-of-lines-in-region m5l m6l) + (number-of-lines-in-region m6r m5r) + (number-of-lines-in-region m6l m6r) + (number-of-lines-in-region m1l m6r) + (number-of-lines-in-region m3r m6l)))) + 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 2 1) + +(deftest standard-buffer-number-of-lines-in-region.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs") + (let ((m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 6)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 6)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 7)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7))) + (values + (number-of-lines-in-region m1l 10) + (number-of-lines-in-region 10 m1l) + (number-of-lines-in-region m1r 10) + (number-of-lines-in-region 10 m1r) + (number-of-lines-in-region m1l 3) + (number-of-lines-in-region 3 m2l) + (number-of-lines-in-region 3 m2r) + (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 standard-buffer-forward-to-word-boundary.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs +climacs") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 5)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 5)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17))) + (values + (progn (climacs-base::forward-to-word-boundary m0l) (offset m0l)) + (progn (climacs-base::forward-to-word-boundary m0r) (offset m0r)) + (progn (climacs-base::forward-to-word-boundary m1l) (offset m1l)) + (progn (climacs-base::forward-to-word-boundary m1r) (offset m1r)) + (progn (climacs-base::forward-to-word-boundary m2l) (offset m2l)) + (progn (climacs-base::forward-to-word-boundary m2r) (offset m2r))))) + 2 2 5 5 17 17) + +(deftest standard-buffer-backward-to-word-boundary.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs ") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 10)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 10)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (values + (progn (climacs-base::backward-to-word-boundary m0l) (offset m0l)) + (progn (climacs-base::backward-to-word-boundary m0r) (offset m0r)) + (progn (climacs-base::backward-to-word-boundary m1l) (offset m1l)) + (progn (climacs-base::backward-to-word-boundary m1r) (offset m1r)) + (progn (climacs-base::backward-to-word-boundary m2l) (offset m2l)) + (progn (climacs-base::backward-to-word-boundary m2r) (offset m2r))))) + 15 15 10 10 0 0) + +(deftest standard-buffer-forward-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs +climacs") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 5)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 15)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17))) + (values + (progn (forward-word m0l) (offset m0l)) + (progn (forward-word m0r) (offset m0r)) + (progn (forward-word m1l) (offset m1l)) + (progn (forward-word m1r) (offset m1r)) + (progn (forward-word m2l) (offset m2l)) + (progn (forward-word m2r) (offset m2r))))) + 9 9 9 17 17 17) + +(deftest standard-buffer-backward-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs +climacs ") + (let ((m0l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 17)) + (m0r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 17)) + (m1l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 10)) + (m1r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 5)) + (m2l (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 0)) + (m2r (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (values + (progn (backward-word m0l) (offset m0l)) + (progn (backward-word m0r) (offset m0r)) + (progn (backward-word m1l) (offset m1l)) + (progn (backward-word m1r) (offset m1r)) + (progn (backward-word m2l) (offset m2l)) + (progn (backward-word m2r) (offset m2r))))) + 8 8 8 0 0 0) + +(deftest standard-buffer-delete-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((m (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3))) + (delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + "cli" 3) + +(deftest standard-buffer-delete-word.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (let ((m (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 0))) + (delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + #() 0) + +(deftest standard-buffer-backward-delete-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs") + (let ((m (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 3))) + (backward-delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + "macs" 0) + +(deftest standard-buffer-backward-delete-word.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs ") + (let ((m (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 9))) + (backward-delete-word m) + (values + (buffer-sequence buffer 0 (size buffer)) + (offset m)))) + #() 0) + +(deftest standard-buffer-previous-word.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 "climacs climacs") + (let ((m0 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 7)) + (m1 (make-instance 'standard-left-sticky-mark + :buffer buffer :offset 8)) + (m2 (make-instance 'standard-right-sticky-mark + :buffer buffer :offset 10))) + (values + (climacs-base::previous-word m0) + (climacs-base::previous-word m1) + (climacs-base::previous-word m2)))) + "climacs" #() "cl") \ No newline at end of file Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.8 climacs/buffer-test.lisp:1.9 --- climacs/buffer-test.lisp:1.8 Thu Jan 20 15:21:52 2005 +++ climacs/buffer-test.lisp Mon Jan 24 15:53:52 2005 @@ -526,6 +526,23 @@ (= 0 (line-number m1) (1- (line-number m2))))) t) +(deftest standard-buffer-buffer-column-number.test-1 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " climacs") + (values + (buffer-object buffer 2) + (buffer-column-number buffer 2))) + #\c 2) + +(deftest standard-buffer-buffer-column-number.test-2 + (let ((buffer (make-instance 'standard-buffer))) + (insert-buffer-sequence buffer 0 " + climacs") + (values + (buffer-object buffer 3) + (buffer-column-number buffer 3))) + #\c 2) + (deftest standard-buffer-column-number.test-1 (let ((buffer (make-instance 'standard-buffer))) (insert-buffer-sequence buffer 0 "climacs

1 0

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

24 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv2689 Modified Files: climacs.asd Log Message: Fixed file order issue preventing compilation in CMUCL Date: Mon Jan 24 15:01:39 2005 Author: mvilleneuve Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.14 climacs/climacs.asd:1.15 --- climacs/climacs.asd:1.14 Mon Jan 24 04:49:08 2005 +++ climacs/climacs.asd Mon Jan 24 15:01:37 2005 @@ -58,8 +58,8 @@ "syntax" "text-syntax" "kill-ring" - "pane" "undo" + "pane" "gui" ;;---- optional ---- "testing/rt"

1 0

[climacs-cvs] CVS update: climacs/undo.lisp
by rstrandh＠common-lisp.net 24 Jan '05

24 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5047 Added Files: undo.lisp Log Message: Undo Date: Mon Jan 24 05:12:52 2005 Author: rstrandh

1 0

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

24 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3921 Modified Files: climacs.asd gui.lisp packages.lisp pane.lisp Log Message: Implemented undo and redo. Date: Mon Jan 24 04:49:09 2005 Author: rstrandh Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.13 climacs/climacs.asd:1.14 --- climacs/climacs.asd:1.13 Thu Jan 20 15:21:52 2005 +++ climacs/climacs.asd Mon Jan 24 04:49:08 2005 @@ -59,6 +59,7 @@ "text-syntax" "kill-ring" "pane" + "undo" "gui" ;;---- optional ---- "testing/rt" Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.97 climacs/gui.lisp:1.98 --- climacs/gui.lisp:1.97 Sun Jan 23 15:30:34 2005 +++ climacs/gui.lisp Mon Jan 24 04:49:09 2005 @@ -88,6 +88,11 @@ (defmacro current-window () ; shouldn't this be an inlined function? --amb `(car (windows *application-frame*))) +(defmethod execute-frame-command :around ((frame climacs) command) + (declare (ignore command)) + (with-undo ((buffer (current-window))) + (call-next-method))) + (defmethod redisplay-frame-panes :around ((frame climacs) &rest args) (declare (ignore args)) (let ((buffers (remove-duplicates (mapcar #'buffer (windows frame))))) @@ -1099,6 +1104,12 @@ (define-named-command com-isearch-exit () (setf (isearch-mode (current-window)) nil)) +(define-named-command com-undo () + (undo (undo-tree (buffer (current-window))))) + +(define-named-command com-redo () + (redo (undo-tree (buffer (current-window))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Dynamic abbrevs @@ -1263,6 +1274,8 @@ (c-x-set-key '(#\k) 'com-kill-buffer) (c-x-set-key '(#\l :control) 'com-load-file) (c-x-set-key '(#\o) 'com-other-window) +(c-x-set-key '(#\r) 'com-redo) +(c-x-set-key '(#\u) 'com-undo) (c-x-set-key '(#\s :control) 'com-save-buffer) (c-x-set-key '(#\t :control) 'com-transpose-lines) (c-x-set-key '(#\w :control) 'com-write-buffer) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.39 climacs/packages.lisp:1.40 --- climacs/packages.lisp:1.39 Sun Jan 23 15:30:34 2005 +++ climacs/packages.lisp Mon Jan 24 04:49:09 2005 @@ -88,9 +88,16 @@ #:reset-yank-position #:rotate-yank-position #:kill-ring-yank #:kill-ring-standard-push #:kill-ring-concatenating-push)) +(defpackage :undo + (:use :common-lisp) + (:export #:no-more-undo + #:undo-tree #:standard-undo-tree + #:undo-record #:standard-undo-record + #:add-undo #:flip-undo-record #:undo #:redo)) + (defpackage :climacs-pane (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev - :climacs-syntax :flexichain) + :climacs-syntax :flexichain :undo) (:export #:climacs-buffer #:needs-saving #:filename #:climacs-pane #:point #:mark #:redisplay-pane #:full-redisplay @@ -100,9 +107,10 @@ #:auto-fill-mode #:auto-fill-column #:isearch-state #:search-string #:search-mark #:search-forward-p #:isearch-mode #:isearch-states #:isearch-previous-string + #:with-undo #:url)) (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax - :climacs-kill-ring :climacs-pane :clim-extensions)) + :climacs-kill-ring :climacs-pane :clim-extensions :undo)) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.12 climacs/pane.lisp:1.13 --- climacs/pane.lisp:1.12 Sun Jan 23 15:30:35 2005 +++ climacs/pane.lisp Mon Jan 24 04:49:09 2005 @@ -44,6 +44,99 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Undo + +(defclass undo-mixin () + ((tree :initform (make-instance 'standard-undo-tree) :reader undo-tree) + (undo-accumulate :initform '() :accessor undo-accumulate) + (performing-undo :initform nil :accessor performing-undo))) + +(defclass climacs-undo-record (standard-undo-record) + ((buffer :initarg :buffer))) + +(defclass simple-undo-record (climacs-undo-record) + ((offset :initarg :offset))) + +(defclass insert-record (simple-undo-record) + ((objects :initarg :objects))) + +(defclass delete-record (simple-undo-record) + ((length :initarg :length))) + +(defclass compound-record (climacs-undo-record) + ((records :initform '() :initarg :records))) + +(defmethod print-object ((object delete-record) stream) + (with-slots (offset length) object + (format stream "[offset: ~a length: ~a]" offset length))) + +(defmethod print-object ((object insert-record) stream) + (with-slots (offset objects) object + (format stream "[offset: ~a objects: ~a]" offset objects))) + +(defmethod print-object ((object compound-record) stream) + (with-slots (records) object + (format stream "[records: ~a]" records))) + +(defmethod insert-buffer-object :before ((buffer undo-mixin) offset object) + (declare (ignore object)) + (unless (performing-undo buffer) + (push (make-instance 'delete-record + :buffer buffer :offset offset :length 1) + (undo-accumulate buffer)))) + +(defmethod insert-buffer-sequence :before ((buffer undo-mixin) offset sequence) + (unless (performing-undo buffer) + (push (make-instance 'delete-record + :buffer buffer :offset offset :length (length sequence)) + (undo-accumulate buffer)))) + + +(defmethod delete-buffer-range :before ((buffer undo-mixin) offset n) + (unless (performing-undo buffer) + (push (make-instance 'insert-record + :buffer buffer :offset offset + :objects (buffer-sequence buffer offset (+ offset n))) + (undo-accumulate buffer)))) + +(defmacro with-undo ((buffer) &body body) + (let ((buffer-var (gensym))) + `(let ((,buffer-var ,buffer)) + (setf (undo-accumulate ,buffer-var) '()) + ,@body + (cond ((null (undo-accumulate ,buffer-var)) nil) + ((null (cdr (undo-accumulate ,buffer-var))) + (add-undo (car (undo-accumulate ,buffer-var)) (undo-tree ,buffer-var))) + (t + (add-undo (make-instance 'compound-record :records (undo-accumulate ,buffer-var)) + (undo-tree ,buffer-var))))))) + +(defmethod flip-undo-record :around ((record climacs-undo-record)) + (with-slots (buffer) record + (let ((performing-undo (performing-undo buffer))) + (setf (performing-undo buffer) t) + (unwind-protect (call-next-method) + (setf (performing-undo buffer) performing-undo))))) + +(defmethod flip-undo-record ((record insert-record)) + (with-slots (buffer offset objects) record + (change-class record 'delete-record + :length (length objects)) + (insert-buffer-sequence buffer offset objects))) + +(defmethod flip-undo-record ((record delete-record)) + (with-slots (buffer offset length) record + (change-class record 'insert-record + :objects (buffer-sequence buffer offset (+ offset length))) + (delete-buffer-range buffer offset length))) + +(defmethod flip-undo-record ((record compound-record)) + (with-slots (records) record + (mapc #'flip-undo-record records) + (setf records (nreverse records)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Isearch (defclass isearch-state () @@ -63,7 +156,7 @@ ;(defgeneric indent-tabs-mode (climacs-buffer)) -(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin) +(defclass climacs-buffer (standard-buffer abbrev-mixin filename-mixin name-mixin undo-mixin) ((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

1 0

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

23 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28339 Modified Files: gui.lisp packages.lisp pane.lisp Log Message: Added backward isearch Date: Sun Jan 23 15:30:35 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.96 climacs/gui.lisp:1.97 --- climacs/gui.lisp:1.96 Sun Jan 23 02:21:08 2005 +++ climacs/gui.lisp Sun Jan 23 15:30:34 2005 @@ -990,9 +990,8 @@ ;;; ;;; Incremental search -(define-named-command com-isearch-mode () - (let* ((pane (current-window)) - (point (point pane))) +(defun isearch-command-loop (pane forwardp) + (let ((point (point pane))) (unless (endp (isearch-states pane)) (setf (isearch-previous-string pane) (search-string (first (isearch-states pane))))) @@ -1000,7 +999,8 @@ (setf (isearch-states pane) (list (make-instance 'isearch-state :search-string "" - :search-mark (clone-mark point)))) + :search-mark (clone-mark point) + :search-forward-p forwardp))) (redisplay-frame-panes *application-frame*) (loop while (isearch-mode pane) as gesture = (climacs-read-gesture) @@ -1020,33 +1020,47 @@ (setf (isearch-mode pane) nil))) (redisplay-frame-panes *application-frame*)))) -(defun isearch-from-mark (pane mark string) - (let* ((point (point pane)) - (mark2 (clone-mark mark))) - (when (search-forward mark2 string - :test (lambda (x y) - (if (characterp x) - (and (characterp y) (char-equal x y)) - (eql x y)))) - (setf (offset point) (offset mark2)) - (setf (offset mark) (- (offset mark2) (length string)))))) +(defun isearch-from-mark (pane mark string forwardp) + (flet ((object-equal (x y) + (if (characterp x) + (and (characterp y) (char-equal x y)) + (eql x y)))) + (let* ((point (point pane)) + (mark2 (clone-mark mark)) + (success (funcall (if forwardp #'search-forward #'search-backward) + mark2 + string + :test #'object-equal))) + (cond (success + (setf (offset point) (offset mark2) + (offset mark) (if forwardp + (- (offset mark2) (length string)) + (+ (offset mark2) (length string)))) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark + :search-forward-p forwardp) + (isearch-states pane))) + (t + (beep)))))) + +(define-named-command com-isearch-mode-forward () + (isearch-command-loop (current-window) t)) + +(define-named-command com-isearch-mode-backward () + (isearch-command-loop (current-window) nil)) (define-named-command com-isearch-append-char () (let* ((pane (current-window)) - (point (point pane)) (states (isearch-states pane)) (string (concatenate 'string (search-string (first states)) (string *current-gesture*))) (mark (clone-mark (search-mark (first states)))) - (previous-point-offset (offset point))) - (isearch-from-mark pane mark string) - (if (/= (offset point) previous-point-offset) - (push (make-instance 'isearch-state - :search-string string - :search-mark mark) - (isearch-states pane)) - (beep)))) + (forwardp (search-forward-p (first states)))) + (unless forwardp + (incf (offset mark))) + (isearch-from-mark pane mark string forwardp))) (define-named-command com-isearch-delete-char () (let* ((pane (current-window))) @@ -1056,8 +1070,11 @@ (pop (isearch-states pane)) (let ((state (first (isearch-states pane)))) (setf (offset (point pane)) - (+ (offset (search-mark state)) - (length (search-string state))))))))) + (if (search-forward-p state) + (+ (offset (search-mark state)) + (length (search-string state))) + (- (offset (search-mark state)) + (length (search-string state)))))))))) (define-named-command com-isearch-forward () (let* ((pane (current-window)) @@ -1066,15 +1083,18 @@ (string (if (null (second states)) (isearch-previous-string pane) (search-string (first states)))) - (mark (clone-mark point)) - (previous-point-offset (offset point))) - (isearch-from-mark pane mark string) - (if (/= (offset point) previous-point-offset) - (push (make-instance 'isearch-state - :search-string string - :search-mark mark) - (isearch-states pane)) - (beep)))) + (mark (clone-mark point))) + (isearch-from-mark pane mark string t))) + +(define-named-command com-isearch-backward () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (if (null (second states)) + (isearch-previous-string pane) + (search-string (first states)))) + (mark (clone-mark point))) + (isearch-from-mark pane mark string nil))) (define-named-command com-isearch-exit () (setf (isearch-mode (current-window)) nil)) @@ -1197,7 +1217,8 @@ (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) -(global-set-key '(#\s :control) 'com-isearch-mode) +(global-set-key '(#\s :control) 'com-isearch-mode-forward) +(global-set-key '(#\r :control) 'com-isearch-mode-backward) (global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line) @@ -1422,4 +1443,4 @@ (isearch-set-key '(#\Newline) 'com-isearch-exit) (isearch-set-key '(#\Backspace) 'com-isearch-delete-char) (isearch-set-key '(#\s :control) 'com-isearch-forward) - +(isearch-set-key '(#\r :control) 'com-isearch-backward) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.38 climacs/packages.lisp:1.39 --- climacs/packages.lisp:1.38 Sun Jan 23 02:21:08 2005 +++ climacs/packages.lisp Sun Jan 23 15:30:34 2005 @@ -98,7 +98,7 @@ #:tab-space-count #:indent-tabs-mode #:auto-fill-mode #:auto-fill-column - #:isearch-state #:search-string #:search-mark + #:isearch-state #:search-string #:search-mark #:search-forward-p #:isearch-mode #:isearch-states #:isearch-previous-string #:url)) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.11 climacs/pane.lisp:1.12 --- climacs/pane.lisp:1.11 Sun Jan 23 02:21:08 2005 +++ climacs/pane.lisp Sun Jan 23 15:30:35 2005 @@ -48,7 +48,8 @@ (defclass isearch-state () ((search-string :initarg :search-string :accessor search-string) - (search-mark :initarg :search-mark :accessor search-mark))) + (search-mark :initarg :search-mark :accessor search-mark) + (search-forward-p :initarg :search-forward-p :accessor search-forward-p))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/INSTALL
by rstrandh＠common-lisp.net 23 Jan '05

23 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7225 Modified Files: INSTALL Log Message: Added warning agains using old versions of McCLIM. Date: Sun Jan 23 08:37:30 2005 Author: rstrandh Index: climacs/INSTALL diff -u climacs/INSTALL:1.3 climacs/INSTALL:1.4 --- climacs/INSTALL:1.3 Sat Jan 8 10:07:30 2005 +++ climacs/INSTALL Sun Jan 23 08:37:24 2005 @@ -33,5 +33,12 @@ Start the Climacs editor. +Finally, please notice that as we develop Climacs, we occasionally +find bugs in McCLIM, or ask for functionality of McCLIM that can be +useful to us. + +For that reason, McCLIM often depend on very fresh CVS versions of +McCLIM. If you discover a bug, please try to install a new version of +McCLIM before looking to hard for any other reasons.

1 0

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

23 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv20514 Modified Files: gui.lisp packages.lisp pane.lisp Log Message: Added basic Isearch support Date: Sun Jan 23 02:21:09 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.95 climacs/gui.lisp:1.96 --- climacs/gui.lisp:1.95 Sat Jan 22 07:20:44 2005 +++ climacs/gui.lisp Sun Jan 23 02:21:08 2005 @@ -109,7 +109,7 @@ (declare (ignore frame)) (with-slots (climacs-pane) pane (let* ((buf (buffer climacs-pane)) - (name-info (format nil " ~a ~a Syntax: ~a~a~a ~a" + (name-info (format nil " ~a ~a Syntax: ~a~a~a~a ~a" (if (needs-saving buf) "**" "--") (name buf) (name (syntax buf)) @@ -119,6 +119,9 @@ (if (auto-fill-mode climacs-pane) " Fill" "") + (if (isearch-mode climacs-pane) + " Isearch" + "") (if (recordingp *application-frame*) "Def" "")))) @@ -983,17 +986,102 @@ (let ((size (accept 'integer :prompt "New kill ring size"))) (setf (kill-ring-max-size *kill-ring*) size))) -(define-named-command com-search-forward () - (search-forward (point (current-window)) - (accept 'string :prompt "Search Forward") - :test (lambda (a b) - (and (characterp b) (char-equal a b))))) - -(define-named-command com-search-backward () - (search-backward (point (current-window)) - (accept 'string :prompt "Search Backward") - :test (lambda (a b) - (and (characterp b) (char-equal a b))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Incremental search + +(define-named-command com-isearch-mode () + (let* ((pane (current-window)) + (point (point pane))) + (unless (endp (isearch-states pane)) + (setf (isearch-previous-string pane) + (search-string (first (isearch-states pane))))) + (setf (isearch-mode pane) t) + (setf (isearch-states pane) + (list (make-instance 'isearch-state + :search-string "" + :search-mark (clone-mark point)))) + (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*)))) + +(defun isearch-from-mark (pane mark string) + (let* ((point (point pane)) + (mark2 (clone-mark mark))) + (when (search-forward mark2 string + :test (lambda (x y) + (if (characterp x) + (and (characterp y) (char-equal x y)) + (eql x y)))) + (setf (offset point) (offset mark2)) + (setf (offset mark) (- (offset mark2) (length string)))))) + +(define-named-command com-isearch-append-char () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (concatenate 'string + (search-string (first states)) + (string *current-gesture*))) + (mark (clone-mark (search-mark (first states)))) + (previous-point-offset (offset point))) + (isearch-from-mark pane mark string) + (if (/= (offset point) previous-point-offset) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark) + (isearch-states pane)) + (beep)))) + +(define-named-command com-isearch-delete-char () + (let* ((pane (current-window))) + (cond ((null (second (isearch-states pane))) + (beep)) + (t + (pop (isearch-states pane)) + (let ((state (first (isearch-states pane)))) + (setf (offset (point pane)) + (+ (offset (search-mark state)) + (length (search-string state))))))))) + +(define-named-command com-isearch-forward () + (let* ((pane (current-window)) + (point (point pane)) + (states (isearch-states pane)) + (string (if (null (second states)) + (isearch-previous-string pane) + (search-string (first states)))) + (mark (clone-mark point)) + (previous-point-offset (offset point))) + (isearch-from-mark pane mark string) + (if (/= (offset point) previous-point-offset) + (push (make-instance 'isearch-state + :search-string string + :search-mark mark) + (isearch-states pane)) + (beep)))) + +(define-named-command com-isearch-exit () + (setf (isearch-mode (current-window)) nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Dynamic abbrevs (define-named-command com-dabbrev-expand () (let* ((win (current-window)) @@ -1109,6 +1197,7 @@ (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) +(global-set-key '(#\s :control) 'com-isearch-mode) (global-set-key '(:up) 'com-previous-line) (global-set-key '(:down) 'com-next-line) @@ -1316,3 +1405,21 @@ (dead-circumflex-set-key '(#\o) '(com-insert-charcode 244)) (dead-circumflex-set-key '(#\u) '(com-insert-charcode 251)) (dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Isearch command table + +(make-command-table 'isearch-climacs-table :errorp nil) + +(defun isearch-set-key (gesture command) + (add-command-to-command-table command 'isearch-climacs-table + :keystroke gesture :errorp nil)) + +(loop for code from (char-code #\Space) to (char-code #\~) + do (isearch-set-key (code-char code) 'com-isearch-append-char)) + +(isearch-set-key '(#\Newline) 'com-isearch-exit) +(isearch-set-key '(#\Backspace) 'com-isearch-delete-char) +(isearch-set-key '(#\s :control) 'com-isearch-forward) + Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.37 climacs/packages.lisp:1.38 --- climacs/packages.lisp:1.37 Thu Jan 20 22:54:54 2005 +++ climacs/packages.lisp Sun Jan 23 02:21:08 2005 @@ -98,6 +98,8 @@ #:tab-space-count #:indent-tabs-mode #:auto-fill-mode #:auto-fill-column + #:isearch-state #:search-string #:search-mark + #:isearch-mode #:isearch-states #:isearch-previous-string #:url)) (defpackage :climacs-gui Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.10 climacs/pane.lisp:1.11 --- climacs/pane.lisp:1.10 Sat Jan 22 07:20:44 2005 +++ climacs/pane.lisp Sun Jan 23 02:21:08 2005 @@ -44,6 +44,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Isearch + +(defclass isearch-state () + ((search-string :initarg :search-string :accessor search-string) + (search-mark :initarg :search-mark :accessor search-mark))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; View (defclass climacs-textual-view (textual-view tabify-mixin) @@ -75,6 +83,9 @@ (tab-width :initform nil) (auto-fill-mode :initform t :accessor auto-fill-mode) (auto-fill-column :initform 70 :accessor auto-fill-column) + (isearch-mode :initform nil :accessor isearch-mode) + (isearch-states :initform '() :accessor isearch-states) + (isearch-previous-string :initform nil :accessor isearch-previous-string) (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/gui.lisp climacs/pane.lisp
by mvilleneuve＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25661 Modified Files: gui.lisp pane.lisp Log Message: Copy auto-fill parameters when splitting panes, moved auto-fill-column to pane Date: Sat Jan 22 07:20:45 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.94 climacs/gui.lisp:1.95 --- climacs/gui.lisp:1.94 Sat Jan 22 00:04:35 2005 +++ climacs/gui.lisp Sat Jan 22 07:20:44 2005 @@ -290,13 +290,13 @@ (let* ((pane (current-window)) (buffer (buffer pane))) (when (auto-fill-mode pane) - (let* ((fill-column (auto-fill-column buffer)) + (let* ((fill-column (auto-fill-column pane)) (point (point pane)) (offset (offset point)) (tab-width (tab-space-count (stream-default-view pane))) (syntax (syntax buffer))) (when (>= (buffer-display-column buffer offset tab-width) - (1- (auto-fill-column buffer))) + (1- fill-column)) (fill-line point (lambda (mark) (syntax-line-indentation mark tab-width syntax)) @@ -876,7 +876,9 @@ (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window (current-window)) (constellation-root (parent3 current-window))) - (setf (buffer new-pane) (buffer current-window)) + (setf (buffer new-pane) (buffer current-window) + (auto-fill-mode new-pane) (auto-fill-mode current-window) + (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) (replace-constellation constellation-root vbox t) (full-redisplay current-window) @@ -888,7 +890,9 @@ (multiple-value-bind (vbox new-pane) (make-pane-constellation) (let* ((current-window (current-window)) (constellation-root (parent3 current-window))) - (setf (buffer new-pane) (buffer current-window)) + (setf (buffer new-pane) (buffer current-window) + (auto-fill-mode new-pane) (auto-fill-mode current-window) + (auto-fill-column new-pane) (auto-fill-column current-window)) (push new-pane (windows *application-frame*)) (replace-constellation constellation-root vbox nil) (full-redisplay current-window) Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.9 climacs/pane.lisp:1.10 --- climacs/pane.lisp:1.9 Sat Jan 22 00:04:35 2005 +++ climacs/pane.lisp Sat Jan 22 07:20:44 2005 @@ -58,8 +58,7 @@ ((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 - :accessor indent-tabs-mode) - (auto-fill-column :initform 70 :accessor auto-fill-column)) + :accessor indent-tabs-mode)) (:default-initargs :name "*scratch*")) @@ -75,6 +74,7 @@ (space-width :initform nil) (tab-width :initform nil) (auto-fill-mode :initform t :accessor auto-fill-mode) + (auto-fill-column :initform 70 :accessor auto-fill-column) (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/gui.lisp climacs/pane.lisp
by rstrandh＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3538 Modified Files: gui.lisp pane.lisp Log Message: Prepare for the day when McCLIM moves output records instead of recomputing them. Date: Sat Jan 22 00:04:37 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.93 climacs/gui.lisp:1.94 --- climacs/gui.lisp:1.93 Fri Jan 21 21:45:25 2005 +++ climacs/gui.lisp Sat Jan 22 00:04:35 2005 @@ -922,6 +922,30 @@ (sheet-adopt-child parent other) (reorder-sheets parent (list first other))))))) +;; (define-named-command com-delete-window () +;; (unless (null (cdr (windows *application-frame*))) +;; (let* ((constellation (parent3 (current-window))) +;; (box (sheet-parent constellation)) +;; (box-children (sheet-children box)) +;; (other (if (eq constellation (first box-children)) +;; (third box-children) +;; (first box-children))) +;; (parent (sheet-parent box)) +;; (children (sheet-children parent)) +;; (first (first children)) +;; (second (second children)) +;; (third (third children))) +;; (pop (windows *application-frame*)) +;; (sheet-disown-child box other) +;; (cond ((eq box first) +;; (sheet-disown-child parent box) +;; (sheet-adopt-child parent other) +;; (reorder-sheets parent (list other second third))) +;; (t +;; (sheet-disown-child parent box) +;; (sheet-adopt-child parent other) +;; (reorder-sheets parent (list first second other))))))) + ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.8 climacs/pane.lisp:1.9 --- climacs/pane.lisp:1.8 Fri Jan 21 11:39:50 2005 +++ climacs/pane.lisp Sat Jan 22 00:04:35 2005 @@ -315,7 +315,7 @@ for id from 0 below (nb-elements cache) do (setf scan start-offset) (updating-output - (pane :unique-id id + (pane :unique-id (element* cache id) :cache-value (if (<= start-offset (offset (point pane)) (+ start-offset (length (element* cache id))))

1 0

← Newer
1
...
69
70
71
72
73
74
75
...
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