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