459 lines
9.4 KiB
Smalltalk
459 lines
9.4 KiB
Smalltalk
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
|
|
|
|
]
|