home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 35_12.tcl < prev    next >
Text File  |  2003-04-15  |  3KB  |  127 lines
  1. #
  2. # Example 35-12
  3. # Simple edit bindings for canvas text items.
  4. #
  5.  
  6. proc Canvas_EditBind { c } {
  7.     bind $c <Button-1> \
  8.         {CanvasFocus %W [%W canvasx %x] [%W canvasy %y]}
  9.     bind $c <Button-2> \
  10.         {CanvasPaste %W [%W canvasx %x] [%W canvasy %y]}
  11.     bind $c <<Cut>> {CanvasTextCopy %W; CanvasDelete %W}
  12.     bind $c <<Copy>> {CanvasTextCopy %W}
  13.     bind $c <<Paste>> {CanvasPaste %W}
  14.     $c bind text <Button-1> \
  15.         {CanvasTextHit %W [%W canvasx %x] [%W canvasy %y]}
  16.     $c bind text <B1-Motion> \
  17.         {CanvasTextDrag %W [%W canvasx %x] [%W canvasy %y]}
  18.     $c bind text <Delete> {CanvasDelete %W}
  19.     $c bind text <Control-d> {CanvasDelChar %W}
  20.     $c bind text <Control-h> {CanvasBackSpace %W}
  21.     $c bind text <BackSpace> {CanvasBackSpace %W}
  22.     $c bind text <Control-Delete> {CanvasErase %W}
  23.     $c bind text <Return> {CanvasNewline %W}
  24.     $c bind text <Any-Key> {CanvasInsert %W %A}
  25.     $c bind text <Key-Right> {CanvasMoveRight %W}
  26.     $c bind text <Control-f> {CanvasMoveRight %W}
  27.     $c bind text <Key-Left> {CanvasMoveLeft %W}
  28.     $c bind text <Control-b> {CanvasMoveLeft %W}
  29. }
  30. proc CanvasFocus {c x y} {
  31.     focus $c
  32.     set id [$c find overlapping [expr $x-2] [expr $y-2] \
  33.             [expr $x+2] [expr $y+2]]
  34.     if {($id == {}) || ([$c type $id] != "text")} {
  35.         set t [$c create text $x $y -text "" \
  36.             -tags text -anchor nw]
  37.         $c focus $t
  38.         $c select clear
  39.         $c icursor $t 0
  40.     }
  41. }
  42. proc CanvasTextHit {c x y {select 1}} {
  43.     $c focus current
  44.     $c icursor current @$x,$y
  45.     $c select clear
  46.     $c select from current @$x,$y
  47. }
  48. proc CanvasTextDrag {c x y} {
  49.     $c select to current @$x,$y
  50. }
  51. proc CanvasDelete {c} {
  52.     if {[$c select item] != {}} {
  53.         $c dchars [$c select item] sel.first sel.last
  54.     } elseif {[$c focus] != {}} {
  55.         $c dchars [$c focus] insert
  56.     }
  57. }
  58. proc CanvasTextCopy {c} {
  59.     if {[$c select item] != {}} {
  60.         clipboard clear
  61.         set t [$c select item]
  62.         set text [$c itemcget $t -text]
  63.         set start [$c index $t sel.first]
  64.         set end [$c index $t sel.last]
  65.         clipboard append [string range $text $start $end]
  66.     } elseif {[$c focus] != {}} {
  67.         clipboard clear
  68.         set t [$c focus]
  69.         set text [$c itemcget $t -text]
  70.         clipboard append $text
  71.     }
  72. }
  73. proc CanvasDelChar {c} {
  74.     if {[$c focus] != {}} {
  75.         $c dchars [$c focus] insert
  76.     }
  77. }
  78. proc CanvasBackSpace {c} {
  79.     if {[$c select item] != {}} {
  80.         $c dchars [$c select item] sel.first sel.last
  81.     } elseif {[$c focus] != {}} {
  82.         set _t [$c focus]
  83.         $c icursor $_t [expr [$c index $_t insert]-1]
  84.         $c dchars $_t insert
  85.     }
  86. }
  87. proc CanvasErase {c} {
  88.     $c delete [$c focus]
  89. }
  90. proc CanvasNewline {c} {
  91.     $c insert [$c focus] insert \n
  92. }
  93. proc CanvasInsert {c char} {
  94.     $c insert [$c focus] insert $char
  95. }
  96. proc CanvasPaste {c {x {}} {y {}}} {
  97.     if {[catch {selection get} _s] &&
  98.          [catch {selection get -selection CLIPBOARD} _s]} {
  99.         return        ;# No selection
  100.     }
  101.     set id [$c focus]
  102.     if {[string length $id] == 0 } {
  103.         set id [$c find withtag current]
  104.     }
  105.     if {[string length $id] == 0 } {
  106.         # No object under the mouse
  107.         if {[string length $x] == 0} {
  108.             # Keyboard paste
  109.             set x [expr [winfo pointerx $c] - [winfo rootx $c]]
  110.             set y [expr [winfo pointery $c] - [winfo rooty $c]]
  111.         }
  112.         CanvasFocus $c $x $y
  113.     } else {
  114.         $c focus $id
  115.     }
  116.     $c insert [$c focus] insert $_s
  117. }
  118.  
  119. proc CanvasMoveRight {c} {
  120.     $c icursor [$c focus] [expr [$c index current insert]+1]
  121. }
  122. proc CanvasMoveLeft {c} {
  123.     $c icursor [$c focus] [expr [$c index current insert]-1]
  124. }
  125.  
  126.  
  127.