Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25135
Modified Files: gui.lisp Log Message: Added command menu.
Only covers a few generic commands for now. I think McCLIM support for :inherit-menu would make this implementable in a much better way.
--- /project/climacs/cvsroot/climacs/gui.lisp 2008/01/26 23:06:04 1.256 +++ /project/climacs/cvsroot/climacs/gui.lisp 2008/01/28 17:08:50 1.257 @@ -226,32 +226,61 @@ global-esa-table esa-io-table))
+;; This command table is what assembles the various other command +;; tables for the commands actually accessible by the user. (defclass climacs-command-table (standard-command-table) ())
(defmethod command-table-inherit-from ((table climacs-command-table)) - (append (when (typep (current-window) 'climacs-pane) - (view-command-tables (current-view))) + (append (view-command-tables (current-view)) '(global-climacs-table) - (when (and (typep (current-window) 'climacs-pane) - (use-editor-commands-p (current-view))) + (when (use-editor-commands-p (current-view)) '(editor-table)) (call-next-method)))
+;; This is the actual command table that will be used for Climacs. +(make-command-table 'climacs-global-table + :inherit-from (list (make-instance 'climacs-command-table + :name 'climacs-dispatching-table)) + :menu `(("File" :menu ,(make-command-table nil + :inherit-from 'esa-io-table + :menu `(("Find File" + :command (com-find-file ,*unsupplied-argument-marker*)) + ("Find File (read-only)" + :command (com-find-file-read-only ,*unsupplied-argument-marker*)) + ("Save Buffer" + :command (com-save-buffer)) + ("Save Bufer As" + :command (com-write-buffer ,*unsupplied-argument-marker*)) + ("Set Visited File Name" + :command (com-set-visited-file-name ,*unsupplied-argument-marker*)) + (nil :divider :line) + ("Quit" :command com-quit)))) + ("Help" :menu ,(make-command-table nil + :inherit-from 'help-table + :menu `(("Where is" :command com-where-is) + ("Describe Bindings" :command (com-describe-bindings nil)) + ("Describe Bindings (sorted)" :command (com-describe-bindings t)) + ("Describe Key" :command com-describe-key) + ("Describe Command" + :command (com-describe-command ,*unsupplied-argument-marker*)) + ("Apropos Command" + :command (com-apropos-command ,*unsupplied-argument-marker*)))))) + :errorp nil) + (define-application-frame climacs (esa-frame-mixin standard-application-frame) ((%views :initform '() :accessor views) (%groups :initform (make-hash-table :test #'equal) :accessor groups) (%active-group :initform nil :accessor active-group) (%kill-ring :initform (make-instance 'kill-ring :max-size 7) :accessor kill-ring) - (%command-table :initform (make-instance 'climacs-command-table - :name 'climacs-dispatching-table) + (%command-table :initform (find-command-table 'climacs-global-table) :accessor find-applicable-command-table :accessor frame-command-table) (%output-stream :accessor output-stream :initform nil :initarg :output-stream)) - (:menu-bar nil) + (:menu-bar climacs-global-table) (:panes (climacs-window (let* ((*esa-instance* *application-frame*)