xdeview

UUDeview是一个编码解码器

#! /bin/sh
# The next line restarts using wish \
exec uuwish "$0" ${1+"$@"}

#
# Init Options
#

proc ifndef { var val } {
    global $var
    if { [ catch { set $var } ] } {
	set $var $val
    }
}

#
# read in rc file
#

if { ! [ catch { set env(HOME) } ] } {
    catch { source $env(HOME)/.xdeviewrc }
}

#
# overridable options for decoding
#

ifndef OptionFast 0
ifndef OptionBracket 0
ifndef OptionOverwrite 0
ifndef OptionDesperate 0
ifndef OptionVerbose 0
ifndef OptionDumbness 0
ifndef OptionUsetext 0
ifndef SaveFilePath [ pwd ]
ifndef OptionDebug 0
ifndef OptionAutoInfo 0
ifndef OptionRemove 0
ifndef OptionMoreMime 0

#
# overridable encoding options
#

ifndef EncodeMaxLines	0
ifndef EncodeEncoding	0
ifndef EncodeSubject	""
ifndef EncodeFrom       ""
ifndef EncodeReplyTo    ""
ifndef EncodeFileYes	1
ifndef EncodeFilePath	$SaveFilePath
ifndef EncodeMailYes	0
ifndef EncodeMailAddr	""
ifndef EncodeNewsYes	0
ifndef EncodeNewsGroup	""
ifndef NNTPServer	""

#
# MIME configuration
#

ifndef MIMEGlobalTypes	""
ifndef MIMEGlobalCap	""
if { ! [ catch { set env(HOME) } ] } {
    ifndef MIMELocalTypes	$env(HOME)/.mime.types
    ifndef MIMELocalCap		$env(HOME)/.mailcap
} else {
    ifndef MIMELocalTypes	""
    ifndef MIMELocalCap		""
}

#
# check whether we are started from within uudeview and have tk support
#

if { [ catch { uu_Info have_tk } have_tk ] } {
    puts "Xdeview error: this file must be loaded from within uudeview"
    exit 1
}
if { ! [ lindex [ lindex $have_tk 0 ] 1 ] } {
    puts "Xdeview error: tk support not compiled"
    exit 1
}

##############################################################################
# General Helper functions
##############################################################################

#
# Get a file type from .mime.types
#

proc GetTypeByExtension { ext } {
    global MIMELocalTypes MIMEGlobalTypes

    foreach fname "$MIMELocalTypes $MIMEGlobalTypes" {
	if { [ catch { open $fname r } fileID ] } {
	    return
	}
	while { ! [ eof $fileID ] } {
	    if { [ gets $fileID TheLine ] < 0 } {
		break
	    }
	    if { [ string index $TheLine 0 ] == "#" } {
		continue
	    } elseif { [ llength $TheLine ] < 2 } {
		continue
	    }
	    for { set index 1 } { $index < [ llength $TheLine ] } { incr index } {
		if { [ string tolower [ lindex $TheLine $index ] ] == \
			[ string tolower $ext ] } {
		    close $fileID
		    return [ lindex $TheLine 0 ]
		}
	    }
	}
	close $fileID
    }
    return
}

#
# see what to do with this type by reading .mailcap
#

proc GetTypeAction { type } {
    global MIMELocalCap MIMEGlobalCap
    foreach fname "$MIMELocalCap $MIMEGlobalCap" {
	if { [ catch { open $fname r } fileID ] } {
	    continue
	}
	while { ! [ eof $fileID ] } {
	    if { [ gets $fileID TheLine ] < 0 } {
		break
	    }
	    if { [ string index $TheLine 0 ] == "#" } {
		continue
	    }

	    if { [ set ThisType [ lindex [ split $TheLine ";" ] 0 ] ] == "" } {
		continue
	    }

	    if { [ string match \
		    [ string tolower $ThisType ] [ string tolower $type ] ] } {
		close $fileID
		return [ lindex [ split $TheLine ";" ] 1 ]
	    }
	}
	close $fileID
    }
    return
}

##############################################################################
# Specific helper functions
##############################################################################

#
# Retrieve the current global FileList and display it. Store in $FileList
#

proc ShowFileList {} {
    global FileList

    proc GetStatus { Code } {
	if { [ expr $Code & 0x08 ] } {
	    return "No Data"
	} elseif { [ expr $Code & 0x20 ] } {
	    return "Error"
	} elseif { [ expr $Code & 0x10 ] } {
	    return "OK"
	} elseif { [ expr $Code & 0x01 ] } {
	    return "Incomplete"
	} elseif { [ expr $Code & 0x02 ] } {
	    return "No Begin"
	} elseif { [ expr $Code & 0x04 ] } {
	    return "No End"
	} elseif { $Code == 0 } {
	    return "Oops"
	}
	return "Error"
    }

    ._MainFrame._FileList._Status delete 0 end
    ._MainFrame._FileList._Liste delete 0 end

    set FileList [uu_GetListOfFiles]

    foreach item $FileList {
	._MainFrame._FileList._Status insert end [GetStatus [lindex $item 1]]
	._MainFrame._FileList._Liste insert end [ lindex $item 2 ]
    }
}

#
# Check the Path
#

proc CheckWritable { Path } {
    if { ! [ expr [ file isdirectory $Path ] && [ file writable $Path ] ] } {
	tk_dialog ._Dialog { Illegal Save Path } "You do not have the\
		proper permissions to write to the selected Save Path.\
		Please use a different Directory" \
		warning 0 OK
	return 0
    }
    return 1
}

#
# Callback function for warnings and errors
#

proc OpenMessageWindow { } {
    if { [ catch { .messages configure } ] } {
	toplevel .messages
	frame .messages.top
	frame .messages.bot
	text .messages.top.text -relief raised -bd 2 -wrap none \
		-xscrollcommand ".messages.top.sbx set" \
		-yscrollcommand ".messages.top.sby set" 
	scrollbar .messages.top.sbx -command ".messages.top.text xview" \
		-orient horizontal
	scrollbar .messages.top.sby -command ".messages.top.text yview"
	
	pack .messages.top.sbx -side bottom -fill x
	pack .messages.top.sby -side right -fill y
	pack .messages.top.text -fill both -expand 1
	
	button .messages.bot.done -text "Done" -command "destroy .messages"
	pack .messages.bot.done -side right -padx 4 -pady 4
	
	pack .messages.top -side top -fill both -expand 1
	pack .messages.bot -side bottom
	
	wm title .messages "Runtime Messages"
    }
}

#
# Display a message in our Runtime Messages window, if verbose
#

proc DisplayMessage { level string } {
    global OptionVerbose

    if { $OptionVerbose } {
	OpenMessageWindow
	.messages.top.text insert end $string
	.messages.top.text insert end "\n"
	.messages.top.text yview end
	update
    }
    if { $level == 2 } {
	tk_dialog ._Dialog "Warning" $string warning 0 OK
    } elseif { $level > 2 } {
	tk_dialog ._Dialog "Error" $string error 0 OK
    }    
}

#
# Dump the current File List in the Runtime Messages window
#

proc DumpFileList { } {
    global FileList

    OpenMessageWindow

    if { [ llength $FileList ] == 0 } {
	return
    }

    .messages.top.text insert end "\n"

    foreach file $FileList {
	if { [ expr [ lindex $file 1 ] & 0x08 ] } {
	    continue
	}
	.messages.top.text insert end \
		"Found '[lindex $file 2]'\
		State [lindex $file 1] [lindex $file 4]\
		Parts [lindex $file 5]\n"
    }
    .messages.top.text insert end "\n"
    .messages.top.text yview end
}

#
# Handle Busy Callback
#

proc WeAreBusy {} {
    set BusyInfo [uu_GetProgressInfo]

    if { [ lindex $BusyInfo 0 ] == 1 } {
	._Status._Text config -text \
		"Loading [ file tail [ lindex $BusyInfo 1 ] ] --\
		[ lindex $BusyInfo 4 ]% done"
    } elseif { [ lindex $BusyInfo 0 ] == 2 } {
	set percent [expr 100*[lindex $BusyInfo 2]+[lindex $BusyInfo 4]-100]
	set percent [expr $percent / [lindex $BusyInfo 3]]

	._Status._Text configure -text \
		"Decoding [file tail [lindex $BusyInfo 1 ] ] --\
		$percent% done"
    } elseif { [ lindex $BusyInfo 0 ] == 3 } {
	._Status._Text config -text \
		"Copying [ file tail [ lindex $BusyInfo 1 ] ] --\
		[ lindex $BusyInfo 4 ]% done"
    } elseif { [ lindex $BusyInfo 0 ] == 4 } {
	set percent [expr 100*[lindex $BusyInfo 2]+[lindex $BusyInfo 4]-100]
	set percent [expr $percent / [lindex $BusyInfo 3]]

	._Status._Text configure -text \
		"Encoding [file tail [lindex $BusyInfo 1 ] ] --\
		$percent% done"
    }
    update
}

#
# Helper function to load a bunch of files
#

proc LoadFiles { LoadFileList } {
    set oldCursor [ lindex [ . config -cursor ] 4 ]
    set oldText   [ lindex [ ._Status._Text config -text ] 4 ]

    . config -cursor watch

    foreach file $LoadFileList {
	#
	# recurse into subdirectories
	#
	if { [ file isdirectory $file ] && [ file readable $file ] } {
	    LoadFiles [ glob -nocomplain [ file join $file * ] ]
	    continue
	} elseif { ! [ file readable $file ] || [ file isdirectory $file ] } {
	    tk_dialog ._Dialog "File Unreadable" "File $file is read\
		    protected or is a directory" warning 0 OK
	    continue
	}
	._Status._Text config -text "Loading [ file tail $file ] ..."
	update
	uu_LoadFile $file
    }

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

##############################################################################
# Button bindings && Menu functions
##############################################################################

#
# Menu Command File->Quit
#

proc Quit {} { 
    uu_CleanUp
    destroy .
    exit 0
}

#
# Menu Command File->Load
#

proc Load {} {
    global OptionVerbose

    set oldText [ lindex [ ._Status._Text config -text ] 4 ]
    ._Status._Text config -text "Waiting for you to Select Files"
    set LoadFileList [ tk_SelectFiles "Select Files for Decoding" 1 1 ]
    ._Status._Text config -text $oldText

    if { $LoadFileList != {} } {
	LoadFiles $LoadFileList
	ShowFileList
	if { $OptionVerbose } {
	    DumpFileList
	}
    }
}

#
# Menu Command File->Helper Setup
#

proc MimeSetup {} {
    global MIMEGlobalTypes MIMELocalCap MIMEGlobalCap MIMELocalTypes
    global tempGlobalTypes tempLocalCap tempGlobalCap tempLocalTypes
    global MSFinish

    set tempGlobalTypes $MIMEGlobalTypes
    set tempLocalCap    $MIMELocalCap
    set tempGlobalCap   $MIMEGlobalCap
    set tempLocalTypes  $MIMELocalTypes

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

    toplevel .mime
    wm title .mime "Helper Setup"

    frame .mime.top -relief groove -bd 1
    frame .mime.top.gt
    frame .mime.top.lt
    frame .mime.top.gc
    frame .mime.top.lc

    label .mime.top.gt.lab -text "Global Types File" -width 16 \
	    -justify left -anchor w
    entry .mime.top.gt.ent -relief sunken -width 30 \
	    -textvariable MIMEGlobalTypes
    button .mime.top.gt.but -text "Browse" -width 8 -command {
	set OldDir [ file dirname $MIMEGlobalTypes ]
	set NewFile [ tk_SelectFiles "Global Types File" 0 0 $OldDir ]
	if { $NewFile != "" } { set MIMEGlobalTypes $NewFile }
    }
    label .mime.top.lt.lab -text "Local Types File" -width 16 \
	    -justify left -anchor w
    entry .mime.top.lt.ent -relief sunken -width 30 \
	    -textvariable MIMELocalTypes
    button .mime.top.lt.but -text "Browse" -width 8 -command {
	set OldDir [ file dirname $MIMELocalTypes ]
	set NewFile [ tk_SelectFiles "Local Types File" 0 0 $OldDir ]
	if { $NewFile != "" } { set MIMELocalTypes $NewFile }
    }
    label .mime.top.gc.lab -text "Global Mailcap File" -width 16 \
	    -justify left -anchor w
    entry .mime.top.gc.ent -relief sunken -width 30 \
	    -textvariable MIMEGlobalCap
    button .mime.top.gc.but -text "Browse" -width 8 -command {
	set OldDir [ file dirname $MIMEGlobalCap ]
	set NewFile [ tk_SelectFiles "Global Mailcap File" 0 0 $OldDir ]
	if { $NewFile != "" } { set MIMEGlobalCap $NewFile }
    }
    label .mime.top.lc.lab -text "Local Mailcap File" -width 16 \
	    -justify left -anchor w
    entry .mime.top.lc.ent -relief sunken -width 30 \
	    -textvariable MIMELocalCap
    button .mime.top.lc.but -text "Browse" -width 8 -command {
	set OldDir [ file dirname $MIMELocalCap ]
	set NewFile [ tk_SelectFiles "Local Mailcap File" 0 0 $OldDir ]
	if { $NewFile != "" } { set MIMELocalCap $NewFile }
    }

    pack .mime.top.gt.lab -side left -padx 4 -pady 4
    pack .mime.top.gt.but -side right -padx 4
    pack .mime.top.gt.ent -side right -padx 4 -pady 4 -expand true -fill x

    pack .mime.top.lt.lab -side left -padx 4 -pady 4
    pack .mime.top.lt.but -side right -padx 4