/[mcclim]/mcclim/menu.lisp
ViewVC logotype

Diff of /mcclim/menu.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.36 by dlichteblau, Sat May 13 00:19:36 2006 UTC revision 1.37 by thenriksen, Thu Dec 14 19:43:51 2006 UTC
# Line 415  Line 415 
415                              (- real-height 4)))                              (- real-height 4)))
416              (incf x width)              (incf x width)
417              (incf x x-spacing)))))              (incf x x-spacing)))))
418    
419    (defmethod display-command-table-menu ((command-table standard-command-table)
420                                           (stream fundamental-output-stream)
421                                           &rest args
422                                           &key max-width max-height n-rows n-columns
423                                           x-spacing y-spacing initial-spacing
424                                           row-wise (cell-align-x :left)
425                                           (cell-align-y :top) (move-cursor t))
426      (formatting-item-list (stream :max-width max-width :max-height max-height :n-rows n-rows
427                                    :n-columns n-columns :x-spacing x-spacing :y-spacing y-spacing
428                                    :initial-spacing initial-spacing :row-wise row-wise
429                                    :move-cursor move-cursor)
430        (map-over-command-table-menu-items
431         #'(lambda (item-name accelerator item)
432             (declare (ignore accelerator))
433             (formatting-cell (stream :align-x cell-align-x :align-y cell-align-y)
434               (cond ((eq (command-menu-item-type item) :menu)
435                      (with-text-style (stream (make-text-style :serif '(:bold :italic) nil))
436                        (write-string item-name stream)
437                        (terpri stream))
438                      (surrounding-output-with-border (stream)
439                        (apply #'display-command-table-menu
440                               (find-command-table (command-menu-item-value item))
441                               stream args)))
442                     ((eq (command-menu-item-type item) :command)
443                      (let ((name (command-name (command-menu-item-value item))))
444                        (when (command-line-name-for-command name command-table :errorp nil)
445                          (present name 'command-name :stream stream)))))))
446         command-table)))
447    
448    (defmethod display-command-menu (frame (stream fundamental-output-stream)
449                                     &rest args &key
450                                     (command-table (frame-command-table frame))
451                                     initial-spacing row-wise max-width
452                                     max-height n-rows n-columns
453                                     (cell-align-x :left) (cell-align-y :top))
454      (declare (ignore initial-spacing row-wise max-width max-height
455                       n-rows n-columns cell-align-x cell-align-y))
456      (with-keywords-removed (args (:command-table))
457        (apply #'display-command-table-menu command-table stream args)))

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

  ViewVC Help
Powered by ViewVC 1.1.5