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))))
