"{ 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 := (OperatingSystem getLoginName  = 'jv')

    "Modified: / 11-02-2012 / 20:21:00 / 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

    | renderer |

    UzblCorePath ifNil:[

        renderer := 'WebKitRenderer.' , (OperatingSystem getSystemInfo at:#machine).

        UzblCorePath := ((Smalltalk packageDirectoryForPackageId: 'stx:libwebkit') / renderer ) pathName.

    ].

    ^UzblCorePath

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

    "Modified: / 20-06-2011 / 11:27:20 / 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>"

!

PTR_MOVE: event

    view buttonMotion: 0 x: event second y: event third

    "Created: / 18-02-2012 / 14:31:16 / 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

    view sensor pushUserEvent: #dispatchEvent: for:self withArgument: channel nextEvent.

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

    "Modified: / 18-02-2012 / 14:36:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

dispatchEvent: ev

    | sym |

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

        self perform: sym with: ev

    ] ifFalse: [

        Debug ifTrue:[

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

        ]

    ].

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

    "Created: / 18-02-2012 / 14:32:28 / 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>"

!

isRunning

    ^pid notNil

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

! !

!WebKitRenderer methodsFor:'renderer API'!

render:webKitView1 on:webKitView2 at:aPoint

    "Nothing to do here, since my renderer process renders

     the content"

    "Created: / 15-06-2011 / 15:22:35 / 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

    pid := nil.

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

    "Modified: / 10-06-2011 / 23:41:24 / 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>"