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

]