Starting PetitCommonMark extraction from Jan Kurs PhD thesis.
This commit is contained in:
commit
5d097cade4
3
software/.properties
Normal file
3
software/.properties
Normal file
@ -0,0 +1,3 @@
|
||||
{
|
||||
#format : #tonel
|
||||
}
|
||||
48
software/PetitMarkdown/CMBlockVisitor.class.st
Normal file
48
software/PetitMarkdown/CMBlockVisitor.class.st
Normal file
@ -0,0 +1,48 @@
|
||||
Class {
|
||||
#name : 'CMBlockVisitor',
|
||||
#superclass : 'CMVisitor',
|
||||
#instVars : [
|
||||
'inlineParser'
|
||||
],
|
||||
#category : 'PetitMarkdown-Visitors'
|
||||
}
|
||||
|
||||
{ #category : 'initialization' }
|
||||
CMBlockVisitor >> initialize [
|
||||
inlineParser := PPCommonMarkInlinesParser new.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMBlockVisitor >> visitLinkRefDef: node [
|
||||
inlineParser registerLinkRefDef: node.
|
||||
^ super visitLinkRefDef: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMBlockVisitor >> visitParagraph: node [
|
||||
| result text |
|
||||
self assert: (node children anySatisfy: [ :e | e isLine ]).
|
||||
text := Character cr join: (node children collect: [:e | e text]).
|
||||
|
||||
result := inlineParser parse: (text trimRight).
|
||||
^ PPCMParagraph new
|
||||
addChildren: result;
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMBlockVisitor >> visitPlainLine: node [
|
||||
| result |
|
||||
self assert: node text isString.
|
||||
result := inlineParser parse: node text.
|
||||
^ PPCMLine new
|
||||
addChildren: result;
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMBlockVisitor >> visitPlainText: node [
|
||||
^ PPCMText new
|
||||
text: node text;
|
||||
yourself
|
||||
]
|
||||
458
software/PetitMarkdown/CMHTMLVisitor.class.st
Normal file
458
software/PetitMarkdown/CMHTMLVisitor.class.st
Normal file
@ -0,0 +1,458 @@
|
||||
Class {
|
||||
#name : 'CMHTMLVisitor',
|
||||
#superclass : 'CMVisitor',
|
||||
#instVars : [
|
||||
'links',
|
||||
'shouldEscape',
|
||||
'tight',
|
||||
'shouldHtmlSpecChars'
|
||||
],
|
||||
#category : 'PetitMarkdown-Visitors'
|
||||
}
|
||||
|
||||
{ #category : 'support' }
|
||||
CMHTMLVisitor >> encodeEntities: text [
|
||||
^ PPCommonMarkUtils instance encodeEntities: text
|
||||
]
|
||||
|
||||
{ #category : 'escape' }
|
||||
CMHTMLVisitor >> escape: string [
|
||||
| retval regex |
|
||||
self shouldEscape ifFalse: [ ^ string ].
|
||||
|
||||
retval := string.
|
||||
retval := retval copyReplaceAll: '\\' with: '\'.
|
||||
|
||||
"Remove backlashes, \! -> !"
|
||||
regex := '\\[!#$%''()*+,-./:;=?@^_`{|}~]' asRegex.
|
||||
retval := regex copy: retval translatingMatchesUsing: [ :match | match second asString ].
|
||||
|
||||
retval := retval copyReplaceAll: '\[' with: '['.
|
||||
retval := retval copyReplaceAll: '\]' with: ']'.
|
||||
retval := retval copyReplaceAll: '\\' with: '\'.
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'escape' }
|
||||
CMHTMLVisitor >> forbidEscape [
|
||||
shouldEscape push: false
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
CMHTMLVisitor >> forbidHtmlSpecChars [
|
||||
shouldHtmlSpecChars push: false
|
||||
]
|
||||
|
||||
{ #category : 'initialization' }
|
||||
CMHTMLVisitor >> initialize [
|
||||
super initialize.
|
||||
links := IdentityDictionary new.
|
||||
shouldEscape := Stack with: true.
|
||||
shouldHtmlSpecChars := Stack with: true.
|
||||
]
|
||||
|
||||
{ #category : 'string operations' }
|
||||
CMHTMLVisitor >> removeLeadingEmptyLines: collection [
|
||||
| retval |
|
||||
collection isEmpty ifTrue: [ ^ collection ].
|
||||
|
||||
retval := collection copy.
|
||||
[retval first text = ''] whileTrue: [
|
||||
retval removeFirst
|
||||
].
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'string operations' }
|
||||
CMHTMLVisitor >> removeTrailingEmptyLines: collection [
|
||||
| retval |
|
||||
collection isEmpty ifTrue: [ ^ collection ].
|
||||
|
||||
retval := collection copy.
|
||||
[retval last text = ''] whileTrue: [
|
||||
retval removeLast
|
||||
].
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'escape' }
|
||||
CMHTMLVisitor >> restoreEscape [
|
||||
shouldEscape pop
|
||||
]
|
||||
|
||||
{ #category : 'string operations' }
|
||||
CMHTMLVisitor >> restoreHtmlSpecChars [
|
||||
shouldHtmlSpecChars pop
|
||||
]
|
||||
|
||||
{ #category : 'escape' }
|
||||
CMHTMLVisitor >> shouldEscape [
|
||||
^ shouldEscape top
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
CMHTMLVisitor >> shouldHtmlSpecChars [
|
||||
^ shouldHtmlSpecChars top
|
||||
]
|
||||
|
||||
{ #category : 'string operations' }
|
||||
CMHTMLVisitor >> trimLeadingEmptyLines: string [
|
||||
| retval |
|
||||
retval := string.
|
||||
|
||||
[retval beginsWith: String cr] whileTrue: [
|
||||
retval := retval copyFrom: 2 to: retval size.
|
||||
].
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitBlockQuote: node [
|
||||
| stream content |
|
||||
stream := WriteStream on: ''.
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '<blockquote>'.
|
||||
|
||||
content := node child accept: self.
|
||||
content := content trimRight.
|
||||
|
||||
stream nextPutAll: content.
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '</blockquote>'.
|
||||
^ stream contents.
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitContainer: node [
|
||||
| parts concat |
|
||||
parts := node children collect: [ :child |
|
||||
child accept: self
|
||||
].
|
||||
|
||||
concat := (parts reject: [ :e | e = '' ]) inject: '' into: [ :string :e | string, e ].
|
||||
^ concat
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitDelegate: node [
|
||||
| parts |
|
||||
parts := node children collect: [ :child |
|
||||
child accept: self
|
||||
].
|
||||
|
||||
^ String cr join: parts
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitDocument: node [
|
||||
^ self trimLeadingEmptyLines: (self visitContainer: node)
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitEmphasize: node [
|
||||
| retval |
|
||||
retval:= WriteStream on: ''.
|
||||
|
||||
retval nextPutAll: '<em>'.
|
||||
node children do: [ :child |
|
||||
retval nextPutAll: (child accept: self)
|
||||
].
|
||||
|
||||
retval nextPutAll: '</em>'.
|
||||
^ retval contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitFencedCode: node [
|
||||
| stream |
|
||||
stream := WriteStream on: ''.
|
||||
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '<pre><code'.
|
||||
node infoString isNil ifFalse: [
|
||||
stream nextPutAll: ' class="language-'.
|
||||
stream nextPutAll: (self escape: node infoString trim).
|
||||
stream nextPutAll: '"'
|
||||
].
|
||||
stream nextPut: $>.
|
||||
|
||||
self forbidEscape.
|
||||
(node children) do: [ :child |
|
||||
stream nextPutAll: (child accept: self).
|
||||
stream nextPut: Character cr.
|
||||
].
|
||||
self restoreEscape.
|
||||
|
||||
stream nextPutAll: '</code></pre>'.
|
||||
^ stream contents.
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitHRule: node [
|
||||
^ String cr, '<hr />'
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitHardBreak: node [
|
||||
^ '<br />'
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitHeader: node [
|
||||
^ String cr, '<h', node level asString, '>',
|
||||
(node title accept: self) trim,
|
||||
'</h', node level asString, '>'
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitHtml: node [
|
||||
^ node text
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitHtmlBlock: node [
|
||||
| parts |
|
||||
self forbidEscape.
|
||||
self forbidHtmlSpecChars.
|
||||
parts := node children collect: [ :child |
|
||||
child accept: self
|
||||
].
|
||||
self restoreHtmlSpecChars.
|
||||
self restoreEscape.
|
||||
|
||||
" ^ String cr join: parts "
|
||||
^ parts inject: '' into: [ :string :e | string, String cr, e ]
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitIndentedCode: node [
|
||||
| stream |
|
||||
stream := WriteStream on: ''.
|
||||
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '<pre><code>'.
|
||||
|
||||
self forbidEscape.
|
||||
(self removeTrailingEmptyLines: (self removeLeadingEmptyLines: node children)) do: [ :child |
|
||||
stream nextPutAll: (child accept: self).
|
||||
stream nextPut: Character cr.
|
||||
].
|
||||
self restoreEscape.
|
||||
|
||||
stream nextPutAll: '</code></pre>'.
|
||||
^ stream contents.
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitInlinedCode: node [
|
||||
| code code2 |
|
||||
code := node code.
|
||||
|
||||
code := code copyReplaceAll: (String cr) with: (String space).
|
||||
code := code.
|
||||
|
||||
code2 := code.
|
||||
[
|
||||
code := code2.
|
||||
code2 := code copyReplaceAll: ' ' with: ' '
|
||||
] doWhileFalse: [ code2 = code ].
|
||||
|
||||
^ '<code>', code trim , '</code>'
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitLine: node [
|
||||
| stream |
|
||||
stream := WriteStream on: ''.
|
||||
|
||||
node children do: [ :child |
|
||||
stream nextPutAll: (child accept: self).
|
||||
].
|
||||
^ stream contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitLink: node [
|
||||
| stream |
|
||||
stream := WriteStream on: ''.
|
||||
stream nextPutAll: '<a href="'.
|
||||
node destination isNil ifFalse: [
|
||||
stream nextPutAll: (self encodeEntities: (self escape: node destination)).
|
||||
] ifTrue: [ ].
|
||||
stream nextPutAll: '"'.
|
||||
node title isNil ifFalse: [
|
||||
stream nextPutAll: ' title="'.
|
||||
stream nextPutAll: (self escape: (self encodeEntities: node title)).
|
||||
stream nextPutAll: '"'.
|
||||
].
|
||||
stream nextPutAll: '>'.
|
||||
stream nextPutAll: (node label accept: self).
|
||||
stream nextPutAll: '</a>'.
|
||||
|
||||
^ stream contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitLinkRef: node [
|
||||
| stream ref |
|
||||
stream := WriteStream on: ''.
|
||||
|
||||
ref := links at: node label text asLowercase asSymbol.
|
||||
|
||||
stream nextPutAll: '<a href="'.
|
||||
stream nextPutAll: (self escape: ref destination).
|
||||
stream nextPutAll: '"'.
|
||||
ref title isNil ifFalse: [
|
||||
stream nextPutAll: ' title="'.
|
||||
stream nextPutAll: (self escape: ref title).
|
||||
stream nextPutAll: '"'.
|
||||
].
|
||||
stream nextPutAll: '>'.
|
||||
stream nextPutAll: (self escape: node label text).
|
||||
stream nextPutAll: '</a>'.
|
||||
|
||||
^ stream contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitLinkRefDef: node [
|
||||
links at: node label text asLowercase asSymbol ifAbsentPut: node.
|
||||
^ ''
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitLinkRefDefPlaceholder: node [
|
||||
^ ''
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitList: node [
|
||||
| stream tag tmp start |
|
||||
stream := WriteStream on: ''.
|
||||
|
||||
tmp := tight.
|
||||
tight := node isTight.
|
||||
start := ''.
|
||||
|
||||
(node type = #ordered) ifTrue: [
|
||||
tag := 'ol'.
|
||||
(node start = 1) ifFalse: [ start := ' start="', node start asString, '"' ]
|
||||
] ifFalse: [
|
||||
tag := 'ul'
|
||||
].
|
||||
|
||||
stream nextPut: Character cr.
|
||||
stream nextPut: $<.
|
||||
stream nextPutAll: tag.
|
||||
stream nextPutAll: start.
|
||||
stream nextPut: $>.
|
||||
|
||||
node children do: [ :child |
|
||||
child isBlankLine ifFalse: [
|
||||
stream nextPutAll: (child accept: self).
|
||||
]
|
||||
].
|
||||
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '</'.
|
||||
stream nextPutAll: tag.
|
||||
stream nextPut: $>.
|
||||
|
||||
tight := tmp.
|
||||
^ stream contents
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitListItem: node [
|
||||
| stream nodeChildren |
|
||||
stream := WriteStream on: ''.
|
||||
nodeChildren := node child children reject: [:e | e isBlankLine ].
|
||||
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '<li>'.
|
||||
nodeChildren do: [ :child |
|
||||
(child isParagraph and: [ tight ]) ifTrue: [
|
||||
child children do: [ :ch | stream nextPutAll: (ch accept: self) ]
|
||||
] ifFalse: [
|
||||
stream nextPutAll: (child accept: self).
|
||||
]
|
||||
].
|
||||
(nodeChildren isEmpty or:
|
||||
[nodeChildren last isParagraph and: [tight]]) ifFalse: [
|
||||
stream nextPut: Character cr
|
||||
].
|
||||
stream nextPutAll: '</li>'.
|
||||
|
||||
^ stream contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitNode: node [
|
||||
^ ''
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitParagraph: node [
|
||||
| stream |
|
||||
stream := WriteStream on: ''.
|
||||
stream nextPut: Character cr.
|
||||
stream nextPutAll: '<p>'.
|
||||
node children do: [ :child |
|
||||
stream nextPutAll: (child accept: self)
|
||||
].
|
||||
stream nextPutAll: '</p>'.
|
||||
|
||||
^ stream contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitPlainLine: node [
|
||||
^ self error: 'should not happen'
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitPlainText: node [
|
||||
^ self error: 'should not happen'
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitSoftBreak: node [
|
||||
^ String cr
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitStrong: node [
|
||||
| retval |
|
||||
retval:= WriteStream on: ''.
|
||||
|
||||
retval nextPutAll: '<strong>'.
|
||||
node children do: [ :child |
|
||||
retval nextPutAll: (child accept: self)
|
||||
].
|
||||
|
||||
retval nextPutAll: '</strong>'.
|
||||
^ retval contents
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
CMHTMLVisitor >> visitText: node [
|
||||
^ node text
|
||||
|
||||
]
|
||||
99
software/PetitMarkdown/CMVisitor.class.st
Normal file
99
software/PetitMarkdown/CMVisitor.class.st
Normal file
@ -0,0 +1,99 @@
|
||||
Class {
|
||||
#name : 'CMVisitor',
|
||||
#superclass : 'Object',
|
||||
#category : 'PetitMarkdown-Visitors'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitBlockQuote: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitContainer: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitDocument: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitFencedCode: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitHRule: node [
|
||||
^ node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitHeader: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitHtml: node [
|
||||
^ node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitHtmlBlock: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitIndentedCode: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitLine: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitLinkRefDef: node [
|
||||
^ node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitLinkRefDefPlaceholder: node [
|
||||
^ node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitList: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitListItem: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitNode: node [
|
||||
^ node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitParagraph: node [
|
||||
^ self visitWhatever: node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitText: node [
|
||||
^ node
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
CMVisitor >> visitWhatever: node [
|
||||
node children do: [ :child |
|
||||
node replace: child
|
||||
with: (child accept: self)
|
||||
].
|
||||
^ node
|
||||
]
|
||||
25
software/PetitMarkdown/PPCMBlockQuote.class.st
Normal file
25
software/PetitMarkdown/PPCMBlockQuote.class.st
Normal file
@ -0,0 +1,25 @@
|
||||
Class {
|
||||
#name : 'PPCMBlockQuote',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#instVars : [
|
||||
'code',
|
||||
'infoString'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMBlockQuote >> accept: visitor [
|
||||
^ visitor visitBlockQuote: self
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMBlockQuote >> initialize [
|
||||
super initialize.
|
||||
children := Array new: 1.
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMBlockQuote >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
10
software/PetitMarkdown/PPCMContainer.class.st
Normal file
10
software/PetitMarkdown/PPCMContainer.class.st
Normal file
@ -0,0 +1,10 @@
|
||||
Class {
|
||||
#name : 'PPCMContainer',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMContainer >> accept: visitor [
|
||||
^ visitor visitContainer: self
|
||||
]
|
||||
92
software/PetitMarkdown/PPCMDelegateNode.class.st
Normal file
92
software/PetitMarkdown/PPCMDelegateNode.class.st
Normal file
@ -0,0 +1,92 @@
|
||||
Class {
|
||||
#name : 'PPCMDelegateNode',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'children'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMDelegateNode >> accept: visitor [
|
||||
^ visitor visitDelegate: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> addChild: node [
|
||||
self assert: node isCommonMarkNode.
|
||||
|
||||
self children add: node.
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> addChildFirst: node [
|
||||
self assert: node isCommonMarkNode.
|
||||
|
||||
self children addFirst: node.
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> addChildren: nodes [
|
||||
nodes do: [ :node | self addChild: node ]
|
||||
]
|
||||
|
||||
{ #category : 'enumerating' }
|
||||
PPCMDelegateNode >> allChildren [
|
||||
| retval |
|
||||
retval := OrderedCollection new.
|
||||
self children do: [ :child | retval addAll: child allChildren ].
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> child [
|
||||
self assert: children size = 1.
|
||||
^ children first
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> child: whatever [
|
||||
children at: 1 put: whatever
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> children [
|
||||
^ children
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> children: whatever [
|
||||
children := whatever
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> firstChild [
|
||||
^ children at: 1
|
||||
]
|
||||
|
||||
{ #category : 'initialization' }
|
||||
PPCMDelegateNode >> initialize [
|
||||
children := OrderedCollection new
|
||||
]
|
||||
|
||||
{ #category : 'replacing' }
|
||||
PPCMDelegateNode >> replace: child with: anotherChild [
|
||||
children doWithIndex: [ :ch :index |
|
||||
(ch == child) ifTrue: [
|
||||
children at: index put: anotherChild .
|
||||
^ true
|
||||
]
|
||||
].
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> secondChild [
|
||||
^ children at: 2
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMDelegateNode >> thirdChild [
|
||||
^ children at: 3
|
||||
]
|
||||
15
software/PetitMarkdown/PPCMDocument.class.st
Normal file
15
software/PetitMarkdown/PPCMDocument.class.st
Normal file
@ -0,0 +1,15 @@
|
||||
Class {
|
||||
#name : 'PPCMDocument',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMDocument >> accept: visitor [
|
||||
^ visitor visitDocument: self
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMDocument >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
10
software/PetitMarkdown/PPCMEmphasize.class.st
Normal file
10
software/PetitMarkdown/PPCMEmphasize.class.st
Normal file
@ -0,0 +1,10 @@
|
||||
Class {
|
||||
#name : 'PPCMEmphasize',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMEmphasize >> accept: visitor [
|
||||
^ visitor visitEmphasize: self
|
||||
]
|
||||
34
software/PetitMarkdown/PPCMFencedCode.class.st
Normal file
34
software/PetitMarkdown/PPCMFencedCode.class.st
Normal file
@ -0,0 +1,34 @@
|
||||
Class {
|
||||
#name : 'PPCMFencedCode',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#instVars : [
|
||||
'infoString'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMFencedCode >> accept: visitor [
|
||||
^ visitor visitFencedCode: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMFencedCode >> code [
|
||||
"hackity hack, this should not be used except for tests..."
|
||||
^ String cr join: (self children collect: [ :e | e text ])
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMFencedCode >> infoString [
|
||||
^ infoString
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMFencedCode >> infoString: anObject [
|
||||
infoString := anObject
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMFencedCode >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
10
software/PetitMarkdown/PPCMHardBreak.class.st
Normal file
10
software/PetitMarkdown/PPCMHardBreak.class.st
Normal file
@ -0,0 +1,10 @@
|
||||
Class {
|
||||
#name : 'PPCMHardBreak',
|
||||
#superclass : 'PPCMNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMHardBreak >> accept: visitor [
|
||||
^ visitor visitHardBreak: self
|
||||
]
|
||||
45
software/PetitMarkdown/PPCMHeader.class.st
Normal file
45
software/PetitMarkdown/PPCMHeader.class.st
Normal file
@ -0,0 +1,45 @@
|
||||
Class {
|
||||
#name : 'PPCMHeader',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#instVars : [
|
||||
'level',
|
||||
'title'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMHeader >> accept: visitor [
|
||||
^ visitor visitHeader: self
|
||||
]
|
||||
|
||||
{ #category : 'initialization' }
|
||||
PPCMHeader >> initialize [
|
||||
super initialize.
|
||||
children := Array new: 1.
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHeader >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHeader >> level [
|
||||
^ level
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHeader >> level: anObject [
|
||||
level := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHeader >> title [
|
||||
^ self child
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHeader >> title: anObject [
|
||||
self children at: 1 put: anObject
|
||||
]
|
||||
23
software/PetitMarkdown/PPCMHrule.class.st
Normal file
23
software/PetitMarkdown/PPCMHrule.class.st
Normal file
@ -0,0 +1,23 @@
|
||||
Class {
|
||||
#name : 'PPCMHrule',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'rule'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMHrule >> accept: visitor [
|
||||
^ visitor visitHRule: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHrule >> rule [
|
||||
^ rule
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHrule >> rule: anObject [
|
||||
rule := anObject
|
||||
]
|
||||
23
software/PetitMarkdown/PPCMHtml.class.st
Normal file
23
software/PetitMarkdown/PPCMHtml.class.st
Normal file
@ -0,0 +1,23 @@
|
||||
Class {
|
||||
#name : 'PPCMHtml',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'text'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMHtml >> accept: visitor [
|
||||
^ visitor visitHtml: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHtml >> text [
|
||||
^ text
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMHtml >> text: anObject [
|
||||
text := anObject
|
||||
]
|
||||
15
software/PetitMarkdown/PPCMHtmlBlock.class.st
Normal file
15
software/PetitMarkdown/PPCMHtmlBlock.class.st
Normal file
@ -0,0 +1,15 @@
|
||||
Class {
|
||||
#name : 'PPCMHtmlBlock',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMHtmlBlock >> accept: visitor [
|
||||
^ visitor visitHtmlBlock: self
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMHtmlBlock >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
20
software/PetitMarkdown/PPCMIndentedCode.class.st
Normal file
20
software/PetitMarkdown/PPCMIndentedCode.class.st
Normal file
@ -0,0 +1,20 @@
|
||||
Class {
|
||||
#name : 'PPCMIndentedCode',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMIndentedCode >> accept: visitor [
|
||||
^ visitor visitIndentedCode: self
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMIndentedCode >> code [
|
||||
^ self text
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMIndentedCode >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
28
software/PetitMarkdown/PPCMInlinedCode.class.st
Normal file
28
software/PetitMarkdown/PPCMInlinedCode.class.st
Normal file
@ -0,0 +1,28 @@
|
||||
Class {
|
||||
#name : 'PPCMInlinedCode',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'code'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMInlinedCode >> accept: visitor [
|
||||
^ visitor visitInlinedCode: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMInlinedCode >> code [
|
||||
^ code
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMInlinedCode >> code: anObject [
|
||||
code := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMInlinedCode >> text [
|
||||
^ code
|
||||
]
|
||||
37
software/PetitMarkdown/PPCMLine.class.st
Normal file
37
software/PetitMarkdown/PPCMLine.class.st
Normal file
@ -0,0 +1,37 @@
|
||||
Class {
|
||||
#name : 'PPCMLine',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMLine class >> empty [
|
||||
^ PPCMLine new
|
||||
addChild: (PPCMText empty);
|
||||
yourself
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMLine >> accept: visitor [
|
||||
^ visitor visitLine: self
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMLine >> isBlankLine [
|
||||
^ self text = ''
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMLine >> isLine [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMLine >> text [
|
||||
| stream |
|
||||
"hackity hack, this should not be used except for tests..."
|
||||
stream := WriteStream on: ''.
|
||||
children do: [ :child | stream nextPutAll: child text ].
|
||||
^ stream contents
|
||||
]
|
||||
45
software/PetitMarkdown/PPCMLink.class.st
Normal file
45
software/PetitMarkdown/PPCMLink.class.st
Normal file
@ -0,0 +1,45 @@
|
||||
Class {
|
||||
#name : 'PPCMLink',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'label',
|
||||
'destination',
|
||||
'title'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMLink >> accept: visitor [
|
||||
^ visitor visitLink: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLink >> destination [
|
||||
^ destination
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLink >> destination: anObject [
|
||||
destination := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLink >> label [
|
||||
^ label
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLink >> label: anObject [
|
||||
label := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLink >> title [
|
||||
^ title
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLink >> title: anObject [
|
||||
title := anObject
|
||||
]
|
||||
23
software/PetitMarkdown/PPCMLinkRef.class.st
Normal file
23
software/PetitMarkdown/PPCMLinkRef.class.st
Normal file
@ -0,0 +1,23 @@
|
||||
Class {
|
||||
#name : 'PPCMLinkRef',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'label'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMLinkRef >> accept: visitor [
|
||||
^ visitor visitLinkRef: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRef >> label [
|
||||
^ label
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRef >> label: anObject [
|
||||
label := anObject
|
||||
]
|
||||
50
software/PetitMarkdown/PPCMLinkRefDef.class.st
Normal file
50
software/PetitMarkdown/PPCMLinkRefDef.class.st
Normal file
@ -0,0 +1,50 @@
|
||||
Class {
|
||||
#name : 'PPCMLinkRefDef',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'label',
|
||||
'destination',
|
||||
'title'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMLinkRefDef >> accept: visitor [
|
||||
^ visitor visitLinkRefDef: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRefDef >> destination [
|
||||
^ destination
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRefDef >> destination: anObject [
|
||||
destination := anObject
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMLinkRefDef >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRefDef >> label [
|
||||
^ label
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRefDef >> label: anObject [
|
||||
label := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRefDef >> title [
|
||||
^ title
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMLinkRefDef >> title: anObject [
|
||||
title := anObject
|
||||
]
|
||||
15
software/PetitMarkdown/PPCMLinkRefDefPlaceholder.class.st
Normal file
15
software/PetitMarkdown/PPCMLinkRefDefPlaceholder.class.st
Normal file
@ -0,0 +1,15 @@
|
||||
Class {
|
||||
#name : 'PPCMLinkRefDefPlaceholder',
|
||||
#superclass : 'PPCMNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMLinkRefDefPlaceholder >> accept: visitor [
|
||||
^ visitor visitLinkRefDefPlaceholder: self
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMLinkRefDefPlaceholder >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
89
software/PetitMarkdown/PPCMList.class.st
Normal file
89
software/PetitMarkdown/PPCMList.class.st
Normal file
@ -0,0 +1,89 @@
|
||||
Class {
|
||||
#name : 'PPCMList',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#instVars : [
|
||||
'type',
|
||||
'start'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMList >> accept: visitor [
|
||||
^ visitor visitList: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMList >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMList >> isLooseItem: item [
|
||||
| document size |
|
||||
"empty item case"
|
||||
(item children size == 0) ifTrue: [ ^ false ].
|
||||
|
||||
document := item child.
|
||||
size := document children size.
|
||||
|
||||
size < 3 ifTrue: [ ^ false ].
|
||||
|
||||
(1 to: size - 2) do: [ :idx |
|
||||
((document children at: idx) isBlockLevel and:
|
||||
[(document children at: idx + 1) isBlankLine and:
|
||||
[(document children at: idx + 2) isBlockLevel] ]) ifTrue: [ ^ true ]
|
||||
].
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMList >> isLooseList [
|
||||
| size |
|
||||
size := children size.
|
||||
|
||||
size < 3 ifTrue: [ ^ false ].
|
||||
|
||||
(1 to: size - 2) do: [ :idx |
|
||||
((children at: idx) isBlockLevel and:
|
||||
[(children at: idx + 1) isBlankLine and:
|
||||
[(children at: idx + 2) isBlockLevel] ]) ifTrue: [ ^ true ]
|
||||
].
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMList >> isTight [
|
||||
"blanks in the list?"
|
||||
self isLooseList ifTrue: [
|
||||
^ false
|
||||
].
|
||||
|
||||
"blanks in the items?"
|
||||
self children do: [ :listItem |
|
||||
(self isLooseItem: listItem) ifTrue: [
|
||||
^ false
|
||||
]
|
||||
].
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMList >> start [
|
||||
^ start
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMList >> start: anObject [
|
||||
start := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMList >> type [
|
||||
^ type
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMList >> type: string [
|
||||
type := string
|
||||
]
|
||||
21
software/PetitMarkdown/PPCMListItem.class.st
Normal file
21
software/PetitMarkdown/PPCMListItem.class.st
Normal file
@ -0,0 +1,21 @@
|
||||
Class {
|
||||
#name : 'PPCMListItem',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMListItem >> accept: visitor [
|
||||
^ visitor visitListItem: self
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMListItem >> initialize [
|
||||
super initialize.
|
||||
children := Array new: 1.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMListItem >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
67
software/PetitMarkdown/PPCMNode.class.st
Normal file
67
software/PetitMarkdown/PPCMNode.class.st
Normal file
@ -0,0 +1,67 @@
|
||||
Class {
|
||||
#name : 'PPCMNode',
|
||||
#superclass : 'Object',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMNode >> accept: visitor [
|
||||
^ visitor visitNode: self
|
||||
]
|
||||
|
||||
{ #category : 'enumerating' }
|
||||
PPCMNode >> allChildren [
|
||||
^ Array with: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMNode >> children [
|
||||
^ #()
|
||||
]
|
||||
|
||||
{ #category : 'gt' }
|
||||
PPCMNode >> gtTreeViewIn: composite [
|
||||
<gtInspectorPresentationOrder: 40>
|
||||
|
||||
composite tree
|
||||
title: 'Tree';
|
||||
children: [:n | n children ];
|
||||
format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
|
||||
shouldExpandToLevel: 6
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMNode >> isBlankLine [
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMNode >> isBlockLevel [
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMNode >> isCommonMarkNode [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMNode >> isLine [
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMNode >> isParagraph [
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'replacing' }
|
||||
PPCMNode >> replace: child with: anotherChild [
|
||||
^ false
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMNode >> text [
|
||||
"hackity hack, this should not be used except for tests..."
|
||||
^ String cr join: (self children collect: [ :e | e text ])
|
||||
]
|
||||
26
software/PetitMarkdown/PPCMParagraph.class.st
Normal file
26
software/PetitMarkdown/PPCMParagraph.class.st
Normal file
@ -0,0 +1,26 @@
|
||||
Class {
|
||||
#name : 'PPCMParagraph',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMParagraph >> accept: visitor [
|
||||
^ visitor visitParagraph: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMParagraph >> isBlockLevel [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'testing' }
|
||||
PPCMParagraph >> isParagraph [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMParagraph >> text [
|
||||
"hackity hack, this should not be used except for tests..."
|
||||
^ String cr join: (self children collect: [ :e | e text ])
|
||||
]
|
||||
40
software/PetitMarkdown/PPCMPlainLine.class.st
Normal file
40
software/PetitMarkdown/PPCMPlainLine.class.st
Normal file
@ -0,0 +1,40 @@
|
||||
Class {
|
||||
#name : 'PPCMPlainLine',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'text'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMPlainLine class >> empty [
|
||||
^ self new
|
||||
text: '';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMPlainLine >> accept: visitor [
|
||||
^ visitor visitPlainLine: self
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMPlainLine >> isBlankLine [
|
||||
^ self text = ''
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMPlainLine >> isLine [
|
||||
^ true
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMPlainLine >> text [
|
||||
^ text
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMPlainLine >> text: whatever [
|
||||
text := whatever
|
||||
]
|
||||
45
software/PetitMarkdown/PPCMPlainText.class.st
Normal file
45
software/PetitMarkdown/PPCMPlainText.class.st
Normal file
@ -0,0 +1,45 @@
|
||||
Class {
|
||||
#name : 'PPCMPlainText',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'text'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMPlainText class >> empty [
|
||||
^ self new
|
||||
text: '';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMPlainText >> accept: visitor [
|
||||
^ visitor visitPlainText: self
|
||||
]
|
||||
|
||||
{ #category : 'converting' }
|
||||
PPCMPlainText >> asString [
|
||||
^ text
|
||||
]
|
||||
|
||||
{ #category : 'printing' }
|
||||
PPCMPlainText >> printOn: aStream [
|
||||
super printOn: aStream.
|
||||
aStream nextPut: $(.
|
||||
aStream nextPut: $'.
|
||||
text isNil ifFalse: [ aStream nextPutAll: text ].
|
||||
aStream nextPut: $'.
|
||||
aStream nextPut: $).
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMPlainText >> text [
|
||||
^ text
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMPlainText >> text: anObject [
|
||||
text := anObject
|
||||
]
|
||||
10
software/PetitMarkdown/PPCMSoftBreak.class.st
Normal file
10
software/PetitMarkdown/PPCMSoftBreak.class.st
Normal file
@ -0,0 +1,10 @@
|
||||
Class {
|
||||
#name : 'PPCMSoftBreak',
|
||||
#superclass : 'PPCMNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMSoftBreak >> accept: visitor [
|
||||
^ visitor visitSoftBreak: self
|
||||
]
|
||||
10
software/PetitMarkdown/PPCMStrong.class.st
Normal file
10
software/PetitMarkdown/PPCMStrong.class.st
Normal file
@ -0,0 +1,10 @@
|
||||
Class {
|
||||
#name : 'PPCMStrong',
|
||||
#superclass : 'PPCMDelegateNode',
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMStrong >> accept: visitor [
|
||||
^ visitor visitStrong: self
|
||||
]
|
||||
55
software/PetitMarkdown/PPCMText.class.st
Normal file
55
software/PetitMarkdown/PPCMText.class.st
Normal file
@ -0,0 +1,55 @@
|
||||
Class {
|
||||
#name : 'PPCMText',
|
||||
#superclass : 'PPCMNode',
|
||||
#instVars : [
|
||||
'text'
|
||||
],
|
||||
#category : 'PetitMarkdown-AST'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCMText class >> empty [
|
||||
^ self new
|
||||
text: '';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : 'comparing' }
|
||||
PPCMText >> = anObject [
|
||||
^ text = anObject
|
||||
]
|
||||
|
||||
{ #category : 'visiting' }
|
||||
PPCMText >> accept: visitor [
|
||||
^ visitor visitText: self
|
||||
]
|
||||
|
||||
{ #category : 'converting' }
|
||||
PPCMText >> asString [
|
||||
^ text
|
||||
]
|
||||
|
||||
{ #category : 'comparing' }
|
||||
PPCMText >> hash [
|
||||
^ text hash
|
||||
]
|
||||
|
||||
{ #category : 'printing' }
|
||||
PPCMText >> printOn: aStream [
|
||||
super printOn: aStream.
|
||||
aStream nextPut: $(.
|
||||
aStream nextPut: $'.
|
||||
text isNil ifFalse: [ aStream nextPutAll: text ].
|
||||
aStream nextPut: $'.
|
||||
aStream nextPut: $).
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMText >> text [
|
||||
^ text ifNil: [ '' ]
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPCMText >> text: anObject [
|
||||
text := anObject
|
||||
]
|
||||
743
software/PetitMarkdown/PPCommonMarkBlockParser.class.st
Normal file
743
software/PetitMarkdown/PPCommonMarkBlockParser.class.st
Normal file
@ -0,0 +1,743 @@
|
||||
Class {
|
||||
#name : 'PPCommonMarkBlockParser',
|
||||
#superclass : 'PPCompositeParser',
|
||||
#instVars : [
|
||||
'space',
|
||||
'lineEnd',
|
||||
'linePrefix',
|
||||
'indentedCode',
|
||||
'fencedCode',
|
||||
'codeFirstFenceIndent',
|
||||
'newline',
|
||||
'codeFenceStart',
|
||||
'infoString',
|
||||
'prefix',
|
||||
'codeFenceStop',
|
||||
'codeFenceIndent',
|
||||
'codeLine',
|
||||
'prefixedEmptyLine',
|
||||
'documentEnd',
|
||||
'codeIndent',
|
||||
'emptyLine',
|
||||
'contentElement',
|
||||
'horizontalRule',
|
||||
'quoteBlock',
|
||||
'code',
|
||||
'list',
|
||||
'htmlBlock',
|
||||
'header',
|
||||
'linkRefDef',
|
||||
'paragraph',
|
||||
'document',
|
||||
'ATXHeader',
|
||||
'setextHeader',
|
||||
'setexLine',
|
||||
'setextHeaderUnderline',
|
||||
'listItem',
|
||||
'htmlTag',
|
||||
'plainLine',
|
||||
'quoteDedent',
|
||||
'quote',
|
||||
'listBegin',
|
||||
'listEmptyItem',
|
||||
'listEnd',
|
||||
'listOrderedMarker',
|
||||
'listBulletMarker',
|
||||
'listMarker',
|
||||
'listDoubleBlanks',
|
||||
'listBullet',
|
||||
'listContent',
|
||||
'listItemEnd',
|
||||
'quoteIndent',
|
||||
'paragraphLine',
|
||||
'lazyParagraphPrefix',
|
||||
'content',
|
||||
'linkLabel',
|
||||
'linkDestination',
|
||||
'linkTitle',
|
||||
'lineStart',
|
||||
'linkQuoteStart',
|
||||
'linkQuoteStop',
|
||||
'htmlBlockLine',
|
||||
'abstractLinkTitle'
|
||||
],
|
||||
#category : 'PetitMarkdown-Parser'
|
||||
}
|
||||
|
||||
{ #category : 'headers' }
|
||||
PPCommonMarkBlockParser >> ATXHeader [
|
||||
| begin end title |
|
||||
begin := (($# asParser plus) setMax: 6).
|
||||
end := ((space, $# asParser plus) optional trimRight: space), lineEnd.
|
||||
|
||||
title := end negate plus flatten asPPCMPlainLine.
|
||||
|
||||
^ linePrefix, begin, (end not, space, title ==> #last) optional, end
|
||||
|
||||
map: [ :_lp :level :_titleLine :_end |
|
||||
| size titleLine |
|
||||
size := level size.
|
||||
titleLine := _titleLine ifNil: [ PPCMPlainLine empty ].
|
||||
|
||||
PPCMHeader new
|
||||
level: size;
|
||||
title: titleLine;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> abstractLinkTitle [
|
||||
^ (space preceeds / lineStart),
|
||||
linkQuoteStart,
|
||||
( (linkQuoteStop / (lineEnd, emptyLine)) not,
|
||||
(('\' asParser, linkQuoteStop) / #any asParser)
|
||||
) plus flatten,
|
||||
linkQuoteStop
|
||||
|
||||
==> [ :e | self decodeEntities: (self escape: (e third)) ]
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> code [
|
||||
^ indentedCode / fencedCode
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> codeFenceIndent [
|
||||
^ [ :context |
|
||||
context codeFenceIndent parseOn: context
|
||||
] asParser
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> codeFenceStart [
|
||||
| tilde eh |
|
||||
tilde := ($~ asParser min: 3) >=> [ :context :cc |
|
||||
| retval |
|
||||
retval := cc value.
|
||||
retval isPetitFailure ifFalse: [
|
||||
context codeFence: ($~ asParser min: retval size).
|
||||
].
|
||||
retval
|
||||
].
|
||||
|
||||
eh := ($` asParser min: 3) >=> [ :context :cc |
|
||||
| retval |
|
||||
retval := cc value.
|
||||
retval isPetitFailure ifFalse: [
|
||||
context codeFence: ($` asParser min: retval size).
|
||||
].
|
||||
retval
|
||||
].
|
||||
|
||||
^ codeFirstFenceIndent, (tilde / eh)
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> codeFenceStop [
|
||||
^ ([ :context |
|
||||
context codeFence parseOn: context
|
||||
] asParser trimRight: space), lineEnd and
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> codeFirstFenceIndent [
|
||||
^ (space max: 3) >=> [ :context :cc |
|
||||
| result |
|
||||
result := cc value.
|
||||
result isPetitFailure ifFalse: [
|
||||
context codeFenceIndent: (space max: result size).
|
||||
].
|
||||
result
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> codeIndent [
|
||||
^ ' ' asParser / Character tab asParser
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> codeLine [
|
||||
^ newline negate star flatten
|
||||
|
||||
map: [ :_text |
|
||||
| textNode |
|
||||
textNode := PPCMText new
|
||||
text: (self encodeEntities: _text);
|
||||
yourself.
|
||||
|
||||
PPCMLine new
|
||||
addChild: textNode;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'document' }
|
||||
PPCommonMarkBlockParser >> content [
|
||||
^ contentElement,
|
||||
((prefix, contentElement) nonEmpty ==> #second) star
|
||||
|
||||
map: [ :first :rest |
|
||||
| |
|
||||
PPCMContainer new
|
||||
addChild: first;
|
||||
addChildren: rest;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'document' }
|
||||
PPCommonMarkBlockParser >> contentElement [
|
||||
^
|
||||
horizontalRule /
|
||||
quoteBlock /
|
||||
code /
|
||||
list /
|
||||
htmlBlock /
|
||||
header /
|
||||
linkRefDef /
|
||||
paragraph /
|
||||
((emptyLine, lineEnd) ==> #first)
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkBlockParser >> decodeEntities: string [
|
||||
^ PPCommonMarkUtils instance decodeEntities: string
|
||||
]
|
||||
|
||||
{ #category : 'document' }
|
||||
PPCommonMarkBlockParser >> document [
|
||||
^ ((prefix, contentElement) nonEmpty ==> #second) star
|
||||
|
||||
map: [ :elems |
|
||||
PPCMDocument new
|
||||
addChildren: elems;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> documentEnd [
|
||||
^ #eof asParser
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> emptyLine [
|
||||
^ space star, #endOfLine asParser ==> [ :e |
|
||||
PPCMPlainLine empty
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkBlockParser >> encodeEntities: string [
|
||||
^ PPCommonMarkUtils instance encodeEntities: string
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkBlockParser >> escape: string [
|
||||
^ PPCommonMarkUtils instance escape: string
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkBlockParser >> escapeUrl: string [
|
||||
^ PPCommonMarkUtils instance escapeUrl: string
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> fencedCode [
|
||||
^ linePrefix and, codeFenceStart, infoString optional, lineEnd,
|
||||
(
|
||||
((
|
||||
(prefix, linePrefix, codeFenceStop) not, prefix, codeFenceIndent, codeLine, lineEnd) ==> #fourth /
|
||||
(prefixedEmptyLine, lineEnd ==> #first)
|
||||
) nonEmpty
|
||||
) star,
|
||||
((((prefix, linePrefix, codeFenceStop) / documentEnd), lineEnd) / prefix not)
|
||||
|
||||
map: [ :_lp :_fenceStart :_info :_le :_code :_fenceStop |
|
||||
PPCMFencedCode new
|
||||
infoString: _info;
|
||||
addChildren: _code;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'headers' }
|
||||
PPCommonMarkBlockParser >> header [
|
||||
^ ATXHeader / setextHeader
|
||||
]
|
||||
|
||||
{ #category : 'horizontal rule' }
|
||||
PPCommonMarkBlockParser >> horizontalRule [
|
||||
| stars minus under |
|
||||
stars := '*' asParser, (('*' asParser trim: space) min: 2).
|
||||
minus := '-' asParser, (('-' asParser trim: space) min: 2).
|
||||
under := '_' asParser, (('_' asParser trim: space) min: 2).
|
||||
|
||||
^ linePrefix, ((stars / minus / under) flatten), space star, lineEnd
|
||||
map: [ :_prefix :_hrule :_space :_le |
|
||||
PPCMHrule new
|
||||
rule: _hrule;
|
||||
yourself
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'html blocks' }
|
||||
PPCommonMarkBlockParser >> htmlBlock [
|
||||
^ (linePrefix, htmlTag) and, htmlBlockLine, lineEnd,
|
||||
(prefix, (emptyLine not), htmlBlockLine, lineEnd ==> #third) star
|
||||
|
||||
map: [ :_pred :_line :_le :_rest |
|
||||
PPCMHtmlBlock new
|
||||
addChild: _line;
|
||||
addChildren: _rest;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'html blocks' }
|
||||
PPCommonMarkBlockParser >> htmlBlockLine [
|
||||
^ newline negate star flatten
|
||||
|
||||
map: [ :_text |
|
||||
| text |
|
||||
text := PPCMText new
|
||||
text: _text;
|
||||
yourself.
|
||||
|
||||
PPCMLine new
|
||||
addChild: text;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'html blocks' }
|
||||
PPCommonMarkBlockParser >> htmlTag [
|
||||
^ '<table' asParser /
|
||||
'<tr' asParser /
|
||||
'<td' asParser /
|
||||
'<div' asParser /
|
||||
'<DIV' asParser /
|
||||
'<p' asParser /
|
||||
'</table' asParser /
|
||||
'</tr' asParser /
|
||||
'</td' asParser /
|
||||
'</div' asParser /
|
||||
'</DIV' asParser /
|
||||
'</p' asParser /
|
||||
'<!--' asParser /
|
||||
('<?' asParser, #letter asParser plus) /
|
||||
'<![CDATA[' asParser
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> indentedCode [
|
||||
^ codeIndent, emptyLine not, codeLine, lineEnd,
|
||||
(
|
||||
((prefix, codeIndent, codeLine, lineEnd) ==> #third) /
|
||||
((prefix, emptyLine, lineEnd) nonEmpty ==> #second)
|
||||
) star
|
||||
|
||||
map: [ :_cp :_pred :_first :_le :_rest |
|
||||
PPCMIndentedCode new
|
||||
addChild: _first;
|
||||
addChildren: _rest;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkBlockParser >> infoString [
|
||||
^ ((lineEnd / space / codeFenceStop / $` asParser) negate plus trimBlanks flatten),
|
||||
(lineEnd / $` asParser) negate star ==> [:e | self decodeEntities: e first ]
|
||||
]
|
||||
|
||||
{ #category : 'paragraphs' }
|
||||
PPCommonMarkBlockParser >> lazyParagraphPrefix [
|
||||
^ (prefix, quoteIndent) not,
|
||||
(quote / space) star
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> lineEnd [
|
||||
^ newline / documentEnd
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> linePrefix [
|
||||
^ ((PPPossessiveRepeatingParser on: (#blank asParser ))
|
||||
setMax: 3;
|
||||
yourself),
|
||||
(#blank asParser not)
|
||||
==> #first
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> lineStart [
|
||||
^ #startOfLine asParser
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> linkDestination [
|
||||
| parens escapedParen |
|
||||
"TODO: fix?"
|
||||
escapedParen := '\(' asParser / '\)' asParser.
|
||||
|
||||
parens := PPDelegateParser new
|
||||
name: 'parens';
|
||||
yourself.
|
||||
"Parens cannot be nested!"
|
||||
parens setParser: $( asParser, (($( asParser / $) asParser) not, (escapedParen / #any asParser)) star, $) asParser.
|
||||
|
||||
^ (($< asParser, ((($> asParser / newline) not, #any asParser) star) flatten, $> asParser)
|
||||
==> [ :e | self escapeUrl: (self escape: e second) ]) /
|
||||
((space / lineEnd / $) asParser) not, (parens / escapedParen / $( asParser negate)) plus flatten
|
||||
==> [ :e | self escapeUrl: (self escape: e) ]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> linkLabel [
|
||||
| label |
|
||||
label := ($] asParser not, ('\]' asParser / #any asParser)) star flatten.
|
||||
|
||||
^ $[ asParser, label, $] asParser
|
||||
|
||||
map: [ :_start :_label :_end |
|
||||
PPCMText new
|
||||
text: (self escape: _label);
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> linkQuoteStart [
|
||||
^ PPFailingParser message: 'abstract quote start'.
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> linkQuoteStop [
|
||||
^ PPFailingParser message: 'abstract quote stop'
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> linkRefDef [
|
||||
^ (linePrefix, linkLabel, ':' asParser, (lineEnd optional trim: space), linkDestination, ((lineEnd optional trim: space), linkTitle ==> #second) optional, space star, lineEnd
|
||||
|
||||
map: [ :_lp :_label :_semicolon :_ws1 :_dest :_title :_ws3 :_le |
|
||||
PPCMLinkRefDef new
|
||||
label: _label;
|
||||
title: _title;
|
||||
destination: _dest;
|
||||
yourself.
|
||||
])
|
||||
|
||||
>=> [ :context :cc |
|
||||
| retval |
|
||||
retval := cc value.
|
||||
retval isPetitFailure ifFalse: [
|
||||
context registerLink: retval.
|
||||
retval := PPCMLinkRefDefPlaceholder new.
|
||||
].
|
||||
retval
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkBlockParser >> linkTitle [
|
||||
^
|
||||
((abstractLinkTitle
|
||||
where: linkQuoteStart is: $" asParser)
|
||||
where: linkQuoteStop is: $" asParser) /
|
||||
((abstractLinkTitle
|
||||
where: linkQuoteStart is: $' asParser)
|
||||
where: linkQuoteStop is: $' asParser) /
|
||||
((abstractLinkTitle
|
||||
where: linkQuoteStart is: $( asParser)
|
||||
where: linkQuoteStop is: $) asParser)
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> list [
|
||||
^
|
||||
listBegin,
|
||||
listItem,
|
||||
(
|
||||
(prefix, listItem ==> #second) /
|
||||
"empty item is part of the list only if followed by normal item"
|
||||
(listEmptyItem, (prefix, listItem) and ==> #first)
|
||||
) star,
|
||||
listEnd
|
||||
|
||||
map: [ :_start :_first :_rest :_end |
|
||||
PPCMList new
|
||||
type: _start second;
|
||||
start: _start first;
|
||||
addChild: _first;
|
||||
addChildren: _rest;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listBegin [
|
||||
^ (linePrefix, (listOrderedMarker / listBulletMarker)) and ==> #second >=> [ :context :cc |
|
||||
| retval |
|
||||
retval := cc value.
|
||||
retval isPetitFailure ifFalse: [
|
||||
context listItemType: (retval third).
|
||||
].
|
||||
retval
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listBullet [
|
||||
^
|
||||
"push content as spaces on the indent stack"
|
||||
(
|
||||
(linePrefix, listMarker, space, linePrefix optional) flatten and
|
||||
==> [:e | self spaces: (e size)]
|
||||
/
|
||||
(linePrefix, listMarker, lineEnd) flatten and
|
||||
==> [:e | self spaces: (e size)]
|
||||
) pushAsParser,
|
||||
"Consume marker and one space"
|
||||
(linePrefix, listMarker, (space / lineEnd and))
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listBulletMarker [
|
||||
^
|
||||
($- asParser /
|
||||
$* asParser /
|
||||
$+ asParser)
|
||||
|
||||
"Start . type . parser to accept the same type"
|
||||
==> [ :e | { nil . #unordered . e asParser } ]
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listContent [
|
||||
^
|
||||
contentElement,
|
||||
(
|
||||
((prefix, contentElement) nonEmpty ==> #second) /
|
||||
"Empty line of the list content is part of the content only if followed by non-empty line"
|
||||
((prefixedEmptyLine, lineEnd, (prefix, contentElement) and) nonEmpty
|
||||
==> #first)
|
||||
) star
|
||||
|
||||
map: [ :_first :_rest |
|
||||
| |
|
||||
PPCMContainer new
|
||||
addChild: _first;
|
||||
addChildren: _rest;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listDoubleBlanks [
|
||||
^
|
||||
(prefixedEmptyLine, lineEnd) nonEmpty,
|
||||
(prefixedEmptyLine, lineEnd) nonEmpty
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listEmptyItem [
|
||||
^ (listDoubleBlanks not, prefixedEmptyLine, lineEnd) nonEmpty ==> #second
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listEnd [
|
||||
^ [ :context |
|
||||
context listItemStack pop
|
||||
] asParser
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listItem [
|
||||
^ horizontalRule not, listBullet, listContent, listItemEnd
|
||||
|
||||
map: [ :_pred :_bullet :_content :_end |
|
||||
PPCMListItem new
|
||||
child: _content;
|
||||
yourself
|
||||
]
|
||||
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listItemEnd [
|
||||
^ [ :context | context indentStack pop ] asParser
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listMarker [
|
||||
^ [ :context | context listItemType parseOn: context ] asParser
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> listOrderedMarker [
|
||||
| dot bracket |
|
||||
dot := #digit asParser plus flatten, $. asParser.
|
||||
bracket := #digit asParser plus flatten, $) asParser.
|
||||
|
||||
"Start . type . parser to accept the same type"
|
||||
^ (dot ==> [ :e | { e first asNumber . #ordered . dot } ]) /
|
||||
(bracket ==> [ :e | { e first asNumber . #ordered . bracket } ])
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> newline [
|
||||
^ #newline asParser
|
||||
]
|
||||
|
||||
{ #category : 'paragraphs' }
|
||||
PPCommonMarkBlockParser >> paragraph [
|
||||
^ linePrefix, (emptyLine) not, paragraphLine trimBlanks, lineEnd,
|
||||
(
|
||||
(prefix / lazyParagraphPrefix),
|
||||
(emptyLine / ATXHeader / horizontalRule / fencedCode / htmlBlock / list / quote) not,
|
||||
paragraphLine trimBlanks,
|
||||
lineEnd ==> #third
|
||||
) nonEmpty star
|
||||
map: [ :_lp :_pred :_line :_end :_rest |
|
||||
| para |
|
||||
para := PPCMParagraph new.
|
||||
para addChild: _line.
|
||||
_rest do: [ :anotherLine | para addChild: anotherLine ].
|
||||
para
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'paragraphs' }
|
||||
PPCommonMarkBlockParser >> paragraphLine [
|
||||
^ plainLine
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> plainLine [
|
||||
^ newline negate star flatten
|
||||
|
||||
map: [ :_text |
|
||||
PPCMPlainLine new
|
||||
text: _text;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> prefix [
|
||||
^ #prefix asParser
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> prefixedEmptyLine [
|
||||
"empty line with appropriate number of quotes, but with arbitrary whitespaces"
|
||||
^ (quoteDedent not, (quote / space) star, #endOfLine asParser) ==> [ :e | PPCMPlainLine empty ]
|
||||
]
|
||||
|
||||
{ #category : 'quotes' }
|
||||
PPCommonMarkBlockParser >> quote [
|
||||
^ (linePrefix, $> asParser, space optional) flatten
|
||||
]
|
||||
|
||||
{ #category : 'quotes' }
|
||||
PPCommonMarkBlockParser >> quoteBlock [
|
||||
^ quoteIndent,
|
||||
content,
|
||||
quoteDedent
|
||||
|
||||
map: [ :indent :_content :dedent |
|
||||
PPCMBlockQuote new
|
||||
child: _content;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'quotes' }
|
||||
PPCommonMarkBlockParser >> quoteDedent [
|
||||
^ (prefix not, quote pop) flatten
|
||||
]
|
||||
|
||||
{ #category : 'quotes' }
|
||||
PPCommonMarkBlockParser >> quoteIndent [
|
||||
^ (quote ==> [ :e | quote ]) pushAsParser
|
||||
]
|
||||
|
||||
{ #category : 'headers' }
|
||||
PPCommonMarkBlockParser >> setexLine [
|
||||
^ plainLine
|
||||
]
|
||||
|
||||
{ #category : 'headers' }
|
||||
PPCommonMarkBlockParser >> setextHeader [
|
||||
^ linePrefix, emptyLine not, setexLine, lineEnd, setextHeaderUnderline
|
||||
|
||||
map: [ :_prefix :_predicates :_text :_nl :_underline |
|
||||
PPCMHeader new
|
||||
title: _text;
|
||||
level: _underline;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'headers' }
|
||||
PPCommonMarkBlockParser >> setextHeaderUnderline [
|
||||
| equal minus |
|
||||
equal := '=' asParser plus ==> [:t | 1].
|
||||
minus := '-' asParser plus ==> [:t | 2].
|
||||
|
||||
^ prefix, listItem not, linePrefix, ((equal / minus) trimRight: space), lineEnd ==> #fourth
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> space [
|
||||
^ Character space asParser
|
||||
]
|
||||
|
||||
{ #category : 'lists' }
|
||||
PPCommonMarkBlockParser >> spaces: length [
|
||||
| retval |
|
||||
retval := ''.
|
||||
length timesRepeat: [
|
||||
retval := retval, ' '.
|
||||
].
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'document' }
|
||||
PPCommonMarkBlockParser >> start [
|
||||
^ document >=> [ :context :cc |
|
||||
| retval |
|
||||
retval := cc value.
|
||||
retval isPetitFailure ifFalse: [
|
||||
context links do: [ :link |
|
||||
retval addChildFirst: link.
|
||||
]
|
||||
].
|
||||
retval
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'initialization' }
|
||||
PPCommonMarkBlockParser >> utils [
|
||||
^ PPCommonMarkUtils instance
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkBlockParser >> whitespace [
|
||||
^ #space asParser
|
||||
]
|
||||
732
software/PetitMarkdown/PPCommonMarkBlockTest.class.st
Normal file
732
software/PetitMarkdown/PPCommonMarkBlockTest.class.st
Normal file
@ -0,0 +1,732 @@
|
||||
Class {
|
||||
#name : 'PPCommonMarkBlockTest',
|
||||
#superclass : 'PPCompositeParserTest',
|
||||
#instVars : [
|
||||
'context',
|
||||
'quote',
|
||||
'string',
|
||||
'expected'
|
||||
],
|
||||
#category : 'PetitMarkdown-Tests'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> assert: something type: type [
|
||||
self assert: (something isKindOf: type).
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> assertResult: expectedResult [
|
||||
self assert: expectedResult = result.
|
||||
|
||||
"
|
||||
(TextDiffBuilder from: result to: expectedResult) buildDisplayPatch.
|
||||
"
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> context [
|
||||
^ context
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> parse: input rule: rule to: expectedResult [
|
||||
self parse: input rule: rule.
|
||||
self assert: expectedResult = result.
|
||||
|
||||
"
|
||||
(TextDiffBuilder from: result to: expectedResult) buildDisplayPatch.
|
||||
"
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> parserClass [
|
||||
^ PPCommonMarkBlockParser
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> setUp [
|
||||
context := PPContext new.
|
||||
|
||||
quote := self parserInstanceFor: #quote
|
||||
]
|
||||
|
||||
{ #category : 'test-headers' }
|
||||
PPCommonMarkBlockTest >> testATXHeader [
|
||||
self parse: '# foo' rule: #ATXHeader.
|
||||
self assert: result title text = 'foo'.
|
||||
|
||||
self parse: '# foo#' rule: #ATXHeader.
|
||||
self assert: result title text = 'foo#'.
|
||||
|
||||
self parse: '# foo #' rule: #ATXHeader.
|
||||
self assert: result title text = 'foo'.
|
||||
]
|
||||
|
||||
{ #category : 'test-headers' }
|
||||
PPCommonMarkBlockTest >> testATXHeader2 [
|
||||
self parse: '#' rule: #ATXHeader.
|
||||
self assert: result title text = ''.
|
||||
|
||||
self parse: '# ' rule: #ATXHeader.
|
||||
self assert: result title text = ''.
|
||||
|
||||
self parse: '# #' rule: #ATXHeader.
|
||||
self assert: result title text = ''.
|
||||
|
||||
self parse: '### ###' rule: #ATXHeader.
|
||||
self assert: result title text = ''.
|
||||
]
|
||||
|
||||
{ #category : 'test-code' }
|
||||
PPCommonMarkBlockTest >> testFencedCode [
|
||||
self parse: '```
|
||||
abc
|
||||
|
||||
def
|
||||
```' rule: #code.
|
||||
self assert: result type: PPCMFencedCode.
|
||||
self assert: result code = 'abc
|
||||
|
||||
def'.
|
||||
]
|
||||
|
||||
{ #category : 'test-code' }
|
||||
PPCommonMarkBlockTest >> testFencedCode2 [
|
||||
context := PPContext new.
|
||||
context indentStack push: ' ' asParser.
|
||||
self parse: '```
|
||||
abc
|
||||
|
||||
def
|
||||
```' rule: #code.
|
||||
|
||||
self assert: result type: PPCMFencedCode.
|
||||
self assert: result code = 'abc
|
||||
|
||||
def'.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> testHorizontalRule [
|
||||
self parse: '***' rule: #horizontalRule.
|
||||
|
||||
self parse: ' - - -' rule: #horizontalRule.
|
||||
]
|
||||
|
||||
{ #category : 'test-html blocks' }
|
||||
PPCommonMarkBlockTest >> testHtmlBlock [
|
||||
self parse: '<table>
|
||||
</table>' rule: #htmlBlock.
|
||||
|
||||
self assert: result type: PPCMHtmlBlock.
|
||||
]
|
||||
|
||||
{ #category : 'test-code' }
|
||||
PPCommonMarkBlockTest >> testIndentedCode [
|
||||
self parse: ' abc' rule: #code.
|
||||
self assert: result type: PPCMIndentedCode.
|
||||
self assert: result code = 'abc'.
|
||||
|
||||
self parse: ' abc
|
||||
def' rule: #code.
|
||||
self assert: result code = 'abc
|
||||
def'.
|
||||
|
||||
self parse: ' this is a
|
||||
code' rule: #code.
|
||||
self assert: result code = 'this is a
|
||||
code'.
|
||||
|
||||
self parse: ' this is
|
||||
|
||||
a code' rule: #code.
|
||||
self assert: result code = ' this is
|
||||
|
||||
a code'.
|
||||
|
||||
self parse: ' this is
|
||||
|
||||
a code
|
||||
' rule: #code.
|
||||
self assert: result code = ' this is
|
||||
|
||||
a code'.
|
||||
|
||||
|
||||
|
||||
|
||||
self parse: ' chunk1
|
||||
|
||||
chunk2
|
||||
|
||||
|
||||
|
||||
chunk3' rule: #code.
|
||||
|
||||
self assert: result code = 'chunk1
|
||||
|
||||
chunk2
|
||||
|
||||
|
||||
|
||||
chunk3'.
|
||||
|
||||
self parse: ' chunk1
|
||||
|
||||
chunk2' rule: #code.
|
||||
self assert: result code = 'chunk1
|
||||
|
||||
chunk2'.
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkBlockTest >> testLazyParagraphPrefix [
|
||||
self parse: '' rule: #lazyParagraphPrefix.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self parse: '> ' rule: #lazyParagraphPrefix.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self fail: '> >' rule: #lazyParagraphPrefix.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: quote.
|
||||
self parse: ' > >' rule: #lazyParagraphPrefix.
|
||||
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkBlockTest >> testLinkRef [
|
||||
self parse: '[foo]' rule: #paragraph.
|
||||
self assert: result type: PPCMParagraph.
|
||||
self assert: result text = '[foo]'.
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkBlockTest >> testLinkRefDef [
|
||||
self parse: '[foo]: /url "title"' rule: #linkRefDef.
|
||||
self assert: result type: PPCMLinkRefDefPlaceholder.
|
||||
self assert: context links size = 1.
|
||||
self assert: context links anyOne type: PPCMLinkRefDef.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testList [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child text = 'one'.
|
||||
|
||||
self assert: context indentStack isEmpty.
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- two' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 2.
|
||||
self assert: result firstChild text = 'one'.
|
||||
self assert: result secondChild text = 'two'.
|
||||
self assert: context indentStack isEmpty.
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
|
||||
- two' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 3.
|
||||
self assert: result firstChild text trim = 'one'.
|
||||
self assert: result thirdChild text = 'two'.
|
||||
self assert: context indentStack isEmpty.
|
||||
self assert: context indentStack isEmpty.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self parse: '- one
|
||||
>- two' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 2.
|
||||
self assert: result firstChild text = 'one'.
|
||||
self assert: result secondChild text = 'two'.
|
||||
self assert: context indentStack size = 1.
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- ' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 2.
|
||||
self assert: result firstChild text = 'one'.
|
||||
self assert: result secondChild text = ''.
|
||||
self assert: context indentStack isEmpty.
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testList2 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '1. one' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child text = 'one'.
|
||||
|
||||
self assert: context indentStack isEmpty.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListBullet [
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
self parse: '- ' rule: #listBullet.
|
||||
self assert: context indentStack size = 1.
|
||||
self assert: context indentStack top literal = ' '.
|
||||
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
self parse: ' - ' rule: #listBullet.
|
||||
|
||||
self assert: context indentStack size = 1.
|
||||
self assert: context indentStack top literal = ' '.
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
parser := self parserInstanceFor: #listBullet.
|
||||
self assert: parser parse: ' - ' end: 3.
|
||||
|
||||
self assert: context indentStack size = 1.
|
||||
self assert: context indentStack top literal = ' '.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListBullet2 [
|
||||
context := PPContext new.
|
||||
context listItemType: $* asParser.
|
||||
self fail: '- ' rule: #listBullet.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListContent [
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: ' ' asParser.
|
||||
|
||||
self parse: 'one
|
||||
> two' rule: #listContent.
|
||||
|
||||
self assert: result text = 'one
|
||||
two'.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: ' ' asParser.
|
||||
|
||||
self parse: 'one
|
||||
> two' rule: #listContent.
|
||||
|
||||
self assert: result text = 'one
|
||||
two'.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: ' ' asParser.
|
||||
|
||||
self parse: '> one
|
||||
> > two' rule: #listContent.
|
||||
|
||||
self assert: result firstChild type: PPCMBlockQuote.
|
||||
self assert: result firstChild text = 'one
|
||||
two'.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListItem [
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
self parse: '- one' rule: #listItem.
|
||||
|
||||
self assert: result type: PPCMListItem.
|
||||
self assert: result text = 'one'.
|
||||
self assert: context indentStack size = 0.
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
context indentStack push: quote.
|
||||
self parse: '- > one
|
||||
> > two' rule: #listItem.
|
||||
self assert: result type: PPCMListItem.
|
||||
self assert: result child child type: PPCMBlockQuote.
|
||||
self assert: result child child text = 'one
|
||||
two'.
|
||||
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context listItemType: $- asParser.
|
||||
self parse: '- > one
|
||||
>
|
||||
> > two' rule: #listItem.
|
||||
self assert: result type: PPCMListItem.
|
||||
self assert: result child children size = 3.
|
||||
self assert: result child children first type: PPCMBlockQuote.
|
||||
self assert: result child children third type: PPCMIndentedCode.
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
|
||||
self parse: '- ' rule: #listItem.
|
||||
self assert: result type: PPCMListItem.
|
||||
self assert: result text = ''.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListItemCode [
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
self parse: '- one' rule: #listItem.
|
||||
self assert: result child child type: PPCMIndentedCode.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListItemEmpty [
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
self parse: '- ' rule: #listItem.
|
||||
|
||||
self assert: result type: PPCMListItem.
|
||||
self assert: result text = ''.
|
||||
self assert: context indentStack size = 0.
|
||||
|
||||
context := PPContext new.
|
||||
context listItemType: $- asParser.
|
||||
self parse: '-' rule: #listItem.
|
||||
|
||||
self assert: result type: PPCMListItem.
|
||||
self assert: result text = ''.
|
||||
self assert: context indentStack size = 0.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListNested01 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- two' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child child firstChild text = 'one'.
|
||||
self assert: result child child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild child text = 'two'.
|
||||
|
||||
self assert: context indentStack isEmpty.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListNested02 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- two
|
||||
- three' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child child firstChild text = 'one'.
|
||||
self assert: result child child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild child child firstChild text = 'two'.
|
||||
self assert: result child child secondChild child child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild child child secondChild text = 'three'.
|
||||
|
||||
self assert: context indentStack isEmpty.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListNested03 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- two
|
||||
- three
|
||||
- four' rule: #list.
|
||||
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child child firstChild text = 'one'.
|
||||
self assert: result child child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild firstChild child firstChild text = 'two'.
|
||||
self assert: result child child secondChild firstChild child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild firstChild child secondChild text = 'three'.
|
||||
self assert: result child child secondChild secondChild child firstChild text = 'four'.
|
||||
|
||||
self assert: context indentStack isEmpty.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListNested04 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- two
|
||||
- three
|
||||
- four
|
||||
|
||||
five' rule: #list.
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child child firstChild text = 'one'.
|
||||
self assert: result child child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild firstChild child firstChild text = 'two'.
|
||||
self assert: result child child secondChild firstChild child secondChild type: PPCMList.
|
||||
self assert: result child child secondChild firstChild child secondChild text = 'three'.
|
||||
self assert: result child child secondChild secondChild child firstChild text = 'four'.
|
||||
self assert: result child child secondChild secondChild child thirdChild text = 'five'.
|
||||
|
||||
self assert: context indentStack isEmpty.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListTight [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
- two' rule: #list.
|
||||
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result isTight.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListTight2 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
|
||||
- two' rule: #list.
|
||||
|
||||
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result children size = 3.
|
||||
self assert: result isTight not.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListTight3 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
two' rule: #list.
|
||||
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result isTight.
|
||||
]
|
||||
|
||||
{ #category : 'test-lists' }
|
||||
PPCommonMarkBlockTest >> testListTight4 [
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '- one
|
||||
|
||||
two' rule: #list.
|
||||
|
||||
self assert: result type: PPCMList.
|
||||
self assert: result isTight.
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkBlockTest >> testParagraph [
|
||||
self parse: 'abc
|
||||
def' rule: #paragraph.
|
||||
self assert: result text = 'abc
|
||||
def'.
|
||||
|
||||
self parse: 'abc
|
||||
def' rule: #paragraph.
|
||||
self assert: result text = 'abc
|
||||
def'.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self parse: ' abc
|
||||
def' rule: #paragraph.
|
||||
self assert: result text = 'abc
|
||||
def'.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self parse: 'abc
|
||||
> def' rule: #paragraph.
|
||||
self assert: result text = 'abc
|
||||
def'.
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkBlockTest >> testParagraph2 [
|
||||
self parse: 'foo
|
||||
# bar' rule: #paragraph.
|
||||
self assert: result text = 'foo
|
||||
# bar'.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkBlockTest >> testPrefix [
|
||||
self parse: '' rule: #prefix.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self parse: '> ' rule: #prefix
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-quotes' }
|
||||
PPCommonMarkBlockTest >> testQuote [
|
||||
self parse: '>' rule: #quote.
|
||||
self assertResult: '>'.
|
||||
|
||||
self parse: '> ' rule: #quote.
|
||||
self assertResult: '> '.
|
||||
|
||||
self fail: ('>', String cr) rule: #quote.
|
||||
]
|
||||
|
||||
{ #category : 'test-quotes' }
|
||||
PPCommonMarkBlockTest >> testQuoteBlock [
|
||||
self parse: '> foo' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child text = 'foo'.
|
||||
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '> foo
|
||||
> bar' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
self assert: result children size = 1.
|
||||
self assert: result child text = 'foo
|
||||
bar'.
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '>> foo
|
||||
>> bar' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
self assert: result child child type: PPCMBlockQuote.
|
||||
self assert: result child child text = 'foo
|
||||
bar'.
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '># Foo' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
self assert: result child child type: PPCMHeader.
|
||||
self assert: result child child text = 'Foo'.
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '> foo
|
||||
>
|
||||
> bar' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
self assert: result child child type: PPCMIndentedCode.
|
||||
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '>' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
|
||||
|
||||
context := PPContext new.
|
||||
self parse: '>
|
||||
>
|
||||
> ' rule: #quoteBlock.
|
||||
self assert: result type: PPCMBlockQuote.
|
||||
]
|
||||
|
||||
{ #category : 'test-quotes' }
|
||||
PPCommonMarkBlockTest >> testQuoteDedent [
|
||||
parser := self parserInstanceFor: #quoteDedent.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: '' end: 0.
|
||||
self assert: context indentStack size = 0.
|
||||
self assert: parser fail: '' end: 0.
|
||||
|
||||
context := PPContext new.
|
||||
self assert: parser fail: ''.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self assert: parser fail: '>' end: 0.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: ' > ' end: 0.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: ' ' asParser.
|
||||
self assert: parser fail: ' > ' end: 0.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: ' > > ' end: 0.
|
||||
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: '' end: 0.
|
||||
self assert: parser parse: '' end: 0.
|
||||
self assert: parser fail: '' end: 0.
|
||||
]
|
||||
|
||||
{ #category : 'test-quotes' }
|
||||
PPCommonMarkBlockTest >> testQuoteIndent [
|
||||
parser := self parserInstanceFor: #quoteIndent.
|
||||
|
||||
context := PPContext new.
|
||||
self assert: parser parse: '>' end: 1.
|
||||
self assert: context indentStack size = 1.
|
||||
self assert: context indentStack top = quote.
|
||||
|
||||
context := PPContext new.
|
||||
self assert: parser parse: ' > ' end: 5.
|
||||
|
||||
context := PPContext new.
|
||||
self assert: parser parse: ' >' end: 3.
|
||||
|
||||
context := PPContext new.
|
||||
self assert: parser parse: ' >' end: 2.
|
||||
|
||||
context := PPContext new.
|
||||
self assert: parser fail: ' >'.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: '>' end: 1.
|
||||
self assert: context indentStack size = 2.
|
||||
self assert: context indentStack top = quote.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: '> > ' end: 2.
|
||||
|
||||
context := PPContext new.
|
||||
context indentStack push: quote.
|
||||
self assert: parser parse: ' > > ' end: 3.
|
||||
]
|
||||
|
||||
{ #category : 'test-headers' }
|
||||
PPCommonMarkBlockTest >> testSetextHeader [
|
||||
self parse: 'Foo
|
||||
---' rule: #setextHeader.
|
||||
self assert: result title text = 'Foo'.
|
||||
]
|
||||
179
software/PetitMarkdown/PPCommonMarkInlineTest.class.st
Normal file
179
software/PetitMarkdown/PPCommonMarkInlineTest.class.st
Normal file
@ -0,0 +1,179 @@
|
||||
Class {
|
||||
#name : 'PPCommonMarkInlineTest',
|
||||
#superclass : 'PPCompositeParserTest',
|
||||
#category : 'PetitMarkdown-Tests'
|
||||
}
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlineTest >> assert: something type: type [
|
||||
self assert: (something isKindOf: type).
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlineTest >> parserClass [
|
||||
^ PPCommonMarkInlinesParser
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlineTest >> setUp [
|
||||
super setUp.
|
||||
self parserInstance initialize.
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkInlineTest >> testAmpersand [
|
||||
self parse: 'ab'.
|
||||
self assert: result first text = 'ab'.
|
||||
|
||||
self parse: 'a&b'.
|
||||
self assert: result first text = 'a'.
|
||||
self assert: result second text = '&'.
|
||||
self assert: result third text = 'b'.
|
||||
|
||||
self parse: 'a\&b'.
|
||||
self assert: result first text = 'a'.
|
||||
self assert: result second text = '&'.
|
||||
self assert: result third text = 'b'.
|
||||
|
||||
self parse: 'a&b'.
|
||||
self assert: result first text = 'a'.
|
||||
self assert: result second text = '&'.
|
||||
self assert: result third text = 'b'.
|
||||
|
||||
self parse: 'a\&b'.
|
||||
self assert: result first text = 'a'.
|
||||
self assert: result second text = '&'.
|
||||
self assert: result third text = 'amp;b'.
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkInlineTest >> testAutolink [
|
||||
self parse: '<http://foo.bar.baz>' rule: #autolink.
|
||||
self assert: result type: PPCMLink.
|
||||
]
|
||||
|
||||
{ #category : 'test-emphasize' }
|
||||
PPCommonMarkInlineTest >> testEmphasize [
|
||||
self parse: '*bar*' rule: #emphasize.
|
||||
self assert: result type: PPCMEmphasize.
|
||||
self assert: result text = 'bar'.
|
||||
]
|
||||
|
||||
{ #category : 'test-emphasize' }
|
||||
PPCommonMarkInlineTest >> testEmphasize2 [
|
||||
self fail: '\*bar*' rule: #emphasize.
|
||||
self fail: '*bar\*' rule: #emphasize.
|
||||
]
|
||||
|
||||
{ #category : 'tests' }
|
||||
PPCommonMarkInlineTest >> testEscaped [
|
||||
| escaped |
|
||||
escaped := self parserInstanceFor: #escaped.
|
||||
parser := #any asParser, escaped, 'a' asParser.
|
||||
|
||||
self assert: parser parse: '\a'.
|
||||
self assert: parser fail: 'ba'.
|
||||
|
||||
escaped := self parserInstanceFor: #escaped.
|
||||
parser := #any asParser, #any asParser, escaped, 'a' asParser.
|
||||
|
||||
self assert: parser parse: 'a\a'.
|
||||
self assert: parser fail: '\\a'.
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkInlineTest >> testLinkDestination [
|
||||
self parse: '/url' rule: #linkDestination.
|
||||
self assert: result = '/url'.
|
||||
|
||||
self parse: '<my url>' rule: #linkDestination.
|
||||
self assert: result = 'my%20url'.
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkInlineTest >> testLinkInLabel [
|
||||
parser := self parserInstanceFor: #linkInLabel.
|
||||
|
||||
self assert: parser parse: 'bar [baz](/uri)' end: 4.
|
||||
self assert: parser parse: 'foo *[bar [baz](/uri)](/uri)*' end: 10.
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkInlineTest >> testLinkRef [
|
||||
parser := self parserInstanceFor: #linkRef.
|
||||
|
||||
self assert: parser fail: '[foo]'.
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-links' }
|
||||
PPCommonMarkInlineTest >> testLinkRef2 [
|
||||
| refDef |
|
||||
refDef := PPCMLinkRefDef new
|
||||
label: 'foo';
|
||||
destination: 'url';
|
||||
title: 'title';
|
||||
yourself.
|
||||
self parserInstance registerLinkRefDef: refDef.
|
||||
parser := self parserInstanceFor: #linkRef.
|
||||
|
||||
self assert: parser parse: '[foo]'.
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkInlineTest >> testParagraphBreak [
|
||||
self parse: 'foo
|
||||
bar'.
|
||||
self assert: result first type: PPCMText.
|
||||
self assert: result first text = 'foo'.
|
||||
self assert: result second type: PPCMSoftBreak.
|
||||
self assert: result third type: PPCMText.
|
||||
self assert: result third text = 'bar'.
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkInlineTest >> testParagraphEscape [
|
||||
self parse: 'a *a*'.
|
||||
self assert: result size = 2.
|
||||
self assert: result second type: PPCMEmphasize.
|
||||
|
||||
self parse: 'a \*a\*'.
|
||||
self assert: result size = 4.
|
||||
self assert: result first text = 'a '.
|
||||
self assert: result second text = '*'.
|
||||
self assert: result third text = 'a'.
|
||||
self assert: result fourth text = '*'.
|
||||
]
|
||||
|
||||
{ #category : 'test-html' }
|
||||
PPCommonMarkInlineTest >> testRawHtml [
|
||||
self parse: '<foo><bar>'.
|
||||
|
||||
self assert: result size = 2.
|
||||
self assert: result first type: PPCMHtml.
|
||||
]
|
||||
|
||||
{ #category : 'test-emphasize' }
|
||||
PPCommonMarkInlineTest >> testText [
|
||||
self parse: 'foo *bar*'.
|
||||
self assert: result size = 2.
|
||||
self assert: result first type: PPCMText.
|
||||
self assert: result second type: PPCMEmphasize.
|
||||
]
|
||||
|
||||
{ #category : 'test-paragraph' }
|
||||
PPCommonMarkInlineTest >> testText2 [
|
||||
self parse: '*bar*'.
|
||||
self assert: result first type: PPCMEmphasize.
|
||||
self assert: result first text = 'bar'.
|
||||
|
||||
self parse: 'foo*bar*'.
|
||||
self assert: result first type: PPCMText.
|
||||
self assert: result second type: PPCMEmphasize.
|
||||
self assert: result first text = 'foo'.
|
||||
self assert: result second text = 'bar'.
|
||||
]
|
||||
866
software/PetitMarkdown/PPCommonMarkInlinesParser.class.st
Normal file
866
software/PetitMarkdown/PPCommonMarkInlinesParser.class.st
Normal file
@ -0,0 +1,866 @@
|
||||
Class {
|
||||
#name : 'PPCommonMarkInlinesParser',
|
||||
#superclass : 'PPCompositeParser',
|
||||
#instVars : [
|
||||
'starDelimiterRun',
|
||||
'underscoreDelimiterRun',
|
||||
'space',
|
||||
'newline',
|
||||
'leftDelimiterRun',
|
||||
'rightDelimiterRun',
|
||||
'emphasize',
|
||||
'link',
|
||||
'inlineCode',
|
||||
'punctuation',
|
||||
'emphasisR1',
|
||||
'emphasisR2',
|
||||
'strongR1',
|
||||
'strongR2',
|
||||
'delimiterRunSpace',
|
||||
'delimiterRun',
|
||||
'preceedingDelimiterRunSpace',
|
||||
'followingDelimiterRunSpace',
|
||||
'escaped',
|
||||
'hexadecimalEntity',
|
||||
'decimalEntity',
|
||||
'namedEntity',
|
||||
'lt',
|
||||
'gt',
|
||||
'quot',
|
||||
'copyEntity',
|
||||
'nbsp',
|
||||
'aelig',
|
||||
'ouml',
|
||||
'dcaron',
|
||||
'amp',
|
||||
'linkRef',
|
||||
'hardBreak',
|
||||
'entity',
|
||||
'linkLabel',
|
||||
'linkDestination',
|
||||
'linkTitle',
|
||||
'lineEnd',
|
||||
'inlines',
|
||||
'linkInLabel',
|
||||
'linkLabelContent',
|
||||
'lineStart',
|
||||
'emptyLine',
|
||||
'inlineCodeStart',
|
||||
'inlineCodeEnd',
|
||||
'documentEnd',
|
||||
'line',
|
||||
'linkRefDefs',
|
||||
'softBreak',
|
||||
'autolink',
|
||||
'escapedCharacter',
|
||||
'emailAutolink',
|
||||
'normalAutolink',
|
||||
'rawHtml',
|
||||
'rawHtmlAttribute',
|
||||
'autolinkScheme',
|
||||
'openTag',
|
||||
'closeTag',
|
||||
'rawHtmlComment',
|
||||
'processingInstruction',
|
||||
'htmlDeclaration',
|
||||
'cdata'
|
||||
],
|
||||
#category : 'PetitMarkdown-Parser'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkInlinesParser class >> ignoredNames [
|
||||
^ super ignoredNames , #('linkRefDefs')
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> aelig [
|
||||
^ 'Æ' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: 'Æ'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> amp [
|
||||
^ '&' asParser / '&' asParser / '\&' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: '&'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'autolinks' }
|
||||
PPCommonMarkInlinesParser >> autolink [
|
||||
^ normalAutolink / emailAutolink
|
||||
]
|
||||
|
||||
{ #category : 'autolinks' }
|
||||
PPCommonMarkInlinesParser >> autolinkScheme [
|
||||
^ 'http' asParser /
|
||||
'irc' asParser /
|
||||
'mailto' asParser /
|
||||
'MAILTO' asParser
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> cdata [
|
||||
^ ('<![CDATA' asParser, (']]>' asParser negate star), ']]>' asParser) flatten
|
||||
|
||||
map: [ :_html |
|
||||
PPCMHtml new
|
||||
text: _html
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> closeTag [
|
||||
^ ($< asParser,
|
||||
$/ asParser,
|
||||
#letter asParser,
|
||||
(($> asParser) whileFalse: (#word asParser)),
|
||||
(space optional), $> asParser) flatten
|
||||
|
||||
map: [ :_html |
|
||||
PPCMHtml new
|
||||
text: _html
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> codeInLabel [
|
||||
| brackets |
|
||||
brackets := PPDelegateParser new
|
||||
name: 'brackets';
|
||||
yourself.
|
||||
|
||||
brackets setParser:
|
||||
(escaped not, $[ asParser,
|
||||
((inlineCode / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)),
|
||||
$] asParser optional).
|
||||
|
||||
"while there is no link or ] -> consume brackets or any"
|
||||
^ (brackets, inlineCode) and.
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> copyEntity [
|
||||
^ '©' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: '©'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> dcaron [
|
||||
^ 'Ď' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: 'Ď'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> decimalEntity [
|
||||
^ '&#' asParser, #digit asParser plus flatten, $; asParser
|
||||
|
||||
map: [ :_prefix :_number :_end |
|
||||
PPCMText new
|
||||
text: (Character codePoint: _number asNumber) asString;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlinesParser >> decodeEntities: string [
|
||||
^ PPCommonMarkUtils instance decodeEntities: string
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> delimiterRun [
|
||||
^ starDelimiterRun / underscoreDelimiterRun
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> delimiterRunSpace [
|
||||
^ space / newline
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> documentEnd [
|
||||
^ #eof asParser
|
||||
]
|
||||
|
||||
{ #category : 'autolinks' }
|
||||
PPCommonMarkInlinesParser >> emailAutolink [
|
||||
^ $< asParser,
|
||||
( ($> asParser / space / $\ asParser / $@ asParser) negate plus,
|
||||
$@ asParser,
|
||||
($> asParser / space / $\ asParser) negate plus
|
||||
) flatten,
|
||||
$> asParser
|
||||
|
||||
map: [ :start :content :end |
|
||||
| label |
|
||||
label := PPCMText new
|
||||
text: (self encodeEntities: content);
|
||||
yourself.
|
||||
|
||||
PPCMLink new
|
||||
destination: 'mailto:', (self escapeUrl: content);
|
||||
label: label;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> emphasisR1 [
|
||||
| start stop text children |
|
||||
start := (leftDelimiterRun and, $* asParser, $* asParser not) wrapped name: 'start'; yourself.
|
||||
stop := (rightDelimiterRun and, $* asParser, $* asParser not) wrapped name: 'stop'; yourself.
|
||||
|
||||
text := (stop / emphasize / link / inlineCode / hardBreak) negate plus flatten asPPCMText.
|
||||
children := (text / emphasize / link / inlineCode / hardBreak) star.
|
||||
|
||||
|
||||
^ start, children, stop
|
||||
map: [ :_start :_children :_stop |
|
||||
PPCMEmphasize new
|
||||
addChildren: _children;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> emphasisR2 [
|
||||
| start stop text children |
|
||||
start := (leftDelimiterRun and,
|
||||
((rightDelimiterRun not) / (punctuation preceeds, rightDelimiterRun) and),
|
||||
$_ asParser, $_ asParser not) wrapped name: 'start'; yourself.
|
||||
stop := (rightDelimiterRun and,
|
||||
((leftDelimiterRun not) / (leftDelimiterRun, punctuation) and),
|
||||
$_ asParser, $_ asParser not) wrapped name: 'stop'; yourself.
|
||||
|
||||
text := (stop / emphasize / entity) negate plus flatten asPPCMText.
|
||||
children := (text / emphasize / entity) star.
|
||||
|
||||
|
||||
^ start, children, stop
|
||||
map: [ :_start :_children :_stop |
|
||||
PPCMEmphasize new
|
||||
addChildren: _children;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> emphasize [
|
||||
^ emphasisR1 /
|
||||
emphasisR2 /
|
||||
strongR1 /
|
||||
strongR2
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> emptyLine [
|
||||
^ space star, #endOfLine asParser ==> [ :e |
|
||||
PPCMLine empty
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlinesParser >> encodeEntities: string [
|
||||
^ PPCommonMarkUtils instance encodeEntities: string
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> entity [
|
||||
^ hexadecimalEntity / decimalEntity / namedEntity
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlinesParser >> escape: string [
|
||||
^ PPCommonMarkUtils instance escape: string
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlinesParser >> escapeUrl: string [
|
||||
^ PPCommonMarkUtils instance escapeUrl: string
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> escaped [
|
||||
" ^ ('\\' asParser preceeds: 2) not, '\' asParser preceeds"
|
||||
|
||||
"Might be a bit faster version:"
|
||||
^ [ :context |
|
||||
(context position == 0) ifTrue: [ PPFailure new ] ifFalse: [
|
||||
context skip: -1.
|
||||
context peek == $\ ifFalse: [ context skip: 1. PPFailure new ]
|
||||
ifTrue: [
|
||||
(context position == 0) ifTrue: [ context skip: 1. #escaped ] ifFalse: [
|
||||
context skip: -1.
|
||||
context peek == $\ ifTrue: [ context skip: 2. PPFailure new ]
|
||||
ifFalse: [ context skip: 2. #escaped ]
|
||||
]
|
||||
]
|
||||
]
|
||||
] asParser
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> escapedCharacter [
|
||||
^ $\ asParser, (
|
||||
$\ asParser /
|
||||
$[ asParser /
|
||||
$! asParser /
|
||||
$# asParser /
|
||||
$$ asParser /
|
||||
$% asParser /
|
||||
$' asParser /
|
||||
$( asParser /
|
||||
$) asParser /
|
||||
$* asParser /
|
||||
$+ asParser /
|
||||
$, asParser /
|
||||
$+ asParser /
|
||||
$- asParser /
|
||||
$. asParser /
|
||||
$/ asParser /
|
||||
$: asParser /
|
||||
$; asParser /
|
||||
$= asParser /
|
||||
$? asParser /
|
||||
$@ asParser /
|
||||
$^ asParser /
|
||||
$_ asParser /
|
||||
$` asParser /
|
||||
${ asParser /
|
||||
$| asParser /
|
||||
$} asParser /
|
||||
$~ asParser /
|
||||
$] asParser
|
||||
) map: [ :_escape :_char |
|
||||
PPCMText new
|
||||
text: _char asString;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> followingDelimiterRunSpace [
|
||||
^ delimiterRunSpace and / #eof asParser
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> gt [
|
||||
^ '>' asParser / '\>' asParser / '>' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: '>'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'newlines' }
|
||||
PPCommonMarkInlinesParser >> hardBreak [
|
||||
^ ($\ asParser, newline and) / ((space min: 2), newline and)
|
||||
==> [ :e | PPCMHardBreak new ]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> hexadecimalEntity [
|
||||
^ '&#x' asParser, (#hex asParser) plus flatten, $; asParser
|
||||
|
||||
map: [ :_prefix :_number :_end |
|
||||
| text char |
|
||||
char := Character codePoint: (Number readFrom: _number base: 16).
|
||||
text := (char = $") ifTrue: [ '"' ] ifFalse: [ char asString ].
|
||||
|
||||
PPCMText new
|
||||
text: text;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> htmlDeclaration [
|
||||
^ ('<!' asParser, '--' asParser not, ('>' asParser negate star), '>' asParser) flatten
|
||||
|
||||
map: [ :_html |
|
||||
PPCMHtml new
|
||||
text: _html
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'intialization' }
|
||||
PPCommonMarkInlinesParser >> initialize [
|
||||
super initialize.
|
||||
linkRefDefs := IdentityDictionary new.
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkInlinesParser >> inlineCode [
|
||||
^ inlineCodeStart, inlineCodeEnd negate star flatten, inlineCodeEnd
|
||||
|
||||
map: [ :_begin :_content :_end |
|
||||
PPCMInlinedCode new
|
||||
code: (self encodeEntities: _content);
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkInlinesParser >> inlineCodeEnd [
|
||||
^ [ :context |
|
||||
context inlineCodeEnd parseOn: context
|
||||
] asParser
|
||||
]
|
||||
|
||||
{ #category : 'code' }
|
||||
PPCommonMarkInlinesParser >> inlineCodeStart [
|
||||
^ ((escaped / $` asParser preceeds) not, ($` asParser plus)) flatten >=> [ :context :cc |
|
||||
| result |
|
||||
result := cc value.
|
||||
result isPetitFailure ifFalse: [
|
||||
context inlineCodeEnd: (($` asParser preceeds) not, result asParser, $` asParser not).
|
||||
].
|
||||
result
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> inlines [
|
||||
^ emphasize / inlineCode / rawHtml / autolink / link / linkRef / hardBreak / softBreak / entity / escapedCharacter
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> leftDelimiterRun [
|
||||
| a |
|
||||
a := delimiterRun, delimiterRunSpace not, #any asParser and.
|
||||
|
||||
^ (a, punctuation not) / ((preceedingDelimiterRunSpace / punctuation preceeds), a)
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkInlinesParser >> line [
|
||||
| text |
|
||||
text := inlines negate plus flatten asPPCMText.
|
||||
^ (inlines / text) star
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> lineEnd [
|
||||
^ newline / documentEnd
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> lineStart [
|
||||
^ #startOfLine asParser
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> link [
|
||||
^ linkLabel, $( asParser, linkDestination optional trimSpaces, linkTitle optional trim, $) asParser
|
||||
|
||||
map: [ :_label :_open :_destination :_title :_close |
|
||||
PPCMLink new
|
||||
label: _label;
|
||||
destination: _destination;
|
||||
title: _title;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkDestination [
|
||||
| parens escapedParen |
|
||||
|
||||
escapedParen := '\(' asParser / '\)' asParser.
|
||||
|
||||
parens := PPDelegateParser new
|
||||
name: 'parens';
|
||||
yourself.
|
||||
"Parens cannot be nested!"
|
||||
parens setParser: $( asParser, (($( asParser / $) asParser) not, (escapedParen / #any asParser)) star, $) asParser.
|
||||
|
||||
^ (($< asParser, ((($> asParser / newline) not, #any asParser) star) flatten, $> asParser)
|
||||
==> [ :e | self escapeUrl: (self escape: e second) ]) /
|
||||
((space / lineEnd / $) asParser) not, (parens / escapedParen / $( asParser negate)) plus flatten
|
||||
==> [ :e | self escapeUrl: (self escape: e) ]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkInLabel [
|
||||
| brackets |
|
||||
brackets := PPDelegateParser new
|
||||
name: 'brackets';
|
||||
yourself.
|
||||
|
||||
brackets setParser:
|
||||
(escaped not, $[ asParser,
|
||||
((link / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)),
|
||||
$] asParser optional).
|
||||
|
||||
"while there is no link or ] -> consume brackets or any"
|
||||
^ ((link / $] asParser) whileFalse: (brackets / #any asParser)),
|
||||
link and.
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkInLinkLabel [
|
||||
| brackets |
|
||||
brackets := PPDelegateParser new
|
||||
name: 'brackets';
|
||||
yourself.
|
||||
|
||||
brackets setParser:
|
||||
(escaped not, $[ asParser,
|
||||
((link / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)),
|
||||
$] asParser optional).
|
||||
|
||||
"while there is no link or ] -> consume brackets or any"
|
||||
^ (link / $] asParser) whileFalse: (brackets / #any asParser),
|
||||
link and.
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkLabel [
|
||||
| brackets labelText |
|
||||
brackets := PPDelegateParser new
|
||||
name: 'brackets';
|
||||
yourself.
|
||||
|
||||
brackets setParser:
|
||||
(escaped not, $[ asParser,
|
||||
((escaped not, $] asParser) not, (brackets / #any asParser)) plus,
|
||||
$] asParser) flatten asPPCMText.
|
||||
|
||||
labelText := (inlines / brackets / (escaped not, $] asParser)) negate plus flatten asPPCMText.
|
||||
|
||||
^ ((escaped not, $[ asParser) wrapped, (linkInLabel not),
|
||||
(inlines / brackets / labelText) plus,
|
||||
$] asParser
|
||||
|
||||
|
||||
map: [ :_open :_pred :_content :_close |
|
||||
| retval |
|
||||
retval := PPCMLine new
|
||||
addChildren: _content;
|
||||
yourself.
|
||||
]) "limitedBy: linkLabelContent"
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkLabelContent [
|
||||
| brackets |
|
||||
brackets := PPDelegateParser new
|
||||
name: 'brackets';
|
||||
yourself.
|
||||
|
||||
brackets setParser:
|
||||
(escaped not, $[ asParser,
|
||||
((escaped not, $] asParser) not, (brackets / #any asParser)) plus,
|
||||
$] asParser).
|
||||
|
||||
^ brackets
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkRef [
|
||||
^ linkLabel >=> [ :context :cc |
|
||||
| retval memento |
|
||||
memento := context position.
|
||||
|
||||
retval := cc value.
|
||||
retval isPetitFailure ifFalse: [
|
||||
(linkRefDefs includesKey: retval text asString asLowercase asSymbol) ifTrue: [
|
||||
retval := PPCMLinkRef new
|
||||
label: retval;
|
||||
yourself
|
||||
] ifFalse: [
|
||||
context position: memento.
|
||||
retval := PPFailure message: 'label not registered!' context: context
|
||||
]
|
||||
].
|
||||
retval
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> linkTitle [
|
||||
^ ((space preceeds / lineStart),
|
||||
(($" asParser,
|
||||
((escaped not, $" asParser) / (lineEnd, emptyLine)) negate plus flatten,
|
||||
$" asParser ==> #second) /
|
||||
($' asParser,
|
||||
((escaped not, $' asParser) / (lineEnd, emptyLine)) negate plus flatten,
|
||||
$' asParser ==> #second) /
|
||||
($( asParser,
|
||||
($) asParser / (lineEnd, emptyLine)) negate plus flatten,
|
||||
$) asParser ==> #second)))
|
||||
|
||||
==> [ :e | self decodeEntities: (self escape: (e second)) ]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> lt [
|
||||
^ '<' asParser / '\<' asParser / '<' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: '<'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> namedEntity [
|
||||
^ lt / gt / quot / copyEntity / nbsp / aelig / ouml / dcaron / amp
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> nbsp [
|
||||
^ ' ' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: ' '
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> newline [
|
||||
^ #newline asParser
|
||||
]
|
||||
|
||||
{ #category : 'autolinks' }
|
||||
PPCommonMarkInlinesParser >> normalAutolink [
|
||||
^
|
||||
$< asParser,
|
||||
(autolinkScheme, $: asParser,
|
||||
($> asParser / space) negate plus) flatten,
|
||||
$> asParser
|
||||
|
||||
map: [ :start :content :end |
|
||||
| label |
|
||||
label := PPCMText new
|
||||
text: (self encodeEntities: content);
|
||||
yourself.
|
||||
|
||||
PPCMLink new
|
||||
destination: (self escapeUrl: content);
|
||||
label: label;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> openTag [
|
||||
^ ($< asParser,
|
||||
#letter asParser,
|
||||
(($> asParser) whileFalse: (#word asParser /
|
||||
space /
|
||||
newline /
|
||||
$= asParser /
|
||||
$_ asParser /
|
||||
$: asParser /
|
||||
rawHtmlAttribute)),
|
||||
($/ asParser optional), $> asParser) flatten
|
||||
|
||||
map: [ :_html |
|
||||
PPCMHtml new
|
||||
text: _html
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> ouml [
|
||||
^ 'ö' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: 'ö'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> preceedingDelimiterRunSpace [
|
||||
^
|
||||
delimiterRunSpace preceeds /
|
||||
[:context | context position == 0 ifFalse: [
|
||||
PPFailure message: 'start of file not found' ]
|
||||
ifTrue: [ #startOfFile ]
|
||||
] asParser
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> processingInstruction [
|
||||
^ ('<?' asParser, ('?>' asParser negate star), '?>' asParser) flatten
|
||||
|
||||
map: [ :_html |
|
||||
PPCMHtml new
|
||||
text: _html
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> punctuation [
|
||||
^ $. asParser /
|
||||
$" asParser /
|
||||
$, asParser /
|
||||
$- asParser /
|
||||
$( asParser /
|
||||
$) asParser /
|
||||
$] asParser
|
||||
]
|
||||
|
||||
{ #category : 'entities' }
|
||||
PPCommonMarkInlinesParser >> quot [
|
||||
^ '"' asParser / '\"' asParser / '"' asParser
|
||||
|
||||
map: [ :r |
|
||||
PPCMText new
|
||||
text: '"'
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> rawHtml [
|
||||
^ closeTag / openTag / rawHtmlComment / processingInstruction / cdata / htmlDeclaration
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> rawHtmlAttribute [
|
||||
| pairedBrackets |
|
||||
pairedBrackets := PPDelegateParser new name: 'brackets'; yourself.
|
||||
pairedBrackets setParser: ( $< asParser,
|
||||
($> asParser whileFalse: pairedBrackets / #any asParser),
|
||||
$> asParser).
|
||||
|
||||
^
|
||||
(
|
||||
($' asParser, ($' asParser whileFalse: (pairedBrackets / #any asParser)), $' asParser) /
|
||||
($" asParser, ($" asParser whileFalse: (pairedBrackets / #any asParser)), $" asParser)
|
||||
),
|
||||
(($> asParser / space / newline) and )
|
||||
|
||||
]
|
||||
|
||||
{ #category : 'raw html' }
|
||||
PPCommonMarkInlinesParser >> rawHtmlComment [
|
||||
^ ('<!--' asParser, $> asParser not, ('--' asParser negate star), '-->' asParser) flatten
|
||||
|
||||
map: [ :_html |
|
||||
PPCMHtml new
|
||||
text: _html
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'links' }
|
||||
PPCommonMarkInlinesParser >> registerLinkRefDef: node [
|
||||
linkRefDefs at: node label asString asLowercase asSymbol
|
||||
put: node
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> rightDelimiterRun [
|
||||
| a |
|
||||
a := (preceedingDelimiterRunSpace not), delimiterRun.
|
||||
|
||||
^ (punctuation preceeds not, a) / (a, (punctuation and / followingDelimiterRunSpace))
|
||||
]
|
||||
|
||||
{ #category : 'newlines' }
|
||||
PPCommonMarkInlinesParser >> softBreak [
|
||||
^ space optional, Character cr asParser ==> [ :e |
|
||||
PPCMSoftBreak new
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'lines and whitespace' }
|
||||
PPCommonMarkInlinesParser >> space [
|
||||
^ Character space asParser
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> starDelimiterRun [
|
||||
^ ($* asParser preceeds / escaped) not, $* asParser plus
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkInlinesParser >> start [
|
||||
^ line
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> strongR1 [
|
||||
| start stop text children |
|
||||
start := (leftDelimiterRun and, ($* asParser, $* asParser), $* asParser not) wrapped name: 'start'; yourself.
|
||||
stop := (rightDelimiterRun and, ($* asParser, $* asParser), $* asParser not) wrapped name: 'stop'; yourself.
|
||||
|
||||
text := (stop / emphasize / entity) negate plus flatten asPPCMText.
|
||||
children := (text / emphasize / entity) star.
|
||||
|
||||
|
||||
^ start, children, stop
|
||||
map: [ :_start :_children :_stop |
|
||||
PPCMStrong new
|
||||
addChildren: _children;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> strongR2 [
|
||||
| start stop text children |
|
||||
start := (leftDelimiterRun and,
|
||||
((rightDelimiterRun not) / (punctuation preceeds, rightDelimiterRun) and),
|
||||
($_ asParser, $_ asParser), $_ asParser not) wrapped name: 'start'; yourself.
|
||||
stop := (rightDelimiterRun and,
|
||||
((leftDelimiterRun not) / (leftDelimiterRun, punctuation) and),
|
||||
($_ asParser, $_ asParser), $_ asParser not) wrapped name: 'stop'; yourself.
|
||||
|
||||
text := (stop / emphasize) negate plus flatten asPPCMText.
|
||||
children := (text / emphasize) star.
|
||||
|
||||
|
||||
^ start, children, stop
|
||||
map: [ :_start :_children :_stop |
|
||||
PPCMStrong new
|
||||
addChildren: _children;
|
||||
yourself
|
||||
]
|
||||
]
|
||||
|
||||
{ #category : 'emphasis' }
|
||||
PPCommonMarkInlinesParser >> underscoreDelimiterRun [
|
||||
^ ($_ asParser preceeds / escaped not), $_ asParser plus
|
||||
]
|
||||
|
||||
{ #category : 'support' }
|
||||
PPCommonMarkInlinesParser >> utils [
|
||||
^ PPCommonMarkUtils instance
|
||||
]
|
||||
5417
software/PetitMarkdown/PPCommonMarkSpecTest.class.st
Normal file
5417
software/PetitMarkdown/PPCommonMarkSpecTest.class.st
Normal file
File diff suppressed because it is too large
Load Diff
72
software/PetitMarkdown/PPCommonMarkUtils.class.st
Normal file
72
software/PetitMarkdown/PPCommonMarkUtils.class.st
Normal file
@ -0,0 +1,72 @@
|
||||
Class {
|
||||
#name : 'PPCommonMarkUtils',
|
||||
#superclass : 'Object',
|
||||
#classInstVars : [
|
||||
'Instance'
|
||||
],
|
||||
#category : 'PetitMarkdown-Parser'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkUtils class >> instance [
|
||||
Instance isNil ifTrue: [ Instance := PPCommonMarkUtils new ].
|
||||
^ Instance
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkUtils >> decodeEntities: string [
|
||||
| retval |
|
||||
retval := string.
|
||||
|
||||
retval := retval copyReplaceAll: 'ö' with: 'ö'.
|
||||
retval := retval copyReplaceAll: '&' with: '&'.
|
||||
retval := retval copyReplaceAll: '"' with: '"'.
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkUtils >> encodeEntities: string [
|
||||
| retval |
|
||||
retval := string.
|
||||
|
||||
retval := retval copyReplaceAll: '&' with: '&'.
|
||||
retval := retval copyReplaceAll: '"' with: '"'.
|
||||
retval := retval copyReplaceAll: '>' with: '>'.
|
||||
retval := retval copyReplaceAll: '<' with: '<'.
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkUtils >> escape: string [
|
||||
| retval regex |
|
||||
retval := string.
|
||||
retval := retval copyReplaceAll: '\\' with: '\'.
|
||||
|
||||
"Remove backlashes, \! -> !"
|
||||
regex := '\\[!#$%''()*+,-./:;=?@^_`{|}~]' asRegex.
|
||||
retval := regex copy: retval translatingMatchesUsing: [ :match | match second asString ].
|
||||
|
||||
retval := retval copyReplaceAll: '\"' with: '"'.
|
||||
retval := retval copyReplaceAll: '\[' with: '['.
|
||||
retval := retval copyReplaceAll: '\]' with: ']'.
|
||||
retval := retval copyReplaceAll: '\\' with: '\'.
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPCommonMarkUtils >> escapeUrl: string [
|
||||
| retval |
|
||||
retval := string.
|
||||
retval := retval copyReplaceAll: ' ' with: '%20'.
|
||||
retval := retval copyReplaceAll: '"' with: '%22'.
|
||||
retval := retval copyReplaceAll: '\' with: '%5C'.
|
||||
retval := retval copyReplaceAll: '[' with: '%5B'.
|
||||
retval := retval copyReplaceAll: '`' with: '%60'.
|
||||
retval := retval copyReplaceAll: 'ä' with: '%C3%A4'.
|
||||
retval := retval copyReplaceAll: 'ö' with: '%C3%B6'.
|
||||
|
||||
^ retval
|
||||
]
|
||||
70
software/PetitMarkdown/PPContext.extension.st
Normal file
70
software/PetitMarkdown/PPContext.extension.st
Normal file
@ -0,0 +1,70 @@
|
||||
Extension { #name : 'PPContext' }
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> codeFence [
|
||||
^ self globalAt: #PPCMFence
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> codeFence: fence [
|
||||
self globalAt: #PPCMFence put: fence
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> codeFenceIndent [
|
||||
^ self globalAt: #PPCMFenceIndent
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> codeFenceIndent: indent [
|
||||
self globalAt: #PPCMFenceIndent put: indent
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> inlineCodeEnd [
|
||||
^ self globalAt: #inlineCodeEnd
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> inlineCodeEnd: value [
|
||||
^ self globalAt: #inlineCodeEnd put: value
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> links [
|
||||
^ self globalAt: #PPCMLinks ifAbsentPut: [ IdentitySet new ]
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> listItemStack [
|
||||
^ self propertyAt: #listItemStack ifAbsentPut: [ Stack new ]
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> listItemType [
|
||||
self listItemStack ifEmpty: [ ^ PPFailingParser message: 'stack is empty' ].
|
||||
^ self listItemStack top
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> listItemType: value [
|
||||
self listItemStack push: value
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> readLimit [
|
||||
^ stream size
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> readLimit: limit [
|
||||
stream readLimit: limit
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPContext >> registerLink: node [
|
||||
self assert: node class == PPCMLinkRefDef.
|
||||
(self links contains: [ :e | e label text asLowercase = node label text asLowercase ]) ifFalse: [
|
||||
self links add: node
|
||||
]
|
||||
]
|
||||
33
software/PetitMarkdown/PPLimitParser.class.st
Normal file
33
software/PetitMarkdown/PPLimitParser.class.st
Normal file
@ -0,0 +1,33 @@
|
||||
Class {
|
||||
#name : 'PPLimitParser',
|
||||
#superclass : 'PPDelegateParser',
|
||||
#instVars : [
|
||||
'limiter'
|
||||
],
|
||||
#category : 'PetitMarkdown-Parser'
|
||||
}
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPLimitParser >> limiter [
|
||||
^ limiter
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPLimitParser >> limiter: anObject [
|
||||
limiter := anObject
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPLimitParser >> parseOn: aPPContext [
|
||||
| size position retval|
|
||||
size := aPPContext readLimit.
|
||||
position := aPPContext position.
|
||||
|
||||
limiter parseOn: aPPContext.
|
||||
aPPContext readLimit: aPPContext position.
|
||||
aPPContext position: position.
|
||||
|
||||
retval := parser parseOn: aPPContext.
|
||||
aPPContext readLimit: size.
|
||||
^ retval
|
||||
]
|
||||
28
software/PetitMarkdown/PPLimitParserTest.class.st
Normal file
28
software/PetitMarkdown/PPLimitParserTest.class.st
Normal file
@ -0,0 +1,28 @@
|
||||
Class {
|
||||
#name : 'PPLimitParserTest',
|
||||
#superclass : 'PPParserTest',
|
||||
#instVars : [
|
||||
'parser'
|
||||
],
|
||||
#category : 'PetitMarkdown-Tests'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPLimitParserTest >> testLimit [
|
||||
| limiter foo |
|
||||
limiter := #any asParser max: 3.
|
||||
foo := 'foo' asParser.
|
||||
parser := foo limitedBy: limiter.
|
||||
|
||||
self assert: parser parse: 'foo'.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPLimitParserTest >> testLimit2 [
|
||||
| limiter foo |
|
||||
limiter := #any asParser max: 2.
|
||||
foo := 'foo' asParser.
|
||||
parser := foo limitedBy: limiter.
|
||||
|
||||
self assert: parser fail: 'foo'.
|
||||
]
|
||||
80
software/PetitMarkdown/PPParser.extension.st
Normal file
80
software/PetitMarkdown/PPParser.extension.st
Normal file
@ -0,0 +1,80 @@
|
||||
Extension { #name : 'PPParser' }
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> asPPCMLine [
|
||||
^ (self map: [ :elems |
|
||||
PPCMLine new
|
||||
children: elems;
|
||||
yourself
|
||||
]) name: 'asPPCMLine';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> asPPCMPlainLine [
|
||||
^ (self map: [ :text |
|
||||
PPCMPlainLine new
|
||||
text: text;
|
||||
yourself
|
||||
]) name: 'asPPCMPlainLine';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> asPPCMPlainText [
|
||||
^ (self map: [ :text |
|
||||
PPCMPlainText new
|
||||
text: text;
|
||||
yourself
|
||||
]) name: 'asPPCMPlainText';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> asPPCMText [
|
||||
^ (self map: [ :text |
|
||||
PPCMText new
|
||||
text: text;
|
||||
yourself
|
||||
]) name: 'asPPCMText';
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> limitedBy: limiter [
|
||||
^ (PPLimitParser on: self)
|
||||
limiter: limiter;
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> preceeds [
|
||||
^ (PPPreceedsParser on: self)
|
||||
length: 1;
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> preceeds: length [
|
||||
^ (PPPreceedsParser on: self)
|
||||
length: length;
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> where: replacee is: replacement [
|
||||
^ (PPReplaceParser on: self)
|
||||
replacee: replacee;
|
||||
replacement: replacement;
|
||||
yourself
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> whileFalse: parser [
|
||||
^ (self not, parser) star
|
||||
]
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPParser >> whileFalse: condition consume: parser [
|
||||
^ (condition not, parser) star
|
||||
]
|
||||
35
software/PetitMarkdown/PPPreceedsParser.class.st
Normal file
35
software/PetitMarkdown/PPPreceedsParser.class.st
Normal file
@ -0,0 +1,35 @@
|
||||
Class {
|
||||
#name : 'PPPreceedsParser',
|
||||
#superclass : 'PPDelegateParser',
|
||||
#instVars : [
|
||||
'length'
|
||||
],
|
||||
#category : 'PetitMarkdown-Parser'
|
||||
}
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPPreceedsParser >> length [
|
||||
^ length
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPPreceedsParser >> length: anObject [
|
||||
length := anObject
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPPreceedsParser >> parseOn: aPPContext [
|
||||
| memento result |
|
||||
(aPPContext position < length) ifTrue: [
|
||||
^ PPFailure message: 'not enough space to preceed' context: aPPContext
|
||||
].
|
||||
|
||||
memento := aPPContext position.
|
||||
|
||||
aPPContext skip: length negated.
|
||||
result := parser parseOn: aPPContext.
|
||||
|
||||
aPPContext position: memento.
|
||||
^ result
|
||||
|
||||
]
|
||||
36
software/PetitMarkdown/PPPreceedsParserTest.class.st
Normal file
36
software/PetitMarkdown/PPPreceedsParserTest.class.st
Normal file
@ -0,0 +1,36 @@
|
||||
Class {
|
||||
#name : 'PPPreceedsParserTest',
|
||||
#superclass : 'PPParserTest',
|
||||
#instVars : [
|
||||
'parser'
|
||||
],
|
||||
#category : 'PetitMarkdown-Tests'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPPreceedsParserTest >> testLiteral [
|
||||
| foo |
|
||||
foo := 'foo' asParser.
|
||||
parser := foo, (foo preceeds: 3).
|
||||
|
||||
self assert: parser parse: 'foo'.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPPreceedsParserTest >> testLiteral2 [
|
||||
| foo |
|
||||
foo := 'foo' asParser.
|
||||
parser := foo, (foo preceeds: 2).
|
||||
|
||||
self assert: parser fail: 'foo'.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPPreceedsParserTest >> testLiteral3 [
|
||||
| foo bar |
|
||||
foo := 'foo' asParser.
|
||||
bar := 'bar' asParser.
|
||||
parser := foo, (bar preceeds: 3).
|
||||
|
||||
self assert: parser fail: 'foo'.
|
||||
]
|
||||
60
software/PetitMarkdown/PPReplaceParser.class.st
Normal file
60
software/PetitMarkdown/PPReplaceParser.class.st
Normal file
@ -0,0 +1,60 @@
|
||||
"
|
||||
Replaces replacee with the replacement and evaluates its child.The replacee is restored after the child is evaluated.
|
||||
|
||||
WARNING: IMO does not work with memoization
|
||||
"
|
||||
Class {
|
||||
#name : 'PPReplaceParser',
|
||||
#superclass : 'PPDelegateParser',
|
||||
#instVars : [
|
||||
'replacee',
|
||||
'replacement'
|
||||
],
|
||||
#category : 'PetitMarkdown-Parser'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPReplaceParser >> children [
|
||||
^ Array with: parser with: replacee with: replacement
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPReplaceParser >> parseOn: aPPContext [
|
||||
| tmp retval |
|
||||
self assert: (replacee isKindOf: PPDelegateParser).
|
||||
tmp := replacee children first.
|
||||
|
||||
replacee setParser: replacement.
|
||||
retval := parser parseOn: aPPContext.
|
||||
replacee setParser: tmp.
|
||||
|
||||
^ retval
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPReplaceParser >> replace: aParser with: anotherParser [
|
||||
super replace: aParser with: anotherParser.
|
||||
|
||||
(replacee == aParser) ifTrue: [ replacee := anotherParser ].
|
||||
(replacement == aParser) ifTrue: [ replacement := anotherParser ].
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPReplaceParser >> replacee [
|
||||
^ replacee
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPReplaceParser >> replacee: anObject [
|
||||
replacee := anObject
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPReplaceParser >> replacement [
|
||||
^ replacement
|
||||
]
|
||||
|
||||
{ #category : 'accessing' }
|
||||
PPReplaceParser >> replacement: anObject [
|
||||
replacement := anObject
|
||||
]
|
||||
38
software/PetitMarkdown/PPReplaceParserTest.class.st
Normal file
38
software/PetitMarkdown/PPReplaceParserTest.class.st
Normal file
@ -0,0 +1,38 @@
|
||||
Class {
|
||||
#name : 'PPReplaceParserTest',
|
||||
#superclass : 'PPParserTest',
|
||||
#instVars : [
|
||||
'parser'
|
||||
],
|
||||
#category : 'PetitMarkdown-Tests'
|
||||
}
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPReplaceParserTest >> test1 [
|
||||
| foo literal1 literal2 |
|
||||
literal1 := 'foo' asParser.
|
||||
literal2 := 'bar' asParser.
|
||||
|
||||
foo := PPDelegateParser new
|
||||
setParser: literal1;
|
||||
yourself.
|
||||
|
||||
parser := foo wrapped where: foo is: literal2.
|
||||
|
||||
self assert: parser parse: 'bar'.
|
||||
]
|
||||
|
||||
{ #category : 'as yet unclassified' }
|
||||
PPReplaceParserTest >> test2 [
|
||||
| foo literal1 literal2 |
|
||||
literal1 := 'foo' asParser.
|
||||
literal2 := 'bar' asParser.
|
||||
|
||||
foo := PPDelegateParser new
|
||||
setParser: literal1;
|
||||
yourself.
|
||||
|
||||
parser := (foo wrapped where: foo is: literal2), foo.
|
||||
|
||||
self assert: parser parse: 'barfoo'.
|
||||
]
|
||||
6
software/PetitMarkdown/PPStream.extension.st
Normal file
6
software/PetitMarkdown/PPStream.extension.st
Normal file
@ -0,0 +1,6 @@
|
||||
Extension { #name : 'PPStream' }
|
||||
|
||||
{ #category : '*PetitMarkdown' }
|
||||
PPStream >> readLimit: limit [
|
||||
readLimit := limit
|
||||
]
|
||||
1
software/PetitMarkdown/package.st
Normal file
1
software/PetitMarkdown/package.st
Normal file
@ -0,0 +1 @@
|
||||
Package { #name : 'PetitMarkdown' }
|
||||
Loading…
Reference in New Issue
Block a user