# -*-Mode:Tcl-*-
#
#  Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander
#
# This file is part of the WaveSurfer package.
# The latest version can be found at http://sourceforge.net/projects/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(OptionTable) [list \
			    -alignment alignment e \
			    -labelcolor labColor black \
			    -boundarycolor bdColor black \
			    -backgroundcolor bgColor white \
			    -extension labext ".lab" \
			    -format format WaveSurfer \
			    -labeldirectory labdir "" \
			    -fileencoding encoding "" \
			    -adjustleftevent adjustLeftEvent Control-l \
			    -adjustrightevent adjustRightEvent Control-r \
			    -playlabelevent playLabelEvent Control-space \
			    -nextlabelevent nextLabelEvent Key-Up \
			    -prevlabelevent prevLabelEvent Key-Down \
			    -locked locked 0 \
			    -quickenter quickenter 1 \
			    -quickentertolerance quicktol 20 \
			    -extendboundaries extBounds 0 \
			    -linkboundaries linkBounds 0 \
			    -zeroxboundaries zeroXBounds 0 \
			    -playhighlight highlight 0 \
			    -autodetectformat autodetect 1 \
			    -hidelabels hide "<silence>" \
			   ]
 if {[string match unix $::tcl_platform(platform)] } {
  lappend Info(OptionTable) -font font {Courier 10}
 } else {
  lappend Info(OptionTable) -font font {Courier 8}  
 }
 if {[string match Darwin $::tcl_platform(os)]} {
  lappend Info(OptionTable) -labelmenuevent labelMenuEvent Shift-ButtonPress-1
  lappend Info(OptionTable) -labelmenu dummy {1 6 lab1 lab2 lab3 lab4 lab5 lab6}
 } else {
  lappend Info(OptionTable) -labelmenuevent labelMenuEvent Shift-ButtonPress-3
  lappend Info(OptionTable) -labelmenu dummy \
      {2 7 lab1 lab2 lab3 lab4 lab5 lab6 lab7 lab8 {} {} {} {} {} {}}
 }
 
 set Info(path) ""
}

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

proc trans::addMenuEntries {w pane m hook x y} {
#    puts [info level 0]
 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 "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 command -label "Convert..." \
	-command [namespace code [list convert $w $pane]]
    #    $m add separator 
    $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 All 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 "Transcription" \
    -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
   }
  }
 }

 regsub -all {\.} $pane _ tmp
 catch {destroy .browse$tmp}

 namespace delete [namespace current]::${pane}
}

proc trans::createTranscription {w pane} {
 set pane [$w addPane -before $pane -height 24 -closeenough 3 \
   -minheight 24 -maxheight 24]
 addTranscription $w $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)]]
  }
 }
 if {[string match Darwin $::tcl_platform(os)]} {
  if {[file exists $file] == 0} { set file "." }
 }
 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)]]
  }
 }
 if {[string match Darwin $::tcl_platform(os)]} {
  if {[file exists $file] == 0} { set file "." }
 }
 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::transcriptionFromList {w pane transList} {
 variable Info
 upvar [namespace current]::${pane}::var v

 set fileName ""
 set Info(path) ""
 set i 0
 set v(t1,start) 0.0
 set map {}
 foreach {end label} $transList {
  set v(t1,$i,end)   $end
  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

 foreach {option key default} $Info(OptionTable) {
  set a($option) $default
 }
 array set a $args
 
 foreach {option key default} $Info(OptionTable) {
  set v($key) $a($option)
 }
 set v(labext)           .[string trim $v(labext) .]
 set v(menuNcols)         [lindex $a(-labelmenu) 0]
 set v(menuNrows)         [lindex $a(-labelmenu) 1]
 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) ""
 set v(matchCase) 0
 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)>
 event add <<NextLabelEvent>>   <$v(nextLabelEvent)>
 event add <<PrevLabelEvent>>   <$v(prevLabelEvent)>

 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]

 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 <Button-1> [namespace code [list InsertLabel $w $pane %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 <Control-Delete> "[namespace code [list handleCtrlDelete $w $pane %W]];break"
 bind $c <Control-Insert> "[namespace code [list handleCtrlInsert $w $pane %W]];break"
 bind $c <Control-F1> "[namespace code [list $w _redrawPane $pane]];break"
 bind $c <Multi_key> "[namespace code [list handleMultiKey $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]]
 $c bind text <Control-Key-Down> \
     [namespace code [list kbPlayLabel $w $pane %W this]]
 $c bind text <Control-Key-Up> \
     [namespace code [list kbPlayLabel $w $pane %W next]]
 $c bind text <Control-Key-Right> \
     [namespace code [list kbAdjustLeftRight $w $pane %W right]]
 $c bind text <Control-Key-Left> \
     [namespace code [list kbAdjustLeftRight $w $pane %W left]]

 util::canvasbind $c text <<NextLabelEvent>> "[namespace code [list Cursor2NextLabel $w $pane %W next]];break"
util::canvasbind $c text <<PrevLabelEvent>> "[namespace code [list Cursor2NextLabel $w $pane %W prev]]"

 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} {
#    puts [info level 0]
 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} {
#    puts [info level 0]
 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} {
#    puts [info level 0]
    upvar [namespace current]::${pane}::var v
    if {[string length $A] == 0} return
    if {[string is print $A] == 0} return

    # retrieve x & y from vtcanvas since x,y event fields for keypress
    # (on tclkit 8.5.9 for OSX) are garbage...
    set x [$pane getCurX]
    set y [$pane getCurY]

    set c [$pane canvas]
#    puts focus=[$W focus],hidden=$v(hidden)
    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::handleCtrlDelete {w pane W} {
 if {[$W focus] != {}} {
  set tag [$W focus]
  Cursor2NextLabel $w $pane $W next
  set c [$pane canvas]
  DeleteLabelFromTags $w $pane [$c gettags $tag]
 }
}

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::handleMultiKey {w pane W} {
 upvar [namespace current]::${pane}::var v
 set v(multiKeyPressed) 1
}

proc trans::handleSpace {w pane W} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 if {[$W focus] != {}} {
  $W select clear
  if {[info exists v(multiKeyPressed)]} {
   $W insert [$W focus] insert `
  } else {
   $W insert [$W focus] insert _
  }
  SetLabelText $w $pane [lindex [$c gettags [$W focus]] 0] \
    [$c itemcget [$W focus] -text]
 }
 unset -nocomplain v(multiKeyPressed)
}

proc trans::kbPlayLabel {w pane W flag} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]
 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
 if {[$W focus] != {}} {
  set i [lindex [$c gettags [$W focus]] 0]
  if {$flag == "next"} { 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::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::kbAdjustLeftRight {w pane W dir} {
 upvar [namespace current]::${pane}::var v
 
 set c [$pane canvas]
 set tagno [lindex [$c gettags [$W focus]] 0]
 if {$tagno == "End"} return
 if {$tagno != ""} {
  if {$dir == "right"} {
   set t [expr $v(t1,$tagno,end) + 0.005]
  } else {
   set t [expr $v(t1,$tagno,end) - 0.005]
  }
 }
 
 if {$v(zeroXBounds)} {
  set s [$w cget -sound]
  set length [$s length]
  set start [expr {int($t*[$s cget -rate])}]
  if {$start > $length} { set start $length }
  set leftmost [expr {$start-600}]
  if {$leftmost < 0} { ;# to fill sample buffer with leftmost
   $s sample 0
  } else {
   $s sample [expr {$start-600}]
  }
  for {set i 0} {$i < 600} {incr i} {
   if {$dir == "right"} {
    set j [expr {$start + $i}]
    if {$j > 0 && $j < $length} {
     set s1 [lindex [$s sample $j] 0]
     set s0 [lindex [$s sample [expr {$j-1}]] 0]
     if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} {
      break
     }
    }
   } else {
    set j [expr {$start - $i}]
    if {$j > 0 && $j < $length} {
     set s1 [lindex [$s sample $j] 0]
     set s0 [lindex [$s sample [expr {$j-1}]] 0]
     if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} {
      break
     }
    }
   }
  }
  set t [expr double($j)/[$s cget -rate]]
 }
 
 set start [$pane getCanvasX [GetStartByIndex $w $pane $tagno]]
 
 set oldTime $v(t1,$tagno,end)

 # Place this label
 set co [$c coords b$tagno]
 set xc [$pane getCanvasX $t]
 PlaceLabel $w $pane $tagno $co $start $xc
 set v(t1,$tagno,end) $t
 
 # Place next label
 PlaceNextLabel $w $pane $tagno $xc
 
 changed $w $pane

 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) $t
      PlaceLabel $w $otherpane $tag $co $start $xc
      changed $w $otherpane
      break
     }
    }
   }
  }
 }

 $w messageProc [format "Transcription - %s" [$w formatTime $t]]
}

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::checkTranscriptionFile {w pane} {
 variable Info
 upvar [namespace current]::${pane}::var v

 if {[file readable $v(fileName)] == 0} return

 set fd [open $v(fileName)]
 # the transcription file may be empty
 set rows {} 
 foreach row [split [read -nonewline $fd] \n] {
  if {$row != ""} {
   lappend rows $row
  }
 }
 close $fd
 
 foreach {format loadProc saveProc testProc} $Info(formats) {
  set res [[namespace parent]::$testProc $w $pane $rows]
  #puts $format,$res
  if {$res != ""} {
   set v(format) $res
   return
  }
 }

 set v(format) WaveSurfer
}

proc trans::openFile {w soundFileName} {
 variable Info
 
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription)} {
   openTranscriptionFile $w $pane $soundFileName 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(fullName) $fn
 set v(nLabels) 0
 set v(map)     {}
 set v(labext) [file extension $fileName]

 if {$v(autodetect)} {
  checkTranscriptionFile $w $pane
 }

 foreach {format loadProc saveProc testProc} $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::validateTranscription {w pane} {
 upvar [namespace current]::${pane}::var v

 set okStress [list \
		   a2: a2. a2 ä2: ä2. ä2 e2: e2 i2: i2. i2 \
		   å2: å2. å2 u2: u2. u2 \
		   ö2: ö2. ö2 o2: o2. o2 y2: y2. y2 \
		   au. au eu. eu ö3: ö3. ö3 ä3: ä3. ä3 \
		   a: a. a ä: ä. ä e. e i. i å. å u. u ö. ö o: o. o y: y. y \
		   e3 u3 u3. o3 i3 i3. an: an en: en on a3: u4: u4 öw ë]
 set noStress [list \
		   b: b. b d: d. d rd: rd. rd f: f. f g: g. g h: h. h j: j. j \
		   k: k. k l: l. l rl: rl. rl m: m. m n: n. n ng: ng. ng \
		   rn: rn. rn p: p. p r: r. r s: s. s rs: rs. rs sj: sj. sj \
		   t: t. t tj: tj. tj rt: rt. rt v: v. v w: w. w sj3: sj3 \
		   j3 j3: z rs3 tj3 tj3: th: th dh: dh r3 r3: r4 \
		   tcl pcl kcl bcl dcl gcl rtc rdc sil]

 for {set i 0} {$i < $v(nLabels)} {incr i} {
  set ind   [lindex $v(map) $i]
  set label $v(t1,$ind,label)
  
  set label [string trim $label {+,-}]
  set unStrL [string trim $label {\"\'\`+,}]
  if {$v(labext) == ".lab"} {
   if {[lsearch $okStress $unStrL] == -1 && [lsearch $noStress $label] == -1} {
    tk_messageBox -message [::util::mc "Bad label: $label"]    
   }
  } 
  if {$v(labext) == ".ord"} {
   if {[string match <*> $label] && $label != "<silence>"} {
    tk_messageBox -message [::util::mc "Bad label: $label"]    
   }
  } 
 }
}

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

 #validateTranscription $w $pane

 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 testProc} $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)
   if {[lsearch $v(hide) $label] >= 0} { set 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]
    # Make sure labels don't get drawn off left side of screen
    if {$v(alignment) == "e" && $tx < [font measure $v(font) $label]} {
     set tx [font measure $v(font) $label]
    }
    if {$v(alignment) == "c" && $tx < [font measure $v(font) $label]/2.0} {
     set tx [expr [font measure $v(font) $label] / 2.0]
    }

    set bgColor $v(bgColor)
    if {$label == "ons"} { set bgColor green }
    if {$label == "nuc"} { set bgColor red }

    $c create rectangle [expr {$x+$lx}] $y \
      [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \
      -tags [list g$ind obj bg tran] -fill $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 -scrollheight]
      $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 -scrollheight]
    $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]]
  if {$ind == ""} { set ind [lindex $v(map) [expr $i-2]] }
  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 -scrollheight]
    $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 }
 
 if {$v(zeroXBounds)} {
  set length [$s length]
  set start [expr {int([$pane getTime $xc]*[$s cget -rate])}]
  set leftmost [expr {$start-200}]
  if {$leftmost < 0} { ;# to fill sample buffer with leftmost
   $s sample 0
  } else {
   $s sample [expr {$start-200}]
  }
  for {set i 0} {$i < 200} {incr i} {
   set j [expr {$start + $i}]
   if {$j > 0 && $j < $length} {
    set s1 [lindex [$s sample $j] 0]
    set s0 [lindex [$s sample [expr {$j-1}]] 0]
    if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} {
     break
    }
   }
   set j [expr {$start - $i}]
   if {$j > 0 && $j < $length} {
    set s1 [lindex [$s sample $j] 0]
    set s0 [lindex [$s sample [expr {$j-1}]] 0]
    if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} {
     break
    }
   }
  }
   set xc [$pane getCanvasX [expr double($j)/[$s cget -rate]]]
 }

 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
      changed $w $otherpane
      break
     }
    }
   }
  }
 }

 changed $w $pane
 if {$v(lastmoved) != $i} {
  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} {
#    puts [info level 0]
 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 ""}} {
#    puts [info level 0]
 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::xxxhandleCtrlInsert {w pane W} {
 upvar [namespace current]::${pane}::var v
 
 if {[$W focus] != {}} {
  set tag [$W focus]
  #Cursor2NextLabel $w $pane $W next
  set c [$pane canvas]
  set tags [$c gettags $tag]
  set tagno [string trim [lindex $tags 0] gb]

  set i [lsearch -exact $v(map) $tagno]
  if {$i == -1} return

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

  # Deduct some time from current label
  set v(t1,$tagno,end) [expr $v(t1,$tagno,end)-0.04]

  set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]
  set cx    [$pane getCanvasX [GetStartByIndex $w $pane [expr $i+1]]]
  set cx2    [$pane getCanvasX [GetStartByIndex $w $pane [expr $i+2]]]
  
  # Draw inserted label
  DrawLabel $w $pane $c $n $i 0 0 $cx $cx2 ""
  
  # Place next label
  #if {$i < 0} { incr i }
  #incr i -1
  PlaceNextLabel $w $pane $i $start
  PlaceNextLabel $w $pane [expr $i+1] $cx
  PlaceNextLabel $w $pane [expr $i+2] $cx2
  
  changed $w $pane
  return $n
 }
}

proc trans::handleCtrlInsert {w pane W} {
 upvar [namespace current]::${pane}::var v
 
 if {[$W focus] != {}} {
  set tag [$W focus]
  #Cursor2NextLabel $w $pane $W next
  set c [$pane canvas]
  set tags [$c gettags $tag]
  set tagno [string trim [lindex $tags 0] gb]

  set i [lsearch -exact $v(map) $tagno]
  if {$i == -1} return

  # Create label with a randomly chosen tag number
  set n [clock clicks]
  set v(t1,$n,end) [expr $v(t1,$tagno,end)-0.04]
  set v(t1,$n,label) $v(t1,$tagno,label)
  set v(t1,$n,rest)  ""
  set v(map) [linsert $v(map) $i $n]
  incr v(nLabels)
  #foreach qq {3 4 5 6} {
  # set qqq [lindex $v(map) $qq]
  # puts "\t$qqq $v(t1,$qqq,label) $v(t1,$qqq,end)"
  #}
  
  #set v(t1,$tagno,label) "" ; #fungerar inte

  # 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]]
  }
  set cx    [$pane getCanvasX [GetStartByIndex $w $pane [expr $i+1]]]

  # Draw inserted label
  DrawLabel $w $pane $c $n $i 0 0 $start $cx $v(t1,$n,label)
  
  # Place next label
  if {$i < 0} { incr i }
  PlaceNextLabel $w $pane $i $cx
  
  # Display cursor if label is empty
  if {1} {
   focus [$pane canvas]
   [$pane canvas] focus lab$tagno
   [$pane canvas] icursor lab$tagno 0
  }
  
  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]]]
 DeleteLabelFromTags $w $pane $tags
}

proc trans::DeleteLabelFromTags {w pane tags} {
 upvar [namespace current]::${pane}::var v
 set c [$pane canvas]

 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} {
#    puts [info level 0]
 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
 set oldTime $v(t1,$tagno,end)
 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

 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) $t
      PlaceLabel $w $otherpane $tag $co $start $xc
      changed $w $otherpane
      break
     }
    }
   }
  }
 }
 
 $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 length [[$w cget -sound] length -unit seconds]
 foreach {left right} [$w cget -zoomfracs] break
 set mid [expr ($right - $left) / 2.0]
 $w xscroll moveto [expr ($start - $mid)/ $length]
 $w play $start $end
 set delay [expr 500 + int(1000 * ($end - $start))]
 after $delay [namespace code [list FindNextLabel $w $pane]]
}

proc trans::Cursor2NextLabel {w pane W dir} {
 upvar [namespace current]::${pane}::var v

 # move insertion cursor to next label
 set c [$pane canvas]
 set ti [lindex [$c gettags [$W focus]] 0]

 set i [lsearch -exact $v(map) $ti]
 if {$dir == "next"} {
  set __focus [lindex $v(map) [expr {$i+1}]]
 } else {
  set __focus [lindex $v(map) [expr {$i-1}]]
 }
 
 $W focus lab$__focus
 $W icursor lab$__focus 0

 set start [GetStartByIndex $w $pane [lsearch -exact $v(map) $__focus]]
 
 set end $v(t1,$__focus,end)
 $w play $start $end

 # center label in view
 if {$dir == "next"} {
  set i [expr {$i+2}]
 } else {
  set i [expr {$i-1}]
 }
 set start [GetStartByIndex $w $pane $i]
 
 set length [[$w cget -sound] length -unit seconds]
 foreach {left right} [$w cget -zoomfracs] break
 set mid [expr ($right - $left) / 2.0]
 $w xscroll moveto [expr ($start - $mid)/ $length]
}

proc trans::Cursor2FirstLabel {w} {
 foreach p [$w _getPanes] {
  upvar ::wsurf::trans::${p}::var v
  if {$v(drawTranscription)} break
 }
 set c [$p canvas]

 if {[$c focus] == ""} {
  focus $c
  set __focus [lindex $v(map) 0]
  $c focus lab$__focus
  $c icursor lab$__focus 0
  Cursor2NextLabel $w $p $c next
 }
}

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 ttk::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
 $c delete bg ;# sometimes characters seem to have been obscured by the bg
}

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

 if {$v(drawTranscription)} {
     set v(currentX) [$pane getCanvasX $time]
     set v(currentY) [$pane getCanvasY $value]
  $w messageProc \
    [format "%s: %s | $v(labelMenuEvent): Label menu" $v(fileName) [$w formatTime $time]]
 }
}

proc trans::soundChanged {w flag} {
 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 nextLabelEvent \
     locked quickenter quicktol hide \
     extBounds linkBounds highlight autodetect zeroXBounds} {
    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 [string match nextLabelEvent $var] {
      event delete <<NextLabelEvent>> <$v($var)>
      event add <<NextLabelEvent>> <$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 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)
      set oldFormat $v(format)
      openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
      set doRedraw 1
      if {$oldFormat != $v(format)} {
       set formatChanged 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 hide $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 hide \
   font locked quickenter quicktol extBounds linkBounds zeroXBounds} {
  set v(t,$var) $v($var)
 }

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

 pack [ttk::frame $path.f2] -anchor w
 ttk::label $path.f2.l -text "Label alignment:" -width 25 -anchor w
    ttk::combobox $path.f2.om -textvariable [namespace current]::${pane}::var(t,alignment) -values [list e c w] -state readonly

 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 [ttk::frame $path.f4] -anchor w
 ttk::label $path.f4.l -text "Label file path:" -width 25 -anchor w
 ttk::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)

 stringPropItem $path.f10 "Hide labels:" 25 16 "" \
   [namespace current]::${pane}::var(t,hide)

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

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

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

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

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

 booleanPropItem $path.f16 "Constrain boundaries to zero crossings" "" \
   [namespace current]::${pane}::var(t,zeroXBounds)
}

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 [ttk::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 [ttk::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 \
  nextLabelEvent menuNrows menuNcols highlight autodetect} {
  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)
 
 booleanPropItem $path.f00 "Auto-detect transcription file format" "" \
     [namespace current]::${pane}::var(t,autodetect)
 
 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.f31 "Move to next label event:" 28 25 "" \
   [namespace current]::${pane}::var(t,nextLabelEvent)

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

 pack [ttk::frame $path.f5] -anchor w
 pack [ttk::label $path.f5.l -text "Label menu pane:" -width 25 -anchor w] -padx 3
 pack [ttk::frame $path.f6] -anchor w
 pack [ttk::label $path.f6.lc -text "Columns:" -anchor w] -side left -padx 3
 pack [ttk::entry $path.f6.ec -width 2 -textvar \
   [namespace current]::${pane}::var(t,menuNcols)] -side left
 pack [ttk::label $path.f6.lr -text "Rows:" -anchor w] -side left
 pack [ttk::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 [ttk::frame $path.fl$i] -anchor w
  for {set j 0} {$j < $v(t,menuNcols)} {incr j } {
   pack [ttk::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} {
 variable Info
 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"

  foreach {option key default} $Info(OptionTable) {
   if {$v($key) != $default && $option != "-labelmenu"} {
     append result " $option \"$v($key)\""
   }
   if {$option == "-labelmenu" && $labmenu != $default} {
    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
   } else {
    if {[llength $v(map)] == 0} continue
    
    # Skip labels before $t
    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 labels $dt to the left
    set ind [lindex $v(map) $i]
    while {$ind != ""} {
     set v(t1,$ind,end) [expr {$v(t1,$ind,end)+$length}]
     incr i
     set ind [lindex $v(map) $i]
    }
    changed $w $pane
    $w _redrawPane $pane
    
   }
  }
 }
}

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

 set p $v(browseTL)
 set v(nMatch) 0
 $p.b.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.b.f2.list insert end $tmp
   incr v(nMatch)
  }
  incr i
 }
}

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

 set p $v(browseTL)

 set cursel [$p.b.f2.list curselection]
 if {$cursel == ""} return
 set start [lindex [$p.b.f2.list get [lindex $cursel 0]] end-1]
 set end   [lindex [$p.b.f2.list get [lindex $cursel end]] end]
 if {$v(selectMode) == "start"} {
  $w configure -selection [list $start $start]
 } else {
  $w configure -selection [list $start $end]
 }
 set length [[$w cget -sound] length -unit seconds]
 foreach {left right} [$w cget -zoomfracs] break
 set mid [expr ($right - $left) / 2.0]
 $w xscroll moveto [expr ($start - $mid)/ $length]

 # Mark word in text widget

 foreach ind $v(map) {
  if {$start < $v(t1,$ind,end)} break
 }
 $p.f.t tag configure $ind -background [$w cget -cursorcolor]
 $p.f.t see [$p.f.t index ${ind}.first]
 $p.f.t tag configure $v(oldHighlight) -background ""
 set v(oldHighlight) $ind
}

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: $v(fileName)"

 if {[info exists v(pattern)] == 0} { set v(pattern) "" }
 if {[info exists v(selectMode)] == 0} {
  set v(selectMode) start
 }
 if {[info exists v(breakAtLab)] == 0} {
  set v(breakAtLab) <silence>
 }
 if {[info exists v(breakAtLen)] == 0} {
  set v(breakAtLen) 1.0
 }
 
 pack [ ttk::frame $p.f] -fill both -expand true
 pack [ text $p.f.t -yscrollcommand [list $p.f.sb set] -font {Courier 16} \
	  -height 8] -side left -expand true -fill both
 pack [ scrollbar $p.f.sb -orient vert -command [list $p.f.t yview]] -side left -fill y
 

 pack [ ttk::frame $p.b] -fill both -expand true
 pack [ ttk::frame $p.b.f0]

 pack [ ttk::radiobutton $p.b.f0.r1 -text [::util::mc "Select start"] -value start \
	    -variable [namespace current]::${pane}::var(selectMode) \
	    -command [namespace code [list listSelect $w $pane]]] -side left
 pack [ ttk::radiobutton $p.b.f0.r2 -text [::util::mc "Select word"] -value word \
	    -variable [namespace current]::${pane}::var(selectMode) \
	    -command [namespace code [list listSelect $w $pane]]] \
     -padx 20 -side left
 pack [ ttk::label $p.b.f0.l1 -text "Insert line break at label:"] -side left
 pack [ ttk::entry $p.b.f0.e1 -width 15 \
	    -textvar [namespace current]::${pane}::var(breakAtLab)] -side left
 pack [ ttk::label $p.b.f0.l2 -text "longer than"] -side left
 pack [ ttk::entry $p.b.f0.e2 -width 4 \
	    -textvar [namespace current]::${pane}::var(breakAtLen)] -side left
 pack [ ttk::label $p.b.f0.l3 -text "s"] -side left

 pack [ ttk::frame $p.b.f1] -pady 20
 pack [ ttk::entry $p.b.f1.e -textvar [namespace current]::${pane}::var(pattern)] \
     -side left
 pack [ button $p.b.f1.l -text Find \
	    -command [namespace code [list find $w $pane]]] -side left
  pack [ ttk::checkbutton $p.b.f1.cb -text "Match case" \
	     -variable [namespace current]::${pane}::var(matchCase)]
 pack [ ttk::label $p.b.l -text "Results:"]
 pack [ ttk::frame $p.b.f2] -fill both -expand true
 pack [ scrollbar $p.b.f2.scroll -command "$p.b.f2.list yview"] -side right \
   -fill y
 listbox $p.b.f2.list -yscroll "$p.b.f2.scroll set" -setgrid 1 \
   -selectmode extended -height 6 -width 40
 pack $p.b.f2.list -side left -expand true -fill both

 pack [ ttk::frame $p.b.f3] -pady 10 -fill x -expand true
 pack [ button $p.b.f3.b1 -image $::wsurf::Info(Img,play) \
	    -command "$w play"] -side left
 pack [ button $p.b.f3.b2 -image $::wsurf::Info(Img,stop) -command "$w stop"] \
     -side left
 pack [ button $p.b.f3.b3 -text Close -command "destroy $p"] -side right

 bind $p.b.f1.e <Return> [namespace code [list find $w $pane]]
 bind $p.b.f0.e1 <Return> [namespace code [list insertBrowseText $w $pane]]
 bind $p.b.f0.e2 <Return> [namespace code [list insertBrowseText $w $pane]]
 bind $p.b.f2.list <ButtonRelease-1> [namespace code [list listSelect $w $pane]]
 if {$v(pattern) != ""} {
  find $w $pane
 }
 bind $p.b.f2.list <Double-Button-1> "$w play"
 focus $p.b.f1.e

 insertBrowseText $w $pane

 bind $p.f.t <ButtonRelease-1> [namespace code [list textSelect $w $pane]]
}

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

 set p $v(browseTL)
 $p.f.t delete 0.0 end

 foreach ind $v(map) {
  set label $v(t1,$ind,label)
  if {[lsearch $v(hide) $label] >= 0} { set label "" }
  set last [$p.f.t index end-1c]
  $p.f.t insert end "$label "
  $p.f.t tag add $ind $last [$p.f.t index end-1c]
  set v(oldHighlight) ""
  if {$v(t1,$ind,label) == $v(breakAtLab)} {
   set start [GetStartByIndex $w $pane $ind]
   if {$v(t1,$ind,end) - $start > $v(breakAtLen)} {
    $p.f.t insert end "\n"
   }
#   $p.f.t tag add $ind [$p.f.t index end-2c] [$p.f.t index end-1c]
#   continue
  }
 }
}

proc trans::textSelect {w pane} {
 upvar [namespace current]::${pane}::var v
 
 set p $v(browseTL)
 set tag [lindex [$p.f.t tag names [$p.f.t index current]] 0]
 $p.f.t tag configure $tag -background [$w cget -cursorcolor]
 $p.f.t tag configure $v(oldHighlight) -background ""
 set v(oldHighlight) $tag
 
 foreach ind $v(map) {
  if {$tag == $ind} {
   set start [GetStartByIndex $w $pane $ind]
   set end   $v(t1,$ind,end)
   if {$v(selectMode) == "start"} {
    $w configure -selection [list $start $start]
   } else {
    $w configure -selection [list $start $end]
   }
   set length [[$w cget -sound] length -unit seconds]
   foreach {left right} [$w cget -zoomfracs] break
   set mid [expr ($right - $left) / 2.0]
   $w xscroll moveto [expr ($start - $mid)/ $length]
  }
 }
}

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 [ ttk::label $p.l1 -text "Current transcription file format: $v(format)"]

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

 pack [ttk::frame $p.f]
 pack [ ttk::button $p.f.b1 -text OK -command [namespace code [list doConvert $w $pane]]\n[list destroy $p]] -side left -padx 3
 pack [ ttk::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)} {
   set v(playIndex) 0
   set v(oldHighlight) 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)} {
     $c itemconf g$v(oldHighlight) -fill $v(bgColor)
    }
   }
  }
  return
 }
 set s [$w cget -sound]
 foreach pane [$w _getPanes] {
  upvar [namespace current]::${pane}::var v
  if {$v(drawTranscription) && ($v(highlight) || [info exists v(browseTL)])} {
   set cursorpos [$pane cget -cursorpos]
   set c [$pane canvas]
   set ind [lindex $v(map) $v(playIndex)]
   while (1) {
    set ind [lindex $v(map) $v(playIndex)]
    if {$ind == ""} return
    if {$cursorpos < $v(t1,$ind,end)} break
    incr v(playIndex)
   }
   if {$ind != "" && $v(oldHighlight) != $ind} {
    if {$v(highlight)} {
     $c itemconf g$ind -fill [$w cget -cursorcolor]
     $c itemconf g$v(oldHighlight) -fill $v(bgColor)
    }
    if {[info exists v(browseTL)] && [winfo exists $v(browseTL)]} {
     set p $v(browseTL)
     $p.f.t tag configure $ind -background [$w cget -cursorcolor]
     $p.f.t see [$p.f.t index ${ind}.first]
     $p.f.t tag configure $v(oldHighlight) -background ""
    }
    set v(oldHighlight) $ind
   }
  }
 }
 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]
    
    set start 0

    set basefn [$w getInfo fileName]
    if {$basefn!=""} {
	set dir $basefn.split
	file mkdir $dir
    } else {
	set dir $::env(HOME)
    } 

    set ii 0
    foreach ind $v(map) {
	set end   [expr {int($v(t1,$ind,end) * [$s cget -rate])}]
	$s write $dir/[util::zpad $ii 6]$v(t1,$ind,label).wav -start $start -end $end
	set start $end
	incr ii
    }
}
