Merge pull request #192 from OpenSmock/stash

OpenSmock · Jul 17, 2024 · 974a5fc · 974a5fc
2 parents 529a245 + 1731056
commit 974a5fc
Show file tree

Hide file tree

Showing 13 changed files with 2,216 additions and 27,155 deletions.
diff --git a/src/Pyramid-Bloc/PyramidBlElementHelper.class.st b/src/Pyramid-Bloc/PyramidBlElementHelper.class.st
diff --git a/src/Pyramid-Bloc/PyramidDrawOrderIcons.class.st b/src/Pyramid-Bloc/PyramidDrawOrderIcons.class.st
diff --git a/src/Pyramid-Bloc/PyramidSavePlugin.class.st b/src/Pyramid-Bloc/PyramidSavePlugin.class.st
@@ -65,7 +65,6 @@ PyramidSavePlugin >> initialize [
 
 	savingService := PyramidSavingService new
 		                 saveModel: saveModel;
-		                 methodBuilder: PyramidSavingMethodBuilder ston;
 		                 yourself.
 
 	inputsButton := SpButtonPresenter new

diff --git a/src/Pyramid-Bloc/PyramidSaveProjectConfigurationView.class.st b/src/Pyramid-Bloc/PyramidSaveProjectConfigurationView.class.st
@@ -13,7 +13,8 @@ Class {
 		'labelErrorMethod',
 		'controller',
 		'saveModel',
-		'shouldTriggerEvent'
+		'shouldTriggerEvent',
+		'openSettingsLink'
 	],
 	#category : 'Pyramid-Bloc-plugin-save',
 	#package : 'Pyramid-Bloc',
@@ -65,7 +66,8 @@ PyramidSaveProjectConfigurationView >> defaultLayout [
 		  expand: false;
 		  add: (SpBoxLayout newHorizontal
 				   spacing: 4;
-				   add: (Smalltalk ui icons iconNamed: #packageColored) expand: false;
+				   add: (Smalltalk ui icons iconNamed: #packageColored)
+				   expand: false;
 				   add: self inputPackage)
 		  expand: false;
 		  add: self labelErrorPackage expand: false;
@@ -77,7 +79,8 @@ PyramidSaveProjectConfigurationView >> defaultLayout [
 		  add: self labelErrorClass expand: false;
 		  add: (SpBoxLayout newHorizontal
 				   spacing: 4;
-				   add: (Smalltalk ui icons iconNamed: #changeUpdate) expand: false;
+				   add: (Smalltalk ui icons iconNamed: #changeUpdate)
+				   expand: false;
 				   add: self inputMethod)
 		  expand: false;
 		  add: self labelErrorMethod expand: false;
@@ -87,6 +90,11 @@ PyramidSaveProjectConfigurationView >> defaultLayout [
 				   add: self buttonBrowse width: 32;
 				   yourself)
 		  expand: false;
+		  add: (SpBoxLayout newHorizontal
+				   add: 'Go on ' expand: false;
+				   add: self openSettingsLink expand: false;
+				   add: ' to change the format.';
+				   yourself);
 		  yourself
 ]
 
@@ -160,7 +168,12 @@ PyramidSaveProjectConfigurationView >> initializePresenters [
 
 	labelErrorPackage := self newLabel.
 	labelErrorClass := self newLabel.
-	labelErrorMethod := self newLabel
+	labelErrorMethod := self newLabel.
+	openSettingsLink := self newLink.
+	openSettingsLink
+		label: 'Pyramid Settings';
+		action: [
+			self openSettingsBrowser ]
 ]
 
 { #category : 'accessing' }
@@ -214,6 +227,22 @@ PyramidSaveProjectConfigurationView >> model: aPySaveModel [
 	self updateFromModelWithoutEvents
 ]
 
+{ #category : 'initialization' }
+PyramidSaveProjectConfigurationView >> openSettingsBrowser [
+
+	| browser |
+	browser := SettingBrowser new.
+	browser changeSearchedText: 'Pyramid'.
+	browser open.
+	browser expandAll
+]
+
+{ #category : 'accessing' }
+PyramidSaveProjectConfigurationView >> openSettingsLink [
+
+	^ openSettingsLink
+]
+
 { #category : 'accessing' }
 PyramidSaveProjectConfigurationView >> saveModel [
 

diff --git a/src/Pyramid-Bloc/PyramidSavingMethodBuilder.class.st b/src/Pyramid-Bloc/PyramidSavingMethodBuilder.class.st
@@ -7,40 +7,30 @@ Class {
 		'pragma',
 		'serializeBlock'
 	],
+	#classInstVars : [
+		'stash',
+		'ston'
+	],
 	#category : 'Pyramid-Bloc-plugin-save',
 	#package : 'Pyramid-Bloc',
 	#tag : 'plugin-save'
 }
 
-{ #category : 'as yet unclassified' }
-PyramidSavingMethodBuilder class >> ston [
-
-	^ self new
-		  classifier: #'pyramid-serialized-bloc';
-		  comment:
-			  [('This class has been generated using Pyramid.<r><r><t>By: <1s><r><t><2s> <3s>'
-				   expandMacrosWith: Author uniqueInstance fullName
-				   with: Date today yyyymmdd
-				   with: Time now print24)];
-		  pragma: 'pySTON';
-		  serializeBlock: [ :collection |
-			  BlSerializer serialize: collection ];
-		  yourself
-]
-
 { #category : 'instance creation' }
 PyramidSavingMethodBuilder >> build: aSaveModel [
 
 	| result |
 	result := '<1s><r>' expandMacrosWith: aSaveModel savingMethodName.
 	self comment ifNotNil: [
-		result := result , ('<t>"<1s>"<r>' expandMacrosWith: self comment value) ].
+		result := result
+		          , ('<t>"<1s>"<r>' expandMacrosWith: self comment value) ].
 	result := result , '<r>' expandMacros.
 	self pragma ifNotNil: [
-		result := result , ('<t>%<<1s>><r>' expandMacrosWith: self pragma value) ].
+		result := result
+		          , ('<t>%<<1s>><r>' expandMacrosWith: self pragma value) ].
 	result := result
 	          ,
-	          ('<t>^ <1p>' expandMacrosWith:
+	          ('<t>^ <1s>' expandMacrosWith:
 		           (self serializedString: aSaveModel)).
 
 	^ result

diff --git a/src/Pyramid-Bloc/PyramidSavingService.class.st b/src/Pyramid-Bloc/PyramidSavingService.class.st
@@ -2,15 +2,97 @@ Class {
 	#name : 'PyramidSavingService',
 	#superclass : 'Object',
 	#instVars : [
-		'methodBuilder',
 		'saveModel',
 		'verifier'
 	],
+	#classInstVars : [
+		'currentMethodBuilder',
+		'stash',
+		'ston',
+		'currentMethodBuilderSelector'
+	],
 	#category : 'Pyramid-Bloc-plugin-save',
 	#package : 'Pyramid-Bloc',
 	#tag : 'plugin-save'
 }
 
+{ #category : 'as yet unclassified' }
+PyramidSavingService class >> allSaveMethodBuilders [
+
+	^ (Pragma allNamed: #pyramidSaveMethodBuilder:) collect: [ :pragma | pragma arguments first -> pragma methodSelector ]
+
+
+]
+
+{ #category : 'as yet unclassified' }
+PyramidSavingService class >> currentMethodBuilder [
+
+	^ self perform: self currentMethodBuilderSelector
+]
+
+{ #category : 'accessing' }
+PyramidSavingService class >> currentMethodBuilderSelector [
+
+	currentMethodBuilderSelector ifNil: [ currentMethodBuilderSelector := #stash ].
+	^ currentMethodBuilderSelector
+]
+
+{ #category : 'accessing' }
+PyramidSavingService class >> currentMethodBuilderSelector: anObject [
+
+	currentMethodBuilderSelector := anObject
+]
+
+{ #category : 'as yet unclassified' }
+PyramidSavingService class >> saveMethodBuilderSettingOn: aBuilder [
+
+	<systemsettings>
+	(aBuilder pickOne: #currentMethodBuilderSelector)
+		parent: #pyramid;
+		label: 'Select the serialization format';
+		target: self;
+		default: #stash;
+		domainValues: self allSaveMethodBuilders;
+		description:
+			'Change the serialization format when saving a project.'
+]
+
+{ #category : 'as yet unclassified' }
+PyramidSavingService class >> stash [
+
+	<pyramidSaveMethodBuilder: 'Serialize as Source Code'>
+	^ PyramidSavingMethodBuilder new
+		         classifier: #'pyramid-serialized-bloc';
+		         comment: [
+			         'This class has been generated using Pyramid.<r><r><t>By: <1s><r><t><2s> <3s>'
+				         expandMacrosWith: Author uniqueInstance fullName
+				         with: Date today yyyymmdd
+				         with: Time now print24 ];
+		         pragma: 'pyStash';
+		         serializeBlock: [ :collection |
+			         '[ <1s> ] value' expandMacrosWith:
+					         (BlStashSerializer serialize: collection) ];
+		         yourself
+]
+
+{ #category : 'as yet unclassified' }
+PyramidSavingService class >> ston [
+
+	<pyramidSaveMethodBuilder: 'Serialize as STON object'>
+	^ PyramidSavingMethodBuilder new
+		        classifier: #'pyramid-serialized-bloc';
+		        comment: [
+			        'This class has been generated using Pyramid.<r><r><t>By: <1s><r><t><2s> <3s>'
+				        expandMacrosWith: Author uniqueInstance fullName
+				        with: Date today yyyymmdd
+				        with: Time now print24 ];
+		        pragma: 'pySTON';
+		        serializeBlock: [ :collection |
+			        '<1p>' expandMacrosWith:
+					        (BlStonSerializer serialize: collection) ];
+		        yourself
+]
+
 { #category : 'testing' }
 PyramidSavingService >> canSave [
 	"Verify:
@@ -31,13 +113,7 @@ PyramidSavingService >> errorCannotSave [
 { #category : 'accessing' }
 PyramidSavingService >> methodBuilder [
 
-	^ methodBuilder
-]
-
-{ #category : 'accessing' }
-PyramidSavingService >> methodBuilder: anObject [
-
-	methodBuilder := anObject
+	^ self class currentMethodBuilder
 ]
 
 { #category : 'testing' }