Racket GUI, can not write in a text field

Question

I'm currently writing a program (in Racket) in which I use multiple tabs.

To do so I use the "tab-panel%". For each tab I then make a new vertical panel. When someone clicks on a tab, my callback procedure is called and I change the children of the "tab-panel%" so that now the vertical panel of the tab (the user clicked on) is set as child of the tab-panel.

I do so by sending following messages :

(send tab-panel change-chidren (lambda (x) '())) ; Deletes all childs
(send tab-pannel add-child vertical-panel-of-the-clicked-tab)

I do so because if I only use one vertical panel for all of my tabs, then when I create widgets, they are placed under the already existing widgets. If then I only show the widgets of the selected tab and hide the others, the widgets will not begin at the top of my tab (because other tabs also have widgets, which may be created before this one and thus be above this widget (since we are using a vertical panel)). So I found out that using one vertical panel for each tab and changing the child of the tab-panel to the vertical panel of the selected tab solves this problem.

But since I did so I cannot write any more in my "text-field%" widgets.. When I click on it nothing happens (the callback is not even called). Only if I do a right click and then choose for example "paste" it will paste it in the text field and then my callback procedure is called.

Long story short : My vertical panels are all used for one specific tab and all have as parent the tab-panel. When clicking on a tab I change the child of the tab-panel to the vertical panel of the selected tab.

Does anyone know why I cannot write in the text-field widgets?

I searched the documentation for a message to block/activate text input (maybe that changing the child of the tab panel blocks the text fields) but didn't found.

EDIT : Notice that all the other widgets work correctly, except for the text fields.

Here's the code:

; Remark the code below belongs to 2 different files. The "make-tab-beheerder" and "simple-widgets" procedures belong in one file, the rest belongs to another file which uses the first one.

; "make-tab-beheerder" is an abstraction to easily open and close tabs
; It's an ad-hoc object constructor. The return value is a closure
; that exposes the internal defines as methods.
(define (make-tab-beheerder list-of-tab-names widget-maker)
  (let* ((idx-of-current-tab -1)
         (nr-of-tabs (length list-of-tab-names))
         (tabs (make-vector nr-of-tabs '()))
         (tab-panel '())
         (panels (make-vector nr-of-tabs '())))

    ; Before opening/closing a tab the tab-panel has to be set. It's the parent of all vertical panels
    (define (set-tab-panel! t-panel)
      (set! tab-panel t-panel)
      (vector-map! (lambda (elmt) (let ((panel ((widget-maker 'make-vertical-panel) tab-panel 'center 'top)))
                                    (send panel enable #f)
                                    panel))
                   panels))

    ; Not relevant
    (struct tab-element (widget enable-proc disable-proc))

    (define (make-tab-widget widget enable-proc disable-proc)
      (tab-element widget enable-proc disable-proc))

    ; Not relevant (when I add widgets to a tab I give a "enable" and "disable" procedure, to enable/disable them in a             generic way
    (define (add-widget-to-tab tab-name widget enable-widget-proc disable-widget-proc)
      (let* ((idx (zoek-index tab-name list-of-tab-names string=?))
             (already-added-widgets (vector-ref tabs idx)))

        (send widget show #f) ; Widget hidden
        (vector-set! tabs idx (cons (make-tab-widget widget enable-widget-proc disable-widget-proc) already-added-widgets))))

    (define (open-tab idx)
      (let ((elements-to-open (if (or (< idx 0) (> idx (- (vector-length tabs) 1)))
                                  '()
                                  (vector-ref tabs idx)))
            (panel (vector-ref panels idx)))

        ; Eerst de vorige tab sluiten
        (close-tab idx-of-current-tab)

        (define (open-all elements-lst)
          (when (not (null? elements-lst)) ; There still are widgets (belonging to the tab) we have to open.
            (let* ((elmt (car elements-lst))
                   (widget (tab-element-widget elmt))
                   (enable-proc (tab-element-enable-proc elmt)))
              (enable-proc widget)
              (open-all (cdr elements-lst)))))

        ; Change children to set the vertical panel of the chosen tab as child.
        (send tab-panel change-children (lambda (x) '())) ; We deleten alle kinderen
        (send tab-panel add-child panel)

        (open-all elements-to-open)
        (set! idx-of-current-tab idx)))

    ; Not relevant
    (define (close-tab idx)
      (let ((tab-elements-to-close (if (or (= idx -1) (> idx (- (vector-length tabs) 1)))
                                       '()
                                       (vector-ref tabs idx))))

        (for-each (lambda (tab-elmt) (let ((disable-proc (tab-element-disable-proc tab-elmt))
                                           (widget (tab-element-widget tab-elmt)))
                                       (disable-proc widget))) tab-elements-to-close)
        (set! idx-of-current-tab -1)))

    ; ...

    (define (dispatch msg)
      (cond ((eq? msg 'open-tab) open-tab)
            ((eq? msg 'add-widget-to-tab) add-widget-to-tab)
            ((eq? msg 'clear-tab!) clear-tab!)
            ((eq? msg 'get-tab-panel) get-tab-panel)
            ((eq? msg 'set-tab-panel!) set-tab-panel!)
            (else (display "Bericht werd niet verstaan! -- make-tab-panel - Graphics") (newline))))
    dispatch))

; This is an abstraction I wrote on top of the Racket GUI
(define (simple-widgets)

  ; Irrelevant code omitted

  (define (add-panel parent alignment min-width min-height stretchable-width? stretchable-height?)
    (new panel%  
         [parent parent]         
         [style (list 'border)]  
         [enabled #t]    
         ;[vert-margin vert-margin]      
         ;[horiz-margin horiz-margin]    
         ;[border border]        
         ;[spacing spacing]      
         [alignment alignment]   
         [min-width min-width]   
         [min-height min-height]         
         [stretchable-width stretchable-width?]  
         [stretchable-height stretchable-height?]))

  (define (add-vertical-panel parent links-midden-of-rechts boven-midden-of-onder)
    (new vertical-panel% [parent parent]
         [alignment (list links-midden-of-rechts boven-midden-of-onder)]))

  (define (add-horizontal-panel parent links-midden-of-rechts boven-midden-of-onder . extra)
    (let ((min-width (if (null? extra)
                         #f
                         (car extra)))
          (min-height (if (or (null? extra) (null? (cdr extra)))
                          #f
                          (cadr extra))))
      (new horizontal-panel%
           [parent parent]
           [alignment (list links-midden-of-rechts boven-midden-of-onder)]
           [min-width min-width]         
           [min-height min-height]
           [stretchable-width #t]        
           [stretchable-height #f])))

  (define (add-tab-panel list-of-labels callback-proc parent alignment-arg min-width min-height stretchable-width? stretchable-height?)
    (new tab-panel%      
         [choices list-of-labels]                
         [parent parent]
         [callback callback-proc]                
         [enabled #t]    
         [alignment alignment-arg]       
         [min-width min-width]   
         [min-height min-height]         
         [stretchable-width stretchable-width?]  
         [stretchable-height stretchable-height?]))

  (define (add-text-field label parent callback init-value)
    (new text-field%     
         [label label]   
         [parent parent]         
         [callback callback]     
         [init-value init-value]         
         ;[style style]  
         ;[font font]    
         [enabled #t]    
         ;[vert-margin vert-margin]      
         ;[horiz-margin horiz-margin]    
         ;[min-width min-width]  
         ;[min-height min-height]        
         [stretchable-width #f]  
         [stretchable-height #f]))

  (define (add-editor-canvas parent label)
    (new editor-canvas%
         (parent parent)
         (label label)))

  ; Irrelevant code omitted  

  (define (dispatch msg)
    (cond ((eq? msg 'make-dialog) add-dialog)
          ((eq? msg 'make-editor-canvas) add-editor-canvas)
          ((eq? msg 'make-menu-bar) add-menu-bar)
          ((eq? msg 'make-menu) add-menu-to-menu-bar)
          ((eq? msg 'make-menu-item) add-menu-item)
          ((eq? msg 'make-text) add-text)
          ((eq? msg 'make-message) add-message)
          ((eq? msg 'append-text) append-text)
          ((eq? msg 'make-button) add-button)
          ((eq? msg 'set-button-label!) set-button-label!)
          ((eq? msg 'make-panel) add-panel)
          ((eq? msg 'make-vertical-panel) add-vertical-panel)
          ((eq? msg 'make-horizontal-panel) add-horizontal-panel)
          ((eq? msg 'make-slider) add-slider)
          ((eq? msg 'make-gauge) add-gauge)
          ((eq? msg 'setGaugeValue!) setGaugeValue!)
          ((eq? msg 'make-tab-panel) add-tab-panel)
          ((eq? msg 'make-choice) add-choice)
          ((eq? msg 'add-choice) add-choice-to-choice-widget)
          ((eq? msg 'make-text-field) add-text-field)
          (else (display "Bericht werd niet verstaan -- dispatch - simple-widgets") (newline))))
  dispatch)

; Second file, uses the abstraction ("simple-widgets") built on top of the Racket GUI.
(define (addWidgetToTab tabName widget)
      ((tabBeheerder 'add-widget-to-tab) tabName widget
                                         (lambda (widget) (send widget show #t))
                                         (lambda (widget) (send widget show #f))))

(define (makeTrainTabWidgets tabPaneel tabBeheerder)
      (let ((nameOfNewTrain '()))

        ; Callback for the text field
        (define (trainNameCallback tekstVeldje controleEvenement)
          (set! nameOfNewTrain (send tekstVeldje get-value)))

        (let* ((trainNameField ((widgetMaker 'make-text-field) "Name" tabPaneel trainNameCallback "Write train name here")))

        ; Stuff omitted

          (addWidgetToTab "Train" trainNameField)))))

; Define the necessary things and make the "train" tab which contains the text field.
(define tabBeheerder (make-tab-beheerder (list "Simulatie" "Train" "Traject" "Settings") widgetMaker))
((tabBeheerder 'set-tab-panel!) tabPaneel) ; "tabPaneel" is just a tab-panel%
(makeTrainTabWidgets ((tabBeheerder 'get-tab-panel) "Train") tabBeheerder)

I can't reproduce your problem on Linux. When I try, I end up with a GUI in which the text fields work properly, even after the `vertical-panel%` containing them has been added and removed repeatedly from the `tab-panel%`. [Here is what I tried.](http://pastebin.com/qqTHb2Sr) — Throw Away Account, Mar 17 '15 at 11:11
I tested u'r example and it works indeed. Now I'm searching what's wrong in my program but couldn't find it. I already had the tabs and text fields a few weeks ago, and they worked. But recently I changed the code a bit so that each tab begins at the top of the tab panel and since then it doesn't work any more. I really don't understand why because everything I had before still works except the text fields (and I didn't changed anything to the text fields...). Here is the relevant part of my code : http://pastebin.com/5DvyL5dD — Kevin, Mar 17 '15 at 18:00

Throw Away Account · Accepted Answer · 2015-03-18T03:24:48.380

I got your code to work now, and I'm finding I need to do (send the-vertical-panel enable #t) before I can edit the text-fields. That's because you go through all the panels in set-tab-panel! and do (send panel enable #f) on them, which seems unnecessary if you're also removing them from view with change-children.

It also seems unnecessary to do (send widget show #f) and (send widget enable #f) on each widget, since the widgets are only visible and interactive if their parent vertical-panel% is visible.

Also, you could avoid having to write that cond block at the end of every closure by writing a macro to do it for you:

(define-syntax define-closure-class
  (syntax-rules (define struct)
    ((_ (constructor-name . constructor-args)
        ((member-name member-value) ...)
        (define (method-name . method-args) . method-body) ...)
     (define (constructor-name . constructor-args)
         (let* ((member-name member-value) ...)
       (define (method-name . method-args) . method-body) ...
       (define (dispatch method)
         (case method
           ((method-name) method-name)
           ...
           (else (error (format "No such method: ~a" method)))))
       dispatch)))))

Then you can do this:

(define-closure-class (make-simple-object arg1 arg2)
  ((local-var1 1)
   (local-var2 2))
  (define (set-local1 new-value)
     (set! local-var1 new-value))
  (define (set-local2 new-value)
     (set! local-var2 new-value))
  (define (get-sum) (+ local-var1 local-var2 arg1 arg2)))

Then make-simple-object works just like your make-tab-beheerder. How to make struct work inside that form without resorting to syntax-case is an exercise for the reader.

Or you could just use Racket's classes, and extend the tab-panel% class to include everything you put into make-tab-beheerder.

score 0 · Answer 2 · answered Mar 18 '15 at 01:51

@Throwaway Account 3 Mil : Thanks for the help! But the "tabPaneel" which is the parent of the text field isn't the tab-panel. It's a formal parameter (argument) off the procedure, the name I choose for that argument was also "tabPaneel", a bit confusing.

(define (makeTrainTabWidgets tabPaneel tabBeheerder)

When I call the "makeTrainTabWidgets" procedure I pass as actual parameter the vertical panel of that tab.

(makeTrainTabWidgets ((tabBeheerder 'get-tab-panel) "Train") tabBeheerder)

The "get-tab-panel" message will simply return the right vertical panel.

(define (get-tab-panel name)
  (if (null? panels) ; Not yet initialized
      (begin (display "De panelen werden nog niet geïnitialiseerd. Het paneel van een tab kan dus nog niet worden opgevraagd.")(newline))
      (let ((idx (search-index name list-of-tab-names string-ci=?)))
        (if (>= idx 0)
            (vector-ref panels idx) ; Return the right vertical panel
            (begin (display "Er bestaat geen tab genaamd ") (display name)(newline))))))

The name I've chosen here should be "get-vertical-panel" in order not to confuse tab-panels and vertical panels.

I updated my original answer. In summary, call `(send panel enable #t)` on your panel when you open the tab, or stop disabling them as it's unnecessary. — Throw Away Account, Mar 18 '15 at 03:26

Racket GUI, can not write in a text field

2 Answers2