# test indent from ased editor
        # written on Windows XP on eTCL
        # working under TCL version 8.5.6 and eTCL 1.0.1
        # gold on TCL WIKI 
        #!/usr/bin/env wish
        package require Tk
         proc populateCanvas {canvas cols rows} {
            variable ids ;# links text ids with respective rect ids
            variable boxes ;# lists text id and text associated with each rect id
            catch {unset ids boxes}
            # parameters for drawing boxes
            set boxwidth 50
            set boxheight 20
            set padx 3
            set pady 3
            set colors {red orange yellow green blue purple}
            set labels {one two three four}
            # draw the boxes
            for {set row 0} {$row < $rows} {incr row} {
                for {set col 0} {$col < $cols} {incr col} {
                    # calculate coordinates
                    set x1 [expr {$col * ($boxwidth + $padx) + $padx}]
                    set x2 [expr {$x1 + $boxwidth}]
                    set x3 [expr {$x1 + ($boxwidth / 2)}]
                    set y1 [expr {$row * ($boxheight + $pady) + $pady}]
                    set y2 [expr {$y1 + $boxheight}]
                    set y3 [expr {$y1 + ($boxheight / 2)}]
                    # choose color and text
                    set color [lindex $colors [expr {int(rand() * [llength $colors])}]]
                    set text [lindex $labels [expr {int(rand() * [llength $labels])}]]
                    # create the boxes
                    set boxid [$canvas create rectangle $x1 $y1 $x2 $y2 -fill $color -outline black]
                    set textid [$canvas create text $x3 $y3 -text $text]
                    # remember which text item goes with which box and what the text says
                    set boxes($boxid) [list $textid $text]
                    set ids($textid) $boxid
                    set ids($boxid) $boxid
                }
            }
        }
        proc clearSelection {canvas} {
            # if there is an existing currently selected box, change its border back to
            # black; set variables selectedid and selectedtext to empty strings
            variable selectedid
            variable selectedtext
            if {$selectedid ne "" && [$canvas find withtag $selectedid] ne ""} {
                $canvas itemconfigure $selectedid -outline black
            }
            set selectedid ""
            set selectedtext ""
        }
        proc handleSelection {canvas id} {
            # determine the "next step" by comparing the newly selected box id and text
            # to the box id and text of the previously selected box (contained in
            # the variables $selectedid and $selectedtext)
            variable ids
            variable boxes
            variable selectedid
            variable selectedtext
            set boxid $ids($id)
            lassign $boxes($boxid) textid text
            if {$boxid eq $selectedid} {
                # user has selected the same box twice; deselect the box
                clearSelection $canvas
                return
            } elseif {$text eq $selectedtext} {
                # user has selected two boxes with the same text; delete both boxes
                $canvas delete $boxid $textid $selectedid [lindex $boxes($selectedid) 0]
                clearSelection $canvas
                return
            } else {
                # user has selected a box when there is no selection, or user has
                # selected a box with different text than the previously selected box;
                # try to deselect the previous box, then select the new box
                clearSelection $canvas
                set selectedid $boxid
                set selectedtext $text
                $canvas itemconfigure $boxid -outline white
                return
            }
        }
        proc processClick {canvas x y} {
            # determine whether the user has clicked on something; if so, call
            # proc handleSelection
            set id [$canvas find overlapping $x $y $x $y]
            if {[llength $id] > 0} {
                handleSelection $canvas [lindex $id 0]
            }
        }
        set win [toplevel .demo]
        wm title $win "Mahjong-style deletion"
        set canvas [canvas $win.canvas]
        pack $canvas  -expand 1 -fill both
        bind $canvas <Button-1> [list processClick %W %x %y]
        set state 1
        proc mahjongstyle { state } {
            global coloritem canvas details
            set coloritem gray
            set details {
                Mahjong-style deletion.
                press in succession two tiles with the same text.
                both tiles should be deleted.
                The Mahjong-style deletion is for
                the right mouse press.}
   $canvas create window 15 210 -window [button $canvas.r -width 10 -text report \
      -bg $coloritem    -command {tk_messageBox -message $details}]
   $canvas create window 30 230 -window [button $canvas.c -width 10 -height 1 -text exit \
   -bg $coloritem     -command {exit }]    
     }
        mahjongstyle { $state }
        populateCanvas $canvas 4 5
        set selectedid ""
        set selectedtext ""
        console hide

  proc populateCanvas {canvas cols rows} {
    variable ids ;# links text ids with respective rect ids
    variable boxes ;# lists text id and text associated with each rect id
    catch {unset ids boxes}
    
    # parameters for drawing boxes
    set boxwidth 50
    set boxheight 20
    set padx 3
    set pady 3
    set colors {red orange yellow green blue purple}
    set labels {one two three four}
    
    # draw the boxes
    for {set row 0} {$row < $rows} {incr row} {
      for {set col 0} {$col < $cols} {incr col} {
        
        # calculate coordinates
        set x1 [expr {$col * ($boxwidth + $padx) + $padx}]
        set x2 [expr {$x1 + $boxwidth}]
        set x3 [expr {$x1 + ($boxwidth / 2)}]
        set y1 [expr {$row * ($boxheight + $pady) + $pady}]
        set y2 [expr {$y1 + $boxheight}]
        set y3 [expr {$y1 + ($boxheight / 2)}]
        
        # choose color and text
        set color [lindex $colors [expr {int(rand() * [llength $colors])}]]
        set text [lindex $labels [expr {int(rand() * [llength $labels])}]]
        
        # create the boxes
        set boxid [$canvas create rectangle $x1 $y1 $x2 $y2 \
          -fill $color \
          -outline black]
        set textid [$canvas create text $x3 $y3 \
          -text $text]
        
        # remember which text item goes with which box and what the text says
        set boxes($boxid) [list $textid $text]
        set ids($textid) $boxid
        set ids($boxid) $boxid
      }
    }
  }
  
  proc clearSelection {canvas} {

    # if there is an existing currently selected box, change its border back to
    # black; set variables selectedid and selectedtext to empty strings

    variable selectedid
    variable selectedtext
    
    if {$selectedid ne "" && [$canvas find withtag $selectedid] ne ""} {
      $canvas itemconfigure $selectedid -outline black
    }
    set selectedid ""
    set selectedtext ""
  }
  
  proc handleSelection {canvas id} {

    # determine the "next step" by comparing the newly selected box id and text
    # to the box id and text of the previously selected box (contained in
    # the variables $selectedid and $selectedtext)

    variable ids
    variable boxes
    variable selectedid
    variable selectedtext
    
    set boxid $ids($id)
    lassign $boxes($boxid) textid text
    if {$boxid eq $selectedid} {

      # user has selected the same box twice; deselect the box

      clearSelection $canvas
      return
    } elseif {$text eq $selectedtext} {

      # user has selected two boxes with the same text; delete both boxes

      $canvas delete $boxid $textid $selectedid [lindex $boxes($selectedid) 0]
      clearSelection $canvas
      return
    } else {

      # user has selected a box when there is no selection, or user has
      # selected a box with different text than the previously selected box;
      # try to deselect the previous box, then select the new box

      clearSelection $canvas
      set selectedid $boxid
      set selectedtext $text
      $canvas itemconfigure $boxid -outline white
      return
    }
  }
  
  proc processClick {canvas x y} {

    # determine whether the user has clicked on something; if so, call
    # proc handleSelection

    set id [$canvas find overlapping $x $y $x $y]
    if {[llength $id] > 0} {
      handleSelection $canvas [lindex $id 0]
    }
  }
  
  set win [toplevel .demo]
  wm title $win "Mahjong-style deletion?"
  set canvas [canvas $win.canvas]
  pack $canvas -expand 1 -fill both
  bind $canvas <Button-1> [list processClick %W %x %y]
  
  populateCanv