Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv17375

Modified Files: editing.lisp Log Message: Hm! Apparently we need different transposition methods for left- and right-sticky-marks.

--- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/14 10:31:37 1.2 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2006/11/29 09:39:57 1.3 @@ -166,7 +166,7 @@ (:documentation ,(concat "Transpose two " plural " at MARK."))) (defmethod ,transpose - (mark syntax) + ((mark right-sticky-mark) syntax) (let (start1 end1 start2 end2) (,backward mark syntax 1 nil) (setf start1 (clone-mark mark)) @@ -190,7 +190,33 @@ (insert-sequence mark obj2) (update-syntax (buffer syntax) syntax) - (,forward mark syntax 1 nil)))))))) + (,forward mark syntax 1 nil)))) + (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) + ;; KLUDGE: Having to do this manually is ugly, but it + ;; is necessary if the motion functions uses syntax + ;; information. + (update-syntax (buffer syntax) + syntax) + (,backward mark syntax 2 nil) + (,forward-delete mark syntax 1 nil) + (insert-sequence mark obj2) + (update-syntax (buffer syntax) + syntax))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;