diff --git a/src/Lepiter-Core-Examples/LeExampleCustomPageTypeExamples.class.st b/src/Lepiter-Core-Examples/LeExampleCustomPageTypeExamples.class.st new file mode 100644 index 000000000..11b1c5487 --- /dev/null +++ b/src/Lepiter-Core-Examples/LeExampleCustomPageTypeExamples.class.st @@ -0,0 +1,64 @@ +Class { + #name : #LeExampleCustomPageTypeExamples, + #superclass : #Object, + #category : #'Lepiter-Core-Examples-Custom Page Types' +} + +{ #category : #example } +LeExampleCustomPageTypeExamples >> databaseWithExampleCustomPage [ + + | database | + database := LeDatabaseWithLocalMonitorExamples new databaseWithMonitor. + database monitor + storage: (LeMockLocalJsonV4StorageWithMissingDeserializers new + deserializersToRemove: {LeExampleCustomPageType}). + database addPage: LeExampleCustomPageType samplePage. + self assert: database pages size = 1. + ^ database +] + +{ #category : #example } +LeExampleCustomPageTypeExamples >> deregisterCustomPageTypeAndReloadPage [ + + | database leJsonV4 reader | + database := self reloadPage. + leJsonV4 := database monitor storage leJsonV4. + leJsonV4 disableDeserializers. + reader := leJsonV4 newReader. + self assert: (reader mappings keys includes: LeExampleCustomPageType) not. + database detachPageButKeepFile: database pages first. + database monitor reload. + self + assert: (database pages first type isKindOf: LeUnknownNamedPageType) + description: 'A page with a title and an unknown page type most be loaded into the database as a page with type `LeUnknownNamedPageType`'. + ^ database +] + +{ #category : #example } +LeExampleCustomPageTypeExamples >> reloadPage [ + + | database | + database := self databaseWithExampleCustomPage. + database detachPageButKeepFile: database pages first. + database monitor reload. + self assert: (database pages first type isKindOf: LeExampleCustomPageType). + ^ database +] + +{ #category : #example } +LeExampleCustomPageTypeExamples >> reregisterCustomPageTypeAndReloadPage [ + + | database leJsonV4 reader | + database := self deregisterCustomPageTypeAndReloadPage. + leJsonV4 := database monitor storage leJsonV4. + leJsonV4 enableDeserializers. + reader := leJsonV4 newReader. + self assert: (reader mappings keys includes: LeExampleCustomPageType). + database detachPageButKeepFile: database pages first. + database monitor reload. + self flag: #TODO. "Check page hash optimization. unknown page types should be excluded and tried to be reloaded." + self + assert: (database pages first type isKindOf: LeExampleCustomPageType) + description: 'If code that handles custom page types is loaded and database reloaded, page should get reloaded as the correct page type.'. + ^ database +] diff --git a/src/Lepiter-Core-Examples/LeExampleUnnamedCustomPageTypeExamples.class.st b/src/Lepiter-Core-Examples/LeExampleUnnamedCustomPageTypeExamples.class.st new file mode 100644 index 000000000..42480ba2a --- /dev/null +++ b/src/Lepiter-Core-Examples/LeExampleUnnamedCustomPageTypeExamples.class.st @@ -0,0 +1,79 @@ +Class { + #name : #LeExampleUnnamedCustomPageTypeExamples, + #superclass : #Object, + #category : #'Lepiter-Core-Examples-Custom Page Types' +} + +{ #category : #example } +LeExampleUnnamedCustomPageTypeExamples >> databaseWithExampleCustomPage [ + + | database | + database := LeDatabaseWithLocalMonitorExamples new databaseWithMonitor. + database monitor + storage: (LeMockLocalJsonV4StorageWithMissingDeserializers new + deserializersToRemove: {LeExampleUnnamedCustomPageType}). + database addPage: LeExampleUnnamedCustomPageType samplePage. + self assert: database pages size = 1. + ^ database +] + +{ #category : #example } +LeExampleUnnamedCustomPageTypeExamples >> deregisterCustomPageTypeAndReloadPage [ + + | database leJsonV4 reader | + database := self reloadPage. + leJsonV4 := database monitor storage leJsonV4. + leJsonV4 disableDeserializers. + reader := leJsonV4 newReader. + self assert: (reader mappings keys includes: LeExampleUnnamedCustomPageType) not. + database detachPageButKeepFile: database pages first. + database monitor reload. + self + assert: (database pages first type isKindOf: LeUnknownUnnamedPageType) + description: 'A page with a title and an unknown page type most be loaded into the database as a page with type `LeUnknownNamedPageType`'. + ^ database +] + +{ #category : #example } +LeExampleUnnamedCustomPageTypeExamples >> modifyAndReloadPage [ + + | database page pageJson | + database := self reregisterCustomPageTypeAndReloadPage. + page := database pages first. + page type theAnswer: page type theAnswer + 1. + page announceTreeChanged: page. + database monitor reload. + pageJson := NeoJSONReader + fromString: (LeJsonV4 uniqueInstance serializePretty: page). + self assert: (pageJson at: #pageType at: #theAnswer) = 43. + ^ database +] + +{ #category : #example } +LeExampleUnnamedCustomPageTypeExamples >> reloadPage [ + + | database | + database := self databaseWithExampleCustomPage. + database detachPageButKeepFile: database pages first. + database monitor reload. + self assert: (database pages first type isKindOf: LeExampleUnnamedCustomPageType). + ^ database +] + +{ #category : #example } +LeExampleUnnamedCustomPageTypeExamples >> reregisterCustomPageTypeAndReloadPage [ + + | database leJsonV4 reader | + database := self deregisterCustomPageTypeAndReloadPage. + leJsonV4 := database monitor storage leJsonV4. + leJsonV4 enableDeserializers. + reader := leJsonV4 newReader. + self assert: (reader mappings keys includes: LeExampleUnnamedCustomPageType). + database detachPageButKeepFile: database pages first. + database monitor reload. + self flag: #TODO. "Check page hash optimization. unknown page types should be excluded and tried to be reloaded." + self + assert: (database pages first type isKindOf: LeExampleUnnamedCustomPageType) + description: 'If code that handles custom page types is loaded and database reloaded, page should get reloaded as the correct page type.'. + ^ database +] diff --git a/src/Lepiter-Core-Examples/LeMockJsonV4WithMissingDeserializers.class.st b/src/Lepiter-Core-Examples/LeMockJsonV4WithMissingDeserializers.class.st new file mode 100644 index 000000000..22e6bc0e7 --- /dev/null +++ b/src/Lepiter-Core-Examples/LeMockJsonV4WithMissingDeserializers.class.st @@ -0,0 +1,49 @@ +Class { + #name : #LeMockJsonV4WithMissingDeserializers, + #superclass : #LeJsonV4, + #instVars : [ + 'deserializersToDisable', + 'disableDeserializers' + ], + #category : #'Lepiter-Core-Examples-Mocks' +} + +{ #category : #accessing } +LeMockJsonV4WithMissingDeserializers >> deserializersToDisable [ + ^ deserializersToDisable +] + +{ #category : #accessing } +LeMockJsonV4WithMissingDeserializers >> deserializersToDisable: aCollection [ + deserializersToDisable := aCollection +] + +{ #category : #accessing } +LeMockJsonV4WithMissingDeserializers >> disableDeserializers [ + disableDeserializers := true +] + +{ #category : #accessing } +LeMockJsonV4WithMissingDeserializers >> enableDeserializers [ + disableDeserializers := false +] + +{ #category : #initialization } +LeMockJsonV4WithMissingDeserializers >> initialize [ + super initialize. + disableDeserializers := false +] + +{ #category : #initialization } +LeMockJsonV4WithMissingDeserializers >> newReader [ + | aReader | + mutex + critical: [ aReader := LeJsonV4Reader new. + self allClassMappingsFor: aReader. + disableDeserializers + ifTrue: [ self deserializersToDisable + do: [ :each | + aReader mappings removeKey: each. + (aReader instVarNamed: #typeMap) removeKey: each leJsonV4Name ] ] ]. + ^ aReader +] diff --git a/src/Lepiter-Core-Examples/LeMockLocalJsonV4StorageWithMissingDeserializers.class.st b/src/Lepiter-Core-Examples/LeMockLocalJsonV4StorageWithMissingDeserializers.class.st new file mode 100644 index 000000000..5d6139573 --- /dev/null +++ b/src/Lepiter-Core-Examples/LeMockLocalJsonV4StorageWithMissingDeserializers.class.st @@ -0,0 +1,26 @@ +Class { + #name : #LeMockLocalJsonV4StorageWithMissingDeserializers, + #superclass : #LeLocalJsonV4Storage, + #instVars : [ + 'deserializersToRemove', + 'leJsonV4' + ], + #category : #'Lepiter-Core-Examples-Mocks' +} + +{ #category : #accessing } +LeMockLocalJsonV4StorageWithMissingDeserializers >> deserializersToRemove [ + ^ deserializersToRemove +] + +{ #category : #accessing } +LeMockLocalJsonV4StorageWithMissingDeserializers >> deserializersToRemove: aCollection [ + deserializersToRemove := aCollection +] + +{ #category : #loading } +LeMockLocalJsonV4StorageWithMissingDeserializers >> leJsonV4 [ + ^ leJsonV4 + ifNil: [ leJsonV4 := LeMockJsonV4WithMissingDeserializers new + deserializersToDisable: self deserializersToRemove ] +] diff --git a/src/Lepiter-Core/GtSpotterReturnAllItemsFilter.class.st b/src/Lepiter-Core/GtSpotterReturnAllItemsFilter.class.st new file mode 100644 index 000000000..26941960e --- /dev/null +++ b/src/Lepiter-Core/GtSpotterReturnAllItemsFilter.class.st @@ -0,0 +1,15 @@ +Class { + #name : #GtSpotterReturnAllItemsFilter, + #superclass : #GtSpotterSubstringFilter, + #category : #'Lepiter-Core-Search' +} + +{ #category : #evaluating } +GtSpotterReturnAllItemsFilter >> applyInScope: aStream context: aSpotterContext [ + "Returns true no matter what is in the search query." + + ^ (GtSpotterSubstringFilterStream + forStream: aStream + search: aSpotterContext searchQuery) + itemString: [ :_ | aSpotterContext searchQuery ] +] diff --git a/src/Lepiter-Core/LeDatabase.class.st b/src/Lepiter-Core/LeDatabase.class.st index 00ca6d4cd..4eabf4639 100644 --- a/src/Lepiter-Core/LeDatabase.class.st +++ b/src/Lepiter-Core/LeDatabase.class.st @@ -416,6 +416,23 @@ LeDatabase >> detachPage: aPage [ page: aPage) ] +{ #category : #'api - adding / removing' } +LeDatabase >> detachPageButKeepFile: aPage [ + + "I detach the page from the give database. The page could remain deleted or be later added to + another database." + + self assertNotReadOnly. + + (pagesByType at: aPage pageTypeClass) + removeKey: aPage databaseKey + ifAbsent: [ "do nothing" ]. + pagesByUuid removeKey: aPage uid ifAbsent: [ "do nothing" ]. + + aPage removedFromDatabase: self. + self updateSortedCollectionsDueToRemoval: aPage. +] + { #category : #'api - enumerating' } LeDatabase >> do: aBlock [ "Evaluate aBlock for every page in the receiver" @@ -689,6 +706,11 @@ LeDatabase >> initialize [ readOnly := false. pagesByType := IdentityDictionary new. pagesByUuid := Dictionary new. + "Populate all the page types" + LePageType allSubclassesDo: [ :pageType | + pagesByType + at: pageType pageTypeClass + ifAbsentPut: [ GtStringContentDictionary new ] ]. blocksByUID := Dictionary new. self populatePageTypes. @@ -1029,10 +1051,18 @@ LeDatabase >> pagesByDateToShow [ { #category : #'private - accessing' } LeDatabase >> pagesByName [ - "Answer the pages by name. - This is internal structure that may change." + | namedPageClasses | + namedPageClasses := (pagesByType associations + select: [ :each | each key = LeNamedPageType or: [ each key inheritsFrom: LeNamedPageType ] ]) + sorted: [ :each | each value size ] descending. + ^ namedPageClasses allButFirst + inject: namedPageClasses first value + into: [ :acc :each | acc , each value ] +] - ^ pagesByType at: LeNamedPageType +{ #category : #'private - accessing' } +LeDatabase >> pagesByType [ + ^ pagesByType ] { #category : #'private - accessing' } diff --git a/src/Lepiter-Core/LeExampleCustomPageType.class.st b/src/Lepiter-Core/LeExampleCustomPageType.class.st new file mode 100644 index 000000000..ffc2b5c19 --- /dev/null +++ b/src/Lepiter-Core/LeExampleCustomPageType.class.st @@ -0,0 +1,93 @@ +" +This is an example of a custom page type. It doesn't really do anything, but it is used in tests and helps users understand what methods need to be overriden/created, etc. when creating their own custom page types. To inspect a sample page from this class, you can evaluate such method or click on the 'eg' class action on the op right of this class. + +The best approach for creating a new custom page type is to copy {{gtClass:LeExampleCustomPageType}} (this class) in your own package, including all it's methods, then start modifying the below methods accordingly. + +- {{gtMethod:LeExampleCustomPageType class>>#initialize}} : In your custom page type class's `initialize` method, you need to 'register' that class on all the databases in the system. This will automatically get done in the `super initialize` call but you **DO** need to define an initialize class method and make the super call, this will **NOT** happen automatically. When you are testing locally, before code is loaded through Metacello or other means, you will need to evaluate this method manually for your class to be able to be recognized by Lepiter databases and serializers/deserializers. + +- {{gtMethod:LeExampleCustomPageType>>#printOn:}} controls how your class is displayed and should overriden or you might think a page has been defined with the incorrect page type as it will display the superclass 'Named Page:' string. + +- {{gtMethod:LeExampleCustomPageType class>>#niceClassName}}: this is a 'nice' human readable name of your page type, something like 'Something Page'. This will come up in the global spotter to be able to create a new page of your custom type. + +- {{gtMethod:LeExampleCustomPageType class>>#leJsonV4Name}}: needs a unique name for lepiter JSON serialization. + +- {{gtMethod:LeExampleUnnamedCustomPageType class>>#leJsonV4AttributeMapping}} (note this is a different class) needs to be modified if your custom page type will have slots and/or values that need to be serialized to the file system as a Lepiter page/JSON file. + +- {{gtMethod:LeExampleCustomPageType class>>samplePage}} should be overriden and have an example page to potentially help users understand how to use the custom page type. + +- Crucially, {{gtMethod:LeExampleCustomPageType>>defaultPhlowTool}}: can be overriden to display the custom page type in a different graphical format than the normal Lepiter page. Custom page types will have a 'composite' tool with the default tool as the first/main tool. Two different inspectors will also show up, one for the page type class, and one for the Lepiter page itself. One can add custom views on the page type that will not appear on arbitrary Lepiter pages, only pages of the specific page type. + +- If one wants to completely override the phlow/composite tools displayed and not include the page type and page inspectors, or do any other more advanced custom logic, one can instead override {{gtMethod:LePageType>>asLepiterPagePhlowTool}} on their own class for added flexibility. + +- {{gtMethod:LeExampleCustomPageType>>#asPreviewElement}} should be modified if you want to control what shows up in the global spotter when one selects a custom page type. This class implements a sane default you can use in your own custom page type. + +- {{gtMethod:LePageType >>#pageTypeRepo}} **MUST** be implemented in your custom page type (even though it is not in this class). Read the comments in the superclass for the reasoning behind this. Defining this metadata enables being able to share Lepiter databases with people that don't have your custom page type logic yet and enables loading that code in the future. +" +Class { + #name : #LeExampleCustomPageType, + #superclass : #LeNamedPageType, + #category : #'Lepiter-Core-Model' +} + +{ #category : #initialization } +LeExampleCustomPageType class >> initialize [ + super initialize. +] + +{ #category : #'as yet unclassified' } +LeExampleCustomPageType class >> leJsonV4AttributeMapping [ + + ^ super leJsonV4AttributeMapping +] + +{ #category : #accesing } +LeExampleCustomPageType class >> leJsonV4Name [ + + ^ 'exampleCustomPage' +] + +{ #category : #printing } +LeExampleCustomPageType class >> niceClassName [ + ^ 'Example Custom Page' +] + +{ #category : #example } +LeExampleCustomPageType class >> samplePage [ + | page | + page := LePage new. + page + type: (LeExampleCustomPageType new + title: 'Testing'; + page: page). + ^ page +] + +{ #category : #ui } +LeExampleCustomPageType >> asPreviewElement [ + ^ self defaultPhlowTool asElement +] + +{ #category : #converting } +LeExampleCustomPageType >> defaultPhlowTool [ + ^ GtPhlowExplicitTool new withIconAptitude + name: self page title; + icon: BrGlamorousVectorIcons gt; + stencil: [ BrFrame new matchParent + addChild: (BrGlamorousVectorIcons perform: #largeGt) create asScalableElement; + when: BlDoubleClickEvent + do: [ :anEvent | anEvent currentTarget phlow spawnObject: 42 ] ] +] + +{ #category : #printing } +LeExampleCustomPageType >> printOn: aStream [ + + aStream + nextPutAll: 'Example Custom Page: '; + print: title +] + +{ #category : #example } +LeExampleCustomPageType >> samplePage [ + + ^ self class samplePage +] diff --git a/src/Lepiter-Core/LeExampleUnnamedCustomPageType.class.st b/src/Lepiter-Core/LeExampleUnnamedCustomPageType.class.st new file mode 100644 index 000000000..36f5f8016 --- /dev/null +++ b/src/Lepiter-Core/LeExampleUnnamedCustomPageType.class.st @@ -0,0 +1,87 @@ +Class { + #name : #LeExampleUnnamedCustomPageType, + #superclass : #LeUnnamedPageType, + #instVars : [ + 'theAnswer' + ], + #category : #'Lepiter-Core-Model' +} + +{ #category : #initialization } +LeExampleUnnamedCustomPageType class >> initialize [ + super initialize. +] + +{ #category : #'as yet unclassified' } +LeExampleUnnamedCustomPageType class >> leJsonV4AttributeMapping [ + + ^ super leJsonV4AttributeMapping + add: #theAnswer -> #theAnswer; + yourself +] + +{ #category : #accesing } +LeExampleUnnamedCustomPageType class >> leJsonV4Name [ + + ^ 'exampleUnnamedCustomPage' +] + +{ #category : #printing } +LeExampleUnnamedCustomPageType class >> niceClassName [ + ^ 'Example Unnamed Custom Page' +] + +{ #category : #example } +LeExampleUnnamedCustomPageType class >> samplePage [ + | page | + page := LePage new assignNewUID. + page + type: (LeExampleUnnamedCustomPageType new + page: page; + theAnswer: 42). + page + addSnippet: (page snippetBuilder + text: 'testing' asRopedText; + build). + ^ page +] + +{ #category : #ui } +LeExampleUnnamedCustomPageType >> asPreviewElement [ + ^ self defaultPhlowTool asElement +] + +{ #category : #converting } +LeExampleUnnamedCustomPageType >> defaultPhlowTool [ + ^ GtPhlowExplicitTool new withIconAptitude + name: self page title; + icon: BrGlamorousVectorIcons gt; + stencil: [ BrFrame new matchParent + addChild: (BrGlamorousVectorIcons perform: #largeGt) create asScalableElement; + when: BlDoubleClickEvent + do: [ :anEvent | anEvent currentTarget phlow spawnObject: self theAnswer ] ] +] + +{ #category : #printing } +LeExampleUnnamedCustomPageType >> printOn: aStream [ + + aStream + << 'Unnamed custom page: '; + << self shortDescription +] + +{ #category : #example } +LeExampleUnnamedCustomPageType >> samplePage [ + + ^ self class samplePage +] + +{ #category : #accessing } +LeExampleUnnamedCustomPageType >> theAnswer [ + ^ theAnswer ifNil: [ theAnswer := 42 ] +] + +{ #category : #accessing } +LeExampleUnnamedCustomPageType >> theAnswer: anObject [ + theAnswer := anObject +] diff --git a/src/Lepiter-Core/LeNamedPageType.class.st b/src/Lepiter-Core/LeNamedPageType.class.st index 6e7650f5e..4c84fa7c6 100644 --- a/src/Lepiter-Core/LeNamedPageType.class.st +++ b/src/Lepiter-Core/LeNamedPageType.class.st @@ -11,6 +11,11 @@ Class { #category : #'Lepiter-Core-Model' } +{ #category : #printing } +LeNamedPageType class >> niceClassName [ + ^ 'Named Page' +] + { #category : #accessing } LeNamedPageType class >> title: aString page: aLePage [ | newType | diff --git a/src/Lepiter-Core/LePage.class.st b/src/Lepiter-Core/LePage.class.st index ae903934b..d496b41a7 100644 --- a/src/Lepiter-Core/LePage.class.st +++ b/src/Lepiter-Core/LePage.class.st @@ -293,10 +293,10 @@ LePage >> gtCopyActionFor: anAction [ action: [ :aButton | Clipboard clipboardText: self asRemoteLink ] ] -{ #category : #'as yet unclassified' } +{ #category : #'gt - inspector' } LePage >> gtDefaultInspectorTool [ - - ^ self asLepiterPagePhlowTool + + ^ self asPhlowTool ] { #category : #search } diff --git a/src/Lepiter-Core/LePageType.class.st b/src/Lepiter-Core/LePageType.class.st index a6c59b2e6..f2e9d94c3 100644 --- a/src/Lepiter-Core/LePageType.class.st +++ b/src/Lepiter-Core/LePageType.class.st @@ -8,7 +8,8 @@ Class { #name : #LePageType, #superclass : #LeModel, #instVars : [ - 'page' + 'page', + 'pageTypeRepo' ], #category : #'Lepiter-Core-Model' } @@ -18,8 +19,42 @@ LePageType class >> default [ ^ LeNamedPageType new ] +{ #category : #default } +LePageType class >> defaultSystemPageTypes [ + ^ {LeDailyNotePageType. + LeNamedPageType. + LePharoClassCommentPageType. + LePharoClassPageType. + LeProxyClassPageType. + LeUnnamedPageType. + LeUnknownNamedPageType. + LeUnknownUnnamedPageType} +] + +{ #category : #action } +LePageType class >> gtSamplePageFor: anAction [ + + (self respondsTo: #samplePage) ifFalse: [ ^ anAction noAction ]. + + ^ anAction button + priority: 0; + tooltip: 'Browse Sample Page'; + icon: BrGlamorousVectorIcons eg; + action: [ :aButton | aButton phlow spawnObject: (self perform: #samplePage) ] +] + +{ #category : #initialization } +LePageType class >> initialize [ + super initialize. + self = LePageType + ifFalse: [ self leJsonV4MappingFor: LeJsonV4 uniqueInstance newWriter. + self leJsonV4MappingFor: LeJsonV4 uniqueInstance newReader. + LeDatabasesRegistry defaultLogicalDatabase databases + do: [ :aDatabase | aDatabase pagesByType at: self ifAbsentPut: [ GtStringContentDictionary new ] ] ] +] + { #category : #testing } -LePageType class >> isAbstract [ +LePageType class >> isAbstract [ ^ self name = #LePageType ] @@ -31,6 +66,14 @@ LePageType class >> pageTypeClass [ ^ self ] +{ #category : #converting } +LePageType >> asPreviewElement [ + ^ LePageToolContentTreeElement new + withTitleOnly; + pageViewModel: self page asContentUIModel; + matchParent +] + { #category : #accessing } LePageType >> databaseKey [ "Answer the attribute used to index a page of the receiver's type in the database." @@ -38,6 +81,29 @@ LePageType >> databaseKey [ ^ self subclassResponsibility ] +{ #category : #converting } +LePageType >> defaultPhlowTool [ + ^ LePagePhlowTool new + shouldFocusFirstSnippet: true; + page: self page +] + +{ #category : #action } +LePageType >> gtSpawnWithDefaultPhlowToolActionFor: anAction [ + + ^ anAction button + priority: 0; + tooltip: 'Inspect with default page phlow tool'; + icon: LeIcons lepiterPage; + action: [ :aButton | aButton phlow spawnTool: self page asLepiterPagePhlowTool ] +] + +{ #category : #initialization } +LePageType >> initialize [ +super initialize. +self pageTypeRepo +] + { #category : #'api - testing' } LePageType >> isDailyNote [ ^ false @@ -85,6 +151,22 @@ LePageType >> pageTypeClass [ ^ self class pageTypeClass ] +{ #category : #accessing } +LePageType >> pageTypeRepo [ + "Return a URL where one can get more details about downloading the code needed to support this page type" + + (self class defaultSystemPageTypes + , {LeExampleCustomPageType. + LeExampleUnnamedCustomPageType} includes: self class) + ifTrue: [ ^ pageTypeRepo ] + ifFalse: [ self shouldBeImplemented ] +] + +{ #category : #accessing } +LePageType >> pageTypeRepo: anObject [ + pageTypeRepo := anObject +] + { #category : #accessing } LePageType >> remoteLinkId [ "Answer the string to be used to identify the page in a remote link annotation ({{gtPage:...}})" diff --git a/src/Lepiter-Core/LeSlideshowPageType.class.st b/src/Lepiter-Core/LeSlideshowPageType.class.st new file mode 100644 index 000000000..42197744f --- /dev/null +++ b/src/Lepiter-Core/LeSlideshowPageType.class.st @@ -0,0 +1,122 @@ +Class { + #name : #LeSlideshowPageType, + #superclass : #LeNamedPageType, + #category : #'Lepiter-Core-Model' +} + +{ #category : #initialization } +LeSlideshowPageType class >> initialize [ + super initialize. +] + +{ #category : #jsonV4 } +LeSlideshowPageType class >> leJsonV4AttributeMapping [ + + ^ super leJsonV4AttributeMapping + yourself +] + +{ #category : #accesing } +LeSlideshowPageType class >> leJsonV4Name [ + + ^ 'slideshowPage' +] + +{ #category : #printing } +LeSlideshowPageType class >> niceClassName [ + ^ 'Slideshow Page' +] + +{ #category : #examples } +LeSlideshowPageType class >> samplePage [ + | aPage slideCode | + aPage := LePage new. + aPage + type: (LeSlideshowPageType new + title: 'A Sample Slideshow'; + page: aPage). + + slideCode := [ GtProtoLiveSlide new textAndElement + elementWeight: 0.5; + newTextWithFormat: ('Header' asRopedText + glamorousRegularFont; + bold; + fontSize: 32; + bold) , String cr asRopedText + , ('description' asRopedText + glamorousRegularFont; + fontSize: 20); + element: [ GtLudoGame new asElement asScalableElement ] ]. + + aPage + addSnippet: (LeElementSnippet new + code: slideCode sourceNode formattedCode allButFirst allButLast; + uid: LeUID new). + 2 + to: 9 + do: [ :n | + aPage + addSnippet: (LeElementSnippet new + code: 'BlBasicExamples new circle background: ' , Color random storeString , ' "Slide # ' , n asString + , '. Move slides around to change slide order"'; + uid: LeUID new) ]. + ^ aPage +] + +{ #category : #ui } +LeSlideshowPageType >> asPreviewElement [ + ^ self defaultPhlowTool asElement +] + +{ #category : #converting } +LeSlideshowPageType >> defaultPhlowTool [ + ^ GtPhlowExplicitTool new withIconAptitude + name: self page title; + icon: BrGlamorousVectorIcons play; + stencil: [ self tool ] +] + +{ #category : #accessing } +LeSlideshowPageType >> elementSnippets [ + | result | + result := OrderedCollection new. + self page + withAllChildrenDepthFirstDo: [ :aSnippet | (aSnippet isKindOf: LeElementSnippet) ifTrue: [ result add: aSnippet ] ]. + + ^ result +] + +{ #category : #examples } +LeSlideshowPageType >> emptyPage [ + + | aPage | + aPage := LePage new. + ^ aPage + type: (LeSlideshowPageType new + title: 'An Empty Slideshow'; + page: aPage) +] + +{ #category : #accessing } +LeSlideshowPageType >> pageTypeRepo [ + ^ pageTypeRepo ifNil: [ pageTypeRepo := 'https://github.com/feenkcom/lepiter' ] +] + +{ #category : #printing } +LeSlideshowPageType >> printOn: aStream [ + + aStream + nextPutAll: 'Slideshow Page: '; + print: title +] + +{ #category : #examples } +LeSlideshowPageType >> samplePage [ + + ^ self class samplePage +] + +{ #category : #ui } +LeSlideshowPageType >> tool [ + ^ LeSlideshowPageElement page: self page +] diff --git a/src/Lepiter-Core/LeUnknownNamedPageType.class.st b/src/Lepiter-Core/LeUnknownNamedPageType.class.st new file mode 100644 index 000000000..f785c8999 --- /dev/null +++ b/src/Lepiter-Core/LeUnknownNamedPageType.class.st @@ -0,0 +1,36 @@ +Class { + #name : #LeUnknownNamedPageType, + #superclass : #LeNamedPageType, + #traits : 'TLeUnknownPageType', + #classTraits : 'TLeUnknownPageType classTrait', + #category : #'Lepiter-Core-Model' +} + +{ #category : #initialization } +LeUnknownNamedPageType class >> initialize [ + super initialize +] + +{ #category : #accesing } +LeUnknownNamedPageType class >> leJsonV4Name [ + + ^ 'unknownNamedCustomPage' +] + +{ #category : #printing } +LeUnknownNamedPageType class >> niceClassName [ + ^ 'Unknown Named Custom Page' +] + +{ #category : #ui } +LeUnknownNamedPageType >> asPreviewElement [ + ^ self defaultPhlowTool asElement +] + +{ #category : #printing } +LeUnknownNamedPageType >> printOn: aStream [ + + aStream + nextPutAll: 'Unknown Named Custom Page: '; + print: title +] diff --git a/src/Lepiter-Core/LeUnknownUnnamedPageType.class.st b/src/Lepiter-Core/LeUnknownUnnamedPageType.class.st new file mode 100644 index 000000000..f8ecc3928 --- /dev/null +++ b/src/Lepiter-Core/LeUnknownUnnamedPageType.class.st @@ -0,0 +1,33 @@ +Class { + #name : #LeUnknownUnnamedPageType, + #superclass : #LeUnnamedPageType, + #traits : 'TLeUnknownPageType', + #classTraits : 'TLeUnknownPageType classTrait', + #category : #'Lepiter-Core-Model' +} + +{ #category : #initialization } +LeUnknownUnnamedPageType class >> initialize [ + super initialize +] + +{ #category : #accesing } +LeUnknownUnnamedPageType class >> leJsonV4Name [ + + ^ 'unknownUnnamedCustomPage' +] + +{ #category : #printing } +LeUnknownUnnamedPageType class >> niceClassName [ + ^ 'Unknown Unnamed Custom Page' +] + +{ #category : #ui } +LeUnknownUnnamedPageType >> asPreviewElement [ + ^ self defaultPhlowTool asElement +] + +{ #category : #printing } +LeUnknownUnnamedPageType >> printOn: aStream [ + aStream nextPutAll: 'Unknown Unnamed Custom Page' +] diff --git a/src/Lepiter-Core/TLeUnknownPageType.trait.st b/src/Lepiter-Core/TLeUnknownPageType.trait.st new file mode 100644 index 000000000..2e4ac537c --- /dev/null +++ b/src/Lepiter-Core/TLeUnknownPageType.trait.st @@ -0,0 +1,84 @@ +Trait { + #name : #TLeUnknownPageType, + #instVars : [ + 'pageType', + 'additionalFields', + 'pageTypeRepo' + ], + #category : #'Lepiter-Core-Traits' +} + +{ #category : #jsonV4 } +TLeUnknownPageType classSide >> leFromJsonV4Dictionary: aDictionary [ + "Create a new instance of the receiver from the supplied dictionary. + Store additional fields in the slot named as such." + + | anUnknownPageType knownMapKeys | + anUnknownPageType := super leFromJsonV4Dictionary: aDictionary. + knownMapKeys := self leJsonV4AttributeMapping collect: #value. + anUnknownPageType + additionalFields: (aDictionary + associationsSelect: [ :each | (knownMapKeys includes: each key) not ]). + aDictionary + at: #additionalFields + ifPresent: [ :aValue | anUnknownPageType additionalFields addAll: aValue ]. + aDictionary + at: #title + ifPresent: [ :aValue | anUnknownPageType title: '*UNKNOWN* | ' ,aValue ]. + ^ anUnknownPageType +] + +{ #category : #jsonV4 } +TLeUnknownPageType classSide >> leJsonV4AttributeMapping [ + ^ super leJsonV4AttributeMapping + add: #pageTypeRepo -> #pageTypeRepo; + add: #pageType -> #'__type'; + yourself +] + +{ #category : #jsonV4 } +TLeUnknownPageType classSide >> leJsonV4MappingFor: aNeoJSONMapper [ + aNeoJSONMapper + for: self + customDo: [ :aNeoJSONCustomMapping | + aNeoJSONCustomMapping + encoder: [ :anUnknownPageType | + | aDictionary | + aDictionary := GtStringContentDictionary new. + self leJsonV4AttributeMapping + do: [ :attributeMap | + aDictionary + at: attributeMap value + put: (anUnknownPageType perform: attributeMap key) ]. + anUnknownPageType additionalFields + ifNotNil: [ :notNil | aDictionary addAll: notNil ]. + aDictionary + at: #title + ifPresent: [ :aValue | aDictionary at: #title put: (aValue copyReplaceAll: '*UNKNOWN* | ' with: '') ]. + aDictionary ] ] +] + +{ #category : #accessing } +TLeUnknownPageType >> additionalFields [ + ^ additionalFields +] + +{ #category : #accessing } +TLeUnknownPageType >> additionalFields: anObject [ + additionalFields := anObject +] + +{ #category : #accessing } +TLeUnknownPageType >> pageType [ + ^ pageType +] + +{ #category : #accessing } +TLeUnknownPageType >> pageType: anObject [ + pageType := anObject +] + +{ #category : #accessing } +TLeUnknownPageType >> pageTypeRepo [ + ^ pageTypeRepo +] diff --git a/src/Lepiter-Snippet-Element/LeElementSnippet.class.st b/src/Lepiter-Snippet-Element/LeElementSnippet.class.st index c839621b3..60d237dda 100644 --- a/src/Lepiter-Snippet-Element/LeElementSnippet.class.st +++ b/src/Lepiter-Snippet-Element/LeElementSnippet.class.st @@ -90,6 +90,19 @@ LeElementSnippet >> asPreviewElement [ ^ snippetElement ] +{ #category : #converting } +LeElementSnippet >> asSlideshowPageElement [ + | viewModel snippetElement | + viewModel := self asSnippetViewModel. + snippetElement := ((LeSlideshowPageSnippetView new + snippetElementClass: viewModel snippetElementClass) + beFullWidth; + needsContentDecorationBar: false) asElement. + snippetElement snippetViewModel: viewModel. + snippetElement padding: (BlInsets all: 10). + ^ snippetElement +] + { #category : #accessing } LeElementSnippet >> asSnippetViewModel [ diff --git a/src/Lepiter-Snippet-Element/LeElementSnippetElement.class.st b/src/Lepiter-Snippet-Element/LeElementSnippetElement.class.st index b6d791d3f..b53ed3657 100644 --- a/src/Lepiter-Snippet-Element/LeElementSnippetElement.class.st +++ b/src/Lepiter-Snippet-Element/LeElementSnippetElement.class.st @@ -89,7 +89,8 @@ LeElementSnippetElement >> createRefreshContentButton [ icon: BrGlamorousVectorIcons refresh asElement; label: 'Refresh' asString; action: [ - self generateDisplayElement]; + self generateDisplayElement. + self fireEvent: (LeElementSnippetEvaluated new element: self; snippet: self snippet)]; yourself ] @@ -265,7 +266,12 @@ LeElementSnippetElement >> onCodeEvaluated: anEvaluatedAnnouncement [ (anEvaluatedAnnouncement requesterObject isRequestedByElementOrItsChild: self) ifFalse: [ ^ self ]. - self setElement: [ anEvaluatedAnnouncement evaluationResult value ] + self setElement: [ anEvaluatedAnnouncement evaluationResult value ]. + self + fireEvent: (LeSnippetEvaluated new + element: self; + snippet: self snippet; + evaluationResult: anEvaluatedAnnouncement evaluationResult) ] { #category : #'private - event handling' } @@ -516,3 +522,8 @@ LeElementSnippetElement >> updateCoderWhenFocused: isFocused [ ifTrue: [ coderElement requestFocus ] ifFalse: [ coderElement loseFocus ] ] + +{ #category : #private } +LeElementSnippetElement >> updateElementHeightTo: aHeight [ + elementContainer vExact: aHeight +] diff --git a/src/Lepiter-Store/LeJsonV4Reader.class.st b/src/Lepiter-Store/LeJsonV4Reader.class.st index 833bc1322..87048a2b2 100644 --- a/src/Lepiter-Store/LeJsonV4Reader.class.st +++ b/src/Lepiter-Store/LeJsonV4Reader.class.st @@ -51,10 +51,12 @@ LeJsonV4Reader >> nextListAs: schema [ { #category : #private } LeJsonV4Reader >> object: type from: map [ - - ^ typeMap at: type + ^ typeMap + at: type ifPresent: [ :cls | cls leFromJsonV4Dictionary: map ] - ifAbsent: [ self unknownSnippetTypeFrom: map ] + ifAbsent: [ [ self unknownSnippetTypeFrom: map ] + on: NeoJSONParseError + do: [ self unknownPageTypeFrom: map ] ] ] { #category : #private } @@ -129,18 +131,39 @@ LeJsonV4Reader >> unknownObjectsResolversMap [ yourself ] ] +{ #category : #private } +LeJsonV4Reader >> unknownPageTypeFrom: map [ + "If the supplied map looks like a page type, answer an unknown page, otherwise raise an exception" + + | class | + "map is considered a page type if it has all the keys of LePageType" + ((LePageType leJsonV4AttributeMapping collect: #key as: GtStringContentSet) + difference: map keys) ifNotEmpty: [ self error: 'Unknown page type' ]. + + class := map + at: #title + ifPresent: [ :aTitle | LeUnknownNamedPageType ] + ifAbsent: [ LeUnknownUnnamedPageType ]. + + ^ class leFromJsonV4Dictionary: map +] + { #category : #private } LeJsonV4Reader >> unknownSnippetTypeFrom: map [ "If the supplied map looks like a snippet, answer an unknown snippet, otherwise raise an exception" - | children snippet | + | children class snippet type | "map is considered a snippet if it has all the keys of LeBlock" ((LeSnippet leJsonV4AttributeMapping collect: #key as: GtStringContentSet) difference: map keys) ifNotEmpty: [ ^ LeUnknownParsedObject forMap: map ]. children := map at: 'children'. map at: 'children' put: LeSnippets new. - snippet := LeUnknownSnippet + type := map at: #__type. + class := LeUnknownSnippet withAllSubclasses + detect: [ :each | each leJsonV4Name = type ] + ifNone: [ LeUnknownSnippet ]. + snippet := class jsonString: (String streamContents: [ :stream | LeJsonV4 uniqueInstance diff --git a/src/Lepiter-Store/LeLocalJsonV4Storage.class.st b/src/Lepiter-Store/LeLocalJsonV4Storage.class.st index 46eaca0dc..efd89981e 100644 --- a/src/Lepiter-Store/LeLocalJsonV4Storage.class.st +++ b/src/Lepiter-Store/LeLocalJsonV4Storage.class.st @@ -42,27 +42,33 @@ LeLocalJsonV4Storage >> explicitLinksFileOrNilIn: aDirectory [ ^ nil ] +{ #category : #accessing } +LeLocalJsonV4Storage >> leJsonV4 [ + ^ LeJsonV4 uniqueInstance +] + { #category : #loading } LeLocalJsonV4Storage >> loadFromFile: aFileReference [ | originalException result | - - result := [ aFileReference readStreamDo: [ :stream | - LeJsonV4 uniqueInstance deserialize: stream ] ] - on: NeoJSONParseError - do: [ :ex | - originalException := ex. - nil ]. - originalException ifNotNil: - [ | corruptFileReference loadError | - corruptFileReference := (aFileReference withExtension: 'corrupt') nextVersion. - UIManager default inform: 'Lepiter: Unable to load: ', aFileReference basename, ' in ', aFileReference parent fullName, ' due to a JSON parser error'. - aFileReference resolve renameTo: corruptFileReference basename. - loadError := LeDBLoadError new. + result := [ aFileReference + readStreamDo: [ :stream | self leJsonV4 deserialize: stream ] ] + on: NeoJSONParseError + do: [ :ex | + originalException := ex. + nil ]. + originalException + ifNotNil: [ | corruptFileReference loadError | + corruptFileReference := (aFileReference withExtension: 'corrupt') nextVersion. + UIManager default + inform: 'Lepiter: Unable to load: ' , aFileReference basename , ' in ' + , aFileReference parent fullName , ' due to a JSON parser error'. + aFileReference resolve renameTo: corruptFileReference basename. + loadError := LeDBLoadError new. loadError properties at: #fileReference put: corruptFileReference. loadError reason: 'JSON Parse Error'; originalException: originalException. - loadError signal ]. + loadError signal ]. ^ result ] diff --git a/src/Lepiter-Store/LeNamedPageType.extension.st b/src/Lepiter-Store/LeNamedPageType.extension.st index 9d2a55fc9..0de7e8333 100644 --- a/src/Lepiter-Store/LeNamedPageType.extension.st +++ b/src/Lepiter-Store/LeNamedPageType.extension.st @@ -4,8 +4,11 @@ Extension { #name : #LeNamedPageType } LeNamedPageType class >> leJsonV3AttributeMapping [ ^ super leJsonV3AttributeMapping - add: (#title -> #title); - yourself + add: #title -> #title; + in: [ :aMapping | + (self defaultSystemPageTypes includes: self) + ifFalse: [ aMapping add: #pageTypeRepo -> #pageTypeRepo ]. + aMapping ] ] @@ -19,9 +22,11 @@ LeNamedPageType class >> leJsonV3Name [ LeNamedPageType class >> leJsonV4AttributeMapping [ ^ super leJsonV4AttributeMapping - add: (#title -> #title); - yourself - + add: #title -> #title; + in: [ :aMapping | + (self defaultSystemPageTypes includes: self) + ifFalse: [ aMapping add: #pageTypeRepo -> #pageTypeRepo ]. + aMapping ] ] { #category : #'*Lepiter-Store' } diff --git a/src/Lepiter-Store/LeUnnamedPageType.extension.st b/src/Lepiter-Store/LeUnnamedPageType.extension.st index e45289aa4..5e9e37a54 100644 --- a/src/Lepiter-Store/LeUnnamedPageType.extension.st +++ b/src/Lepiter-Store/LeUnnamedPageType.extension.st @@ -8,11 +8,12 @@ LeUnnamedPageType class >> leJsonV3Name [ { #category : #'*Lepiter-Store' } LeUnnamedPageType class >> leJsonV4AttributeMapping [ - ^ super leJsonV4AttributeMapping - add: (#defaultTitle -> #defaultTitle); - yourself - + add: #defaultTitle -> #defaultTitle; + in: [ :aMapping | + (self defaultSystemPageTypes includes: self) + ifFalse: [ aMapping add: #pageTypeRepo -> #pageTypeRepo ]. + aMapping ] ] { #category : #'*Lepiter-Store' } diff --git a/src/Lepiter-Tool/LeHomePagesElement.class.st b/src/Lepiter-Tool/LeHomePagesElement.class.st index c688c438e..9c2583edd 100644 --- a/src/Lepiter-Tool/LeHomePagesElement.class.st +++ b/src/Lepiter-Tool/LeHomePagesElement.class.st @@ -18,7 +18,7 @@ LeHomePagesElement >> isForTodayNote [ { #category : #'private - event handling' } LeHomePagesElement >> onPageClick: aLePageViewModel [ - BlSpace spawnPage: aLePageViewModel pageModel from: self + aLePageViewModel pageModel gtSpotterActDefaultFrom: self ] { #category : #'private - accessing' } diff --git a/src/Lepiter-UI-Core/BrGlamorousSlideExteriorAptitude.class.st b/src/Lepiter-UI-Core/BrGlamorousSlideExteriorAptitude.class.st new file mode 100644 index 000000000..45d6ecceb --- /dev/null +++ b/src/Lepiter-UI-Core/BrGlamorousSlideExteriorAptitude.class.st @@ -0,0 +1,76 @@ +Class { + #name : #BrGlamorousSlideExteriorAptitude, + #superclass : #BrLazyStyleCommonAptitude, + #instVars : [ + 'backgroundPaint', + 'borderWidth', + 'borderPaint' + ], + #category : #'Lepiter-UI-Core-Brick - Looks' +} + +{ #category : #accessing } +BrGlamorousSlideExteriorAptitude >> backgroundPaint [ + ^ backgroundPaint ifNil: [ self theme button defaultBackgroundColor ] +] + +{ #category : #accessing } +BrGlamorousSlideExteriorAptitude >> backgroundPaint: aPaint [ + backgroundPaint := aPaint +] + +{ #category : #accessing } +BrGlamorousSlideExteriorAptitude >> borderPaint [ + ^ borderPaint ifNil: [ self theme button defaultBorderColor ] +] + +{ #category : #accessing } +BrGlamorousSlideExteriorAptitude >> borderPaint: aColor [ + borderPaint := aColor +] + +{ #category : #accessing } +BrGlamorousSlideExteriorAptitude >> borderWidth [ + ^ borderWidth ifNil: [ 1 ] +] + +{ #category : #accessing } +BrGlamorousSlideExteriorAptitude >> borderWidth: anInteger [ + borderWidth := anInteger +] + +{ #category : #initialization } +BrGlamorousSlideExteriorAptitude >> initialize [ + super initialize. + + self default: [ :aStyle | + aStyle + background: self backgroundPaint; + border: (BlBorder paint: self borderPaint width: self borderWidth) ]. + + self focused: [ :aStyle | + aStyle border: + (BlBorder + paint: self theme button hoveredBorderColor + width: self borderWidth) ]. + + self hovered: [ :aStyle | + aStyle border: + (BlBorder + paint: self theme button fadedBackgroundColor darker + width: self borderWidth) ]. + + self pressed: [ :aStyle | + aStyle border: + (BlBorder + paint: self theme button pressedBorderColor + width: self borderWidth) ]. + + self disabled: [ :aSyle | + aSyle + background: self theme button disabledBackgroundColor; + border: + (BlBorder + paint: self theme button disabledBorderColor + width: self borderWidth) ] +] diff --git a/src/Lepiter-UI-Core/LeSlideshowPageSnippetExpandableAptitude.class.st b/src/Lepiter-UI-Core/LeSlideshowPageSnippetExpandableAptitude.class.st new file mode 100644 index 000000000..1465f25f1 --- /dev/null +++ b/src/Lepiter-UI-Core/LeSlideshowPageSnippetExpandableAptitude.class.st @@ -0,0 +1,33 @@ +Class { + #name : #LeSlideshowPageSnippetExpandableAptitude, + #superclass : #LeSnippetExpandableAptitude, + #category : #'Lepiter-UI-Core-Brick - Looks' +} + +{ #category : #'instace creation' } +LeSlideshowPageSnippetExpandableAptitude >> newAddSnippetDropdown [ + + | aButton | + aButton := self newPlusElement. + aButton + addAptitude: (BrGlamorousWithExplicitDropdownAptitude + handle: [ self newPlusElement + aptitude: BrIconAptitude; + background: BrGlamorousColors secondaryHeaderBackgroundColor ] + content: [ GtSpotterDropdownButtonStencil new + valuable: LeSlideshowPageSpotterStart new; + extent: [ 800 @ 600 ]; + spotterModelDo: [ :aSpotter | + aSpotter announcer weak + when: GtSpotterExitAnnouncement + send: #onSpotterExitAnnouncement: + to: self ]; + objectActOn: [ :anActOnEvent :aMenuItem :theButton | + self widget snippetViewModel snippetModel + addSnippetAfterSelf: aMenuItem asSnippet. + anActOnEvent beActed ]; + spotterElementFor: aButton ] + containerDo: [ :aMenuContainer | aMenuContainer background: BrGlamorousColors secondaryHeaderBackgroundColor ]) + doNotHideWidget. + ^ aButton +] diff --git a/src/Lepiter-UI-Snippet/LeSlideshowNewSlideItemSpecification.class.st b/src/Lepiter-UI-Snippet/LeSlideshowNewSlideItemSpecification.class.st new file mode 100644 index 000000000..ec7d2f596 --- /dev/null +++ b/src/Lepiter-UI-Snippet/LeSlideshowNewSlideItemSpecification.class.st @@ -0,0 +1,156 @@ +Class { + #name : #LeSlideshowNewSlideItemSpecification, + #superclass : #Object, + #traits : 'TLeContextMenuItemSpecification', + #classTraits : 'TLeContextMenuItemSpecification classTrait', + #instVars : [ + 'title', + 'definingMethod', + 'preview' + ], + #classInstVars : [ + 'slideTemplates' + ], + #category : #'Lepiter-UI-Snippet-Spotter' +} + +{ #category : #initialization } +LeSlideshowNewSlideItemSpecification class >> demoSlides [ + ^ DemoSlideshow new slidePriorities collect: [ :each | DemoSlideshow >> each ] +] + +{ #category : #instantiation } +LeSlideshowNewSlideItemSpecification class >> emptySlideAndTemplates [ + ^ self new asArray , self slideTemplates +] + +{ #category : #initialization } +LeSlideshowNewSlideItemSpecification class >> slideTemplates [ + ^ slideTemplates + ifNil: [ slideTemplates := self demoSlides + collect: [ :each | + LeSlideshowNewSlideItemSpecification new + definingMethod: each; + title: each methodClass name , ' >> ' , '#' , each selector; + preview: (BrValuableStencil + from: [ BrVerticalPane new matchParent + addChildren: {BlTextElement + text: ((each pragmaAt: #text:) + ifNil: [ '' ] + ifNotNil: [ :aPragma | aPragma arguments first ]) asRopedText. + each asScalableSlide create} ]) ] ] +] + +{ #category : #'api - converting' } +LeSlideshowNewSlideItemSpecification >> asSnippet [ + + ^ LeElementSnippet new + uid: LeUID new; + code: (self rewriteMethod: self definingMethod) +] + +{ #category : #'api - accessing' } +LeSlideshowNewSlideItemSpecification >> definingMethod [ + ^ definingMethod +] + +{ #category : #'api - accessing' } +LeSlideshowNewSlideItemSpecification >> definingMethod: anObject [ + definingMethod := anObject +] + +{ #category : #'gt - extensions' } +LeSlideshowNewSlideItemSpecification >> gtDefiningMethodFor: aView [ + + self definingMethod ifNil: [ ^ aView empty ]. + ^ aView forward + title: 'Source'; + priority: 2; + object: [ self definingMethod ]; + view: #gtSourceFor: +] + +{ #category : #'gt - extensions' } +LeSlideshowNewSlideItemSpecification >> gtLiveFor: aView [ + + self definingMethod ifNil: [ ^ aView empty ]. + ^ aView forward + title: 'Live'; + priority: 1; + object: [ self asSnippet ]; + view: #gtLiveFor: +] + +{ #category : #initialization } +LeSlideshowNewSlideItemSpecification >> initialize [ + super initialize. + title := 'Empty Slide' +] + +{ #category : #accessing } +LeSlideshowNewSlideItemSpecification >> preview [ + ^ preview + ifNil: [ LeElementSnippet new asPreviewElement preventChildrenMouseEvents ] + ifNotNil: [ preview asElement preventChildrenMouseEvents ] +] + +{ #category : #accessing } +LeSlideshowNewSlideItemSpecification >> preview: aBrStencil [ + preview := aBrStencil +] + +{ #category : #printing } +LeSlideshowNewSlideItemSpecification >> printOn: aStream [ + super printOn: aStream. + aStream + nextPut: $(; + nextPutAll: self title asString; + nextPut: $) +] + +{ #category : #converting } +LeSlideshowNewSlideItemSpecification >> rewriteMethod: aMethod [ + ^ aMethod + ifNil: [ '' ] + ifNotNil: [ | anAst rewriter slideText | + anAst := aMethod ast veryDeepCopy. + anAst body + addNodeFirst: (RBParser + parseExpression: 'aSlide := GtProtoLiveSlide new. + aDemo := DemoSlideshow new.'). + slideText := anAst + pragmaNamed: #text: + ifPresent: [ :aPragma | aPragma arguments first value copyReplaceAll: String cr with: ' ' ] + ifAbsent: [ nil ]. + slideText + ifNotNil: [ anAst body + addNodeFirst: (RBParser + parseExpression: '"' , anAst method methodClass name , ' >> ' , '#' , anAst method selector + , ' | ' , slideText , '"') ]. + anAst removePragmaNamed: #text:. + anAst removePragmaNamed: #gtSlide. + rewriter := RBParseTreeRewriter new. + rewriter + replace: '| `@temp | +`@.Statements' + with: '`@.Statements'. + rewriter executeTree: anAst. + ((((((anAst newSource lines allButFirst + reject: [ :each | each includesSubstring: ' . "' ]) joinUsing: String cr) + copyReplaceAll: 'self ' + with: 'aDemo ') copyReplaceAll: 'self' , String cr with: 'aDemo' , String cr) + copyReplaceAll: '^' + with: '') copyReplaceAll: 'setPriority;' with: '') + copyReplaceAll: 'setPriority' + with: '' ] +] + +{ #category : #'as yet unclassified' } +LeSlideshowNewSlideItemSpecification >> title [ + ^ title +] + +{ #category : #'api - accessing' } +LeSlideshowNewSlideItemSpecification >> title: anObject [ + title := anObject +] diff --git a/src/Lepiter-UI-Snippet/LeSlideshowPageSnippetView.class.st b/src/Lepiter-UI-Snippet/LeSlideshowPageSnippetView.class.st new file mode 100644 index 000000000..7ce6aaf55 --- /dev/null +++ b/src/Lepiter-UI-Snippet/LeSlideshowPageSnippetView.class.st @@ -0,0 +1,10 @@ +Class { + #name : #LeSlideshowPageSnippetView, + #superclass : #LeSnippetView, + #category : #'Lepiter-UI-Snippet-! Views' +} + +{ #category : #'api - instantiation' } +LeSlideshowPageSnippetView >> newSnippetElementLook [ + ^ LeSlideshowPageSnippetExpandableAptitude new +] diff --git a/src/Lepiter-UI-Snippet/LeSlideshowPageSpotterStart.class.st b/src/Lepiter-UI-Snippet/LeSlideshowPageSpotterStart.class.st new file mode 100644 index 000000000..9b512df5b --- /dev/null +++ b/src/Lepiter-UI-Snippet/LeSlideshowPageSpotterStart.class.st @@ -0,0 +1,25 @@ +Class { + #name : #LeSlideshowPageSpotterStart, + #superclass : #Object, + #category : #'Lepiter-UI-Snippet-Spotter' +} + +{ #category : #printing } +LeSlideshowPageSpotterStart >> gtDisplayOn: aStream [ + aStream nextPutAll: 'Add New Slide' +] + +{ #category : #searching } +LeSlideshowPageSpotterStart >> gtNewSnippetFor: aSearch [ + + ^ aSearch list + title: 'Add Slide to Page'; + priority: 1; + items: [ LeSlideshowNewSlideItemSpecification emptySlideAndTemplates ]; + itemName: #title; + previewElement: #preview; + filterBySubstring; + withoutCategoryAction; + withoutItemsLimit; + wantsToDisplayOnEmptyQuery: true +] diff --git a/src/Lepiter-UI/BlReorderingHandler.class.st b/src/Lepiter-UI/BlReorderingHandler.class.st new file mode 100644 index 000000000..cef027320 --- /dev/null +++ b/src/Lepiter-UI/BlReorderingHandler.class.st @@ -0,0 +1,200 @@ +Class { + #name : #BlReorderingHandler, + #superclass : #BlCustomEventHandler, + #instVars : [ + 'originalPosition', + 'dragStartPosition', + 'allowedOutOfBounds', + 'direction', + 'overlay', + 'parent', + 'placeholder', + 'originalConstraints', + 'dragStartEventAction', + 'dragEventAction', + 'dragEndEventAction' + ], + #classVars : [ + 'Any', + 'Horizontal', + 'Vertical' + ], + #category : #'Lepiter-UI-Drag & Drop' +} + +{ #category : #initialization } +BlReorderingHandler class >> initialize [ + Any := #any. + Vertical := #vertical. + Horizontal := #horizontal +] + +{ #category : #'api - pull handler' } +BlReorderingHandler >> allowOutOfBounds [ + "Allow the pulled element to be pulled outside of the parent bounds" + + allowedOutOfBounds := true +] + +{ #category : #'api - pull handler' } +BlReorderingHandler >> beFree [ + direction := Any +] + +{ #category : #'api - pull handler' } +BlReorderingHandler >> beHorizontal [ + direction := Horizontal +] + +{ #category : #'api - pull handler' } +BlReorderingHandler >> beVertical [ + direction := Vertical +] + +{ #category : #'private - pulling' } +BlReorderingHandler >> computePullDelta: aDragDelta [ + + + direction = Any + ifTrue: [ ^ aDragDelta ]. + + direction = Vertical + ifTrue: [ ^ 0 @ aDragDelta y ]. + + direction = Horizontal + ifTrue: [ ^ aDragDelta x @ 0 ]. + + ^ direction +] + +{ #category : #'api - pull handler' } +BlReorderingHandler >> disallowOutOfBounds [ + "Do not allow the pulled element to be pulled outside of the parent bounds" + + allowedOutOfBounds := false +] + +{ #category : #'event handling' } +BlReorderingHandler >> dragEndEvent: aBlDragEndEvent [ + | draggable | + aBlDragEndEvent consumed: true. + draggable := aBlDragEndEvent currentTarget. + overlay removeChild: draggable. + parent replaceChild: placeholder with: draggable. + overlay detach. + draggable constraints: originalConstraints. + + aBlDragEndEvent currentTarget dispatchEvent: BlPullEndEvent new. + self onDragEndEvent: aBlDragEndEvent +] + +{ #category : #'event handling' } +BlReorderingHandler >> dragEvent: aBlDragEvent [ + | dragPosition dragDelta aNewPosition | + dragPosition := aBlDragEvent currentTarget + globalPointToParent: aBlDragEvent position. + self movePlaceholderIfOverOtherChild: aBlDragEvent. + dragDelta := dragPosition + - (dragStartPosition ifNil: [ dragStartPosition := dragPosition ]). + dragDelta := self computePullDelta: dragDelta. + aNewPosition := (originalPosition + ifNil: [ originalPosition := aBlDragEvent currentTarget position ]) + + dragDelta. + allowedOutOfBounds + ifFalse: [ | aMaxPosition | + aMaxPosition := aBlDragEvent currentTarget hasParent + ifTrue: [ aBlDragEvent currentTarget parent extent - aBlDragEvent currentTarget extent ] + ifFalse: [ 0 @ 0 ]. + aNewPosition := aNewPosition min: aMaxPosition max: 0 @ 0 ]. + aBlDragEvent currentTarget relocate: aNewPosition. + aBlDragEvent consumed: true. + self onDragEvent: aBlDragEvent. + aBlDragEvent currentTarget + dispatchEvent: + (BlPullEvent new + initialPosition: originalPosition; + oldPosition: dragPosition; + newPosition: aNewPosition; + delta: dragDelta) +] + +{ #category : #'event handling' } +BlReorderingHandler >> dragStartEvent: aBlDragStartEvent [ + |draggable originalSize | + aBlDragStartEvent consumed: true. + self onDragStartEvent: aBlDragStartEvent. + draggable := aBlDragStartEvent currentTarget. + originalSize := draggable size. + parent := draggable parent. + overlay := BlOverlayElement on: parent. + parent parent addChild: overlay. + + "drag start position in parent" + dragStartPosition := draggable globalPointToParent: aBlDragStartEvent position. + + "element position in parent" + originalPosition := draggable position. + originalConstraints := draggable constraints veryDeepCopy. + placeholder := self placeholderFor: draggable. + parent replaceChild: draggable with: placeholder. + overlay addChild: draggable. + draggable size: originalSize. + + aBlDragStartEvent currentTarget dispatchEvent: BlPullStartEvent new +] + +{ #category : #'api - accessing' } +BlReorderingHandler >> eventsToHandle [ + ^ { BlDragStartEvent . BlDragEvent . BlDragEndEvent } +] + +{ #category : #initialization } +BlReorderingHandler >> initialize [ + super initialize. + + allowedOutOfBounds := false. + direction := Any. + dragStartEventAction := [ :aBlDragStartEvent | ]. + dragEventAction := [ :aBlDragEvent | ]. + dragEndEventAction := [ :aBlDragEndEvent | ] +] + +{ #category : #'event handling' } +BlReorderingHandler >> movePlaceholderIfOverOtherChild: anEvent [ + | mouseOverOther | + mouseOverOther := placeholder. + parent children + do: [ :each | + (each containsGlobalPoint: anEvent position) + ifTrue: [ mouseOverOther := each ] ]. + mouseOverOther = placeholder + ifFalse: [ | index | + index := parent childIndexOf: mouseOverOther. + parent removeChild: placeholder. + parent addChild: placeholder at: index ] +] + +{ #category : #'event handling' } +BlReorderingHandler >> onDragEndEvent: aBlDragEndEvent [ + dragEndEventAction value: aBlDragEndEvent +] + +{ #category : #'event handling' } +BlReorderingHandler >> onDragEvent: aBlDragEvent [ + dragEventAction value: aBlDragEvent +] + +{ #category : #'event handling' } +BlReorderingHandler >> onDragStartEvent: aBlDragStartEvent [ + dragEndEventAction value: aBlDragStartEvent +] + +{ #category : #'event handling' } +BlReorderingHandler >> placeholderFor: draggable [ + ^BlElement new + size: draggable size; + border: (draggable border copyWithStyle: BlStrokeStyle dashed); + margin: draggable margin; + background: (draggable background paint color alpha: 0.2); + yourself +] diff --git a/src/Lepiter-UI/BlSpace.extension.st b/src/Lepiter-UI/BlSpace.extension.st index 7a0d0bc69..1a820c05d 100644 --- a/src/Lepiter-UI/BlSpace.extension.st +++ b/src/Lepiter-UI/BlSpace.extension.st @@ -21,7 +21,19 @@ BlSpace class >> spawnPage: aLePage from: anElement [ - opened in a new window." - ^ self new spawnPage: aLePage from: anElement + | aSpaceOrNil | + self + assert: [ aLePage isNotNil ] + description: [ 'Page must be non-nil' ]. + aSpaceOrNil := self + spawnTool: [ aLePage asPhlowTool ] + from: anElement. + aSpaceOrNil ifNotNil: [ :aSpace | + aSpace + title: aLePage printPageTabLabel; + icon: LeIcons lepiterPage ]. + + ^ aSpaceOrNil ] { #category : #'*Lepiter-UI' } diff --git a/src/Lepiter-UI/GtSlideReorderingHandler.class.st b/src/Lepiter-UI/GtSlideReorderingHandler.class.st new file mode 100644 index 000000000..e6ad4315d --- /dev/null +++ b/src/Lepiter-UI/GtSlideReorderingHandler.class.st @@ -0,0 +1,40 @@ +Class { + #name : #GtSlideReorderingHandler, + #superclass : #BlReorderingHandler, + #instVars : [ + 'page' + ], + #category : #'Lepiter-UI-Drag & Drop' +} + +{ #category : #initialization } +GtSlideReorderingHandler >> initialize [ + super initialize. + dragEndEventAction := [ :aBlDragEndEvent | + | newSlideOrder | + newSlideOrder := (aBlDragEndEvent currentTarget parent query + // LeSlideshowPageSlideGridElement) result collect: #snippet. + newSlideOrder = self page type elementSnippets + ifFalse: [ | copyOfSnippets currentElementSnippetIndex | + currentElementSnippetIndex := 1. + copyOfSnippets := self page children asArray. + copyOfSnippets + do: [ :aSnippet | self page children removeSnippet: aSnippet ]. + copyOfSnippets + do: [ :aSnippet | + (aSnippet isKindOf: LeElementSnippet) + ifTrue: [ self page basicAddSnippet: (newSlideOrder at: currentElementSnippetIndex). + currentElementSnippetIndex := currentElementSnippetIndex + 1 ] + ifFalse: [ self page basicAddSnippet: aSnippet ] ]. + self page announceTreeChanged: self page ] ] +] + +{ #category : #accessing } +GtSlideReorderingHandler >> page [ + ^ page +] + +{ #category : #accessing } +GtSlideReorderingHandler >> page: aLePage [ + page := aLePage +] diff --git a/src/Lepiter-UI/GtSlidesGridShowLessDetailEvent.class.st b/src/Lepiter-UI/GtSlidesGridShowLessDetailEvent.class.st new file mode 100644 index 000000000..1f1449369 --- /dev/null +++ b/src/Lepiter-UI/GtSlidesGridShowLessDetailEvent.class.st @@ -0,0 +1,5 @@ +Class { + #name : #GtSlidesGridShowLessDetailEvent, + #superclass : #BlEvent, + #category : #'Lepiter-UI-Basic - Events' +} diff --git a/src/Lepiter-UI/GtSlidesGridShowMoreDetailEvent.class.st b/src/Lepiter-UI/GtSlidesGridShowMoreDetailEvent.class.st new file mode 100644 index 000000000..b47f5e55f --- /dev/null +++ b/src/Lepiter-UI/GtSlidesGridShowMoreDetailEvent.class.st @@ -0,0 +1,5 @@ +Class { + #name : #GtSlidesGridShowMoreDetailEvent, + #superclass : #BlEvent, + #category : #'Lepiter-UI-Basic - Events' +} diff --git a/src/Lepiter-UI/LeElementSnippetEvaluated.class.st b/src/Lepiter-UI/LeElementSnippetEvaluated.class.st new file mode 100644 index 000000000..4611b83ea --- /dev/null +++ b/src/Lepiter-UI/LeElementSnippetEvaluated.class.st @@ -0,0 +1,5 @@ +Class { + #name : #LeElementSnippetEvaluated, + #superclass : #LeSnippetEvaluated, + #category : #'Lepiter-UI-Basic - Events' +} diff --git a/src/Lepiter-UI/LePage.extension.st b/src/Lepiter-UI/LePage.extension.st index 8a7f895f0..17a8cd5d4 100644 --- a/src/Lepiter-UI/LePage.extension.st +++ b/src/Lepiter-UI/LePage.extension.st @@ -40,16 +40,12 @@ LePage >> asLepiterReferencedPagePhlowTool: aReferencedPage [ { #category : #'*Lepiter-UI' } LePage >> asPhlowTool [ - ^ self asLepiterPagePhlowTool + ^ self type asLepiterPagePhlowTool ] { #category : #'*Lepiter-UI' } LePage >> asPreviewElement [ - - ^ LePageToolContentTreeElement new - withTitleOnly; - pageViewModel: self asContentUIModel; - matchParent + ^ self type asPreviewElement ] { #category : #'*Lepiter-UI' } @@ -276,7 +272,7 @@ LePage >> gtRemoveActionFor: anAction [ { #category : #'*Lepiter-UI' } LePage >> gtSpotterActDefaultFrom: aSpotterElement [ - BlSpace showTool: self asLepiterPagePhlowTool from: aSpotterElement + BlSpace showTool: self asPhlowTool from: aSpotterElement ] { #category : #'*Lepiter-UI' } diff --git a/src/Lepiter-UI/LePageType.extension.st b/src/Lepiter-UI/LePageType.extension.st index 8a5519cad..eada58968 100644 --- a/src/Lepiter-UI/LePageType.extension.st +++ b/src/Lepiter-UI/LePageType.extension.st @@ -1,6 +1,21 @@ Extension { #name : #LePageType } { #category : #'*Lepiter-UI' } +LePageType >> asLepiterPagePhlowTool [ + ^ (self class defaultSystemPageTypes includes: self class) + ifTrue: [ self page asLepiterPagePhlowTool ] + ifFalse: [ GtPhlowCompositeTool new + addTool: self defaultPhlowTool; + addTool: (GtPhlowExplicitTool new withLabelAndIconAptitude + icon: BrGlamorousVectorIcons inspect; + name: 'Page Type'; + stencil: [ (GtPhlowTool default object: self) asElement ]); + addTool: (GtPhlowExplicitTool new withLabelAndIconAptitude + icon: BrGlamorousVectorIcons inspect; + name: 'Page'; + stencil: [ (GtPhlowTool default object: self page) asElement ]) ] +] + LePageType >> asLepiterPagePhlowToolFocusStatus: aBoolean [ ^ GtPhlowCompositeTool new addTool: (LePagePhlowTool new diff --git a/src/Lepiter-UI/LeSlideshowPageElement.class.st b/src/Lepiter-UI/LeSlideshowPageElement.class.st new file mode 100644 index 000000000..558790384 --- /dev/null +++ b/src/Lepiter-UI/LeSlideshowPageElement.class.st @@ -0,0 +1,440 @@ +Class { + #name : #LeSlideshowPageElement, + #superclass : #BrHorizontalPane, + #instVars : [ + 'columnCount', + 'page', + 'slidesGridTool', + 'slidesDetailTool', + 'toolDetailAptitude' + ], + #category : #'Lepiter-UI-Slideshow Page Type' +} + +{ #category : #initialization } +LeSlideshowPageElement class >> page: aLePage [ + ^ self basicNew + page: aLePage; + initialize +] + +{ #category : #initialization } +LeSlideshowPageElement >> addExplainerToButtons: anElement [ + | buttonsToExplain | + buttonsToExplain := {#slidesChangeLayoutButton + -> (anElement query // #slidesChangeLayoutButton) anyOne. + #playSlidesButton -> (anElement query // #playSlidesButton) anyOne}. + buttonsToExplain + do: [ :each | + each value + preventChildrenMouseEvents; + addChild: (BrButton new + constraintsDo: [ :c | c ignoreByLayout ]; + size: 25 @ 25; + elevation: (BlRelativeElevation elevation: 10); + geometry: BlCircle new; + aptitude: (GtExplainerTargetAptitude new explanationModel: each key); + relocate: 5 @ each value extent y / 2) ]. + ^ anElement +] + +{ #category : #initialization } +LeSlideshowPageElement >> addSlideLabel [ + ^ BrLabel new + aptitude: (BrGlamorousLabelAptitude new fontSize: 20); + text: 'Add Slide'; + padding: (BlInsets top: 50) +] + +{ #category : #ui } +LeSlideshowPageElement >> changeLayoutButton [ + ^ BrButton new + id: #slidesChangeLayoutButton; + zIndex: 1000; + aptitude: BrGlamorousButtonWithIconAptitude; + margin: (BlInsets all: 25); + constraintsDo: [ :c | + c frame horizontal alignLeft. + c frame vertical alignTop ]; + label: 'Zoom out to change slide order'; + icon: self dynamicGridButtonIcon; + action: [ :aBrButton :aBrButtonModel :anEvent | + | grid | + anEvent consumed: true. + grid := (aBrButton parent query // #slidesGrid) result anyOne. + self columnCount = self summaryColumnCount + ifTrue: [ grid columnCount: self detailedColumnCount. + self columnCount: self detailedColumnCount. + aBrButton icon: self dynamicGridButtonIcon; + label: 'Zoom out to change slide order'. + (grid query // LeElementSnippetElement) result + do: [ :aSnippetElement | aSnippetElement showCoder ]. + self dispatchEvent: GtSlidesGridShowMoreDetailEvent new ] + ifFalse: [ grid columnCount: self summaryColumnCount. + self columnCount: self summaryColumnCount. + aBrButton icon: self dynamicGridButtonIcon; + label: 'Zoom in to work on slide code'. + (grid query // LeElementSnippetElement) result + do: [ :aSnippetElement | aSnippetElement hideCoder ]. + self dispatchEvent: GtSlidesGridShowLessDetailEvent new ] ] +] + +{ #category : #accessing } +LeSlideshowPageElement >> columnCount [ + ^ columnCount +] + +{ #category : #accessing } +LeSlideshowPageElement >> columnCount: anInteger [ + columnCount := anInteger +] + +{ #category : #ui } +LeSlideshowPageElement >> detailedColumnCount [ + ^ 2 +] + +{ #category : #ui } +LeSlideshowPageElement >> dynamicGridButtonIcon [ + | columns pane | + columns := {self detailedColumnCount. + self summaryColumnCount} detect: [ :each | (each = self columnCount) not ]. + pane := BrHorizontalPane new + matchParent; + addChild: (BrHorizontalGrid new + fitContent; + size: 20 @ 20; + cellSpacing: 1; + columnCount: columns; + addChildren: ((1 to: (columns = 4 ifTrue: [ 12 ] ifFalse: [ 4 ])) + collect: [ :_ | + BlElement new + size: (columns = 4 ifTrue: [ 4 @ 4 ] ifFalse: [ 8 @ 8 ]); + background: Color black ])). + ^ columns = 4 ifTrue: [ pane alignBottomCenter ] ifFalse: [ pane alignCenter ] +] + +{ #category : #accessing } +LeSlideshowPageElement >> elementSnippets [ + | result | + result := OrderedCollection new. + self page + withAllChildrenDepthFirstDo: [ :aSnippet | (aSnippet isKindOf: LeElementSnippet) ifTrue: [ result add: aSnippet ] ]. + + ^ result +] + +{ #category : #initialization } +LeSlideshowPageElement >> howToEditor [ + ^ (BrEditor new + aptitude: BrGlamorousRegularEditorAptitude new; + beReadOnlyWithSelection; + text: self howToText) + constraintsDo: [ :c | + c vertical fitContent. + c horizontal matchParent ]; + margin: (BlInsets + top: 10 + left: 50 + bottom: 0 + right: 10) +] + +{ #category : #initialization } +LeSlideshowPageElement >> howToText [ + ^ 'Add a slide above or continue reading below for instructions on how to use this tool. + +The two views below show the two views this tool has. On the left is the view you will see when the tool is in expanded mode. On the right is the view you wil see when the tool is in ''minimized mode'' (when there are two miller columns in the current pager). + +You will not see both tools at once, only shown here for explanatory purposes. + +The view on the left has a scrollable list of slides and a detailed view of a single slide where you can modify the slide code. Try it out! You can use the + and x buttons on each slide to add (either empty or from templates) or delete slides respectively. + +The view on the right is scrollable as well. It has two buttons: + - The ' + asRopedText + , ('change layout' asRopedText glamorousExplanationFor: #slidesChangeLayoutButton) + , ' button toggles the amount of columns shown as well as the slide code. When in ''summmary mode'', when you can''t see the slide code, you can drag and drop slides around to modify their order. Try it out! + - The ' + asRopedText + , ('play slideshow' asRopedText glamorousExplanationFor: #playSlidesButton) + , ' button generates a slideshow from the current slides in a new window.' asRopedText +] + +{ #category : #initialization } +LeSlideshowPageElement >> howToTool [ + | verticalPane | + verticalPane := BrVerticalPane new matchParent + alignBottomCenter; + addChildren: {self addSlideLabel. + self newAddSlideDropdown. + self howToEditor. + self toolForExplainer}. + verticalPane explainer isExplanationHolder: true. + self addExplainerToButtons: verticalPane. + ^ verticalPane +] + +{ #category : #initialization } +LeSlideshowPageElement >> initializaTools [ + toolDetailAptitude + ifNotNil: [ self removeAptitude: toolDetailAptitude. + toolDetailAptitude := nil ]. + self page type elementSnippets size = 0 + ifTrue: [ self + removeChildren; + addChild: self howToTool asElement ] + ifFalse: [ self + removeChildren; + addChildren: {slidesDetailTool := self slidesDetailTool. + slidesGridTool := self slidesGridTool}; + addAptitude: (toolDetailAptitude := GtPhlowToolDetailAptitude new + normal: [ :aStyle | + aStyle + do: [ slidesDetailTool visibility: BlVisibility gone. + slidesGridTool visibility: BlVisibility visible ] ]; + detailed: [ :aStyle | + aStyle + do: [ slidesDetailTool visibility: BlVisibility visible. + slidesGridTool visibility: BlVisibility gone ] ]) ] +] + +{ #category : #initialization } +LeSlideshowPageElement >> initialize [ + super initialize. + self phlow beViewContent. + self + id: #slideshowPageTool; + matchParent. + self initializaTools. + self page announcer weak + when: LeContentTreeRemoved + do: [ :anAnnouncement | + self page type elementSnippets size = 0 + ifTrue: [ self initializaTools ] ] +] + +{ #category : #initialization } +LeSlideshowPageElement >> newAddSlideDropdown [ + + | aButton | + aButton := self newPlusElement. + aButton + addAptitude: (BrGlamorousWithExplicitDropdownAptitude + handle: [ self newPlusElement + aptitude: BrIconAptitude; + background: BrGlamorousColors secondaryHeaderBackgroundColor ] + content: [ GtSpotterDropdownButtonStencil new + valuable: LeSlideshowPageSpotterStart new; + extent: [ 800 @ 600 ]; + objectActOn: [ :anActOnEvent :aMenuItem :theButton | + self page addSnippet: aMenuItem asSnippet. + self initializaTools. + anActOnEvent beActed ]; + spotterElementFor: aButton ] + containerDo: [ :aMenuContainer | aMenuContainer background: BrGlamorousColors secondaryHeaderBackgroundColor ]) + doNotHideWidget. + ^ aButton +] + +{ #category : #initialization } +LeSlideshowPageElement >> newPlusElement [ + + ^ GtInspectorRoundButtonStencil large asElement + icon: (BrPlusIconStencil add + thickness: 1; + radius: 4; + asElement); + margin: (BlInsets top: 10 bottom: 10) +] + +{ #category : #ui } +LeSlideshowPageElement >> onSnippetAdded: aGrid createElementOfClass: aClass [ + self page announcer weak + when: LeContentTreeAdded + do: [ :anAnnouncement | + (anAnnouncement content isKindOf: LeElementSnippet) + ifTrue: [ | indexOfNewSnippet pageSnippets | + pageSnippets := self page type elementSnippets. + indexOfNewSnippet := pageSnippets indexOf: anAnnouncement content. + aGrid + addChild: (aClass forSnippet: anAnnouncement content) + at: indexOfNewSnippet ] ] +] + +{ #category : #ui } +LeSlideshowPageElement >> onSnippetRemoved: aGrid [ + self page announcer weak + when: LeContentTreeRemoved + do: [ :anAnnouncement | + (anAnnouncement content isKindOf: LeElementSnippet) + ifTrue: [ aGrid children + detect: [ :each | [ each snippet = anAnnouncement content ] on: MessageNotUnderstood do: [ false ] ] + ifFound: [ :found | + (found isKindOf: LeSlideshowPageSlideListDetailElement) + ifTrue: [ aGrid replaceChild: found with: self placeholderElement ] + ifFalse: [ aGrid removeChild: found ] ] ] ] +] + +{ #category : #accessing } +LeSlideshowPageElement >> page [ + ^ page +] + +{ #category : #accessing } +LeSlideshowPageElement >> page: aLePge [ + page := aLePge +] + +{ #category : #ui } +LeSlideshowPageElement >> placeholderElement [ + ^ BlTextElement + text: ('Select a slide to work on' asRopedText foreground: Color lightGray) +] + +{ #category : #ui } +LeSlideshowPageElement >> playSlideshowButton [ + ^ BrButton new + id: #playSlidesButton; + zIndex: 1000; + aptitude: BrGlamorousButtonWithIconAptitude; + margin: (BlInsets all: 25); + constraintsDo: [ :c | + c frame horizontal alignRight. + c frame vertical alignTop ]; + label: 'Play slideshow in new window'; + icon: BrGlamorousVectorIcons play; + action: [ :aBrButton :aBrButtonModel :anEvent | + | gtPresenterSlideshow slideshowElement slideshowViewModel | + anEvent consumed: true. + gtPresenterSlideshow := GtPresenterSlideShow new. + gtPresenterSlideshow slides + slides: (self elementSnippets + collect: [ :elementSnippet | + GtPresenterSlide new + stencil: [ GtElementLiveSlide new + element: [ elementSnippet coder asCoderViewModel doIt value ] ] + asStencil ]). + slideshowViewModel := GtPresenterSlideShowViewModel new + slideShow: gtPresenterSlideshow. + slideshowElement := GtPresenterSlideShowElement new + slideShowViewModel: slideshowViewModel. + BlSpace new + withSceneDriller; + addChild: slideshowElement; + show ] +] + +{ #category : #ui } +LeSlideshowPageElement >> slidesDetailTool [ + | pane slideDetailContainer | + pane := BrHorizontalPane new + id: #slidesDetailTool; + matchParent. + slideDetailContainer := BrVerticalPane new + id: #slidesDetail; + padding: (BlInsets all: 10); + matchParent; + alignCenter; + constraintsDo: [ :c | c linear weight: 4 ]; + addChild: self placeholderElement. + self onSnippetRemoved: slideDetailContainer. + + ^ pane + addChildren: {self slidesList. + slideDetailContainer} +] + +{ #category : #ui } +LeSlideshowPageElement >> slidesGrid [ + self columnCount: self detailedColumnCount. + ^ BrHorizontalGrid new + id: #slidesGrid; + hMatchParent; + vFitContent; + columnCount: self columnCount; + cellSpacing: 10; + addChildren: (self elementSnippets + collect: [ :aSnippet | LeSlideshowPageSlideGridElement forSnippet: aSnippet ]) +] + +{ #category : #ui } +LeSlideshowPageElement >> slidesGridTool [ + | aFrame aGrid aScrollable | + aFrame := BrFrame new + id: #slidesGridTool; + matchParent. + aGrid := self slidesGrid. + aScrollable := BrFrame new + hMatchParent; + vFitContent; + addChild: aGrid; + asScrollableElement. + aFrame + addChildren: {aScrollable. + self changeLayoutButton. + self playSlideshowButton}. + self onSnippetAdded: aGrid createElementOfClass: LeSlideshowPageSlideGridElement. + self onSnippetRemoved: aGrid. + + ^ aFrame +] + +{ #category : #ui } +LeSlideshowPageElement >> slidesList [ + | aVerticalPane | + aVerticalPane := BrVerticalPane new + id: #slidesList; + hMatchParent; + vFitContent; + padding: (BlInsets all: 10); + constraintsDo: [ :c | c linear weight: 1 ]; + cellSpacing: 10; + addAptitude: BrShadowAptitude new + + (BrGlamorousSlideExteriorAptitude new + backgroundPaint: Color white; + borderPaint: Color transparent); + addChildren: (self elementSnippets + collect: [ :aSnippet | LeSlideshowPageSlideListElement forSnippet: aSnippet ]). + self onSnippetAdded: aVerticalPane createElementOfClass: LeSlideshowPageSlideListElement. + self onSnippetRemoved: aVerticalPane. + self page announcer weak + when: LeContentTreeChanged + do: [ :anEvent | + anEvent content = self page + ifTrue: [ | slideElements | + slideElements := aVerticalPane children + groupedBy: [ :each | each snippet uid ]. + aVerticalPane removeChildren. + self elementSnippets + do: [ :each | aVerticalPane addChild: (slideElements at: each uid) first ] ] ]. + ^ aVerticalPane asScrollableElement +] + +{ #category : #ui } +LeSlideshowPageElement >> summaryColumnCount [ + ^ 4 +] + +{ #category : #initialization } +LeSlideshowPageElement >> toolForExplainer [ + | tool samplePage | + samplePage := LeSlideshowPageType samplePage. + tool := samplePage type tool. + tool + removeAptitude: (tool aptitude children + detect: [ :each | each isKindOf: GtPhlowToolDetailAptitude ]). + tool children + do: [ :each | + each + margin: (BlInsets + top: 25 + bottom: 25 + left: 25 + right: 25); + addAptitude: BrShadowAptitude new + + (BrGlamorousButtonExteriorAptitude new + backgroundPaint: Color white; + borderPaint: Color transparent) ]. + ^ tool +] diff --git a/src/Lepiter-UI/LeSlideshowPageSlideElement.class.st b/src/Lepiter-UI/LeSlideshowPageSlideElement.class.st new file mode 100644 index 000000000..c772b4fa1 --- /dev/null +++ b/src/Lepiter-UI/LeSlideshowPageSlideElement.class.st @@ -0,0 +1,58 @@ +Class { + #name : #LeSlideshowPageSlideElement, + #superclass : #BrFrame, + #instVars : [ + 'snippet' + ], + #category : #'Lepiter-UI-Slideshow Page Type' +} + +{ #category : #initialization } +LeSlideshowPageSlideElement class >> forSnippet: aLeElementSnippet [ + ^ self basicNew + snippet: aLeElementSnippet; + initialize +] + +{ #category : #initialization } +LeSlideshowPageSlideElement >> initialize [ + super initialize. + self addChild: self snippetAsElement. + self snippet weak + when: LeUIPageChildEvaluationAnnouncement + do: [ :anEvent | + anEvent evaluatedBlockElement = self + ifFalse: [ (self query // LeElementSnippetElement) result first generateDisplayElement ] ]. + self + when: LeElementSnippetEvaluated + do: [ :anEvent | + anEvent consumed: true. + self snippet notifier local + announce: (LeUIPageChildEvaluationAnnouncement new + evaluatedBlock: anEvent snippet; + evaluatedBlockElement: anEvent element; + topParentElement: self) ] +] + +{ #category : #accessing } +LeSlideshowPageSlideElement >> parentTool [ + ^ self phlow firstParentWithViewContent +] + +{ #category : #accessing } +LeSlideshowPageSlideElement >> snippet [ + ^ snippet +] + +{ #category : #accessing } +LeSlideshowPageSlideElement >> snippet: aLeElementSnippet [ + snippet := aLeElementSnippet +] + +{ #category : #initialization } +LeSlideshowPageSlideElement >> snippetAsElement [ + ^ self snippet + elementHeight: 200; + codeHeight: 200; + asSlideshowPageElement +] diff --git a/src/Lepiter-UI/LeSlideshowPageSlideGridElement.class.st b/src/Lepiter-UI/LeSlideshowPageSlideGridElement.class.st new file mode 100644 index 000000000..02cfca1bf --- /dev/null +++ b/src/Lepiter-UI/LeSlideshowPageSlideGridElement.class.st @@ -0,0 +1,49 @@ +Class { + #name : #LeSlideshowPageSlideGridElement, + #superclass : #LeSlideshowPageSlideElement, + #instVars : [ + 'reorderingHandler', + 'parentTool' + ], + #category : #'Lepiter-UI-Slideshow Page Type' +} + +{ #category : #initialization } +LeSlideshowPageSlideGridElement >> initialize [ + super initialize. + + + self + vFitContent; + hMatchParent; + addAptitude: BrShadowAptitude new + + (BrGlamorousSlideExteriorAptitude new + backgroundPaint: Color white; + borderPaint: Color transparent); + when: BlMouseLeaveEvent + do: [ :anEvent | + anEvent consumed: true. + self hasFocus ifTrue: [ self loseFocus ] ]; + when: BlElementAddedToSceneGraphEvent + do: [ :anEvent | + anEvent consumed: true. + parentTool + ifNil: [ parentTool := self parentTool. + parentTool + when: GtSlidesGridShowMoreDetailEvent + do: [ :anAnnouncement | + self + allowChildrenMouseEvents; + removeEventHandler: self reorderingHandler ]; + when: GtSlidesGridShowLessDetailEvent + do: [ :anAnnouncement | + self + preventChildrenMouseEvents; + addEventHandler: self reorderingHandler ] ] ] +] + +{ #category : #accessing } +LeSlideshowPageSlideGridElement >> reorderingHandler [ + ^ reorderingHandler + ifNil: [ reorderingHandler := GtSlideReorderingHandler new page: self snippet page ] +] diff --git a/src/Lepiter-UI/LeSlideshowPageSlideListDetailElement.class.st b/src/Lepiter-UI/LeSlideshowPageSlideListDetailElement.class.st new file mode 100644 index 000000000..0b279dc22 --- /dev/null +++ b/src/Lepiter-UI/LeSlideshowPageSlideListDetailElement.class.st @@ -0,0 +1,21 @@ +Class { + #name : #LeSlideshowPageSlideListDetailElement, + #superclass : #LeSlideshowPageSlideElement, + #category : #'Lepiter-UI-Slideshow Page Type' +} + +{ #category : #initialization } +LeSlideshowPageSlideListDetailElement >> initialize [ + super initialize. + self + matchParent; + when: BlElementExtentChangedEvent + do: [ :anEvent | + | snippetElement | + anEvent consumed: true. + snippetElement := anEvent currentTarget children first children first. + snippetElement + updateCoderHeightTo: snippetElement parent parent extent y * 0.25; + updateElementHeightTo: snippetElement parent parent extent y * 0.70 ]. + (self query // #'source-coder--editor') result first requestFocus +] diff --git a/src/Lepiter-UI/LeSlideshowPageSlideListElement.class.st b/src/Lepiter-UI/LeSlideshowPageSlideListElement.class.st new file mode 100644 index 000000000..0a0ea19f9 --- /dev/null +++ b/src/Lepiter-UI/LeSlideshowPageSlideListElement.class.st @@ -0,0 +1,35 @@ +Class { + #name : #LeSlideshowPageSlideListElement, + #superclass : #LeSlideshowPageSlideElement, + #category : #'Lepiter-UI-Slideshow Page Type' +} + +{ #category : #initialization } +LeSlideshowPageSlideListElement >> initialize [ + super initialize. + self + matchParent; + preventChildrenMouseEvents; + addAptitude: BrShadowAptitude new + + (BrGlamorousSlideExteriorAptitude new + backgroundPaint: Color white; + borderPaint: Color transparent); + when: BlClickEvent + do: [ :anEvent | + | detailedSlideContainer | + anEvent consumed: true. + self allowChildrenMouseEvents. + detailedSlideContainer := anEvent currentTarget + allParentsDetect: [ :anElement | anElement id asSymbol = #slidesDetailTool ] + ifFound: [ :found | found children second ] + ifNone: [ nil ]. + detailedSlideContainer + replaceChild: detailedSlideContainer children first + with: (LeSlideshowPageSlideListDetailElement forSnippet: self snippet) ]; + when: BlMouseLeaveEvent + do: [ :anEvent | + anEvent consumed: true. + self hasFocus ifTrue: [ self loseFocus ]. + self preventChildrenMouseEvents ]. + (self query // LeElementSnippetElement) result first hideCoder +] diff --git a/src/Lepiter-UI/TLeUnknownPageType.extension.st b/src/Lepiter-UI/TLeUnknownPageType.extension.st new file mode 100644 index 000000000..ae3d85d5f --- /dev/null +++ b/src/Lepiter-UI/TLeUnknownPageType.extension.st @@ -0,0 +1,15 @@ +Extension { #name : #TLeUnknownPageType } + +{ #category : #'*Lepiter-UI' } +TLeUnknownPageType >> asLepiterPagePhlowTool [ + ^ GtPhlowCompositeTool new + addTool: self defaultPhlowTool; + addTool: (GtPhlowExplicitTool new withLabelAndIconAptitude + icon: BrGlamorousVectorIcons debug; + name: 'Unknown (' , self pageType asString , ') Page Type'; + stencil: [ (GtPhlowTool default object: self) asElement ]); + addTool: (GtPhlowExplicitTool new withLabelAndIconAptitude + icon: BrGlamorousVectorIcons inspect; + name: 'Page'; + stencil: [ (GtPhlowTool default object: self page) asElement ]) +]