Tcl/Tk examples?

Question

Tcl/Tk is a simple way to script small GUIs.

Can anyone give a nice example with a button and a text widget. When the button is pressed should a shell command be executed and the output piped to the text widget.

If you have other nice and clean examples for useful tasks, please add them too.

Answer 1

I can give a start...please suggest improvements. I.e I'd like it to scroll as the command is outputting

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

Answer 2

Some suggestions:

To append the output to the text widget, instead of specifying line 999999, you can use the index end, which refers to the position just after the last newline. For example,

.main insert end "$x\n"

To have the text scroll as the command is outputting, use the see command. For example, after appending to the .main text widget

.main see end

You may also want to consider grabbing the command output asynchronously, by using the fileevent command.

Answer 3

Here's a more complete example using fileevents. This will auto-scroll all the time. For usability purposes you probably only want to auto-scroll if the bottom of the text is visible (ie: if the user hasn't moved the scrollbar) but I'll leave that as an exercise for the reader to keep this already long example from getting any longer.

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

Answer 4

wiki.tcl.tk is good website for all kinds of examples