Check-in [110fb196bb]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added support for PNG "icon" files to both ScriptServer and CreateShortCuts.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:110fb196bb2fa70b43dec8fc8200fd8d44f469a0
User & Date: gwlester 2014-12-10 17:51:12
Context
2014-12-10
18:06
fixed typo check-in: 975183ea07 user: gwlester tags: trunk
17:51
Added support for PNG "icon" files to both ScriptServer and CreateShortCuts. check-in: 110fb196bb user: gwlester tags: trunk
06:22
WebView example working. check-in: a721c00182 user: gwlester tags: trunk
Changes

Changes to CreateShortCuts.tcl.

1
2

3
4
5
6
7
8
9
..
12
13
14
15
16
17
18






19

20
21
22
23
24
25
26
package require Tcl 8.6
package require Tk 8.6


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]]
................................................................................
                    -icon question \
                    -detail "Create shortcut '$name'?" \
                    -type yesno \
                    -parent . \
                    -title {Create Shortcut} \
            ]
        if {[string is boolean -strict $ans] && $ans} {






            catch {borg shortcut add $name $fullFile}

        } elseif {![string is boolean -strict $ans]} {
            return
        }
    }
}

proc ListenForServer {socket} {


>







 







>
>
>
>
>
>
|
>







1
2
3
4
5
6
7
8
9
10
..
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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]]
................................................................................
                    -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} {

Changes to ServeScripts.tcl.

464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
...
572
573
574
575
576
577
578



579
580
581
582
583
584
585
                regexp -nocase {^basic +([^ ]+)$}\
                    [dict get $request header authorization] -> auth
            }
            if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
                return
            }
 
            switch -exact -- $method {
                POST {
                    ##
                    ## This is all broken and needs to be fixed
                    ##
                    set data ""
                    if {[dict exists $request header transfer-encoding]
                        && [dict get $request header transfer-encoding] eq "chunked"} {
................................................................................
}

proc GetFileList {} {
    set results [list]
    foreach file [glob -nocomplain *.tcl] {
        lappend results $file [file mtime $file]
    }



    return $results
}

proc GetFile {fileName} {
    set ifd [open $fileName r]
    set data [read $ifd]
    close $ifd







|







 







>
>
>







464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
...
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
                regexp -nocase {^basic +([^ ]+)$}\
                    [dict get $request header authorization] -> auth
            }
            if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
                return
            }
 
            switch -exact -- $method 
                POST {
                    ##
                    ## This is all broken and needs to be fixed
                    ##
                    set data ""
                    if {[dict exists $request header transfer-encoding]
                        && [dict get $request header transfer-encoding] eq "chunked"} {
................................................................................
}

proc GetFileList {} {
    set results [list]
    foreach file [glob -nocomplain *.tcl] {
        lappend results $file [file mtime $file]
    }
    foreach file [glob -nocomplain *.png] {
        lappend results $file [file mtime $file]
    }
    return $results
}

proc GetFile {fileName} {
    set ifd [open $fileName r]
    set data [read $ifd]
    close $ifd