"{ 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>"
!
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
"
(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: / 08-06-2011 / 12:57:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
old_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]]
].
(conv == #asNumber and:[c isDigit not and:[c ~~ $.]]) ifTrue:
[conv := #asSymbol].
s nextPut: c.
].
conv ifNotNil:[
conv = #asString ifTrue:[s skip: -1].
event add: (s contents perform: conv).
].
^c == Character space.
"Created: / 08-06-2011 / 12:47:54 / 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$'
! !
WebKitRenderer initialize!