Racket GUI，不能在文本字段中写入

Question

我目前正在编写一个使用多个标签的程序（在 Racket 中）。

为此，我使用“tab-panel%”。 我为每个标签然后制作一个新的垂直面板。 当有人点击一个选项卡时，我的回调过程被调用并且我改变了“tab-panel%”的子元素，以便现在标签的垂直面板（用户点击）被设置为标签面板的子标签。

我通过发送以下消息来做到这一点：

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

我这样做是因为如果我只为我的所有选项卡使用一个垂直面板，那么当我创建小部件时，它们会被放置在已经存在的小部件下。如果那时我只显示所选选项卡的小部件并隐藏其他小部件，则小部件将不会从我的选项卡顶部开始（因为其他选项卡也有小部件，可能在此之前创建，因此在此小部件之上（因为我们正在使用垂直面板））。所以我发现为每个选项卡使用一个垂直面板并将选项卡面板的子级更改为所选选项卡的垂直面板可以解决这个问题。

但是既然我这样做了，我就不能在我的“text-field%”小部件中再写任何东西了.. 当我点击它时，什么也没有发生（甚至没有调用回调）。 只有当我右键单击然后选择例如“粘贴”时，它才会将其粘贴到文本字段中，然后调用我的回调过程。

长话短说：我的垂直面板都用于一个特定的选项卡，并且都以选项卡面板为父级。单击选项卡时，我将选项卡面板的子级更改为所选选项卡的垂直面板。

有人知道为什么我不能在文本字段小部件中写字吗？

我在文档中搜索了一条阻止/激活文本输入的消息（可能是更改选项卡面板的子项会阻止文本字段），但没有找到。

编辑：请注意，所有其他小部件都可以正常工作，除了文本字段。

代码如下：

; 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)

Answer 1

我现在可以使用您的代码，我发现我需要先执行(send the-vertical-panel enable #t)，然后才能编辑文本字段。那是因为您浏览了set-tab-panel! 中的所有面板并对其执行(send panel enable #f)，如果您还使用change-children 将它们从视图中删除，这似乎是不必要的。

似乎也没有必要对每个小部件执行(send widget show #f) 和(send widget enable #f)，因为这些小部件只有在其父级vertical-panel% 可见时才可见和交互。

此外，您可以通过编写一个宏来为您执行此操作，从而避免在每个闭包末尾编写 cond 块：

(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)))))

那么你可以这样做：

(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)))

然后make-simple-object 就像你的make-tab-beheerder 一样工作。如何使struct 在该表单内工作而不诉诸syntax-case 是读者的练习。

或者您可以只使用 Racket 的 classes，并扩展 tab-panel% 类以包含您放入 make-tab-beheerder 的所有内容。

Answer 2

@Throwaway Account 3 百万：感谢您的帮助！但是作为文本字段的父级的“tabPaneel”不是选项卡面板。它是过程之外的形式参数（参数），我为该参数选择的名称也是“tabPaneel”，有点混乱。

(define (makeTrainTabWidgets tabPaneel tabBeheerder)

当我调用“makeTrainTabWidgets”过程时，我将该选项卡的垂直面板作为实际参数传递。

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

“get-tab-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))))))

我在这里选择的名称应该是“get-vertical-panel”，以免混淆选项卡面板和垂直面板。