Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7633 Modified Files: esa.lisp Log Message: Added command Describe Key C-h k (which just displays the command name for the key in the minibuffer, for now). Date: Mon Sep 5 09:06:34 2005 Author: dmurray Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.15 climacs/esa.lisp:1.16 --- climacs/esa.lisp:1.15 Thu Sep 1 03:05:51 2005 +++ climacs/esa.lisp Mon Sep 5 09:06:33 2005 @@ -234,6 +234,49 @@ (t nil))))) do (redisplay-frame-panes frame))) +(defun read-gestures-for-help (command-table) + (loop for gestures = (list (esa-read-gesture)) + then (nconc gestures (list (esa-read-gesture))) + for item = (find-gestures-with-inheritance gestures command-table) + unless item + do (return (values nil gestures)) + when (eq (command-menu-item-type item) :command) + do (return (values (command-menu-item-value item) + gestures)))) + +(defun describe-key (pane) + (let ((command-table (command-table pane))) + (multiple-value-bind (command gestures) + (read-gestures-for-help command-table) + (when (consp command) + (setf command (car command))) + (display-message "~{~A ~}~:[is not bound~;runs the command ~:*~A~]" + (mapcar #'gesture-name gestures) + (or (command-line-name-for-command + command command-table :errorp nil) + command))))) + +(defgeneric gesture-name (gesture)) + +(defmethod gesture-name ((char character)) + (or (char-name char) + char)) + +(defmethod gesture-name ((ev keyboard-event)) + (let ((key-name (keyboard-event-key-name ev)) + (modifiers (event-modifier-state ev))) + (with-output-to-string (s) + (loop for (modifier name) on (list + ;(+alt-key+ "A-") + +hyper-key+ "H-" + +super-key+ "s-" + +meta-key+ "M-" + +control-key+ "C-") + by #'cddr + when (plusp (logand modifier modifiers)) + do (princ name s)) + (princ key-name s)))) + (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p) (declare (ignore force-p)) (when (null (remaining-keys *application-frame*)) @@ -359,6 +402,13 @@ (execute-frame-command *application-frame* item))) (set-key 'com-extended-command 'global-esa-table '((#\x :meta))) + +(define-command (com-describe-key :name t :command-table global-esa-table) () + (display-message "Describe key:") + (redisplay-frame-panes *application-frame*) + (describe-key (car (windows *application-frame*)))) + +(set-key 'com-describe-key 'global-esa-table '((#\h :control) (#\k))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;