xdeview

UUDeview是一个编码解码器

#
# Action 'List'
#

proc List {} {
    global FileList

    set ListFile [ lindex [ ._MainFrame._FileList._Liste curselection ] 0 ]

    if { $ListFile == {} } {
	return;
    }

    set oldCursor [ lindex [ . config -cursor ] 4 ]
    set oldText   [ lindex [ ._Status._Text config -text ] 4 ]
    set FileName  [ lindex [ lindex $FileList $ListFile ] 2 ]

    . config -cursor watch
    ._Status._Text config -text "Listing $FileName"

    if { [ catch { .list configure } ] } {
	toplevel .list
	frame .list.top
	frame .list.bot
	text .list.top.text -relief raised -bd 2 -wrap none \
		-xscrollcommand ".list.top.sbx set" \
		-yscrollcommand ".list.top.sby set" 
	scrollbar .list.top.sbx -command ".list.top.text xview" \
		-orient horizontal
	scrollbar .list.top.sby -command ".list.top.text yview"

	pack .list.top.sbx -side bottom -fill x
	pack .list.top.sby -side right -fill y
	pack .list.top.text -fill both -expand 1

	button .list.bot.done -text "Done" -command "destroy .list"
	pack .list.bot.done -side right -padx 4 -pady 4

	pack .list.top -side top -fill both -expand 1
	pack .list.bot -side bottom
    }

    wm title .list "Listing of [ file tail $FileName ]"

    .list.top.text configure -state normal

    if { [ catch { uu_ListFile $ListFile .list.top.text } errorMsg ] } {
	tk_dialog ._Dialog "Oops" "The following problem occured\
		while trying to list the file: $errorMsg" error 0 OK
    }

    .list.top.text configure -state disabled

    ._Status._Text config -text $oldText
    . config -cursor $oldCursor
}

#
# Action 'Rename'
#

proc Rename {} {
    global FileList
    global NewName
    global OldName
    global RenBut

    set RenameList [ ._MainFrame._FileList._Liste curselection ]
    set count      [ llength $RenameList ]
    set oldCursor  [ lindex [ . config -cursor ] 4 ]
    set oldText    [ lindex [ ._Status._Text config -text ] 4 ]
    set oldFocus   [ focus ]

    if { $RenameList == {} } {
	return;
    }

    toplevel .rename
    frame .rename.cur -relief raised -bd 1
    frame .rename.new -relief raised -bd 1
    frame .rename.but -relief raised -bd 2
    frame .rename.but.but

    label .rename.cur.lab -text "Old Name: "
    entry .rename.cur.nam -width 40 -relief sunken -bd 2 \
	    -textvariable OldName
    label .rename.new.lab -text "New Name: "
    entry .rename.new.nam -width 40 -relief sunken -bd 2 \
	    -textvariable NewName

    pack .rename.cur.nam -side right -padx 8 -pady 8
    pack .rename.new.nam -side right -padx 8 -pady 8
    pack .rename.cur.lab -side left -padx 8 -pady 8 -fill x
    pack .rename.new.lab -side left -padx 8 -pady 8 -fill x

    button .rename.but.but.ok  -text "Ok"     -command "set RenBut 1"
    button .rename.but.but.can -text "Cancel" -command "set RenBut 0"

    pack .rename.but.but.ok  -side left -padx 4 -pady 4 -fill x
    pack .rename.but.but.can -side left -padx 4 -pady 4 -fill x
    pack .rename.but.but

    pack .rename.cur -side top -fill x
    pack .rename.new -side top -fill x
    pack .rename.but -side bottom -fill x

    bind .rename.new.nam <Return> "set RenBut 1"

    wm title .rename "Rename"
    . config -cursor watch
    set oldFocus [ focus ]
    tkwait visibility .rename
    grab set .rename
    focus .rename

    for { set index 0 } { $index < $count } { incr index } {
	set ItemNo     [ lindex $RenameList $index ]
	set FileName   [ lindex [ lindex $FileList $ItemNo ] 2 ]
	set FileNumber [ lindex [ lindex $FileList $ItemNo ] 0 ]

	._Status._Text config -text "Renaming $FileName"

	.rename.cur.nam configure -state normal
	set OldName $FileName
	set NewName $FileName
	.rename.cur.nam configure -state disabled
	set RenBut {}
	update
	tkwait variable RenBut

	if { $RenBut == 0 } {
	    break
	} elseif { $RenBut == 1 && $NewName != {} } {
	    if { [ catch { uu_Rename $ItemNo [file tail $NewName] } eMsg ] } {
		tk_dialog ._Dialog "Oops" "Couldn't rename the file for\
			the following reason: $eMsg" error 0 OK
	    }
	}
    }
    ._Status._Text config -text $oldText
    . config -cursor $oldCursor
    destroy .rename
    focus $oldFocus

    ShowFileList
}

#
# Action 'Execute'
#

proc Execute {} {
    global FileList
    global FileTypes
    global ExeCom
    global ExeBut

    ifndef ExeCom {}

    set ListFile [ lindex [ ._MainFrame._FileList._Liste curselection ] 0 ]
    set app {}

    if { $ListFile == {} } {
	return;
    }

    set oldCursor [ lindex [ . config -cursor ] 4 ]
    set oldText   [ lindex [ ._Status._Text config -text ] 4 ]
    set FileName  [ lindex [ lindex $FileList $ListFile ] 2 ]
    set FileNumb  [ lindex [ lindex $FileList $ListFile ] 0 ]
    set mimtype   [ lindex [ lindex $FileList $ListFile ] 3 ]
    set oldFocus  [ focus ]

    . config -cursor watch
    ._Status._Text config -text "Decoding $FileName to temp file"
    update

    if { [ catch { uu_GetTempFile $FileNumb } tempFile ] } {
	tk_dialog ._Dialog "Error while decoding" "The following problem\
		occured while decoding: $tempFile" \
		error 0 OK
    } else {
	#
	# Do we have a Content-Type:
	#

	if { $mimtype != "" } {
	    set app [ GetTypeAction $mimtype ]
	}

	#
	# try to determine app from file extension
	#

	if { $app == "" } {
	    set lfn [ split [ string tolower $FileName ] . ]
	    set ext [ lindex $lfn [ expr [ llength $lfn ] - 1 ] ]

	    if { [ set mimtype [ GetTypeByExtension $ext ] ] != "" } {
		set app [ GetTypeAction $mimtype ]
	    }
	}

	#
	# if we have no app yet, ask the user
	#

	if { $app == "" } {
	    toplevel .app
	    label .app.msg -wraplength 3i -relief raised -bd 1 -text "Enter \
		    a command line to execute. Use %s for the file name.\
		    Do not attempt to background the command."

	    pack .app.msg -side top -ipadx 8 -ipady 8 -fill x

	    frame .app.com
	    label .app.com.lab -text "Command: "
	    entry .app.com.ent -relief sunken -bd 2 \
		    -textvariable ExeCom
	    pack .app.com.lab -side left -padx 8 -pady 8
	    pack .app.com.ent -side right -padx 8 -pady 8 -fill x -expand 1
	    pack .app.com -side top -fill x
	    
	    frame .app.but -relief raised -bd 2
	    frame .app.but.but
	    button .app.but.but.ok -text "Execute" -command "set ExeBut 1"
	    button .app.but.but.can -text "Cancel" -command "set ExeBut 0"
	    pack .app.but.but.ok -side left -padx 4 -pady 4 -fill x
	    pack .app.but.but.can -side left -padx 4 -pady 4 -fill x
	    pack .app.but.but
	    pack .app.but -side bottom -fill x

	    bind .app.com.ent <Return> "set ExeBut 1"

	    wm title .app "Execute Command"
	    tkwait visibility .app
	    grab set .app
	    focus .app

	    ._Status._Text config -text "Watiting for you to enter command"
	    set ExeBut {}
	    update
	    tkwait variable ExeBut
	    destroy .app
	    focus $oldFocus

	    if { $ExeBut == 1 } {
		set app $ExeCom
	    }
	}

	if { $app != "" } {
	    set RunString [ format $app $tempFile ]

	    ._Status._Text config -text "Watiting for child to terminate"

	    update

	    if { [ catch { eval exec $RunString } errorMsg ] } {
		tk_dialog ._Dialog "Execution failed" "The following problem\
			occured while executing your command: $errorMsg" \
			error 0 OK
	    }
	}
    }
    ._Status._Text config -text $oldText
    . config -cursor $oldCursor
    focus $oldFocus
}

#
# Menu Help->About
#

proc About {} {
    global AboutFinish
    global FrankPic

    set w ._About
    set AboutFinish {}

    toplevel $w
    wm title $w "About UUDeview"

    #
    # don't load the image if less than 256 colors or colormap full
    #

    if { [ catch { winfo colormapfull $w } cmf ] } {
	set cmf 0
    }

    if { [ winfo depth $w ] >= 8 && ! $cmf } {
	if { ! [ catch { image create photo Frank -data $FrankPic } ] } {
	    frame $w._Image -relief raised -bd 2
	    label $w._Image._Frank -image Frank
	    label $w._Image._Name -text "This Is Me"
	    pack $w._Image._Frank $w._Image._Name -side top
	    pack $w._Image -side left -padx 3 -pady 3
	}
    }
    frame $w._Right
    label $w._Right._Text1 -text "UUDeview Version\
	[ lindex [ lindex [ uu_Info version ] 0 ] 1 ]" \
	    -font -Adobe-Helvetica-Bold-R-Normal--*-180-*-*-*-*-*-*
    label $w._Right._Text2 -text "Written by Frank Pilhofer"
    label $w._Right._Text3 -text "[e-mail]\
	    \nhttp://www.fpx.de/"
    label $w._Right._Text4 -text "This software is Freeware and may be\
	    distributed freely. But if you happen to like it, why not\
	    surprise the Author with a postcard, sent to" \
	    -font -Adobe-Helvetica-Bold-R-Normal--*-100-*-*-*-*-*-* \
	    -wraplength 3i
    label $w._Right._Addr -text "Frank Pilhofer\nIn Der Wink 3\
	    \n60437 Frankfurt\nGermany" -justify left
    button $w._Right._Button -text "Ok" -command { set AboutFinish ok }

    pack $w._Right._Button -fill both -padx 10 -pady 3 -side bottom
    pack $w._Right._Text1 $w._Right._Text2 $w._Right._Text3 \
	    $w._Right._Text4 $w._Right._Addr \
	    -fill both -padx 10 -pady 5 -side top
    pack $w._Right -fill both

    set oldFocus [ focus ]
    tkwait visibility $w
    grab set $w
    focus $w
    tkwait variable AboutFinish
    destroy $w
    focus $oldFocus
}

#
# Menu Help->License
#

proc License {} {
    global COPYING

    set oldCursor [ lindex [ . config -cursor ] 4 ]
    set oldText   [ lindex [ ._Status._Text config -text ] 4 ]

    . config -cursor watch
    ._Status._Text config -text "Loading and Displaying License"

    if { [ catch { set COPYING } ] } {
	tk_dialog ._Dialog "Not Available" "I could not load the License\
		file. You received a copy of the GPL (GNU General Public\
		License) in the file COPYING along with the UUDeview\
		distribution. Please refer to this file instead." \
		error 0 OK
    } elseif { [ catch { .license configure } ] } {
	toplevel .license
	frame .license.top
	frame .license.bot
	text .license.top.text -relief raised -bd 2 -wrap none \
		-xscrollcommand ".license.top.sbx set" \
		-yscrollcommand ".license.top.sby set" \
		-font -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
	scrollbar .license.top.sbx -command ".license.top.text xview" \
		-orient horizontal
	scrollbar .license.top.sby -command ".license.top.text yview"

	pack .license.top.sbx -side bottom -fill x
	pack .license.top.sby -side right -fill y
	pack .license.top.text -fill both -expand 1

	button .license.bot.done -text "Done" -command "destroy .license"
	pack .license.bot.done -side right -padx 4 -pady 4

	pack .license.top -side top -fill both -expand 1
	pack .license.bot -side bottom

	wm title .license "GPL - Gnu General Public License"

	regsub -all "#" $COPYING "" TempText

	.license.top.text insert 1.0 $TempText
	.license.top.text configure -state disabled
    }

    ._Status._Text config -text $oldText
    . config -cursor $oldCursor
}

##############################################################################
## Display helper functions
##############################################################################

#
# these two procedures are needed to keep 2 listboxes in sync
#

proc ScrollCommand { args } {
    eval ._MainFrame._FileList._Status yview $args
    eval ._MainFrame._FileList._Liste  yview $args
}

proc UpdateListScroll { idlb1 idlb2 idsb first last } {
    set InMotion 1
    if { [ $idlb1 size ] } {
	set lbnf [ expr $first + 0.5 / [ $idlb1 size ] ]
    } else {
	set lbnf $first
    }
    $idsb set $first $last
    
    $idlb1 yview moveto $lbnf
    $idlb2 yview moveto $lbnf
}

proc UpdateSBScroll { idlb1 idlb2 idsb command number { units "" } } {
    set InMotion 1
    if { [ $idlb1 size ] } {
	set lbnf [ expr $number + 0.5 / [ $idlb1 size ] ]
    } else {
	set lbnf $number
    }
    if { $command == "scroll" } {
	$idlb1 yview $command $number $units
	$idlb2 yview $command $number $units
	update
    } elseif { $command == "moveto" } {
	$idlb1 yview $command $lbnf
	$idlb2 yview $command $lbnf
	update
    } else {
	puts "Unknown Scrolling Command: $view $command $number $units"
    }
}

##############################################################################
## Build our Main Frame
##############################################################################

#
# Menu Bar
#

frame ._MainMenu -relief raised -bd 2

menubutton ._MainMenu._File    -text File    -underline 0 \
	-menu ._MainMenu._File._Menu
menubutton ._MainMenu._Options -text Options -underline 0 \
	-menu ._MainMenu._Options._Menu
menubutton ._MainMenu._Actions -text Actions -underline 0 \
	-menu ._MainMenu._Actions._Menu
menubutton ._MainMenu._Help    -text Help    -underline 0 \
	-menu ._MainMenu._Help._Menu

menu ._MainMenu._File._Menu
menu ._MainMenu._Options._Menu
menu ._MainMenu._Actions._Menu
menu ._MainMenu._Help._Menu

._MainMenu._File._Menu add command -label "Load ..." -underline 0 \
	-command "Load"
._MainMenu._File._Menu add command -label "Encode ..." -underline 0 \