filemorph

Check-in [3ef6454d8b]
Login

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

Overview
Comment:Update for Windows
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 3ef6454d8b3015796cc129c06e5992ee146030cb
User & Date: kevin 2018-08-20 19:12:05
Context
2018-08-21
00:41
Refinements for scripting and unit testing on Windows check-in: 27d8264cf3 user: kevin tags: trunk
2018-08-20
19:12
Update for Windows check-in: 3ef6454d8b user: kevin tags: trunk
17:57
Unit test, rev bump for 3.0 and Windows check-in: 6c7f57f091 user: kevin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to filemorph-changes.tcl.

1
2


* Improved scrolling performance, security support on macOS.
* Improved security support on Windows.


|
|
>
>
1
2
3
4
* New scripting API for Windows.
* Removal of console on Windows.
* Migration to new source code server.
* UI improvements.

Changes to filemorph-version.tcl.

1
2.9
|
1
3.0

Changes to filemorph.pl.

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Tkx::package_require('xplat');

if ($IS_AQUA) {
    Tkx::package_require('fullscreen');
    Tkx::package_require('aem');
    Tkx::package_require('cocoaprint');
    Tkx::package_require('windowlist');
  }

if ($IS_WINDOWS) {
  Tkx::package_require('dde');
  Tkx::dde_servername('FileMorph');
}
  

  

#initialize variables
our $folder;
our $sourceext;
our $targetext;
our $targetstring;
our $srcstring;







|


|
|

<
<
<







59
60
61
62
63
64
65
66
67
68
69
70
71



72
73
74
75
76
77
78
Tkx::package_require('xplat');

if ($IS_AQUA) {
    Tkx::package_require('fullscreen');
    Tkx::package_require('aem');
    Tkx::package_require('cocoaprint');
    Tkx::package_require('windowlist');
}

if ($IS_WINDOWS) {
    Tkx::package_require('dde');
    Tkx::dde_servername('FileMorph');
}




#initialize variables
our $folder;
our $sourceext;
our $targetext;
our $targetstring;
our $srcstring;
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
    &Tkx::machelp__userhelp;
}

#initialize the app
sub startUp {

    $appname    = 'FileMorph';
    $appversion = '2.9';
    &Tkx::machelp__setAppName( $appname, $appversion );
    &Tkx::softwareupdate__setAppName($appname);
    &Tkx::softwareupdate__setVersion( $appname, $appversion );

    #check for app support directory
    our $prefdir = Tkx::xplat__appconfig("FileMorph");
    mkdir $prefdir unless ( -d $prefdir );







|







1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
    &Tkx::machelp__userhelp;
}

#initialize the app
sub startUp {

    $appname    = 'FileMorph';
    $appversion = '3.0';
    &Tkx::machelp__setAppName( $appname, $appversion );
    &Tkx::softwareupdate__setAppName($appname);
    &Tkx::softwareupdate__setVersion( $appname, $appversion );

    #check for app support directory
    our $prefdir = Tkx::xplat__appconfig("FileMorph");
    mkdir $prefdir unless ( -d $prefdir );

Changes to scriptlibs/softwareupdate/softwareupdate.tcl.

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
	variable currentversion
	variable versionnumber

	set appname $app

	softwareupdate::checkingForUpdates

	set versionurl https://www.codebykevin.com/$appname-version.tcl
	http::config -useragent "$appname Update Check"

	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 .
	catch {destroy .updateprogress}
	    return
	} 

	set versionnumber [string trim [http::data [http::geturl $versionurl]]]
	if [expr $currentversion < $versionnumber] {







|



|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
	variable currentversion
	variable versionnumber

	set appname $app

	softwareupdate::checkingForUpdates

	set versionurl [string tolower https://www.codebykevin.com/$appname-version.tcl]
	http::config -useragent "$appname Update Check"

	if [catch {http::geturl $versionurl} msg] {
	    if {[tk windowingsystem] ne "win32"} { 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 .
	catch {destroy .updateprogress}
	    return
	} 

	set versionnumber [string trim [http::data [http::geturl $versionurl]]]
	if [expr $currentversion < $versionnumber] {
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

	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 .
	    catch {destroy .updateprogress}
	    return
	} 


	set changelist [http::data [http::geturl $changeurl]]







|


|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

	catch {destroy .updateprogress}

	catch {destroy .update}
	
	variable appname

	set changeurl [string tolower https://www.codebykevin.com/$appname-changes.tcl]

        if [catch {http::geturl $changeurl} msg] {
	    if {[tk windowingsystem] ne "win32"} { 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 .
	    catch {destroy .updateprogress}
	    return
	} 


	set changelist [http::data [http::geturl $changeurl]]
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

	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
	    }







>
>
>
|










|







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

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

	    "aqua" {
		update
		after 1000
		#http package causes file corruption of the DMG for some reason
		exec curl -s https://www.codebykevin.com/updates/[list $appname].dmg -o  $tmpdir/[list $appname].dmg
		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 -binary 1 -channel [open $tmpdir/[list $appname]_Setup.exe wb]

	    }
	    
	    "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
	    }