January 2005 - climacs-cvs@common-lisp.net

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

30 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv30608 Modified Files: gui.lisp packages.lisp pane.lisp Log Message: Fixed bad isearch behaviour when searching after a failure Date: Sun Jan 30 14:17:31 2005 Author: mvilleneuve Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.104 climacs/gui.lisp:1.105 --- climacs/gui.lisp:1.104 Sun Jan 30 11:56:53 2005 +++ climacs/gui.lisp Sun Jan 30 14:17:30 2005 @@ -1031,7 +1031,8 @@ (list (make-instance 'isearch-state :search-string "" :search-mark (clone-mark point) - :search-forward-p forwardp))) + :search-forward-p forwardp + :search-success-p t))) (simple-command-loop 'isearch-climacs-table (isearch-mode pane) ((setf (isearch-mode pane) nil))))) @@ -1047,18 +1048,19 @@ 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)))))) + (when 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 + :search-success-p success) + (isearch-states pane)) + (unless success + (beep))))) (define-named-command com-isearch-mode-forward () (isearch-command-loop (current-window) t)) @@ -1084,6 +1086,9 @@ (beep)) (t (pop (isearch-states pane)) + (loop until (endp (rest (isearch-states pane))) + until (search-success-p (first (isearch-states pane))) + do (pop (isearch-states pane))) (let ((state (first (isearch-states pane)))) (setf (offset (point pane)) (if (search-forward-p state) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.43 climacs/packages.lisp:1.44 --- climacs/packages.lisp:1.43 Sun Jan 30 11:56:53 2005 +++ climacs/packages.lisp Sun Jan 30 14:17:31 2005 @@ -111,7 +111,8 @@ #:tab-space-count #:indent-tabs-mode #:auto-fill-mode #:auto-fill-column - #:isearch-state #:search-string #:search-mark #:search-forward-p + #:isearch-state #:search-string #:search-mark + #:search-forward-p #:search-success-p #:isearch-mode #:isearch-states #:isearch-previous-string #:query-replace-state #:string1 #:string2 #:query-replace-mode Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.15 climacs/pane.lisp:1.16 --- climacs/pane.lisp:1.15 Wed Jan 26 14:49:47 2005 +++ climacs/pane.lisp Sun Jan 30 14:17:31 2005 @@ -142,7 +142,8 @@ (defclass isearch-state () ((search-string :initarg :search-string :accessor search-string) (search-mark :initarg :search-mark :accessor search-mark) - (search-forward-p :initarg :search-forward-p :accessor search-forward-p))) + (search-forward-p :initarg :search-forward-p :accessor search-forward-p) + (search-success-p :initarg :search-success-p :accessor search-success-p))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

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

30 Jan '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23067 Modified Files: base.lisp gui.lisp packages.lisp Log Message: Made query-replace respect the case of replaced strings. Date: Sun Jan 30 11:56:54 2005 Author: mvilleneuve Index: climacs/base.lisp diff -u climacs/base.lisp:1.29 climacs/base.lisp:1.30 --- climacs/base.lisp:1.29 Sat Jan 29 05:16:25 2005 +++ climacs/base.lisp Sun Jan 30 11:56:53 2005 @@ -219,6 +219,29 @@ ;;; ;;; Character case +(defun buffer-region-case (buffer offset1 offset2) + (let ((possibly-uppercase t) + (possibly-lowercase t) + (possibly-capitalized t)) + (do-buffer-region (object offset buffer offset1 offset2) + (unless (characterp object) + (return-from buffer-region-case nil)) + (when (lower-case-p object) + (setf possibly-uppercase nil)) + (when (upper-case-p object) + (setf possibly-lowercase nil)) + (when (plusp offset) + (let ((previous-object (buffer-object buffer (1- offset)))) + (when (and (characterp previous-object) + (if (constituentp previous-object) + (upper-case-p object) + (lower-case-p object))) + (setf possibly-capitalized nil))))) + (cond (possibly-uppercase :upper-case) + (possibly-lowercase :lower-case) + (possibly-capitalized :capitalized) + (t nil)))) + ;;; 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) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.103 climacs/gui.lisp:1.104 --- climacs/gui.lisp:1.103 Fri Jan 28 23:05:42 2005 +++ climacs/gui.lisp Sun Jan 30 11:56:53 2005 @@ -1120,9 +1120,13 @@ ;;; Query replace (defun query-replace-find-next-match (mark string) - (let ((offset-before (offset mark))) - (search-forward mark string) - (/= (offset mark) offset-before))) + (flet ((object-equal (x y) + (and (characterp x) + (characterp y) + (char-equal x y)))) + (let ((offset-before (offset mark))) + (search-forward mark string :test #'object-equal) + (/= (offset mark) offset-before)))) (define-named-command com-query-replace () (let* ((string1 (accept 'string :prompt "Query replace")) @@ -1143,11 +1147,21 @@ (define-named-command com-query-replace-replace () (let* ((pane (current-window)) (point (point pane)) + (buffer (buffer 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)) + (let* ((offset1 (offset point)) + (offset2 (+ offset1 string1-length)) + (region-case (buffer-region-case buffer offset1 offset2))) + (delete-range point string1-length) + (insert-sequence point (string2 state)) + (setf offset2 (+ offset1 (length (string2 state)))) + (finish-output *error-output*) + (case region-case + (:upper-case (upcase-buffer-region buffer offset1 offset2)) + (:lower-case (downcase-buffer-region buffer offset1 offset2)) + (:capitalized (capitalize-buffer-region buffer offset1 offset2)))) (unless (query-replace-find-next-match point (string1 state)) (setf (query-replace-mode pane) nil)))) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.42 climacs/packages.lisp:1.43 --- climacs/packages.lisp:1.42 Wed Jan 26 14:49:47 2005 +++ climacs/packages.lisp Sun Jan 30 11:56:53 2005 @@ -59,7 +59,10 @@ #:constituentp #:whitespacep #:forward-word #:backward-word #:delete-word #:backward-delete-word - #:upcase-region #:downcase-region #:capitalize-region + #:buffer-region-case + #:upcase-buffer-region #:upcase-region + #:downcase-buffer-region #:downcase-region + #:capitalize-buffer-region #:capitalize-region #:upcase-word #:downcase-word #:capitalize-word #:tabify-region #:untabify-region #:indent-line

1 0

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

29 Jan '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv20755/Persistent Modified Files: persistent-base-test.lisp Log Message: Test updates. Date: Sat Jan 29 14:23:17 2005 Author: abakic Index: climacs/Persistent/persistent-base-test.lisp diff -u climacs/Persistent/persistent-base-test.lisp:1.3 climacs/Persistent/persistent-base-test.lisp:1.4 --- climacs/Persistent/persistent-base-test.lisp:1.3 Fri Jan 28 10:47:34 2005 +++ climacs/Persistent/persistent-base-test.lisp Sat Jan 29 14:23:14 2005 @@ -622,10 +622,10 @@ (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)) + (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 binseq-buffer-downcase-region.test-1 (let ((buffer (make-instance 'binseq-buffer))) @@ -658,21 +658,21 @@ (deftest binseq-buffer-downcase-word.test-1 (let ((buffer (make-instance 'binseq-buffer))) - (insert-buffer-sequence buffer 0 "CLI MA CS") + (insert-buffer-sequence buffer 0 "CLI MA CS CLIMACS") (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) + "cli ma cs CLIMACS" 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)) + (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 binseq-buffer-upcase-region.test-1 (let ((buffer (make-instance 'binseq-buffer))) @@ -705,21 +705,21 @@ (deftest binseq-buffer-upcase-word.test-1 (let ((buffer (make-instance 'binseq-buffer))) - (insert-buffer-sequence buffer 0 "cli ma cs") + (insert-buffer-sequence buffer 0 "cli ma cs climacs") (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) + "CLI MA CS climacs" 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") + "cLi Ma Cs") (deftest binseq-buffer-capitalize-buffer-region.test-2 (let ((buffer (make-instance 'binseq-buffer))) @@ -759,14 +759,14 @@ (deftest binseq-buffer-capitalize-word.test-1 (let ((buffer (make-instance 'binseq-buffer))) - (insert-buffer-sequence buffer 0 "cli ma cs") + (insert-buffer-sequence buffer 0 "cli ma cs climacs") (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) + "Cli Ma Cs climacs" 9) ;;; obinseq tests @@ -1370,10 +1370,10 @@ (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)) + (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 obinseq-buffer-downcase-region.test-1 (let ((buffer (make-instance 'obinseq-buffer))) @@ -1417,10 +1417,10 @@ (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)) + (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 obinseq-buffer-upcase-region.test-1 (let ((buffer (make-instance 'obinseq-buffer))) @@ -1467,7 +1467,7 @@ (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 obinseq-buffer-capitalize-buffer-region.test-2 (let ((buffer (make-instance 'obinseq-buffer)))

1 0

[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

[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 25 Jan '05

25 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 25 Jan '05

25 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 24 Jan '05

24 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

[climacs-cvs] CVS update: climacs/gui.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-serv28656 Modified Files: gui.lisp Log Message: Factored out buffer saving into a separate function. Improved on com-quit so that it asks the user to save buffers before quitting. Date: Fri Jan 21 21:45:26 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.92 climacs/gui.lisp:1.93 --- climacs/gui.lisp:1.92 Fri Jan 21 11:39:50 2005 +++ climacs/gui.lisp Fri Jan 21 21:45:25 2005 @@ -282,9 +282,6 @@ `(,@command-name :name t) `(,command-name :name t)) ,args ,@body)) -(define-named-command (com-quit) () - (frame-exit *application-frame*)) - (define-named-command com-toggle-overwrite-mode () (with-slots (overwrite-mode) (current-window) (setf overwrite-mode (not overwrite-mode)))) @@ -631,20 +628,34 @@ ;; resets the low and high marks after redisplay (redisplay-frame-panes *application-frame*))) +(defun save-buffer (buffer) + (let ((filename (or (filename buffer) + (accept 'completable-pathname + :prompt "Save Buffer to File")))) + (with-open-file (stream filename :direction :output :if-exists :supersede) + (output-to-stream stream buffer 0 (size buffer))) + (setf (filename buffer) filename + (name buffer) (pathname-filename filename)) + (display-message "Wrote: ~a" (filename buffer)) + (setf (needs-saving buffer) nil))) + (define-named-command com-save-buffer () - (let* ((buffer (buffer (current-window))) - (filename (or (filename buffer) - (accept 'completable-pathname - :prompt "Save Buffer to File")))) + (let ((buffer (buffer (current-window)))) (if (or (null (filename buffer)) (needs-saving buffer)) - (progn (with-open-file (stream filename :direction :output :if-exists :supersede) - (output-to-stream stream buffer 0 (size buffer))) - (setf (filename buffer) filename - (name buffer) (pathname-filename filename)) - (display-message "Wrote: ~a" (filename buffer))) - (display-message "No changes need to be saved from ~a" (name buffer))) - (setf (needs-saving buffer) nil))) + (save-buffer buffer) + (display-message "No changes need to be saved from ~a" (name buffer))))) + +(define-named-command (com-quit) () + (loop for buffer in (buffers *application-frame*) + when (and (needs-saving buffer) + (accept 'boolean + :prompt (format nil "Save buffer: ~a ?" (name buffer)))) + do (save-buffer buffer)) + (when (or (notany #'needs-saving + (buffers *application-frame*)) + (accept 'boolean :prompt "Modified buffers exist. Quit anyway?")) + (frame-exit *application-frame*))) (define-named-command com-write-buffer () (let ((filename (accept 'completable-pathname

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv27428 Modified Files: climacs-internals.texi Log Message: Separated syntax from redisplay. Date: Fri Jan 21 21:15:52 2005 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.8 climacs/Doc/climacs-internals.texi:1.9 --- climacs/Doc/climacs-internals.texi:1.8 Tue Jan 18 10:59:54 2005 +++ climacs/Doc/climacs-internals.texi Fri Jan 21 21:15:50 2005 @@ -558,77 +558,77 @@ implementations may implement it fairly efficiently, say O(log n) where n is the number of lines in the buffer. -@chapter Redisplay and the syntax protocol +@chapter The syntax protocol @section General -A buffer can be on display in several panes. The redisplay -algorithm is invoked on each such pane. Each pane is associated -with a distinguished mark called the `point' of the pane. The point -is a right-sticky mark independently of whether you are typing -left-to-right or right-to-left. - -The redisplay function works by dispatching on an object of type -syntax, which determines exactly how the buffer contents is going to -be rendered in this particular pane. +A buffer may have a syntax module associated with it. The syntax +module usually consists of an incremental parser that analyzes the +contents of the buffer and creates some kind of parse tree or other +representation of the contents in order that it can be exploited by +the redisplay module and by user commands. @deftp {Protocol Class} syntax The base class for all syntaxes. - -A syntax object is a placeholder for many kinds of information -depending on the exact syntax, but in particular, it holds information -(in the form of two marks) about what part of the buffer was on -display after the previous invocation of the redisplay algorithm. @end deftp -@deftp {:initarg} :pane -Indicates the pane where rendering is to take place. -@end deftp +The redisplay module exploits the syntax module for several things: + +@itemize @bullet +@item highlighting of various syntactic entities of the buffer +@item highlighting of matching parenthesis, +@item turning syntactic entities into clickable presentations, +@item marking lines with inconsistent indentation, +@item etc. +@end itemize -All subclasses of the syntax class must support the :pane initarg. -The pane that is passed as an initarg must have a valid buffer -associated with it. +User commands can use the syntax module for: -@deffn {Function} {redisplay-pane} pane +@itemize @bullet +@item moving point by units that are specific to a particular buffer +syntax, such as expressions, statements, or paragraphs, +@item transposing syntactic units, +@item sending the text of a syntactic unit to a language processor, +@item indenting lines according to the syntax, +@item etc. +@end itemize -This function is called by the command loop on every pane that is on -display. It simply calls redisplay-with-syntax with the pane and the -syntax of the pane. -@end deffn +The view that the syntax module has of the buffer is updated only when +needed, and then only for the parts of the buffer that are needed. +Most syntax modules (such as for programming languages) need to +compute their representations from the beginning of the buffer up to a +particular point beyond which the structure of the buffer does not +need to be known. + +There are two situations where updating might be needed: -@deffn {Generic Function} {redisplay-with-syntax} pane syntax +@itemize @bullet +@item before redisplay is about to show the contents of part of the +buffer in a pane. +@item as a result of a command that exploits the syntactic entities of +the buffer contents. +@end itemize + +The first case is handled by the redisplay invoking the following +generic function before proceeding to display the buffer contents in a +pane: -Redisplay a pane using a given syntax. +@deffn {Generic Function} {update-syntax} buffer syntax mark + +Inform the syntax module that it must update its view of the buffer +contents up to the point indicated by the mark. It is acceptable to +pass an offset instead of the mark. @end deffn -This function can behave radically differently for different syntaxes. -In all cases, however, it starts by determining the current dimensions -of the pane, and compare that to the size of the region of the buffer -that is currently on display. Adjustments are made as necessary. It -then determines whether the point of the pane is within the region on -display. If not, a new region is computed in a way that the point is -as close to the middle of the pane as possible. It is important to -maintain the region on display as much as possible, so as to avoid -unnecessary scrolling. +The second case is handled by the syntax module itself when needed in +order to correctly compute the effects of a command. -The final step of this function is to render the region of the buffer -that is to be displayed. Some syntaxes can use simple algorithms that -simply draw everything in the region. Others can optimize so that -only the portions of the pane that have actually changed are redrawn. - -The redisplay-with-syntax function also implements parsing of the -buffer text. - -Simple parsers may be restricted to dividing the text into words, -possibly recognizing special words like URLs or email addresses, and -then using `present' to render these words. - -More complicated parsers may use incremental parsing techniques to -maintain sophisticated information of the buffer contents. Such a -parser needs to use the low-mark and high-mark to determine which -parts of the buffer have changed, and recompute parsing information as -necessary. +It is important to realize that the syntax module is not directly +involved in displaying buffer contents in a pane. In fact, the syntax +module should work even if there is no graphic user interface +present, and it should be exploitable by several, potentially totally +different, display units. @section Common Lisp syntax @@ -1404,6 +1404,58 @@ top element, increment the expression count of the new top entry, and perform a count check again. @end deffn + +@chapter Redisplay + +A buffer can be on display in several panes. The redisplay +algorithm is invoked on each such pane. Each pane is associated +with a distinguished mark called the `point' of the pane. The point +is a right-sticky mark independently of whether you are typing +left-to-right or right-to-left. + +@deffn {Generic Function} {redisplay-pane} pane view current-p + +This function is invoked on all panes at the end of each iteration of +the command loop. The current-p argument is a boolean that indicates +whether the pane is the one that currently has the input focus +@end deffn + +For maximum flexibility, the redisplay-pane function dispatches off of +two objects, a pane and a CLIM view. The reason for this is that the +same type of pane, such as a simple CLIM application pane, can be used +to show the buffer contents in slightly different ways: + +@itemize @bullet +@item highlighted or not, +@item highlighting tabulation characters (for makefiles) +@item showing control characters in a special font +@item etc. +@end itemize + +These minor variations are obtained by creating a special view type +and a method that dispatches on that type. + +Major differences such as the need to have pane-specific output +recording are best handled by creating a different pane type. + +The redisplay-pane function may use the current-p argument to slightly +alter the presentation such as drawing the cursor in a different +color. + +The redisplay-pane function starts by determining the current +dimensions of the pane, and compare that to the size of the region of +the buffer that is currently on display. Adjustments are made as +necessary. It then determines whether the point of the pane is within +the region on display. If not, a new region is computed in a way that +the point is as close to the middle of the pane as possible. It is +important to maintain the region on display as much as possible, so as +to avoid unnecessary scrolling. + +The final step of this function is to render the region of the buffer +that is to be displayed. Some pane types can use simple algorithms +that simply draw everything in the region. Others can optimize so +that only the portions of the pane that have actually changed are +redrawn. @chapter The undo protocol

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs January 2005