user-interface scripting tcl tk

user interface - Tcl/Tk ejemplos?



user-interface scripting (4)

Tcl / Tk es una forma simple de script de pequeñas GUI.

¿Alguien puede dar un buen ejemplo con un botón y un widget de texto ? Cuando se presiona el botón, se debe ejecutar un comando de shell y la salida se canaliza al widget de texto .

Si tiene otros ejemplos agradables y limpios para tareas útiles, agréguelos también.


Algunas sugerencias:

Para agregar el resultado al widget de texto , en lugar de especificar la línea 999999, puede usar el extremo del índice, que se refiere a la posición justo después de la última línea nueva. Por ejemplo,

.main insert end "$x/n"

Para hacer que el texto se desplace a medida que el comando sale, use el comando see . Por ejemplo, después de agregar al widget de texto .main

.main see end

También puede considerar tomar el resultado del comando de forma asincrónica, utilizando el comando fileevent .


Puedo empezar ... por favor sugiera mejoras. Es decir, me gustaría desplazarme mientras el comando está emitiendo

#!/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


Aquí hay un ejemplo más completo usando fileevents. Esto se desplazará automáticamente todo el tiempo. Para fines de usabilidad, probablemente solo quiera desplazarse automáticamente si la parte inferior del texto está visible (es decir, si el usuario no ha movido la barra de desplazamiento), pero lo dejaré como un ejercicio para que el lector conserve este ejemplo ya largo. de obtener más tiempo.

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