isip_tkdiff.tcl

这是一个从音频信号里提取特征参量的程序

#! @SH@
# determine if help is asked for \
opts="`echo $@ | @SED@ 's/\-help//'` -- `echo $@ | @SED@ 's/^\(.*\(-help\).*\|.*\)$/\2/'`"
#if getopts "hVDrbiw" var; if then opts="-- -help"; else opts="$@"; fi
# the next line restarts using wish \
exec @TCL@ "$0" $opts &
# if this is shell, exit by now (line needed for background run) \
exit

# file: $isip/util/dev/tkdiff/tkdiff.tcl
# version: $Id: isip_tkdiff.tcl,v 1.24 2000/12/14 02:29:31 duncan Exp $

# declare some global variables
#
global line_count current_line current_index jump_pos last_bg
global p pd ph v_flag D_opt r_opt diff_opts files num_v_opts
global cvs

set p ""
set pd ""
set ph ""
set last_bg ""
set cvs "cvs"

# define some fonts to be used
#
global fonts font_list

set fonts(6) "-misc-fixed-medium-r-normal-*-*-60-*-*-c-*-iso8859-*"
set fonts(10) "*-times-medium-r-normal--*-100-*"
set fonts(12) "*-times-bold-r-normal--*-120-*"
set fonts(14) "*-times-bold-r-normal--*-140-*"

set font_list($fonts(6)) {Misc 6}
set font_list($fonts(10)) {Times 10}
set font_list($fonts(12)) {Times-Bold 12}
set font_list($fonts(14)) {Times-Bold 14}

# define the colors
#
global colors
set colors(deleted) "red"
set colors(inserted) "yellow"
set colors(main) "white"

# method: loadFile
#
# load a file into text widget
#
proc loadFile {w fp} {
    
    global line_count
    set line_count 0
    $w delete 1.0 end
    while {! [eof $fp]} {
	incr line_count
	set str [gets $fp]
	$w insert end "$str\n"
    }
}


# method: applyDiff
#
# scan through the differences, as reported by diff, and modify the text
# buffer to display these changes. red means that the line has been deleted,
# yellow means that the line has been inserted.
#
proc applyDiff {w fp} {

    global line_count current_line current_index p jump_pos colors

    set current_line 0
    set current_index 0
    set jump_pos "1.0"

    set CHANGE 1
    set DELETE 2
    set INSERT 3
    
    set FILE1 10
    set FILE_DELIM 11
    set FILE2 12

    set state 0
    set sub_state 0
    set n0 0
    set n1 0
    set n2 0
    set n3 0
    
    # offset is the current number of inserted lines
    #
    set offset 0

    # initialized means at least one change is found
    #
    set initialized 0


    #  The normal output contains lines of these forms:
    #
    #    n17 a n3,n4n1,n2 d n3n1,n2 c n3,n4
    #
    #  where n1 and n2 represent lines file1 and n3 and n4 represent lines in
    #  file2 These lines resemble ed(1) commands to convert file1 to
    #  file2. By exchanging a for d and reading backward, file2 can be
    #  converted to file1. As in ed , identical pairs, where n1=n2 or
    #  n3=n4, are abbreviated as a single number.
    #
    #  Following each of these lines come all the lines that are affected in
    #  the first file flagged by `<', then all the lines that are affected in
    #  the second file flagged by `>'.


    while {! [eof $fp]} {
	
	set str [gets $fp]
#	puts "reading line $str, state = $state, sub_state = $sub_state"
	switch $state {
	    
	    0  
	    {
		if [regexp {[0-9]+c[0-9]+} $str] {
		    set initialized 1

		    if [regexp {^([0-9]+),([0-9]+)c([0-9]+),([0-9]+)$} $str \
			    dummy n1 n2 n3 n4] {
		    } elseif [regexp {^([0-9]+),([0-9]+)c([0-9]+)$} $str \
			    dummy n1 n2 n3] {
			set n4 $n3
		    } elseif [regexp {^([0-9]+)c([0-9]+),([0-9]+)$} $str \
			    dummy n1 n3 n4] {
			set n2 $n1
		    } elseif [regexp {^([0-9]+)c([0-9]+)$} $str dummy n1 n3] {
			set n2 $n1
			set n4 $n3
		    }

		    set state $CHANGE
		    set sub_state $FILE1
		    
		    set skip_count1 [expr $n2 - $n1 + 1]
		    set skip_count2 [expr $n4 - $n3 + 1]
		    set sc1 $skip_count1
		    set sc2 $skip_count2

#		    puts "read a CHANGE command, sc1 = $skip_count1, sc2 = $skip_count2, $str"
		} elseif [regexp {[0-9]+d[0-9]+} $str] {

		    set initialized 1

		    if [regexp {^([0-9]+),([0-9]+)d([0-9]+),([0-9]+)$} $str \
			    dummy n1 n2 n3 n4] {
		    } elseif [regexp {^([0-9]+),([0-9]+)d([0-9]+)$} $str \
			    dummy n1 n2 n3] {
			set n4 $n3
		    } elseif [regexp {^([0-9]+)d([0-9]+),([0-9]+)$} $str \
			    dummy n1 n3 n4] {
			set n2 $n1
		    } elseif [regexp {^([0-9]+)d([0-9]+)$} $str dummy n1 n3] {
			set n2 $n1
			set n4 $n3
		    }
		    set state $DELETE
		    set sub_state $FILE1
		    
		    set skip_count1 [expr $n2 - $n1 + 1]
		    set skip_count2 [expr $n4 - $n3 + 1]

		    set sc1 $skip_count1
		    set sc2 $skip_count2

		    # needed for line numbering
		    incr n3

#		    puts "read a DELETE command, sc1 = $skip_count1, sc2 = $skip_count2, $str"
		} elseif [regexp {[0-9]+a[0-9]+} $str] {

		    set initialized 1

		    if [regexp {^([0-9]+),([0-9]+)a([0-9]+),([0-9]+)$} $str \
			    dummy n1 n2 n3 n4] {
		    } elseif [regexp {^([0-9]+),([0-9]+)a([0-9]+)$} $str \
			    dummy n1 n2 n3] {
			set n4 $n3
		    } elseif [regexp {^([0-9]+)a([0-9]+),([0-9]+)$} $str \
			    dummy n1 n3 n4] {
			set n2 $n1
		    } elseif [regexp {^([0-9]+)a([0-9]+)$} $str dummy n1 n3] {
			set n2 $n1
			set n4 $n3
		    }
		    set state $INSERT
		    set sub_state $FILE2
		    
		    set skip_count1 [expr $n2 - $n1 + 1]
		    set skip_count2 [expr $n4 - $n3 + 1]

		    set sc1 $skip_count1
		    set sc2 $skip_count2

#		    puts "read an INSERT command, sc1 = $skip_count1, sc2 = $skip_count2, $str"
		} elseif [regexp {Binary files .* and .* differ} $str] {

		    # binary files, don't try to display
		    mesgBox "tkdiff message" "$str"
		    destroyWin $p
		    return
		} elseif {[regexp {^\s*$} $str] == 0} {
		    puts "ERROR: unknown command, $str"
		    exit
		}
		
		# catch up on line numbers
		#
		for {set i [expr $current_line + 1]} {$i < $n3} {incr i} {
		    
		    incr current_index
		    incr current_line
#		    puts "adding line number $current_line to pos $current_index"
		    $w insert $current_index.0 \
			    [format "%5.5d  " $current_line] line_number
		    incr line_count -1
		}
	    }

  	    1
  	    {
		
#  		puts "n1=$n1,n2=$n2,n3=$n3,n4=$n4,of=$offset,sc1=$skip_count1,sc2=$skip_count2,sc1=$sc1,sc2=$sc2 for CHANGE_MULTI"
		
  		switch $sub_state {

  		    10
  		    {
  			if {[regexp "^<" $str] == 0} {
  			    puts "ERROR: state CHANGE_MULTI:FILE1, >$str<"
  			    exit
  			}
			incr skip_count1 -1
			if {$skip_count1 == 0} {
			    set sub_state $FILE_DELIM
			}
  		    }

  		    11
  		    {
  			if {[regexp "^---$" $str] == 0} {
  			    puts "ERROR: state CHANGE_MULTI:FILE_DELIM, >$str<"
  			    exit
  			}
  			set sub_state $FILE2

			set l1 [expr $n1 + $offset]
			set l2 [expr $l1 + $sc1]

			for {set i 0} {$i < $sc1} {incr i} {
			    incr line_count -1
			    incr current_index
			    $w insert $current_index.0 "       " deleted
			}

  			$w tag add deleted $l1.0 $l2.0
  			$w tag add modified $l1.0 $l1.5
			
  		    }
		    
  		    12
  		    {
  			if {[regexp "^> (.*)$" $str dummy new_line] == 0} {
  			    puts "ERROR: state CHANGE_SINGLE:FILE_DELIM, >$str<"
  			    exit
  			}
			
  			set line [expr $n1 + $offset + $sc1 ]

  			$w insert $line.0 "$new_line\n" inserted
			
			incr current_index
			incr current_line

			if {$line != $current_index} {
			    puts "ERROR1: line = $line, current_index = $current_index"
			    exit
			}
			$w insert $current_index.0 \
			    [format "%5.5d  " $current_line] inserted

  			incr offset 1
			incr skip_count2 -1

			if {$skip_count2 == 0} {
			    set state 0
			}

  		    }
  		}
  	    }

  	    2
  	    {
		
#  		puts "n1=$n1,n2=$n2,n3=$n3,n4=$n4,of=$offset,sc1=$skip_count1,sc2=$skip_count2,sc1=$sc1,sc2=$sc2 for DELETE"
		
  		switch $sub_state {

  		    10
  		    {
  			if {[regexp "^<" $str] == 0} {
  			    puts "ERROR: state DELETE:FILE1, >$str<"
  			    exit
  			}
			incr skip_count1 -1
			if {$skip_count1 == 0} {
			    set state 0
			    
			    set l1 [expr $n1 + $offset]
			    set l2 [expr $l1 + $sc1]
			    
			    for {set i 0} {$i < $sc1} {incr i} {
				incr line_count -1
				incr current_index
				$w insert $current_index.0 "       " \
					deleted
			    }

			    $w tag add deleted $l1.0 $l2.0
			    $w tag add modified $l1.0 $l1.5
			}
			
  		    }
  		}
  	    }
	    
	    3
  	    {
		
#  		puts "n1=$n1,n2=$n2,n3=$n3,n4=$n4,of=$offset,sc1=$skip_count1,sc2=$skip_count2,sc1=$sc1,sc2=$sc2 for INSERT"
		
  		switch $sub_state {

  		    12
  		    {
  			if {[regexp "^> (.*)$" $str dummy new_line] == 0} {
  			    puts "ERROR: state CHANGE_SINGLE:FILE_DELIM, >$str<"
  			    exit
  			}
			
  			set line [expr $n1 + $offset + $sc1 ]

  			$w insert $line.0 "$new_line\n" inserted

			incr current_index
			incr current_line

			if {$line != $current_index} {
			    puts "ERROR2: line = $line, current_index = $current_index"
			    exit
			}
			$w insert $current_index.0 \
			    [format "%5.5d  " $current_line] inserted

			if {$skip_count2 == $sc2} {
			    $w tag add modified $line.0 $line.5
			}

  			incr offset 1
			incr skip_count2 -1

			if {$skip_count2 == 0} {
			    set state 0
			}

  		    }
  		}
  	    }
	    
	}
    }

    if {$initialized == 0} {
	mesgBox "tkdiff message" "Files are identical"
	destroyWin $p
	return
    }

    # catch up on final line numbers
    #
    while {$line_count > 1} {
	
	incr current_index
	incr current_line
	$w insert $current_index.0 \
		[format "%5.5d  " $current_line] line_number
	incr line_count -1
    }

    $w tag configure deleted -background $colors(deleted)
    $w tag configure inserted -background $colors(inserted)
    $w mark set insert 1.0

    focus $w

}

# method: nextChange
#
proc nextChange {w} {
    global jump_pos
    set next_range [$w tag nextrange modified $jump_pos]
    
    jumpAndShowChange $w $next_range
}

# method: prevChange
#
proc prevChange {w} {
    global jump_pos

    # go back one from the jump_pos
    #
    set jump_line [expr [lindex [split $jump_pos "."] 0] -1]
    set jp "$jump_line.0"

    # find the previous modified tag
    #
    set prev_range [$w tag prevrange modified $jp]
    
    jumpAndShowChange $w $prev_range
}

# method: jumpAndShowChange
#
# jump to the next change in the buffer
#
proc jumpAndShowChange {w new_range} {
    
    global jump_pos last_bg colors
    
    if {[regexp {^\s*$} "$new_range"] == 0} {
	
	if {! [string match "$last_bg" ""]} {
	    $w tag configure jump_line -foreground black -background $last_bg \
		    -overstrike 0
	    $w tag remove jump_line 1.0 end
	}

	# determine what color the background should be
	#
	set tags [$w tag names [lindex $new_range 0]]
	if {[lsearch -exact $tags "deleted"] != -1} {
	    set last_bg [$w tag cget deleted -background]
	} elseif {[lsearch -exact $tags "inserted"] != -1} {
	    set last_bg [$w tag cget inserted -background]
	} else {
	    set last_bg $colors(main)
	}

	# add the tag -- the eval is needed since the entire range
	# is in one variable
	#
	eval "$w tag add jump_line $new_range"

	# change the highlight on the current jump point
	#
	$w tag configure jump_line -background black -foreground $last_bg \
		-overstrike 1

	# scroll to the jump point
	#
	$w see [lindex $new_range 0]
	$w yview scroll -2 pages
	$w see [lindex $new_range 0]
	$w yview scroll +2 pages
	$w see [lindex $new_range 0]

	# save the jump point
	#
	set jump_pos [lindex $new_range 1]
    } else {
	bell
    }
}

# method: displayText
#
# build the display screen used for text
#
proc displayText {} {

    global p fonts view_title

    if [winfo exists $p] {
	
	wm deiconify $p
	raise $p
	
    } else {
	
	# change the name of the toplevel widget
	#
	wm withdraw .
	set p ".parent"
	toplevel $p
	wm title $p "tkdiff"
	
	# create the text widget
	#
	text $p.t -yscrollcommand "$p.scrolly set" -wrap none \
		-xscrollcommand "$p.scrollx set"
	scrollbar $p.scrolly -command "$p.t yview"
	scrollbar $p.scrollx -command "$p.t xview" -orient horizontal
	pack $p.scrollx -side bottom -fill x
	pack $p.scrolly -side right -fill y
	frame $p.mbar_f 
	pack $p.mbar_f -side top -fill x
	pack $p.t -expand true -fill both