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