Author: junrue Date: Fri Mar 3 17:27:21 2006 New Revision: 24
Modified: trunk/src/uitoolkit/widgets/menu-language.lisp Log:
Modified: trunk/src/uitoolkit/widgets/menu-language.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/menu-language.lisp (original) +++ trunk/src/uitoolkit/widgets/menu-language.lisp Fri Mar 3 17:27:21 2006 @@ -53,7 +53,9 @@ ;;;
(defclass base-menu-generator () - ((menu-stack :accessor menu-stack-of + ((commands :accessor commands-of + :initform nil) + (menu-stack :accessor menu-stack-of :initform nil)))
(defgeneric define-item (generator label dispatcher disabled checked image) @@ -61,10 +63,10 @@ (:method (generator label dispatcher disabled checked image) (declare (ignorable generator label dispatcher disabled checked image))))
-(defgeneric define-submenu (generator label body dispatcher disabled) +(defgeneric define-submenu (generator label dispatcher disabled) (:documentation "Defines a submenu and its associated item on the parent menu.") - (:method (generator label body dispatcher disabled) - (declare (ignorable generator label body dispatcher disabled)))) + (:method (generator label dispatcher disabled) + (declare (ignorable generator label dispatcher disabled))))
(defgeneric define-separator (generator) (:documentation "Defines a separator.") @@ -144,14 +146,17 @@ (if (or checked image sep (not (listp sub))) (error 'gfs:toolkit-error :detail "invalid option for submenu"))) (cond - (sep `(define-separator ,generator)) - (sub `(define-submenu ,generator ,label ,sub ,disp ,disabled)) - (t `(define-item ,generator ,label ,disp ,disabled ,checked ,image))))) - -#| - (mapcar #'(lambda (var) (process-item-form gen var)) body) - (complete-submenu gen))) -|# + (sep (push (commands-of generator) `(define-separator ,generator))) + (sub (push (commands-of generator) `(define-submenu ,generator + ,label + ,disp + ,disabled))) + (t (push (commands-of generator) `(define-item ,generator + ,label + ,disp + ,disabled + ,checked + ,image))))))
;;; ;;; interpreter for debugging @@ -159,7 +164,8 @@
(defun interp-menusystem (sexp) (let ((gen (make-instance 'base-menu-generator))) - (mapcar #'(lambda (var) (process-item-form gen var)) sexp))) + (mapcar #'(lambda (var) (process-item-form gen var)) sexp) + (commands-of gen)))
;;; ;;; the real generator @@ -187,7 +193,7 @@ (setf (slot-value it 'gfi:handle) hmenu) (vector-push-extend it (items owner))))
-(defmethod define-submenu ((gen win32-menu-generator) label body dispatcher disabled) +(defmethod define-submenu ((gen win32-menu-generator) label dispatcher disabled) (let* ((submenu (make-instance 'menu :handle (gfs::create-popup-menu) :dispatcher dispatcher)) (parent (first (menu-stack-of gen))) (item (append-submenu parent label submenu))) @@ -200,4 +206,5 @@ (defmacro defmenusystem (sexp) (let ((gen (gensym))) `(let ((,gen (make-instance 'win32-menu-generator))) - ,@(loop for form in sexp append (process-item-form gen form))))) + (loop for form in sexp do (process-item-form gen form)) + ,@(commands-of ,gen))))