Class { #name : 'PPCommonMarkInlinesParser', #superclass : 'PPCompositeParser', #instVars : [ 'starDelimiterRun', 'underscoreDelimiterRun', 'space', 'newline', 'leftDelimiterRun', 'rightDelimiterRun', 'emphasize', 'link', 'inlineCode', 'punctuation', 'emphasisR1', 'emphasisR2', 'strongR1', 'strongR2', 'delimiterRunSpace', 'delimiterRun', 'preceedingDelimiterRunSpace', 'followingDelimiterRunSpace', 'escaped', 'hexadecimalEntity', 'decimalEntity', 'namedEntity', 'lt', 'gt', 'quot', 'copyEntity', 'nbsp', 'aelig', 'ouml', 'dcaron', 'amp', 'linkRef', 'hardBreak', 'entity', 'linkLabel', 'linkDestination', 'linkTitle', 'lineEnd', 'inlines', 'linkInLabel', 'linkLabelContent', 'lineStart', 'emptyLine', 'inlineCodeStart', 'inlineCodeEnd', 'documentEnd', 'line', 'linkRefDefs', 'softBreak', 'autolink', 'escapedCharacter', 'emailAutolink', 'normalAutolink', 'rawHtml', 'rawHtmlAttribute', 'autolinkScheme', 'openTag', 'closeTag', 'rawHtmlComment', 'processingInstruction', 'htmlDeclaration', 'cdata' ], #category : 'PetitMarkdown-Parser' } { #category : 'as yet unclassified' } PPCommonMarkInlinesParser class >> ignoredNames [ ^ super ignoredNames , #('linkRefDefs') ] { #category : 'entities' } PPCommonMarkInlinesParser >> aelig [ ^ 'Æ' asParser map: [ :r | PPCMText new text: 'Æ' yourself ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> amp [ ^ '&' asParser / '&' asParser / '\&' asParser map: [ :r | PPCMText new text: '&' yourself ] ] { #category : 'autolinks' } PPCommonMarkInlinesParser >> autolink [ ^ normalAutolink / emailAutolink ] { #category : 'autolinks' } PPCommonMarkInlinesParser >> autolinkScheme [ ^ 'http' asParser / 'irc' asParser / 'mailto' asParser / 'MAILTO' asParser ] { #category : 'raw html' } PPCommonMarkInlinesParser >> cdata [ ^ ('' asParser negate star), ']]>' asParser) flatten map: [ :_html | PPCMHtml new text: _html yourself ] ] { #category : 'raw html' } PPCommonMarkInlinesParser >> closeTag [ ^ ($< asParser, $/ asParser, #letter asParser, (($> asParser) whileFalse: (#word asParser)), (space optional), $> asParser) flatten map: [ :_html | PPCMHtml new text: _html yourself ] ] { #category : 'links' } PPCommonMarkInlinesParser >> codeInLabel [ | brackets | brackets := PPDelegateParser new name: 'brackets'; yourself. brackets setParser: (escaped not, $[ asParser, ((inlineCode / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)), $] asParser optional). "while there is no link or ] -> consume brackets or any" ^ (brackets, inlineCode) and. ] { #category : 'entities' } PPCommonMarkInlinesParser >> copyEntity [ ^ '©' asParser map: [ :r | PPCMText new text: '©' yourself ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> dcaron [ ^ 'Ď' asParser map: [ :r | PPCMText new text: 'Ď' yourself ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> decimalEntity [ ^ '&#' asParser, #digit asParser plus flatten, $; asParser map: [ :_prefix :_number :_end | PPCMText new text: (Character codePoint: _number asNumber) asString; yourself ] ] { #category : 'support' } PPCommonMarkInlinesParser >> decodeEntities: string [ ^ PPCommonMarkUtils instance decodeEntities: string ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> delimiterRun [ ^ starDelimiterRun / underscoreDelimiterRun ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> delimiterRunSpace [ ^ space / newline ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> documentEnd [ ^ #eof asParser ] { #category : 'autolinks' } PPCommonMarkInlinesParser >> emailAutolink [ ^ $< asParser, ( ($> asParser / space / $\ asParser / $@ asParser) negate plus, $@ asParser, ($> asParser / space / $\ asParser) negate plus ) flatten, $> asParser map: [ :start :content :end | | label | label := PPCMText new text: (self encodeEntities: content); yourself. PPCMLink new destination: 'mailto:', (self escapeUrl: content); label: label; yourself ] ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> emphasisR1 [ | start stop text children | start := (leftDelimiterRun and, $* asParser, $* asParser not) wrapped name: 'start'; yourself. stop := (rightDelimiterRun and, $* asParser, $* asParser not) wrapped name: 'stop'; yourself. text := (stop / emphasize / link / inlineCode / hardBreak) negate plus flatten asPPCMText. children := (text / emphasize / link / inlineCode / hardBreak) star. ^ start, children, stop map: [ :_start :_children :_stop | PPCMEmphasize new addChildren: _children; yourself ] ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> emphasisR2 [ | start stop text children | start := (leftDelimiterRun and, ((rightDelimiterRun not) / (punctuation preceeds, rightDelimiterRun) and), $_ asParser, $_ asParser not) wrapped name: 'start'; yourself. stop := (rightDelimiterRun and, ((leftDelimiterRun not) / (leftDelimiterRun, punctuation) and), $_ asParser, $_ asParser not) wrapped name: 'stop'; yourself. text := (stop / emphasize / entity) negate plus flatten asPPCMText. children := (text / emphasize / entity) star. ^ start, children, stop map: [ :_start :_children :_stop | PPCMEmphasize new addChildren: _children; yourself ] ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> emphasize [ ^ emphasisR1 / emphasisR2 / strongR1 / strongR2 ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> emptyLine [ ^ space star, #endOfLine asParser ==> [ :e | PPCMLine empty ] ] { #category : 'support' } PPCommonMarkInlinesParser >> encodeEntities: string [ ^ PPCommonMarkUtils instance encodeEntities: string ] { #category : 'entities' } PPCommonMarkInlinesParser >> entity [ ^ hexadecimalEntity / decimalEntity / namedEntity ] { #category : 'support' } PPCommonMarkInlinesParser >> escape: string [ ^ PPCommonMarkUtils instance escape: string ] { #category : 'support' } PPCommonMarkInlinesParser >> escapeUrl: string [ ^ PPCommonMarkUtils instance escapeUrl: string ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> escaped [ " ^ ('\\' asParser preceeds: 2) not, '\' asParser preceeds" "Might be a bit faster version:" ^ [ :context | (context position == 0) ifTrue: [ PPFailure new ] ifFalse: [ context skip: -1. context peek == $\ ifFalse: [ context skip: 1. PPFailure new ] ifTrue: [ (context position == 0) ifTrue: [ context skip: 1. #escaped ] ifFalse: [ context skip: -1. context peek == $\ ifTrue: [ context skip: 2. PPFailure new ] ifFalse: [ context skip: 2. #escaped ] ] ] ] ] asParser ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> escapedCharacter [ ^ $\ asParser, ( $\ asParser / $[ asParser / $! asParser / $# asParser / $$ asParser / $% asParser / $' asParser / $( asParser / $) asParser / $* asParser / $+ asParser / $, asParser / $+ asParser / $- asParser / $. asParser / $/ asParser / $: asParser / $; asParser / $= asParser / $? asParser / $@ asParser / $^ asParser / $_ asParser / $` asParser / ${ asParser / $| asParser / $} asParser / $~ asParser / $] asParser ) map: [ :_escape :_char | PPCMText new text: _char asString; yourself ] ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> followingDelimiterRunSpace [ ^ delimiterRunSpace and / #eof asParser ] { #category : 'entities' } PPCommonMarkInlinesParser >> gt [ ^ '>' asParser / '\>' asParser / '>' asParser map: [ :r | PPCMText new text: '>' yourself ] ] { #category : 'newlines' } PPCommonMarkInlinesParser >> hardBreak [ ^ ($\ asParser, newline and) / ((space min: 2), newline and) ==> [ :e | PPCMHardBreak new ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> hexadecimalEntity [ ^ '&#x' asParser, (#hex asParser) plus flatten, $; asParser map: [ :_prefix :_number :_end | | text char | char := Character codePoint: (Number readFrom: _number base: 16). text := (char = $") ifTrue: [ '"' ] ifFalse: [ char asString ]. PPCMText new text: text; yourself ] ] { #category : 'raw html' } PPCommonMarkInlinesParser >> htmlDeclaration [ ^ ('' asParser negate star), '>' asParser) flatten map: [ :_html | PPCMHtml new text: _html yourself ] ] { #category : 'intialization' } PPCommonMarkInlinesParser >> initialize [ super initialize. linkRefDefs := IdentityDictionary new. ] { #category : 'code' } PPCommonMarkInlinesParser >> inlineCode [ ^ inlineCodeStart, inlineCodeEnd negate star flatten, inlineCodeEnd map: [ :_begin :_content :_end | PPCMInlinedCode new code: (self encodeEntities: _content); yourself ] ] { #category : 'code' } PPCommonMarkInlinesParser >> inlineCodeEnd [ ^ [ :context | context inlineCodeEnd parseOn: context ] asParser ] { #category : 'code' } PPCommonMarkInlinesParser >> inlineCodeStart [ ^ ((escaped / $` asParser preceeds) not, ($` asParser plus)) flatten >=> [ :context :cc | | result | result := cc value. result isPetitFailure ifFalse: [ context inlineCodeEnd: (($` asParser preceeds) not, result asParser, $` asParser not). ]. result ] ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> inlines [ ^ emphasize / inlineCode / rawHtml / autolink / link / linkRef / hardBreak / softBreak / entity / escapedCharacter ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> leftDelimiterRun [ | a | a := delimiterRun, delimiterRunSpace not, #any asParser and. ^ (a, punctuation not) / ((preceedingDelimiterRunSpace / punctuation preceeds), a) ] { #category : 'as yet unclassified' } PPCommonMarkInlinesParser >> line [ | text | text := inlines negate plus flatten asPPCMText. ^ (inlines / text) star ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> lineEnd [ ^ newline / documentEnd ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> lineStart [ ^ #startOfLine asParser ] { #category : 'links' } PPCommonMarkInlinesParser >> link [ ^ linkLabel, $( asParser, linkDestination optional trimSpaces, linkTitle optional trim, $) asParser map: [ :_label :_open :_destination :_title :_close | PPCMLink new label: _label; destination: _destination; title: _title; yourself ] ] { #category : 'links' } PPCommonMarkInlinesParser >> linkDestination [ | parens escapedParen | escapedParen := '\(' asParser / '\)' asParser. parens := PPDelegateParser new name: 'parens'; yourself. "Parens cannot be nested!" parens setParser: $( asParser, (($( asParser / $) asParser) not, (escapedParen / #any asParser)) star, $) asParser. ^ (($< asParser, ((($> asParser / newline) not, #any asParser) star) flatten, $> asParser) ==> [ :e | self escapeUrl: (self escape: e second) ]) / ((space / lineEnd / $) asParser) not, (parens / escapedParen / $( asParser negate)) plus flatten ==> [ :e | self escapeUrl: (self escape: e) ] ] { #category : 'links' } PPCommonMarkInlinesParser >> linkInLabel [ | brackets | brackets := PPDelegateParser new name: 'brackets'; yourself. brackets setParser: (escaped not, $[ asParser, ((link / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)), $] asParser optional). "while there is no link or ] -> consume brackets or any" ^ ((link / $] asParser) whileFalse: (brackets / #any asParser)), link and. ] { #category : 'links' } PPCommonMarkInlinesParser >> linkInLinkLabel [ | brackets | brackets := PPDelegateParser new name: 'brackets'; yourself. brackets setParser: (escaped not, $[ asParser, ((link / (escaped not, $] asParser)) whileFalse: (brackets / #any asParser)), $] asParser optional). "while there is no link or ] -> consume brackets or any" ^ (link / $] asParser) whileFalse: (brackets / #any asParser), link and. ] { #category : 'links' } PPCommonMarkInlinesParser >> linkLabel [ | brackets labelText | brackets := PPDelegateParser new name: 'brackets'; yourself. brackets setParser: (escaped not, $[ asParser, ((escaped not, $] asParser) not, (brackets / #any asParser)) plus, $] asParser) flatten asPPCMText. labelText := (inlines / brackets / (escaped not, $] asParser)) negate plus flatten asPPCMText. ^ ((escaped not, $[ asParser) wrapped, (linkInLabel not), (inlines / brackets / labelText) plus, $] asParser map: [ :_open :_pred :_content :_close | | retval | retval := PPCMLine new addChildren: _content; yourself. ]) "limitedBy: linkLabelContent" ] { #category : 'links' } PPCommonMarkInlinesParser >> linkLabelContent [ | brackets | brackets := PPDelegateParser new name: 'brackets'; yourself. brackets setParser: (escaped not, $[ asParser, ((escaped not, $] asParser) not, (brackets / #any asParser)) plus, $] asParser). ^ brackets ] { #category : 'links' } PPCommonMarkInlinesParser >> linkRef [ ^ linkLabel >=> [ :context :cc | | retval memento | memento := context position. retval := cc value. retval isPetitFailure ifFalse: [ (linkRefDefs includesKey: retval text asString asLowercase asSymbol) ifTrue: [ retval := PPCMLinkRef new label: retval; yourself ] ifFalse: [ context position: memento. retval := PPFailure message: 'label not registered!' context: context ] ]. retval ] ] { #category : 'links' } PPCommonMarkInlinesParser >> linkTitle [ ^ ((space preceeds / lineStart), (($" asParser, ((escaped not, $" asParser) / (lineEnd, emptyLine)) negate plus flatten, $" asParser ==> #second) / ($' asParser, ((escaped not, $' asParser) / (lineEnd, emptyLine)) negate plus flatten, $' asParser ==> #second) / ($( asParser, ($) asParser / (lineEnd, emptyLine)) negate plus flatten, $) asParser ==> #second))) ==> [ :e | self decodeEntities: (self escape: (e second)) ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> lt [ ^ '<' asParser / '\<' asParser / '<' asParser map: [ :r | PPCMText new text: '<' yourself ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> namedEntity [ ^ lt / gt / quot / copyEntity / nbsp / aelig / ouml / dcaron / amp ] { #category : 'entities' } PPCommonMarkInlinesParser >> nbsp [ ^ ' ' asParser map: [ :r | PPCMText new text: ' ' yourself ] ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> newline [ ^ #newline asParser ] { #category : 'autolinks' } PPCommonMarkInlinesParser >> normalAutolink [ ^ $< asParser, (autolinkScheme, $: asParser, ($> asParser / space) negate plus) flatten, $> asParser map: [ :start :content :end | | label | label := PPCMText new text: (self encodeEntities: content); yourself. PPCMLink new destination: (self escapeUrl: content); label: label; yourself ] ] { #category : 'raw html' } PPCommonMarkInlinesParser >> openTag [ ^ ($< asParser, #letter asParser, (($> asParser) whileFalse: (#word asParser / space / newline / $= asParser / $_ asParser / $: asParser / rawHtmlAttribute)), ($/ asParser optional), $> asParser) flatten map: [ :_html | PPCMHtml new text: _html yourself ] ] { #category : 'entities' } PPCommonMarkInlinesParser >> ouml [ ^ 'ö' asParser map: [ :r | PPCMText new text: 'ö' yourself ] ] { #category : 'emphasis' } PPCommonMarkInlinesParser >> preceedingDelimiterRunSpace [ ^ delimiterRunSpace preceeds / [:context | context position == 0 ifFalse: [ PPFailure message: 'start of file not found' ] ifTrue: [ #startOfFile ] ] asParser ] { #category : 'raw html' } PPCommonMarkInlinesParser >> processingInstruction [ ^ ('' asParser negate star), '?>' asParser) flatten map: [ :_html | PPCMHtml new text: _html yourself ] ] { #category : 'lines and whitespace' } PPCommonMarkInlinesParser >> punctuation [ ^ $. asParser / $" asParser / $, asParser / $- asParser / $( asParser / $) asParser / $] asParser ] { #category : 'entities' } PPCommonMarkInlinesParser >> quot [ ^ '"' asParser / '\"' asParser / '"' asParser map: [ :r | PPCMText new text: '"' yourself ] ] { #category : 'raw html' } PPCommonMarkInlinesParser >> rawHtml [ ^ closeTag / openTag / rawHtmlComment / processingInstruction / cdata / htmlDeclaration ] { #category : 'raw html' } PPCommonMarkInlinesParser >> rawHtmlAttribute [ | pairedBrackets | pairedBrackets := PPDelegateParser new name: 'brackets'; yourself. pairedBrackets setParser: ( $< asParser, ($> asParser whileFalse: pairedBrackets / #any asParser), $> asParser). ^ ( ($' asParser, ($' asParser whileFalse: (pairedBrackets / #any asParser)), $' asParser) / ($" asParser, ($" asParser whileFalse: (pairedBrackets / #any asParser)), $" asParser) ), (($> asParser / space / newline) and ) ] { #category : 'raw html' } PPCommonMarkInlinesParser >> rawHtmlComment [ ^ ('' asParser) 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 ]