Migrating PetitMarkdown from Jan Kurs' PhD thesis and adding views for the new GT.

This commit is contained in:
Offray Vladimir Luna Cárdenas 2023-04-03 20:02:24 -05:00
parent 557f1893e3
commit e9465349e3
47 changed files with 10010 additions and 2 deletions

View File

@ -77,7 +77,7 @@ Markdown >> detectYAMLMetadata [
{ #category : #persistence } { #category : #persistence }
Markdown >> exportAsFile [ Markdown >> exportAsFile [
| newFile | | newFile |
self file ifNil: [ self inform: 'Define an input Markdown file or use #exportAsFileOn: instead.' ].
newFile := (self file fullName ) asFileReference. newFile := (self file fullName ) asFileReference.
^ self notifyExportAsFileOn: newFile. ^ self notifyExportAsFileOn: newFile.
] ]
@ -121,7 +121,7 @@ Markdown >> exportMetadataAsYaml [
{ #category : #accessing } { #category : #accessing }
Markdown >> file [ Markdown >> file [
^ file ^ file ifNil: [ file := FileLocator temp / (NanoID generate asLowercase, '.md') ]
] ]
{ #category : #accessing } { #category : #accessing }

View 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
]

View 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
]

View 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
]

View 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
]

View File

@ -0,0 +1,10 @@
Class {
#name : #PPCMContainer,
#superclass : #PPCMDelegateNode,
#category : #'PetitMarkdown-AST'
}
{ #category : #'as yet unclassified' }
PPCMContainer >> accept: visitor [
^ visitor visitContainer: self
]

View 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
]

View File

@ -0,0 +1,52 @@
Class {
#name : #PPCMDocument,
#superclass : #PPCMDelegateNode,
#category : #'PetitMarkdown-AST'
}
{ #category : #'as yet unclassified' }
PPCMDocument >> accept: visitor [
^ visitor visitDocument: self
]
{ #category : #testing }
PPCMDocument >> isBlockLevel [
^ true
]
{ #category : #accessing }
PPCMDocument >> viewBody [
| aText |
aText := self className asRopedText.
self children do: [ :child |
aText append: ' ' asRopedText.
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: ('= "' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append:
('"' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor) ].
^ aText
]
{ #category : #accessing }
PPCMDocument >> viewChildrenFor: aView [
<gtView>
children ifNil: [ ^ aView empty ].
^ aView columnedTree
title: 'Document tree';
priority: 1;
items: [ { self } ];
children: #children;
column: 'Name' text: #viewBody;
expandUpTo: 6
]

View File

@ -0,0 +1,10 @@
Class {
#name : #PPCMEmphasize,
#superclass : #PPCMDelegateNode,
#category : #'PetitMarkdown-AST'
}
{ #category : #visiting }
PPCMEmphasize >> accept: visitor [
^ visitor visitEmphasize: self
]

View 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
]

View File

@ -0,0 +1,10 @@
Class {
#name : #PPCMHardBreak,
#superclass : #PPCMNode,
#category : #'PetitMarkdown-AST'
}
{ #category : #'as yet unclassified' }
PPCMHardBreak >> accept: visitor [
^ visitor visitHardBreak: self
]

View File

@ -0,0 +1,67 @@
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
]
{ #category : #accessing }
PPCMHeader >> viewBody [
| aText |
aText := (self className, ' level: ', self level asString) asRopedText.
self children do: [ :child |
aText append: ' ' asRopedText.
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: ('= "' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append:
('"' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor) ].
^ aText
]

View 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
]

View 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
]

View 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
]

View 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
]

View 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
]

View 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
]

View 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
]

View 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
]

View 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
]

View 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
]

View File

@ -0,0 +1,111 @@
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
]
{ #category : #accessing }
PPCMList >> viewBody [
| aText |
aText := (self className, ' type: ', self type) asRopedText.
self children do: [ :child |
aText append: ' ' asRopedText.
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: ('= "' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append:
('"' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor) ].
^ aText
]

View 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
]

View 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 ])
]

View File

@ -0,0 +1,47 @@
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 ])
]
{ #category : #accessing }
PPCMParagraph >> viewBody [
| aText |
aText := self className asRopedText.
self children do: [ :child |
aText append: ' ' asRopedText.
aText append: (child className asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: ('= "' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: (child text asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append:
('"' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor) ].
^ aText
]

View File

@ -0,0 +1,62 @@
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
]
{ #category : #accessing }
PPCMPlainLine >> viewBody [
| aText |
aText := (self className ,' ', self text) asRopedText.
self children do: [ :child |
aText append: ' ' asRopedText.
aText append: (child text asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: ('= "' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append: (child text asRopedText foreground:
BrGlamorousColors disabledButtonTextColor).
aText append:
('"' asRopedText foreground:
BrGlamorousColors disabledButtonTextColor) ].
^ aText
]

View 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
]

View File

@ -0,0 +1,10 @@
Class {
#name : #PPCMSoftBreak,
#superclass : #PPCMNode,
#category : #'PetitMarkdown-AST'
}
{ #category : #'as yet unclassified' }
PPCMSoftBreak >> accept: visitor [
^ visitor visitSoftBreak: self
]

View File

@ -0,0 +1,10 @@
Class {
#name : #PPCMStrong,
#superclass : #PPCMDelegateNode,
#category : #'PetitMarkdown-AST'
}
{ #category : #visiting }
PPCMStrong >> accept: visitor [
^ visitor visitStrong: self
]

View 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
]

View 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
]

View 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'.
]

View 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 = '&amp;'.
self assert: result third text = 'b'.
self parse: 'a\&b'.
self assert: result first text = 'a'.
self assert: result second text = '&amp;'.
self assert: result third text = 'b'.
self parse: 'a&amp;b'.
self assert: result first text = 'a'.
self assert: result second text = '&amp;'.
self assert: result third text = 'b'.
self parse: 'a\&amp;b'.
self assert: result first text = 'a'.
self assert: result second text = '&amp;'.
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'.
]

View 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 [
^ '&AElig;' asParser
map: [ :r |
PPCMText new
text: 'Æ'
yourself
]
]
{ #category : #entities }
PPCommonMarkInlinesParser >> amp [
^ '&amp;' asParser / '&' asParser / '\&' asParser
map: [ :r |
PPCMText new
text: '&amp;'
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 [
^ '&copy;' asParser
map: [ :r |
PPCMText new
text: '©'
yourself
]
]
{ #category : #entities }
PPCommonMarkInlinesParser >> dcaron [
^ '&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 / '&gt;' asParser
map: [ :r |
PPCMText new
text: '&gt;'
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: [ '&quot;' ] 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 / '&lt;' asParser
map: [ :r |
PPCMText new
text: '&lt;'
yourself
]
]
{ #category : #entities }
PPCommonMarkInlinesParser >> namedEntity [
^ lt / gt / quot / copyEntity / nbsp / aelig / ouml / dcaron / amp
]
{ #category : #entities }
PPCommonMarkInlinesParser >> nbsp [
^ '&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 [
^ '&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 / '&quot;' asParser
map: [ :r |
PPCMText new
text: '&quot;'
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
]

File diff suppressed because it is too large Load Diff

View 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: '&ouml;' with: 'ö'.
retval := retval copyReplaceAll: '&amp;' with: '&'.
retval := retval copyReplaceAll: '&quot;' with: '"'.
^ retval
]
{ #category : #'as yet unclassified' }
PPCommonMarkUtils >> encodeEntities: string [
| retval |
retval := string.
retval := retval copyReplaceAll: '&' with: '&amp;'.
retval := retval copyReplaceAll: '"' with: '&quot;'.
retval := retval copyReplaceAll: '>' with: '&gt;'.
retval := retval copyReplaceAll: '<' with: '&lt;'.
^ 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: '&auml;' with: '%C3%A4'.
retval := retval copyReplaceAll: '&ouml;' with: '%C3%B6'.
^ retval
]

View 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
]
]

View 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
]

View 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'.
]

View 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
]

View 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
]

View 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'.
]

View 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
]

View 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'.
]

View File

@ -0,0 +1,6 @@
Extension { #name : #PPStream }
{ #category : #'*PetitMarkdown' }
PPStream >> readLimit: limit [
readLimit := limit
]

View File

@ -0,0 +1 @@
Package { #name : #PetitMarkdown }