Merge pull request #91 from dolphinsmalltalk/wine-fixes

Wine fixes now part of base system.

Core/Object Arts/Dolphin/Base/KernelLibrary.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.1"!
+"Filed out from Dolphin Smalltalk 7"!
 
 PermanentLibrary subclass: #KernelLibrary
 	instanceVariableNames: ''
@@ -1760,6 +1760,10 @@ fileName
 
 	^'KERNEL32'!
 
+isWine
+	Smalltalk at: #NTLibrary ifPresent: [:ntl | ^ntl isWine].
+	^false !
+
 open
 	"Answer a new instance of the receiver to represent the Kernel32 DLL. Special handling 
 	is required for this library because opening a library is normally done through the 
@@ -1769,5 +1773,6 @@ open
 	^self fromHandle: VMLibrary default kernelHandle! !
 !KernelLibrary class categoriesFor: #clear!initializing!private! !
 !KernelLibrary class categoriesFor: #fileName!constants!public! !
+!KernelLibrary class categoriesFor: #isWine!public! !
 !KernelLibrary class categoriesFor: #open!instance creation!public! !
 

Core/Object Arts/Dolphin/Base/MessageBox.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.1"!
+"Filed out from Dolphin Smalltalk 7"!
 
 MessageBoxAbstract subclass: #MessageBox
 	instanceVariableNames: 'button uniqueId flags icon styleFlags'
@@ -267,6 +267,21 @@ result
 	"Answer a portable symbolic constant describing the button that was pressed by the user
 	to close the receiver."
 
+	Smalltalk at: #NTLibrary
+		ifPresent: 
+			[:ntl | 
+			"Use this dynamic lookup to avoid compilation issues during boot"
+			ntl isWine 
+				ifTrue: 
+					[#wineFix.
+					"Suppressible message boxes under Wine have a bug where they
+					ignore the buttonStyles #yesNo and #yesNoCancel and will
+					always answer #ok or #cancel instead. Here we map the return
+					button ids to the correct values"
+					(self buttonStyle == #yesNo or: [self buttonStyle == #yesNoCancel]) 
+						ifTrue: 
+							[button = IDOK ifTrue: [button := IDYES].
+							button = IDCANCEL ifTrue: [button := IDNO]]]].
 	^ButtonMap at: button!
 
 retryCancel
@@ -372,7 +387,7 @@ yesNoCancel
 !MessageBox categoriesFor: #okCancel!accessing-styles!public! !
 !MessageBox categoriesFor: #open!displaying!public! !
 !MessageBox categoriesFor: #prompt!accessing-styles!public! !
-!MessageBox categoriesFor: #result!accessing!public! !
+!MessageBox categoriesFor: #result!accessing!public!wine fix! !
 !MessageBox categoriesFor: #retryCancel!accessing-styles!public! !
 !MessageBox categoriesFor: #setForeground!accessing-styles!public! !
 !MessageBox categoriesFor: #setStyle:maskedBy:!accessing-styles!private! !

Core/Object Arts/Dolphin/Base/ResourceIdentifier.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6"!
+"Filed out from Dolphin Smalltalk 7"!
 
 Object subclass: #ResourceIdentifier
 	instanceVariableNames: 'owningClass selector'
@@ -42,6 +42,14 @@ editExpression
 
 	^'ViewComposer openOn: (ResourceIdentifier class: self selector: <1p>)' expandMacrosWith: self selector!
 
+editViewUsing: aMonadicBlock 
+	"Use dynamic lookup to avoid boot ordering problems."
+	| view | 
+	view := self loadWithContext: (Smalltalk at: #View) desktop.
+	aMonadicBlock value: view.
+	self assign: view literalStoreArray.
+	view destroy!
+
 emit: aResourceArray asStringOn: aWriteStream 
 	aWriteStream nextPutAll: '#('.
 	aResourceArray do: [:each |  each literalPrintOn: aWriteStream. aWriteStream space].
@@ -192,6 +200,7 @@ storeOn: aStream
 !ResourceIdentifier categoriesFor: #compiledMethod!accessing!public! !
 !ResourceIdentifier categoriesFor: #copy!copying!public! !
 !ResourceIdentifier categoriesFor: #editExpression!helpers!private! !
+!ResourceIdentifier categoriesFor: #editViewUsing:!operations!public! !
 !ResourceIdentifier categoriesFor: #emit:asStringOn:!helpers!private! !
 !ResourceIdentifier categoriesFor: #emitMethodHeaderFor:on:!accessing!private! !
 !ResourceIdentifier categoriesFor: #exists!public!testing! !

Core/Object Arts/Dolphin/IDE/Base/ClassBrowserAbstract.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.1"!
+"Filed out from Dolphin Smalltalk 7"!
 
 SmalltalkToolShell subclass: #ClassBrowserAbstract
 	instanceVariableNames: 'classesPresenter categoriesPresenter methodBrowserPresenter definitionPresenter modePresenter flags history variablesPresenter protocolsPresenter filterPresenter packageModel statusModel versionModel cardsPresenter loadedPlugins methodCategories'
@@ -2829,6 +2829,12 @@ plugins
 	"Answer the plugins installed by instances of the receiver"
 
 	plugins isNil ifTrue: [self plugins: self defaultPluginsCollection].
+	NTLibrary isWine 
+		ifTrue: 
+			["Under Wine we must remove the CodeMentor plugin since it relies in the
+			 Internet Explorer control which is not available."
+			#wineFix.
+			plugins := plugins reject: [:each | each name == #CodeMentorPlugin]].
 	^plugins!
 
 plugins: anOrderedCollection 
@@ -2897,7 +2903,7 @@ wordWrapSource: aBoolean
 !ClassBrowserAbstract class categoriesFor: #initialize!initializing!private! !
 !ClassBrowserAbstract class categoriesFor: #looseMethodColor!accessing!options!public! !
 !ClassBrowserAbstract class categoriesFor: #looseMethodColor:!accessing!options!public! !
-!ClassBrowserAbstract class categoriesFor: #plugins!accessing!public! !
+!ClassBrowserAbstract class categoriesFor: #plugins!accessing!public!wine fix! !
 !ClassBrowserAbstract class categoriesFor: #plugins:!accessing!public! !
 !ClassBrowserAbstract class categoriesFor: #publishedAspects!development!public! !
 !ClassBrowserAbstract class categoriesFor: #removePlugin:!initializing!private! !

Core/Object Arts/Dolphin/MVP/Base/Icon.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.2"!
+"Filed out from Dolphin Smalltalk 7"!
 
 Image subclass: #Icon
 	instanceVariableNames: ''
@@ -255,13 +255,21 @@ valueWithHandle: operation forExtent: aPoint
 				ifTrue: 
 					[(self loadFromFile: self fileSpec extent: aPoint) ifNotNil: [:hIcon | ^operation value: hIcon]]
 				ifFalse: 
-					[(hModule == 0 
-						and: [aPoint ~= SystemMetrics current largeIconExtent and: [OSVERSIONINFO current isWinVista]]) 
-							ifTrue: 
-								[(self 
-									load: ident
-									fromInstance: hModule
-									extent: aPoint) ifNotNil: [:hIcon | ^operation value: hIcon]]]].
+					[(hModule == 0 and: 
+							["Wine does not support the
+							 ComCtrlLibrary>>loadIconWithScaleDown:..
+							 method which is normally availble under
+							 Vista and later. Hence we don't allow this
+							 to be called even if the Windows version
+							 indicates Vista is available."
+							aPoint ~= SystemMetrics current largeIconExtent and: 
+									[#wineFix.
+									OSVERSIONINFO current isWinVista & NTLibrary isWine not]]) 
+						ifTrue: 
+							[(self 
+								load: ident
+								fromInstance: hModule
+								extent: aPoint) ifNotNil: [:hIcon | ^operation value: hIcon]]]].
 	^operation value: self asParameter! !
 !Icon categoriesFor: #addToImageList:mask:!double dispatch!private! !
 !Icon categoriesFor: #asAlphaBitmap:!converting!public! !
@@ -284,7 +292,7 @@ valueWithHandle: operation forExtent: aPoint
 !Icon categoriesFor: #includesFrame:!public!searching! !
 !Icon categoriesFor: #load:fromInstance:extent:!private!realizing/unrealizing! !
 !Icon categoriesFor: #loadFromInstance:!private!realizing/unrealizing! !
-!Icon categoriesFor: #valueWithHandle:forExtent:!helpers!private! !
+!Icon categoriesFor: #valueWithHandle:forExtent:!helpers!private!wine fix! !
 
 !Icon class methodsFor!
 

Core/Object Arts/Dolphin/MVP/Base/IndexedColor.cls

@@ -50,9 +50,22 @@ asParameter
 
 asRGB
 	"Answer the receiver as an RGB using the default palette."
-
-	^self asRGBUsingPalette: self defaultPalette
-!
+	#wineFix.
+	NTLibrary isWine ifTrue: [
+		"Wine doesn't yet implement GDILibrary>>getPaletteEntries:"
+		^self asRGBUsingNoPalette].
+	^self asRGBUsingPalette: self defaultPalette!
+
+asRGBUsingNoPalette
+	"Answer the receiver as an RGB  when no palette is available ."
+
+	| colorNameMap stdColorName |
+	#wineFix.
+	colorNameMap := LookupTable new.
+	#(#(#black 16r1000000) #(#darkRed 16r1000001) #(#darkGreen 16r1000002) #(#brown 16r1000003) #(#darkBlue 16r1000004) #(#darkMagenta 16r1000005) #(#darkCyan 16r1000006) #(#gray 16r1000007) #(#darkGray 16r100000C) #(#red 16r100000D) #(#green 16r100000E) #(#yellow 16r100000F) #(#blue 16r1000010) #(#magenta 16r1000011) #(#cyan 16r1000012) #(#white 16r1000013)) 
+		do: [:each | colorNameMap at: each second put: each first].
+	stdColorName := colorNameMap at: index.
+	^RGB stdColor: stdColorName!
 
 asRGBUsingPalette: anExternalHandle 
 	"Answer the <RGB> equivalent of the receiver as mapped in the palette with the specified
@@ -105,7 +118,8 @@ setIndex: anInteger
 !IndexedColor categoriesFor: #=!comparing!public! !
 !IndexedColor categoriesFor: #asIndexedColor!converting!public! !
 !IndexedColor categoriesFor: #asParameter!converting!public! !
-!IndexedColor categoriesFor: #asRGB!converting!public! !
+!IndexedColor categoriesFor: #asRGB!converting!public!wine fix! !
+!IndexedColor categoriesFor: #asRGBUsingNoPalette!converting!public!wine fix! !
 !IndexedColor categoriesFor: #asRGBUsingPalette:!converting!public! !
 !IndexedColor categoriesFor: #hash!comparing!public! !
 !IndexedColor categoriesFor: #index!accessing!public! !

Core/Object Arts/Dolphin/MVP/Base/InternalDragDropSession.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6"!
+"Filed out from Dolphin Smalltalk 7"!
 
 DragDropSession subclass: #InternalDragDropSession
 	instanceVariableNames: 'lastImageKey imageList oldCursor dragButton operationDescriptions'
@@ -138,6 +138,23 @@ giveFeedback
 	(imageKey := self imageKey) ~~ lastImageKey 
 		ifTrue: 
 			[| dragIm |
+			NTLibrary isWine 
+				ifTrue: 
+					[| cursorSelector |
+					#wineFix.
+					"Wine doesn't appear to support setting drag cursors
+					from image lists. Until available we fall back to using the
+					old (non-specific) drag and drop cursors"
+					cursorSelector := ##((LookupTable new)
+								at: #none put: #ddNone;
+								at: #move put: #ddMove;
+								at: #copy put: #ddCopy;
+								at: #copyScroll put: #ddCopyScroll;
+								at: #moveScroll put: #ddMoveScroll;
+								at: #linkScroll put: #ddLinkScroll;
+								yourself) at: self imageKey.
+					(Cursor perform: cursorSelector) makeCurrent.
+					lastImageKey := imageKey].
 			dragIm := dragImages at: imageKey.
 			imageList 
 				setDragCursorImage: dragIm key
@@ -245,7 +262,7 @@ startTrackingAt: aPoint
 !InternalDragDropSession categoriesFor: #dropTargetUnder:!helpers!private!tracking! !
 !InternalDragDropSession categoriesFor: #endTrackingAt:!public!tracking! !
 !InternalDragDropSession categoriesFor: #getExtendedOperation!operations!private! !
-!InternalDragDropSession categoriesFor: #giveFeedback!operations!private! !
+!InternalDragDropSession categoriesFor: #giveFeedback!operations!private!wine fix! !
 !InternalDragDropSession categoriesFor: #hideDragImage!operations!public! !
 !InternalDragDropSession categoriesFor: #isExtendedDrag!public!testing! !
 !InternalDragDropSession categoriesFor: #operationDescriptions!accessing!public! !

Core/Object Arts/Dolphin/MVP/Base/View.cls

@@ -422,6 +422,11 @@ beForeground
 beNotThemed
 	"Turns off any visual theme for the receiver. Only effective on Windows XP and above"
 
+	NTLibrary isWine ifTrue: [
+		"Wine currently errors on this, so ignore"
+		#wineFix.
+		^self].
+
 	ThemeLibrary default 
 		setWindowTheme: self handle
 		pszSubAppName: '' asUnicodeString
@@ -4401,7 +4406,7 @@ zOrderTop
 !View categoriesFor: #beCentered!operations!public! !
 !View categoriesFor: #beDefaultThemed!modes!public! !
 !View categoriesFor: #beForeground!operations!public! !
-!View categoriesFor: #beNotThemed!modes!public! !
+!View categoriesFor: #beNotThemed!modes!public!wine fix! !
 !View categoriesFor: #beNotTopMost!operations!public! !
 !View categoriesFor: #bePopupFor:!operations!public! !
 !View categoriesFor: #beTopMost!operations!public! !

Core/Object Arts/Dolphin/MVP/Presenters/Text/Dolphin Text Presenter.pax

@@ -36,6 +36,7 @@ package globalAliases: (Set new
 
 package setPrerequisites: (IdentitySet new
 	add: '..\..\..\Base\Dolphin';
+	add: '..\..\..\Base\Dolphin Base';
 	add: '..\..\Dialogs\Common\Dolphin Common Dialogs';
 	add: '..\..\Base\Dolphin MVP Base';
 	add: '..\..\Type Converters\Dolphin Type Converters';

Core/Object Arts/Dolphin/MVP/Presenters/Text/TextEdit.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6.2"!
+"Filed out from Dolphin Smalltalk 7"!
 
 ValueConvertingControlView subclass: #TextEdit
 	instanceVariableNames: 'teFlags'
@@ -1066,6 +1066,11 @@ setAlignment: anInteger
 
 setMarginWidths: anArray 
 	| margins |
+	NTLibrary isWine 
+		ifTrue: 
+			["Wine doesn't yet implement EM_SETMARGINS "
+			#wineFix.
+			^self].
 	margins := (DWORD new)
 				highWord: anArray first;
 				lowWord: anArray last.
@@ -1387,7 +1392,7 @@ wmSetFocus: message wParam: wParam lParam: lParam
 !TextEdit categoriesFor: #selectionStart:length:!public!selection! !
 !TextEdit categoriesFor: #selectLine:!public!selection! !
 !TextEdit categoriesFor: #setAlignment:!modes!private! !
-!TextEdit categoriesFor: #setMarginWidths:!accessing!private! !
+!TextEdit categoriesFor: #setMarginWidths:!accessing!private!wine fix! !
 !TextEdit categoriesFor: #setReadOnly:!modes!private! !
 !TextEdit categoriesFor: #state!accessing!private! !
 !TextEdit categoriesFor: #suggestedFindText!helpers!private! !

Core/Object Arts/Dolphin/MVP/Views/Common Controls/Dolphin Common Controls.pax

@@ -63,6 +63,7 @@ package globalAliases: (Set new
 
 package setPrerequisites: (IdentitySet new
 	add: '..\..\..\Base\Dolphin';
+	add: '..\..\..\Base\Dolphin Base';
 	add: '..\..\Presenters\Folder\Dolphin Folder Presenter';
 	add: '..\..\Models\List\Dolphin List Models';
 	add: '..\..\Presenters\List\Dolphin List Presenter';

Core/Object Arts/Dolphin/MVP/Views/Common Controls/ListView.cls

@@ -803,6 +803,13 @@ imageFromRow: item
 	where the list does not have images."
 
 	self viewMode == #thumbnails ifTrue: [^self getThumbnailOf: item].
+
+	NTLibrary isWine ifTrue: [
+		#wineFix.
+		"Wine ListViews seem to expect image indices to always be set in ListView>>onDisplayDetailsRequired:, 
+		even if we don't want images to appear. Normally, we answer nil here if no image is required. 
+		In Wine we must answer an image index of 0"
+		getImageBlock ifNil: [^0]].
 	^self getImageBlock isNil ifFalse: [getImageBlock value: item]!
 
 indentFromRow: item
@@ -1818,6 +1825,15 @@ selectIndex: anInteger set: aBoolean
 	| anLvItem mask |
 	anLvItem := LVITEM new.
 	mask := ##(LVIS_SELECTED | LVIS_FOCUSED).
+	NTLibrary isWine 
+		ifTrue: 
+			["Having autoSelectPackages option turned on in System Browser gives
+			unpleasant scrolling effect when many multiple packages are selected. This
+			also happens in Package Browser. Problem under Wine traced to LVIS_FOCUSED
+			option in ListView>>selectIndex:. Not sure what overall effect it will have
+			turning this off."
+			#wineFix.
+			mask := mask maskClear: LVIS_FOCUSED].
 	anLvItem stateMask: mask.
 	aBoolean ifTrue: [anLvItem dwState: mask].
 	self lvmSetItem: anInteger - 1 state: anLvItem!
@@ -2209,7 +2225,7 @@ wantCustomDrawItemNotifications: pNMHDR
 !ListView categoriesFor: #hideDropHighlight!drag & drop!private! !
 !ListView categoriesFor: #iconSpacing!accessing!public! !
 !ListView categoriesFor: #iconSpacing:!accessing!public! !
-!ListView categoriesFor: #imageFromRow:!adapters!private! !
+!ListView categoriesFor: #imageFromRow:!adapters!private!wine fix! !
 !ListView categoriesFor: #indentFromRow:!adapters!private! !
 !ListView categoriesFor: #infoTipFromRow:withPrefix:!adapters!private! !
 !ListView categoriesFor: #initialize!initializing!private! !
@@ -2324,7 +2340,7 @@ wantCustomDrawItemNotifications: pNMHDR
 !ListView categoriesFor: #revertSelection!helpers!private!selection! !
 !ListView categoriesFor: #selectAll!public!selection! !
 !ListView categoriesFor: #selectedCount!private!selection! !
-!ListView categoriesFor: #selectIndex:set:!private!selection! !
+!ListView categoriesFor: #selectIndex:set:!private!selection!wine fix! !
 !ListView categoriesFor: #selectionByIndex:ifAbsent:!public!selection! !
 !ListView categoriesFor: #selectionFromPoint:!event handling!private! !
 !ListView categoriesFor: #selections:ifAbsent:!public!selection! !

Core/Object Arts/Dolphin/MVP/Views/Common Controls/ListViewColumn.cls

@@ -1,4 +1,4 @@
-"Filed out from Dolphin Smalltalk X6"!
+"Filed out from Dolphin Smalltalk 7"!
 
 Object subclass: #ListViewColumn
 	instanceVariableNames: 'text width alignment getTextBlock getSortValueBlock getContentsBlock name parent getImageBlock flags getInfoTipBlock customDrawBlock'
@@ -203,8 +203,15 @@ imageFromRow: item
 	As of Dolphin 3.0 the image block is permitted to be nil for the common case
 	where the columns does not have images."
 
+	NTLibrary isWine ifTrue: [
+		#wineFix.
+		"Wine ListViews seem to expect image indices to always be set in ListView>>onDisplayDetailsRequired:, 
+		even if we don't want images to appear. Normally, we answer nil here if no image is required. 
+		In Wine we must answer an image index of 0"
+		getImageBlock ifNil: [^0]].
+
 	^getImageBlock isNil ifFalse: [
-		getImageBlock value: (self contentFromRow: item)]
+		getImageBlock value: (self contentFromRow: item)].
 !
 
 index
@@ -428,7 +435,7 @@ width: anInteger
 !ListViewColumn categoriesFor: #getTextBlock!adapters!public! !
 !ListViewColumn categoriesFor: #getTextBlock:!adapters!public! !
 !ListViewColumn categoriesFor: #headerIcon:!helpers!private! !
-!ListViewColumn categoriesFor: #imageFromRow:!adapters!private! !
+!ListViewColumn categoriesFor: #imageFromRow:!adapters!private!wine fix! !
 !ListViewColumn categoriesFor: #index!accessing!public! !
 !ListViewColumn categoriesFor: #infoTipFromRow:withPrefix:!adapters!private! !
 !ListViewColumn categoriesFor: #initialize!initializing!private! !