[squeak-dev] swiki source suited to recent Squeaks

Levente Uzonyi leves at caesar.elte.hu
Tue Aug 13 22:59:05 UTC 2019


Hi Tim,

On Tue, 13 Aug 2019, tim Rowledge wrote:

> Well, here's a weird thing that I don't recall ever coming up against before.
>
> I've got a basic swiki page component for Seaside, as previously mentioned. Now we have Levente's (original plus small fixes) parser/generator to convert swiki markup to html. I join them together to see what happens ... and weird stuff happens. Testing in a workspace is fine BUT not when getting text back from a browser.

If you use Seaside, its #renderOn: implementations may be clashing with 
StreamingHtmlCanvas's. I just checked three such methods in my image 
(Seaside2 + StreamingHtmlCanvas loaded at the same time), and 
the implementations are the same, so no issue there.

But, if you use Seaside, you might want to consider using TinyWiki.

>
> It turns out that the browser (safari and chrome) sends a string with CRLF line ends to us. Now, I'm a long way from keeping up to date with web stuff but really?  I thought we got LFs because unixy-things.
>
> The practical issue is that the grammar provided in PEGParser class>>#grammarWiki has a load of places reliant on \n and so, for example, the Preformatted & Code tags simply get ignored.
>
> Two obvious questions come to mind here
> a) what on earth? CRLF? Is that normal or is it an artefact of some Seaside setup I can change?
> b) if we need to change the grammar to cope with crlf, what is the best way? I don't find the grammar terribly intuitable and can't spot any rule explanation. I've tried changing the Preformatted rule for example to 
> Preformatted <- "---\r\n" .{"---\r\n"} 
> and the parser doesn't even recognise the swiki tags.
>
> I'd hate to have to do a crlf -> lf conversion every time, it seems so inelegant.
>
> Oh - http://code.google.com/p/support/wiki/WikiSyntax (as referenced in #grammarWiki) seems to be a dead page now, which makes it a not very good bit of documentation! Bizarrely there doesn't appear to be much related info found by google.

crlf is pretty much an internet thing. Even Squeak's converter method is 
called #withInternetLineEndings.

I have attached updated GoogleWikiCompiler and #grammarWiki 
implementations. The new grammar should accept crlf, cr and lf line 
endings. Weird thing is that \n refers to cr, while \r refers to lf in 
PEGParser's grammar, so crlf is \n\r...

The google page is gone, but its content is not: 
https://web.archive.org/web/20150418033327/http://code.google.com/p/support/wiki/WikiSyntax

Levente

>
> tim
> --
> tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim
> Strange OpCodes: CM: Circulate Memory
-------------- next part --------------
'From Squeak5.3alpha of 13 August 2019 [latest update: #18757] on 14 August 2019 at 12:50:18 am'!

!PEGParser class methodsFor: 'grammars' stamp: 'ul 8/14/2019 00:50'!
grammarWiki
	"This syntax is variation of google wiki syntax (http://code.google.com/p/support/wiki/WikiSyntax). It is used to mark up the package comments so that they can be turned into web pages. It is important that the mark-up isn't visually obtrusive so that the comments are still comfortably readable.
	The three major players in wiki syntax are:
		http://code.google.com/p/support/wiki/WikiSyntax
		http://en.wikipedia.org/wiki/Help:Wiki_markup
		http://c2.com/cgi/wiki?TextFormattingRules
	"
	^
'Page <- (Preformatted / Code / UnorderedList / OrderedList / Heading / Table / Paragraph / Empty)*

LineCharacter <- [^\r\n]
Flow <- Escape / Bold / Italic / LinkShort / LinkFull / LineCharacter
Escape <- "**" / "__" / "[["
Bold <- "*" Flow{"*"}
Italic <- "_" Flow{"_"}
LinkShort <- "[" .{&[>\]]} "]"
LinkFull <- "[" Flow{">"} .{"]"}


Line <- Flow{1,Empty}
Paragraph <- Line
Empty <- "\n\r" / "\n" / "\r"
Preformatted <- "---" Empty .{"---" Empty} 
Code <- "{{{" Empty .{"}}}" Empty} 
Whitespace <- [\t\s]*
Heading		<-	Heading4 / Heading3 / Heading2 / Heading1
Heading1	<-	Whitespace "= " Flow{" =" Empty}
Heading2	<-	Whitespace "== " Flow{" ==" Empty}
Heading3	<-	Whitespace "=== " Flow{" ===" Empty}
Heading4	<-	Whitespace "==== " Flow{" ====" Empty}

Bullet1 <-	Whitespace "*" Line
Bullet2 <-	Whitespace "**" Line
Bullet3 <-	Whitespace "***" Line
UnorderedList <- (UnorderedList2 / Bullet1)+
UnorderedList2 <- (UnorderedList3 / Bullet2)+
UnorderedList3 <- Bullet3+

Hash1 <- Whitespace "#" Line
Hash2 <- Whitespace "##" Line
Hash3 <- Whitespace "###" Line
OrderedList <- (OrderedList2 / Hash1)+
OrderedList2 <- (OrderedList3 / Hash2)+
OrderedList3 <- Hash3+

Table <-	HeadingRow TableRow*
HeadingRow <-	Whitespace "||" HeadingCell{Empty}
HeadingCell	<-	Flow{"||"}
TableRow <-	Whitespace "||" Cell{Empty}
Cell	<-	Flow{"||"}
'! !
-------------- 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/11/2019 21:51'!
LinkFull: flow address: address

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

!GoogleWikiCompiler methodsFor: 'Lexical' stamp: 'ul 8/11/2019 21:50'!
LinkShort: address

	<action: 'LinkShort' arguments: #(2)>
	^GoogleWikiDomNode a
		attributes: { 'href' -> ((address as: String), '.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/14/2019 00:09'!
Code: text

	<action: 'Code' arguments: #(3)>
	^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/14/2019 00:09'!
Preformatted: text

	<action: 'Preformatted' arguments: #(3)>
	^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/11/2019 19:40'!
asString

	^StreamingHtmlCanvas render: [ :html | self renderOn: html ]! !


!GoogleWikiDomNode methodsFor: 'rendering' stamp: 'ul 8/11/2019 19:41'!
renderChildNodes: childNodes of: element on: html

	childNodes ifNil: [ ^self ].
	childNodes class == self class ifTrue: [ ^element with: childNodes ].
	childNodes isString ifTrue: [ ^element with: childNodes ].
	childNodes isCharacter ifTrue: [ ^element with: childNodes ].
	childNodes isCollection ifTrue: [
		^childNodes do: [ :each | self renderChildNodes: each of: element on: html ] ].
	self error: 'Unexpected child nodes'! !

!GoogleWikiDomNode methodsFor: 'rendering' stamp: 'ul 8/11/2019 21:50'!
renderChildNodes: childNodes on: html

	childNodes ifNil: [ ^self ].
	childNodes class == self class ifTrue: [ ^childNodes renderOn: html ].
	childNodes isString ifTrue: [ ^html text: childNodes ].
	childNodes isCharacter ifTrue: [ ^html text: childNodes ].
	childNodes isCollection ifTrue: [
		^childNodes do: [ :each | 
			self renderChildNodes: each on: html ] ].
	self error: 'Unexpected child nodes'! !

!GoogleWikiDomNode methodsFor: 'rendering' stamp: 'ul 8/11/2019 21:49'!
renderOn: html

	| element |
	element := html perform: tag.
	attributes ifNotNil: [
		attributes do: [ :association |
			element
				addAttribute: association key
				value: association value ] ].
	element with: [ self renderChildNodes: children on: html ]! !


!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