Как реагировать на щелчок мышью - PullRequest
0 голосов
/ 13 июня 2019

Я пытаюсь получить текст с локального сайта, используя wget.exe. Я использую код TCL (показан ниже) для запуска wget.exe. Пока TCL ожидает ответа и результата от 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 Я хотел бы иметь возможность прервать и закрыть программу щелчком мыши до истечения wget.exe тайм-аута.

1 Ответ

0 голосов
/ 16 июня 2019

Предполагая, что вы делаете это в контексте графического интерфейса пользователя Tk…

Что вам нужно сделать, это запустить подпроцесс асинхронно, чтобы цикл событий 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 (в отличие от многих других языков)вполне может приостановить выполнение процедур, которые они вызывают.

...