Check-in [a721c00182]

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

Overview
Comment:WebView example working.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:a721c00182b5e68600672f1c728cfc1ea08ed928
User & Date: gwlester 2014-12-10 06:22:55
Context
2014-12-10
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
2014-12-08
15:01
Starting work on WebView Server. check-in: e0088541d1 user: gwlester tags: trunk
Changes

Changes to CreateShortCuts.tcl.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19


20
21
22
23
24
25

26
27
28
29
30
31
32
..
33
34
35
36
37
38
39

40
41
42
43
44
45
46
..
49
50
51
52
53
54
55

56
57
58
59
60
61
62
..
83
84
85
86
87
88
89

90
91

92
93
94
95
96
97
98








99
100

101
102
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 [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} {
            catch {borg shortcut add $name $fullFile}


        }
    }
}

proc ListenForServer {socket} {
    global filesDownloaded


    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

            foreach {fileName date} $infoList {
		set fileExists [file exists $fileName]
                if {$fileExists} {
		    set fileMtime [file mtime $fileName]
		} else {
		    set fileMtime $date
		}
................................................................................
                    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

                }
            }
        }
        set filesDownloaded 1
    }
}

................................................................................
    set filesDownloaded 0
    set group 224.5.1.21
    set port  7771
    set socket [udp_open $port]
    fconfigure $socket -mcastadd $group
    set afterId [after [expr {1000 * 60}] Timeout]
    fileevent $socket readable [list ListenForServer $socket]

    label .status \
        -textvariable status

    grid configure .status -sticky nsew
    grid columnconfigure . .status -weight 1
    grid rowconfigure . .status -weight 1
    set status {Searching for server!}
    vwait filesDownloaded
}









CreateShortCuts


#destroy .
#exit 1







|










>
>






>







 







>







 







>







 







>


>
|
|
|




>
>
>
>
>
>
>
>
|
|
>
|
|
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
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]]
        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} {
            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
		}
................................................................................
                    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
    }
}

................................................................................
    set filesDownloaded 0
    set group 224.5.1.21
    set port  7771
    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

Changes to WebViewServer.tcl.

34
35
36
37
38
39
40



41
































































42


43


44








































45




46


47
48
49





##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################
set baseDir [file dirname [info script]]
source [file join $baseDir HttpdPkg.tcl]




































































proc HandleRequest {socket requestArrName} {


}











































httpd addHandler 8080 /Test.html HandleRequest




httpd listen 8080



set forever 0
vwait forever












>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
|
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>

>
>



>
>
>
>
>
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
##  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR  OTHERWISE) ARISING IN       ##
##  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF  ADVISED OF THE         ##
##  POSSIBILITY OF SUCH DAMAGE.                                              ##
##                                                                           ##
###############################################################################
set baseDir [file dirname [info script]]
source [file join $baseDir HttpdPkg.tcl]
set ofd [open [file join $baseDir WebViewServer.log] {WRONLY APPEND CREAT}]
puts $ofd "[clock format [clock seconds]] -- Starting"
flush $ofd

package require Tcl 8.6
package require Tk
package require html
package require units

if {![llength [info commands borg]]} {
    proc borg {args} {
        puts stdout [info level 0]
        return ;
    }
}

if {![llength [info commands sdltk]]} {
    proc sdltk {args} {
        puts stdout [info level 0]
        return ;
    }
}

proc DisplayInfo {socket requestArrName} {
    upvar 1 $requestArrName requestArr
    global ofd

    puts $ofd "[clock format [clock seconds]] -- [info level 0]"
    flush $ofd
    #parray requestArr

    set replyDict [dict create type text/html]
    dict set replyDict code 200
    set screen(DPI) [winfo pixels . {1i}]
    set screen(Height,Pixels) [winfo screenheight .]
    set screen(Width,Pixels) [winfo screenwidth .]
    set screen(Height,mm) [winfo screenmmheight .]
    set screen(Width,mm) [winfo screenmmwidth .]
    set screen(Height,in) [::units::convert "$screen(Height,mm) mm" "inches"]
    set screen(Width,in) [::units::convert "$screen(Width,mm) mm" "inches"]
    lassign [sdltk maxroot] screen(Width,max) screen(Height,max)
    ::html::init
    ::html::css-clear
    ::html::author {Gerald W. Lester}
    ::html::description {Information on Android Display}

    set results {}
    set results [::html::doctype HTML401]
    append results [::html::head {Information on Android Display}]
    append results [::html::bodyTag]
        append results [::html::h1 [::html::getTitle]]
        append results [::html::tableFromArray screen]
        append results {<br/><br/>}
        append results {<a href="./Test.html">Refresh</a><br>}
        append results {<a href="./Exit">Exit</a><br>}
    append results [::html::closeTag]
    append results [::html::end]

    dict set replyDict data $results
    set requestArr(reply) $replyDict

    #puts $results
    #parray requestArr
    puts $ofd "[clock format [clock seconds]] -- Leaving [lindex [info level 0] 0]\n\n"
    flush $ofd
    return;
}

proc ExitCode {socket requestArrName} {
    upvar 1 $requestArrName requestArr
    global ofd

    puts $ofd "[clock format [clock seconds]] -- [info level 0]"
    flush $ofd

    set replyDict [dict create type text/html]
    dict set replyDict code 200
    ::html::init
    ::html::css-clear
    ::html::author {Gerald W. Lester}
    ::html::description {Good Bye!}

    set results {}
    set results [::html::doctype HTML401]
    append results [::html::head {Good Bye}]
    append results [::html::bodyTag]
        append results [::html::h1 [::html::getTitle]]
        append results {<p>Please exit browser to exit the application</p>}
    append results [::html::closeTag]
    append results [::html::end]
    dict set replyDict data $results
    set requestArr(reply) $replyDict

    puts $ofd "[clock format [clock seconds]] -- Leaving [lindex [info level 0] 0]\n\n"
    flush $ofd

    return;
}

proc ViewDone {args} {
    global ofd

    puts $ofd "[clock format [clock seconds]] -- [info level 0]"
    flush $ofd

    set ::forever 1

    puts $ofd "[clock format [clock seconds]] -- Leaving [lindex [info level 0] 0]\n\n"
    flush $ofd
    return;
}

wm withdraw .

httpd addHandler 8080 /Exit ExitCode
httpd addHandler 8080 /Test.html DisplayInfo
after 1 {borg activity android.intent.action.VIEW http://localhost:8080/Test.html {text/html} {} {} {} ViewDone}

puts $ofd "[clock format [clock seconds]] -- before httpd listen 8080"
flush $ofd
httpd listen 8080
puts $ofd "[clock format [clock seconds]] -- after httpd listen 8080"
flush $ofd

set forever 0
vwait forever
puts $ofd "[clock format [clock seconds]] -- after vwait"
flush $ofd

destroy .
exit