Racket GUI，不能在文本字段中写入
Racket GUI, can not write in a text field
我目前正在编写一个程序（在 Racket 中），我在其中使用了多个选项卡。
为此我使用 "tab-panel%"。 对于每个选项卡，我然后制作一个新的垂直面板。 当有人点击一个选项卡时，我的回调过程被调用并且我改变children的"tab-panel%" 这样 现在 选项卡（用户单击）的垂直面板设置为 tab-panel 的 child。
我通过发送以下消息来做到这一点：
(send tab-panel change-chidren (lambda (x) '())) ; Deletes all childs
(send tab-pannel add-child vertical-panel-of-the-clicked-tab)
我这样做是因为如果我只为我的所有选项卡使用一个垂直面板，那么当我创建小部件时，它们将被放置在已经存在的小部件下面。如果那时我只显示所选选项卡的小部件并隐藏其他小部件，小部件将不会从我的选项卡的顶部开始（因为其他选项卡也有小部件，它们可能在这个之前创建，因此在这个小部件之上（因为我们正在使用垂直面板））。所以我发现为每个选项卡使用一个垂直面板并将 tab-panel 的 child 更改为所选选项卡的垂直面板解决了这个问题。
但是因为我这样做了，所以我不能再在我的 "text-field%" 小部件中写任何东西了..
当我点击它时没有任何反应（甚至没有调用回调）。
只有当我右键单击然后选择 "paste" 时，它才会将其粘贴到文本字段中，然后调用我的回调过程。
长话短说： 我的垂直面板都用于一个特定的选项卡，并且都具有 parent 和 tab-panel。单击选项卡时，我将 tab-panel 的 child 更改为所选选项卡的垂直面板。
有谁知道为什么我不能在 text-field 小部件中写入？
我在文档中搜索了 block/activate 文本输入的消息（也许更改选项卡面板的 child 会阻止文本字段）但没有找到。
编辑：请注意，除文本字段外，所有其他小部件均正常工作。
代码如下：
; 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)
我现在让你的代码可以工作了，我发现我需要做 (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 是 reader.
的练习
或者您可以只使用 Racket 的 classes，并扩展 tab-panel% class 以包含您放入 make-tab-beheerder.
中的所有内容
@Throwaway 帐户 300 万：感谢您的帮助！但是作为文本字段父级的 "tabPaneel" 不是选项卡面板。它是程序的形式参数（参数），我为该参数选择的名称也是 "tabPaneel"，有点混乱。
(define (makeTrainTabWidgets tabPaneel tabBeheerder)
当我调用 "makeTrainTabWidgets" 过程时，我将那个选项卡的垂直面板作为实际参数传递。
(makeTrainTabWidgets ((tabBeheerder 'get-tab-panel) "Train") tabBeheerder)
"get-tab-panel" 消息只会 return 右边的垂直面板。
(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"。
我目前正在编写一个程序（在 Racket 中），我在其中使用了多个选项卡。
为此我使用 "tab-panel%"。 对于每个选项卡，我然后制作一个新的垂直面板。 当有人点击一个选项卡时，我的回调过程被调用并且我改变children的"tab-panel%" 这样 现在 选项卡（用户单击）的垂直面板设置为 tab-panel 的 child。
我通过发送以下消息来做到这一点：
(send tab-panel change-chidren (lambda (x) '())) ; Deletes all childs
(send tab-pannel add-child vertical-panel-of-the-clicked-tab)
我这样做是因为如果我只为我的所有选项卡使用一个垂直面板，那么当我创建小部件时，它们将被放置在已经存在的小部件下面。如果那时我只显示所选选项卡的小部件并隐藏其他小部件，小部件将不会从我的选项卡的顶部开始（因为其他选项卡也有小部件，它们可能在这个之前创建，因此在这个小部件之上（因为我们正在使用垂直面板））。所以我发现为每个选项卡使用一个垂直面板并将 tab-panel 的 child 更改为所选选项卡的垂直面板解决了这个问题。
但是因为我这样做了，所以我不能再在我的 "text-field%" 小部件中写任何东西了.. 当我点击它时没有任何反应（甚至没有调用回调）。 只有当我右键单击然后选择 "paste" 时，它才会将其粘贴到文本字段中，然后调用我的回调过程。
长话短说： 我的垂直面板都用于一个特定的选项卡，并且都具有 parent 和 tab-panel。单击选项卡时，我将 tab-panel 的 child 更改为所选选项卡的垂直面板。
有谁知道为什么我不能在 text-field 小部件中写入？
我在文档中搜索了 block/activate 文本输入的消息（也许更改选项卡面板的 child 会阻止文本字段）但没有找到。
编辑：请注意，除文本字段外，所有其他小部件均正常工作。
代码如下：
; 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)
我现在让你的代码可以工作了，我发现我需要做 (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 是 reader.
或者您可以只使用 Racket 的 classes，并扩展 tab-panel% class 以包含您放入 make-tab-beheerder.
@Throwaway 帐户 300 万：感谢您的帮助！但是作为文本字段父级的 "tabPaneel" 不是选项卡面板。它是程序的形式参数（参数），我为该参数选择的名称也是 "tabPaneel"，有点混乱。
(define (makeTrainTabWidgets tabPaneel tabBeheerder)
当我调用 "makeTrainTabWidgets" 过程时，我将那个选项卡的垂直面板作为实际参数传递。
(makeTrainTabWidgets ((tabBeheerder 'get-tab-panel) "Train") tabBeheerder)
"get-tab-panel" 消息只会 return 右边的垂直面板。
(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"。