Spec synchronisation.

Fixes #3385

Partial changelog:
- Add tests
- Improve robustness of some tests
- Make transmissions an independent package
- Begin to work on commands (WIP)
- Clean API of some presenters (such as lists)
- Work on context menu of Text presenter and table presenter
- Drop box list items can now be sorted
- Proceed the decomposition of Text and Code presenters
- Replace some variables and value holder by observable slots
- Improve demos
- Table columns are now expendables
- ...

src/BaselineOfSpec/BaselineOfSpec.class.st

@@ -16,19 +16,29 @@ BaselineOfSpec >> baseline: spec [
 			spec baseline: 'ParametrizedTests' with: [ spec repository: repository ].
 
 			spec
-				package: 'Spec-Core' with: [ spec requires: #('Spec-Layout') ];
-				package: 'Spec-Deprecated80' with: [ spec requires: #('Spec-Tests' 'Spec-MorphicAdapters') ];
+				package: 'Spec-Core' with: [ spec requires: #('Spec-Layout' 'Spec-Commands') ];
+				package: 'Spec-Commands';
+				package: 'Spec-Deprecated80' with: [ spec requires: #('Spec-Tests' 'Spec-PolyWidgets-Tests' 'Spec-MorphicAdapters') ];
 				package: 'Spec-Deprecated' with: [ spec requires: #('Spec-Core' 'Spec-Deprecated80' 'Spec-PolyWidgets' 'Spec-MorphicAdapters') ];
 
 				package: 'Spec-Inspector' with: [ spec requires: #('Spec-PolyWidgets') ];
 				package: 'Spec-Layout';
+				package: 'Spec-Transmission';
 				package: 'Spec-MorphicAdapters' with: [ spec requires: #('Spec-Core') ];
-				package: 'Spec-PolyWidgets' with: [ spec requires: #('Spec-Core') ];
+				package: 'Spec-PolyWidgets' with: [ spec requires: #('Spec-Core' 'Spec-Transmission') ];
 				package: 'Spec-Tools' with: [ spec requires: #('Spec-PolyWidgets') ];
 				package: 'Spec-StubAdapter' with: [ spec requires: #('Spec-Core') ];
 				package: 'Spec-Examples' with: [ spec requires: #('Spec-Tools' 'Spec-Inspector') ];
 				package: 'Spec-Tests' with: [ spec requires: #('Spec-PolyWidgets' 'Spec-Examples') ];
+				package: 'Spec-PolyWidgets-Tests' with: [ spec requires: #('Spec-Tests' 'Spec-PolyWidgets') ];
 				package: 'Spec-MorphicBackendTests' with: [ spec requires: #('Spec-MorphicAdapters' 'ParametrizedTests' 'Spec-BackendTests') ];
 				package: 'Spec-BackendTests' with: [ spec requires: #('Spec-MorphicAdapters' 'ParametrizedTests') ];
 				package: 'Spec-CompatibilityTests' with: [ spec requires: #('Spec-MorphicBackendTests' 'Spec-Deprecated80') ] ]
 ]
+
+{ #category : #accessing }
+BaselineOfSpec >> project [
+	^ super project
+		loadType: #atomic;
+		yourself
+]

src/Spec-BackendTests/AbstractAdapterTestCase.class.st

@@ -124,7 +124,7 @@ AbstractAdapterTestCase >> runCase [
 
 { #category : #running }
 AbstractAdapterTestCase >> setUp [
-	super setUp. "This super is useless but it's to make the release tests happy."
+	super setUp.	"This super is useless but it's to make the release tests happy."
 	self error: 'Do not override me.... use #initializeTestedInstance'
 ]
 

src/Spec-BackendTests/AbstractLayoutTestCase.class.st

@@ -77,9 +77,8 @@ AbstractLayoutTestCase >> runCase [
 
 { #category : #running }
 AbstractLayoutTestCase >> setUp [
-	super setUp. "This super is useless but it's to make the release tests happy."
+	super setUp.	"This super is useless but it's to make the release tests happy."
 	self error: 'Do not override me.... use #initializeTestedInstance'
-
 ]
 
 { #category : #running }

src/Spec-BackendTests/CodeAdapterTest.class.st

@@ -62,21 +62,20 @@ CodeAdapterTest >> testTextWithStyle [
 		behavior: nil;
 		doItReceiver: Object;
 		type: 'self asString.'.
-	self openInstance.
 
-	text := presenter adapter textWithStyle.
+	text := self adapter textWithStyle.
 	self assertText: text atInterval: "self" (1 to: 4) isStyle: #self.
 	self assertText: text atInterval: "asString" (6 to: 13) isStyle: #unary.
 
 	presenter type: '10 + 42.0'.
-	text := presenter adapter textWithStyle.
+	text := self adapter textWithStyle.
 	self assertText: text atInterval: "10" (1 to: 2) isStyle: #integer.
 	self assertText: text atInterval: "+" (4 to: 4) isStyle: #binary.
 	self assertText: text atInterval: "42.0" (6 to: 9) isStyle: #number.
 
 	presenter behavior: Object.
 	presenter type: 'm1 ^ "test" 42'.
-	text := presenter adapter textWithStyle.
+	text := self adapter textWithStyle.
 	self assertText: text atInterval: "m1" (1 to: 2) isStyle: #patternKeyword.
 	self assertText: text atInterval: "^" (4 to: 4) isStyle: #return.
 	self assertText: text atInterval: "test" (6 to: 11) isStyle: #comment.	

src/Spec-BackendTests/MorphicBackendForTest.class.st

@@ -9,7 +9,7 @@ Class {
 }
 
 { #category : #asserting }
-MorphicBackendForTest >> assertHasHeader: aFTTableMorph [ 
+MorphicBackendForTest >> assertHasHeader: aFTTableMorph [
 	self waitUntilUIRedrawed.
 
 	self assert: (aFTTableMorph instVarNamed: #showColumnHeaders)

src/Spec-BackendTests/NotebookAdapterTest.class.st

@@ -29,6 +29,14 @@ NotebookAdapterTest >> testClickOnPage [
 	self assert: self adapter selectedPageName equals: 'Mock2'
 ]
 
+{ #category : #tests }
+NotebookAdapterTest >> testRemoveAll [
+
+	self assert: self adapter numberOfTabs equals: 2.
+	presenter removeAll.
+	self assert: self adapter numberOfTabs equals: 0
+]
+
 { #category : #tests }
 NotebookAdapterTest >> testRemovePage [
 	| page |

src/Spec-BackendTests/TextAdapterTest.class.st

@@ -9,3 +9,33 @@ TextAdapterTest >> classToTest [
 
 	^ TextPresenter
 ]
+
+{ #category : #accessing }
+TextAdapterTest >> testKeyBindings [
+	| handled |
+
+	handled := false.
+	presenter 
+		bindKeyCombination: $t meta 
+		toAction: [ handled := true ].
+
+	self adapter 
+		keyPressed: $t asciiValue 
+		shift: false 
+		meta: true
+		control: false
+		option: false. 
+
+	self assert: handled
+]
+
+{ #category : #accessing }
+TextAdapterTest >> testRightClickShowsMenu [
+	| menu |
+
+	presenter contextMenu: (menu := SpecMockMenuPresenter new).
+
+	self deny: menu shown.
+	self emulateRightClick.
+	self assert: menu shown
+]

src/Spec-Commands/CmdMenu.extension.st

@@ -0,0 +1,10 @@
+Extension { #name : #CmdMenu }
+
+{ #category : #'*Spec-Commands' }
+CmdMenu >> buildContextMenu [
+	| menu |
+
+	menu := MenuPresenter new.
+	rootGroup buildContextMenu: menu.
+	^ menu
+]

src/Spec-Commands/CmdMenuCommandActivationStrategy.extension.st

@@ -0,0 +1,25 @@
+Extension { #name : #CmdMenuCommandActivationStrategy }
+
+{ #category : #'*Spec-Commands' }
+CmdMenuCommandActivationStrategy class >> buildContextKeyBindingsInContext: aToolContext [
+	| bindings |
+
+	bindings := Dictionary new.
+	CmdShortcutActivation 
+		visibleInstancesInContext: aToolContext
+		do: [ :activation | 
+			| activator |
+			activator := activation newActivatorFor: aToolContext.
+			bindings
+				at: activator activationStrategy keyCombination
+				put: [ activator executeCommand ] ].
+	^ bindings
+]
+
+{ #category : #'*Spec-Commands' }
+CmdMenuCommandActivationStrategy class >> buildContextMenuInContext: aToolContext [
+	| menu |
+
+	menu := self buildMenuInContext: aToolContext.
+	^ menu buildContextMenu
+]

src/Spec-Commands/CmdMenuGroup.extension.st

@@ -0,0 +1,11 @@
+Extension { #name : #CmdMenuGroup }
+
+{ #category : #'*Spec-Commands' }
+CmdMenuGroup >> inlineContextMenuItemsInto: aMenu [
+	self flag: #pharoFixMe. "This is an ugly hack because this part of Spec is still in development. Later this should be removed."
+	(aMenu isKindOf: Morph)
+		ifTrue: [ aMenu addLine.
+			contents do: [ :each | each buildContextMenu: aMenu ].
+			aMenu addLine ]
+		ifFalse: [ aMenu addGroup: [ :group | contents do: [ :each | each buildContextMenu: group ] ] ]
+]

src/Spec-Commands/MenuGroupPresenter.extension.st

@@ -0,0 +1,12 @@
+Extension { #name : #MenuGroupPresenter }
+
+{ #category : #'*Spec-Commands' }
+MenuGroupPresenter >> add: aName target: targetObject selector: aSelector [
+
+	self flag: #TODO. "This is for compatibility with the old menu builder and needs to be removed!"
+	self addItem: [ :item | 
+		item 
+			name: aName; 
+			action: [ targetObject perform: aSelector ] ].
+	^ self menuItems last
+]

src/Spec-Commands/MenuItemPresenter.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #MenuItemPresenter }
+
+{ #category : #'*Spec-Commands' }
+MenuItemPresenter >> keyText: aString [
+
+	self flag: #TODO. "This is for backward compatibility and needs to be removed!"
+	self shortcut: aString first meta
+]

src/Spec-Commands/SpecCodeCommand.class.st

@@ -0,0 +1,5 @@
+Class {
+	#name : #SpecCodeCommand,
+	#superclass : #CmdCommand,
+	#category : #'Spec-Commands-Code'
+}

src/Spec-Commands/SpecCodeContext.class.st

@@ -0,0 +1,5 @@
+Class {
+	#name : #SpecCodeContext,
+	#superclass : #CmdToolContext,
+	#category : #'Spec-Commands-Code'
+}

src/Spec-Commands/SpecCodeDebugItCommand.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #SpecCodeDebugItCommand,
+	#superclass : #SpecCodeSelectionCommand,
+	#category : #'Spec-Commands-Code'
+}
+
+{ #category : #activating }
+SpecCodeDebugItCommand class >> contextMenuActivation [
+	<classAnnotation>
+
+	^ CmdContextMenuActivation byRootGroupItemOrder: 40 for: SpecCodeContext
+]
+
+{ #category : #activating }
+SpecCodeDebugItCommand class >> shortcutActivation [
+	<classAnnotation>
+
+	^ CmdShortcutActivation 
+		by: $d shift meta
+		for: SpecCodeContext
+]
+
+{ #category : #accessing }
+SpecCodeDebugItCommand >> defaultMenuItemName [
+
+	^ 'Debug it'
+]
+
+{ #category : #execution }
+SpecCodeDebugItCommand >> execute [
+
+	'OK' crLog
+]

src/Spec-Commands/SpecCodeDoItCommand.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #SpecCodeDoItCommand,
+	#superclass : #SpecCodeSelectionCommand,
+	#category : #'Spec-Commands-Code'
+}
+
+{ #category : #activating }
+SpecCodeDoItCommand class >> contextMenuActivation [
+	<classAnnotation>
+
+	^ CmdContextMenuActivation byRootGroupItemOrder: 10 for: SpecCodeContext
+]
+
+{ #category : #activating }
+SpecCodeDoItCommand class >> shortcutActivation [
+	<classAnnotation>
+
+	^ CmdShortcutActivation 
+		by: $d meta
+		for: SpecCodeContext
+]
+
+{ #category : #accessing }
+SpecCodeDoItCommand >> defaultMenuItemName [
+
+	^ 'Do it'
+]
+
+{ #category : #execution }
+SpecCodeDoItCommand >> execute [
+
+	'OK' crLog
+]

src/Spec-Commands/SpecCodeInspectItCommand.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #SpecCodeInspectItCommand,
+	#superclass : #SpecCodeSelectionCommand,
+	#category : #'Spec-Commands-Code'
+}
+
+{ #category : #activating }
+SpecCodeInspectItCommand class >> contextMenuActivation [
+	<classAnnotation>
+
+	^ CmdContextMenuActivation byRootGroupItemOrder: 30 for: SpecCodeContext
+]
+
+{ #category : #activating }
+SpecCodeInspectItCommand class >> shortcutActivation [
+	<classAnnotation>
+
+	^ CmdShortcutActivation 
+		by: $i meta
+		for: SpecCodeContext
+]
+
+{ #category : #accessing }
+SpecCodeInspectItCommand >> defaultMenuItemName [
+
+	^ 'Inspect it'
+]
+
+{ #category : #execution }
+SpecCodeInspectItCommand >> execute [
+
+	'OK' crLog
+]

src/Spec-Commands/SpecCodePrintItCommand.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #SpecCodePrintItCommand,
+	#superclass : #SpecCodeSelectionCommand,
+	#category : #'Spec-Commands-Code'
+}
+
+{ #category : #activating }
+SpecCodePrintItCommand class >> contextMenuActivation [
+	<classAnnotation>
+
+	^ CmdContextMenuActivation byRootGroupItemOrder: 10 for: SpecCodeContext
+]
+
+{ #category : #activating }
+SpecCodePrintItCommand class >> shortcutActivation [
+	<classAnnotation>
+
+	^ CmdShortcutActivation 
+		by: $p meta
+		for: SpecCodeContext
+]
+
+{ #category : #accessing }
+SpecCodePrintItCommand >> defaultMenuItemName [
+
+	^ 'Print it'
+]
+
+{ #category : #execution }
+SpecCodePrintItCommand >> execute [
+
+	'OK' crLog
+]

src/Spec-Commands/SpecCodeProfileItCommand.class.st

@@ -0,0 +1,24 @@
+Class {
+	#name : #SpecCodeProfileItCommand,
+	#superclass : #SpecCodeSelectionCommand,
+	#category : #'Spec-Commands-Code'
+}
+
+{ #category : #activating }
+SpecCodeProfileItCommand class >> contextMenuActivation [
+	<classAnnotation>
+
+	^ CmdContextMenuActivation byRootGroupItemOrder: 50 for: SpecCodeContext
+]
+
+{ #category : #accessing }
+SpecCodeProfileItCommand >> defaultMenuItemName [
+
+	^ 'Profile it'
+]
+
+{ #category : #execution }
+SpecCodeProfileItCommand >> execute [
+
+	'OK' crLog
+]

src/Spec-Commands/SpecCodeSelectionCommand.class.st

@@ -0,0 +1,5 @@
+Class {
+	#name : #SpecCodeSelectionCommand,
+	#superclass : #SpecCodeCommand,
+	#category : #'Spec-Commands-Code'
+}

src/Spec-Commands/package.st

@@ -0,0 +1 @@
+Package { #name : #'Spec-Commands' }

src/Spec-Core/AbstractFormButtonPresenter.class.st

@@ -66,7 +66,7 @@ AbstractFormButtonPresenter >> enabled: aBoolean [
 
 { #category : #initialization }
 AbstractFormButtonPresenter >> initialize [
-	self class initializeSlots: self.
+
 	super initialize.
 
 	actionWhenActivatedHolder := [] asValueHolder.