#:word-wrap #f
#:parent window)))))
+(define (on-scrollbar-event id caller)
+ (if (= id GUI-ID-TRANSPARENCY-SCROLLBAR)
+ (let ((pos (get-position caller)))
+ (set-skin-transparency pos (get-skin gui-env))))
+ #f)
+
+(define (on-button-event id)
+ (cond ((= id GUI-ID-QUIT-BUTTON)
+ ;; quit
+ (close-device device)
+ #t)
+
+ ((= id GUI-ID-NEW-WINDOW-BUTTON)
+ ;; new-window
+ (open-new-window)
+ #t)
+
+ ((= id GUI-ID-FILE-OPEN-BUTTON)
+ ;; open file
+ (add-item! listbox "File open")
+ (add-file-open-dialog! gui-env
+ #:title "Please choose a file"
+ #:restore-cwd #t)
+ #t)
+
+ (else #f)))
+
+(define (on-file-selected-event caller)
+ (add-item! listbox (get-file-name caller))
+ #f)
+
+(define (on-gui-event event)
+ (let* ((caller (get-event-gui-caller event))
+ (id (get-id caller))
+ (event-type (get-event-gui-type event)))
+ (cond ((equal? event-type 'scrollbar-changed)
+ (on-scrollbar-event id caller))
+ ((equal? event-type 'button-clicked)
+ (on-button-event id))
+ ((equal? event-type 'file-selected)
+ (on-file-selected-event caller))
+ (else #f))))
+
(define (on-event event)
(if (equal? (get-event-type event) 'gui-event)
- (let* ((caller (get-event-gui-caller event))
- (id (get-id caller))
- (event-type (get-event-gui-type event)))
-
- (cond ((equal? event-type 'scrollbar-changed)
- (if (= id GUI-ID-TRANSPARENCY-SCROLLBAR)
- (let ((pos (get-position caller)))
- (set-skin-transparency pos (get-skin gui-env))))
- #f)
-
- ((equal? event-type 'button-clicked)
- (cond ((= id GUI-ID-QUIT-BUTTON)
- ;; quit
- (close-device device)
- #t)
-
- ((= id GUI-ID-NEW-WINDOW-BUTTON)
- ;; new-window
- (open-new-window)
- #t)
-
- ((= id GUI-ID-FILE-OPEN-BUTTON)
- ;; open file
- (add-item! listbox "File open")
- (add-file-open-dialog! gui-env
- #:title "Please choose a file"
- #:restore-cwd #t)
- #t)
-
- (else #f)))
-
- ((equal? event-type 'file-selected)
- (add-item! listbox (get-file-name caller))
- #f)
-
- (else #f)))
-
+ (on-gui-event event)
#f))
(set-event-receiver! device (make-event-receiver on-event))