filemorph

Check-in [679025187c]
Login
☰Home Timeline Branches Tags Tickets Wiki Login

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

Overview
Comment:Tweak version check
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 679025187ca2f8a8e341902c2aa4554f8b3823f5
User & Date: kevin 2017-01-16 02:30:48
Context
2017-01-16
03:01
Tweak version check check-in: d0287b1faa user: kevin tags: trunk
02:30
Tweak version check check-in: 679025187c user: kevin tags: trunk
01:30
Update to installer check-in: d6928c2ee5 user: kevin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to scriptlibs/softwareupdate/softwareupdate.tcl.

︙︙
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

    variable tmpdir
    variable currentinstall
    variable versionnumber
    
    switch [tk windowingsystem] {
	"aqua" {
	    set tmpdir $::env(TMPDIR)

	}
	
	"win32" {
	    set tmpdir $::env(TMP)
	}
	
	"x11" {








<








22
23
24
25
26
27
28

29
30
31
32
33
34
35

    variable tmpdir
    variable currentinstall
    variable versionnumber
    
    switch [tk windowingsystem] {
	"aqua" {
	    set tmpdir $::env(TMPDIR)

	}
	
	"win32" {
	    set tmpdir $::env(TMP)
	}
	
	"x11" {
︙︙
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


	if [catch {http::geturl $versionurl} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .
	    return
	} 

	set versionnumber [http::data [http::geturl $versionurl]]
	if {$currentversion < $versionnumber} {
	    softwareupdate::updatePitch
	} else {
	    softwareupdate::upToDate
	}
}

#define the current version of the software
proc setVersion {app number} {
    variable currentversion
    variable appname
    set currentversion $number
    set appname $app
    
}


#get the current installation path
proc findCurrentInstallation {} {
    variable currentinstall
    variable appname 
    switch [tk windowingsystem] {

	"aqua" {
	    set approot [info nameofexecutable]
	    set apppath [split $approot /]
	    set currentinstall [join [lrange $apppath 0 [lsearch $apppath "*.app"]] / ]
	}
	
	"win32" {
	    set currentinstall [file join $::env(APPDATA) ${appname}_App]  
	}
	
	"x11" {
	    return
	}
    }
    
    return $currentinstall

}



#prompt user to update
proc updatePitch {} {
    variable appname
    variable icon
    variable changedata
    variable currentversion
    variable versionnumber

    catch {destroy .updateprogress}

    catch {destroy .update}
    
	variable appname

	set changeurl https://www.codebykevin.com/$appname-changes.tcl

        if [catch {http::geturl $changeurl} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .








|





|

|
|
|
|
|
|
|
|


|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|



|
|
|
|
|
|
|

|

|
|








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


	if [catch {http::geturl $versionurl} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .
	    return
	} 

	set versionnumber [string trim [http::data [http::geturl $versionurl]]]
	if {$currentversion < $versionnumber} {
	    softwareupdate::updatePitch
	} else {
	    softwareupdate::upToDate
	}
    }

    #define the current version of the software
    proc setVersion {app number} {
	variable currentversion
	variable appname
	set currentversion $number
	set appname $app
	
    }


    #get the current installation path
    proc findCurrentInstallation {} {
	variable currentinstall
	variable appname 
	switch [tk windowingsystem] {

	    "aqua" {
		set approot [info nameofexecutable]
		set apppath [split $approot /]
		set currentinstall [join [lrange $apppath 0 [lsearch $apppath "*.app"]] / ]
	    }
	    
	    "win32" {
		set currentinstall [file join $::env(APPDATA) ${appname}_App]  
	    }
	    
	    "x11" {
		return
	    }
	}
	
	return $currentinstall

    }



    #prompt user to update
    proc updatePitch {} {
	variable appname
	variable icon
	variable changedata
	variable currentversion
	variable versionnumber

	catch {destroy .updateprogress}

	catch {destroy .update}
	
	variable appname

	set changeurl https://www.codebykevin.com/$appname-changes.tcl

        if [catch {http::geturl $changeurl} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .
︙︙
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369

	    no {
		destroy $updateanswer
		return
	    }
	    
	}

}

proc winPitch {name newversion oldversion} {
    set answer [tk_messageBox  -icon info -title "New Version Available" -message "New Version Available" -detail "$name $newversion is available--you have $oldversion. Would you like to download it now?" -type yesno
	       ]

    switch -- $answer {
	yes {

	    xplat::launch https://www.codebykevin.com/$name.html
	}
	no {
	    return
	}
    }
}
#"busy" dialog
proc checkingForUpdates {} {

    variable appname
    variable icon

    catch {destroy .updateprogress}

    toplevel .updateprogress 
    wm title .updateprogress "Updating $appname"

    wm withdraw .updateprogress
    update idletasks

    ttk::frame .updateprogress.f -padding 5
    pack .updateprogress.f -fill both -expand yes

    label .updateprogress.f.l -bg gray95 -image $icon -bd 0 -relief flat -highlightthickness 0 -width [image width $icon] -height [image height $icon]
    pack .updateprogress.f.l -side left -fill both -expand yes

    frame .updateprogress.f.r -bg gray95 -bd 0 -highlightcolor gray95
    pack .updateprogress.f.r -side right -fill both -expand yes
    
    
    ttk::label .updateprogress.f.r.t -text "Checking for updates..." -padding 5
    pack .updateprogress.f.r.t -side top -fill both -expand yes

    ttk::frame .updateprogress.f.r.f -padding 5
    pack .updateprogress.f.r.f -side top -fill both -expand yes
    
    ttk::progressbar .updateprogress.f.r.f.progress -mode indeterminate -orient horizontal
    pack .updateprogress.f.r.f.progress -fill both -expand yes -side top

    .updateprogress.f.r.f.progress start

    ttk::button .updateprogress.f.r.f.b -text "Cancel" -command {destroy .updateprogress}

    pack .updateprogress.f.r.f.b -side bottom -fill both -expand no

    wm geometry .updateprogress 400x100
    wm resizable .updateprogress 0 0

    wm deiconify .updateprogress
    raise .updateprogress

    wm transient .updateprogress .

}

#dialog if current version is installed
proc upToDate {} {
    variable appname
    variable currentversion

    catch {destroy .updateprogress}

    tk_messageBox  -icon info -title "Up to Date" -message "You're up to date!" -detail "$appname $currentversion is the currently the newest version available."

}

#show progress of installation
proc progressDialog {} {

    variable appname
    variable status
    variable icon

    catch {destroy .downloadprogress}

    toplevel .downloadprogress
    wm title .downloadprogress "Updating $appname"

    wm transient .downloadprogress .

    label .downloadprogress.label -image $icon  -anchor w -bg gray95 -highlightthickness 0

    pack .downloadprogress.label -side left -fill both -expand yes


    ttk::frame .downloadprogress.frame -padding 5
    pack .downloadprogress.frame -side right -fill both -expand yes

    ttk::label .downloadprogress.frame.l -textvariable softwareupdate::status -width 40 -text ""
    pack .downloadprogress.frame.l -side top -fill both -expand yes

    ttk::progressbar .downloadprogress.frame.bar -mode indeterminate -orient horizontal  -maximum 100
    pack .downloadprogress.frame.bar -side top -fill both -expand yes

    .downloadprogress.frame.bar start
    update

    ttk::button .downloadprogress.frame.b -text "Cancel" -command {destroy .updateprogress}
    pack .downloadprogress.frame.b -side right -fill both -expand no

    wm geometry .downloadprogress 400x100
    wm resizable .downloadprogress 0 0
    
}

#download and install the update
proc installUpdate {} {
    variable currentinstall
    variable status
    variable appname
    variable tmpdir

    catch {destroy .update}

    softwareupdate::findCurrentInstallation

    softwareupdate::progressDialog
    set status "Downloading update for $appname"
    
    switch [tk windowingsystem] {

	"aqua" {
	    http::geturl https://www.codebykevin.com/updates/[list $appname].dmg -channel [open $tmpdir/[list $appname].dmg w] 
	    update
	    after 1000
	    cd $tmpdir
	    set status "Attaching [list $appname].dmg"
	    update
	    exec hdiutil attach [list $appname].dmg
	}
	
	"win32" {
	    
	    http::geturl https://www.codebykevin.com/updates/[list $appname]_Setup.exe -channel [open $tmpdir/[list $appname]_Setup.exe w]

	}
	
	"x11" {
	    tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
	    return
	}
    }
    
    
    set status "Ready to install"
    .downloadprogress.frame.bar configure -mode determinate
    .downloadprogress.frame.bar configure -value 100
    .downloadprogress.frame.bar stop
    destroy .downloadprogress.frame.b 
    pack [ttk::button .downloadprogress.frame.b -text "Install and Relaunch" -command softwareupdate::launchUpdate] -side right -fill both -expand no
    return
}


#launch the update
proc launchUpdate {}  {

    variable currentinstall
    variable appname
    variable tmpdir
    
    switch [tk windowingsystem] {

	"aqua" {

		file rename -force $currentinstall [file join /Users [exec whoami] .Trash [file tail $currentinstall]]

		file copy -force /Volumes/[list $appname]/[list $appname].app $currentinstall

		exec $currentinstall/Contents/MacOS/$appname &

		exec hdiutil detach /Volumes/[list $appname]

		exit
	    }
	
	"win32" {
	    
	    eval exec [auto_execok start] $tmpdir/[list $appname]_Setup.exe &
	    exit
	}
	
	"x11" {
	    tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
	    return
	}
    }

    catch {destroy .downloadprogress}

    

}




namespace export *

}








|

|
|
|

|
|

|
|
|
|
|
|
|
|
|

|
|

|

|
|

|
|

|
|

|
|

|
|
|
|
|
|

|
|
|
|
|

|

|

|

|
|

|
|

|

|

|
|
|
|

|

|

|

|
|

|
|
|

|

|
|

|

|

|


|
|

|
|

|
|

|
|

|
|

|
|
|
|

|
|
|
|
|
|

|

|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|


|
|

|
|
|
|
|

|











|
|
|
|
|
|
|
|
|
|
|
|

|

|

|




|



152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368

	    no {
		destroy $updateanswer
		return
	    }
	    
	}

    }

    proc winPitch {name newversion oldversion} {
	set answer [tk_messageBox  -icon info -title "New Version Available" -message "New Version Available" -detail "$name $newversion is available--you have $oldversion. Would you like to download it now?" -type yesno
		   ]

	switch -- $answer {
	    yes {

		xplat::launch https://www.codebykevin.com/$name.html
	    }
	    no {
		return
	    }
	}
    }
    #"busy" dialog
    proc checkingForUpdates {} {

	variable appname
	variable icon

	catch {destroy .updateprogress}

	toplevel .updateprogress 
	wm title .updateprogress "Updating $appname"

	wm withdraw .updateprogress
	update idletasks

	ttk::frame .updateprogress.f -padding 5
	pack .updateprogress.f -fill both -expand yes

	label .updateprogress.f.l -bg gray95 -image $icon -bd 0 -relief flat -highlightthickness 0 -width [image width $icon] -height [image height $icon]
	pack .updateprogress.f.l -side left -fill both -expand yes

	frame .updateprogress.f.r -bg gray95 -bd 0 -highlightcolor gray95
	pack .updateprogress.f.r -side right -fill both -expand yes
	
	
	ttk::label .updateprogress.f.r.t -text "Checking for updates..." -padding 5
	pack .updateprogress.f.r.t -side top -fill both -expand yes

	ttk::frame .updateprogress.f.r.f -padding 5
	pack .updateprogress.f.r.f -side top -fill both -expand yes
	
	ttk::progressbar .updateprogress.f.r.f.progress -mode indeterminate -orient horizontal
	pack .updateprogress.f.r.f.progress -fill both -expand yes -side top

	.updateprogress.f.r.f.progress start

	ttk::button .updateprogress.f.r.f.b -text "Cancel" -command {destroy .updateprogress}

	pack .updateprogress.f.r.f.b -side bottom -fill both -expand no

	wm geometry .updateprogress 400x100
	wm resizable .updateprogress 0 0

	wm deiconify .updateprogress
	raise .updateprogress

	wm transient .updateprogress .

    }

    #dialog if current version is installed
    proc upToDate {} {
	variable appname
	variable currentversion

	catch {destroy .updateprogress}

	tk_messageBox  -icon info -title "Up to Date" -message "You're up to date!" -detail "$appname $currentversion is the currently the newest version available."

    }

    #show progress of installation
    proc progressDialog {} {

	variable appname
	variable status
	variable icon

	catch {destroy .downloadprogress}

	toplevel .downloadprogress
	wm title .downloadprogress "Updating $appname"

	wm transient .downloadprogress .

	label .downloadprogress.label -image $icon  -anchor w -bg gray95 -highlightthickness 0

	pack .downloadprogress.label -side left -fill both -expand yes


	ttk::frame .downloadprogress.frame -padding 5
	pack .downloadprogress.frame -side right -fill both -expand yes

	ttk::label .downloadprogress.frame.l -textvariable softwareupdate::status -width 40 -text ""
	pack .downloadprogress.frame.l -side top -fill both -expand yes

	ttk::progressbar .downloadprogress.frame.bar -mode indeterminate -orient horizontal  -maximum 100
	pack .downloadprogress.frame.bar -side top -fill both -expand yes

	.downloadprogress.frame.bar start
	update

	ttk::button .downloadprogress.frame.b -text "Cancel" -command {destroy .updateprogress}
	pack .downloadprogress.frame.b -side right -fill both -expand no

	wm geometry .downloadprogress 400x100
	wm resizable .downloadprogress 0 0
	
    }

    #download and install the update
    proc installUpdate {} {
	variable currentinstall
	variable status
	variable appname
	variable tmpdir

	catch {destroy .update}

	softwareupdate::findCurrentInstallation

	softwareupdate::progressDialog
	set status "Downloading update for $appname"
	
	switch [tk windowingsystem] {

	    "aqua" {
		http::geturl https://www.codebykevin.com/updates/[list $appname].dmg -channel [open $tmpdir/[list $appname].dmg w] 
		update
		after 1000
		cd $tmpdir
		set status "Attaching [list $appname].dmg"
		update
		exec hdiutil attach [list $appname].dmg
	    }
	    
	    "win32" {
		
		http::geturl https://www.codebykevin.com/updates/[list $appname]_Setup.exe -channel [open $tmpdir/[list $appname]_Setup.exe w]

	    }
	    
	    "x11" {
		tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
		return
	    }
	}
	
	
	set status "Ready to install"
	.downloadprogress.frame.bar configure -mode determinate
	.downloadprogress.frame.bar configure -value 100
	.downloadprogress.frame.bar stop
	destroy .downloadprogress.frame.b 
	pack [ttk::button .downloadprogress.frame.b -text "Install and Relaunch" -command softwareupdate::launchUpdate] -side right -fill both -expand no
	return
    }


    #launch the update
    proc launchUpdate {}  {

	variable currentinstall
	variable appname
	variable tmpdir
	
	switch [tk windowingsystem] {

	    "aqua" {

		file rename -force $currentinstall [file join /Users [exec whoami] .Trash [file tail $currentinstall]]

		file copy -force /Volumes/[list $appname]/[list $appname].app $currentinstall

		exec $currentinstall/Contents/MacOS/$appname &

		exec hdiutil detach /Volumes/[list $appname]

		exit
	    }
	    
	    "win32" {
		
		eval exec [auto_execok start] $tmpdir/[list $appname]_Setup.exe &
		exit
	    }
	    
	    "x11" {
		tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
		return
	    }
	}

	catch {destroy .downloadprogress}

	

    }




    namespace export *

}

This page was generated in about 0.017s by Fossil 2.20 [0d61fd2310] 2022-10-28 19:48:33