Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv6678/Drei
Modified Files: base.lisp editing.lisp motion.lisp packages.lisp Log Message: Fixed some word-motion and word-transposition bugs.
--- /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2008/01/02 14:43:40 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/base.lisp 2008/01/05 20:08:32 1.10 @@ -431,6 +431,12 @@ until (offset-end-of-line-p buffer offset) finally (return offset)))
+(defun extract-region (mark-or-offset1 mark-or-offset2) + "Delete the region delimited by `mark-or-offset1' and +`mark-or-offset2', returning the extracted sequence of objects." + (prog1 (region-to-sequence mark-or-offset1 mark-or-offset2) + (delete-region mark-or-offset1 mark-or-offset2))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Character case --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/12/21 14:22:07 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2008/01/05 20:08:32 1.10 @@ -176,42 +176,50 @@ ,(concat "Transpose two " plural " at MARK."))) (defmethod ,transpose ((mark right-sticky-mark) syntax) - (let (start1 end1 start2 end2) - (,backward mark syntax 1 nil) - (setf start1 (clone-mark mark)) - (,forward mark syntax 1 #'error-limit-action) - (setf end1 (clone-mark mark)) - (,forward mark syntax 1 #'error-limit-action) - (setf end2 (clone-mark mark)) - (,backward mark syntax 1 nil) - (setf start2 (clone-mark mark)) - (let ((obj1 (buffer-sequence (buffer mark) (offset start1) (offset end1))) - (obj2 (buffer-sequence (buffer mark) (offset start2) (offset end2)))) - (,forward-delete mark syntax 1 nil) - (insert-sequence mark obj1) - (,backward mark syntax 2 nil) - (,forward-delete mark syntax 1 nil) - (insert-sequence mark obj2) - (,forward mark syntax 1 nil)))) + (let ((start1 (clone-mark mark))) + (,backward start1 syntax 1 nil) + (let ((end1 (clone-mark start1))) + (,forward end1 syntax 1 #'error-limit-action) + (let ((start2 (clone-mark end1))) + (,forward start2 syntax 1 #'error-limit-action) + (let ((end2 (clone-mark start2))) + (,backward start2 syntax 1 nil) + (as-region (start1 end1) + (as-region (start2 end2) + (when (mark> start1 start2) + (psetf start1 start2 + end1 end2 + start2 start1 + end2 end1)) + (if (mark> end1 start2) + (error-limit-action mark (offset mark) 0 ,unit-name syntax) + (let ((obj2 (extract-region start2 end2))) + (insert-sequence start2 (extract-region start1 end1)) + (insert-sequence start1 obj2) + (setf (offset mark) (offset end2))))))))))) (defmethod ,transpose ((mark left-sticky-mark) syntax) - (let (start1 end1 start2 end2) - (,backward mark syntax 1 nil) - (setf start1 (clone-mark mark)) - (,forward mark syntax 1 #'error-limit-action) - (setf end1 (clone-mark mark)) - (,forward mark syntax 1 #'error-limit-action) - (setf end2 (clone-mark mark)) - (,backward mark syntax 1 nil) - (setf start2 (clone-mark mark)) - (let ((obj1 (buffer-sequence (buffer mark) (offset start1) (offset end1))) - (obj2 (buffer-sequence (buffer mark) (offset start2) (offset end2)))) - (,forward-delete mark syntax 1 nil) - (insert-sequence mark obj1) - (,forward mark syntax 1 nil) - (,backward mark syntax 2 nil) - (,forward-delete mark syntax 1 nil) - (insert-sequence mark obj2)))))))) + (let ((start1 (clone-mark mark))) + (,backward start1 syntax 1 nil) + (let ((end1 (clone-mark start1))) + (,forward end1 syntax 1 #'error-limit-action) + (let ((start2 (clone-mark end1))) + (,forward start2 syntax 1 #'error-limit-action) + (let ((end2 (clone-mark start2))) + (,backward start2 syntax 1 nil) + (as-region (start1 end1) + (as-region (start2 end2) + (when (mark> start1 start2) + (psetf start1 start2 + end1 end2 + start2 start1 + end2 end1)) + (if (mark> end1 start2) + (error-limit-action mark (offset mark) 0 ,unit-name syntax) + (let ((obj2 (extract-region start2 end2))) + (insert-sequence start2 (extract-region start1 end1)) + (insert-sequence start1 obj2) + (setf (offset mark) (offset end2)))))))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2007/08/20 19:44:44 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/motion.lisp 2008/01/05 20:08:32 1.6 @@ -267,24 +267,24 @@ Return T if successful, or NIL if the buffer limit was reached."))
(defmethod forward-one-word (mark syntax) - (forward-to-word-boundary mark syntax) - (and (not (end-of-buffer-p mark)) - (loop until (end-of-buffer-p mark) - while (word-constituentp syntax (object-after mark)) - do (forward-object mark) - finally (return t)))) + (unless (end-of-buffer-p mark) + (forward-to-word-boundary mark syntax) + (loop until (end-of-buffer-p mark) + while (word-constituentp syntax (object-after mark)) + do (forward-object mark) + finally (return t))))
(defgeneric backward-one-word (mark syntax) (:documentation "Move MARK backward over the previous word. Return T if successful, or NIL if the buffer limit was reached."))
(defmethod backward-one-word (mark syntax) - (backward-to-word-boundary mark syntax) - (and (not (beginning-of-buffer-p mark)) - (loop until (beginning-of-buffer-p mark) - while (word-constituentp syntax (object-before mark)) - do (backward-object mark) - finally (return t)))) + (unless (beginning-of-buffer-p mark) + (backward-to-word-boundary mark syntax) + (loop until (beginning-of-buffer-p mark) + while (word-constituentp syntax (object-before mark)) + do (backward-object mark) + finally (return t))))
(define-motion-fns word)
--- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/05 09:17:37 1.32 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/05 20:08:32 1.33 @@ -111,6 +111,7 @@ #:offset-beginning-of-line-p #:offset-end-of-line-p #:end-of-line-offset + #:extract-region #:buffer-whitespacep #:buffer-region-case #:buffer-looking-at #:looking-at