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

Modified Files: commands.lisp Log Message: Added portable implementation of `display-command-table-menu'.

--- /project/mcclim/cvsroot/mcclim/commands.lisp 2006/11/08 01:18:22 1.65 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2006/12/13 22:30:31 1.66 @@ -541,6 +541,35 @@ 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