Tk Code Fragments

The following are some semi useful Tk code fragments

Dynamically Updating Text widget from pipe output

Updates a text widget with text from another process as the text is emitted through the pipe ( rather than waiting till the process finishes).

From Ken Corey (kcorey@eng.sun.com)

#!/usr/local/bin/wish

text .t -yscrollc {.sb set}
scrollbar .sb -command {.t yview}
button .b -text "Quit" -command {destroy .}

pack .sb -side right -fill y
pack .b -side bottom
pack .t -side left -fill both -expand 1


# Open the process we want to monitor hooked up to a pipe 
# swap the #'s to enable 'foo | stdoutin.tcl':
set f [open "|stdoutin.pl" r]
#set f "stdin"

fileevent $f readable {
   .t insert end "[gets $f]\n"
   .t yview end
   update idletasks
}
Heres a somewhat longer example monitoring a logfile.
#!/usr/local/bin/wish4.2

# setup display area( text and scrollbar) and Quit Button 
text   .t -yscrollc {.sb set}
scrollbar .sb -command {.t yview}
button .q -text Abort -command exit 

pack .sb -side right -fill y
pack .q -side bottom
pack .t -side left -fill both -expand 1

# Update display area with line of text
proc line {text} {
    .t insert end $text\n; 
    .t see end; 
    .t yview end
    update idletask
}

# Monitor fd (inpipe) and feed into display area
proc logOutput {inpipe cmd} {
  if {[eof $inpipe]} {
    close $inpipe
    line "end of <$cmd>."
  } else {
    line [gets $inpipe]
  }
}

# Setup fd monitoring 
proc execAndLog {cmd} {
  line "Start of <$cmd>."
  set inpipe [open "|/bin/sh -c \"$cmd &1; :\""]
  fileevent $inpipe readable [list logOutput $inpipe $cmd]
}

# -- mainline ---
#execAndLog {ls -C /tmp}

# setup a display monitor on a growing file
execAndLog { tail -f /usr/adm/syslog }

Making puts redirect output to a Window

From: John Haxby (jch@hazel.pwd.hp.com)
rename puts __puts
proc puts {args} {
    if [llength $args]==1 {
        putsToWindow $args
    } else {
         eval __puts $args
    }
}
# needs handling of nonewline and 
# definition of putsToWindow - creates Text widget if not already and
# adds putted text to end of it ...

Scroll multiple listboxes with one scrollbar

(from the
tkusage FAQ )

Basically you modify the scrollbar command option to replicate its args onto each listbox

# list of names of scrolling listboxes
set BOXES {.lb0 .lb1 .lb2 .lb3}

# proc to replicate scrollbar args
proc LBset args {
    global BOXES
    foreach lb $BOXES { eval $lb $args }
}

proc LBscroll args {
    eval .sy set $args
    LBset yview moveto [lindex $args 0]
}

scrollbar .sy -orient v -command [list LBset yview]
pack .sy -fill y -side right

# make the scrolling listboxes and override btnbindings
foreach lb $BOXES {
    listbox $lb -exportsel no -selectmode browse -yscrollcommand LBscroll
    pack $lb -side left -fill both -expand 1

     bind $lb  {
        LBset select clear 0 end
        LBset select set [%W nearest %y]
    }
    bind $lb  {
        LBset select clear 0 end
        LBset select set [%W nearest %y]
        LBset see [%W nearest %y]
    }
    bind $lb  {
        LBset select clear 0 end
        LBset select set [%W nearest %y]
    }
}

#populate the listboxes
for {set i 100} {$i} {incr i -1} {LBset insert end $i}


Hops (hops@sco.com) $ Last Modified: $Date: 1997/08/11 19:56:58 $: