Posted to tcl by patthoyts at Fri Sep 07 01:17:10 GMT 2007view raw

  1. proc ::tkchat::whiteboard_open {} {
  2. variable useTile
  3. variable NS
  4.  
  5. if {![winfo exists .wb]} {
  6. set wb [Dialog .wb]
  7.  
  8. ${NS}::entry $wb.e -textvar ::wbentry -width 80
  9. if {$useTile == 0} { $wb.e configure -background white }
  10. bind $wb.e <Return> {interp eval .wbinterp $::wbentry}
  11. set white_board [canvas $wb.c -background white -width 350 -height 300]
  12. ${NS}::button $wb.bclear -text "clear" -command ::tkchat::whiteboard_clear
  13. bind $wb.c <Button-1> {
  14. set entry ""
  15. set id [%W create line %x %y %x %y]
  16. }
  17. bind $wb.c <Button1-Motion> {%W coords $id [concat [%W coords $id] %x %y]}
  18. bind $wb.c <ButtonRelease-1> {::tkchat::whiteboard_transmit %W $id}
  19. grid $wb.e $wb.bclear -sticky new
  20. grid $wb.c - -sticky new
  21. #pack $wb.e $wb.c -fill both -expand 1
  22.  
  23. catch {
  24. proc filtered_.wb.c {args} {
  25. if {[string equal "bind" [string tolower [lindex $args 0]] && \
  26. ([llength $args] == 4)} {
  27. lset args 3 [list .wbinterp eval [lindex $args 3]]
  28. }
  29. set c [catch ".wb.c {*}$args" r]
  30. return $r -code $c
  31. }
  32. interp create -safe .wbinterp
  33. interp alias .wbinterp .wb.c {} filtered_.wb.c
  34. }
  35. } else {
  36. focus .wb
  37. }
  38. }