From af4e4ab515966f61d37cac7b1d4818dea9138b04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Fri, 27 Jan 2023 07:18:28 -0300 Subject: [PATCH 1/5] Add buildMicrodownUsing:withComment: as extension methods in Ring. See https://github.com/pharo-project/pharo/pull/12425#pullrequestreview-1272249086 for details. --- src/Microdown/RGBehavior.extension.st | 11 +++++++++++ src/Microdown/RGPackage.extension.st | 11 +++++++++++ 2 files changed, 22 insertions(+) create mode 100644 src/Microdown/RGBehavior.extension.st create mode 100644 src/Microdown/RGPackage.extension.st diff --git a/src/Microdown/RGBehavior.extension.st b/src/Microdown/RGBehavior.extension.st new file mode 100644 index 00000000..7d78e693 --- /dev/null +++ b/src/Microdown/RGBehavior.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #RGBehavior } + +{ #category : #'*Microdown' } +RGBehavior >> buildMicroDownUsing: aMicMicrodownTextualBuilder withComment: aString [ + + aMicMicrodownTextualBuilder + header: [ aMicMicrodownTextualBuilder text: 'Class: '. + aMicMicrodownTextualBuilder text: self name ] withLevel: 1; + horizontalLine; + text: aString +] diff --git a/src/Microdown/RGPackage.extension.st b/src/Microdown/RGPackage.extension.st new file mode 100644 index 00000000..00f67c88 --- /dev/null +++ b/src/Microdown/RGPackage.extension.st @@ -0,0 +1,11 @@ +Extension { #name : #RGPackage } + +{ #category : #'*Microdown' } +RGPackage >> buildMicroDownUsing: aMicMicrodownTextualBuilder withComment: aString [ + + aMicMicrodownTextualBuilder + header: [ aMicMicrodownTextualBuilder text: 'Class: '. + aMicMicrodownTextualBuilder text: self name ] withLevel: 1; + horizontalLine; + text: aString +] From 3b5853de540f8b7357eaa1482f20c8152dfc40e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Sat, 25 Mar 2023 10:33:06 +0100 Subject: [PATCH 2/5] Adding MicDocumentHierarchyBuilder --- .../MicDocumentHierarchyBuilder.class.st | 198 ++++++++++++++++++ 1 file changed, 198 insertions(+) create mode 100644 src/Microdown-RichTextComposer/MicDocumentHierarchyBuilder.class.st diff --git a/src/Microdown-RichTextComposer/MicDocumentHierarchyBuilder.class.st b/src/Microdown-RichTextComposer/MicDocumentHierarchyBuilder.class.st new file mode 100644 index 00000000..4e70f426 --- /dev/null +++ b/src/Microdown-RichTextComposer/MicDocumentHierarchyBuilder.class.st @@ -0,0 +1,198 @@ +" +Create a hierarchy tree to show in microdown documentation. +This builder allows you to create the nice hierarchy you can see at `SpAbstractWidgetPresenter` class comment (in hierarchy section). + +## Example +```Smalltalk +SpDocumentHierarchyBuilder new + ""The class where to start the hierarchy (a superclass of aClass)"" + fromClass: aTopClass; + ""The microdown builder"" + builder: aBuilder; + ""A filter to make sure we include classes we want in hierarchy"" + filter: [ :eachClass | eachClass package packageName beginsWith: 'Spec2-' ]; + ""Build the hierarchy for the class aClass"" + buildFor: aClass +``` +" +Class { + #name : #MicDocumentHierarchyBuilder, + #superclass : #Object, + #instVars : [ + 'topClass', + 'flattenTree', + 'builder', + 'filterBlock', + 'class', + 'fromClass' + ], + #category : #'Microdown-RichTextComposer' +} + +{ #category : #private } +MicDocumentHierarchyBuilder >> addLevel: level from: aClass [ + "'├ ─ ╰ │'" + | path | + + path := (aClass allSuperclasses copyUpTo: self topClass) reversed. + + builder monospace: ' '. + + path do: [ :each | + builder monospace: ((self isPassingThrough: aClass topLevel: each) + ifTrue: [ '│ ' ] + ifFalse: [ ' ' ]) ]. + + level > 0 ifTrue: [ + | list | + list := flattenTree at: aClass superclass ifAbsent: [ #() ]. + list ifNotEmpty: [ + builder monospace: ((list size = 1 or: [ list last = aClass ]) + ifTrue: [ '╰─ ' ] + ifFalse: [ '├─ ' ]) ] ]. + + builder monospace: aClass name. + aClass = class + ifTrue: [ builder monospace: ' (this is me)' ]. + builder newLine. + (flattenTree at: aClass) do: [ :each | + self + addLevel: level + 1 + from: each ] +] + +{ #category : #private } +MicDocumentHierarchyBuilder >> addLevel: level from: aClass to: stream [ + "'├ ─ ╰ │'" + | path | + + path := (aClass allSuperclasses copyUpTo: self topClass) reversed. + + path do: [ :each | + stream << ((self isPassingThrough: aClass topLevel: each) + ifTrue: [ '│ ' ] + ifFalse: [ ' ' ]) ]. + + level > 0 ifTrue: [ + | list | + list := flattenTree at: aClass superclass ifAbsent: [ #() ]. + list ifNotEmpty: [ + (list size = 1 or: [ list last = aClass ]) + ifTrue: [ stream << '╰─ ' ] + ifFalse: [ stream << '├─ ' ] ] ]. + + stream << aClass name. + stream newLine. + (flattenTree at: aClass) do: [ :each | + self + addLevel: level + 1 + from: each + to: stream ] +] + +{ #category : #private } +MicDocumentHierarchyBuilder >> applyFilterTo: aCollection [ + + filterBlock ifNil: [ ^ aCollection ]. + ^ aCollection select: filterBlock +] + +{ #category : #building } +MicDocumentHierarchyBuilder >> buildFor: aClass [ + + self fillTreeOf: aClass. + self + addLevel: 0 + from: self fromClass +] + +{ #category : #building } +MicDocumentHierarchyBuilder >> buildStringFor: aClass [ + + self fillTreeOf: aClass. + ^ String streamContents: [ :stream | + self + addLevel: 0 + from: SpAbstractPresenter + to: (ZnNewLineWriterStream on: stream) ] +] + +{ #category : #accessing } +MicDocumentHierarchyBuilder >> builder: aBuilder [ + + builder := aBuilder +] + +{ #category : #private } +MicDocumentHierarchyBuilder >> fillTreeOf: aClass [ + + class := aClass. + flattenTree := OrderedDictionary new. + self fillTreeWithSuperclassesOf: aClass. + self fillTreeWithSubclassesOf: aClass. + + ^ flattenTree +] + +{ #category : #private } +MicDocumentHierarchyBuilder >> fillTreeWithSubclassesOf: aClass [ + + flattenTree at: aClass put: (self applyFilterTo: aClass subclasses). + aClass subclasses do: [ :each | + self fillTreeWithSubclassesOf: each ] +] + +{ #category : #private } +MicDocumentHierarchyBuilder >> fillTreeWithSuperclassesOf: aClass [ + | superclasses | + + superclasses := (aClass allSuperclasses copyUpTo: self topClass) reversed. + superclasses do: [ :each | + flattenTree + at: each + put: { (superclasses + after: each + ifAbsent: [ aClass ]) } ]. + +] + +{ #category : #accessing } +MicDocumentHierarchyBuilder >> filter: aBlock [ + + filterBlock := aBlock +] + +{ #category : #accessing } +MicDocumentHierarchyBuilder >> fromClass [ + + ^ fromClass ifNil: [ SpAbstractPresenter ] +] + +{ #category : #accessing } +MicDocumentHierarchyBuilder >> fromClass: aClass [ + + fromClass := aClass +] + +{ #category : #testing } +MicDocumentHierarchyBuilder >> isPassingThrough: aClass topLevel: aTopClass [ + | superclasses | + + superclasses := flattenTree at: aTopClass superclass ifAbsent: [ #() ]. + superclasses size <= 1 ifFalse: [ + ^ (superclasses indexOf: aTopClass) < superclasses size ]. + + ^ false +] + +{ #category : #accessing } +MicDocumentHierarchyBuilder >> topClass [ + + ^ topClass ifNil: [ self fromClass superclass ] +] + +{ #category : #accessing } +MicDocumentHierarchyBuilder >> topClass: aClass [ + + topClass := aClass +] From fa2288f1997beeaedd4d00f874a247e4ed84f8af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Sat, 25 Mar 2023 20:59:26 +0100 Subject: [PATCH 3/5] Getting started to improve the class comment template with example support. --- src/Microdown/Class.extension.st | 64 +++++++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) diff --git a/src/Microdown/Class.extension.st b/src/Microdown/Class.extension.st index aa581f5d..3343f437 100644 --- a/src/Microdown/Class.extension.st +++ b/src/Microdown/Class.extension.st @@ -1,5 +1,31 @@ Extension { #name : #Class } +{ #category : #'*Microdown' } +Class >> addDocumentSectionExampleCodeTo: aBuilder [ + + | exampleCode | + exampleCode := self documentExampleCode. + exampleCode ifNil: [ ^ self ]. + + aBuilder newLine. + aBuilder header: [ :builder | builder text: 'Example code' ] withLevel: 2. + aBuilder newLine. + aBuilder codeblock: exampleCode +] + +{ #category : #'*Microdown' } +Class >> addDocumentSectionTo: aBuilder label: label methods: methods [ + + methods ifEmpty: [ ^ self ]. + + aBuilder newLine. + aBuilder header: [ :builder | builder text: label ] withLevel: 2. + aBuilder unorderedListDuring: [ + (methods sorted: #selector ascending) do: [ :each | + aBuilder item: [ + aBuilder monospace: (each methodClass name, '>>#', each selector) ] ] ] +] + { #category : #'*Microdown' } Class >> buildMicroDownUsing: aBuilder withComment: aString [ @@ -7,5 +33,41 @@ Class >> buildMicroDownUsing: aBuilder withComment: aString [ header: [ aBuilder text: 'Class: '. aBuilder text: self name ] withLevel: 1; horizontalLine; - text: aString + text: aString. + + self addDocumentSectionExampleCodeTo: aBuilder. + + self + addDocumentSectionTo: aBuilder + label: 'Examples' + methods: (self class methods select: [ :each | each protocol = self documentExamplesProtocol ]) +] + +{ #category : #'*Microdown' } +Class >> documentExampleCode [ + | exampleMethod | + + exampleMethod := self class methods + detect: [ :each | + (each protocol = self documentExamplesProtocol) + and: [ self documentExampleCodeSelector match: each selector match ] ] + ifNone: [ ^ nil ]. + + ^ (exampleMethod sourceCode lines + allButFirst "Remove method name" + reject: [ :each | each trimLeft beginsWith: '<' ]) "Remove pragmas" + asStringWithCr + trimmed +] + +{ #category : #'*Microdown' } +Class >> documentExampleCodeSelector [ + + ^ 'example*' +] + +{ #category : #'*Microdown' } +Class >> documentExamplesProtocol [ + + ^ #'*Examples' ] From f3833f7227bddbd061016410711c8bea0016c641 Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Fri, 21 Apr 2023 20:14:34 +0200 Subject: [PATCH 4/5] added a new extension (pharoeval) to show a code block that can be evaluated by clicking on it. this is barebones, since rubric gives limited control to this kind of thing, but for now is working. --- .../MicRichTextComposer.class.st | 75 +++++++++++++++---- .../MicRichTextDoIt.class.st | 13 ++++ .../MicPharoEvaluatortBlockTest.class.st | 23 ++++++ src/Microdown/MicPharoEvaluatorBlock.class.st | 35 +++++++++ 4 files changed, 132 insertions(+), 14 deletions(-) create mode 100644 src/Microdown-RichTextComposer/MicRichTextDoIt.class.st create mode 100644 src/Microdown-Tests/MicPharoEvaluatortBlockTest.class.st create mode 100644 src/Microdown/MicPharoEvaluatorBlock.class.st diff --git a/src/Microdown-RichTextComposer/MicRichTextComposer.class.st b/src/Microdown-RichTextComposer/MicRichTextComposer.class.st index 5ff46a5d..bf81fe18 100644 --- a/src/Microdown-RichTextComposer/MicRichTextComposer.class.st +++ b/src/Microdown-RichTextComposer/MicRichTextComposer.class.st @@ -259,6 +259,32 @@ MicRichTextComposer >> codeStylerClass [ ^ codeStylerClass ] +{ #category : #private } +MicRichTextComposer >> doVisitCode: aCodeBlock [ + + self + doVisitCode: aCodeBlock + code: aCodeBlock body +] + +{ #category : #private } +MicRichTextComposer >> doVisitCode: aCodeBlock code: aStringOrText [ + + canvas indentIn: [ + canvas + << ((self codeStylerClass stylerFor: aCodeBlock language) + style: aStringOrText ); + newLine. + aCodeBlock hasCaption ifTrue: [ + canvas + includeAttribute: TextEmphasis bold + in: [ + canvas + << aCodeBlock caption asText; + newLine ]]]. + canvas << textStyler interBlockSpacing +] + { #category : #initialization } MicRichTextComposer >> initialize [ super initialize. @@ -377,21 +403,9 @@ MicRichTextComposer >> visitCenter: aMicCenterBlock [ { #category : #visiting } MicRichTextComposer >> visitCode: aCodeBlock [ + canvas newLineIfNotAlready. - canvas indentIn: [ - canvas - << ((self codeStylerClass stylerFor: aCodeBlock language) - style: aCodeBlock body ); - newLine. - aCodeBlock hasCaption ifTrue: [ - canvas - includeAttribute: TextEmphasis bold - in: [ - canvas - << aCodeBlock caption asText; - newLine ]]]. - canvas << textStyler interBlockSpacing - + self doVisitCode: aCodeBlock ] { #category : #'visiting - format' } @@ -602,6 +616,39 @@ MicRichTextComposer >> visitParameters: anObject [ ^ self ] +{ #category : #'visiting - extensions' } +MicRichTextComposer >> visitPharoEvaluator: aScriptBlock [ + "I execute the body. I handle four types of results: + Text - inserted verbatim + Microdown tree - rendered to text then inserted verbatim + String - Parsed, then rendered, then inserted. + Other results - printString asText - then inserted verbatim" + | label script textWithForm codeText oldCanvas | + + script := aScriptBlock body. + label := aScriptBlock label ifNil: [ String value: 1 ]. + + oldCanvas := canvas. + canvas := MicRichTextCanvas new + textStyler: self textStyler; + yourself. + self doVisitCode: aScriptBlock. + codeText := canvas contents trim. + canvas := oldCanvas. + + codeText addAttribute: (MicRichTextDoIt new + actOnClickBlock: [ self class evaluate: script ]; + yourself). + + textWithForm := ((Form + extent: 16@22 depth: Display depth) + mergeWith:(self iconNamed: #smallDoIt) at: 0@8) + asText. + + canvas << textWithForm << codeText. + canvas newLineIfNotAlready +] + { #category : #visiting } MicRichTextComposer >> visitQuote: aQuote [ "I should have a fancier implementation, but for now this should work and be recognized as a quote" diff --git a/src/Microdown-RichTextComposer/MicRichTextDoIt.class.st b/src/Microdown-RichTextComposer/MicRichTextDoIt.class.st new file mode 100644 index 00000000..3f30bb62 --- /dev/null +++ b/src/Microdown-RichTextComposer/MicRichTextDoIt.class.st @@ -0,0 +1,13 @@ +" +An extension of TextDoIt attribute to be used to display executable code (in the evaluator). +" +Class { + #name : #MicRichTextDoIt, + #superclass : #TextDoIt, + #category : #'Microdown-RichTextComposer-Composer' +} + +{ #category : #scanning } +MicRichTextDoIt >> emphasizeScanner: scanner [ + "Skip emphasis" +] diff --git a/src/Microdown-Tests/MicPharoEvaluatortBlockTest.class.st b/src/Microdown-Tests/MicPharoEvaluatortBlockTest.class.st new file mode 100644 index 00000000..3b72bb03 --- /dev/null +++ b/src/Microdown-Tests/MicPharoEvaluatortBlockTest.class.st @@ -0,0 +1,23 @@ +Class { + #name : #MicPharoEvaluatortBlockTest, + #superclass : #MicBlockTest, + #category : #'Microdown-Tests-Extensions' +} + +{ #category : #tests } +MicPharoEvaluatortBlockTest >> subjectClass [ + + ^ MicPharoEvaluatorBlock +] + +{ #category : #tests } +MicPharoEvaluatortBlockTest >> testScriptBloc [ + + | doc | + doc := Microdown parse: +'```pharoeval +1 < 3 +```'. + self assert: doc children first class equals: MicPharoEvaluatorBlock. + self assert: doc children first body equals: '1 < 3' +] diff --git a/src/Microdown/MicPharoEvaluatorBlock.class.st b/src/Microdown/MicPharoEvaluatorBlock.class.st new file mode 100644 index 00000000..fb93d565 --- /dev/null +++ b/src/Microdown/MicPharoEvaluatorBlock.class.st @@ -0,0 +1,35 @@ +" +I am a block containing a Pharo expression. + +A script showing my visitors: +```pharoeval +Transcript show: 'Test'; cr. +``` +" +Class { + #name : #MicPharoEvaluatorBlock, + #superclass : #MicScriptBlock, + #category : #'Microdown-Extensions' +} + +{ #category : #accessing } +MicPharoEvaluatorBlock class >> tag [ + + ^ #pharoeval +] + +{ #category : #visiting } +MicPharoEvaluatorBlock >> accept: aVisitor [ + ^ aVisitor visitPharoEvaluator: self +] + +{ #category : #accessing } +MicPharoEvaluatorBlock >> label [ + + ^ arguments at: #label ifAbsent: [ nil ] +] + +{ #category : #accessing } +MicPharoEvaluatorBlock >> title [ + ^ arguments at: 'title' ifAbsent: [ '' ] +] From fe8c622106c35945fd282153f4ad16152644d12a Mon Sep 17 00:00:00 2001 From: Esteban Lorenzano Date: Fri, 21 Apr 2023 20:25:22 +0200 Subject: [PATCH 5/5] add stub in the visitor --- .../MicRichTextComposer.class.st | 10 ++++++---- src/Microdown/MicrodownVisitor.class.st | 6 ++++++ 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/Microdown-RichTextComposer/MicRichTextComposer.class.st b/src/Microdown-RichTextComposer/MicRichTextComposer.class.st index bf81fe18..e2b377bf 100644 --- a/src/Microdown-RichTextComposer/MicRichTextComposer.class.st +++ b/src/Microdown-RichTextComposer/MicRichTextComposer.class.st @@ -623,7 +623,7 @@ MicRichTextComposer >> visitPharoEvaluator: aScriptBlock [ Microdown tree - rendered to text then inserted verbatim String - Parsed, then rendered, then inserted. Other results - printString asText - then inserted verbatim" - | label script textWithForm codeText oldCanvas | + | label script doitForm codeText oldCanvas | script := aScriptBlock body. label := aScriptBlock label ifNil: [ String value: 1 ]. @@ -639,13 +639,15 @@ MicRichTextComposer >> visitPharoEvaluator: aScriptBlock [ codeText addAttribute: (MicRichTextDoIt new actOnClickBlock: [ self class evaluate: script ]; yourself). - - textWithForm := ((Form + + "this is a hack, because the align of the icon is attached to some top-left of the + letters that I do not understand, and I want it aligned with the actual text" + doitForm := ((Form extent: 16@22 depth: Display depth) mergeWith:(self iconNamed: #smallDoIt) at: 0@8) asText. - canvas << textWithForm << codeText. + canvas << doitForm << codeText. canvas newLineIfNotAlready ] diff --git a/src/Microdown/MicrodownVisitor.class.st b/src/Microdown/MicrodownVisitor.class.st index 67d29466..d00b69d6 100644 --- a/src/Microdown/MicrodownVisitor.class.st +++ b/src/Microdown/MicrodownVisitor.class.st @@ -187,6 +187,12 @@ MicrodownVisitor >> visitParagraph: aParagraph [ ^ self visitChildrenOf: aParagraph ] +{ #category : #'visiting - extensions' } +MicrodownVisitor >> visitPharoEvaluator: aScriptBlock [ + + self visitScript: aScriptBlock +] + { #category : #'visiting - extensions' } MicrodownVisitor >> visitPharoScript: aPharoScriptNode [ ^ self visitScript: aPharoScriptNode