Merge pull request #100 from dolphinsmalltalk/blairmc/osver

Blairmc/osver
dolphinsmalltalk · Feb 28, 2016 · 57bf2bf · 57bf2bf
2 parents 52ab677 + cc2a065
commit 57bf2bf
Show file tree

Hide file tree

Showing 45 changed files with 433 additions and 303 deletions.
diff --git a/BootCore.cmd b/BootCore.cmd
@@ -2,5 +2,5 @@
 Dolphin7 DBOOT.img7 DolphinCoreProduct
 IF %ERRORLEVEL% NEQ 0 (
   ECHO Boot failed, Code=%ERRORLEVEL%
-  PAUSE
+  if "%AppVeyor%"=="" PAUSE
 )
diff --git a/BootDPRO.cmd b/BootDPRO.cmd
@@ -2,5 +2,5 @@
 Dolphin7 DBOOT.img7 DolphinProfessional
 IF %ERRORLEVEL% NEQ 0 (
   ECHO Boot failed, Code=%ERRORLEVEL%
-  PAUSE
+  if "%AppVeyor%"=="" PAUSE
 )
diff --git a/Core/Contributions/ITC Gorisek/COMPortWriter.cls b/Core/Contributions/ITC Gorisek/COMPortWriter.cls
@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.2"!
+"Filed out from Dolphin Smalltalk 7"!
 
 Object subclass: #COMPortWriter
 	instanceVariableNames: 'handle'
@@ -95,7 +95,7 @@ setBaudRate: baudRate parity: parity dataBits: dataBits
 
 setBaudRate: baudRate parity: parity dataBits: dataBits stopBits: stopBits 
 	| dcb result |
-	OSVERSIONINFO current dwMajorVersion > 5 
+	VMLibrary default isWindowsVistaOrGreater 
 		ifTrue: 
 			["the code below does not work on Windows 7, do nothing here until this is fixed"
 

diff --git a/Core/Contributions/Solutions Software/EmulatedCheckBox.cls b/Core/Contributions/Solutions Software/EmulatedCheckBox.cls
@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.1"!
+"Filed out from Dolphin Smalltalk 7"!
 
 View subclass: #EmulatedCheckBox
 	instanceVariableNames: 'isTransition isChecked hasCursor isThemed'
@@ -139,7 +139,7 @@ isThemed
 
 	^isThemed ifNil:
 		[isThemed := 
-			OSVERSIONINFO current isWinXP 
+			SystemMetrics current hasThemes
 			and: [ThemeLibrary default isThemeActive 
 			and: [ThemeLibrary default isAppThemed]]]
 !

diff --git a/Core/Contributions/Solutions Software/SSW ListView Extensions.pax b/Core/Contributions/Solutions Software/SSW ListView Extensions.pax
@@ -250,13 +250,13 @@ onHScroll: aScrollEvent
 	^super onHScroll: aScrollEvent!
 
 onViewOpened
-
 	"Turn off real gridlines and activate virtual gridlines on XP to handle corruption when scrolling"
-	(self hasGridLines and: [OSVERSIONINFO current isWinXP]) ifTrue:
-		[self 
-			hasGridLines: false;
-			hasVirtualGridLines: true].
 
+	(self hasGridLines and: [SystemMetrics current hasListViewGridLineScrollScarringBug]) 
+		ifTrue: 
+			[self
+				hasGridLines: false;
+				hasVirtualGridLines: true].
 	^super onViewOpened!
 
 rowPixelHeight

diff --git a/Core/Object Arts/Dolphin/ActiveX/OCX/AXControlSite.cls b/Core/Object Arts/Dolphin/ActiveX/OCX/AXControlSite.cls
@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6"!
+"Filed out from Dolphin Smalltalk 7"!
 
 ControlView subclass: #AXControlSite
 	instanceVariableNames: 'progId dispControl host sink hostFlags propertyMap ambientDispatch unkControl licenseKey _reserved1 _reserved2'
@@ -917,7 +917,7 @@ chooseControl: defaultProgId
 	answering the <readableString> progId of that chosen, or nil if none was chosen (the user pressed
 	cancel)."
 
-	| prompter controlReg choices choicePresenter |
+	| prompter controlReg choices choicePresenter imageManager |
 	choices := ICatInformation controls.
 	controlReg := defaultProgId isNil 
 				ifFalse: 
@@ -932,15 +932,11 @@ chooseControl: defaultProgId
 		newCaption: 'Other Active-X control...';
 		newPrompt: 'Please enter a Prog Id:';
 		newBlock: [:aString | COMObjectRegistration clsid: (CLSID fromString: aString)].
-	OSVERSIONINFO current isNT 
-		ifTrue: 
-			["Only display the toolbox images on NT because danger of exhausting resources on Win9x"
-			| imageManager |
-			imageManager := ImageManager new.
-			imageManager maskcolor: Color face3d.
-			prompter
-				getImageBlock: [:objreg | imageManager addImage: objreg toolboxImage];
-				imageManager: imageManager].
+	imageManager := ImageManager new.
+	imageManager maskcolor: Color face3d.
+	prompter
+		getImageBlock: [:objreg | imageManager addImage: objreg toolboxImage];
+		imageManager: imageManager.
 	choicePresenter := prompter presenterNamed: 'choices'.
 	choicePresenter viewModel searchPolicy: SearchPolicy equality.
 	^prompter showModal ifNotNil: [:choice | choice clsid displayString]!

diff --git a/Core/Object Arts/Dolphin/Base/BootSessionManager.cls b/Core/Object Arts/Dolphin/Base/BootSessionManager.cls
@@ -109,7 +109,7 @@ productVersion
 !
 
 reloadSystemPackage
-	| srcMgr basePackage baseClasses imageDir obsoleteMethodFilter |
+	| srcMgr basePackage baseClasses imageDir obsoleteMethodFilter missingClasses |
 	basePackage := PackageManager systemPackage.
 	imageDir := self imageBase.
 	srcMgr := SourceManager default.
@@ -118,19 +118,32 @@ reloadSystemPackage
 	basePackage sourceGlobalVariables 
 		collect: [:each | srcMgr fileIn: (File relativePathOf: each value fileOutName to: imageDir)].
 	Notification signal: 'Reloading BCL class definitions...'.
+	"First tag all the existing classes so we can spot the dead ones later."
 	srcMgr fileIn: (File relativePathOf: basePackage classDefinitionsFileName to: imageDir).
 	"Then reload all base package classes in breadth-first order"
 	Notification signal: 'Reloading BCL classes...'.
 	baseClasses := basePackage classesInHierarchyOrder.
+	missingClasses := OrderedCollection new.
 	baseClasses do: 
 			[:each | 
 			each == BootSessionManager 
-				ifFalse: [srcMgr fileIn: (File relativePathOf: each fileOutName to: imageDir)]].
+				ifFalse: 
+					[| relativePath |
+					relativePath := File relativePathOf: each fileOutName to: imageDir.
+					(File exists: relativePath) 
+						ifTrue: [srcMgr fileIn: relativePath]
+						ifFalse: [missingClasses add: each]]].
+	missingClasses reverseDo: 
+			[:each | 
+			Notification signal: 'Removing obsolete boot class ' , each printString , '...'.
+			each removeFromSystem.
+			basePackage basicRemoveClass: each].
 	Notification signal: 'Deleting obsolete boot image methods...'.
 	obsoleteMethodFilter := [:each | each hasChanged not].
-	baseClasses do: 
+	(baseClasses difference: missingClasses) do: 
 			[:each | 
-			(((each selectMethods: obsoleteMethodFilter) asSortedCollection)
+			(((each selectMethods: obsoleteMethodFilter) 
+				asSortedCollection: [:a :b | a printString <= b printString])
 				addAll: (each class selectMethods: obsoleteMethodFilter);
 				yourself) do: 
 						[:m | 

diff --git a/Core/Object Arts/Dolphin/Base/Deprecated/Dolphin Base (Deprecated).pax b/Core/Object Arts/Dolphin/Base/Deprecated/Dolphin Base (Deprecated).pax
@@ -12,6 +12,7 @@ package basicPackageVersion: '6.1'.
 
 package classNames
 	add: #MethodContext;
+	add: #OSVERSIONINFO;
 	add: #STBSymbolProxy;
 	yourself.
 
@@ -28,10 +29,8 @@ package methodNames
 	add: #Integer -> #digitSize;
 	add: #Integer -> #highSWord;
 	add: #Integer -> #lowSWord;
+	add: #KernelLibrary -> #getVersionEx:;
 	add: #Object -> #asDword;
-	add: #OSVERSIONINFO -> #isNT4;
-	add: #OSVERSIONINFO -> #isWin98;
-	add: #OSVERSIONINFO -> #isWinMe;
 	add: #Package -> #script:;
 	add: #Package -> #script:put:;
 	add: #SourceManager -> #nextChunkFrom:;
@@ -64,6 +63,11 @@ Object variableSubclass: #MethodContext
 	classVariableNames: ''
 	poolDictionaries: ''
 	classInstanceVariableNames: ''!
+Win32Structure subclass: #OSVERSIONINFO
+	instanceVariableNames: 'osName'
+	classVariableNames: 'Current'
+	poolDictionaries: ''
+	classInstanceVariableNames: ''!
 STBProxy subclass: #STBSymbolProxy
 	instanceVariableNames: 'string'
 	classVariableNames: ''
@@ -207,6 +211,19 @@ lowSWord
 !Integer categoriesFor: #highSWord!bit manipulation!public! !
 !Integer categoriesFor: #lowSWord!bit manipulation!public! !
 
+!KernelLibrary methodsFor!
+
+getVersionEx: anOSVERSIONINFO 
+	"Populate the argument with extended OS version information. Answers whether the request succeeded.
+		BOOL GetVersionEx(
+			LPOSVERSIONINFO lpVersionInformation 
+		);"
+
+	<stdcall: bool GetVersionExA OSVERSIONINFO*>
+	#deprecated.	"Deprecated by Microsoft, see https://msdn.microsoft.com/en-us/library/windows/desktop/ms724451(v=vs.140).aspx"
+	^self invalidCall! !
+!KernelLibrary categoriesFor: #getVersionEx:!public!win32 functions-system information! !
+
 !Object methodsFor!
 
 asDword
@@ -219,39 +236,6 @@ asDword
 	^self! !
 !Object categoriesFor: #asDword!converting!private! !
 
-!OSVERSIONINFO methodsFor!
-
-isNT4
-	"Answer whether the host OS is NT4.
-		OSVERSIONINFO current isNT
-	"
-
-	"NT4 is no longer supported"
-	#deprecated.
-	^false!
-
-isWin98
-	"Answer whether the host OS is Windows 98.
-		OSVERSIONINFO current isWin98
-	"
-
-	"Dolphin no longer supports the pre-NT Windows OSs"
-	#deprecated.
-	^false!
-
-isWinMe
-	"Answer whether the host OS is Windows Me.
-		OSVERSIONINFO current isWinMe
-	"
-
-	"Dolphin no longer supports the pre-NT Windows OSs"
-
-	#deprecated.
-	^false! !
-!OSVERSIONINFO categoriesFor: #isNT4!public!testing! !
-!OSVERSIONINFO categoriesFor: #isWin98!public!testing! !
-!OSVERSIONINFO categoriesFor: #isWinMe!public!testing! !
-
 !Package methodsFor!
 
 script: scriptSymbol

diff --git a/...bject Arts/Dolphin/Base/OSVERSIONINFO.cls → ...Dolphin/Base/Deprecated/OSVERSIONINFO.cls b/...bject Arts/Dolphin/Base/OSVERSIONINFO.cls → ...Dolphin/Base/Deprecated/OSVERSIONINFO.cls
@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.1"!
+"Filed out from Dolphin Smalltalk 7"!
 
 Win32Structure subclass: #OSVERSIONINFO
 	instanceVariableNames: 'osName'
@@ -8,9 +8,9 @@ Win32Structure subclass: #OSVERSIONINFO
 OSVERSIONINFO guid: (GUID fromString: '{87B4C604-026E-11D3-9FD7-00A0CC3E4A32}')!
 OSVERSIONINFO comment: 'OSVERSIONINFO is an ExternalStructure class to represent the Win32 OSVERSIONINFOEX structure.
 
-OSVERSIONINFO is used to retrieve version information about the host OS on which an application is running. It is used in conjunction with .
+OSVERSIONINFO is used to retrieve version information about the host OS on which an application is running.
 
-This class adds various tests for common Windows variants (e.g. #isWin2k) and also an #osName method which answers a symbolic name for the host OS.
+Please note that the Windows API GetVersionEx is now deprecated, and consequently this entire class is deprecated. The Win32 Version Helper functions should be used instead. These are all accessible through VMLibrary. However, rather than test for a specific OS version in class library methods, it is preferable to define a capability enquiry with an appropriate intention revealing name, e.g. see those in SystemMetrics.
 '!
 !OSVERSIONINFO categoriesForClass!External-Data-Structured-Win32! !
 !OSVERSIONINFO methodsFor!
@@ -21,16 +21,18 @@ calculateOsName
 	major := self dwMajorVersion.
 	minor := self dwMinorVersion.
 	type := self wProductType.
-	major > 5 
+	major <= 5 
 		ifTrue: 
-			["Vista or later"
-			minor > 0 
-				ifTrue: 
-					[^type == VER_NT_WORKSTATION ifTrue: [#win7] ifFalse: [#win2k8r2].
-					^type == VER_NT_WORKSTATION ifTrue: [#winVista] ifFalse: [#win2k8]]].
-	minor > 1 ifTrue: [^#win2k3].
-	minor > 0 ifTrue: [#winXP].
-	^#win2k!
+			[minor = 0 ifTrue: [^#win2k].
+			minor = 1 ifTrue: [^#winXP].
+			^#win2k3].
+	major = 6 
+		ifTrue: 
+			[minor = 0 ifTrue: [^type == VER_NT_WORKSTATION ifTrue: [#winVista] ifFalse: [#win2k8]].
+			minor = 1 ifTrue: [^type == VER_NT_WORKSTATION ifTrue: [#win7] ifFalse: [#win2k8r2]].
+			minor = 2 ifTrue: [^#win8].
+			^#win81].
+	^#win10!
 
 dwBuildNumber
 	"Answer the receiver's dwBuildNumber field as a Smalltalk object."
@@ -67,6 +69,14 @@ isNT
 
 	^self dwPlatformId == VER_PLATFORM_WIN32_NT!
 
+isNT4
+	"Answer whether the host OS is NT4.
+		OSVERSIONINFO current isNT
+	"
+
+	"NT4 is no longer supported"
+	^false!
+
 isWin2K
 	"Answer whether the host OS is Windows 2000.
 		OSVERSIONINFO current isWin2K
@@ -94,15 +104,32 @@ isWin95
 
 	^false!
 
+isWin98
+	"Answer whether the host OS is Windows 98.
+		OSVERSIONINFO current isWin98
+	"
+
+	"Dolphin no longer supports the pre-NT Windows OSs"
+
+	^false!
+
 isWin9X
 	"Answer whether the host OS is Windows 95/98 or ME."
 
 	"Dolphin no longer supports the pre-NT Windows OSs"
 
 	^false!
 
+isWinMe
+	"Answer whether the host OS is Windows Me.
+		OSVERSIONINFO current isWinMe
+	"
+
+	"Dolphin no longer supports the pre-NT Windows OSs"
+
+	^false!
+
 isWinV5
-	#deprecated.	"Use isWinV5OrLater, or test for specific versions"
 	^#(#win2k #winXP #win98 #winMe) identityIncludes: self osName!
 
 isWinV5OrLater
@@ -178,11 +205,14 @@ wSuiteMask
 !OSVERSIONINFO categoriesFor: #dwSize:!**compiled accessors**!public! !
 !OSVERSIONINFO categoriesFor: #hasThemes!accessing!private! !
 !OSVERSIONINFO categoriesFor: #isNT!public!testing! !
+!OSVERSIONINFO categoriesFor: #isNT4!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWin2K!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWin2K3!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWin2K3OrLater!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWin95!public!testing! !
+!OSVERSIONINFO categoriesFor: #isWin98!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWin9X!public!testing! !
+!OSVERSIONINFO categoriesFor: #isWinMe!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWinV5!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWinV5OrLater!public!testing! !
 !OSVERSIONINFO categoriesFor: #isWinV6OrLater!public!testing! !

diff --git a/Core/Object Arts/Dolphin/Base/DolphinClasses.st b/Core/Object Arts/Dolphin/Base/DolphinClasses.st
@@ -1255,11 +1255,6 @@ Win32Structure subclass: #MSGBOXPARAMS
 	classVariableNames: ''
 	poolDictionaries: 'MessageBoxConstants'
 	classInstanceVariableNames: ''!
-Win32Structure subclass: #OSVERSIONINFO
-	instanceVariableNames: 'osName'
-	classVariableNames: 'Current'
-	poolDictionaries: ''
-	classInstanceVariableNames: ''!
 Win32Structure subclass: #PROCESS_INFORMATION
 	instanceVariableNames: ''
 	classVariableNames: ''

diff --git a/Core/Object Arts/Dolphin/Base/ExternalLibrary.cls b/Core/Object Arts/Dolphin/Base/ExternalLibrary.cls
@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6"!
+"Filed out from Dolphin Smalltalk 7"!
 
 Object subclass: #ExternalLibrary
 	instanceVariableNames: 'handle '
@@ -402,13 +402,12 @@ load: aString flags: anInteger
 	"Private - Open the external library with the external file name, aString,
 	and answer the handle."
 
-	| hLibrary klib flags |
-	flags := OSVERSIONINFO current isNT ifTrue: [anInteger] ifFalse: [0].
+	| hLibrary klib |
 	klib := KernelLibrary default.
 	hLibrary := klib 
 				loadLibraryEx: aString
 				hFile: nil
-				dwFlags: flags.
+				dwFlags: anInteger.
 	^hLibrary ifNil: [Win32Error signal: aString printString]!
 
 moduleFileName: aLibOrHandle