Artifact eb5a543e547cc99cc2e170e367b1cc3b341d16db:

• File CreateShortCuts.tcl — part of check-in [2484e9629e] at 2016-05-30 04:26:11 on branch trunk — (no comment) (user: gwlester size: 3924)

package require Tcl 8.6
package require Tk 8.6
package require base64

cd [file dirname [info script]]

proc CreateShortCuts {} {
    foreach file [glob *.tcl] {
        set name [file tail [file rootname $file]]
        set fullFile [format {file://%s} [file join [pwd] $file]]
        set ans [tk_messageBox \
                    -default no \
                    -icon question \
                    -detail "Create shortcut '$name'?" \
                    -type yesno \
                    -parent . \
                    -title {Create Shortcut} \
            ]
        if {[string is boolean -strict $ans] && $ans} {
            if {[file exists $name.png]} {
                image create photo icon -file $name.png
                set icon [::base64::encode [icon data -format PNG]]
                image delete icon
                catch {borg shortcut add $name $fullFile $icon}
            } else {
                catch {borg shortcut add $name $fullFile}
            }
        } elseif {![string is boolean -strict $ans]} {
            return
        }
    }
}

proc ListenForServer {socket} {
    global filesDownloaded
    global downloadedList

    set dataDict [read $socket]
    fileevent $socket readable {}
    close $socket
    if {[dict exists $dataDict port]} {
        set toPort [dict get $dataDict port]
        set host [dict get $dataDict host]
        set ::status "Sever '$host' found!  Requesting file list..."
        set url [format {http://%s:%d/ScriptSever} $host $toPort]
        set token [::http::geturl $url -query [::http::formatQuery COMMAND LIST]]
        ::http::wait $token
        if {[::http::status $token] eq {ok}} {
            set infoList [::http::data $token]
            ::http::cleanup $token
            set downloadedList {}
            foreach {fileName date} $infoList {
		set fileExists [file exists $fileName]
                if {$fileExists} {
		    set fileMtime [file mtime $fileName]
		} else {
		    set fileMtime $date
		}
                if {!$fileExists || ($fileMtime < $date)} {
                    set ::status "Downloading '$fileName'..."
                    set ofd [open $fileName w]
                    set query [::http::formatQuery COMMAND GET FILE $fileName]
                    set token [::http::geturl $url -query $query -channel $ofd]
                    ::http::wait $token
                    close $ofd
		    catch {file mtime $fileName $date}
                    ::http::cleanup $token
                    lappend downloadedList $fileName
                }
            }
        }
        set filesDownloaded 1
    }
}

proc Timeout {} {
    global filesDownloaded

    set filesDownloaded -1
}

set ans [tk_messageBox \
            -default no \
            -detail {Download Scripts from server?} \
            -icon question \
            -parent . \
            -title {Download Scripts?} \
            -type yesno]

update idletasks

if  {[string is boolean -strict $ans] && $ans} {
    package require udp
    package require http

    set filesDownloaded 0
    set group 224.5.1.21
    set port  7770
    set socket [udp_open $port]
    fconfigure $socket -mcastadd $group
    set afterId [after [expr {1000 * 60}] Timeout]
    fileevent $socket readable [list ListenForServer $socket]
    listbox .downloads -listvariable downloadedList
    label .status \
        -textvariable status
    grid configure .downloads -sticky nsew
    grid configure .status -sticky ew
    grid columnconfigure . .downloads -weight 1
    grid rowconfigure . .downloads -weight 1
    set status {Searching for server!}
    vwait filesDownloaded
}

set ans [tk_messageBox \
            -default no \
            -detail {Create Short Cuts?} \
            -icon question \
            -parent . \
            -title {Create Short Cuts?} \
            -type yesno]
if  {[string is boolean -strict $ans] && $ans} {
    CreateShortCuts
}

destroy .
exit 1