| The selection handle command registers a Tcl command to handle selection requests. The command is called to return the value of the selection to a requesting application. If the selection value is large, the command might be called several times to return the selection in pieces. The command gets two parameters that indicate the offset within the selection to start returning data, and the maximum number of bytes to return. If the command returns fewer than that many bytes, the selection request is assumed to be completed. Otherwise, the command is called again to get the rest of the data, and the offset parameter is adjusted accordingly. You can also get a callback when you lose ownership of the selection. At that time it is appropriate to unhighlight the selected object in your interface. The selection own command sets ownership and registers a callback for when you lose ownership. A Canvas Selection Handler Example 35-3 through Example 35-7 implement cut and paste for a canvas. The CanvasSelect_Demo procedure creates a canvas and sets up some bindings for cut and paste: Example 35-3 Bindings for canvas selection. proc CanvasSelect_Demo { c } { # Create a canvas with a couple of objects canvas $c pack $c $c create rect 10 10 50 50 -fill red -tag object $c create poly 100 100 100 30 140 50 -fill orange \ -tag object # Set up cut and paste bindings $c bind object <Button-1> [list CanvasSelect $c %x %y] bind $c <Key-Delete> [list CanvasDelete $c] bind $c <<Cut>> [list CanvasCut $c] bind $c <<Copy>> [list CanvasCopy $c] bind $c <<Paste>> [list CanvasPaste $c] bind $c <Button-2> [list CanvasPaste $c %x %y] # Register the handler for selection requests selection handle $c [list CanvasSelectHandle $c] } The CanvasSelect procedure selects an object. It uses the find closest canvas operation to find out what object is under the mouse, which works because the binding is on canvas items with the object tag. If the binding were on the canvas as a whole, you would use the find overlapping operation to limit selection to objects near the mouse click. The CanvasHighlight procedure is used to highlight the selected object. It displays small boxes at the corners of the object's bounding box. Finally, the CanvasSelectLose procedure is registered to be called when another application asserts ownership of the PRIMARY selection. Example 35-4 Selecting objects. proc CanvasSelect { w x y } { # Select an item on the canvas. global canvas set id [$w find closest $x $y] set canvas(select,$w) $id CanvasHighlight $w $id # Claim ownership of the PRIMARY selection selection own -command [list CanvasSelectLose $w] $w focus $w } proc CanvasHighlight {w id {clear clear}} { if {$clear == "clear"} { $w delete highlight } foreach {x1 y1 x2 y2}[$w bbox $id] {# lassign } foreach x [list $x1 $x2] { foreach y [list $y1 $y2] { $w create rectangle [expr $x-2] [expr $y-2] \ [expr $x+2] [expr $y+2] -fill black \ -tag highlight } } } proc CanvasSelectLose { w } { # Some other app has claimed the selection global canvas $w delete highlight unset canvas(select,$w) } Once you claim ownership, Tk calls back to the CanvasSelectHandle procedure when another application, even yours, requests the selection. This uses CanvasDescription to compute a description of the canvas object. It uses canvas operations to query the object's configuration and store that as a command that will create the object: Example 35-5 A canvas selection handler. proc CanvasSelectHandle {w offset maxbytes } { # Handle a selection request global canvas if ![info exists canvas(select,$w)] { error "No selected item" } set id $canvas(select,$w) # Return the requested chunk of data. return [string range [CanvasDescription $w $id] \ $offset [expr $offset+$maxbytes]] } proc CanvasDescription { w id } { # Generate a description of the object that can # be used to recreate it later. set type [$w type $id] set coords [$w coords $id] set config {} # Bundle up non-default configuration settings foreach conf [$w itemconfigure $id] { # itemconfigure returns a list like # -fill {} {} {}red set default [lindex $conf 3] set value [lindex $conf 4] if {[string compare $default $value] != 0} { lappend config [lindex $conf 0] $value } } return [concat CanvasObject $type $coords $config] } The CanvasCopy procedure puts the description of the selected item onto the clipboard with the clipboard append command. The CanvasDelete deletes an object and the highlighting, and CanvasCut is built from CanvasCopy and CanvasDelete: Example 35-6 The copy and cut operations. proc CanvasCopy { w } { global canvas if [info exists canvas(select,$w)] { set id $canvas(select,$w) clipboard clear clipboard append [CanvasDescription $w $id] } } proc CanvasDelete {w} { global canvas catch { $w delete highlight $w delete $canvas(select,$w) unset canvas(select,$w) } } proc CanvasCut { w } { CanvasCopy $w CanvasDelete $w } The CanvasPaste operation gets the value from the CLIPBOARD selection. The selection value has all the parameters needed for a canvas create operation. It gets the position of the new object from the <Button-2> event, or from the current mouse position if the <<Paste>> event is generated. If the mouse is out of the window, then the object is just put into the middle of the canvas. The original position and the new position are used to compute values for a canvas move: Example 35-7 Pasting onto the canvas. proc CanvasPaste {w {x {}} {y {} }} { # Paste the selection from the CLIPBOARD if [catch {selection get -selection CLIPBOARD}sel] { # no clipboard data return } if {[string length $x] == 0} { # <<Paste>>, get the current mouse coordinates set x [expr [winfo pointerx $w] - [winfo rootx $w]] set y [expr [winfo pointery $w] - [winfo rooty $w]] if {$x < 0 || $y < 0 || $x > [winfo width $w] || $y > [winfo height $w]} { # Mouse outside the window - center object set x [expr [winfo width $w]/2] set y [expr [winfo height $w]/2] } } if [regexp {^CanvasObject}$sel] { if [catch {eval {$w create}[lrange $sel 1 end]}id] { return; } # look at the first coordinate to see where to # move the object. Element 1 is the type, the # next two are the first coordinate set x1 [lindex $sel 2] set y1 [lindex $sel 3] $w move $id [expr $x-$x1] [expr $y-$y1] } } There is more you can do for a drawing program, of course. You'd like to be able to select multiple objects, create new ones, and more. The canvas_ui program on the CD-ROM was my first little effort at a canvas drawing program. The ImPress application by Christopher Cox is a full-featured page layout application based on the Tk canvas. You can find it on the CD-ROM and on the Web at: http://www.ntlug.org/~ccox/impress/
| 
