[Cuis-dev] Morphic-Widget repo (ExamplesBrowser)

Sat Dec 11 08:51:09 PST 2021

El 11/12/21 a las 08:49, Mariano Montone escribió:
> What I'd be interested in implementing is a widgets browser, a tool that
> lets you select a widget from a list and opens several examples of how
> the widget is used and how it looks.

I've started an implementation of this :)

Demo:
https://drive.google.com/file/d/1bDs9IH85VNRdYovbMxO4e2XqDCMn8sY-/view?usp=sharing

All system methods that contain examples are collected, so the tool is
useful for any kind of examples, not only for Morphs.

I attach the current implementation in case someone wants to give it a try.

I'm still thinking about the best way of displaying an example; the
class method source is displayed for now, but that may change.

Cheers,

Mariano
-------------- next part --------------
'From Cuis 5.0 [latest update: #4999] on 11 December 2021 at 1:33:29 pm'!
'Description '!
!provides: 'ExamplesBrowser' 1 11!
SystemOrganization addCategory: 'ExamplesBrowser'!

!classDefinition: #ExamplesBrowserWindow category: 'ExamplesBrowser'!
SystemWindow subclass: #ExamplesBrowserWindow
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ExamplesBrowser'!
!classDefinition: 'ExamplesBrowserWindow class' category: 'ExamplesBrowser'!
ExamplesBrowserWindow class
	instanceVariableNames: ''!

!classDefinition: #ExamplesBrowser category: 'ExamplesBrowser'!
Object subclass: #ExamplesBrowser
	instanceVariableNames: 'examples categoriesIndex subCategoriesIndex examplesListIndex subCategoriesList examplesList categoriesList'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ExamplesBrowser'!
!classDefinition: 'ExamplesBrowser class' category: 'ExamplesBrowser'!
ExamplesBrowser class
	instanceVariableNames: ''!

!ExamplesBrowserWindow methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:05:09'!
buildMorphicWindow

	| navigationLayout categoriesList subCategoriesList examplesList content buttons docsMorph |

	navigationLayout _ LayoutMorph newColumn.

	categoriesList _ PluggableListMorph model: model 
					listGetter: #examplesCategories 
					indexGetter: #examplesCategoriesIndex 
					indexSetter: #examplesCategoriesIndex:.

	subCategoriesList _ PluggableListMorph model: model 
						listGetter: #examplesSubCategories
						indexGetter: #examplesSubCategoriesIndex 
						indexSetter: #examplesSubCategoriesIndex:.

	examplesList _ PluggableListMorph model: model 
						listGetter: #examplesList
						indexGetter: #examplesListIndex
						indexSetter: #examplesListIndex:.

	navigationLayout 
		addMorph: categoriesList proportionalHeight: 0.33;
		addAdjusterAndMorph: subCategoriesList proportionalHeight: 0.33;
		addAdjusterAndMorph: examplesList proportionalHeight: 0.33.

	layoutMorph addMorph: navigationLayout proportionalWidth: 0.33.

	content _ LayoutMorph newColumn.

	docsMorph _ TextModelMorph textProvider: model textGetter: #exampleDocumentation.
	content addMorphUseAll: docsMorph.

	buttons _ LayoutMorph newRow.

	buttons addMorph: (PluggableButtonMorph model: model action: #runExample label: 'Run').
	buttons addMorph: (PluggableButtonMorph model: model action: #inspectExample label: 'Inspect').
	buttons addMorph: (PluggableButtonMorph model: model action: #exploreExample label: 'Explore').
	buttons addMorph: (PluggableButtonMorph model: model action: #browseExample label: 'Browse').
	content addMorph: buttons fixedHeight: 30.

	layoutMorph addAdjusterAndMorph: content layoutSpec: LayoutSpec useAll.! !

!ExamplesBrowserWindow methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 11:12:16'!
initialize

	super initialize.

	self beRow.! !

!ExamplesBrowserWindow class methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 11:51:07'!
open
	"self open"
	^ self open: ExamplesBrowser new label: 'Examples browser'! !

!ExamplesBrowserWindow class methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 13:31:57'!
worldMenuForOpenGroup
	^ `{{
			#itemGroup 				-> 	10.
			#itemOrder 				-> 	50.
			#label 				->	'Examples Browser'.
			#object 				-> 	ExamplesBrowserWindow.
			#selector 				-> 	#open.
			#icon 				-> 	#morphsIcon.
			#balloonText 				-> 	'A browser tool for running examples'.
		} asDictionary}`! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:11:46'!
browseExample

	self currentExample ifNotNil: [:example | example browse]
		! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:12:46'!
collectExamples

	"Collect examples in Smalltalk system"

	"Traverse all system classes looking for class methods that start with #example or are annotated with an 'example' pragma."

	examples _ Dictionary new.

	Smalltalk organization categories do: [:cat |
		(Smalltalk organization classesAt: cat) do: [:class | | annotatedMethods namedMethods exampleMethods |
			annotatedMethods _ (Pragma allNamed: #example in: class) collect: #method.
			namedMethods _ class class methodsSelect: [:method | method selector asString includesSubstring: 'example' caseSensitive: false].
			exampleMethods _ (annotatedMethods, namedMethods) asSet asOrderedCollection.
			exampleMethods ifNotEmpty: [ | catExamples |
				examples at: cat ifAbsent: [examples at: cat put: Dictionary new].
				catExamples _ examples at: cat.
				catExamples at: class name put: exampleMethods]]].! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 11:49:59'!
currentCategory

	^ categoriesIndex ifNotNil: [:index | categoriesList at: index]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 11:49:41'!
currentExample

	^ examplesListIndex ifNotNil: [:index | examplesList at: index]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 11:49:21'!
currentSubCategory

	^ subCategoriesIndex ifNotNil: [:index | subCategoriesList at: index]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:07:19'!
exampleDocumentation

	^ self currentExample 
		ifNotNil: [:example | 
			String streamContents: [:s |
				s nextPutAll: example getSource]]
		ifNil: ['']! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 10:23:48'!
examplesCategories
	^ examples keys! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 10:40:42'!
examplesCategoriesIndex
	^ categoriesIndex ifNil: [0]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 13:19:36'!
examplesCategoriesIndex: anIndex

	anIndex isZero ifTrue: [^ categoriesIndex _ nil].

	categoriesIndex _ anIndex.

	subCategoriesList _ (examples at: self currentCategory) keys.
	self changed: #examplesSubCategories.

	self examplesSubCategoriesIndex: 1! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 10:24:11'!
examplesInCategory: aCategory
	^ examples at: aCategory! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 13:06:35'!
examplesList
	^ examplesList collect: [:example | self formatExampleName: example selector asString]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 10:43:04'!
examplesListIndex
	^ examplesListIndex ifNil: [0]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:09:19'!
examplesListIndex: anIndex

	anIndex isZero ifTrue: [^ examplesListIndex _ nil].
	examplesListIndex _ anIndex.
	self changed: #exampleDocumentation! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 11:53:07'!
examplesSubCategories

	^ subCategoriesList ! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 10:42:10'!
examplesSubCategoriesIndex
	^ subCategoriesIndex ifNil: [0]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 13:18:53'!
examplesSubCategoriesIndex: anIndex
	anIndex isZero ifTrue: [^ subCategoriesIndex _ nil].
	subCategoriesIndex _ anIndex.

	examplesList _ (examples at: self currentCategory) at: self currentSubCategory.
	self changed: #examplesList.
	self examplesListIndex: 1.! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:35:32'!
exploreExample
	self currentExample ifNotNil: [:example | (example methodClass soleInstance perform: example selector) explore]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 13:09:46'!
formatExampleName: aString

	^ String streamContents: [:s |
		s nextPut: aString first asUppercase.
		aString allButFirstDo: [:char |
			char isDigit ifTrue: [
				s nextPut: Character space; nextPut: char]
			ifFalse: [
				char isUppercase ifTrue: [
					s nextPut: Character space;					nextPut: char asLowercase]
				ifFalse: [s nextPut: char]]]]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 10:52:26'!
initialize

	self collectExamples.
	categoriesList _ examples keys.
	subCategoriesList _ OrderedCollection new.
	examplesList _ OrderedCollection new.! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:35:24'!
inspectExample
	self currentExample ifNotNil: [:example | (example methodClass soleInstance perform: example selector) inspect]! !

!ExamplesBrowser methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 12:37:28'!
runExample
	self currentExample ifNotNil: [:example | |result|
		result _ example methodClass soleInstance perform: example selector.
		(result isKindOf: Morph) ifTrue: [result openInWorld]]! !

!ExamplesBrowser class methodsFor: 'as yet unclassified' stamp: 'MM 12/11/2021 13:22:45'!
windowColor
	^ Color lightOrange! !