如何响应鼠标单击

时间:2019-06-12 22:16:22

标签: tcl mouse

我正在尝试使用NewsPost从本地网站获取一些文本。 我使用TCL代码(如下所示)启动wget.exe。 TCL等待wget.exe的响应和结果时,没有对鼠标的响应。甚至没有关闭窗口右上角的小x。

我已经在互联网上搜索了一些答案,但只找到指向绑定的结果。

wget.exe

在等待while {[catch {set line1 [exec wget.exe \ --no-check-certificate \ -q \ -O - \ -T $tout \ -t 1 \ $serverip$url]}]} { # ACCESS HAS FAILED AND TEST HOW MANY TIMES? Some more code here } 的输出时,我希望能够在wget.exe超时之前通过单击鼠标中止并关闭程序。

1 个答案:

答案 0 :(得分:0)

假设您正在Tk GUI的环境中执行此操作...

您需要做的是异步运行子进程,以便在子进程运行时继续为GUI事件循环提供服务。如果您使用的是Tcl 8.6(或更高版本),则在您的情况下这样做会更容易,因为我们可以使用协程简单地完成很多工作。

# A global variable that you can hook into the GUI to get a crash stop
set StopRightNow 0

coroutine doWget apply {{} {
    global tout serverip url StopRightNow
    while true {
        set subprocess [open |[list wget.exe \
            --no-check-certificate \
            -q \
            -O - \
            -T $tout \
            -t 1 \
            $serverip$url]]
        fconfigure $subprocess -blocking 0
        # Arrange for the coroutine to resume whenever there's something to do
        fileevent $subprocess readable [info coroutine]
        set lines {}
        while {![eof $subprocess]} {
            yield
            # Check for override!
            if {$StopRightNow} return
            if {[gets $subprocess line] >= 0} {
                lappend lines $line
            }
        }
        fconfigure $subprocess -blocking 1
        if {![catch {close $subprocess} errors]} {
            break
        }
        # Do something to handle the errors here...
        puts "Problem when reading; will retry\n$errors"
    }
    # At this point, $lines has the list of lines read from the wget subprocess. For example:
    puts "Read the output..."
    foreach line $lines {
        puts "[incr lineNumber]: $line"
    }
}}

好的,这有点大。让我们将其核心分解为一个过程。

proc asyncRunSubprocess args {
    global StopRightNow
    set subprocess [open |$args]
    fconfigure $subprocess -blocking 0
    # Arrange for the coroutine to resume whenever there's something to do
    fileevent $subprocess readable [info coroutine]
    # Accumulate the subprocess's stdout
    set lines {}
    while {![eof $subprocess]} {
        yield
        if {$StopRightNow} {
            return {{} -1 interrupted {}}
        }
        if {[gets $subprocess line] >= 0} {
            lappend lines $line
        }
    }
    # Close down the subprocess; we've got an EOF
    fconfigure $subprocess -blocking 1
    set code [catch {close $subprocess} errors opts]
    return [list $lines $code $errors $opts]
}

然后我们可以像这样制作外部协程:

coroutine doWget apply {{} {
    global tout serverip url
    while true {
        set results [asyncRunSubprocess \
                wget.exe --no-check-certificate -q -O - -T $tout -t 1 $serverip$url]
        lassign $results lines code errors
        if {$code < 0} return elseif {$code == 0} break
        # Do something to handle the errors here...
        puts "Problem when reading; will retry\n$errors"
    }
    # At this point, $lines has the list of lines read from the wget subprocess. For example:
    puts "Read the output..."
    foreach line $lines {
        puts "[incr lineNumber]: $line"
    }
}}

请注意,Tcl的协程(与许多其他语言不同)可以很高兴地在它们调用的过程中挂起。