[squeak-dev] swiki source suited to recent Squeaks

Levente Uzonyi leves at caesar.elte.hu
Sat Aug 10 22:04:52 UTC 2019


On Tue, 6 Aug 2019, tim Rowledge wrote:

>
>
>> On 2019-08-05, at 10:50 PM, Chris Cunnington <brasspen at gmail.com> wrote:
>> 
>> Copy this code into a Workspace and DoIt.
>> 
>> Installer ss
>>       project: 'MetacelloRepository';
>>       install: 'ConfigurationOfXMLParser'.
>> (Smalltalk at: #ConfigurationOfXMLParser) project bleedingEdge load
>
>
> OK, so yet another "I couldn't spot this with google" moment. What fun.
>
> It does at least load. And then of course I had to load the XTreams stuff because I foolishly thought trying a cleaner image might be smart after all the 'fun' of previous attempts.

Right. I also failed to notice it was for XMLParser instead of Xtreams.
The following should load Xtreams and its dependencies, including monty's 
XMLParser into a fresh image:

Installer ensureRecentMetacello.
Installer ss
 	project: 'MetacelloRepository';
 	install: 'ConfigurationOfXtreams'.
(Smalltalk at: #ConfigurationOfXtreams) project bleedingEdge load

>
>>
>> 	wikiGrammar := PEGParser grammarWiki reading.
>> 	wikiParser := PEGParser parserPEG parse: 'Grammar' stream: wikiGrammar actor: PEGParserParser new.
>> 	 input := 'Single paragraph with *bold* and _italic_ text and a [link]' reading.
>> 	wikiParser parse: 'Page' stream: input actor: PEGWikiGenerator new
>> 
>> And  you’ll get this. 
>> 
>> <div><p>Single paragraph with <span style="font-weight: bold">bold</span> and <span style="font-style: italic">italic</span> text and a <a href="link.html">an OrderedCollection($l $i $n $k)</a></p></div>
>
> Just for fun I did try that in the earlier-dirty image and it failed because somewher it decided that 'link' was an orderedcollection of symbols instead of a string. Made for an amusing crash within XMLWriter>>#write:escapedWith:
>
> In a start-from-clean image it did actually do what your show. Thank you for that. I really think a simpler solution would be nice here. Adding 4Mb to an image for a simple swiki markup parser seems a bit much.

I wrote and attached a different actor, which builds a simple dom tree, 
which can be turned into a string:

 	GoogleWikiCompiler example asString

should give

 	'<div><p>Single paragraph with <strong>bold</strong> and <em>italic</em> text and a <a href="link.html">link</a></p></div>'

It has no external dependencies but Xtreams-Parsing, so it doesn't need 
monty's XMLParser to be loaded.

Levente

>
> tim
> --
> tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim
> Strange OpCodes: RDL: Rotate Disk Left
-------------- next part --------------
PEGActor subclass: #GoogleWikiCompiler
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GoogleWikiCompiler'!
!GoogleWikiCompiler commentStamp: '<historical>' prior: 0!
This actor is used to convert text with wiki mark-up into an XML document with xhtml tags.

Shared Variables
	Anchor	<NodeTag>
	Break	<NodeTag>
	Division	<NodeTag>
	Heading1	<NodeTag>
	Heading2	<NodeTag>
	Heading3	<NodeTag>
	Heading4	<NodeTag>
	Href	<NodeTag>
	ListItem	<NodeTag>
	OrderedList	<NodeTag>
	Paragraph	<NodeTag>
	Preformatted	<NodeTag>
	Span	<NodeTag>
	Style	<NodeTag>
	Table	<NodeTag>
	TableBody	<NodeTag>
	TableData	<NodeTag>
	TableHead	<NodeTag>
	TableHeading	<NodeTag>
	TableRow	<NodeTag>
	UnorderedList	<NodeTag>

!


!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/10/2019 22:17'!
Bold: flow

	<action: 'Bold' arguments: #(2)>
	^GoogleWikiDomNode strong: flow! !

!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/10/2019 14:58'!
Escape: escape

	<action: 'Escape'>
	^escape first! !

!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/10/2019 22:31'!
Italic: flow

	<action: 'Italic' arguments: #(2)>
	^GoogleWikiDomNode em: flow! !

!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/10/2019 22:32'!
LinkFull: flow address: address

	<action: 'LinkFull' arguments: #(2 3)>
	^GoogleWikiDomNode a
		attributes: { 'href' -> address };
		children: flow;
		yourself! !

!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/10/2019 22:32'!
LinkShort: address

	<action: 'LinkShort' arguments: #(2)>
	^GoogleWikiDomNode a
		attributes: { 'href' -> (address, '.html') };
		children: address;
		yourself! !

!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/10/2019 22:37'!
Underline: flow

	<action: 'Underline' arguments: #(2)>
	^GoogleWikiDomNode span
		attributes: { 'style' -> 'text-decoration: underline' };
		children: flow;
		yourself! !


!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:17'!
Code: text

	<action: 'Code' arguments: #(2)>
	^GoogleWikiDomNode code: text! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 15:01'!
Empty

	<action: 'Empty' arguments: #()>
	^nil! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:30'!
Heading1: flow

	<action: 'Heading1' arguments: #(3)>
	^GoogleWikiDomNode h1: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:31'!
Heading2: flow

	<action: 'Heading2' arguments: #(3)>
	^GoogleWikiDomNode h2: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:31'!
Heading3: flow

	<action: 'Heading3' arguments: #(3)>
	^GoogleWikiDomNode h3: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:31'!
Heading4: flow

	<action: 'Heading4' arguments: #(3)>
	^GoogleWikiDomNode h4: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:33'!
ListItem: bullets flow: flow

	<action: 'Bullet1' arguments: #(2 3)>
	<action: 'Bullet2' arguments: #(2 3)>
	<action: 'Bullet3' arguments: #(2 3)>
	<action: 'Hash1' arguments: #(2 3)>
	<action: 'Hash2' arguments: #(2 3)>
	<action: 'Hash3' arguments: #(2 3)>

	^GoogleWikiDomNode li: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:33'!
OrderedList: bullets

	<action: 'OrderedList'>
	^GoogleWikiDomNode ol: bullets! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:34'!
OrderedListN: bullets

	<action: 'OrderedList2'>
	<action: 'OrderedList3'>

	^GoogleWikiDomNode li: (GoogleWikiDomNode ol: bullets)! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:34'!
Page: lines

	<action: 'Page'>
	^GoogleWikiDomNode div: lines! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:34'!
Paragraph: flow

	<action: 'Paragraph'>
	^GoogleWikiDomNode p: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:35'!
Preformatted: text

	<action: 'Code' arguments: #(2)>
	^GoogleWikiDomNode pre: text! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:36'!
Table: header rows: rows

	<action: 'Table' arguments: #(1 2)>
	^GoogleWikiDomNode table: {
		GoogleWikiDomNode thead: header.
		GoogleWikiDomNode tbody: rows }! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:36'!
TableCell: flow

	<action: 'Cell'>
	^GoogleWikiDomNode td: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:36'!
TableHeadingCell: flow

	<action: 'HeadingCell'>
	^GoogleWikiDomNode th: flow! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:36'!
TableRow: cells

	<action: 'TableRow' arguments: #(3)>
	<action: 'HeadingRow' arguments: #(3)>
	^GoogleWikiDomNode tr: cells! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:37'!
UnorderedList: bullets

	<action: 'UnorderedList'>
	^GoogleWikiDomNode ul: bullets! !

!GoogleWikiCompiler methodsFor: 'Structural' stamp: 'ul 8/10/2019 22:37'!
UnorderedListN: bullets

	<action: 'UnorderedList2'>
	<action: 'UnorderedList3'>
	^GoogleWikiDomNode li: (GoogleWikiDomNode ul: bullets)! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GoogleWikiCompiler class
	instanceVariableNames: ''!

!GoogleWikiCompiler class methodsFor: 'utilities' stamp: 'ul 8/10/2019 23:40'!
process: input
	"Convert input into an xhtml XML document.
	"
	"	input	<ReadStream>	text with wiki markup
		^		<GoogleWikiDomNode>
	"
	"
		self process: 'Single paragraph with *bold* and _italic_ text and a [link]' reading
	"

	^self parser
		parse: 'Page'
		stream: input
		actor: self new! !


!GoogleWikiCompiler class methodsFor: 'examples' stamp: 'ul 8/10/2019 23:36'!
example
	" self example "

	| input output |
	input := 'Single paragraph with *bold* and _italic_ text and a [link]' reading.
	output := self process: input.
	^output! !


!GoogleWikiCompiler class methodsFor: 'accessing' stamp: 'ul 8/10/2019 23:45'!
parser

	^PEGParser parserPEG
		parse: 'Grammar'
		stream: PEGParser grammarWiki reading
		actor: PEGParserParser new! !


Object subclass: #GoogleWikiDomNode
	instanceVariableNames: 'tag attributes children'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GoogleWikiCompiler'!

!GoogleWikiDomNode methodsFor: 'converting' stamp: 'ul 8/10/2019 23:41'!
asString

	^String streamContents: [ :stream | self writeOn: stream ]! !


!GoogleWikiDomNode methodsFor: 'writing' stamp: 'ul 8/10/2019 22:26'!
writeAttributeValue: valueString on: stream

	| startIndex quoteIndex |
	startIndex := 1.
	[ (quoteIndex := (valueString indexOf: $" startingAt: startIndex)) = 0 ] whileFalse: [
		stream
			next: quoteIndex - startIndex + 1
				putAll: valueString
				startingAt: startIndex;
			nextPut: $".
		startIndex := quoteIndex + 1 ].
	stream
		next: valueString size - startIndex + 1
		putAll: valueString
		startingAt: startIndex! !

!GoogleWikiDomNode methodsFor: 'writing' stamp: 'ul 8/10/2019 22:39'!
writeChildNodes: childNodes on: stream

	childNodes ifNil: [ ^self ].
	childNodes class == self class ifTrue: [ ^childNodes writeOn: stream ].
	childNodes isString ifTrue: [ ^stream nextPutAll: childNodes ].
	childNodes isCharacter ifTrue: [ ^stream nextPut: childNodes ].
	childNodes isCollection ifTrue: [
		^childNodes do: [ :each | self writeChildNodes: each on: stream ] ].
	self error: 'Unexpected child nodes'! !

!GoogleWikiDomNode methodsFor: 'writing' stamp: 'ul 8/10/2019 23:39'!
writeOn: stream

	stream
		nextPut: $<;
		nextPutAll: tag.
	attributes ifNotNil: [
		attributes do: [ :association |
			stream
				space;
				nextPutAll: association key;
				nextPutAll: '="'.
			self writeAttributeValue: association value on: stream.
			stream nextPut: $" ] ].
	stream nextPut: $>.
	self writeChildNodes: children on: stream.
	stream
		nextPutAll: '</';
		nextPutAll: tag;
		nextPut: $>! !


!GoogleWikiDomNode methodsFor: 'accessing' stamp: 'ul 8/10/2019 22:15'!
attributes: aCollectionOfAssociations

	attributes := aCollectionOfAssociations! !

!GoogleWikiDomNode methodsFor: 'accessing' stamp: 'ul 8/10/2019 23:38'!
children: anObject

	children := anObject! !

!GoogleWikiDomNode methodsFor: 'accessing' stamp: 'ul 8/10/2019 22:15'!
tag: aSymbol

	tag := aSymbol! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GoogleWikiDomNode class
	instanceVariableNames: ''!

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:15'!
a

	^self new
		tag: #a;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:17'!
code: children

	^self new
		tag: #code;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:34'!
div: children

	^self new
		tag: #div;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:31'!
em: children

	^self new
		tag: #em;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:30'!
h1: children

	^self new
		tag: #h1;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:31'!
h2: children

	^self new
		tag: #h2;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:31'!
h3: children

	^self new
		tag: #h3;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:31'!
h4: children

	^self new
		tag: #h4;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:32'!
li: children

	^self new
		tag: #li;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:33'!
ol: children

	^self new
		tag: #ol;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:34'!
p: children

	^self new
		tag: #p;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
pre: children

	^self new
		tag: #pre;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:37'!
span

	^self new
		tag: #span;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:17'!
strong: children

	^self new
		tag: #strong;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
table: children

	^self new
		tag: #table;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
tbody: children

	^self new
		tag: #tbody;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
td: children

	^self new
		tag: #td;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
th: children

	^self new
		tag: #th;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
thead: children

	^self new
		tag: #thead;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:35'!
tr: children

	^self new
		tag: #tr;
		children: children;
		yourself! !

!GoogleWikiDomNode class methodsFor: 'instance creation' stamp: 'ul 8/10/2019 22:33'!
ul: children

	^self new
		tag: #ul;
		children: children;
		yourself! !


More information about the Squeak-dev mailing list