Remove insecure CollectionPresenter default add item prompt (uses compiler)

Core/DolphinVM/DevRes.vcxproj

@@ -308,6 +308,9 @@
     <Image Include="Res\MethodHistory.ico" />
     <Image Include="Res\MethodHistoryErase.ico" />
     <Image Include="Res\MethodSource.ico" />
+    <Image Include="Res\MoveDown.ico" />
+    <Image Include="Res\MoveFirst.ico" />
+    <Image Include="Res\MoveLast.ico" />
     <Image Include="Res\MoveUp.ico" />
     <Image Include="Res\Namespace.ico" />
     <Image Include="Res\NewIdeaSpaceShell.ico" />

Core/DolphinVM/DevRes.vcxproj.filters

@@ -1048,6 +1048,15 @@
     <Image Include="Res\MethodDelete.ico">
       <Filter>Icons</Filter>
     </Image>
+    <Image Include="Res\MoveDown.ico">
+      <Filter>Icons</Filter>
+    </Image>
+    <Image Include="Res\MoveFirst.ico">
+      <Filter>Icons</Filter>
+    </Image>
+    <Image Include="Res\MoveLast.ico">
+      <Filter>Icons</Filter>
+    </Image>
   </ItemGroup>
   <ItemGroup>
     <None Include="Res\hsplit.cur">

Core/DolphinVM/devres.rc

@@ -347,6 +347,11 @@ MOENTREEVIEW.ICO        ICON                    "Res\\MoenTreeView.ico"
 
 MOUSETRACKER.ICO        ICON                    "Res\\MouseTracker.ico"
 
+MOVEDOWN.ICO			ICON                    "Res\\MoveDown.ico"
+MOVEFIRST.ICO			ICON                    "Res\\MoveFirst.ico"
+MOVELAST.ICO			ICON                    "Res\\MoveLast.ico"
+MOVEUP.ICO				ICON                    "Res\\MoveUp.ico"
+
 MUTEX.ICO               ICON                    "Res\\Mutex.ico"
 
 NAMESPACE.ICO           ICON                    "Res\\Namespace.ico"

Core/Object Arts/Dolphin/ActiveX/Components/WebView2/WebView2.Tests.WebView2ViewTest.cls

@@ -87,6 +87,7 @@ tearDown
 testContextMenu
 	<knownSlowTest>
 	<skipIf: #isCiBuild> "Too unreliable"
+	<skipUnless: #isInForeground>
 	| contextMenuHandler menuEvent newCmd iconStream cmdEventSink cmdFired |
 	iconStream := IStream read: (FileLocator installRelative: 'Resources\Dolphin.ico') asString.
 	newCmd := presenter view webviewEnvironment

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

@@ -734,6 +734,10 @@ getCurrentProcess
 	<stdcall: handle GetCurrentProcess>
 	^self invalidCall: _failureCode!
 
+getCurrentProcessId
+	<stdcall: uint32 GetCurrentProcessId>
+	^self invalidCall: _failureCode!
+
 getCurrentThread
 	"Answer the handle of the current thread
 
@@ -2149,6 +2153,7 @@ getCPInfoExW:dwFlags:lpCPInfoEx:!**auto generated**!public!win32 functions-natio
 getCurrentDirectory!public!win32 functions-directory management! !
 getCurrentDirectory:lpBuffer:!public!win32 functions-directory management! !
 getCurrentProcess!public!win32 functions-process and thread! !
+getCurrentProcessId!public!win32 functions-process and thread! !
 getCurrentThread!public!win32 functions-process and thread! !
 getCurrentThreadId!public!win32 functions-process and thread! !
 getDiskFreeSpace:lpSectorsPerCluster:lpBytesPerSector:lpNumberOfFreeClusters:lpTotalNumberOfClusters:!public!win32 functions-file management! !

Core/Object Arts/Dolphin/IDE/Base/Development System.pax

@@ -853,6 +853,7 @@ package setPrerequisites: #(
 	'..\..\MVP\Views\GroupBox\Dolphin GroupBox'
 	'..\..\MVP\Presenters\Image\Dolphin Image Presenter'
 	'..\..\MVP\Presenters\Prompters\Dolphin Integer Prompter'
+	'..\..\MVP\Presenters\Prompters\Dolphin Key-Value Prompter'
 	'..\..\Base\Dolphin Legacy Date & Time'
 	'..\..\MVP\Models\List\Dolphin List Models'
 	'..\..\MVP\Presenters\List\Dolphin List Presenter'

Core/Object Arts/Dolphin/IDE/Base/Tools.Aspect.cls

@@ -532,7 +532,11 @@ collection: aCollectionAspectSymbol addFrom: anArray
 collection: aSymbol presenterClass: aClass
 	^(self
 		name: aSymbol
-		presenterBlock: [:p :m | aClass createIn: p on: m]
+		presenterBlock: 
+			[:p :m |
+			(aClass createIn: p on: m)
+				setAddItemBlock: [Smalltalk developmentSystem promptForExpression: 'Evaluate:' caption: 'Add Item'];
+				yourself]
 		editBlock: self defaultCollectionEditBlock)
 		type: Collection;
 		yourself!
@@ -601,7 +605,16 @@ dictionary: aSymbol
 	"Answer an instance of the receiver for the <Dictionary> aspect named by the <Symbol> 
 	argument . The aspect is displayed using a DictionaryPresenter"
 
-	^(self collection: aSymbol presenterClass: DictionaryPresenter)
+	^(self
+		name: aSymbol
+		presenterBlock: 
+			[:p :m |
+			(DictionaryPresenter createIn: p on: m)
+				setAddItemBlock: 
+						[Smalltalk developmentSystem promptForKeyValuePair: 'Enter key and value expressions:'
+							caption: 'Add to Dictionary…'];
+				yourself]
+		editBlock: self defaultCollectionEditBlock)
 		type: Dictionary;
 		yourself!
 

Core/Object Arts/Dolphin/IDE/Base/Tools.SmalltalkSystem.cls

@@ -2045,12 +2045,6 @@ instVarReaderFilter: aString in: startClass
 	(each methodClass includesBehavior: startClass)
 		and: [[each readsInstVar: aString] on: NotFoundError do: [:e | false]]]!
 
-instVarWriterFilter: aString in: startClass
-	^
-	[:each |
-	(each methodClass includesBehavior: startClass)
-		and: [[each writesInstVar: aString] on: NotFoundError do: [:e | false]]]!
-
 interruptHotKey
 	"Answer the <integer> HOTKEYF_XXX|VK_XXX code used by the VM as the break/interrupt key,
 	e.g. VK_CANCEL (Ctrl+Break)"
@@ -3146,6 +3140,35 @@ promptForClassVarName: nameString in: aClass prompt: promptString caption: capti
 promptForDefinitionsOf: aString in: aBrowserEnvironment
 	^self promptForSelector: aString caption: 'Definitions of message in <1p>…' << aBrowserEnvironment!
 
+promptForExpression: promptString caption: captionString
+	| result text |
+	result := nil.
+	text := '' asValue.
+
+	[| expression |
+	expression := Prompter
+				on: text
+				prompt: promptString
+				caption: captionString.
+	expression notNil and: 
+			[| error |
+
+			[result := Compiler evaluate: expression.
+			error := nil] on: Compiler errorClass , Error
+					do: 
+						[:ex |
+						error := ex.
+						ex return: nil].
+			error notNil and: 
+					[(MessageBox new
+						buttonStyle: #yesNo;
+						iconStyle: #error;
+						caption: 'Error evaluating expression…';
+						headline: error displayString;
+						errorMsg: 'Try again?') == #yes]]]
+			whileTrue.
+	^result!
+
 promptForInstVarName: nameString in: aClass prompt: promptString caption: captionString
 	| newName |
 	newName := (Prompter
@@ -3157,6 +3180,37 @@ promptForInstVarName: nameString in: aClass prompt: promptString caption: captio
 				showModal.
 	^newName!
 
+promptForKeyValuePair: promptString caption: captionString
+	| pair result |
+	pair := Association new.
+
+	[(KeyValuePrompter
+		createOn: pair
+		prompt: promptString
+		caption: captionString) showModal
+		notNil and: 
+				[| error |
+				error := nil.
+				result := 
+						[| key value |
+						key := Compiler evaluate: pair key.
+						value := Compiler evaluate: pair value.
+						self value newAssociation: key value: value]
+								on: Compiler errorClass , Error
+								do: 
+									[:ex |
+									error := ex.
+									ex return: nil].
+				error notNil and: 
+						[(MessageBox new
+							buttonStyle: #yesNo;
+							iconStyle: #error;
+							caption: 'Error evaluating expression…';
+							headline: error displayString;
+							errorMsg: 'Try again?') == #yes]]]
+			whileTrue.
+	^result!
+
 promptForReferencesTo: aString in: aBrowserEnvironment
 	^self promptForSelector: aString caption: 'References to message in <1p>…' << aBrowserEnvironment!
 
@@ -4506,7 +4560,6 @@ inspectVisualObject!commands!public! !
 installPackage:!commands!private! !
 instVarAccessFilter:in:!helpers!private! !
 instVarReaderFilter:in:!helpers!private! !
-instVarWriterFilter:in:!helpers!private! !
 interruptHotKey!options!public! !
 interruptHotKey:!options!public! !
 isOAD!accessing!private!product! !
@@ -4602,12 +4655,14 @@ printSignatureForKeywordsAndArgs:on:!autocompletion!helpers!private! !
 privateMethodIcon!constants!private! !
 privatePrefix!constants!private! !
 privatizeMethod:!operations!private! !
-promptForClass!enquiries!public! !
-promptForClassIn:!enquiries!public! !
+promptForClass!commands!public! !
+promptForClassIn:!commands!public! !
 promptForClassName:!helpers!private! !
 promptForClassVarName:in:prompt:caption:!helpers!private!refactoring! !
 promptForDefinitionsOf:in:!browsing!commands!private! !
+promptForExpression:caption:!commands!public! !
 promptForInstVarName:in:prompt:caption:!helpers!private! !
+promptForKeyValuePair:caption:!commands!public! !
 promptForReferencesTo:in:!commands!private! !
 promptForReferencesToGlobal:in:!browsing!private! !
 promptForSearchString:caption:!browsing!commands!private! !

Core/Object Arts/Dolphin/MVP/Base/Dolphin MVP Base.pax

@@ -234,6 +234,7 @@ package setMethodNames: #(
 	#(#{OS.UserLibrary} #isChild:hWnd:)
 	#(#{OS.UserLibrary} #isClipboardFormatAvailable:)
 	#(#{OS.UserLibrary} #isDialogMessage:lpMsg:)
+	#(#{OS.UserLibrary} #isForegroundProcess:)
 	#(#{OS.UserLibrary} #isIconic:)
 	#(#{OS.UserLibrary} #isWindowUnicode:)
 	#(#{OS.UserLibrary} #isZoomed:)
@@ -3218,6 +3219,15 @@ isDialogMessage: aHandle lpMsg: aMSG
 	<stdcall: bool IsDialogMessageW handle MSG*>
 	^self invalidCall: _failureCode!
 
+isForegroundProcess: anInteger
+	| hWnd |
+	hWnd := self getForegroundWindow.
+	^hWnd notNil and: 
+			[| foregroundPid |
+			foregroundPid := UInt32Bytes new.
+			(self getWindowThreadProcessId: hWnd lpdwProcessId: foregroundPid) ~~ 0
+				and: [foregroundPid = anInteger]]!
+
 isIconic: aWindowHandle
 	"Answer whether the specified window is iconic (minimized). 
 		BOOL IsIconic(
@@ -3891,6 +3901,7 @@ invalidateRgn:hRgn:bErase:!public!win32 functions-painting and drawing! !
 isChild:hWnd:!public!win32 functions-window! !
 isClipboardFormatAvailable:!public!win32 functions-clipboard! !
 isDialogMessage:lpMsg:!public!win32 functions-dialog box! !
+isForegroundProcess:!enquiries!public! !
 isIconic:!public!win32 functions-icon! !
 isWindowUnicode:!public!win32 functions-window!win32 functions-window procedure! !
 isZoomed:!public!win32 functions-window! !

Core/Object Arts/Dolphin/MVP/Base/UI.GUISessionManager.cls

@@ -81,6 +81,11 @@ disableWindowGhosting
 inputStateClass
 	^GuiInputState!
 
+isForegroundProcess
+	"Answer whether this Dolphin process owns the foreground window"
+
+	^User32 isForegroundProcess: Kernel32 getCurrentProcessId!
+
 isUnattended
 	"Answer whether the session was started with a unattended flag"
 
@@ -205,6 +210,7 @@ clearWindowState!operations-saving!private! !
 commandLineParser!helpers!private! !
 disableWindowGhosting!helpers!public! !
 inputStateClass!constants!private! !
+isForegroundProcess!public!testing! !
 isUnattended!public!testing! !
 onInputLanguageChanged:!event handling!private! !
 onSettingChanged:!event handling!private! !

Core/Object Arts/Dolphin/MVP/Presenters/Collection/Dolphin Collection Presenters.pax

@@ -26,15 +26,11 @@ package setPrerequisites: #(
 	'..\..\Views\Common Controls\Dolphin Common Controls'
 	'..\..\Views\Control Bars\Dolphin Control Bars'
 	'..\..\Graphics\Dolphin GDI Graphics'
-	'..\Prompters\Dolphin Key-Value Prompter'
 	'..\..\Models\List\Dolphin List Models'
 	'..\List\Dolphin List Presenter'
 	'..\..\..\System\Filer\Dolphin Literal Filer'
-	'..\..\..\System\Win32\MessageBox\Dolphin Message Box'
 	'..\..\Base\Dolphin MVP Base'
-	'..\Prompters\Dolphin Prompter'
 	'..\..\..\System\Filer\Dolphin STx Filer Core'
-	'..\..\Icons\Dolphin Text Tile Icons'
 ).
 
 package!
@@ -82,7 +78,7 @@ resource_List_tools
 	Tools.ViewComposer openOn: (UI.ResourceIdentifier class: self selector: #resource_List_tools)
 	"
 
-	^#(#'!!STL' 6 2118 10 #{UI.STBViewProxy} #{UI.Toolbar} 38 #{Core.Array} 28 nil nil 50 2 8 1409289036 131137 32 nil 6 #{Graphics.Color} #face3d nil 517 nil nil nil 32 114 #default nil 518 #{Kernel.STBIdentityDictionaryProxy} #{Core.IdentityDictionary} 8 #() nil nil nil nil 50 8 1094 1 #{UI.ToolbarIconButton} 32 1 1350 4 #{UI.CommandDescription} #addItem 8 'New Item' 1 1 838 4 #{Graphics.Icon} nil true 1030 #{Graphics.ImageFromStringResourceInitializer} 8 'NewThing.ico' 838 1 #{External.ResourceLibrary} 8 'dolphindr8.dll' 65541 nil nil 226 32 1 258 #removeItem 8 'Delete Item' 1 1 306 nil true 338 8 'EditClear.ico' 400 65541 nil nil 582 1 #{UI.ToolbarSeparator} 32 1 226 32 1 258 #moveFirst 8 'Move First' 1 1 2374 2 #{Graphics.TextTileIcon} 8 $⏮ 8 'Georgia' nil 114 #highlight nil nil 3 nil nil nil 226 32 1 258 #moveUp 8 'Move Up' 1 1 610 8 $▲ 8 'Segoe UI' nil 672 nil nil 1 nil nil nil 226 32 1 258 #moveDown 8 'Move Down' 1 1 610 8 $▼ nil nil 672 nil nil 1 nil nil nil 226 32 1 258 #moveLast 8 'Move Last' 1 1 610 8 $⏭ 8 'Georgia' nil 672 nil nil 3 nil nil nil 530 32 1 nil nil 1 nil nil nil nil nil 262 #{Core.MessageSequence} 50 1 774 #{Core.MessageSend} #createAt:extent: 50 2 518 #{Graphics.Point} 6143 21 1074 321 51 32 262 #{OS.WINDOWPLACEMENT} 8 #[44 0 0 0 0 0 0 0 1 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 11 0 0 10 0 0 0 159 12 0 0 35 0 0 0] 8 #() 1074 193 193 nil 29)! !
+	^#(#'!!STL' 6 2118 10 #{UI.STBViewProxy} #{UI.Toolbar} 38 #{Core.Array} 28 nil nil 50 2 8 1409289036 131137 32 nil 6 #{Graphics.Color} #face3d nil 517 nil nil nil 32 114 #default nil 518 #{Kernel.STBIdentityDictionaryProxy} #{Core.IdentityDictionary} 8 #() nil nil nil nil 50 8 1094 1 #{UI.ToolbarIconButton} 32 1 1350 4 #{UI.CommandDescription} #addItem 8 'New Item' 1 1 838 4 #{Graphics.Icon} nil true 1030 #{Graphics.ImageFromStringResourceInitializer} 8 'NewThing.ico' 838 1 #{External.ResourceLibrary} 8 'dolphindr8.dll' 65541 nil nil 226 32 1 258 #removeItem 8 'Delete Item' 1 1 306 nil true 338 8 'EditClear.ico' 400 65541 nil nil 582 1 #{UI.ToolbarSeparator} 32 1 226 32 1 258 #moveFirst 8 'Move First' 1 1 306 nil true 338 8 'MoveFirst.ico' 400 65541 nil nil 226 32 1 258 #moveUp 8 'Move Up' 1 1 306 nil true 338 8 'MoveUp.ico' 400 65541 nil nil 226 32 1 258 #moveDown 8 'Move Down' 1 1 306 nil true 338 8 'MoveDown.ico' 400 65541 nil nil 226 32 1 258 #moveLast 8 'Move Last' 1 1 306 nil true 338 8 'MoveLast.ico' 400 65541 nil nil 530 32 1 nil nil 1 nil nil nil nil nil 262 #{Core.MessageSequence} 50 1 774 #{Core.MessageSend} #createAt:extent: 50 2 518 #{Graphics.Point} 6143 21 1058 321 51 32 262 #{OS.WINDOWPLACEMENT} 8 #[44 0 0 0 0 0 0 0 1 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 11 0 0 10 0 0 0 159 12 0 0 35 0 0 0] 8 #() 1058 193 193 nil 29)! !
 !UI.Toolbar class categoriesForMethods!
 resource_List_tools!public!resources-views! !
 !

Core/Object Arts/Dolphin/MVP/Presenters/Collection/UI.CollectionPresenter.cls

@@ -19,12 +19,9 @@ Instance Variables:
 addItem
 	"Uses the receiver's addItemBlock to answer a new item to add to the collection"
 
-	<commandQuery: #canAddOrRemoveItems>
-	self canAddOrRemoveItems
-		ifTrue: 
-			[| item |
-			item := addItemBlock notNil ifTrue: [addItemBlock value] ifFalse: [self defaultAddItem].
-			item notNil ifTrue: [self addItem: item]]
+	<commandQuery: #canAddItem>
+	self canAddItem
+		ifTrue: [addItemBlock value ifNotNil: [:item | self addItem: item]]
 		ifFalse: [Sound errorBeep]!
 
 addItem: anObject
@@ -33,6 +30,11 @@ addItem: anObject
 	self listModel add: anObject
 	!
 
+canAddItem
+	"Private - Answer true if it is valid to add elements to the receiver's collection"
+
+	^addItemBlock notNil and: [self canAddOrRemoveItems]!
+
 canAddOrRemoveItems
 	"Private - Answer true if it is valid to add and remove elements of the receiver's collection"
 
@@ -70,11 +72,6 @@ createSchematicWiring
 		send: #onSelectionChanged
 		to: self!
 
-defaultAddItem
-	"Private - Prompts to add an item to the receiver. Used if no addItemBlock has been specified"
-
-	^self promptForExpression: 'Evaluate:' caption: 'Add Item'!
-
 initialize
 	changing := false.
 	flags := 0.
@@ -125,35 +122,6 @@ onValueChanged
 	listPresenter list: self value asOrderedCollection] 
 			ensure: [changing := false]!
 
-promptForExpression: promptString caption: captionString
-	| result text |
-	result := nil.
-	text := '' asValue.
-
-	[| expression |
-	expression := Prompter
-				on: text
-				prompt: promptString
-				caption: captionString.
-	expression notNil and: 
-			[| error |
-
-			[result := Compiler evaluate: expression.
-			error := nil] on: Compiler errorClass , Error
-					do: 
-						[:ex |
-						error := ex.
-						ex return: nil].
-			error notNil and: 
-					[(MessageBox new
-						buttonStyle: #yesNo;
-						iconStyle: #error;
-						caption: 'Error evaluating expression…';
-						headline: error displayString;
-						errorMsg: 'Try again?') == #yes]]]
-			whileTrue.
-	^result!
-
 removeItem
 	"Removes the current selection from the receiver's list"
 
@@ -182,11 +150,11 @@ setAddItemBlock: aNiladicValuable
 !UI.CollectionPresenter categoriesForMethods!
 addItem!commands-actions!public! !
 addItem:!operations!public! !
-canAddOrRemoveItems!private!testing! !
-canRemoveItem!private!testing! !
+canAddItem!commands-queries!private!testing! !
+canAddOrRemoveItems!commands-queries!private!testing! !
+canRemoveItem!commands-queries!private!testing! !
 createComponents!initializing!public! !
 createSchematicWiring!initializing!public! !
-defaultAddItem!helpers!private! !
 initialize!initializing!public! !
 isReadOnly!public!testing! !
 isReadOnly:!modes!public! !
@@ -196,7 +164,6 @@ model:!accessing!public! !
 onListChanged!event handling!private! !
 onSelectionChanged!public! !
 onValueChanged!event handling!private! !
-promptForExpression:caption:!helpers!private! !
 removeItem!commands-actions!operations!public! !
 selectionOrNil!public!selection! !
 selectionOrNil:!public!selection! !