source: plugins/wavesurfer/aubio.plug @ 79e72cf

# -*-Mode:Tcl-*-
#
#  Copyright (C) 2000-2004 Jonas Beskow and Kare Sjolander 
#
# This file is part of the WaveSurfer package.
# The latest version can be found at http://www.speech.kth.se/wavesurfer/
#
# -----------------------------------------------------------------------------

wsurf::RegisterPlugin transcription \
  -description "This plug-in is used to create transcription panes. Use the\
  properties-dialog to specify which transcription file that should be\
  displayed in a pane. It is usually practical to create a special\
  configuration for a certain combination of sound and transcription\
  files, specifying file properties such as filename extension, format,\
  file path, and encoding. There are\
  many options to control appearance and\
  editing functionality. Depending on the transcription file format\
  additional options might be available. There is a special pop-up menu\
  with functions to edit, play, convert and search labels. Unicode\
  characters are supported if using the source version of WaveSurfer,\
  in order to keep the binary versions small. The transcription plug-in is\
  used in combination with format handler plug-ins which handle\
  the conversion between file formats and the internal format\
  used by the transcription plug-in." \
  -url "http://www.speech.kth.se/wavesurfer/" \
  -addmenuentriesproc   trans::addMenuEntries \
  -widgetcreatedproc    trans::widgetCreated \
  -widgetdeletedproc    trans::widgetDeleted \
  -panecreatedproc      trans::paneCreated \
  -panedeletedproc      trans::paneDeleted \
  -redrawproc           trans::redraw \
  -getboundsproc        trans::getBounds \
  -cursormovedproc      trans::cursorMoved \
  -printproc            trans::print \
  -propertiespageproc   trans::propertyPane \
  -applypropertiesproc  trans::applyProperties \
  -getconfigurationproc trans::getConfiguration \
  -openfileproc         trans::openFile \
  -savefileproc         trans::saveFile \
  -needsaveproc         trans::needSave \
  -cutproc              trans::cut \
  -copyproc             trans::copy \
  -pasteproc            trans::paste \
  -stateproc            trans::state \
  -playproc             trans::play \
  -stopproc             trans::stop \
  -registercallbackproc trans::regCallback \
  -soundchangedproc     trans::soundChanged 

# -----------------------------------------------------------------------------

namespace eval trans {
 variable Info

 set Info(path) ""
}

# -----------------------------------------------------------------------------

proc trans::addMenuEntries {w pane m hook x y} {
 if {[string match query $hook]} {
  upvar [namespace current]::${pane}::var v
  if {[info exists v(drawTranscription)]} {
   if {$v(drawTranscription)} {
    return 1
   }
  }
  return 0
 }
 if {[string match main $hook]} {
  upvar [namespace current]::${pane}::var v
  if {[info exists v(drawTranscription)]} {
   if {$v(drawTranscription)} {

    for {set j 0} {$j < $v(menuNcols)} {incr j } {
     for {set i 0} {$i < $v(menuNrows)} {incr i } {
      if {$i==0} {set cb 1} else {set cb 0}
      $m add command -label [subst $v($i$j)] -columnbreak $cb \
        -command [namespace code [list InsertLabel $w $pane $x $y \
        [subst $v($i$j)]]] \
        -font $v(font)
     }
    }

    $m add command -label "Onsets Detection ..." \
      -command [namespace code [list getComputeAubioOnset $w $pane]]
    $m add command -label "Play Label" -columnbreak 1 \
      -command [namespace code [list PlayLabel $w $pane $x $y]]
    $m add command -label "Insert Label" \
      -command [namespace code [list InsertLabel $w $pane $x $y]]
    $m add command -label "Select Label" \
      -command [namespace code [list SelectLabel $w $pane $x $y]]
    $m add command -label "Align Label" \
      -command [namespace code [list AlignLabel $w $pane $x $y]]
    $m add command -label "Browse..." \
      -command [namespace code [list browse $w $pane]]
    $m add command -label "Delete Label" \
      -command [namespace code [list DeleteLabel $w $pane $x $y]]
    #$m add separator 
    $m add command -label "Convert..." \
      -command [namespace code [list convert $w $pane]]
    $m add command -label "Load Transcription..." \
      -command [namespace code [list getOpenTranscriptionFile $w $pane]]
    $m add command -label "Load Text Labels..." \
      -command [namespace code [list getOpenTextLabelFile $w $pane]]
    $m add command -label "Save Transcriptions" \
      -command [namespace code [list saveTranscriptionFiles $w $pane]]
    $m add command -label "Save Transcription As..." \
      -command [namespace code [list getSaveTranscriptionFile $w $pane]]    
    $m add command -label "Split Sound on Labels" \
        -command [namespace code [list SplitSoundFile $w $pane]]    
   }
  }
 }  


 if {[string match create $hook]} {
  $m.$hook add command -label "AubioTranscription" \
    -command [namespace code [list createTranscription $w $pane]]
 } elseif {[string length $hook] == 0} {
  upvar [namespace current]::${pane}::var v
  if {[info exists v(drawTranscription)]} {
   if {$v(drawTranscription)} {
   }
  }
 }
}

proc trans::widgetCreated {w} {
 variable Info
 set Info($w,active) ""
}

proc trans::widgetDeleted {w} {
 variable Info
 foreach key [array names Info $w*] {unset Info($key)}
}

proc trans::paneCreated {w pane} {
 namespace eval [namespace current]::${pane} {
  variable var
 }
 upvar [namespace current]::${pane}::var v
 set v(drawTranscription) 0
 
# foreach otherpane [$w _getPanes] {
#  upvar wsurf::trans::${otherpane}::var ov
#  if {[info exists ov(extBounds)] && $ov(extBounds)} {
#   puts aaa
#   $w _redraw
#  }
# }
}

proc trans::paneDeleted {w pane} {
 upvar [namespace current]::${pane}::var v
 
 foreach otherpane [$w _getPanes] {
  if {$pane == $otherpane} continue
  upvar wsurf::analysis::${otherpane}::var ov
  upvar wsurf::dataplot::${otherpane}::var dv
  if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
   set othercanvas [$otherpane canvas]
   if {[winfo exists $othercanvas]} {
    $othercanvas delete tran$pane
   }
  }
 }
 namespace delete [namespace current]::${pane}
}

proc trans::createTranscription {w pane} {
 set pane [$w addPane -before $pane -height 20 -closeenough 3 \
   -minheight 20 -maxheight 20]
 addTranscription $w $pane
}

### Add-ons from Paul Brossier <piem@altern.org>


proc trans::getComputeAubioOnset {w pane} {
 set execFileName aubioonset
 #exec which $execFileName > /dev/null || echo "$execFileName not found in the path"
 # save selection to a file 
 # (from wavesurfer.tcl : SaveSelection)
 set w [::wsurf::GetCurrent]
 BreakIfInvalid $w

 # select all
 set pane [lindex [$w _getPanes] 0]
 if {$pane != ""} {
  set length [$pane cget -maxtime]
 } else {
  set length [[$w cget -sound] length -unit seconds]
 }
 $w configure -selection [list 0.0 $length]

 # run on selection
 foreach {left right} [$w cget -selection] break
 if {$left == $right} return
 set s [$w cget -sound]
 set start [expr {int($left*[$s cget -rate])}]
 set end   [expr {int($right*[$s cget -rate])}]
 set path [file dirname [$w getInfo fileName]]
 
 set tmpdir      $::wsurf::Info(Prefs,tmpDir)
 set fileName    "$tmpdir/wavesurfer-tmp-aubio.snd"
 set fileNameTxt "$tmpdir/wavesurfer-tmp-aubio.txt"
 set aubioThreshold 0.2 
        #[snack::getSaveFile -initialdir $path \
     #-format $::surf(fileFormat)]
 #if {$fileName == ""} return
 $s write $fileName -start $start -end $end -progress progressCallback

 # system command : compute onsets
 exec aubioonset -i $fileName -t $aubioThreshold > $fileNameTxt 2> /dev/null
 # some ed hacks to put the .txt in .lab format
 # copy the times 3 times: 0.0000 0.0000 0.0000
 exec echo -e "e $fileNameTxt\\n,s/\\(.*\\)/\\\\1 \\\\1 \\\\1/\\nwq" | ed 2> /dev/null
 
 # open the file as a labelfile
 openTranscriptionFile $w $pane $fileNameTxt labelfile
 # delete both files
 exec rm -f $fileName $fileNameTxt
 $w _redrawPane $pane
}

proc trans::getOpenTranscriptionFile {w pane} {
 variable Info
 upvar [namespace current]::${pane}::var v

 if {$v(changed)} {
  if {[string match no [tk_messageBox -message "You have unsaved changes.\nDo you really want to continue?" -type yesno -icon question]]} {
   return
  }
 }
 set file [file tail $v(fileName)]
 if {$Info(path) != ""} {
  set path $Info(path)
 } else {
  if {$v(labdir) == ""} {
   set path [file dirname $v(fileName)]
  } else {
   set path [file normalize [file dirname $v(fileName)]]
   set pathlist [file split $path]
   set path [eval file join [lreplace $pathlist end end $v(labdir)]]
  }
 }
 set fileName [tk_getOpenFile -title "Load Transcription" -initialfile $file \
   -initialdir $path -defaultextension $v(labext)]
 if {$fileName == ""} return

 if {[string compare $path [file dirname $fileName]] != 0} {
  set Info(path) [file dirname $fileName]
 }

 openTranscriptionFile $w $pane $fileName labelfile
 $w _redrawPane $pane
}

proc trans::getOpenTextLabelFile {w pane} {
 variable Info
 upvar [namespace current]::${pane}::var v

 if {$v(changed)} {
  if {[string match no [tk_messageBox -message "You have unsaved changes.\nDo you really want to continue?" -type yesno -icon question]]} {
   return
  }
 }
 set file [file tail $v(fileName)]
 if {$Info(path) != ""} {
  set path $Info(path)
 } else {
  if {$v(labdir) == ""} {
   set path [file dirname $v(fileName)]
  } else {
   set path [file normalize [file dirname $v(fileName)]]
   set pathlist [file split $path]
   set path [eval file join [lreplace $pathlist end end $v(labdir)]]
  }
 }
 set fileName [tk_getOpenFile -title "Load Text Labels" -initialfile $file \
   -initialdir $path -defaultextension $v(labext)]
 if {$fileName == ""} return

 if {[string compare $path [file dirname $fileName]] != 0} {
  set Info(path) [file dirname $fileName]
 }

 set f [open $fileName]
 fconfigure $f -encoding utf-8 
 set labels [split [read -nonewline $f]]
 close $f


 set start [expr 0.5 * [$pane cget -maxtime]]
 set delta [expr 0.5 * [$pane cget -maxtime] / [llength $labels]]
 set i 0
 set v(t1,start) 0.0
 foreach label $labels {
  set v(t1,$i,end)   [expr {$start + $i * $delta}]
  set v(t1,$i,label) $label
  set v(t1,$i,rest)  ""
  lappend map $i
  incr i
 }
 set v(t1,end)  [$pane cget -maxtime]
 set v(nLabels) $i
 set v(map)     $map
 set v(header)  ""
 set v(headerFmt) WaveSurfer

 $w _redrawPane $pane
}

proc trans::saveTranscriptionFiles {w pane} {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription) && $v(changed)} {
   saveTranscriptionFile $w $pane
  }
 }
}

proc trans::getSaveTranscriptionFile {w pane} {
 upvar [namespace current]::${pane}::var v

 set file [file tail $v(fileName)]
 if {$v(labdir) == ""} {
  set path [file dirname $v(fileName)]
 } else {
  set path [file normalize [file dirname $v(fileName)]]
  set pathlist [file split $path]
  set path [eval file join [lreplace $pathlist end end $v(labdir)]]
 }

 set fileName [tk_getSaveFile -title "Save Transcription" -initialfile $file \
   -initialdir $path -defaultextension $v(labext)]
 if {$fileName == ""} return

 set v(fileName) $fileName
 set v(labext) [file extension $fileName]

 saveTranscriptionFile $w $pane
}

proc trans::addTranscription {w pane args} {
 variable Info
 upvar [namespace current]::${pane}::var v
 
 array set a [list \
   -alignment e \
   -labelcolor black \
   -boundarycolor black \
   -backgroundcolor white \
   -extension ".lab" \
   -font {Courier 8} \
   -format WaveSurfer \
   -labeldirectory "" \
   -fileencoding "" \
   -adjustleftevent Control-l \
   -adjustrightevent Control-r \
   -playlabelevent Control-space \
   -labelmenu {2 7 lab1 lab2 lab3 lab4 lab5 lab6 lab7 lab8} \
   -locked 0 \
   -quickenter 1 \
   -quickentertolerance 20 \
   -extendboundaries 0 \
   -linkboundaries 0 \
   -playhighlight 0 \
   ]
 if {[string match macintosh $::tcl_platform(platform)]} {
  set a(-labelmenuevent) Shift-ButtonPress-1
 } else {
  set a(-labelmenuevent) Shift-ButtonPress-3
 }
 if {[string match Darwin $::tcl_platform(os)]} {
  set a(-labelmenuevent) Shift-ButtonPress-1
  set a(-labelmenu) {1 6 lab1 lab2 lab3 lab4 lab5 lab6}
 }
 if {[string match unix $::tcl_platform(platform)] } {
  set a(-font) {Courier 10}
 }
 array set a $args

 set v(alignment)         $a(-alignment)
 set v(labColor)          $a(-labelcolor)
 set v(bdColor)           $a(-boundarycolor)
 set v(bgColor)           $a(-backgroundcolor)
 set v(labext)            .[string trim $a(-extension) .]
 set v(font)              $a(-font)
 set v(format)            $a(-format)
 set v(labdir)            $a(-labeldirectory)
 set v(encoding)          $a(-fileencoding)
 set v(menuNcols)         [lindex $a(-labelmenu) 0]
 set v(menuNrows)         [lindex $a(-labelmenu) 1]
 set v(labelMenuEvent)    $a(-labelmenuevent)
 set v(adjustLeftEvent)   $a(-adjustleftevent)
 set v(adjustRightEvent)  $a(-adjustrightevent)
 set v(playLabelEvent)    $a(-playlabelevent)
 set v(locked)            $a(-locked)
 set v(quickenter)        $a(-quickenter)
 set v(quicktol)          $a(-quickentertolerance)
 set v(extBounds)         $a(-extendboundaries)
 set v(linkBounds)        $a(-linkboundaries)
 set v(highlight)         $a(-playhighlight)
 set v(changed)           0
 set v(t1,start)          0.0
 set v(t1,end)            0.0
 set v(nLabels)           0
 set v(fileName)          ""
 set v(lastPos)           0
 set v(map)               {}
 set v(lastmoved)         -1
 set v(drawTranscription) 1
 set v(headerFmt) WaveSurfer
 set v(header) ""
 list {
  set v(lastTag) ""
  set v(hidden) ""
 }  
 event add <<LabelMenuEvent>>   <$v(labelMenuEvent)>
 event add <<AdjustLeftEvent>>  <$v(adjustLeftEvent)>
 event add <<AdjustRightEvent>> <$v(adjustRightEvent)>
 event add <<PlayLabelEvent>>   <$v(playLabelEvent)>

 for {set i 0} {$i < $v(menuNrows)} {incr i } {
  for {set j 0} {$j < $v(menuNcols)} {incr j } {
   set v($i$j) [lindex $a(-labelmenu) \
     [expr {2 + $v(menuNcols) * $i + $j}]]
  }
 }

 set c [$pane canvas]
list {
 foreach tag {text bg bound} {
  util::canvasbind $c $tag <<LabelMenuEvent>> \
    [namespace code [list labelsMenu $w $pane %X %Y %x %y]]
 }
}
 util::canvasbind $c bound <B1-Motion> \
   [namespace code [list MoveBoundary $w $pane %x]]
 util::canvasbind $c bound <ButtonPress-1> ""

 bind $c <ButtonPress-2> \
     [namespace code [list handleEvents PlayLabel %x %y]]

 $c bind bound <Enter> [list $c configure \
   -cursor sb_h_double_arrow]
 $c bind bound <Leave> [list $c configure -cursor {}]
 $c bind text  <Enter> [list $c configure -cursor xterm]
 $c bind text  <Leave> [list $c configure -cursor {}]

 util::canvasbind $c text <B1-Motion> [namespace code \
   [list textB1Move $w $pane %W %x %y]]
 util::canvasbind $c text <ButtonRelease-1> ""
 util::canvasbind $c text <ButtonPress-1> [namespace code \
   [list textClick $w $pane %W %x %y]]

 util::canvasbind $c bg <ButtonPress-1> [namespace code \
   [list boxClick $w $pane %W %x %y]]
 bind $c <Any-Key>   [namespace code [list handleAnyKey $w $pane %W %x %y %A]]
 bind $c <BackSpace> [namespace code [list handleBackspace $w $pane %W]]
 bind $c <Return> {
  %W insert current insert ""
  %W focus {}
 }

 bind $c <Enter> [namespace code [list handleEnterLeave $w $pane 1]]
 bind $c <Leave> [namespace code [list handleEnterLeave $w $pane 0]]

 bind [winfo toplevel $c] <<AdjustRightEvent>> \
   [namespace code [list handleEvents AdjustLabel %x %y right]]
 bind [winfo toplevel $c] <<AdjustLeftEvent>> \
   [namespace code [list handleEvents AdjustLabel %x %y left]]

 util::canvasbind $c text <<AdjustRightEvent>> ""
 util::canvasbind $c text <<AdjustLeftEvent>> ""

 bind $c <<PlayLabelEvent>> \
   [namespace code [list handleEvents PlayLabel %x %y]]
 bind [winfo toplevel $c] <<PlayLabelEvent>> \
   [namespace code [list handleEvents PlayLabel %x %y]]

 bind $c <<Delete>> "[namespace code [list handleDelete $w $pane %W]];break"
 bind $c <space> "[namespace code [list handleSpace $w $pane %W]];break"
 bind $c <Shift-Control-space> "[namespace code [list FindNextLabel $w $pane]];break"
 $c bind text <Key-Right> [namespace code [list handleKeyRight $w $pane %W]]
 $c bind text <Key-Left>  [namespace code [list handleKeyLeft $w $pane %W]]
 
 if {[$w getInfo fileName] != ""} {
  openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
#  redraw $w $pane
 }
 
 if {$::tcl_version > 8.2} {
  if $v(locked) {
   $c configure -state disabled
  } else {
   $c configure -state normal
  }
 }
 # If the label file is longer than any current displayed pane, update them all
 if {[info exists v(t1,end)]} {
  if {$v(t1,end) > [$pane cget -maxtime]} {
   $w _redraw
  }
 }
}

proc trans::handleEvents {proc args} {
 if {![info exists ::trpane]} {
  return
 }
 if {[namespace which -variable \
          [namespace current]::${::trpane}::var] == ""} return
 upvar [namespace current]::${::trpane}::var v

 if {[info exists v(cursorInPane)]} {
  if {$v(cursorInPane)} {
   eval $proc $::trw $::trpane $args
  }
 }
}

proc trans::handleEnterLeave {w pane arg} {
 upvar [namespace current]::${pane}::var v

 set v(cursorInPane) $arg
}

proc trans::activateInput {w pane state} {
 variable Info
 upvar [namespace current]::${pane}::var v

 if {[info exists Info($w,active)]} {
  if {$state == 1} {
   set Info($w,active) $pane
   [$pane yaxis] configure -relief solid
   [$pane canvas] configure -relief solid
   if {$v(extBounds)} {
    drawExtendedBoundaries $w $pane
   }
  }
  foreach p [$w _getPanes] {
   if {$state == 0 || [string compare $p $pane]} {
    if {[info exists v(drawTranscription)]} {
     if {$v(drawTranscription)} {
      [$p yaxis] configure -relief flat
      [$p canvas] configure -relief flat
     }
    }
   }
  }
 }
}

proc trans::state {w state} {
 variable Info

 if {[info exists Info($w,active)]} {
  if {$Info($w,active) != ""} {
   activateInput $w $Info($w,active) $state
   set c [$Info($w,active) canvas]
   if {$state} {
    boxClick $w $Info($w,active) $c 0 0
   }
  }
 }
}

proc trans::labelsMenu {w pane X Y x y} {
 upvar [namespace current]::${pane}::var v
 set m $w.popup
 if {[winfo exists $m]} {destroy $m}
 menu $m -tearoff 0
 $m add command -label "Play Label" \
   -command [namespace code [list PlayLabel $w $pane $x $y]]
 $m add command -label "Insert Label" \
   -command [namespace code [list InsertLabel $w $pane $x $y]]
 $m add command -label "Select Label" \
   -command [namespace code [list SelectLabel $w $pane $x $y]]
 $m add command -label "Align Label" \
   -command [namespace code [list AlignLabel $w $pane $x $y]]
 $m add command -label "Browse..." \
   -command [namespace code [list browse $w $pane]]
 $m add command -label "Convert..." \
   -command [namespace code [list convert $w $pane]]
 $m add separator 
 $m add command -label "Delete Label" \
   -command [namespace code [list DeleteLabel $w $pane $x $y]]

 for {set j 0} {$j < $v(menuNcols)} {incr j } {
  for {set i 0} {$i < $v(menuNrows)} {incr i } {
   if {$i==0} {set cb 1} else {set cb 0}
   $m add command -label [subst $v($i$j)] -columnbreak $cb \
    -command [namespace code [list InsertLabel $w $pane $x $y \
                               [subst $v($i$j)]]] \
     -font $v(font)
  } 
 }

 if {[string match macintosh $::tcl_platform(platform)]} {
  tk_popup $w.popup $X $Y 0
 } else {
  tk_popup $w.popup $X $Y
 }
}

proc trans::textClick {w pane W x y} {
 upvar [namespace current]::${pane}::var v
 set ::trpane $pane
 set ::trw $w
 set c [$pane canvas]
 focus $W
 $W focus current
 $W icursor current @[$W canvasx $x],[$W canvasy $y]
 $W select clear
 $W select from current @[$W canvasx $x],[$W canvasy $y]
 set tagno [lindex [$c gettags current] 0]
 activateInput $w $pane 1

 set i [lsearch -exact $v(map) $tagno]
 if {$i == -1} return 
 set start [GetStartByIndex $w $pane $i]
 set end $v(t1,$tagno,end)
 set len [expr $end - $start]
 $w messageProc \
    "$v(t1,$tagno,label) ($tagno) start: $start end: $end length: $len"
}

proc trans::textB1Move {w pane W x y} {
 # clear widget selection before selecting any text
 foreach {start end} [$w cget -selection] break
 $w configure -selection [list $start $start]

 $W select to current @[$W canvasx $x],[$W canvasy $y]
}

proc trans::boxClick {w pane W x y} {
 upvar [namespace current]::${pane}::var v
 set ::trpane $pane
 set ::trw $w
 set c [$pane canvas]
 focus $W
 $W focus hidden
 set cx [$c canvasx $x]
 set t [$pane getTime $cx]
 $w configure -selection [list $t $t]
 activateInput $w $pane 1
 set v(clicked) 1
}

proc trans::handleAnyKey {w pane W x y A} {
 upvar [namespace current]::${pane}::var v
 if {[string length $A] == 0} return
 if {[string is print $A] == 0} return
 set c [$pane canvas]
 if {[$W focus] != $v(hidden)} {
  set tag [$W focus]
  catch {$W dchars $tag sel.first sel.last}
  $W insert $tag insert $A
  SetLabelText $w $pane [lindex [$c gettags $tag] 0] \
    [$c itemcget $tag -text]
 } else {
  if {$v(quickenter) == 0} return
  set dx [expr {abs($v(lastPos) - $x)}]
  if {$v(quicktol) > $dx && $v(clicked) == 0} {
   set tagno $v(lastTag)
   append v(t1,$tagno,label) $A
   $c itemconf lab$v(lastTag) -text $v(t1,$tagno,label)
  } else {
   set v(lastTag) [InsertLabel $w $pane $x $y $A]
   if {$v(lastTag) == ""} return
   set v(lastPos) $x
   set v(clicked) 0
  }
 }
 changed $w $pane
}

proc trans::handleDelete {w pane W} {
 set c [$pane canvas]
 if {[$W focus] != {}} {
  set tag [$W focus]
  if {![catch {$W dchars $tag sel.first sel.last}]} {
   return
  }
  $W dchars $tag insert
  SetLabelText $w $pane [lindex [$c gettags $tag] 0] \
      [$c itemcget $tag -text]
  changed $w $pane
 }
}

proc trans::handleBackspace {w pane W} {
 set c [$pane canvas]
 if {[$W focus] != {}} {
  set tag [$W focus]
  if {![catch {$W dchars $tag sel.first sel.last}]} {
   return
  }
  set ind [expr {[$W index $tag insert]-1}]
  if {$ind >= 0} {
   $W icursor $tag $ind
   $W dchars $tag insert
   SetLabelText $w $pane [lindex [$c gettags $tag] 0] \
     [$c itemcget $tag -text]
   changed $w $pane
  }
 }
}

proc trans::handleSpace {w pane W} {
 set c [$pane canvas]
 if {[$W focus] != {}} {
  $W select clear
  $W insert [$W focus] insert _
  SetLabelText $w $pane [lindex [$c gettags [$W focus]] 0] \
    [$c itemcget [$W focus] -text]
 }
}

proc trans::handleKeyRight {w pane W} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
 if {[$W focus] != {}} {
  $W select clear
  set __index [$W index [$W focus] insert]
  $W icursor [$W focus] [expr {$__index + 1}]
  if {$__index == [$W index [$W focus] insert]} {
   set ti [lindex [$c gettags [$W focus]] 0]
   set i [lsearch -exact $v(map) $ti]
   set __focus [lindex $v(map) [expr {$i+1}]]
   $W focus lab$__focus
   $W icursor lab$__focus 0
   while {$width * [lindex [$c xview] 1]-10 < \
     [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 1] < 1} {
    $w xscroll scroll 1 unit
   }
  }
 }
}

proc trans::handleKeyLeft {w pane W} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
 if {[$W focus] != {}} {
  $W select clear
  set __index [$W index [$W focus] insert]
  $W icursor [$W focus] [expr {[$W index [$W focus] insert] - 1}]
  if {$__index == [$W index [$W focus] insert]} {
   set ti [lindex [$c gettags [$W focus]] 0]
   set i [lsearch -exact $v(map) $ti]
   set __focus [lindex $v(map) [expr {$i-1}]]
   $W focus lab$__focus
   $W icursor lab$__focus end
   while {$width * [lindex [$c xview] 0] +10 > \
     [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 0] > 0} {
    $w xscroll scroll -1 unit
   }
  }
 }
}

proc trans::openFile {w soundFileName} {
 variable Info
 
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription)} {
   openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
  }
 }
 return 0
}

proc trans::saveFile {w soundFileName} {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription) && $v(changed)} {
   saveTranscriptionFile $w $pane
  }
 }
 return 0
}

proc trans::openTranscriptionFile {w pane fn type} {
 variable Info
 upvar [namespace current]::${pane}::var v
 
 if {[info exists v(drawTranscription)]} {
  if {$v(drawTranscription) == 0} return
 }
 set fileName ""
 if {[string match soundfile $type]} {
  set path [file normalize [file dirname $fn]]
  set pathlist [file split $path]
  set rootname [file tail [file rootname $fn]]
  set name $rootname.[string trim $v(labext) .]
  
  # Try to locate the corresponding label file

  if {$v(labdir) != ""} {
   # Try the following directories in order
   # 1. try to locate file in specified label file directory 
   # 2. try 'sound file path'/../'specified dir'
   # 3. look in current directory
   # 4. look in same directory as sound file
   
   if {[file readable [file join $v(labdir) $name]]} {
    set fileName [file join $v(labdir) $name]
   } elseif {[file readable [eval file join [lreplace $pathlist end end $v(labdir)] $name]]} {
    set fileName [eval file join [lreplace $pathlist end end $v(labdir)] $name]
   }
  }
  if {$fileName == ""} {
   if {[file readable $name]} {
    set fileName $name
   } elseif {[file readable [file join $path $name]]} {
    set fileName [file join $path $name]
   } else {
    set fileName $name
   }
  }
 } else {
  set fileName $fn
 }
 
 # This filename should be correct, remember it
 
 set v(fileName) $fileName
 set v(nLabels) 0
 set v(map)     {}
 set v(labext) [file extension $fileName]

 foreach {format loadProc saveProc} $Info(formats) {
  if {[string compare $format $v(format)] == 0} {
   set res [[namespace parent]::$loadProc $w $pane]
   if {$res != ""} {
    $w messageProc $res
    set v(changed) 0
    return
   }
  }
 }
}

proc trans::saveTranscriptionFile {w pane} {
 variable Info
 upvar [namespace current]::${pane}::var v

 set fn $v(fileName)
 set strip_fn [file tail [file rootname $fn]]
 if {$strip_fn == ""} {
  set strip_fn [file tail [file rootname [$w getInfo fileName]]]
 }
 set path [file dirname $fn]
 set v(fileName) [file join $path $strip_fn.[string trim $v(labext) .]]
 set fn $v(fileName)
 catch {file copy $fn $fn~}

 foreach {format loadProc saveProc} $Info(formats) {
  if {[string compare $format $v(format)] == 0} {
   set res [[namespace parent]::$saveProc $w $pane]
   if {$res != ""} {
    $w messageProc $res
    return
   }
  }
 }
 set v(changed) 0

 return 0
}

proc trans::needSave {w pane} {
 upvar [namespace current]::${pane}::var v

 if {[info exists v(drawTranscription)]} {
  if {$v(drawTranscription)} {
   if {$v(changed)} {
    return 1
   }
  }
 }
 return 0
}

proc trans::redraw {w pane} {
 upvar [namespace current]::${pane}::var v
 
 if {!$v(drawTranscription)} return

 set c [$pane canvas]
 $c delete tran
 foreach otherpane [$w _getPanes] {
  upvar wsurf::analysis::${otherpane}::var ov
  upvar wsurf::dataplot::${otherpane}::var dv
  if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
   set othercanvas [$otherpane canvas]
   $othercanvas delete tran$pane
  }
 }
 _redraw $w $pane $c 0 0
 #  boxClick $w $pane $c 0 0
}

proc trans::_redraw {w pane c x y} {
 upvar [namespace current]::${pane}::var v

 set progressproc [$w cget -progressproc]
 if {$progressproc != "" && $v(nLabels) > 0} {
#  $progressproc "Creating labels" 0.0
 }
 set height [$pane cget -height]
 set v(height) $height
 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
 set ascent [font metrics $v(font) -ascent]
 set v(ascent) $ascent
 $c configure -bg $v(bgColor)

 [$pane yaxis] delete ext
 set vc [$pane yaxis]
 set yw [winfo width $vc]
 if {$::tcl_version > 8.2 && [string match disabled [$c cget -state]]} {
  [$pane yaxis] create text [expr {$yw/2}] [expr {$height/2}] \
    -text L:$v(labext) \
    -font $v(font) -tags ext \
    -fill $v(labColor)
 } else {
  [$pane yaxis] create text [expr {$yw/2}] [expr {$height/2}] \
    -text $v(labext) \
    -font $v(font) -tags ext \
    -fill $v(labColor)
 }
 if {$v(nLabels) == 0} {
  set slen [[$w cget -sound] length -unit seconds]
  set endx [$pane getCanvasX $slen]
  $c create rectangle [expr {$x+0}] $y \
    [expr {$x+$endx}] [expr {$y+$height-4}] -outline "" \
    -tags [list gEnd obj bg tran] -fill $v(bgColor)
  set v(hidden) [$c create text [expr {$x-100}] [expr {$y+10}] \
    -text "" -tags [list hidden tran]]
  return 0
 } else {
  set start 0
  set end   0
  set label ""

  for {set i [expr $v(nLabels)-1]} {$i >= 0} {incr i -1} {
   set ind [lindex $v(map) $i]
   if {$i == 0} {
    set start $v(t1,start)
   } else {
    set ind2 [lindex $v(map) [expr {$i - 1}]]
    set start $v(t1,$ind2,end)
   }
   set end $v(t1,$ind,end)
   set label $v(t1,$ind,label)
   set lx [$pane getCanvasX $start]
   set rx [$pane getCanvasX $end]

   if {$lx >= 0 && $lx <= $width} {
    #DrawLabel $w $pane $c $ind $i $x $y $lx $rx $label
    set tx [ComputeTextPosition $w $pane $lx $rx]
    $c create rectangle [expr {$x+$lx}] $y \
      [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \
      -tags [list g$ind obj bg tran] -fill $v(bgColor)
    $c create text [expr {$x+$tx}] [expr {$y+$ascent}] -text $label\
      -font $v(font) -anchor $v(alignment)\
      -tags [list $ind obj text lab$ind tran] \
      -fill $v(labColor)
    $c create line [expr {$x+$rx}] $y [expr {$x+$rx}] [expr {$y+$height}] \
      -tags [list b$ind obj bound tran topmost] -fill $v(bdColor)
   }
   if {$progressproc != "" && $i % 100 == 99} {
#    $progressproc "Creating labels" [expr double($v(nLabels)-$i)/$v(nLabels)]
   }
  }
  set start $v(t1,start)
  set sx [$pane getCanvasX $start]
  $c create rectangle [expr {$x+0}] $y \
    [expr {$x+$sx}] [expr {$y+$height-4}] -outline "" \
    -tags [list gStart obj bg tran] -fill $v(bgColor)
  $c create line [expr {$x+$sx}] $y [expr {$x+$sx}] [expr {$y+$height}] \
    -tags [list bStart obj bound tran topmost] -fill $v(bdColor)
  
  set slen [[$w cget -sound] length -unit seconds]
  set endx [$pane getCanvasX $slen]
  $c create rectangle [expr {$x+$rx}] $y \
    [expr {$x+$endx}] [expr {$y+$height-4}] -outline "" \
    -tags [list gEnd obj bg tran] -fill $v(bgColor)
  set prev [lindex $v(map) end]
  $c lower gEnd g$prev
 }
 set v(hidden) [$c create text [expr {$x-100}] [expr {$y+10}] \
   -text "" -tags [list hidden tran]]

 if {$v(extBounds)} {
  drawExtendedBoundaries $w $pane
 }

 if {$progressproc != ""} {
#  $progressproc "Creating labels" 1.0
 }

 return $height
}

proc trans::drawExtendedBoundaries {w pane} {
 upvar [namespace current]::${pane}::var v

 foreach otherpane [$w _getPanes] {
  upvar wsurf::analysis::${otherpane}::var ov
  upvar wsurf::dataplot::${otherpane}::var dv
  if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
   set othercanvas [$otherpane canvas]
   $othercanvas delete tran$pane
  }
 }

 set height [$pane cget -height]
 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]

 if {$v(nLabels) > 0} {
  set start 0
  set end   0
  set label ""

  for {set i [expr $v(nLabels)-1]} {$i >= 0} {incr i -1} {
   set ind [lindex $v(map) $i]
   if {$i == 0} {
    set start $v(t1,start)
   } else {
    set ind2 [lindex $v(map) [expr {$i - 1}]]
    set start $v(t1,$ind2,end)
   }
   set end $v(t1,$ind,end)
   set label $v(t1,$ind,label)
   set lx [$pane getCanvasX $start]
   set rx [$pane getCanvasX $end]

   if {$lx >= 0 && $lx <= $width} {
    foreach otherpane [$w _getPanes] {
     upvar wsurf::analysis::${otherpane}::var av
     upvar wsurf::dataplot::${otherpane}::var dv
     if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
      set othercanvas [$otherpane canvas]
      set height [$otherpane cget -height]
      $othercanvas create line $rx 0 $rx \
        $height -tags [list b$ind$pane obj bound tran$pane] \
          -fill $v(bdColor)
     }
    }
   }
  }
 }
}

proc trans::DrawLabel {w pane c tagno i x y lx rx label} {
 upvar [namespace current]::${pane}::var v
 #  set ascent [font metrics $v(font) -ascent]
 #  set height [$pane cget -height]
 set ascent $v(ascent)
 set height $v(height)

 set tx [ComputeTextPosition $w $pane $lx $rx]
 $c create rectangle [expr {$x+$lx}] $y \
   [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \
   -tags [list g$tagno obj bg tran] -fill $v(bgColor)
 $c create text [expr {$x+$tx}] [expr {$y+$ascent}] -text $label\
   -font $v(font) -anchor $v(alignment)\
   -tags [list $tagno obj text lab$tagno tran] \
   -fill $v(labColor)
 $c create line [expr {$x+$rx}] $y [expr {$x+$rx}] [expr {$y+$height}] \
   -tags [list b$tagno obj bound tran topmost] -fill $v(bdColor)
 
 if {$i > 0} {
  set prev [lindex $v(map) [expr {$i-1}]]
  $c lower g$tagno   g$prev
  $c lower lab$tagno g$prev
  $c lower b$tagno   g$prev
 } else {
  $c lower g$tagno   gStart
  $c lower lab$tagno gStart
  $c lower b$tagno   gStart
 }

 if {$v(extBounds)} {
  foreach otherpane [$w _getPanes] {
   upvar wsurf::analysis::${otherpane}::var av
   upvar wsurf::dataplot::${otherpane}::var dv
   if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
    set othercanvas [$otherpane canvas]
    set height [$otherpane cget -height]
    $othercanvas create line $rx 0 $rx \
     $height -tags [list b$tagno obj bound tran$pane] -fill $v(bdColor)
   }
  }
 }
}

proc trans::isLabel {tags} {
 expr [string compare [lindex $tags 2] bg] == 0 || \
   [string compare [lindex $tags 2] text] == 0
}

proc trans::GetStartByIndex {w pane i} {
 upvar [namespace current]::${pane}::var v
 if {$i <= 0 || $i == "Start"} {
  return $v(t1,start)
 } else {
  set ind [lindex $v(map) [expr $i-1]]
  return $v(t1,$ind,end)
 }
}

proc trans::PlaceLabel {w pane tagno coords start end} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 if {$tagno != "Start"} {
  # Place background and boundary
  $c coords b$tagno $end [lindex $coords 1] $end [lindex $coords 3]
  $c coords g$tagno $start [lindex $coords 1] $end [expr [lindex $coords 3]-4]
  
  # Place label text
  set tx [ComputeTextPosition $w $pane $start $end]
  $c coords lab$tagno $tx [lindex [$c coords lab$tagno] 1]
 } else {
  $c coords b$tagno $end [lindex $coords 1] $end [lindex $coords 3]
  $c coords g$tagno 0 [lindex $coords 1] $end [expr [lindex $coords 3]-4]
 }

 if {$v(extBounds)} {
  foreach otherpane [$w _getPanes] {
   upvar wsurf::analysis::${otherpane}::var av
   upvar wsurf::dataplot::${otherpane}::var dv
   if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
    set othercanvas [$otherpane canvas]
    set height [$otherpane cget -height]
    $othercanvas coords b$tagno$pane $end 0 $end $height
   }
  }
 }
}

proc trans::getBounds {w pane} {
 upvar [namespace current]::${pane}::var v

 if {$v(drawTranscription)} {
  list 0 0 $v(t1,end) 0
 } else {
  list
 }
}

proc trans::MoveBoundary {w pane x} {
 upvar [namespace current]::${pane}::var v
 
 set c [$pane canvas]
 set s [$w cget -sound]
 set coords [$c coords current]
 set xc [$c canvasx $x]
 if {$xc < 0} { set xc 0 }
 set tagno [string trim [lindex [$c gettags current] 0] b]
 set i [lsearch -exact $v(map) $tagno]
 
 # Logic which prevents a boundary to be moved past its neighbor
 set h [lindex $v(map) [expr {$i-1}]]
 set j [lindex $v(map) [expr {$i+1}]]
 set px 0
 set nx [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
 set pb [$c find withtag b$h]
 set nb [$c find withtag b$j]
 if {$pb != ""} { set px [lindex [$c coords $pb] 0]}
 if {$nb != ""} { set nx [lindex [$c coords $nb] 0]}
 if {$xc <= $px} { set xc [expr {$px + 1}] }
 if {$nx <= $xc} { set xc [expr {$nx - 1}] }
 
 set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]

 # Update time
 if {$i == -1} {
  set v(t1,start) [$pane getTime $xc]
 } else {
  set this [lindex $v(map) $i]
  set oldTime $v(t1,$this,end)
  set v(t1,$this,end) [$pane getTime $xc]
 }

 # Place this label
 PlaceLabel $w $pane $tagno $coords $start $xc

 # Place next label
 PlaceNextLabel $w $pane $i $xc

 if {$v(linkBounds)} {
  foreach otherpane [$w _getPanes] {
   upvar [namespace current]::${otherpane}::var ov
   if {$otherpane != $pane && $ov(drawTranscription) && \
           [info exists oldTime]} {
    foreach tag $ov(map) {
     if {$ov(t1,$tag,end) == $oldTime} {
      set ov(t1,$tag,end) [$pane getTime $xc]
      PlaceLabel $w $otherpane $tag $coords $start $xc
      break
     }
    }
   }
  }
 }

 if {$v(lastmoved) != $i} {
  changed $w $pane
  if {$tagno == "Start"} {
   #   wsurf::PrepareUndo "set [namespace current]::var(t1,start) \[list $v(t1,start)\]" ""
  } else {
   #   wsurf::PrepareUndo "set [namespace current]::var(t1,$tagno,end) \[list $v(t1,$tagno,end)\]" ""
  }
  set v(lastmoved) $i
 }
 vtcanvas::motionEvent $pane $x 0
}

proc trans::SetLabelText {w pane tagno label} {
 upvar [namespace current]::${pane}::var v

 $w messageProc [format "Transcription - %s" $label]
 set v(t1,$tagno,label) $label
}

proc trans::InsertLabel {w pane x y {label ""}} {
 upvar [namespace current]::${pane}::var v
 
 set s [$w cget -sound]
 set c [$pane canvas]
 set cx [$c canvasx $x]
 set t [$pane getTime $cx]
 
 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
 if {[isLabel $tags]} {
  set tagno [string trim [lindex $tags 0] g]
  if {$tagno == "End"} {
   #      set i $v(nLabels)
   set i 0
   foreach ind $v(map) {
    if {$t < $v(t1,$ind,end)} break
    incr i
   }
  } else {
   set i [lsearch -exact $v(map) $tagno]
  }
 } else {
  set i 0
  foreach ind $v(map) {
   if {$t < $v(t1,$ind,end)} break
   incr i
  }
 }

 # Create label with a randomly chosen tag number
 set n [clock clicks]
 set v(t1,$n,end) $t
 set v(t1,$n,label) $label
 set v(t1,$n,rest)  ""
 set v(map) [linsert $v(map) $i $n]
 incr v(nLabels)

 # Update start time if new label was inserted first
 if {$i < 0} {
  set v(t1,start) 0
  set co [$c coords bStart]
  $c coords bStart 0 [lindex $co 1] 0 [lindex $co 3]
  set co [$c coords gStart]
  $c coords gStart 0 [lindex $co 1] 0 [lindex $co 3]
  set start 0
 } else {
  set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]
 }

 # Draw inserted label
 DrawLabel $w $pane $c $n $i 0 0 $start $cx $label

 # Place next label
 if {$i < 0} { incr i }
 PlaceNextLabel $w $pane $i $cx

 # Display cursor if label is empty
 if {$label==""} {
  focus [$pane canvas]
  [$pane canvas] focus lab$n
  [$pane canvas] icursor lab$n @[$c canvasx $x],[$c canvasy $y]
 }

 changed $w $pane
 return $n
}

proc trans::DeleteLabel {w pane x y} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]

 if {[isLabel $tags] || [string compare [lindex $tags 2] bound] == 0} {
  set tagno [string trim [lindex $tags 0] gb]
  set i [lsearch -exact $v(map) $tagno]
  if {$i == -1} return

  # Delete everything related to this label
  unset v(t1,$tagno,label)
  unset v(t1,$tagno,end)
  unset v(t1,$tagno,rest)
  set v(map) [lreplace $v(map) $i $i]
  incr v(nLabels) -1
  $c delete b$tagno lab$tagno g$tagno
  if {$v(extBounds)} {
   foreach otherpane [$w _getPanes] {
    upvar wsurf::analysis::${otherpane}::var av
    upvar wsurf::dataplot::${otherpane}::var dv
    if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
     set othercanvas [$otherpane canvas]
     $othercanvas delete b$tagno$pane
    }
   }
  }

  # Place previous label box
  set prev [lindex $v(map) [expr {$i-1}]]
  if {$prev != ""} {
   set end [lindex [$c coords g$prev] 2]
  } else {
   set end [$pane getCanvasX $v(t1,start)]
   set prev 0
  }
  set iprev [lsearch -exact $v(map) $prev]
  PlaceNextLabel $w $pane $iprev $end

  changed $w $pane
 }
}

proc trans::AdjustLabel {w pane x y boundary} {
 upvar [namespace current]::${pane}::var v
 
 set c [$pane canvas]
 set xc [$c canvasx $x]
 set t [$pane getTime $xc]
 set tags [$c gettags [$c find closest $xc [$c canvasy $y]]]
 
 if {[isLabel $tags]} {
  set tagno [string trim [lindex $tags 0] g]
  set i [lsearch -exact $v(map) $tagno]
 } else {
  set i 0
  foreach ind $v(map) {
   if {$t < $v(t1,$ind,end)} break
   incr i
  }
  set tagno [lsearch -exact $v(map) $i]
 }

 if {$i == $v(nLabels)} return
 
 if {$tagno != "End" && [string match left $boundary]} {
  incr i -1
  set tagno [lindex $v(map) $i]
 }
 if {$tagno == "End"} return
 if {$tagno != ""} {
  set v(t1,$tagno,end) $t
 }
 
 if {$i < 0} {
  set v(t1,start) $t
  set co [$c coords bStart]
  set sx [$pane getCanvasX $t]
  $c coords bStart $sx [lindex $co 1] $sx [lindex $co 3]
  $c coords gStart 0 [lindex $co 1] $sx [lindex $co 3]
 }
 set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]
 
 # Place this label
 set co [$c coords b$tagno]
 PlaceLabel $w $pane $tagno $co $start $xc
 
 # Place next label
 PlaceNextLabel $w $pane $i $xc
 
 changed $w $pane
 
 $w messageProc [format "Transcription - %s" [$w formatTime $t]]
}

proc trans::PlayLabel {w pane x y} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]

 if {[isLabel $tags]} {
  set tagno [string trim [lindex $tags 0] g]
  set i [lsearch -exact $v(map) $tagno]
  if {$i == -1} return
 } else {
  set i 0
  set cx [$c canvasx $x]
  set t [$pane getTime $cx]
  foreach ind $v(map) {
   if {$t < $v(t1,$ind,end)} break
   incr i
  }
 }
 set start [GetStartByIndex $w $pane $i]
 set this [lindex $v(map) $i]
 if {$this == ""} return
 set end $v(t1,$this,end)
 
 $w play $start $end
}

proc trans::SelectLabel {w pane x y} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
 
 if {[isLabel $tags]} {
  set tagno [string trim [lindex $tags 0] g]
  set i [lsearch -exact $v(map) $tagno]
  if {$i == -1} return
  
  set start [GetStartByIndex $w $pane $i]
  set end $v(t1,$tagno,end)
  
  $w configure -selection [list $start $end]
 }
}

proc trans::AlignLabel {w pane x y} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
 
 if {[isLabel $tags]} {
  set tagno [string trim [lindex $tags 0] g]
  set i [lsearch -exact $v(map) $tagno]
  if {$i == -1} return
  
  # Get current selection
  foreach {start end} [$w cget -selection] break
  if {$start == $end} return
  
  # Validate that selection and label overlap, otherwise generate warning msg

  set ostart [GetStartByIndex $w $pane $i]
  set oend $v(t1,$tagno,end)
  
  if {$start >= $oend || $end <= $ostart} {
   tk_messageBox -message "Label and selection must overlap!"
   return
  }
  
  # Update boundaries according to current selection
  if {$i == 0} {
   set v(t1,start) $start
  } else {
   set ind [lindex $v(map) [expr $i-1]]
   set v(t1,$ind,end) $start
  }
  
  set v(t1,$tagno,end) $end
  
  $w _redrawPane $pane
 }
}

proc trans::FindNextLabel {w pane} {
 upvar [namespace current]::${pane}::var v
 foreach {start end} [$w cget -selection] break
 set i 0
 foreach ind $v(map) {
  if {$end < $v(t1,$ind,end)} break
  incr i
 }
 set tagno [lsearch -exact $v(map) $i]
 if {$tagno == -1} return
 set start [GetStartByIndex $w $pane $i]
 set end $v(t1,$tagno,end)
 
 $w configure -selection [list $start $end]
 set s [$w cget -sound]
 set length [$s length -unit seconds]
 $w xscroll moveto [expr {($start-1.0)/$length}]
 $w play $start $end
 set delay [expr 500 + int(1000 * ($end - $start))]
 after $delay [namespace code [list FindNextLabel $w $pane]]
}

proc trans::ComputeTextPosition {w pane start end} {
 upvar [namespace current]::${pane}::var v
 if {$v(alignment) == "c"} {
  return [expr {($start+$end)/2}]
 } elseif {$v(alignment) == "w"} {
  return [expr {$start + 2}]
 } else {
  return [expr {$end - 2}] 
 }
}

proc trans::PlaceNextLabel {w pane index pos} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 incr index
 set next [lindex $v(map) $index]

 if {$next == ""} {
  set next End
  set co [$c coords g$next]
  $c coords g$next $pos [lindex $co 1] [lindex $co 2] [lindex $co 3]
 } else {
  set co [$c coords b$next]
  $c coords g$next $pos [lindex $co 1] [lindex $co 2] [expr [lindex $co 3]-4]
  #    $c itemconf g$next -fill yellow
  set xc [ComputeTextPosition $w $pane $pos [lindex $co 2]]
  $c coords lab$next $xc [lindex [$c coords lab$next] 1]
 }
}

proc trans::print {w pane c x y} {
 upvar [namespace current]::${pane}::var v
 
 upvar wsurf::analysis::${pane}::var ov
 upvar wsurf::dataplot::${pane}::var dv
 if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
  foreach otherpane [$w _getPanes] {
   upvar wsurf::trans::${otherpane}::var tv
   if {[info exists tv(extBounds)] && $tv(extBounds)} {
    set drawExtBounds 1
    break;
   }
  }
 }
 
 if {[info exists drawExtBounds]} {
  set height [$pane cget -height]
  set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
  set yAxisCanvas [$pane yaxis]
  set yAxisWidth [winfo width $yAxisCanvas]

  if {$tv(nLabels) > 0} {
   set start 0
   set end   0
   set label ""
   
   for {set i [expr $tv(nLabels)-1]} {$i >= 0} {incr i -1} {
    set ind [lindex $tv(map) $i]
    if {$i == 0} {
     set start $tv(t1,start)
    } else {
     set ind2 [lindex $tv(map) [expr {$i - 1}]]
     set start $tv(t1,$ind2,end)
    }
    set end $tv(t1,$ind,end)
    set label $tv(t1,$ind,label)
    set lx [$pane getCanvasX $start]
    set rx [$pane getCanvasX $end]
    
    if {$lx >= 0 && $lx <= $width} {
     $c create line [expr {$rx+$yAxisWidth}] $y \
         [expr {$rx+$yAxisWidth}] [expr {$y+$height}] \
         -tags [list b$ind$pane obj bound tran$pane print tmpPrint] \
         -fill $tv(bdColor)
    }
   }
  }
 }
 
 
 if {!$v(drawTranscription)} return

 $c raise bound

 set yAxisCanvas [$pane yaxis]
 set yAxisWidth [winfo width $yAxisCanvas]
 set h [$pane cget -height]
 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]

 $c create rectangle $yAxisWidth $y \
   [expr {$x+$width+$yAxisWidth}] [expr {$y+$h}] \
   -tags print -outline black
 _redraw $w $pane $c $yAxisWidth $y
}

proc trans::cursorMoved {w pane time value} {
 upvar [namespace current]::${pane}::var v

 if {$v(drawTranscription)} {
  $w messageProc \
    [format "%s: %s | $v(labelMenuEvent): Label menu" $v(fileName) [$w formatTime $time]]
 }
}

proc trans::soundChanged {w flag} {
 set s [$w cget -sound]
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription)} {
    $w _redrawPane $pane
  }
 }
}

proc trans::propertyPane {w pane} {
 if {$pane==""} return
 upvar [namespace current]::${pane}::var v

 if {$v(drawTranscription)} {
  list Trans1 [namespace code drawPage1] \
    Trans2 [namespace code drawPage2]
 }
}

proc trans::applyProperties {w pane} {
 if {[string match *wavebar $pane]} return
 variable Info
 upvar [namespace current]::${pane}::var v
 
 if {[info exists v(drawTranscription)]} {
  if {$v(drawTranscription)} {
   foreach var {format alignment labext labdir encoding \
     labColor bdColor bgColor \
     font menuNrows menuNcols labelMenuEvent adjustLeftEvent \
     adjustRightEvent playLabelEvent locked quickenter quicktol \
     extBounds linkBounds highlight} {
    if {[string compare $v(t,$var) $v($var)] !=0} {
     if [string match labelMenuEvent $var] {
      event delete <<LabelMenuEvent>> <$v($var)>
      event add <<LabelMenuEvent>> <$v(t,$var)>
     }
     if [string match adjustLeftEvent $var] {
      event delete <<AdjustLeftEvent>> <$v($var)>
      event add <<AdjustLeftEvent>> <$v(t,$var)>
     }
     if [string match adjustRightEvent $var] {
      event delete <<AdjustRightEvent>> <$v($var)>
      event add <<AdjustRightEvent>> <$v(t,$var)>
     }
     if [string match playLabelEvent $var] {
      event delete <<PlayLabelEvent>> <$v($var)>
      event add <<PlayLabelEvent>> <$v(t,$var)>
     }
     if {$::tcl_version > 8.2 && [string match locked $var] == 1} {
      set c [$pane canvas]
      if $v(t,$var) {
       $c configure -state disabled
      } else {
       $c configure -state normal
      }
     }
     if {[string match format $var] || \
       [string match labext $var] || \
       [string match encoding $var] || \
       [string match labdir $var]} {
      if {$v(changed)} {
       if {[string match no [tk_messageBox -message "This operation will cause the transcription to be re-read from disk and you have unsaved changes.\nDo you want to continue?" -type yesno -icon question]]} {
        return
       }
      }
      set v($var) $v(t,$var)
      openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
      set doRedraw 1
     }
     set v($var) $v(t,$var)
     if {[string match labColor $var] || \
         [string match bdColor $var] || \
         [string match font $var] || \
         [string match extBounds $var] || \
         [string match alignment $var] || \
         [string match bgColor $var]} {
      set doRedraw 1
     }
     if {[string match format $var]} {
      set formatChanged 1
     }
    }
   }
   if {[info exists doRedraw]} {
    $w _redrawPane $pane
   }
   if {[info exists formatChanged]} {
    wsurf::_remeberPropertyPage $w $pane
    wsurf::_drawPropertyPages $w $pane
   }
   for {set i 0} {$i < $v(menuNrows)} {incr i } {
    for {set j 0} {$j < $v(menuNcols)} {incr j } {
     set v($i$j) $v(t,$i$j)
    }
   }
  }
 }
}

proc trans::drawPage1 {w pane path} {
 variable Info
 upvar [namespace current]::${pane}::var v

 foreach f [winfo children $path] {
  destroy $f    
 }

 foreach var {format alignment labext labdir encoding \
   labColor bdColor bgColor \
   font locked quickenter quicktol extBounds linkBounds} {
  set v(t,$var) $v($var)
 }

 pack [frame $path.f1] -anchor w
 label $path.f1.l -text "Label file format:" -width 25 -anchor w
 foreach {format loadProc saveProc} $Info(formats) {
  lappend tmp $format
 }
 eval tk_optionMenu $path.f1.om [namespace current]::${pane}::var(t,format) \
   $tmp
 pack $path.f1.l $path.f1.om -side left -padx 3

 pack [frame $path.f2] -anchor w
 label $path.f2.l -text "Label alignment:" -width 25 -anchor w
 tk_optionMenu $path.f2.om [namespace current]::${pane}::var(t,alignment) \
   left center right
 $path.f2.om.menu entryconfigure 0 -value w
 $path.f2.om.menu entryconfigure 1 -value c
 $path.f2.om.menu entryconfigure 2 -value e
 pack $path.f2.l $path.f2.om -side left -padx 3

 stringPropItem $path.f3 "Label filename extension:" 25 16 "" \
   [namespace current]::${pane}::var(t,labext)

 pack [frame $path.f4] -anchor w
 label $path.f4.l -text "Label file path:" -width 25 -anchor w
 entry $path.f4.e -textvar [namespace current]::${pane}::var(t,labdir) -wi 16
 pack $path.f4.l $path.f4.e -side left -padx 3
 if {[info command tk_chooseDirectory] != ""} {
  button $path.f4.b -text Choose... \
    -command [namespace code [list chooseDirectory $w $pane]]
  pack $path.f4.b -side left -padx 3
 }

 stringPropItem $path.f5 "Label file encoding:" 25 16 "" \
   [namespace current]::${pane}::var(t,encoding)

 colorPropItem $path.f6 "Label color:" 25 \
   [namespace current]::${pane}::var(t,labColor)

 colorPropItem $path.f7 "Boundary color:" 25 \
   [namespace current]::${pane}::var(t,bdColor)

 colorPropItem $path.f8 "Background color:" 25 \
   [namespace current]::${pane}::var(t,bgColor)

 stringPropItem $path.f9 "Font:" 25 16 "" \
   [namespace current]::${pane}::var(t,font)

 if {$::tcl_version > 8.2} {
  booleanPropItem $path.f10 "Lock transcription" "" \
    [namespace current]::${pane}::var(t,locked)
 }

 booleanPropItem $path.f11 "Quick transcribe" "" \
   [namespace current]::${pane}::var(t,quickenter)

 stringPropItem $path.f12 "Max cursor movement for current label:" 34 4 \
   pixels [namespace current]::${pane}::var(t,quicktol)

 booleanPropItem $path.f13 "Extend boundaries into waveform and spectrogram panes" "" \
   [namespace current]::${pane}::var(t,extBounds)

 booleanPropItem $path.f14 "Move coinciding boundaries in other transcription panes" "" \
   [namespace current]::${pane}::var(t,linkBounds)
}

proc trans::confPage {w pane path} {
 upvar [namespace current]::${pane}::var v

 for {set i 0} {$i < $v(t,menuNrows)} {incr i } {
  if {![winfo exists $path.fl$i]} {
   pack [frame $path.fl$i] -anchor w
  }
  for {set j 0} {$j < $v(t,menuNcols)} {incr j } {
   if {![winfo exists $path.fl$i.e$j]} {
    pack [entry $path.fl$i.e$j -width 6 \
      -textvar [namespace current]::${pane}::var(t,$i$j)] -side left
   }
   $path.fl$i.e$j configure -font $v(t,font)
  }
  while {[winfo exists $path.fl$i.e$j] == 1} {
   destroy $path.fl$i.e$j
   incr j
  }
 }
 while {[winfo exists $path.fl$i] == 1} {
  destroy $path.fl$i
  incr i
 }
}

proc trans::chooseDirectory {w pane} {
 upvar [namespace current]::${pane}::var v
 set dir $v(t,labdir)
 if {$dir == ""} {
  set dir .
 }
 set res [tk_chooseDirectory -initialdir $dir -mustexist yes]
 if {$res != ""} {
  set v(t,labdir) $res
 }
}

proc trans::drawPage2 {w pane path} {
 upvar [namespace current]::${pane}::var v

 foreach f [winfo children $path] {
  destroy $f    
 }

 foreach var {adjustLeftEvent adjustRightEvent playLabelEvent labelMenuEvent \
   menuNrows menuNcols highlight} {
  set v(t,$var) $v($var)
 }
 for {set i 0} {$i < $v(menuNrows)} {incr i } {
  for {set j 0} {$j < $v(menuNcols)} {incr j } {
   set v(t,$i$j) $v($i$j)
  }
 }

 booleanPropItem $path.f0 "Highlight labels during playback" "" \
   [namespace current]::${pane}::var(t,highlight)

 stringPropItem $path.f1 "Adjust left boundary event:" 28 25 "" \
   [namespace current]::${pane}::var(t,adjustLeftEvent)

 stringPropItem $path.f2 "Adjust right boundary event:" 28 25 "" \
   [namespace current]::${pane}::var(t,adjustRightEvent)

 stringPropItem $path.f3 "Play label event:" 28 25 "" \
   [namespace current]::${pane}::var(t,playLabelEvent)

 stringPropItem $path.f4 "Label menu event:" 28 25 "" \
   [namespace current]::${pane}::var(t,labelMenuEvent)

 pack [frame $path.f5] -anchor w
 pack [label $path.f5.l -text "Label menu pane:" -width 25 -anchor w] -padx 3
 pack [frame $path.f6] -anchor w
 pack [label $path.f6.lc -text "Columns:" -anchor w] -side left -padx 3
 pack [entry $path.f6.ec -width 2 -textvar \
   [namespace current]::${pane}::var(t,menuNcols)] -side left
 pack [label $path.f6.lr -text "Rows:" -anchor w] -side left
 pack [entry $path.f6.er -width 2 -textvar \
   [namespace current]::${pane}::var(t,menuNrows)] -side left
 pack [button $path.f6.b -text Update \
   -command [namespace code [list confPage $w $pane $path]]] -side left \
   -padx 3
 bind $path.f6.ec <Key-Return> [namespace code [list confPage $w $pane $path]]
 bind $path.f6.er <Key-Return> [namespace code [list confPage $w $pane $path]]

 for {set i 0} {$i < $v(t,menuNrows)} {incr i } {
  pack [frame $path.fl$i] -anchor w
  for {set j 0} {$j < $v(t,menuNcols)} {incr j } {
   pack [entry $path.fl$i.e$j -font $v(t,font) \
     -textvar [namespace current]::${pane}::var(t,$i$j) -wi 6] \
     -side left
  }
 }
}

proc trans::getConfiguration {w pane} {
 upvar [namespace current]::${pane}::var v

 set result {}
 if {$pane==""} {return {}}
 if {$v(drawTranscription)} {
  
  lappend labmenu $v(menuNcols) $v(menuNrows)
  for {set i 0} {$i < $v(menuNrows)} {incr i } {
   for {set j 0} {$j < $v(menuNcols)} {incr j } {
    if {[info exists v($i$j)]} {
     lappend labmenu $v($i$j)
    } else {
     lappend labmenu \"\"
    }
   }
  }

  append result "\$widget trans::addTranscription \$pane\
    -alignment $v(alignment)\
    -format \"$v(format)\"\
    -extension \"$v(labext)\"\
    -labelcolor $v(labColor)\
    -boundarycolor $v(bdColor)\
    -backgroundcolor $v(bgColor)\
    -labeldirectory \"$v(labdir)\"\
    -fileencoding \"$v(encoding)\"\
    -labelmenuevent $v(labelMenuEvent)\
    -adjustleftevent $v(adjustLeftEvent)\
    -adjustrightevent $v(adjustRightEvent)\
    -playlabelevent $v(playLabelEvent)\
    -locked $v(locked)\
    -quickenter $v(quickenter)\
    -quickentertolerance $v(quicktol)\
    -extendboundaries $v(extBounds)\
    -linkboundaries $v(linkBounds)\
    -playhighlight $v(highlight)\
    -font \{$v(font)\}"
  append result " -labelmenu \{\n"
  append result "[lrange $labmenu 0 1]\n"
  for {set i 0} {$i < $v(menuNrows)} {incr i } {
   append result "[lrange $labmenu [expr 2+$i*$v(menuNcols)] [expr 1+($i+1)*$v(menuNcols)]]\n"
  }
  append result "\}"
  append result "\n"
 }
 return $result
}

proc trans::cut {w t0 t1} {
 set dt [expr {$t1-$t0}]
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if $v(drawTranscription) {
   if {[llength $v(map)] == 0} continue
   set c [$pane canvas]

   set i 0
   foreach ind $v(map) {
    if {$t0 < $v(t1,$ind,end)} break
    incr i
   }   

   # Adjust start time
   if {$t0 < $v(t1,start)} {
    if {$t1 < $v(t1,start)} {
     # Current selection is to the left of start time
     set v(t1,start) [expr {$v(t1,start)-$dt}]
    } else {
     # Left boundary of current selection is to the left of start time
     set v(t1,start) $t0
    }
   }

   # Left boundary is new end time for first label
   if {$t0 < $v(t1,$ind,end) && \
     $t1 > $v(t1,$ind,end)} {
    set v(t1,$ind,end) $t0
    incr i
    set ind [lindex $v(map) $i]
   }
   set j $i

   # Delete labels within the selection
   while {$ind != "" && $t1 > $v(t1,$ind,end)} {
    #       unset v(t1,$ind,label)
    #       unset v(t1,$ind,end)
    #       unset v(t1,$ind,rest)
    incr i
    set ind [lindex $v(map) $i]
   }
   if {$j <= [expr $i - 1] && $j < [llength $v(map)]} {
    set v(map) [lreplace $v(map) $j [expr $i - 1]]
    set v(nLabels) [llength $v(map)]
   }
   
   # Move all remaining labels $dt to the left
   set ind [lindex $v(map) $j]
   while {$ind != "" && $t1 < $v(t1,$ind,end)} {
    set v(t1,$ind,end) [expr {$v(t1,$ind,end)-$dt}]
    incr j
    set ind [lindex $v(map) $j]
   }
   changed $w $pane
   $w _redrawPane $pane
  }
 }
}

proc trans::copy {w t0 t1} {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if $v(drawTranscription) {
   set c [$pane canvas]
   if {[$c focus] != {}} {
    set tag [$c focus]
    if {[catch {set s [$c index $tag sel.first]}]} return
    set e [$c index $tag sel.last]
    clipboard append [string range [$c itemcget $tag -text] $s $e]
   }
  }
 }
}

proc trans::paste {w t length} {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if $v(drawTranscription) {
   set c [$pane canvas]
   if {[focus] == $c && [$c focus] != $v(hidden)} {
    catch {set cbText [selection get -selection CLIPBOARD]}
    if {[info exists cbText] == 0} { return 0 }
    $c insert [$c focus] insert [selection get -selection CLIPBOARD]
    SetLabelText $w $pane [lindex [$c gettags [$c focus]] 0] \
        [$c itemcget [$c focus] -text]
    return 1
   }
  }
 }
 return 0
 list {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if $v(drawTranscription) {
   if {[llength $v(map)] == 0} return
   set i 0
   foreach ind $v(map) {
    if {$t < $v(t1,$ind,end)} break
    incr i
   }

   # Adjust start time
   if {$t < $v(t1,start)} {
    set v(t1,start) [expr {$v(t1,start)+$length}]
   }

   # Move all remaining labels $length to the left
   while {$ind != ""} {
    set v(t1,$ind,end) [expr {$v(t1,$ind,end)+$length}]
    incr i
    set ind [lindex $v(map) $i]
   }

   $w _redrawPane $pane
  }
 }}
}

proc trans::find {w pane} {
 upvar [namespace current]::${pane}::var v

 set p $v(browseTL)
 set v(nMatch) 0
 $p.f2.list delete 0 end
 set i 0
 if {$v(matchCase)} {
  set nocase ""
 } else {
  set nocase -nocase
 }
 foreach ind $v(map) {
  if {[eval regexp $nocase $v(pattern) \{$v(t1,$ind,label)\}]} {
   if {$i == 0} {
    set start $v(t1,start)
   } else {
    set prev [lindex $v(map) [expr $i-1]]
    set start $v(t1,$prev,end)
   }
   if {[string match *\"* \{$v(t1,$ind,label)\}]} {
    set tmp "\{$v(t1,$ind,label):\} $start $v(t1,$ind,end)"
   } else {
    set tmp "$v(t1,$ind,label): $start $v(t1,$ind,end)"
   }
   $p.f2.list insert end $tmp
   incr v(nMatch)
  }
  incr i
 }
}

proc trans::select {w pane} {
 upvar [namespace current]::${pane}::var v

 set p $v(browseTL)

 set cursel [$p.f2.list curselection]
 if {$cursel == ""} return
 set start [lindex [$p.f2.list get [lindex $cursel 0]] end-1]
 set end   [lindex [$p.f2.list get [lindex $cursel end]] end]
 $w configure -selection [list $start $end]
 set s [$w cget -sound]
 set length [$s length -unit seconds]
 $w xscroll moveto [expr {$start/$length}]
}

proc trans::findPlay {w pane} {
 upvar [namespace current]::${pane}::var v

 set p $v(browseTL)
 set cursel [$p.f2.list curselection]
 if {$cursel != ""} {
  set start [lindex [$p.f2.list get [lindex $cursel 0]] end-1]
  set end   [lindex [$p.f2.list get [lindex $cursel end]] end]
  $w play $start $end
 }
}

proc trans::browse {w pane} {
 upvar [namespace current]::${pane}::var v

 regsub -all {\.} $pane _ tmp
 set v(browseTL) .browse$tmp
 catch {destroy .browse$tmp}
 set p [toplevel .browse$tmp]
 wm title $p "Browse Labels"

 pack [frame $p.f]
 pack [entry $p.f.e -textvar [namespace current]::${pane}::var(pattern)]\
   -side left
 pack [button $p.f.l -text Find \
   -command [namespace code [list find $w $pane]]] -side left

 pack [ label $p.l -text "Results:"]
 pack [ frame $p.f2] -fill both -expand true
 pack [ scrollbar $p.f2.scroll -command "$p.f2.list yview"] -side right \
   -fill y
 listbox $p.f2.list -yscroll "$p.f2.scroll set" -setgrid 1 \
   -selectmode extended -height 6 -width 40
 pack $p.f2.list -side left -expand true -fill both

 pack [checkbutton $p.cb -text "Match case" -anchor w \
   -variable [namespace current]::${pane}::var(matchCase)]

 pack [ frame $p.f3] -pady 10 -fill x -expand true
 pack [ button $p.f3.b1 -bitmap snackPlay \
   -command [namespace code [list findPlay $w $pane]]] \
   -side left
 pack [ button $p.f3.b2 -bitmap snackStop -command "$w stop"] -side left
 pack [ button $p.f3.b3 -text Close -command "destroy $p"] -side right

 bind $p.f.e <Return> [namespace code [list find $w $pane]]
 bind $p.f2.list <ButtonRelease-1> [namespace code [list select $w $pane]]
 if {$v(pattern) != ""} {
  find $w $pane
 }
 bind $p.f2.list <Double-Button-1> [namespace code [list findPlay $w $pane]]
 focus $p.f.e
}

proc trans::convert {w pane} {
 upvar [namespace current]::${pane}::var v
 variable Info
 regsub -all {\.} $pane _ tmp
 set v(convertTL) .convert$tmp
 catch {destroy .convert$tmp}
 set p [toplevel .convert$tmp]
 wm title $p "Convert Transcription File format"

 pack [ label $p.l1 -text "Current transcription file format: $v(format)"]

 set v(t,format) $v(format)
 pack [frame $p.f1] -anchor w
 label $p.f1.l -text "New transcription file format:" -anchor w
 foreach {format loadProc saveProc} $Info(formats) {
  lappend fmtlist $format
 }
 eval tk_optionMenu $p.f1.om [namespace current]::${pane}::var(t,format) \
   $fmtlist
 pack $p.f1.l $p.f1.om -side left -padx 3

 pack [frame $p.f]
 pack [ button $p.f.b1 -text OK -command [namespace code [list doConvert $w $pane]]\n[list destroy $p]] -side left -padx 3
 pack [ button $p.f.b2 -text Close -command "destroy $p"] -side left -padx 3
}

proc trans::doConvert {w pane} {
 upvar [namespace current]::${pane}::var v
 set v(format) $v(t,format)
}

proc trans::play {w} {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription) && $v(highlight)} {
   set v(playIndex) 0
  }
 }
 after 200 [namespace code [list _updatePlay $w]]
}

proc trans::stop {w} {
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  set c [$pane canvas]
  if {$v(drawTranscription)} {
   after cancel [namespace code [list FindNextLabel $w $pane]]
  }
 }
}

proc trans::_updatePlay {w} {
 if {[winfo exists $w] == 0} {
  return
 }
 if {[$w getInfo isPlaying] == 0} {
  foreach pane [$w _getPanes] {
   upvar [namespace current]::${pane}::var v
   set c [$pane canvas]
   if {$v(drawTranscription)} {
    if {$v(highlight) && [info exists v(playIndex)]} {
     set ind [lindex $v(map) $v(playIndex)]
     if {$ind != ""} {
      $c itemconf g$ind -fill $v(bgColor)
     }
    }
   }
  }
  return
 }
 set s [$w cget -sound]
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription) && $v(highlight)} {
   set cursorpos [$pane cget -cursorpos]
   set c [$pane canvas]
   set ind [lindex $v(map) $v(playIndex)]
   if {$ind != ""} {
    $c itemconf g$ind -fill $v(bgColor)
    while (1) {
     set ind [lindex $v(map) $v(playIndex)]
     if {$ind == ""} return
     if {$cursorpos < $v(t1,$ind,end)} break
     incr v(playIndex)
    }
    $c itemconf g$ind -fill [$w cget -cursorcolor]
   }
  }
 }
 if {[$w getInfo isPlaying]} {
  after 50 [namespace code [list _updatePlay $w]]
 }
}

# -----------------------------------------------------------------------------
# !!! experimental

proc trans::regCallback {name callback script} {
 variable Info
# puts [info level 0]
 if {$callback != "-transcription::transcriptionchangedproc"} {
  error "unknown callback \"$callback\""
 } else {
  set Info(Callback,$name,transChangedProc) $script
 }
}

proc trans::changed {w pane} {
# puts [info level 0]([info level -1])
 variable Info
 upvar [namespace current]::${pane}::var v
 set v(changed) 1
 foreach key [array names Info Callback,*,transChangedProc] {
  puts "invoking callback $key"
  $Info($key) $w $pane
 }
}






proc trans::SplitSoundFile {w pane} {
 upvar [namespace current]::${pane}::var v
 set s [$w cget -sound]

 foreach ind $v(map) {
  set start [expr {int([GetStartByIndex $w $pane $ind] * [$s cget -rate])}]
  set end   [expr {int($v(t1,$ind,end) * [$s cget -rate])}]
  $s write $v(t1,$ind,label).wav -start $start -end $end
 }
}