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))