isip_tkdiff.tcl

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

	
	# create the menu
	#
	set mw $p.mbar_f
	menubutton $mw.file -font $fonts(14) -text "File" -menu $mw.file.menu 
	menubutton $mw.help -font $fonts(14) -text "Help" -menu $mw.help.menu
	
	pack $mw.file -side left
	pack $mw.help -side right
	
	# fill in the file menu
	#
	menu $mw.file.menu -font $fonts(12)
	
	$mw.file.menu add command -label "Rescan" -command rescan
	$mw.file.menu add separator
	$mw.file.menu add command -label "Close" -command closeOrExit
	$mw.file.menu add command -label "Quit" -command cleanExit
	
	menu $mw.help.menu -font $fonts(12)
	
	$mw.help.menu add command -label "General" -command helpGeneral
	$mw.help.menu add command -label "Keys" -command helpKeys
	
	bind $p.t <KeyPress> {    
	    
	    switch %K {
		
		"space" { nextChange $p.t }
		"Home"  { $p.t mark set insert 1.0 }
		"End"  { $p.t mark set insert end }
		"Up"  { $p.t yview scroll -1 unit}
		"Down"  { $p.t yview scroll 1 unit}
		"q" { closeOrExit }
		"Q" { closeOrExit }
		"r" { rescan }
		"R" { rescan }

		"n" { nextChange $p.t }
		"N" { nextChange $p.t }
		"p" { prevChange $p.t }
		"P" { prevChange $p.t }
	    }
	}

	wm geometry $p "509x683+518+0"
	wm protocol $p WM_DELETE_WINDOW closeOrExit
    }

    # set the title
    #
    wm title $p $view_title
}

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

    global ph fonts

    if [string match $ph ".phelp"] {
	
	wm deiconify $ph
	raise $ph

    } else {
	
	# change the name of the toplevel widget
	#
	wm withdraw .
	set ph ".ph"
	toplevel $ph
	wm title $ph "tkdiff help"
	
	# create the text widget
	#
	text $ph.t -yscrollcommand "$ph.scroll set" -wrap none
	scrollbar $ph.scroll -command "$ph.t yview"
	pack $ph.scroll -side right -fill y
	frame $ph.mbar_f 
	pack $ph.mbar_f -side top -fill x
	pack $ph.t -expand true -fill both
    }
}
    
# method: displayDir
# 
# build the display screen used for directories
#    
proc displayDir {} {

    global pd fonts

    if [string match $pd ".pdir"] {
	
	raise $pd

    } else {
	
	# change the name of the toplevel widget
	#
	wm withdraw .
	set pd ".pdir"
	toplevel $pd
	wm title $pd "tkdiff Directory Scan"
	
	# create the listbox for the added files
	#
	frame $pd.a
	label $pd.labela -text "Added Files:"  -anchor w
	listbox $pd.a.lb -yscrollcommand "$pd.a.scroll set" -width 50
	scrollbar $pd.a.scroll -command "$pd.a.lb yview"
	pack $pd.a.scroll -side right -fill y -expand true
	pack $pd.a.lb -side left -fill both -expand true
	
	# create the listbox for the deleted files
	#
	frame $pd.d
	label $pd.labeld -text "Deleted Files:"  -anchor w
	listbox $pd.d.lb -yscrollcommand "$pd.d.scroll set" -width 50
	scrollbar $pd.d.scroll -command "$pd.d.lb yview"
	pack $pd.d.scroll -side right -fill y -expand true
	pack $pd.d.lb -side left -fill both -expand true

	# create the listbox for the modified files
	#
	frame $pd.m
	label $pd.labelm -text "Modified Files:" -anchor w
	listbox $pd.m.lb -yscrollcommand "$pd.m.scroll set" -width 50
	scrollbar $pd.m.scroll -command "$pd.m.lb yview"
	pack $pd.m.scroll -side right -fill y -expand true
	pack $pd.m.lb -side left -fill both -expand true

	set mw $pd.mbar_f
	frame $mw

	pack $mw $pd.labelm $pd.m $pd.labela $pd.a $pd.labeld $pd.d \
		-side top -fill x -expand true

	# create the menu
	#
	menubutton $mw.file -font $fonts(14) -text "File" -menu $mw.file.menu 
	menubutton $mw.help -font $fonts(14) -text "Help" -menu $mw.help.menu
	
	pack $mw.file -side left
	pack $mw.help -side right
	
	# fill in the file menu
	#
	menu $mw.file.menu -font $fonts(12)
	
	$mw.file.menu add command -label "Rescan" -command main
	$mw.file.menu add separator
	$mw.file.menu add command -label "Quit" -command cleanExit
	
	menu $mw.help.menu -font $fonts(12)
	
	$mw.help.menu add command -label "General" -command helpGeneral
	$mw.help.menu add command -label "About" -command helpAbout
	$mw.help.menu add command -label "Keys" -command helpKeys
	
	wm protocol $pd WM_DELETE_WINDOW cleanExit

	# setup the bindings for the listboxes
	#
	bind $pd.m.lb <Double-Button-1> {
	    set fname [%W get [%W curselection]]
	    eval $dir_commands($fname)
	}

	# setup the bindings for the listboxes
	#
	bind $pd.a.lb <Double-Button-1> {
	    set fname [%W get [%W curselection]]
	    eval $dir_commands($fname)
	}

	# setup the bindings for the listboxes
	#
	bind $pd.d.lb <Double-Button-1> {
	    set fname [%W get [%W curselection]]
	    eval $dir_commands($fname)
	}
    }
}

# method: mesgBox
#
# display a quick message
#
proc mesgBox { label mesg } {
    
    global fonts

    # default message
    #
    if {$mesg == "" } {
	set mesg "I'm sorry, no help is available for this area. Please\
		consult the user's guide for more information"
    }
    
    set w ".help"

    # don't recreate the help window, try to reuse existing one
    #
    if { [winfo exists $w] == 1 } {
	wm deiconify $w
	raise $w

	# reconfigure the message
	#
	$w.msg configure -text $mesg
	wm title $w $label

    } else {

	# create a new window
	#
	wm withdraw .
	toplevel $w
	wm title $w $label
	button $w.dis -text dismiss -command "destroyWin $w" -pady 0 
	frame $w.msg_f -width 400
	pack $w.dis -side bottom -fill x
	pack $w.msg_f -side top -padx 20 -pady 20

	# set the message
	#
	message $w.msg -width 100c 

	pack $w.msg -in $w.msg_f -side top
	$w.msg configure -text $mesg
    }
}

# method: notCvsDir
#
# determine if the specified directory is under CVS or not
#
proc notCvsDir {my_dir} {
    set cvs_dir "$my_dir/CVS"
    if {[file isdirectory $cvs_dir] == 0} {
	return 1
    } else {
	return 0
    }
}

# method: notRcsFile
#
# determine if the given file is under RCS control
#
proc notRcsFile {my_file} {
    
    set rcs_file "$my_file,v"
    if {[file exists $rcs_file] == 0} {
	return 1
    } else {
	return 0
    }
}

# method: main
#
# parse the command line and run the appropriate methods
#
proc main {} {
    
    global argv debug cvs
    global p v_flag v_opts diff_opts files 

    # if the text window exists, destroy it
    #
    catch {destroy $p}

    set v_flag 0
    set v_opts {}
    set diff_opts ""
    set state 0
    set files {}
    set help_flag 0
    set parse_error 0
    set debug 0

    # test that diff is GNU diff
    #
    set fp [open "| diff --version" "r"]
    set diff_ver [gets $fp]
    close $fp
    if {! [string match $diff_ver "diff - GNU diffutils version 2.7"] } {
	puts "you must have GNU diff v2.7 to use tkdiff"
	exit
    }

    foreach arg [split $argv] {
	
	switch $state {
	    
	    0 {
		switch -- "$arg" {
		    
		    "-V" { set v_flag 1}
		    "-b" { set diff_opts "$diff_opts -b" }
		    "-i" { set diff_opts "$diff_opts -i" }
		    "-w" { set diff_opts "$diff_opts -w" }
		    "-D" { set state 1 }
		    "-r" { set state 2 }
		    "-n" { set cvs "$cvs -n" }
		    "-debug" { set debug 1 }
		    "-help" { set help_flag 1 }
		    default { 
			if {[file exists $arg]} {
			    lappend files $arg 
			} else {
			    mesgBox "tkdiff Error" "Error: file $arg not found"
			    set parse_error 1
			}
		    }
			    
	    }   }
	    1 { 
		set arg [string map {_ \ } $arg]
		lappend v_opts "-D \"$arg\""
		set state 0
	    }
	    2 { lappend v_opts "-r $arg"; set state 0 }
	}
    }

    if {$parse_error == 1} {
	return
    }

    if {$help_flag == 1} {
	helpGeneral
	return
    }

    if {$state == 1} {
	puts "Error: you must specify a date after -D"
	exit
    }
    if {$state == 2} {
	puts "Error: you must specify a revision after -r"
	exit
    }
    if {[llength $v_opts] > 0} {
	set v_flag 1
    }

    if {[llength $v_opts] > 2} {
	puts "Error: you can specify at most two revisions to compare"
	exit
    }
    
    # if we are in cvs mode
    #
    switch [llength $files] {

	0 {
	    
	    if {($v_flag == 0) && [notCvsDir "."]} {
		puts "Error: you must specify at least one file or run in cvs mode"
		exit
	    }

	    scanDirCvs "."
	}

	1 {

	    set file1 [lindex $files 0]
	    
	    switch [file type $file1] {
		"file" {
		    if {![notCvsDir [file dirname $file1]] } {
			scanFileCvs $file1
		    } elseif {![notRcsFile $file1]} {
			scanFileRcs $file1
		    } elseif {$v_flag == 0} {
			puts "Error: you must specify two files or run in cvs/rcs mode"
			exit
		    }
		}
		"directory" {
		    if {($v_flag == 0) && [notCvsDir $file1]} {
			puts "Error: you must specify two dirs or run in cvs mode"
			exit
		    }
		    scanDirCvs $file1
		}
		default {puts "Error: bad file type for $file1"; exit }
	    }
	}

	2 {
	    
	    set file1 [lindex $files 0]
	    set file2 [lindex $files 1]
	    
	    if {$v_flag == 0} {

		set type1 [file type $file1]
		set type2 [file type $file2]

		if {[string match $type1 $type2] == 0} {
		    puts "Error: two arguments of different file types"
		    exit
		}
		switch $type1 {
		    "file" { scanFile $file1 $file2 }
		    "directory" { scanDir $file1 $file2 }
		    default { "Error: bad file type"; exit }
		}
	    } else {
		puts "Error: only specify one argument in CVS mode"
		exit
	    }
	}
	
	default { helpGeneral }
	    
    }
}

# method: scanFile
#
# scan two files and display the differences graphically
#
proc scanFile {f1 f2} {

    global p diff_opts file1 file2 v_flag view_title cvs_mode

    set cvs_mode 0

    # make sure both arguments are files
    #
    if [file isdirectory $f1] {
	mesgBox "tkdiff error" "Error: cannot view directory with file viewer"
	destroyWin $p
	return
    }
    
    if  [file isdirectory $f2] {
	mesgBox "tkdiff error" "Error: cannot view directory with file viewer"
	destroyWin $p
	return
    }
    
    if {! [file readable $f1]} {
	mesgBox "tkdiff error" "Error: cannot read $f1"
	destroyWin $p
	return
    }

    if {! [file readable $f2]} {
	mesgBox "tkdiff error" "Error: cannot read $f2"
	destroyWin $p
	return
    }
    
    if {$v_flag == 0} {
	set view_title "tkdiff $f1 $f2"
    }

    displayText

    set file1 $f1
    set file2 $f2

    $p.t configure -state normal
    set fp [open $file1 "r"]
    loadFile $p.t $fp
    close $fp
    
    set fp [open "| /usr/local/bin/diff $diff_opts $file1 $file2" "r"]
    applyDiff $p.t $fp
    catch {close $fp}
    
    if {[winfo exists $p] == 1} {
	$p.t configure -state disabled
    }
}



# method: viewFile
#
# just load one file into the text display
#
proc viewFile {f1} {

    global file1 p view_title
    
    if [file isdirectory $f1] {
	mesgBox "tkdiff error" "Error: cannot view directory with file viewer"
	destroyWin $p
	return
    }

    if {! [file readable $f1]} {
	mesgBox "tkdiff error" "Error: cannot read $f1"
	destroyWin $p
	return
    }
    
    set view_title [file tail $f1]

    displayText
    
    set file1 $f1
    set file2 ""

    $p.t configure -state normal
    set fp [open $file1 "r"]
    loadFile $p.t $fp