"{ Package: 'stx:libwebkit' }"

Object subclass:#WebKitRenderer

	instanceVariableNames:'view pid socket channel'

	classVariableNames:'UzblCorePath Debug'

	poolDictionaries:''

	category:'Views-WebKit'

!

PeekableStream subclass:#Channel

	instanceVariableNames:'socket peekChar buffer'

	classVariableNames:''

	poolDictionaries:''

	privateIn:WebKitRenderer

!

!WebKitRenderer class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    Debug := false

    "Modified: / 10-06-2011 / 18:39:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer class methodsFor:'instance creation'!

for: aWebKitView

    ^self new initializeForView: aWebKitView

    "Created: / 02-06-2011 / 23:38:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-06-2011 / 10:38:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer class methodsFor:'accessing'!

debug: aBoolean

    Debug := aBoolean

    "Created: / 10-06-2011 / 18:40:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

uzblCorePath

    UzblCorePath ifNil:[

        UzblCorePath := ((Smalltalk packageDirectoryForPackageId: 'stx:libwebkit') / 'uzbl' / 'uzbl-core') pathName.

    ].

    ^UzblCorePath

    "Created: / 10-06-2011 / 09:56:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

uzblCorePath: aStringOrFilename

    UzblCorePath := aStringOrFilename

    "Created: / 10-06-2011 / 09:56:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer class methodsFor:'queries'!

isAvailable

    ^OperatingSystem isUNIXlike and:

        [self uzblCorePath asFilename isExecutable]

    "Created: / 10-06-2011 / 09:57:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'commands'!

setVariable: name to: value

    channel ifNil:[^self].

    channel

        nextPutAll: #set;

        space;

        nextPutAll: name;

        nextPut:$=;

        nextPutAll: value printString;

        cr

    "Created: / 07-06-2011 / 10:21:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'event handling'!

LOAD_COMMIT: event

    view url value ~= event second ifTrue:

        [view url value: event second].

    "Created: / 07-06-2011 / 11:36:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-06-2011 / 19:29:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

TITLE_CHANGED: event

    event second = '(no title)' ifFalse:

        [view title value: event second].

    "Created: / 08-06-2011 / 14:14:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'event loop'!

dispatchEvent

    | ev sym |

    ev := channel nextEvent.

    (self respondsTo: (sym := (ev first , ':') asSymbol)) ifTrue: [

        self perform: sym with: ev

    ] ifFalse: [

        Debug ifTrue:[

            Transcript showCR: 'UNKNOWN EVENT: ', ev asArray printString

        ]

    ].

    "Created: / 06-06-2011 / 18:13:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-06-2011 / 18:40:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

eventLoop

    [ channel atEnd ] whileFalse: [

        self dispatchEvent 

    ]

    "Created: / 06-06-2011 / 18:00:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-06-2011 / 10:52:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'initialization & release'!

close

    "Created: / 06-06-2011 / 18:38:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-06-2011 / 10:32:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

init

    self                                                            

        setVariable: #forward_keys to: 1;

        setVariable: #show_status to: 0;

        setVariable: #scrollbars_visible to: 1;

        setVariable: #uri to: view url value;

        yourself

    "Created: / 06-06-2011 / 18:00:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-06-2011 / 19:57:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

initializeForView: aWebKitView

    view := aWebKitView.

    "Created: / 02-06-2011 / 23:38:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'private'!

startEventLoop

    [ 

        self waitFor; init; eventLoop; close

    ] fork

    "Created: / 06-06-2011 / 17:57:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

waitFor

    socket listenFor: 1.

    channel := Channel on: socket accept.

    socket port asFilename remove.

    socket close.

    "Created: / 06-06-2011 / 18:00:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-06-2011 / 10:49:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'queries'!

isAvailable

    ^self class isAvailable

    "Created: / 10-06-2011 / 09:58:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer methodsFor:'spawn / terminate'!

spawn

    |path uzbl args|

    path := Filename newTemporary.

    socket := Socket newUNIXserverAt:path pathName.

    uzbl := self class uzblCorePath.

    args := (Array 

                with:uzbl

                with:'-s'

                with:view rendererView embeddingWindowId printString

                with:'--connect-socket=' , path pathName).

    self startEventLoop.

    pid := OperatingSystem

     exec: uzbl

     withArguments: args

     fork: true.

    "Created: / 02-06-2011 / 23:40:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-06-2011 / 09:59:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

terminate

    "Created: / 02-06-2011 / 23:40:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer::Channel class methodsFor:'instance creation'!

on: aReadStream

    ^self basicNew initializeOn: aReadStream

    "Created: / 07-06-2011 / 10:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer::Channel methodsFor:'accessing'!

contents

    "return the entire contents of the stream.

     For a readStream, that is the rest (i.e. upToEnd),

     for a writeStream, that is the collected data. As we do not know here,

     what we are, this is the responsibility of a subclass..."

    ^ self shouldNotImplement

    "Modified: / 07-06-2011 / 10:46:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

peekChar

    ^ peekChar

!

peekChar:something

    peekChar := something.

! !

!WebKitRenderer::Channel methodsFor:'initialization'!

initializeOn: aReadStream

    socket := aReadStream.

    buffer := String new writeStream.

    "Created: / 07-06-2011 / 10:45:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-06-2011 / 13:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer::Channel methodsFor:'private'!

contentsSpecies

    ^String

    "Created: / 08-06-2011 / 13:19:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer::Channel methodsFor:'queries'!

isReadable

    "return true, if reading is supported by the recevier.

     This has to be redefined in concrete subclasses."

    ^ socket isReadable

    "Modified: / 07-06-2011 / 10:46:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

isWritable

    "return true, if writing is supported by the recevier.

     This has to be redefined in concrete subclasses."

    ^ socket isWritable

    "Modified: / 07-06-2011 / 10:46:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer::Channel methodsFor:'reading'!

expect: aString

    | s |

    (s := self next: aString size) ~= aString

        ifTrue:[self error: 'Unexpect data in rendered channel'].

    "Created: / 07-06-2011 / 10:55:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

next

    "return the next element of the stream

     - we do not know here how to do it, it must be redefined in subclass"

    | char |

    ^peekChar isNil ifFalse:[

        char := peekChar.

        peekChar := nil.

        char.

    ] ifTrue:[

        socket next

    ]

    "Modified: / 08-06-2011 / 13:02:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

next: n

    | nextn |

    peekChar isNil ifTrue:[

        nextn := socket next: n

    ] ifFalse:[

        nextn := peekChar asString , socket next: n - 1.

        peekChar := nil

    ].

    ^nextn

    "Created: / 07-06-2011 / 11:01:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-06-2011 / 13:04:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextEvent

    | ev arg |

    ev := OrderedCollection new: 4.

    self upTo:$E.

    self expect: 'VENT ['.

    self skipFor:$].

    ev add: (self upTo: Character space).

    [ (arg := self nextStringOrSymbolOrNumber) notNil] whileTrue:

        [ev add: arg].

    ^ev asArray

    "

        (WebKitRenderer::Channel on: 'EVENT [1234] LOAD_COMMIT ''http://www.smalltalk-x.de''' readStream)

            nextEvent.

        (WebKitRenderer::Channel on: 'EVENT [1234] TITLE ''This is title''' readStream)

            nextEvent.

        (WebKitRenderer::Channel on: 'EVENT [1234] TITLE ''rock\''n\''roll''' readStream)

            nextEvent.

        (WebKitRenderer::Channel on: 'EVENT [1234] VARIABLE_SET name str ''xxx''' readStream)

            nextEvent.

        (WebKitRenderer::Channel on: 'EVENT [1234] VARIABLE_SET name int 12' readStream)

            nextEvent.

        (WebKitRenderer::Channel on: 'EVENT [1234] VARIABLE_SET name float 1.2

EVENT [1234] VARIABLE_SET name string ''xxx''' readStream)

            nextEvent

    "

    "Created: / 07-06-2011 / 10:52:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 08-06-2011 / 13:45:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextNumberOrSymbol

    | contents |

    buffer reset.

    buffer nextPut: self next.

    [self atEnd not and:[self peek isAlphaNumeric]] whileTrue:[

        buffer nextPut: self next.

    ].

    self peek == $. ifTrue:[

        buffer nextPut: self next.

        [self atEnd not and:[self peek isAlphaNumeric]] whileTrue:[

            buffer nextPut: self next.

        ]

    ].

    contents := buffer contents.

    (contents anySatisfy:[:c|c isLetter])

        ifTrue:[contents := contents asSymbol]

        ifFalse:[contents := contents asNumber].

    ^contents.

    "Created: / 08-06-2011 / 13:06:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextString

    | char |

    "/eat $'

    buffer reset.

    self next.

    [self atEnd not and:[(char := self next) ~~ $']] whileTrue:[

        char == $\ ifTrue:[char := self next].

        buffer nextPut: char.

    ].

    ^buffer contents.

    "Created: / 08-06-2011 / 13:06:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextStringOrSymbolOrNumber

    socket atEnd ifTrue:[^nil].

    self peek == Character cr ifTrue:[^nil]. 

    self skipSeparators.

    self peek == $' ifTrue:[^self nextString].

    self peek isDigit ifTrue:[^self nextNumberOrSymbol].

    ^self nextSymbol

    "Created: / 08-06-2011 / 12:57:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextSymbol

    ^super nextSymbol asSymbol

    "Created: / 08-06-2011 / 13:20:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

peek

    "return the next element of the stream without advancing (i.e.

     the following send of next will return this element again.)

     - we do not know here how to do it, it must be redefined in subclass"

    peekChar ifNil:[peekChar := socket next].

    ^peekChar.

    "Modified: / 08-06-2011 / 13:00:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!WebKitRenderer::Channel methodsFor:'reading (old)'!

old_nextEvent

    | ev |

    ev := OrderedCollection new: 4.

    self upTo:$E.

    self expect: 'VENT ['.

    self skipFor:$].

    ev add: (self upTo: Character space).

    [ self old_nextEventArgumentIn: ev ] whileTrue.

    ^ev asArray