[mcclim-cvs] CVS mcclim

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv20066

Modified Files:
	menu.lisp decls.lisp commands.lisp 
Log Message:
Moved `display-command-table-menu' to menu.lisp and implemented
`display-command-menu'.


--- /project/mcclim/cvsroot/mcclim/menu.lisp	2006/05/13 00:19:36	1.36
+++ /project/mcclim/cvsroot/mcclim/menu.lisp	2006/12/14 19:43:51	1.37
@@ -415,3 +415,43 @@
 			    (- real-height 4)))
 	    (incf x width)
 	    (incf x x-spacing)))))
+
+(defmethod display-command-table-menu ((command-table standard-command-table)
+                                       (stream fundamental-output-stream)
+                                       &rest args
+                                       &key max-width max-height n-rows n-columns
+                                       x-spacing y-spacing initial-spacing
+                                       row-wise (cell-align-x :left)
+                                       (cell-align-y :top) (move-cursor t))
+  (formatting-item-list (stream :max-width max-width :max-height max-height :n-rows n-rows
+                                :n-columns n-columns :x-spacing x-spacing :y-spacing y-spacing
+                                :initial-spacing initial-spacing :row-wise row-wise
+                                :move-cursor move-cursor)
+    (map-over-command-table-menu-items
+     #'(lambda (item-name accelerator item)
+         (declare (ignore accelerator))
+         (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y)
+           (cond ((eq (command-menu-item-type item) :menu)
+                  (with-text-style (stream (make-text-style :serif '(:bold :italic) nil))
+                    (write-string item-name stream)
+                    (terpri stream))
+                  (surrounding-output-with-border (stream)
+                    (apply #'display-command-table-menu
+                           (find-command-table (command-menu-item-value item))
+                           stream args)))
+                 ((eq (command-menu-item-type item) :command)
+                  (let ((name (command-name (command-menu-item-value item))))
+                    (when (command-line-name-for-command name command-table :errorp nil)
+                      (present name 'command-name :stream stream)))))))
+     command-table)))
+
+(defmethod display-command-menu (frame (stream fundamental-output-stream)
+                                 &rest args &key
+                                 (command-table (frame-command-table frame))
+                                 initial-spacing row-wise max-width
+                                 max-height n-rows n-columns
+                                 (cell-align-x :left) (cell-align-y :top))
+  (declare (ignore initial-spacing row-wise max-width max-height
+                   n-rows n-columns cell-align-x cell-align-y))
+  (with-keywords-removed (args (:command-table))
+    (apply #'display-command-table-menu command-table stream args)))
--- /project/mcclim/cvsroot/mcclim/decls.lisp	2006/12/13 22:31:57	1.44
+++ /project/mcclim/cvsroot/mcclim/decls.lisp	2006/12/14 19:43:51	1.45
@@ -659,6 +659,18 @@
 (defgeneric run-frame-top-level (frame &key &allow-other-keys))
 (defgeneric command-enabled (command-name frame))
 (defgeneric (setf command-name) (enabled command-name frame))
+(defgeneric display-command-menu (frame stream &key command-table
+                                        initial-spacing row-wise max-width
+                                        max-height n-rows n-columns
+                                        cell-align-x cell-align-y)
+  (:documentation "Display the command table associated with
+`command-table' on `stream' by calling
+`display-command-table-menu'. If no command table is
+provided, (frame-command-table frame) will be used.
+
+The arguments `initial-spacing', `row-wise',
+`max-width', `max-height', `n-rows', `n-columns', `cell-align-x',
+and `cell-align-y' are as for `formatting-item-list'."))
 
 ;;;; 28.5.2 Frame Manager Operations
 
--- /project/mcclim/cvsroot/mcclim/commands.lisp	2006/12/13 22:30:31	1.66
+++ /project/mcclim/cvsroot/mcclim/commands.lisp	2006/12/14 19:43:51	1.67
@@ -541,35 +541,6 @@
 	      gesture))
 	gesture)))
 
-(defmethod display-command-table-menu ((command-table standard-command-table)
-                                       (stream fundamental-output-stream)
-                                       &rest args
-                                       &key max-width max-height n-rows n-columns
-                                       x-spacing y-spacing initial-spacing
-                                       row-wise (cell-align-x :left)
-                                       (cell-align-y :top) (move-cursor t))
-  (formatting-item-list (stream :max-width max-width :max-height max-height :n-rows n-rows
-                                :n-columns n-columns :x-spacing x-spacing :y-spacing y-spacing
-                                :initial-spacing initial-spacing :row-wise row-wise
-                                :move-cursor move-cursor)
-    (map-over-command-table-menu-items
-     #'(lambda (item-name accelerator item)
-         (declare (ignore accelerator))
-         (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y)
-           (cond ((eq (command-menu-item-type item) :menu)
-                  (with-text-style (stream (make-text-style :serif '(:bold :italic) nil))
-                    (write-string item-name stream)
-                    (terpri stream))
-                  (surrounding-output-with-border (stream)
-                   (apply #'display-command-table-menu
-                          (find-command-table (command-menu-item-value item))
-                          stream args)))
-                 ((eq (command-menu-item-type item) :command)
-                  (let ((name (command-name (command-menu-item-value item))))
-                   (when (command-line-name-for-command name command-table :errorp nil)
-                     (present name 'command-name :stream stream)))))))
-     command-table)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Commands