-(defun create-option-menu (specs active &optional callback &rest args)
- (let ((menu (make-instance 'menu))
- (group nil)
- (i 0))
- (dolist (spec specs)
- (destructuring-bind (label &optional object &rest initargs) (mklist spec)
- (let ((menu-item
- (apply
- #'make-instance 'radio-menu-item
- :label label :active (= i active) initargs)))
- (when group (%radio-menu-item-set-group menu-item group))
- (setq group (%radio-menu-item-get-group menu-item))
- (cond
- (callback
- (signal-connect
- menu-item 'activated
- #'(lambda ()
- (apply (funcallable callback) object args))))
- (object
- (signal-connect
- menu-item 'toggled
- #'(lambda ()
- (apply
- (funcallable object)
- (check-menu-item-active-p menu-item) args)))))
- (incf i)
- (menu-shell-append menu menu-item))))
-
- (make-instance 'option-menu :history active :menu menu)))