Update of /project/mcclim/cvsroot/mcclim/Goatee In directory clnet:/tmp/cvs-serv22853
Modified Files: goatee-command.lisp Log Message: Add transpose-chars, bind it to C-t; add control-modified commands bindings:
* C-left, C-right * C-backspace, C-delete
--- /project/mcclim/cvsroot/mcclim/Goatee/goatee-command.lisp 2005/12/05 22:40:01 1.20 +++ /project/mcclim/cvsroot/mcclim/Goatee/goatee-command.lisp 2006/03/11 11:25:03 1.21 @@ -216,6 +216,29 @@ (error "Last operation was not a yank!")) (yank-prev *kill-ring* *buffer* *insert-extent*))
+;; Transposing (taken from climacs) + +(defun at-beginning-of-buffer-p (buffer) + (and (first-line-p (line (point buffer))) + (zerop (pos (point buffer))))) + +(defun at-end-of-line-p (buffer) + (multiple-value-bind (line pos) (location* (point buffer)) + (declare (ignore line)) + (multiple-value-bind (eoline eolpos) (end-of-line* buffer) + (declare (ignore eoline)) + (= eolpos pos)))) + +(defun cmd-transpose-chars (&key &allow-other-keys) + (unless (at-beginning-of-buffer-p *buffer*) + (with-point (*buffer*) + (when (at-end-of-line-p *buffer*) + (backward-character)) + (let ((object (char-ref *buffer* (point *buffer*)))) + (delete-char *buffer*) + (backward-character) + (insert *buffer* object))))) + ;; Line motion
(defun up-line (&key &allow-other-keys) @@ -284,6 +307,9 @@ (add-gesture-command-to-table '(:right :meta) 'forward-word *simple-area-gesture-table*) +(add-gesture-command-to-table '(:right :control) + 'forward-word + *simple-area-gesture-table*)
(add-gesture-command-to-table '(#\b :meta) 'backward-word @@ -291,15 +317,24 @@ (add-gesture-command-to-table '(:left :meta) 'backward-word *simple-area-gesture-table*) +(add-gesture-command-to-table '(:left :control) + 'backward-word + *simple-area-gesture-table*)
(add-gesture-command-to-table '(#\backspace :meta) 'backwards-delete-word *simple-area-gesture-table*) +(add-gesture-command-to-table '(#\backspace :control) + 'backwards-delete-word + *simple-area-gesture-table*)
+(add-gesture-command-to-table '(#\d :meta) + 'delete-word + *simple-area-gesture-table*) (add-gesture-command-to-table '(#\delete :meta) 'delete-word *simple-area-gesture-table*) -(add-gesture-command-to-table '(#\d :meta) +(add-gesture-command-to-table '(#\delete :control) 'delete-word *simple-area-gesture-table*)
@@ -343,6 +378,10 @@ 'cmd-yank *simple-area-gesture-table*)
+(add-gesture-command-to-table '(#\t :control) + 'cmd-transpose-chars + *simple-area-gesture-table*) + #+nil (add-gesture-command-to-table '(#\y :meta) 'cmd-yank-next