"{ Package: 'stx:libwebkit' }"

Object subclass:#WebKitRenderer

	instanceVariableNames:'view pid socket channel'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-WebKit'

!

PeekableStream subclass:#Channel

	instanceVariableNames:'socket'

	classVariableNames:''

	poolDictionaries:''

	privateIn:WebKitRenderer

!

!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 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

    "Created: / 07-06-2011 / 11:36:43 / 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:[Transcript showCR: 'UNKNOWN EVENT: ', ev asArray printString].

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

    "Modified: / 07-06-2011 / 11:35:34 / 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: #url to: view url value;

        yourself

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

    "Modified: / 07-06-2011 / 10:26:08 / 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:'spawn / terminate'!

spawn

    |path uzbl args|

    path := Filename newTemporary.

    socket := Socket newUNIXserverAt:path pathName.

    uzbl := '/home/jv/work/uzbl/uzbl-core'.

    args := (Array 

                with:'/home/jv/work/uzbl/uzbl-core'

                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: / 07-06-2011 / 10:32:27 / 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>"

! !

!WebKitRenderer::Channel methodsFor:'initialization'!

initializeOn: aReadStream

    socket := aReadStream

    "Created: / 07-06-2011 / 10:45:39 / 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"

    ^ socket next

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

!

next: n

    ^ socket next: n

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

!

nextEvent

    | ev |

    ev := OrderedCollection new: 4.

    self upTo:$E.

    self expect: 'VENT ['.

    self skipFor:$].

    ev add: (self upTo: Character space).

    [ self nextEventArgumentIn: ev ] whileTrue.

    ^ev asArray

    "

        (WebKitRenderer::Channel on: 'EVENT [1234] LOAD_COMMIT ''http://www.smalltalk-x.de''' 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' readStream)

            nextEvent.

    "

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

!

nextEventArgumentIn: event

    | s c conv |

    s := String new writeStream.

    [ socket atEnd not and:[(c := socket next) ~~ Character space and:[ c ~~ Character cr ] ] ] 

        whileTrue: [ 

            conv == nil ifTrue: [

                c == $' ifTrue:[conv := #asString. c := socket next.] ifFalse:[

                c isDigit ifTrue: [conv := #asNumber] ifFalse:[

                conv := #asSymbol]]

            ].

            s nextPut: c.

    ].

    conv ifNotNil:[

        event add: (s contents perform: conv).

    ].

    ^c == Character space.

    "Created: / 07-06-2011 / 19:01:04 / 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"

    ^ self shouldImplement

!

skipFor: obj

    ^ socket skipFor: obj

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

!

upTo: obj

    ^ socket upTo: obj

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

! !

!WebKitRenderer::Channel methodsFor:'testing'!

atEnd

    "return true if the end of the stream has been reached;

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

    ^ socket atEnd

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

!

isEmpty

    "return true, if the contents of the stream is empty"

    ^ socket isEmpty

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

! !

!WebKitRenderer::Channel methodsFor:'writing'!

cr

    ^ socket cr

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

!

nextPut:anObject

    "put the argument, anObject onto the receiver

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

    ^ socket nextPut:anObject

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

!

nextPutAll:anObject

    "put the argument, anObject onto the receiver

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

    ^ socket nextPutAll:anObject

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

!

space

    ^ socket space

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

! !

!WebKitRenderer class methodsFor:'documentation'!

version_SVN

    ^ '$Id$'

! !