Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv17974
Modified Files: gui.lisp Log Message: Patch from Christophe Rhodes implementing transpose-objects and transpose-words. Thank you.
Date: Sat Jan 1 20:58:40 2005 Author: rstrandh
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.42 climacs/gui.lisp:1.43 --- climacs/gui.lisp:1.42 Sat Jan 1 14:25:19 2005 +++ climacs/gui.lisp Sat Jan 1 20:58:40 2005 @@ -212,12 +212,6 @@ (possibly-expand-abbrev (point (win *application-frame*)))) (insert-object (point (win *application-frame*)) *current-gesture*))
-(define-named-command com-backward-object () - (decf (offset (point (win *application-frame*))))) - -(define-named-command com-forward-object () - (incf (offset (point (win *application-frame*))))) - (define-named-command com-beginning-of-line () (beginning-of-line (point (win *application-frame*))))
@@ -234,12 +228,52 @@ (let* ((point (point (win *application-frame*)))) (unless (beginning-of-buffer-p point) (when (end-of-line-p point) - (decf (offset point))) - (let ((object (object-after point))) - (delete-range point) - (decf (offset point)) - (insert-object point object) - (incf (offset point)))))) + (backward-object point)) + (let ((object (object-after point))) + (delete-range point) + (backward-object point) + (insert-object point object) + (forward-object point))))) + +(defgeneric backward-object (mark &optional count)) +(defmethod backward-object ((mark climacs-buffer::mark-mixin) + &optional (count 1)) + (decf (offset mark) count)) + +(defgeneric forward-object (mark &optional count)) +(defmethod forward-object ((mark climacs-buffer::mark-mixin) + &optional (count 1)) + (incf (offset mark) count)) + +(define-named-command com-backward-object () + (backward-object (point (win *application-frame*)))) + +(define-named-command com-forward-object () + (forward-object (point (win *application-frame*)))) + +(define-named-command com-transpose-words () + (let* ((point (point (win *application-frame*)))) + (let (bw1 bw2 ew1 ew2) + (backward-word point) + (setf bw1 (offset point)) + (forward-word point) + (setf ew1 (offset point)) + (forward-word point) + (when (= (offset point) ew1) + ;; this is emacs' message in the minibuffer + (error "Don't have two things to transpose")) + (setf ew2 (offset point)) + (backward-word point) + (setf bw2 (offset point)) + (let ((w2 (buffer-sequence (buffer point) bw2 ew2)) + (w1 (buffer-sequence (buffer point) bw1 ew1))) + (delete-word point) + (insert-sequence point w1) + (backward-word point) + (backward-word point) + (delete-word point) + (insert-sequence point w2) + (forward-word point)))))
(define-named-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -520,6 +554,7 @@ (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 '(#\t :meta) 'com-transpose-words) (global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\y :meta) 'com-kr-rotate) ;currently rotates only (global-set-key '(#\w :meta) 'com-copy-out)