Esempi di Tcl / Tk?
-
03-07-2019 - |
Domanda
Tcl / Tk è un modo semplice per scrivere piccole GUI.
Qualcuno può fare un buon esempio con un pulsante e un testo . Quando si preme il pulsante, deve essere eseguito un comando shell e l'output viene reindirizzato al widget testo .
Se hai altri esempi belli e chiari per attività utili, aggiungile anche tu.
Soluzione
Ecco un esempio più completo usando fileevents. Questo farà scorrere automaticamente tutto il tempo. Ai fini dell'usabilità probabilmente vorrai scorrere automaticamente solo se è visibile la parte inferiore del testo (ovvero: se l'utente non ha spostato la barra di scorrimento) ma lo lascerò come esercizio per il lettore per mantenere questo esempio già lungo dal prolungarsi.
package require Tk
proc main {} {
if {[lsearch -exact [font names] TkDefaultFont] == -1} {
# older versions of Tk don't define this font, so pick something
# suitable
font create TkDefaultFont -family Helvetica -size 12
}
# in 8.5 we can use {*} but this will work in earlier versions
eval font create TkBoldFont [font actual TkDefaultFont] -weight bold
buildUI
}
proc buildUI {} {
frame .toolbar
scrollbar .vsb -command [list .t yview]
text .t \
-width 80 -height 20 \
-yscrollcommand [list .vsb set] \
-highlightthickness 0
.t tag configure command -font TkBoldFont
.t tag configure error -font TkDefaultFont -foreground firebrick
.t tag configure output -font TkDefaultFont -foreground black
grid .toolbar -sticky nsew
grid .t .vsb -sticky nsew
grid rowconfigure . 1 -weight 1
grid columnconfigure . 0 -weight 1
set i 0
foreach {label command} {
date {date}
uptime {uptime}
ls {ls -l}
} {
button .b$i -text $label -command [list runCommand $command]
pack .b$i -in .toolbar -side left
incr i
}
}
proc output {type text} {
.t configure -state normal
.t insert end $text $type "\n"
.t see end
.t configure -state disabled
}
proc runCommand {cmd} {
output command $cmd
set f [open "| $cmd" r]
fconfigure $f -blocking false
fileevent $f readable [list handleFileEvent $f]
}
proc closePipe {f} {
# turn blocking on so we can catch any errors
fconfigure $f -blocking true
if {[catch {close $f} err]} {
output error $err
}
}
proc handleFileEvent {f} {
set status [catch { gets $f line } result]
if { $status != 0 } {
# unexpected error
output error $result
closePipe $f
} elseif { $result >= 0 } {
# we got some output
output normal $line
} elseif { [eof $f] } {
# End of file
closePipe $f
} elseif { [fblocked $f] } {
# Read blocked, so do nothing
}
}
main
Altri suggerimenti
Alcuni suggerimenti:
Per aggiungere l'output al widget testo , anziché specificare la riga 999999, è possibile utilizzare l'indice fine , che fa riferimento alla posizione subito dopo l'ultima riga. Ad esempio,
.main insert end "$x\n"
Per far scorrere il testo mentre viene emesso il comando, utilizzare il comando vedi . Ad esempio, dopo aver aggiunto il widget di testo .main
.main see end
Puoi anche prendere in considerazione l'idea di afferrare l'output del comando in modo asincrono, usando il comando fileevent .
Posso iniziare ... per favore, suggerisci miglioramenti. Ad esempio, vorrei che scorresse mentre viene emesso il comando
#!/usr/bin/wish
proc push_button {} {
put_text
.main see end
}
proc put_text {} {
set f [ open "| date" r]
while {[gets $f x] >= 0} {
.main insert end "$x\n"
}
catch {close $f}
}
button .but -text "Push Me" -command "push_button"
text .main -relief sunken -bd 2 -yscrollcommand ".scroll set"
scrollbar .scroll -command ".main yview"
pack .but
pack .main -side left -fill y
pack .scroll -side right -fill y
wiki.tcl.tk è un buon sito Web per tutti i tipi di esempi