(define (option->widget option) (let ((name (option->name option)) (val (option->value option)) (vals (option->constraint->values option)) (castproc (option->castproc option))) (let ((set-option-value! (make-option-value-setter name val castproc))) (case (option->constraint->type option) ((boolean) `(,type checkbox ,state ,val ,(when commit-value (set-option-value! (op-value state))))) (else (case (option->constraint->ctype option) ((list) (if (value-is-list? option) `(,type checklist ;; ,checklist-policy excluding ;; ,checklist-items ,vals ,checklist-items ("hdc" "hdd") ,(when commit-value (set-option-value! (op-value checklist-items)))) `(,type combobox ,rows ,vals ,current ,(index-of val vals) ,(when commit-value (set-option-value! (op-value text)))))) ((range) (let* ((vmin (car vals)) (vmax (cadr vals)) (vstep (inexact->exact (/ (- vmax vmin) 63)))) `(,type slider ,minimum ,vmin ,maximum ,vmax ,step ,vstep ,value ,val ;; b0rken, attr order matters ,(when commit-value (set-option-value! (op-value value))) ,(when changed (format #t "value changed\n"))))) (else `(,type edit ,(if (number? val) (number->string val) val) ,(when commit-value (set-option-value! (op-value text))) ,(when changed (format #t "value changed\n")))))))))) (document:envelop with-proxy-attributes ((option ((proxy-set self opt) (op-pixmap pixmap (option->pixmap opt)) (op-title text (option->title opt)) (apply op-value (option->widget opt)))) (commit ((proxy-get self) (op-value commit-value))))) (hbox ;;layout-policy 100 -1 (document:id op-pixmap (label "")) (document:id op-title (label "")) ;; layout-policy 30 -1)) (document:id op-value (value-widget)))