[climacs-devel] C-x C-c

[Nyef]

And some more, which you helped with. Thank you.

This set is most of the fun bits along the right side of my keyboard. 
Arrow keys, home, end, pgup, pgdn, del, backspace.

On Mon, Dec 27, 2004 at 05:28:38AM +0100, Robert Strandh wrote:
> Thanks, I'll put that in.  Nice.  
> 
> nyef at sc.am writes:
>  > Hello all.
>  > 
>  > Just spent a little time poking at McCLIM since the C-x C-q to quit 
>  > thing was bothering me, and I came up with somewhat of a solution. A 
>  > patch is attached.
>  > 
>  > --Alastair Bridgewater
> 
> -- 
> Robert Strandh
> 
> ---------------------------------------------------------------------
> Greenspun's Tenth Rule of Programming: any sufficiently complicated C
> or Fortran program contains an ad hoc informally-specified bug-ridden
> slow implementation of half of Common Lisp.
> ---------------------------------------------------------------------

-- 
--Alastair Bridgewater
-------------- next part --------------
Index: gui.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/gui.lisp,v
retrieving revision 1.18
diff -u -r1.18 gui.lisp
--- gui.lisp	27 Dec 2004 04:32:43 -0000	1.18
+++ gui.lisp	27 Dec 2004 05:46:27 -0000
@@ -93,7 +93,15 @@
 	  do (setf *current-gesture* (read-gesture :stream *standard-input*))
 	     (when (or (characterp *current-gesture*)
 		       (and (typep *current-gesture* 'keyboard-event)
-			    (keyboard-event-character *current-gesture*)))
+			    (or (keyboard-event-character *current-gesture*)
+				(not (member (keyboard-event-key-name
+					      *current-gesture*)
+					     '(:control-left :control-right
+					       :shift-left :shift-right
+					       :meta-left :meta-right
+					       :super-left :super-right
+					       :hyper-left :hyper-right
+					       :shift-lock :caps-lock))))))
 	       (setf gestures (nconc gestures (list *current-gesture*)))
 	       (let ((item (find-gestures gestures 'global-climacs-table)))
 		 (cond ((not item)
@@ -131,6 +139,9 @@
 (define-command com-delete-object ()
   (delete-range (point (win *application-frame*))))
 
+(define-command com-backward-delete-object ()
+  (delete-range (point (win *application-frame*)) -1))
+
 (define-command com-previous-line ()
   (previous-line (point (win *application-frame*))))
 
@@ -302,6 +313,19 @@
 (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer)
 (global-set-key '(#\> :shift :meta) 'com-end-of-buffer)
 (global-set-key '(#\u :meta) 'com-browse-url)
+
+(global-set-key '(:up) 'com-previous-line)
+(global-set-key '(:down) 'com-next-line)
+(global-set-key '(:left) 'com-backward-object)
+(global-set-key '(:right) 'com-forward-object)
+(global-set-key '(:left :control) 'com-backward-word)
+(global-set-key '(:right :control) 'com-forward-word)
+(global-set-key '(:home) 'com-beginning-of-line)
+(global-set-key '(:end) 'com-end-of-line)
+(global-set-key '(:home :control) 'com-beginning-of-buffer)
+(global-set-key '(:end :control) 'com-end-of-buffer)
+(global-set-key #\Rubout 'com-delete-object)
+(global-set-key #\Backspace 'com-backward-delete-object)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;