-(defun create-radio-button-group (specs active &optional callback &rest args)
- (let ((group nil)
- (i 0))
- (mapcar
- #'(lambda (spec)
- (destructuring-bind
- (label &optional object &rest initargs) (mklist spec)
- (let ((button
- (apply
- #'make-instance 'radio-button
- :label label :visible t initargs)))
- (when group (%radio-button-set-group button group))
- (setq group (%radio-button-get-group button))
- (cond
- (callback
- (signal-connect
- button 'toggled
- #'(lambda ()
- (when (toggle-button-active-p button)
- (apply (funcallable callback) object args)))))
- (object
- (signal-connect
- button 'toggled
- #'(lambda ()
- (apply
- (funcallable object)
- (toggle-button-active-p button) args)))))
- (when (= i active)
- (setf (toggle-button-active-p button) t))
- (incf i)
- button)))
- specs)))
-
-(defun create-option-menu (specs active &optional callback &rest initargs)
- (let ((menu (make-instance 'menu))
- (group nil)
- (i 0))
- (dolist (spec specs)
- (destructuring-bind (label &optional item-callback) (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 callback :object t))
- (item-callback
- (signal-connect menu-item 'toggled item-callback :object t)))
- (incf i)
- (menu-shell-append menu menu-item))))
-
- (make-instance 'option-menu :history active :menu menu)))
-
-;; (defun sf (n)
-;; (coerce n 'single-float))
-