# Module:         poExtProg
# Copyright:      Paul Obermeier 2001-2018 / paul@poSoft.de
# First Version:  2001 / 07 / 06
#
# Distributed under BSD license.
#
# Module for starting external programs in a portable way.

namespace eval poExtProg {
    variable ns [namespace current]

    namespace ensemble create

    namespace export Init
    namespace export SupportsAsso
    namespace export StartAssoProg StartEditProg StartOneEditProg StartDiffProg StartHexEditProg
    namespace export DumpFileIntoTextWidget LoadFileIntoTextWidget SaveTextWidgetToFile
    namespace export StopDump
    namespace export ShowSimpleTextEdit ShowSimpleHexEdit
    namespace export ShowSimpleTextDiff ShowSimpleHexDiff ShowTkDiffHexDiff
    namespace export ShowTkDiff
    namespace export StartFileBrowser
    namespace export GetExecutable
    namespace export HasTextWidgetChanged CloseSimpleTextEdit
    namespace export GetTextWidgetSaveMode SetTextWidgetSaveMode
    namespace export GetTextWidgetTabStop SetTextWidgetTabStop
    namespace export GetTextWidgetFont SetTextWidgetFont
    namespace export GetTextWidgetLineNumMode SetTextWidgetLineNumMode
    namespace export ShowLineNumbers SetTitle SearchText

    variable maxShowWin
    variable simpleDiffCount
    variable simpleEditCount
    variable simpleHexEditCount
    variable stopDump
    variable simpleEditInfo

    proc AddMenuCmd { menu label acc cmd args } {
        $menu add command -label $label -accelerator $acc -command $cmd {*}$args
    }

    proc AddMenuRadio { menu label acc var val cmd args } {
        $menu add radiobutton -label $label -accelerator $acc \
                              -variable $var -value $val -command $cmd {*}$args
    }

    # Init is called at package load time.
    proc Init {} {
        variable simpleEditInfo
        variable maxShowWin
        variable simpleDiffCount
        variable simpleEditCount
        variable simpleHexEditCount
        variable tkdiffSourced

        set maxShowWin 4
        set simpleDiffCount 0
        set simpleEditCount 0
        set simpleHexEditCount 0
        set tkdiffSourced 0

        set simpleEditInfo(showLineNumbers)   0
        set simpleEditInfo(switchLineNumbers) 0
        set simpleEditInfo(searchIgnCase)     0
        set simpleEditInfo(searchWord)        0
        set simpleEditInfo(saveMode)          "lf"
        set simpleEditInfo(tabStop)           8
        set simpleEditInfo(font)              "Fixed" 
        set simpleEditInfo(resultColor)       "lightgreen"
        set simpleEditInfo(currentColor)      "yellow"
    }

    proc SetTextWidgetSaveMode { mode } {
        variable simpleEditInfo

        set simpleEditInfo(saveMode) $mode
    }

    proc GetTextWidgetSaveMode {} {
        variable simpleEditInfo

        return $simpleEditInfo(saveMode)
    }

    proc SetTextWidgetTabStop { tabStop } {
        variable simpleEditInfo

        set simpleEditInfo(tabStop) $tabStop
    }

    proc GetTextWidgetTabStop {} {
        variable simpleEditInfo

        return $simpleEditInfo(tabStop)
    }

    proc SetTextWidgetFont { font } {
        variable simpleEditInfo

        set simpleEditInfo(font) $font
    }

    proc GetTextWidgetFont {} {
        variable simpleEditInfo

        return [list $simpleEditInfo(font)]
    }

    proc SetTextWidgetLineNumMode { mode } {
        variable simpleEditInfo

        set simpleEditInfo(showLineNumbers)   $mode
        set simpleEditInfo(switchLineNumbers) $mode
    }

    proc GetTextWidgetLineNumMode {} {
        variable simpleEditInfo

        return $simpleEditInfo(showLineNumbers)
    }

    proc HasTextWidgetChanged { w } {
        return [$w edit modified]
    }

    proc StopDump {} {
        variable stopDump

        set stopDump 1
    }

    proc GetTopLevel { widgetName } {
        regexp {\.[A-z,0-9]*} $widgetName topName
        return $topName
    }

    proc CloseSimpleTextEdit { w } {
        variable simpleEditInfo

        if { [HasTextWidgetChanged $w] } {
            set retVal [tk_messageBox \
              -title "Confirmation" \
              -message "Save changed file before closing?" \
              -type yesnocancel -default yes -icon question]
            if { [string compare $retVal "yes"] == 0 } {
                SaveTextWidgetToFile $w
            } elseif { [string compare $retVal "cancel"] == 0 } {
                return
            }
        }
        if { $simpleEditInfo($w,useToplevel) } {
            destroy [GetTopLevel $w]
        }
    }

    proc SetTitle { w title } {
        variable simpleEditInfo

        poWin SetScrolledTitle $w $title
        if { $simpleEditInfo($w,useToplevel) } {
            wm title [GetTopLevel $w] [format "%s" $title]
        }
    }

    proc TextContentChanged { w hasChanged } {
        variable simpleEditInfo

        if { [$w edit modified] && $hasChanged } {
            set title [format "%s +" $simpleEditInfo($w,fileName)]
            SetTitle $w $title
        } else {
            set title [format "%s" $simpleEditInfo($w,fileName)]
            SetTitle $w $title
        }
    }

    proc UpdateTabs { w } {
        variable simpleEditInfo

        if { ! [string is integer -strict $simpleEditInfo(tabStop)] || \
             $simpleEditInfo(tabStop) <= 0 } {
            return
        }
        set textFont [$w cget -font]
        set fontMeasure [expr {$simpleEditInfo(tabStop) * [font measure $textFont 0] }]
        $w configure -tabs "$fontMeasure left" -tabstyle wordprocessor
    }

    proc SelectFont { w } {
        variable simpleEditInfo

        set root [poWin GetRootWidget $w]
        lassign [winfo pointerxy $root] x y
        set selFont [poFontSel OpenWin $x $y $simpleEditInfo(font)]
        set simpleEditInfo(font) $selFont

        $w configure -font $selFont
    }

    proc CutText { w } {
        tk_textCut $w
    }

    proc CopyText { w } {
        tk_textCopy $w
    }

    proc PasteText { w } {
        tk_textPaste $w
        $w see insert
    }

    proc _ShowResult { textId ind } {
        variable simpleEditInfo

        if { ! [info exists simpleEditInfo(curIndex)] || \
             [llength $simpleEditInfo(indices)] == 0 } {
            return
        }

        set curIndex $simpleEditInfo(curIndex)
        $textId tag configure "found$curIndex" -background $simpleEditInfo(currentColor)

        if { $ind == -1 || $ind == 1 } {
            set curIndex [expr $curIndex + $ind]
            set curIndex [poMisc Max $curIndex 0]
            set curIndex [poMisc Min $curIndex \
                                        [expr [llength $simpleEditInfo(indices)] -1]]
        } elseif { $ind eq "end" } {
            set curIndex [expr [llength $simpleEditInfo(indices)] -1]
        } else {
            set curIndex $ind
        }
        $textId tag configure "found$curIndex" -background "yellow"
        $textId see [lindex $simpleEditInfo(indices) $curIndex]

        set simpleEditInfo(curIndex) $curIndex
        $textId tag add sel [lindex $simpleEditInfo(indices) $curIndex]
        $textId mark set insert [lindex $simpleEditInfo(indices) $curIndex]
    }

    proc SearchText { textId { searchStr "" } } {
        variable simpleEditInfo

        if { $searchStr eq "" } {
            if { [catch { set searchStr [$textId get sel.first sel.last] } ] } {
                return
            }
            CopyText $textId
        }

        set quotedSearch [poMisc QuoteSearchPattern $searchStr "exact" $simpleEditInfo(searchWord)]

        set indexIn 1.0
        set countIn 0
        set i       0

        foreach tagName [$textId tag names] {
            $textId tag delete $tagName
        }

        set simpleEditInfo(indices) [list]
        while { 1 } {
            if { $simpleEditInfo(searchIgnCase) } {
                set indexOut [$textId search -count countOut -regexp -nocase -- \
                              $quotedSearch "$indexIn + $countIn chars" end]
            } else {
                set indexOut [$textId search -count countOut -regexp -- \
                              $quotedSearch "$indexIn + $countIn chars" end]
            }
            if { $indexOut eq "" } {
                break
            }

            lappend simpleEditInfo(indices) $indexOut
            $textId tag add "result"  $indexOut "$indexOut + $countOut chars"
            $textId tag add "found$i" $indexOut "$indexOut + $countOut chars"

            set indexIn $indexOut
            set countIn $countOut
            incr i
        }
        $textId tag configure "result" -background $simpleEditInfo(resultColor)
        set simpleEditInfo(curIndex) 0
        _ShowResult $textId 0
    }

    proc _SwitchLineNumbers { w } {
        variable simpleEditInfo

        ShowLineNumbers $w $simpleEditInfo(switchLineNumbers)
    }

    proc ShowLineNumbers { w onOff } {
        variable simpleEditInfo

        if { ! $onOff } {
            foreach {from to} [$w tag ranges linenum] {
                $w delete $from $to
            }
        } else {
            set lastline [expr int([$w index "end - 1 c"])]
            for {set i 1} {$i <= $lastline} {incr i} {
                $w insert $i.0 [format "%5d " $i] linenum
            }
        }
        set simpleEditInfo(showLineNumbers) $onOff
        $w edit reset
        $w edit modified false
    }

    proc LoadFileIntoTextWidget { w fileName { maxBytes -1 } } {
        variable ns
        variable simpleEditInfo

        set retVal [catch {open $fileName r} fp]
        if { $retVal != 0 } {
            error "Could not read file \"$fileName\"."
        }
        set numBytesFile [file size $fileName]
        if { $maxBytes < 0 } {
            set maxBytes $numBytesFile
        }
        set numBytesPerRead 2048
        if { $maxBytes < $numBytesPerRead } {
            set numBytesPerRead $maxBytes
        }

        set simpleEditInfo($w,fileName) $fileName

        set curState [$w cget -state]
        $w configure -state normal
        $w delete 1.0 end
        set numBytesRead 0
        while { ! [eof $fp] && $numBytesRead <= $maxBytes } {
            $w insert end [read $fp $numBytesPerRead]
            incr numBytesRead $numBytesPerRead
        }
        if { ! [eof $fp] } {
            ttk::button $w.b -text "Load complete file" -command "${ns}::LoadFileIntoTextWidget $w \"$fileName\""
            $w insert end "\n"
            $w window create end -window $w.b
        }
        $w configure -state $curState
        close $fp
        $w edit reset
        $w edit modified false
        set simpleEditInfo($w,changed) false
        if { $simpleEditInfo(showLineNumbers) } {
            ShowLineNumbers $w true
        }
    }

    proc SaveTextWidgetToFile { w { fileName "" } } {
        variable simpleEditInfo

        if { $fileName eq "" } {
            if { [info exists simpleEditInfo($w,fileName)] } {
                set fileName $simpleEditInfo($w,fileName)
            }
        }

        # If line numbering is on, switch it off temporary
        # and switch it on back after writing.
        set haveLineNumbers false
        if { $simpleEditInfo(showLineNumbers) } {
            set haveLineNumbers true
            ShowLineNumbers $w false
        }

        set retVal [catch {open $fileName w} fp]
        if { $retVal != 0 } {
            error "Could not write file \"$fileName\"."
        }
        fconfigure $fp -translation $simpleEditInfo(saveMode)
        puts -nonewline $fp [$w get 1.0 "end-1 chars"]
        close $fp

        if { $haveLineNumbers } {
            ShowLineNumbers $w true
        }
        $w edit modified false
        TextContentChanged $w false
    }

    proc DumpFileIntoTextWidget { w fileName { updFlag false } { maxBytes -1 } } {
        variable ns
        variable simpleEditInfo
        variable stopDump

        # Open the file, and set up to process it in binary mode.
        set catchVal [catch { open $fileName r } fp]
        if { $catchVal } {
            error "Could not read file \"$fileName\"."
        }
        fconfigure $fp -translation binary -encoding binary \
                       -buffering full -buffersize 16384

        set numBytesFile [file size $fileName]
        set bytesToRead $maxBytes
        if { $maxBytes < 0 } {
            set bytesToRead $numBytesFile
        }

        if { $updFlag } {
            set stopDump 0
            bind $w <Escape> "${ns}::StopDump"
        }
        set curState [$w cget -state]
        $w configure -state normal
        $w delete 1.0 end
        set numBytesRead 0
        while { ! [eof $fp] } {
            # Record the seek address. Read 16 bytes from the file.
            set addr [tell $fp]
            set s [read $fp 16]
            incr numBytesRead [string length $s]

            # Convert the data to hex and to characters.
            binary scan $s H*@0a* hex ascii

            # Replace non-printing characters in the data.
            regsub -all {[^[:graph:] ]} $ascii {.} ascii

            # Split the 16 bytes into two 8-byte chunks
            set hex1 [string range $hex 0 15]
            set hex2 [string range $hex 16 31]

            # Convert the hex to pairs of hex digits
            regsub -all {..} $hex1 {& } hex1
            regsub -all {..} $hex2 {& } hex2

            # Put the hex and Latin-1 data to the channel
            set hexStr [format "%08X  %-24s %-24s %-16s\n" \
                                $addr $hex1 $hex2 $ascii]
            $w insert end $hexStr

            if { $numBytesRead >= $bytesToRead } {
                break
            }
            if { $updFlag } {
                $w see end
                if { $addr % 1000 == 0 } {
                    update
                }
                if { $stopDump } {
                    break
                }
            }
        }

        if { $maxBytes >= 0 && $numBytesFile != $numBytesRead } {
            ttk::button $w.b -text "Load complete file" \
                             -command "${ns}::DumpFileIntoTextWidget $w \"$fileName\" $updFlag"
            $w insert end "\n"
            $w window create end -window $w.b
            if { $updFlag } {
                $w see end
            }
        }
        $w configure -state $curState
        close $fp
        $w edit reset
        $w edit modified false
        set simpleEditInfo($w,changed) false
        if { $simpleEditInfo(showLineNumbers) } {
            ShowLineNumbers $w true
        }
    }

    proc ShowSimpleTextDiff { fileName1 fileName2 } {
        variable simpleDiffCount

        incr simpleDiffCount

        set titleStr \
            "SimpleDiff: [file tail $fileName1] versus [file tail $fileName2]"
        set tw ".poExtProgSimpleDiff$simpleDiffCount"

        toplevel $tw
        wm title $tw $titleStr
        ttk::frame $tw.workfr -relief sunken -borderwidth 1
        pack $tw.workfr -side top -fill both -expand 1

        set hMenu $tw.menufr
        menu $hMenu -borderwidth 2 -relief sunken

        $hMenu add cascade -menu $hMenu.file -label "File" -underline 0

        set fileMenu $hMenu.file
        menu $fileMenu -tearoff 0
        AddMenuCmd $fileMenu "Close" "Ctrl+W" "destroy $tw"

        bind $tw <Control-w> "destroy $tw"
        bind $tw <Escape>    "destroy $tw"
        wm protocol $tw WM_DELETE_WINDOW "destroy $tw"

        $tw configure -menu $hMenu

        set textList [poWin CreateSyncText $tw.workfr \
                      "$fileName1" "$fileName2" -wrap none]

        set textId1 [lindex $textList 0]
        set textId2 [lindex $textList 1]

        LoadFileIntoTextWidget $textId1 $fileName1
        LoadFileIntoTextWidget $textId2 $fileName2

        $textId1 configure -state disabled -cursor top_left_arrow
        $textId2 configure -state disabled -cursor top_left_arrow
        focus $tw
    }

    proc ShowSimpleHexDiff { fileName1 fileName2 } {
        variable simpleDiffCount

        incr simpleDiffCount

        set titleStr \
            "SimpleHexDiff: [file tail $fileName1] versus [file tail $fileName2]"
        set tw ".poExtProgSimpleDiff$simpleDiffCount"

        toplevel $tw
        wm title $tw $titleStr
        ttk::frame $tw.workfr -relief sunken -borderwidth 1
        pack $tw.workfr -side top -fill both -expand 1

        set hMenu $tw.menufr
        menu $hMenu -borderwidth 2 -relief sunken

        $hMenu add cascade -menu $hMenu.file -label "File" -underline 0

        set fileMenu $hMenu.file
        menu $fileMenu -tearoff 0
        AddMenuCmd $fileMenu "Close" "Ctrl+W" "destroy $tw"

        bind $tw <Control-w> "destroy $tw"
        bind $tw <Escape>    "destroy $tw"
        wm protocol $tw WM_DELETE_WINDOW "destroy $tw"

        $tw configure -menu $hMenu

        set textList [poWin CreateSyncText $tw.workfr \
                      "$fileName1" "$fileName2" -wrap none]

        set textId1 [lindex $textList 0]
        set textId2 [lindex $textList 1]

        focus $tw
        $tw configure -cursor watch

        $textId1 configure -font [poWin GetFixedFont]
        $textId2 configure -font [poWin GetFixedFont]
        update

        DumpFileIntoTextWidget $textId1 $fileName1 true
        DumpFileIntoTextWidget $textId2 $fileName2 true

        $textId1 configure -state disabled
        $textId2 configure -state disabled
        $tw configure -cursor top_left_arrow
    }

    proc ShowTkDiffHexDiff { fileName1 fileName2 } {

        set tmpDir [poMisc GetTmpDir]
        set tmpFileName1 [format "Left_%s"  [file tail $fileName1]]
        set tmpFileName2 [format "Right_%s" [file tail $fileName2]]
        set tmpFileName1 [file join $tmpDir $tmpFileName1]
        set tmpFileName2 [file join $tmpDir $tmpFileName2]

        poMisc HexDumpToFile $fileName1 $tmpFileName1
        poMisc HexDumpToFile $fileName2 $tmpFileName2

        ShowTkDiff [list $tmpFileName1 $tmpFileName2]
    }

    proc ShowSimpleTextEdit { fileName { tw "" } { showButtons false } args } {
        variable ns
        variable simpleEditInfo
        variable simpleEditCount

        incr simpleEditCount

        set useToplevel false

        set titleStr "SimpleEdit: [file tail $fileName]"

        if { $tw eq "" } {
            set useToplevel true

            set tw ".poExtProgSimpleEdit$simpleEditCount"

            toplevel $tw
            wm title $tw $titleStr
        }
        if { $showButtons } {
            ttk::frame $tw.toolfr -relief groove -borderwidth 1
            pack $tw.toolfr -side top -fill x
        }
        ttk::frame $tw.workfr -relief ridge 
        pack $tw.workfr -side top -fill both -expand 1

        set textId [poWin CreateScrolledText $tw.workfr false "$fileName" {*}$args]
        set simpleEditInfo($textId,fileName) $fileName
        $textId tag configure linenum -background yellow

        if { $useToplevel } {
            set hMenu $tw.menufr
            menu $hMenu -borderwidth 2 -relief sunken
            $hMenu add cascade -menu $hMenu.file -label "File"     -underline 0
            $hMenu add cascade -menu $hMenu.edit -label "Edit"     -underline 0
            $hMenu add cascade -menu $hMenu.sett -label "Settings" -underline 0

            set fileMenu $hMenu.file
            menu $fileMenu -tearoff 0
            AddMenuCmd $fileMenu "Save"  "Ctrl+S" "${ns}::SaveTextWidgetToFile $textId"
            AddMenuCmd $fileMenu "Close" "Ctrl+W" "${ns}::CloseSimpleTextEdit $textId"

            set editMenu $hMenu.edit
            menu $editMenu -tearoff 0
            AddMenuCmd $editMenu Search "Ctrl+F" "${ns}::SearchText $textId"
            $editMenu add separator
            AddMenuCmd $editMenu Cut    "Ctrl+X" "${ns}::CutText    $textId"
            AddMenuCmd $editMenu Copy   "Ctrl+C" "${ns}::CopyText   $textId"
            AddMenuCmd $editMenu Paste  "Ctrl+V" "${ns}::PasteText  $textId"

            set settMenu $hMenu.sett
            menu $settMenu -tearoff 0

            set eolMenu $settMenu.eol
            $settMenu add cascade -label "EOL" -menu $eolMenu
            menu $eolMenu -tearoff 0
            AddMenuRadio $eolMenu "LF" "" ${ns}::simpleEditInfo(saveMode) "lf" \
                         "${ns}::SetTextWidgetSaveMode lf"
            AddMenuRadio $eolMenu "CRLF" "" ${ns}::simpleEditInfo(saveMode) "crlf" \
                         "${ns}::SetTextWidgetSaveMode crlf"
            AddMenuRadio $eolMenu "CR" "" ${ns}::simpleEditInfo(saveMode) "cr" \
                         "${ns}::SetTextWidgetSaveMode cr"

            $tw configure -menu $hMenu
        }

        if { $showButtons } {
            # Add new toolbar group and associated buttons.
            set toolfr $tw.toolfr
            poToolbar New $toolfr
            poToolbar AddGroup $toolfr

            poToolbar AddButton $toolfr [::poBmpData::save] \
                      "${ns}::SaveTextWidgetToFile $textId" "Save (Ctrl+S)"
            poToolbar AddRadioButton $toolfr "LF" \
                      "${ns}::SetTextWidgetSaveMode lf" "Set EOL to Unix" \
                      -value "lf" -variable ${ns}::simpleEditInfo(saveMode)
            poToolbar AddRadioButton $toolfr "CRLF" \
                      "${ns}::SetTextWidgetSaveMode crlf" "Set EOL to Dos" \
                      -value "crlf" -variable ${ns}::simpleEditInfo(saveMode)
            poToolbar AddRadioButton $toolfr "CR" \
                      "${ns}::SetTextWidgetSaveMode cr" "Set EOL to Mac" \
                      -value "cr" -variable ${ns}::simpleEditInfo(saveMode)


            # Add new toolbar group and associated buttons.
            poToolbar AddGroup $tw.toolfr
            poToolbar AddButton $tw.toolfr [::poBmpData::search] \
                      "${ns}::SearchText $textId" "Search (Ctrl+F)"

            # Add new toolbar group and associated buttons.
            poToolbar AddGroup $toolfr

            poToolbar AddButton $toolfr [::poBmpData::cut] \
                      "${ns}::CutText $textId" "Cut (Ctrl+X)"
            poToolbar AddButton $toolfr [::poBmpData::copy] \
                      "${ns}::CopyText $textId" "Copy (Ctrl+C)"
            poToolbar AddButton $toolfr [::poBmpData::paste] \
                      "${ns}::PasteText $textId" "Paste (Ctrl+V)"

            # Add new toolbar group and associated buttons.
            poToolbar AddGroup $toolfr
            poToolbar AddCheckButton $toolfr [::poBmpData::linenum] \
                      "${ns}::_SwitchLineNumbers $textId" "Toggle line numbers" \
                      -variable ${ns}::simpleEditInfo(switchLineNumbers)

            poToolbar AddGroup $toolfr
            poToolbar AddButton $toolfr [::poBmpData::halt "red"] \
                      ${ns}::StopDump "Stop file loading (Esc)"

            poToolbar AddGroup $toolfr
            poToolbar AddButton $toolfr [::poBmpData::clear] "${ns}::SelectFont $textId" "Select font"
            set comboId [poToolbar AddCombobox $toolfr ${ns}::simpleEditInfo(tabStop) "Tabstop width" \
                        -values [list 1 2 3 4 8] -state readonly -width 2 -takefocus 0]
            bind $comboId <<ComboboxSelected>> "${ns}::UpdateTabs $textId"
        }
        UpdateTabs $textId
        $textId configure -font $simpleEditInfo(font)

        bind $textId <Control-f> "${ns}::SearchText $textId"
        bind $textId <Control-s> "${ns}::SaveTextWidgetToFile $textId"
        if { $useToplevel } {
            bind $textId <Control-w> "${ns}::CloseSimpleTextEdit $textId"
            bind $textId <Escape>    "${ns}::CloseSimpleTextEdit $textId"
            wm protocol $tw WM_DELETE_WINDOW "${ns}::CloseSimpleTextEdit $textId"
        }

        catch { LoadFileIntoTextWidget $textId $fileName }
        $textId configure -cursor top_left_arrow
        focus $tw

        set simpleEditInfo($textId,useToplevel) $useToplevel

        # Add this binding after reading of content, as reading generates a
        # modified event.
        bind $textId <<Modified>> "${ns}::TextContentChanged $textId true"
        return $textId
    }

    proc SaveHexEdit { w fileName } {
        set fileTypes {
                {"Ascii Dump files" ".dump"}
                {"All files"        "*"} }

        set dumpDir  [file dirname $fileName]
        set dumpFile [format "%s.dump" [file tail $fileName]]
        set saveName [tk_getSaveFile -filetypes $fileTypes \
                              -initialfile $dumpFile -initialdir $dumpDir \
                              -title "Save hexdump to Asciii file"]
        if { $saveName != "" } {
            set retVal [catch {open $saveName w} fp]
            if { $retVal != 0 } {
                error "Could not write file \"$saveName\"."
            }
            puts $fp [$w get 1.0 end]
            close $fp
        }
    }

    proc CloseHexEdit { w } {
        variable stopDump

        set stopDump 1
        update
        destroy $w
    }

    proc ShowSimpleHexEdit { fileName } {
        variable ns
        variable simpleHexEditCount

        incr simpleHexEditCount

        set titleStr "SimpleHexEdit: [file tail $fileName]"
        set tw ".poExtProg:SimpleHexEdit_$simpleHexEditCount"

        toplevel $tw
        wm title $tw $titleStr

        ttk::frame $tw.toolfr -relief groove -borderwidth 1
        pack $tw.toolfr -side top -fill x

        ttk::frame $tw.workfr -relief sunken -borderwidth 1
        pack $tw.workfr -side top -fill both -expand 1

        set hMenu $tw.menufr
        menu $hMenu -borderwidth 2 -relief sunken
        $hMenu add cascade -menu $hMenu.file -label File -underline 0

        set textId [poWin CreateScrolledText $tw.workfr true "$fileName" -wrap none]

        set fileMenu $hMenu.file
        menu $fileMenu -tearoff 0
        AddMenuCmd $fileMenu "Save as ..." "Ctrl+S" "${ns}::SaveHexEdit $textId [list $fileName]"
        AddMenuCmd $fileMenu "Close"       "Ctrl+W" "${ns}::CloseHexEdit $tw"

        bind $tw <Control-s> "${ns}::SaveHexEdit $textId [list $fileName]"
        bind $tw <Control-w> "${ns}::CloseHexEdit $tw"
        wm protocol $tw WM_DELETE_WINDOW "${ns}::CloseHexEdit $tw"

        poToolbar New $tw.toolfr
        poToolbar AddGroup $tw.toolfr
        poToolbar AddButton $tw.toolfr [::poBmpData::save] \
                  "${ns}::SaveHexEdit $textId [list $fileName]" "Save as ... (Ctrl+S)"

        poToolbar AddGroup $tw.toolfr
        poToolbar AddButton $tw.toolfr [::poBmpData::halt "red"] \
                  ${ns}::StopDump "Stop file loading (Esc)"

        $tw configure -menu $hMenu

        focus $textId
        $textId configure -cursor watch
        $textId configure -font [poWin GetFixedFont]
        update

        DumpFileIntoTextWidget $textId $fileName true
        catch {$textId configure -state disabled -cursor top_left_arrow}
    }

    proc SupportsAsso { } {
        global tcl_platform

        if { $tcl_platform(platform) eq "windows" || \
	     $tcl_platform(os) eq "Darwin" || \
             $tcl_platform(os) eq "Linux" } {
            return true
        } else {
            return false
        }
    }

    proc StartAssoProg { fileList infoCB } {
        # Start program associated with a file.
        #
        # fileList  - List of files to open.
        # infoCB    - Callback function with one string parameter.
        #
        # This function is available only on operating systems,
        # which provide association rules with files.
        # Windows for example uses the file extension for association.
        #
        # No return value.
        #
        # See also: StartEditProg StartDiffProg

        StartEditProg $fileList $infoCB 1
    }

    proc StartEditProg { fileList { infoCB "" } { assoc 0 } } {
        global env tcl_platform
        variable maxShowWin

        set count 0
        foreach fileName $fileList {
            # Convert native name back to Unix notation
            set name [file normalize $fileName]

            set prog [poFileType GetEditProg $name]
            if { $prog eq "poImgview" && ! $assoc } {
                poApps StartApp $prog $name
                continue
            }
            if { $prog ne "" } {
                set prog [GetSpecificProg $prog]
            }
            if { ($prog eq "" || [auto_execok $prog] eq "") && ! $assoc } {
                ShowSimpleTextEdit $name "" true
                if { $infoCB ne "" } {
                    $infoCB "No editor rule found for: $name"
                }
                continue
            }

            set fork "&"
            incr count
            if { $count > $maxShowWin } {
                set retVal [tk_messageBox \
                  -title "Confirmation" \
                  -message "Load next file $name ?" \
                  -type yesnocancel -default yes -icon question]
                if { $retVal eq "cancel" } {
                    return
                } elseif { $retVal eq "no" } {
                    continue
                }
            }
            if { $assoc && [SupportsAsso] } {
                if { $infoCB ne "" } {
                    $infoCB "Loading file $name with associated program"
                }
                set nativeFileName [file nativename $name]
                if { $tcl_platform(platform) eq "windows" } {
                    if {[file exists $env(COMSPEC)]} {
                        eval exec [list $env(COMSPEC)] /c start \
                                  [list $nativeFileName] $fork
                    } else {
                        eval exec command /c start [list $nativeFileName] $fork
                    }
                } elseif { $tcl_platform(os) eq "Darwin" } {
                    eval exec open $nativeFileName $fork
                } elseif { $tcl_platform(os) eq "Linux" } {
                    eval exec xdg-open $nativeFileName $fork
                }
            } else {
                if { $prog eq "" } {
                    if { $infoCB ne "" } {
                        $infoCB "No editor rule found for: $name"
                    }
                    ShowSimpleTextEdit $name "" true
                } else {
                    if { $infoCB ne "" } {
                        $infoCB "Loading file $name with program $prog"
                    }
                    eval exec $prog [list $name] $fork
                }
            }
        }
    }

    proc StartOneEditProg { fileList { infoCB "" } { assoc 0 } } {
        global env tcl_platform

        set firstFile [lindex $fileList 0]
        set prog [poFileType GetEditProg $firstFile]
        if { $prog eq "poImgview" && ! $assoc } {
            poApps StartApp $prog $fileList
            return
        }
        if { $prog ne "" } {
            set prog [GetSpecificProg $prog]
        }
        if { $prog eq "" && ! $assoc } {
            ShowSimpleTextEdit $fileList "" true
            if { $infoCB ne "" } {
                $infoCB "No editor rule found for: $firstFile"
            }
            return
        } else {
            if { $assoc && [SupportsAsso] } {
                if { $infoCB ne "" } {
                    $infoCB "Loading files with associated program"
                }
                if { $tcl_platform(platform) eq "windows" } {
                    if {[file exists $env(COMSPEC)]} {
                        eval exec [list $env(COMSPEC)] /c start $fileList &
                    } else {
                        eval exec command /c start $fileList &
                    }
                } elseif { $tcl_platform(os) eq "Darwin" } {
                    eval exec open $fileList &
                } elseif { $tcl_platform(os) eq "Linux" } {
                    eval exec xdg-open $fileList &
                }
            } else {
                if { $infoCB ne "" } {
                    $infoCB "Loading files with program $prog"
                }
                eval exec $prog $fileList &
            }
        }
    }

    proc GetSpecificProg { prog } {
        set specProg $prog
        if { [auto_execok $prog] eq "" } {
            if { $::tcl_platform(os) eq "Darwin" } {
                set specProg [format "open -a $prog " $prog]
            }
        }
        return $specProg
    }

    proc StartHexEditProg { fileList {infoCB ""} {serialize 1} } {
        global env tcl_platform
        variable maxShowWin

        set count 0
        foreach fileName $fileList {
            # Convert native name back to Unix notation
            set name [file normalize $fileName]

            set prog [poFileType GetHexEditProg $name]
            if { $prog ne "" } {
                set prog [GetSpecificProg $prog]
            }
            if { $prog eq "" } {
                ShowSimpleHexEdit $name
                if { $infoCB ne "" } {
                    $infoCB "No hexdump rule found for: $name"
                }
                continue
            }

            set fork "&"
            if { $serialize } {
                set fork ""
            }
            incr count
            if { $serialize || $count > $maxShowWin } {
                set retVal [tk_messageBox \
                  -title "Confirmation" \
                  -message "Load next file $name ?" \
                  -type yesnocancel -default yes -icon question]
                if { $retVal eq "cancel" } {
                    return
                } elseif { $retVal eq "no" } {
                    continue
                }
            }
            if { $infoCB ne "" } {
                $infoCB "Loading file $name with program $prog"
            }
            eval exec $prog [list $name] $fork
        }
    }

    proc ShowTkDiff { argList } {
        variable tkdiffSourced

        if { ! $tkdiffSourced } {
            if { [info exists      starkit::topdir] && \
                 [file isdirectory $starkit::topdir] } {
                set libDir [file join $starkit::topdir "lib"]
            } else {
                set libDir [poApps GetScriptDir]
            }
            uplevel #0 source [list [file join $libDir "tkdiff.tcl"]]
            set tkdiffSourced 1
        }

        set leftFile  ""
        set rightFile ""
        set curArg 0
        while { $curArg < [llength $argList] } {
            set curParam [lindex $argList $curArg]
            if { [poMisc IsReadableFile $curParam] } {
                if { $leftFile eq "" } {
                    set leftFile [file normalize $curParam]
                } else {
                    set rightFile [file normalize $curParam]
                }
            }
            incr curArg
        }
        tkdiff-main $leftFile $rightFile
    }

    proc StartDiffProg { leftFileList rightFileList infoCB { serialize 0 } } {
        variable maxShowWin

        set count 0
        foreach fileName1 $leftFileList fileName2 $rightFileList {
            # Convert native name back to Unix notation
            set name1 [file normalize $fileName1]
            set name2 [file normalize $fileName2]

            set prog [poFileType GetDiffProg $name1]
            if { $prog eq "poImgdiff" } {
                poApps StartApp $prog [list $name1 $name2]
                continue
            } elseif { $prog eq "ExcelDiff" && [poApps HavePkg "cawt"] } {
                eval ::Excel::DiffExcelFiles [list $name1 $name2]
                continue
            } elseif { $prog eq "WordDiff" && [poApps HavePkg "cawt"] } {
                eval ::Word::DiffWordFiles [list $name1 $name2]
                continue
            }
            if { $prog ne "" } {
                set prog [GetSpecificProg $prog]
            }
            if { $prog eq "" } {
                $infoCB "No diff rule found for: $name1"
                if { ! [poType IsBinary $name1] && ! [poType IsBinary $name2] } {
                    ShowTkDiff [list $name1 $name2]
                } else {
                    ShowTkDiffHexDiff $name1 $name2
                }
                continue
            }

            set fork "&"
            if { $serialize } {
                set fork ""
            }

            incr count
            if { $serialize || $count > $maxShowWin } {
                set retVal [tk_messageBox \
                  -title "Confirmation" \
                  -message "Load next diff: $name1 vs. $name2 ?" \
                  -type yesnocancel -default yes -icon question]
                if { $retVal eq "cancel" } {
                    return
                } elseif { $retVal eq "no" } {
                    continue
                }
            }
            $infoCB "Diff'ing $name1 and $name2 with program $prog"
            eval exec $prog [list $name1] [list $name2] $fork
        }
    }

    proc StartFileBrowser { dir } {
        if { $::tcl_platform(platform) eq "windows" } {
            set browserProg "explorer"
        } elseif { $::tcl_platform(os) eq "Linux" } {
            set browserProg "konqueror"
        } elseif { $::tcl_platform(os) eq "Darwin" } {
            set browserProg "open"
        } elseif { $::tcl_platform(os) eq "SunOS" } {
            set browserProg "filemgr -d"
        } elseif { [string match "IRIX*" $::tcl_platform(os)] } {
            set browserProg "fm"
        } else {
            set browserProg "xterm -e ls"
        }
        if { [file isdirectory $dir] } {
            eval exec $browserProg [list [file nativename $dir]] &
        }
    }

    proc GetExecutable { title } {
        global tcl_platform

        set progSuffix "*"
        if { $tcl_platform(platform) eq "windows" } {
            set progSuffix ".exe"
        }
        if { $tcl_platform(os) eq "Darwin" } {
            set progSuffix ".app"
        }
        set fileTypes [list \
            [list Programs  $progSuffix] \
            [list "All files" *]]

        set fileName [tk_getOpenFile -filetypes $fileTypes -title $title]
        if { $fileName ne "" } {
            set fileName [format "\"%s\"" $fileName]
        }
        return $fileName
    }
}

poExtProg Init
catch {poLog Debug "Loaded Package poTklib (Module [info script])"}
