[climacs-cvs] CVS update: climacs/esa.lisp climacs/gui.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv12545

Modified Files:
	esa.lisp gui.lisp 
Log Message:
Removed functions find-climacs-pane and find-real-pane because they
are no longer needed.  

Removed stupid names from panes, because they are not needed.

Wrote a new version of set-key that can take a list of key strokes and
that creates nested command tables as needed.  Modified the esa
example to take advantage of this new feature.  Now, Climacs itself
should probably be modified to take advantage of it.


Date: Fri Jul 22 07:35:07 2005
Author: rstrandh

Index: climacs/esa.lisp
diff -u climacs/esa.lisp:1.5 climacs/esa.lisp:1.6
--- climacs/esa.lisp:1.5	Thu Jul 21 14:24:30 2005
+++ climacs/esa.lisp	Fri Jul 22 07:35:06 2005
@@ -208,13 +208,6 @@
 	    (car command)
 	    command)))
 
-(defun find-real-pane (vbox)
-  (first (sheet-children
-	  (find-if-not (lambda (pane) (typep pane 'scroll-bar-pane))
-		       (sheet-children
-			(find-if (lambda (pane) (typep pane 'scroller-pane))
-				 (sheet-children vbox)))))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Top level
@@ -270,6 +263,37 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
+;;; comand table manipulation
+
+(defun ensure-subtable (table gesture)
+  (let* ((event (make-instance
+		'key-press-event
+		:key-name nil
+		:key-character (car gesture)
+		:modifier-state (apply #'make-modifier-state (cdr gesture))))
+	 (item (find-keystroke-item event table :errorp nil)))
+    (when (or (null item) (not (eq (command-menu-item-type item) :menu)))
+      (let ((name (gensym)))
+	(make-command-table name :errorp nil)
+	(add-menu-item-to-command-table table (symbol-name name)
+					:menu name
+					:keystroke gesture)))
+    (command-menu-item-value
+     (find-keystroke-item event table :errorp nil))))
+    
+      
+(defun set-key (command table gestures)
+  (if (null (cdr gestures))
+      (add-command-to-command-table
+       command table :keystroke (car gestures) :errorp nil)
+      (set-key command
+	       (ensure-subtable table (car gestures))
+	       (cdr gestures))))
+  
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
 ;;; example application
 
 (defclass example-info-pane (info-pane)
@@ -298,7 +322,6 @@
    (win (let* ((my-pane 
 		(make-pane 'example-pane
 			   :width 900 :height 400
-			   :name 'my-pane
 			   :display-function 'display-my-pane))
 	       (my-info-pane
 		(make-pane 'example-info-pane
@@ -329,29 +352,13 @@
 		:command-table 'global-example-table)))
     (run-frame-top-level frame)))
 
-(define-command-table global-example-table)
-
-(define-command (com-quit :name t :command-table global-example-table) ()
-  (frame-exit *application-frame*))
-
-(defun set-key (command table gesture)
-  (add-command-to-command-table
-    command table :keystroke gesture :errorp nil))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
-;;; C-x command table
-
-(make-command-table 'global-c-x-example-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-example-table "C-x"
-				:menu 'global-c-x-example-table
-				:keystroke '(#\x :control))
-
-(set-key 'com-quit 'global-c-x-example-table
-	 '(#\c :control))
-
-
+;;; Commands and key bindings
 
+(define-command-table global-example-table)
 
+(define-command (com-quit :name t :command-table global-example-table) ()
+  (frame-exit *application-frame*))
 
+(set-key 'com-quit 'global-example-table '((#\x :control) (#\c :control)))


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.161 climacs/gui.lisp:1.162
--- climacs/gui.lisp:1.161	Thu Jul 21 14:24:30 2005
+++ climacs/gui.lisp	Fri Jul 22 07:35:06 2005
@@ -56,7 +56,6 @@
    (win (let* ((extended-pane 
 		(make-pane 'extended-pane
 			   :width 900 :height 400
-			   :name 'bla
 			   :end-of-line-action :scroll
 			   :incremental-redisplay t
 			   :display-function 'display-win))
@@ -134,16 +133,6 @@
 	    '((#\0 :meta) (#\1 :meta) (#\2 :meta) (#\3 :meta) (#\4 :meta)
 	      (#\5 :meta) (#\6 :meta) (#\7 :meta) (#\8 :meta) (#\9 :meta))
 	    :test #'event-matches-gesture-name-p))
-
-;;; we know the vbox pane has a scroller pane and an info
-;;; pane in it.  The scroller pane has a viewport in it,
-;;; and the viewport contains the climacs-pane as its only child.
-(defun find-climacs-pane (vbox)
-  (first (sheet-children
-	  (find-if-not (lambda (pane) (typep pane 'scroll-bar-pane))
-		       (sheet-children
-			(find-if (lambda (pane) (typep pane 'scroller-pane))
-				 (sheet-children vbox)))))))
 
 (defun substitute-numeric-argument-p (command numargp)
   (substitute numargp *numeric-argument-p* command :test #'eq))