'From VisualWorks(TM), Release 1.0 of 8 October 1992 on 21 August 1994 at 8:31:06 pm'!



!TextAttributes class methodsFor: 'class initialization'!

initializehtmlDefault
	| style cStyle |
	style := self new.
	cStyle := CharacterAttributes newWithDefaultAttributes.
	cStyle setDefaultQuery: (FontDescription new
			family: #('times' '*');
			fixedWidth: false;
			serif: false;
			italic: false;
			boldness: 0.5;
			pixelSize: 16).
	style setCharacterAttributes: cStyle.
	cStyle at: #veryLarge put: [ :fontDesc | fontDesc pixelSize: 24].
	style lineGrid: 27; baseline: 20; firstIndent: 0; restIndent: 0; rightIndent: 0.

	self styleNamed: #htmlDefault put: style! !

TextAttributes initializehtmlDefault!


'From VisualWorks(R) Release 2.0 of 4 August 1994 on 4 March 1995 at 5:43:05 pm'!



!VisualComponent methodsFor: 'hit detection'!

hitDetect: aPoint
	(self containsPoint: aPoint) ifTrue: [^self].
	^nil! !

!Wrapper methodsFor: 'hit detection'!

hitDetect: aPoint
	^self! !

!CompositePart methodsFor: 'hit detection'!
hitDetect: aPoint
	"Answer a component that contains point aPoint or nil."

	components size to: 1 by: -1 do: 
		[:i |
		| c |
		c := components at: i.
		(c containsPoint: aPoint)
			ifTrue: [^c]].
	^nil! !

!Character methodsFor: 'converting'!

asString
	^String with: self! !
Object subclass: #Stack
	instanceVariableNames: 'content '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Support'!
Stack comment:
'You''d better know who I am !!

Instance Variables:
	content		<OrderedCollection>
'!


!Stack methodsFor: 'enumerating'!

do: aBlock 
	^content do: aBlock!

select: aBlock 
	^content select: aBlock! !

!Stack methodsFor: 'accessing'!

clear
	"Clear all the elements in stack."

	self initialize!

firstElement
	"Without poping, return the most bottom element in the stack"

	content isEmpty ifTrue: [^nil].
	^content first!

lastElement
	"Without poping, return the last inserted element from the stack"

	content isEmpty ifTrue: [^nil].
	^content last!

pop
	"Return the top element."

	content isEmpty ifTrue:[^nil].
	^content removeLast!

push: anObject
	"Push anObject into the top of the stack. "

	content addLast: anObject!

size
	^content size!

top
	"Without poping, return the most bottom element in the stack"

	content isEmpty ifTrue: [^nil].
	^content first! !

!Stack methodsFor: 'initialize-release'!

initialize
	content := OrderedCollection new! !

!Stack methodsFor: 'testing'!

isEmpty
	^content isEmpty! !

!Stack methodsFor: 'printing'!

printOn: aStream 
	aStream nextPutAll: 'a Stack ( '.
	content
		do: 
			[:each | 
			aStream nextPutAll: ' ( '.
			each printOn: aStream.
			aStream nextPutAll: ' ) '].
	aStream nextPutAll: ' ) '! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Stack class
	instanceVariableNames: ''!


!Stack class methodsFor: 'instance creation'!

new
	^super new initialize! !

Object subclass: #ResponseHeader
	instanceVariableNames: 'attributes httpVersion statusCode firstLine '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Support'!
ResponseHeader comment:
'I am the responseHeader for HTTP 1.0 protocol.

Instance Variables:
	attributes	<Dictionary>
	httpVersion	<aString>
	statusCode	<aString>
	firstLine		<aString>
'!


!ResponseHeader methodsFor: 'initialize-release'!

initialize
	attributes := Dictionary new.! !

!ResponseHeader methodsFor: 'accessing'!

addAttributeName: aNameString value: aValueString 
	attributes at: aNameString asLowercase put: aValueString!

atAttribute: aNameString	
	^attributes at: aNameString asLowercase ifAbsent: nil!

firstLine
	^firstLine!

firstLine: aString
	firstLine := aString!

httpVersion
	^httpVersion!

httpVersion: aString
	httpVersion := aString!

mimeSubType
	| subTypeString colonIdx |
	subTypeString := self atAttribute: 'Content-Type'.
	colonIdx := subTypeString indexOf: $/.
	colonIdx = 0 ifFalse: [^(subTypeString copyFrom: colonIdx + 1 to: subTypeString size) asSymbol]
		ifTrue: [^#nil]!

mimeType
	| typeString colonIdx |
	typeString := self atAttribute: 'Content-Type'.
	colonIdx := typeString indexOf: $/.
	colonIdx = 0 ifFalse: [^(typeString copyFrom: 1 to: colonIdx - 1) asSymbol]
		ifTrue: [^typeString asSymbol]!

statusCode
	^statusCode!

statusCode: aString
	statusCode := aString! !

!ResponseHeader methodsFor: 'private'!

crlf
	^String with: Character cr with: Character lf! !

!ResponseHeader methodsFor: 'converting'!

readStream
	| s |
	s := firstLine , self crlf.
	attributes
		keysAndValuesDo: 
			[:attr :value | 
			s := s , attr.
			value notNil ifTrue: [s := s , '=' , value].
			s := s , self crlf].
	^s readStream! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ResponseHeader class
	instanceVariableNames: ''!


!ResponseHeader class methodsFor: 'instance creation'!

new
	^super new initialize! !

VisualComponent subclass: #HorizontalLine
	instanceVariableNames: 'start end height leftOffset '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Support'!
HorizontalLine comment:
'I am just a 3D horizontal line.
'!


!HorizontalLine methodsFor: 'displaying'!

displayOn: aGraphicsContext
	| y|

	aGraphicsContext paint: ColorValue gray.
	aGraphicsContext displayLineFrom: start to: end.

	y := start y + 1.
	aGraphicsContext paint: ColorValue white.
	aGraphicsContext displayLineFrom: start x @ y to: end x @ y.! !

!HorizontalLine methodsFor: 'bounds accessing'!

preferredBounds
	|width|
	width := end x - start x + leftOffset.
	^start extent: width@(self height)! !

!HorizontalLine methodsFor: 'private'!

defaultHeight
	^30! !

!HorizontalLine methodsFor: 'accessing'!

height
	height isNil ifTrue: [^self defaultHeight].
	^height!

height: anInteger
	height := anInteger!

width: anInteger
	start := leftOffset@10.
	end := anInteger @10! !

!HorizontalLine methodsFor: 'initialize-release'!

initialize
	leftOffset := 10! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HorizontalLine class
	instanceVariableNames: ''!


!HorizontalLine class methodsFor: 'instance creation'!

new
	^super new initialize! !

Text subclass: #StructuredText
	instanceVariableNames: 'structuralRuns '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Support'!
StructuredText comment:
'For hypertext application, sometimes, different portions of a Text has different meanings. For example, the first five words belong to a H1 tag in a HTML text file but the second word also belongs to the tag A.  I am capable of storing this information in the same way in which Text stores emphasis.

Instance Varialbes:
	structuralRuns	<RunArray> of anything.
'!


!StructuredText methodsFor: 'private'!

setStructures: anArray
	structuralRuns := anArray!

structures
	^structuralRuns! !

!StructuredText methodsFor: 'structures'!

addStructure: newStructure removeStructure: oldStructure allowDuplicates: aBool 

	structuralRuns := structuralRuns
			add: newStructure
			remove: oldStructure
			duplicate: aBool!

ignoreCR: aBoolean!

structureAllWith: anObject
	"Set the structure for all characters in the receiver to be the given structure."

	self structureFrom: 1 to: self size with: anObject!

structureAt: characterIndex 
	self size = 0 ifTrue: [^nil].	"null text tolerates access"
	^structuralRuns at: characterIndex!

structureFrom: start to: stop with: anObject
	"Set the structure for characters in the interval start-stop."

	structuralRuns := 
		structuralRuns
			copyReplaceFrom: start
			to: stop
			with: (structuralRuns class new: stop - start + 1 withAll: anObject)!

structuresAt: characterIndex 
	| structures |
	self size = 0 ifTrue: [^nil].	"null text tolerates access"
	structures := structuralRuns at: characterIndex.
	structures size = 0
		ifTrue: [^OrderedCollection with: structures]
		ifFalse: [^structures]! !

!StructuredText methodsFor: 'accessing'!

replaceFrom: start to: stop with: aTextOrString
	| repText |
	repText := aTextOrString asText.
	string := string changeFrom: start to: stop with: repText string.
	runs := runs copyReplaceFrom: start to: stop with: repText runs.
	structuralRuns := structuralRuns copyReplaceFrom: start to: stop with: aTextOrString structures.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

StructuredText class
	instanceVariableNames: ''!


!StructuredText class methodsFor: 'instance creation'!

fromString: aString

	^self string: aString emphasis: nil structure: nil!

string: aString emphasis: code structure: anObject
	| st |
	st := self string: aString asString runs: (RunArray new: aString size withAll: code).
	st setStructures: (RunArray new: aString size withAll: anObject).
	^st! !

Stream subclass: #RandomFile
	instanceVariableNames: 'random dirFileName prefix suffix '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Support'!
RandomFile comment:
'I am a random file generator.


Instance Variables:
	random 		<Random>
	dirFilename 	<Filename>
	prefix 		<String>
	extension 	<String>'!


!RandomFile methodsFor: 'accessing'!

next
	"Return the next random file."
	^self nextWithPrefix: prefix suffix: suffix!

nextWithPrefix: aFilenameString
	"Return the next random file."
	^self nextWithPrefix: aFilenameString suffix: suffix!

nextWithPrefix: prefixString suffix: suffixString 
	"Return the next random file."

	| fileString |
	
	[| tmpFilename |
	fileString := prefixString , random next printString , suffixString.
	tmpFilename := Filename named: (dirFileName asString, fileString).
	tmpFilename exists] whileTrue.
	^dirFileName construct: fileString!

nextWithSuffix: aFilenameString
	"Return the next random file."
	^self nextWithPrefix: prefix suffix: aFilenameString! !

!RandomFile methodsFor: 'private'!

dirName: aDirString
	dirFileName := Filename named: aDirString!

prefix: aString
	prefix := aString!

random: aRandom
	random := aRandom!

suffix: aString
	suffix := aString! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

RandomFile class
	instanceVariableNames: ''!


!RandomFile class methodsFor: 'instance creation'!

dirName: dirString 
	^self
		dirName: dirString
		prefix: self defaultPrefix
		suffix: self defaultSuffix!

dirName: dirString prefix: prefixString suffix: suffixString
	|g|
	g := self basicNew.
	g random: (BetterRandom integerBetween: 1 and: 9999999).
	g dirName: dirString; prefix: prefixString; suffix: suffixString.
	^g! !

!RandomFile class methodsFor: 'private'!

defaultPrefix
	^'t'!

defaultSuffix
	^'.tmp'! !

Object subclass: #ResponseHeaderBuilder
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Support'!
ResponseHeaderBuilder comment:
'I can parse a string and build a ResponseHeader in http protocol.'!


!ResponseHeaderBuilder methodsFor: 'private'!

parseFirstHeaderLine: aString to: aResponseHeader 
	| slashIdx spaceIdx1 spaceIdx2 |
	slashIdx := aString indexOf: $/.
	spaceIdx1 := aString indexOf: Character space.
	spaceIdx2 := aString
				nextIndexOf: Character space
				from: spaceIdx1 + 1
				to: aString size.
	aResponseHeader firstLine: aString.
	aResponseHeader httpVersion: (aString copyFrom: slashIdx + 1 to: spaceIdx1 - 1).
	aResponseHeader statusCode: (aString copyFrom: spaceIdx1 + 1 to: spaceIdx2 - 1)!

parseHeaderLine: aString to: aResponseHeader 
	| colonIdx attrName attrValue |
	aString = '' ifTrue: [^self].
	colonIdx := aString indexOf: $:.
	colonIdx > 0
		ifTrue: 
			[attrName := aString copyFrom: 1 to: colonIdx - 1.
			attrValue := aString copyFrom: colonIdx + 2 to: aString size.
			aResponseHeader addAttributeName: attrName value: attrValue]!

remove: aCharCollection from: aStream 
	"If the next occurence of elements in aCharCollection from aStream."

	|oPos tmpCollection|
	oPos := aStream position.
	tmpCollection := aStream throughAll: aCharCollection.	
	(tmpCollection size = aCharCollection size) ifFalse: [ aStream position: oPos ]! !

!ResponseHeaderBuilder methodsFor: 'accessing'!

buildFrom: aStream delimiters: aCharCollection
	| firstLine header |
	header := ResponseHeader new.
	firstLine := aStream upToAll: aCharCollection.
	self parseFirstHeaderLine: firstLine to: header.
	[aStream atEnd]
		whileFalse: 
			[| eachLine |
			self remove: aCharCollection from: aStream.
			eachLine := aStream upToAll: aCharCollection.
			self parseHeaderLine: eachLine to: header].
	^header! !

Object subclass: #Attribute
	instanceVariableNames: 'value id '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
Attribute comment:
'I represent an attribute in a HyperComponent. 

Instance Variales:
	id		<aSymbol>
	value	<aString>

'!


!Attribute methodsFor: 'testing'!

isAttributeName: aSymbol
	"Test if the receiver's attribute Name is the same as aString. Attribute name 
	is case insensitive."

	^id = aSymbol! !

!Attribute methodsFor: 'accessing'!

id
	^id!

id: aSymbol
	id := aSymbol!

name
	"Same as id. Put here so that it is compatible with previous version of HyperTalk."

	^self id!

name: anObject
	"Same as id:. Put here so that it is compatible with previous version of HyperTalk."

	^self id: anObject!

value
	^value!

value: anObject
	value := anObject! !

!Attribute methodsFor: 'printing'!

printOn: aStream 
	aStream nextPutAll: self class printString , ' '.
	id notNil ifTrue: [aStream nextPutAll: id].
	value notNil ifTrue: [aStream nextPutAll: ' =' , value printString]! !

Object subclass: #HyperComponent
	instanceVariableNames: 'attributes presentations anchors content type formatPolicy '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
HyperComponent comment:
'I am the abstract super class for hypertext components.

Instance Variables:
	attributes 		<OrderedCollection> of Attribute
	presentations 	<OrderedCollection> of anObject
	anchors 		<OrderedCollection> of Anchor
	content 			<anObject>
	type 			<aSymbol>
	formatPolicy 	<RenderPolicy> '!


!HyperComponent methodsFor: 'streams'!

flush
	"Signal the end of adding stream input to the receiver. Do whatever the receiver needs to get done. "
	self changed: #end!

next
	"Answer the next object in the content of the receiver."

	self subclassResponsibility!

nextPut: aHyperComponent
	^self subclassResponsibility! !

!HyperComponent methodsFor: 'initialize-release'!

initialize
	self attributes: OrderedCollection new.
	self anchors: OrderedCollection new.
	presentations := OrderedCollection new.! !

!HyperComponent methodsFor: 'accessing'!

addAnchor: anAnchor 
	self anchors add: anAnchor!

addAttribute: anAttribute
	attributes add: anAttribute!

content
	^content!

content: anObject
	content := anObject!

findAttribute: aSymbol
	^attributes detect: [:each | each isAttributeName: aSymbol]
		ifNone: nil!

formatPolicy
	^formatPolicy!

formatPolicy: aRenderPolicy
	aRenderPolicy component: self.
	formatPolicy := aRenderPolicy!

lastAttribute
	^attributes last!

type
	^type!

type: aSymbol
	type := aSymbol! !

!HyperComponent methodsFor: 'refactorings'!

anchors
	^anchors!

anchors: aValue
	^anchors := aValue!

attributes
	^attributes!

attributes: aValue
	^attributes := aValue! !

!HyperComponent methodsFor: 'printing'!

printOn: aStream 
	aStream nextPutAll: '(', self class printString, type printString.
	aStream nextPutAll: ')'; cr.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HyperComponent class
	instanceVariableNames: ''!


!HyperComponent class methodsFor: 'instance-creation'!

new
	^super new initialize! !

HyperComponent subclass: #HyperComposite
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
HyperComposite comment:
'I represent a composite hypertext component. My content is an OrderedCollection of HyperComponents.'!


!HyperComposite methodsFor: 'accessing'!

add: anObject
	"Add an object to the content of HyperComposite."
	content add: anObject! !

!HyperComposite methodsFor: 'streams'!

nextPut: aHyperComponent
	content add: aHyperComponent.
	self changed: #add with: aHyperComponent.! !

!HyperComposite methodsFor: 'initialize-release'!

initialize
	super initialize.
	content := OrderedCollection new.! !

HyperComponent subclass: #WebComponent
	instanceVariableNames: 'hTextFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
WebComponent comment:
'WebComposite and I are parse tree nodes for HTML document. I am an atomic node. 

instance variables:
	hTextFlag 		<Boolean> True means I am a text that can be concatenated to other WebComponent for presentation. '!


!WebComponent methodsFor: 'testing'!

isAnchor
	^false!

isComposite
	^false!

isDestAnchor
	^false!

isHText
	^hTextFlag! !

!WebComponent methodsFor: 'accessing'!

hTextFlag: aBoolean
	hTextFlag := aBoolean! !

!WebComponent methodsFor: 'printing'!

printFormatPolicy: aStream 
	aStream nextPutAll: '(FormatPolicy ='.
	formatPolicy isNil ifFalse: [aStream nextPutAll: formatPolicy printString; cr].
	aStream nextPutAll: type printString.
	aStream nextPutAll: ')'! !

!WebComponent methodsFor: 'enumerating'!

preorderDo: aBlock 
	aBlock value: self.! !

Object subclass: #Anchor
	instanceVariableNames: 'id value '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
Anchor comment:
'I represent an anchor in hypertext systems. 

Instance Variables:
	id		<aSymbol>
	value	<anObject>
'!


!Anchor methodsFor: 'accessing'!

id
	^id!

id: anObject
	id := anObject!

value
	^value!

value: anObject
	value := anObject! !

HyperComposite subclass: #WebComposite
	instanceVariableNames: 'hTextFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
WebComposite comment:
'WebComposite and I are parse tree nodes for HTML document. I am a composite node. 

instance variables:
	hTextFlag 		<Boolean> True means I am a text that can be concatenated to other WebComponent for presentation. '!


!WebComposite methodsFor: 'printing'!

printFormatPolicy: aStream 
	aStream nextPutAll: '(FormatPolicy ='.
	formatPolicy isNil ifFalse: [aStream nextPutAll: formatPolicy printString; cr].
	aStream nextPutAll: type printString.
	aStream nextPutAll: ')'! !

!WebComposite methodsFor: 'accessing'!

hTextFlag: aBoolean
	hTextFlag := aBoolean! !

!WebComposite methodsFor: 'testing'!

isAnchor
	^self type = #a!

isComposite
	^true!

isDestAnchor
	^false!

isHText
	^hTextFlag! !

!WebComposite methodsFor: 'enumerating'!

preorderDo: aBlock 
	aBlock value: self.
	content do: [:each | each preorderDo: aBlock]! !

HyperComponent subclass: #HyperLink
	instanceVariableNames: 'protocol '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Hypertext-Storage Layer'!
HyperLink comment:
'I am an abstract class different types of links in hypertext applications. WWW application use UrlLink. Other hypertext applications may use different types of link to link differnet hypertext documents. I have a default protocol which is used to access the destination HyperComponent. 

Instance Variables:
	protocol		<Protocol>
'!


!HyperLink methodsFor: 'private'!

getProtocol
	^self subclassResponsibility! !

!HyperLink methodsFor: 'accessing'!

getStream
	"Executes the default protocol of this link and return a stream."

	^self getStreamBy: self getProtocol!

getStreamBy: aProtocol
	"Executes the default protocol of this link and put the result into aStream."

	^aProtocol executes!

linkRelativeBy: aString 
	"Return a new instance of HypertextLink relative to the receiver by aString."

	^self subclassResponsibility!

protocol
	protocol isNil ifTrue: [protocol := self defaultProtocol].
	^protocol!

protocolType
	"Return a symbol of the type of protocol which is used by an AccessManager to determine a protocol to use if it wants to substitute the one in the link by another protocol."

	^self subclassResponsibility!

request
	^self subclassResponsibility! !

!HyperLink methodsFor: 'comparing'!

= aHypertextLink
	^self subclassResponsibility! !

Object subclass: #RenderPolicy
	instanceVariableNames: 'maxWidth leftOffset maxWidthFlag component infoString renderer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
RenderPolicy comment:
'I am responsibile for how  a hypertextComponent looks like on the screen. I assume
that I will have certain types of object as my component. In other words, different
kinds of component may have different format managers. For example, FMTag is
used to format HTTag ,and FMList is used to format HTList. 

	BTW, actually I am just a strategy but not qualified to be a manager!!



Instance Variables:
	maxWidth 			<Integer>	The maximum width for displaying a hypertextComponent.
	leftOffset 			<Integer>     indent width.
	maxWidthFlag 		<Integer>	Should I display the hypertextComponent with width = maxWidth?
	component 			<HypertextComponent> that I am going to format.
	infoString 			<InfoString>	misc. information that links the a hypertextComponent with its visual appearance.
	presentationMgr		<PresentationManager> '!


!RenderPolicy methodsFor: 'testing'!

isAllText
	^false!

isHText
	"Return true if all the visual representations of the component are htext. All textual components that can be displayed in the same paragraph. "
	^component isHText!

isText
	^false! !

!RenderPolicy methodsFor: 'accessing'!

component
	^component!

component: aHypertextComponent
	component := aHypertextComponent!

componentString
	^self subclassResponsibility!

embeddedFileLocation
	"The receiver's component may point to an embedded file, such as SRC in HTImage. Return the value of the location of this embedded file."

	^nil!

filename: aFilename
	"The receiver may need a tmpFile to save big data. "!

flatten: aBoolean!

formatInto: aContainer
	"Format component and put its visual representations (visualComponent) into aContainer. Return the last visualComponent put by me into aContainer."

	^nil!

formatsTo: aContainer
	^self formatInto: aContainer!

ignoreCR: aBoolean!

leftOffset: anInteger
	leftOffset := anInteger!

makeTaggedString
	"Return a text where different characters are tagged by the HypertextComponents they represent."

	^self subclassResponsibility!

maxWidth: anInteger
	maxWidth := anInteger!

maxWidthFlag
	^maxWidthFlag!

maxWidthFlag: aBoolean
	maxWidthFlag := aBoolean!

presentationManager
	^renderer!

presentationMgr: aPresentationManager 
	renderer := aPresentationManager!

visibleComponents
	^OrderedCollection new!

visualComponent: aVisualComponent!

visualLink
	^infoString! !

!RenderPolicy methodsFor: 'private'!

allFormatManagersFor: aHTObject 
	"Return all the format managers from aHTObject and its descendants."

	| fmCollection |
	fmCollection := OrderedCollection new.
	aHTObject preorderDo: [:each | fmCollection add: each formatPolicy].
	^fmCollection!

defaultCompositeLink
	^CompositeLink new!

defaultTextLink
	^StructuredTextLink new!

defaultVisualLink
	^VisualLink new!

getEmptyBlockWithHeight: height width: width 
	| ctext vLink |
	ctext := ComposedText
				withText: ' ' asText
				style: nil
				compositionWidth: width.
	ctext compositionWidth: width; setHeight: height.
	vLink := self makeVisualLink: nil visualComponent: ctext.
	^self wrapperClass on: vLink!

leftOffset
	^leftOffset!

makeCompositeLink: anObject visualComponent: aVisualComponent 
	^(self defaultCompositeLink) structuralComponent: anObject; visualComponent: aVisualComponent!

makeVisualLink: anObject visualComponent: aVisualComponent 
	^(self defaultVisualLink) structuralComponent: anObject; visualComponent: aVisualComponent!

maxWidth
	^maxWidth! !

!RenderPolicy methodsFor: 'private-wrappers'!

defaultCompositePart
	^(RecursiveComposite new) spaceBetweenItems: 0; leftSpace: 0!

wrapperClass
	^BoundedWrapper! !

RenderPolicy subclass: #CompositePolicy
	instanceVariableNames: 'flattenFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
CompositePolicy comment:
'I am used to format HTComposite usually.


instance variables:
	flattenFlag 	<Boolean>   true -> format each child individually.
							false -> format all the children together.'!


!CompositePolicy methodsFor: 'private'!

composeTaggedString: anInfoString into: aContainer width: anInteger 
	| style cText vLink vComp |
	self putInfoTo: anInfoString.
	style := renderer styleFor: component type.
	cText := ComposedText
				withText: anInfoString
				style: style
				compositionWidth: anInteger.
	vLink := (self defaultTextLink) structuralComponent: component; visualComponent: cText; infoString: anInfoString.
	vComp := self wrapperClass on: vLink.
	aContainer addWrapper: vComp.
	^vComp!

composeText: aText style: aTextStyle into: aContainer	
	"Make a composedText and put it into aContainer. Return the composedText."

	| cText vLink|

	cText := ComposedText
			withText: aText
			style: aTextStyle
			compositionWidth: maxWidth.
	vLink := self defaultVisualLink structuralComponent: component; visualComponent: cText.
	aContainer addWrapper: (self wrapperClass on: vLink).
	^vLink!

defaultTaggedString
	^StructuredText!

defaultVisualLink
	^StructuredTextLink new!

flatten
	^flattenFlag!

formatCollection: aCollection into: aContainer width: anInteger 
	"Format each element in a collection of HypertextComponents."

	| iString textWidth vComp |
	iString := self defaultTaggedString new.
	textWidth := anInteger.
	aCollection
		do: 
			[:each | 
			| fm |
			fm := each formatPolicy.
			(fm isHText and: [fm isText])
				ifTrue: [iString := iString , fm makeTaggedString]
				ifFalse: 
					[iString size > 0 ifTrue: [self
							composeTaggedString: iString
							into: aContainer
							width: textWidth].
					textWidth := anInteger.
					fm maxWidth: textWidth; maxWidthFlag: false.
					vComp := fm formatInto: aContainer.
					vComp notNil
						ifTrue: 
							[textWidth := textWidth - vComp preferredBounds width.
							textWidth < 1 ifTrue: [textWidth := anInteger]].
					iString := self defaultTaggedString new]].
	iString size > 0 ifTrue: [vComp := self
					composeTaggedString: iString
					into: aContainer
					width: textWidth].
	^vComp!

putInfoTo: anInfoString 
	| emphasis |
	emphasis := renderer emphasisFor: component.
	anInfoString
		addEmphasis: (OrderedCollection with: emphasis)
		removeEmphasis: #()
		allowDuplicates: true.
	anInfoString
		addStructure: (OrderedCollection with: component)
		removeStructure: #()
		allowDuplicates: true! !

!CompositePolicy methodsFor: 'accessing'!

componentString
	"Return the string representation of the elements in the content of my component."

	| writeStream |
	self isAllText ifFalse: [^self error: 'FMComposite has non-textual components.'].
	writeStream := (String new: 100) writeStream.
	component content
		do: 
			[:each | 
			| tmpStr |
			tmpStr := each formatPolicy componentString.
			tmpStr notNil ifTrue: [writeStream nextPutAll: tmpStr]].
	^writeStream contents!

flatten: aBoolean
	flattenFlag := aBoolean!

formatInto: aContainer 
	| vComp |
	self flatten
		ifTrue: 
			[self
				eachComponentFormatPolicyDo: 
					[:fm | 
					fm isText ifTrue: [fm flatten: false].
					vComp := fm formatInto: aContainer].
			^vComp]
		ifFalse: [^self
				formatCollection: component content
				into: aContainer
				width: maxWidth]!

ignoreCR: aBoolean!

makeTaggedString
	"Return a text where different characters are tagged by the 
	HypertextComponents they represent."

	| iString |
"	self isAllText ifFalse: [^self error: 'FMComposite has non-textual components.']."
	iString := self defaultTaggedString new.
	component content
		do: 
			[:each | 
			| tmpInfoStr |
			tmpInfoStr := each formatPolicy makeTaggedString.
			iString := iString , tmpInfoStr].
	self putInfoTo: iString.
	^iString! !

!CompositePolicy methodsFor: 'initialize-release'!

initialize
	self flatten: false! !

!CompositePolicy methodsFor: 'testing'!

isAllText
	"Return true if all the visual representations of the components are text."

	| allText |
	allText := true.
	
	component content do: [:each | each formatPolicy isText ifFalse: [allText := false]].
	^allText!

isText
	"Return true if all the visual representations of the components are text."

	| allText |
	allText := true.
	
	component content do: [:each | each formatPolicy isText ifFalse: [allText := false]].
	^allText! !

!CompositePolicy methodsFor: 'enumerating'!

eachComponentFormatPolicyDo: aBlock 
	component content
		do: 
			[:each | 
			| fm |
			fm := each formatPolicy.
			aBlock value: fm]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

CompositePolicy class
	instanceVariableNames: ''!


!CompositePolicy class methodsFor: 'instance creation'!

new
	^super new initialize! !

RenderPolicy subclass: #ImagePolicy
	instanceVariableNames: 'image filename '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
ImagePolicy comment:
'I can format HTTag with tag = ''IMG''.

Instance Variables:
	filename		<Filename> of the tmp file. 
	image		<Image> to be displayed.'!


!ImagePolicy methodsFor: 'private'!

defaultImage
	^Image parcPlaceLogo!

getImage
	"Currently, only the ParcPlace logo is returned."

	image notNil ifTrue: [^image].
	filename notNil
		ifTrue: 
			[image := renderer visualComponentForFile: filename.
			image isNil
				ifTrue: 
					[image := (ImageReader fromFile: filename) image.
					self changed: #builtVisualComponent with: (OrderedCollection with: filename with: image)].
			^image].
	^self defaultImage! !

!ImagePolicy methodsFor: 'accessing'!

embeddedFileLocation
	|attr|
	attr := component findAttribute: #src.
	attr notNil ifTrue: [ ^attr value].
	^nil!

filename: aFilename
	filename := aFilename!

formatInto: aContainer 
	| vLink anImage vComponent |
	anImage := self getImage.
	vLink := (self defaultVisualLink) structuralComponent: self component; visualComponent: anImage.
	vComponent := self wrapperClass on: vLink.
	aContainer addWrapper: vComponent.
	^vComponent!

visualComponent: aVisualComponent
	image := aVisualComponent! !

CompositePolicy subclass: #PreFormatPolicy
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
PreFormatPolicy comment:
'I can format HTComposite objects with tag = ''CODE'', ''LISTING'', ''PLAINTEXT'', ''PRE'', ''XMP''. I tend to keep all the crlf in the component.
'!


!PreFormatPolicy methodsFor: 'accessing'!

formatInto: aContainer 
	self eachComponentFormatPolicyDo: [:fm | fm ignoreCR: false].
	^super formatInto: aContainer! !

RenderPolicy subclass: #TagPolicy
	instanceVariableNames: 'hTextFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
TagPolicy comment:
'I format HTTag in general. Currently, I only display a horizontal line for HTTag objects with tag = ''HR''. I do have plans for other tags though... later..'!


!TagPolicy methodsFor: 'accessing'!

formatInto: aContainer 
	| line vLink vComp |
	component type == #hr
		ifTrue: 
			[line := HorizontalLine new width: maxWidth.
			vLink := self makeVisualLink: component visualComponent: line.
			vComp := self wrapperClass on: vLink.
			aContainer addWrapper: vComp.
			^vComp].
	^nil!

hTextFlag: aBoolean
	hTextFlag := aBoolean! !

RenderPolicy subclass: #TextPolicy
	instanceVariableNames: 'ignoreCRFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
TextPolicy comment:
'I format HTText object.

instance variable:
	ignoreCRFlag 	<Boolean>	Remove all the crlf characters in the text when I format. '!


!TextPolicy methodsFor: 'initialize-release'!

initialize
	ignoreCRFlag := false! !

!TextPolicy methodsFor: 'accessing'!

componentString
	^component content!

formatInto: aContainer 
	| cText t vLink vComp |
	t := component text.
	ignoreCRFlag
		ifTrue: 
			[t replaceAll: Character lf with: Character space.
			t replaceAll: Character cr with: Character space].
	cText := ComposedText new
				compositionWidth: maxWidth
				text: t
				style: nil
				fitWidth: true.
	vLink := self makeVisualLink: component visualComponent: cText.
	vComp := self wrapperClass on: vLink.
	aContainer addWrapper: vComp.	
	^vComp!

ignoreCR: aBoolean
	ignoreCRFlag := aBoolean!

makeTaggedString
	|st|
	st := StructuredText fromString: self componentString.
	st ignoreCR: ignoreCRFlag.	
	^st! !

!TextPolicy methodsFor: 'testing'!

isAllText
	^true!

isHText
	^true!

isText
	^true! !

!TextPolicy methodsFor: 'private'!

defaultVisualLink
	^StructuredTextLink new! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TextPolicy class
	instanceVariableNames: ''!


!TextPolicy class methodsFor: 'instance creation'!

new
	^super new initialize! !

RenderPolicy subclass: #ParagraphPolicy
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
ParagraphPolicy comment:
'I can format HTTag with tag = ''P''.

'!


!ParagraphPolicy methodsFor: 'accessing'!

formatInto: aContainer 
	| vComp |
	vComp := self wrapperClass on: (self getEmptyBlockWithHeight: 25 width: self maxWidth).
	aContainer addWrapper: vComp.
	^vComp! !

CompositePolicy subclass: #ListPolicy
	instanceVariableNames: 'indentWidth '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
ListPolicy comment:
'I can format HTComposite object with tag = ''DIR'', ''MENU'', ''OL'', ''UL''.

instance variables:
	indentWidth		<Integer>'!


!ListPolicy methodsFor: 'private'!

defaultFirstIndentWidth
	^30!

defaultVisualLink
	^VisualLink new!

getIndentWithHeight: anInteger 
	^self getEmptyBlockWithHeight: anInteger width: self indentWidth! !

!ListPolicy methodsFor: 'initialize-release'!

initialize
	indentWidth := self defaultFirstIndentWidth! !

!ListPolicy methodsFor: 'accessing'!

formatInto: aContainer 
	| compositePart componentHeight componentWidth  vLink vComp |
	compositePart := self defaultCompositePart.
	componentWidth := self maxWidth - self indentWidth.
	self formatCollection: component content into: compositePart width: componentWidth.
	componentHeight := compositePart bounds height.
	aContainer addWrapper: (self getIndentWithHeight: componentHeight).
	vLink := self makeCompositeLink: component visualComponent: compositePart.
	vComp := (self wrapperClass on: vLink).
	aContainer addWrapper: vComp.
	^vComp!

indentWidth
	^indentWidth!

indentWidth: anInteger 
	indentWidth := anInteger!

presentationManager
	^renderer! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ListPolicy class
	instanceVariableNames: ''!


!ListPolicy class methodsFor: 'instance creation'!

new
	^super new initialize! !

ListPolicy subclass: #DefListPolicy
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering Policies'!
DefListPolicy comment:
'FMDefList objects are used to format HTComposite objects with tag = ''DL''. The instance variable component has the pair term and definition alternately. In other words, the first element in component is the first term, the second element the first definition, the third element the second term...


'!


!DefListPolicy methodsFor: 'accessing'!

formatInto: aContainer 
	"note: term without a definition is allowed..."

	| defWidth vComp |
	defWidth := maxWidth - self defaultSpaceAfterTerm.
	component content
		do: 
			[:child | 
			| termCollection defCollection ddIdx htCompChildren |
			htCompChildren := child content.
			ddIdx := htCompChildren findFirst: [:each | each type = #dd].
			ddIdx > 0
				ifTrue: 
					[termCollection := htCompChildren copyFrom: 1 to: ddIdx - 1.
					defCollection := htCompChildren copyFrom: ddIdx to: htCompChildren size]
				ifFalse: 
					[termCollection := htCompChildren.
					defCollection := OrderedCollection new].
			self
				formatCollection: termCollection
				into: aContainer
				width: maxWidth.
			defCollection isEmpty
				ifFalse: 
					[vComp := self getEmptyBlockWithHeight: 10 width: self defaultSpaceAfterTerm.
					aContainer addWrapper: vComp.
					vComp := self
								formatCollection: defCollection
								into: aContainer
								width: defWidth]].
	^vComp! !

!DefListPolicy methodsFor: 'private'!

defaultSpaceAfterTerm
	^15!

defaultTermWidth
	^150!

defaultVisualLink
	^StructuredTextLink new! !

Object subclass: #StyleSheet
	instanceVariableNames: 'emphasisTable styleTable defaultStyle '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering'!
StyleSheet comment:
'I am  an abstract class for different style sheet which provide text styles and emphasis for given a symbol.'!


!StyleSheet methodsFor: 'accessing'!

at: aSymbol emphasis: anEmphasis
	emphasisTable at: aSymbol put: anEmphasis!

at: aSymbol emphasis: anEmphasis style: aTextStyle
	anEmphasis notNil ifTrue: [ self at: aSymbol emphasis: anEmphasis].
	aTextStyle notNil ifTrue: [self at: aSymbol style: aTextStyle]!

at: aSymbol style: aTextStyle
	^styleTable at: aSymbol style: aTextStyle!

defaultStyle
	^defaultStyle!

defaultStyle: aSymbol
	defaultStyle := aSymbol!

emphasisFor: aSymbol
	|emphasis|
	emphasis := emphasisTable at: aSymbol ifAbsent: nil.
"	emphasis isNil ifTrue: [emphasis := self class emphasisFor: aSymbol]."
	^emphasis!

styleFor: aSymbol
	|style|
	style := styleTable at: aSymbol ifAbsent: nil.
	"style isNil ifTrue: [style := self class styleFor: aSymbol]."
	style isNil ifTrue: [style := self defaultStyle].
	^TextAttributes styleNamed: style! !

!StyleSheet methodsFor: 'initialize-release'!

initialize
	styleTable := Dictionary new.
	emphasisTable := Dictionary new.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

StyleSheet class
	instanceVariableNames: ''!


!StyleSheet class methodsFor: 'instance creation'!

defaultStyle: aSymbol
	^super new initialize defaultStyle: aSymbol!

new
	^self error: self class printString, ' is created by #defaultStyle:'! !

Object subclass: #HyperRenderer
	instanceVariableNames: 'model view styleMgr pageFullFlag buffer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering'!
HyperRenderer comment:
'HyperRenderer presents the content of HyperComponent to the user.  HyperRenderer accepts, as input, a stream of HyperComponents, such as a stream of WebComponents generated by parsing a html document. Then, it assigns a RenderPolicy to each of these components. For example, in the parse tree a HTML document, the WebComponent that represents the end paragraph tag P was assigned a ParagraphPolicy. The RenderPolicy is a Strategyobject which  constructs the visual representations of the HyperComponent in terms of VisualLinks. The resuling VisualLink is wrapped by BoundedWrapper and were then put  into HyperView. 

Instance Variables:
	model 				<HyperApp>
	view 				<HyperView>
	styleMgr 			<StyleSheet>
	pageFullFlag 		<Boolean>
	buffer 				<OrderedCollection>'!


!HyperRenderer methodsFor: 'format policies'!

emphasisFor: aHypertextComponent 
	| type href |
	aHypertextComponent isAnchor
		ifTrue: 
			[href := aHypertextComponent findAttribute: #href.
			href isNil ifTrue: [^nil]].
	type := aHypertextComponent type.
	^styleMgr emphasisFor: type!

styleFor: aSymbol
	^styleMgr styleFor: aSymbol! !

!HyperRenderer methodsFor: 'private'!

defaultCompositeComponent
	| c |
	"c := WebComposite new label: #htext."
	c := WebComposite new type: #text.
	self initFormatPolicy: CompositePolicy new for: c.
	^c!

defaultParser
	^HtmlParser new!

defaultPolicySymbol
	^#CompositePolicy!

defaultStyleManager
	^model class defaultStyleSheet!

flush
	self formatComponentsInBuffer.
	view flush!

formatComponent: aHypertextComponent 
	| fm oFlag newFlag |
	fm := aHypertextComponent formatPolicy.
	fm flatten: false.
	oFlag := pageFullFlag.
	fm formatInto: view.
	oFlag ifTrue: [^self].
	newFlag := self checkFirstPageFull.
	(newFlag and: [(oFlag = newFlag) not])
		ifTrue: [view invalidateRectangle: view bounds repairNow: true]!

formatComponentsInBuffer
	| c |
	buffer isEmpty ifTrue: [^self].
	c := self defaultCompositeComponent.
	buffer do: [:each | c add: each].
	self formatComponent: c.
	self initBuffer!

formatManagerMap
	^self class formatManagerMap!

getEmbeddedNode: fm 
	| loc link vc |
	loc := fm embeddedFileLocation.
	loc isNil ifTrue: [^self].
	(UrlLink isUrlString: loc)
		ifTrue: [link := UrlLink urlString: loc]
		ifFalse: [link := model currentLink linkRelativeBy: loc].
	vc := model cacheVisualComponentFor: link.
	vc isNil
		ifTrue: [fm filename: (model retrieve: link)]
		ifFalse: [fm visualComponent: vc]!

initFormatPolicy: aFormatPolicy for: aHypertextComponent 
	aHypertextComponent formatPolicy: aFormatPolicy.
	aFormatPolicy maxWidthFlag: true; presentationMgr: self; maxWidth: view bounds width!

newComponent: aHypertextComponent 
	"Check if this HypertextComponent is a HText, i.e. text that is displayed in the 
	same paragraph with other HypertextComponents. If it is a HText, save the 
	components in a buffer first. If not, format all the components in the buffer in 
	the same paragraph, and then format aHypertextComponent."

	| fm |
	self initFormatPolicy: aHypertextComponent.
	(self isComponentVisible: aHypertextComponent)
		ifTrue: 
			[fm := aHypertextComponent formatPolicy.
			fm isHText
				ifTrue: [buffer add: aHypertextComponent]
				ifFalse: 
					[self formatComponentsInBuffer.
					self formatComponent: aHypertextComponent]]! !

!HyperRenderer methodsFor: 'updating'!

update: aSymbol with: anObject 
	aSymbol == #add ifTrue: [^self newComponent: anObject].
	aSymbol == #end ifTrue: [^self flush].
	aSymbol == #start ifTrue: [^self initialize].
	aSymbol == #builtVisualComponent ifTrue: [^self changed: #builtVisualComponent with: anObject]! !

!HyperRenderer methodsFor: 'testing'!

checkFirstPageFull
	| winBottom |
	pageFullFlag ifTrue: [^pageFullFlag].
	view components isEmpty ifTrue: [^false].
	winBottom := view bounds bottom.
	pageFullFlag := view components last bounds bottom > winBottom.
	^pageFullFlag!

isComponentVisible: aHTComponent 
	| type |
	type := aHTComponent type.
	^(type = #head or: [type = #title]) not!

optimize
	^true! !

!HyperRenderer methodsFor: 'accessing'!

command
	^model command!

inputStream: aStream 
	aStream addDependent: self!

model: aModel
	model := aModel!

open
	| window |
	window := ApplicationWindow
				model: self
				label: 'NetBrowser'
				minimumSize: 400 @ 350.
	view := HyperView new model: self.
	window component: (LookPreferences edgeDecorator on: view).
	window open.
	view bounds: (0 @ 0 extent: window extent).
	self view: view!

optimize: aBoolean!

policyFor: aSymbol 
	"Search the formatManagerMap for a FormatManager for this symbol. If aSymbol is not found in the formatManagerMap, then a defaultFormatManager is given. 
	If the formatManager in a visitor pattern is finished, then this method just return a defaultFormatManager. This saves a lot of time..."

	| class |
	class := self formatManagerMap at: aSymbol ifAbsent: [self defaultPolicySymbol].
	^(Smalltalk at: class) new!

styleSheet: aStyleSheet
	styleMgr := aStyleSheet!

view
	^view!

view: aView 
	view := aView!

visualComponentForFile: aFilename
	^model visualComponentForFile: aFilename! !

!HyperRenderer methodsFor: 'initialize-release'!

initBuffer
	buffer := OrderedCollection new!

initFormatPolicy: aHypertextComponent 
	"Initialize FormatManagers for aHypertextComponent and its descendants."

	aHypertextComponent
		preorderDo: 
			[:each | 
			| fm |
			fm := self policyFor: each type.
			fm addDependent: self.
			each formatPolicy: fm.
			self getEmbeddedNode: fm.
			fm maxWidthFlag: true; presentationMgr: self; maxWidth: view bounds width]!

initForRedraw
	pageFullFlag := false.
	view notNil ifTrue: [view initialize].!

initialize
	self initForRedraw.
	self initStyleManager.
	pageFullFlag := false.
	self initBuffer.!

initStyleManager
	styleMgr isNil ifTrue: [ styleMgr := self defaultStyleManager]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HyperRenderer class
	instanceVariableNames: 'FormatManagerMap '!


!HyperRenderer class methodsFor: 'accessing'!

formatManagerMap
	^FormatManagerMap! !

!HyperRenderer class methodsFor: 'class initialization'!

initialize
	"self initialize"
	FormatManagerMap := Dictionary new.
	(#(#(#base #RenderPolicy ) 
	#(#br #TagPolicy ) 
	#(#code #PreFormatPolicy ) 
	#(#comment #RenderPolicy ) 
	#(#dir #ListPolicy ) 
	#(#dl #DefListPolicy ) 
	#(#head #RenderPolicy ) 
	#(#hr #TagPolicy ) 
	#(#img #ImagePolicy ) 
	#(#input #RenderPolicy)
	#(#isindex #RenderPolicy ) 
	#(#listing #PreFormatPolicy ) 
	#(#menu #ListPolicy ) 
	#(#nextid #RenderPolicy ) 
	#(#ol #ListPolicy ) 
	#(#option #RenderPolicy ) 
	#(#p #ParagraphPolicy ) 
	#(#plaintext #PreFormatPolicy ) 
	#(#pre #PreFormatPolicy ) 
	#(#text #TextPolicy ) 
	#(#ul #ListPolicy ) 
	#(#xmp #PreFormatPolicy ) )) do: [:each | FormatManagerMap at: (each at: 1)
			put: (each at: 2)]! !

!HyperRenderer class methodsFor: 'instance-creation'!

model: aHyperApp styleSheet: aStyleSheet
	^super new styleSheet: aStyleSheet; model: aHyperApp; initialize!

new
	^super new initialize! !

Wrapper subclass: #VisualLink
	instanceVariableNames: 'structuralComponent '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering'!
VisualLink comment:
'I consist of two components -- the structural component and the visual component. The visual component is responsible for the visual appearance of a VisualLink. The Structural component contains information about a VisualLink. This information can be nil or anything such as a node in the parse tree or a String.'!


!VisualLink methodsFor: 'hit detection'!

hitDetect: t1 
	"	***This is decompiled code.*** 
	This may reflect a problem with the configuration of your image 
	and its sources and changes files. 
	Please refer to the documentation and the settings tool for help in 
	setting up the proper source code files."

	| t2 |
	(t2 := visualComponent hitDetect: t1) notNil ifTrue: [^self].
	^nil! !

!VisualLink methodsFor: 'accessing'!

allStructuralComponents
	^OrderedCollection with: self structuralComponent!

allStructuralComponentsAt: aPoint
	"Return the structural component at that point. "

	^self allStructuralComponents!

charAt: aPoint
	^Character space!

componentAt: aPoint
	"Return the structural component at that point. "

	^nil!

getVisualLinkFor: aVisualComponent at: aPoint!

infoString: anInfoString!

size
	^self subclassResponsibility!

structuralComponent
	^structuralComponent!

structuralComponent: anObject
	structuralComponent := anObject!

structuralComponentAt: aPoint
	"Return the structural component at that point. "

	^self structuralComponent!

textAt: aPoint
	^Text new!

visualComponent
	^self component!

visualComponent: aVisualComponent
	self component: aVisualComponent!

wordAt: aPoint
	^String new! !

!VisualLink methodsFor: 'private'!

infoString
	^nil! !

VisualLink subclass: #StructuredTextLink
	instanceVariableNames: 'sText '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering'!
StructuredTextLink comment:
'I am  a subclass of VisualLink where the structuralComponent is a StructuredText and the visualComponent is aComposedText.

Instance Variables:
	sText	<StructuredText>
'!


!StructuredTextLink methodsFor: 'private'!

infoString
	^sText! !

!StructuredTextLink methodsFor: 'accessing'!

allStructuralComponentsAt: aPoint 
	| idx |
	self infoString notNil
		ifTrue: 
			[idx := (component characterBlockAtPoint: aPoint) stringIndex.
			^sText structuresAt: idx]
		ifFalse: [^self allStructuralComponents]!

charAt: aPoint
	
	^(component characterBlockAtPoint: aPoint) character!

componentAt: aPoint
	"Return the structural component at that point. "

	^nil!

infoString: anInfoString 
	sText := anInfoString!

structuralComponentAt: aPoint 
	^(self allStructuralComponentsAt: aPoint) first!

textAt: aPoint
	^component text!

wordAt: aPoint
	^(component characterBlockAtPoint: aPoint) printString! !

VisualLink subclass: #CompositeLink
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Rendering'!
CompositeLink comment:
'My structuralComponent is a WebComposite. I expect a wrapper in my visualComponent.'!


!CompositeLink methodsFor: 'accessing'!

allStructuralComponentsAt: aPoint
	^OrderedCollection with: (self structuralComponentAt: aPoint)!

charAt: aPoint
	|wrapper |
	wrapper := visualComponent  hitDetect: aPoint.
	wrapper notNil ifTrue: [|localPoint|
		localPoint := aPoint translatedBy: wrapper translation negated.
		^(wrapper component) charAt: localPoint].
	^super charAt: aPoint!

structuralComponentAt: aPoint
	|wrapper |
	wrapper := component  hitDetect: aPoint.
	wrapper notNil ifTrue: [|localPoint|
		localPoint := aPoint translatedBy: wrapper translation negated.
		^(wrapper component) structuralComponentAt: localPoint].
	^super structuralComponentAt: aPoint!

textAt: aPoint
	|wrapper |
	wrapper := visualComponent  hitDetect: aPoint.
	wrapper notNil ifTrue: [|localPoint|
		localPoint := aPoint translatedBy: wrapper translation negated.
		^(wrapper component) textAt: localPoint].
	^super textAt: aPoint! !
HyperRenderer initialize!


Object subclass: #Command
	instanceVariableNames: 'model '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Commands'!


!Command methodsFor: 'accessing'!

at: aPoint!

execute
	^self subclassResponsibility!

model: aModel
	model := aModel!

view: aView! !

Command subclass: #CmdClick
	instanceVariableNames: 'view point '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Commands'!


!CmdClick methodsFor: 'accessing'!

at: aPoint
	point := aPoint!

execute
	| state |
	state := WebGUIAction new.
	state visualComponent: view; point: point; actionType: #click.
	model retrieveLink: state!

view: aView
	view := aView! !

Object subclass: #Request
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Protocols'!
Request comment:
'I have  all the information needed by a Protocol. Subclass describes the exact details.'!


!Request methodsFor: 'accessing'!

protocol
	"	***This is decompiled code.*** 
	This may reflect a problem with the configuration of your image 
	and its sources and changes files. 
	Please refer to the documentation and the settings tool for help in 
	setting up the proper source code files."

	^self subclassResponsibility! !

Request subclass: #UnixFileRequest
	instanceVariableNames: 'path '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Protocols'!
UnixFileRequest comment:
'Without me, FileProtocol cannot execute.

Instance Variables:
	path	<String>
'!


!UnixFileRequest methodsFor: 'accessing'!

path
	^path!

path: aString
	path := aString.
	path first = $/ ifFalse: [path := '/', path]!

protocol

	^'file'! !

Object subclass: #Protocol
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Protocols'!
Protocol comment:
'I am an abstract super class for protocols that can access hypertext components. My subclass needs a Request to get the parameters for access.'!


!Protocol methodsFor: 'accessing'!

executes
	"execute this protocol and return a stream as a result."

	^self subclassResponsibility!

executes: aRequest
	"execute this protocol and return a stream as a result."

	^self subclassResponsibility! !

Protocol subclass: #FileProtocol
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Protocols'!
FileProtocol comment:
'I can access local files. 

'!


!FileProtocol methodsFor: 'accessing'!

executes
	"execute this protocol and return a stream as a result."

	^self shouldNotImplement!

executes: aRequest
	^aRequest path asFilename readStream! !

Protocol subclass: #HttpProtocol
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Protocols'!
HttpProtocol comment:
'I can access Web server. 
'!


!HttpProtocol methodsFor: 'private'!

makeRequestFrom: method port: portNumber path: path search: searchStr
	^method , ' ' , path , searchStr , ' HTTP/1.0' , Character cr asString , Character lf asString! !

!HttpProtocol methodsFor: 'accessing'!

executes
	"execute this protocol and return a stream as a result."

	^self shouldNotImplement!

executes: aHTTPRequest 
	"Send a request to an http server and return the reply as a stream."

	| host port path socket connection outStream inStream request search |
	host := aHTTPRequest host.
	port := aHTTPRequest port.
	path := aHTTPRequest path.
	search := aHTTPRequest search.
	socket := SocketAccessor newTCPclientToHost: host port: port.
	connection := ExternalConnection new.
	connection input: socket; output: socket.	
	outStream := connection writeStream.
	request := self
				makeRequestFrom: 'GET'
				port: port
				path: path
				search: search.
	outStream nextPutAll: request; commit.
	inStream := connection readStream binary.
	^inStream! !

Request subclass: #HttpRequest
	instanceVariableNames: 'host path port search '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Protocols'!
HttpRequest comment:
'HttpProtocol definitely needs my knowledge!!

Instance Variables:
	host	<String> like st.cs.uiuc.edu
	path	<String>
	port		<String|Integer>
	search	<String> like ?+hello in the Url. 
	'!


!HttpRequest methodsFor: 'private'!

defaultPortNumber
	"	***This is decompiled code.*** 
	This may reflect a problem with the configuration of your image 
	and its sources and changes files. 
	Please refer to the documentation and the settings tool for help in 
	setting up the proper source code files."

	^80! !

!HttpRequest methodsFor: 'accessing'!

host
	^host!

host: aString
	host := aString!

path
	"	***This is decompiled code.*** 
	This may reflect a problem with the configuration of your image 
	and its sources and changes files. 
	Please refer to the documentation and the settings tool for help in 
	setting up the proper source code files."

	^path!

path: aString
	path := aString!

port
	"	***This is decompiled code.*** 
	This may reflect a problem with the configuration of your image 
	and its sources and changes files. 
	Please refer to the documentation and the settings tool for help in 
	setting up the proper source code files."

	^port!

port: aStringOrInteger
	port := aStringOrInteger asNumber!

protocol
	^'http'!

search
	search isNil ifTrue: [^'']
				ifFalse: [^search]!

search: aString
	search := aString! !

Object subclass: #Url
	instanceVariableNames: 'index '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-URL'!
Url comment:
'I am an abstract super class for URLs. 


instance Variables:
	index	<String> of the form #index.
'!


!Url methodsFor: 'accessing'!

host
	^nil!

host: aString!

index
	^index!

index: aString
	index := aString!

path
	^nil!

path: aString!

port
	^nil!

port: aString!

scheme
	"Return the scheme of a url in Symbol."

	^self subclassResponsibility!

search
	^nil!

search: aString!

urlRelativeBy: aPathString 
	"Return a new copy of the receiver and modify the path of that copy relative by 
	aPathString."

	| url |
	url := self completeUrlString: aPathString.
	^UrlBuilder new url: url! !

!Url methodsFor: 'private'!

completeRelativePath: aPathString to: newUrl 
	"Generate a new path relative to the receiver's path by aPathString. Put this 
	new path into newUrl."

	| tmpPath totalDirUp startIdx dotDotIdx |
	aPathString first = $/
		ifTrue: [tmpPath := aPathString]
		ifFalse: 
			[tmpPath := self path.
			totalDirUp := self computeTotalDirUp: aPathString.
			tmpPath := self move: tmpPath upDirLevel: totalDirUp.
			tmpPath isEmpty ifFalse: [tmpPath last = $/ ifFalse: [tmpPath := tmpPath , '/']].
			dotDotIdx := self lastDotDotIdx: aPathString.
			dotDotIdx = 0
				ifTrue: [startIdx := 1]
				ifFalse: [startIdx := dotDotIdx + 2].
			tmpPath := tmpPath , (aPathString copyFrom: startIdx to: aPathString size).
			tmpPath first = $/ ifFalse: [tmpPath := '/' , tmpPath]].
	newUrl path: tmpPath!

completeUrlString: aPathString 
	"Generate a new url string relative to the receiver."

	| tmpPath totalDirUp startIdx dotDotIdx |
	aPathString first = $/
		ifTrue: [tmpPath := aPathString]
		ifFalse: 
			[tmpPath := self path.
			totalDirUp := self computeTotalDirUp: aPathString.
			tmpPath := self move: tmpPath upDirLevel: totalDirUp.
			tmpPath isEmpty ifFalse: [tmpPath last = $/ ifFalse: [tmpPath := '/']].
			dotDotIdx := self lastDotDotIdx: aPathString.
			dotDotIdx = 0
				ifTrue: [startIdx := 1]
				ifFalse: [startIdx := dotDotIdx + 2].
			tmpPath := tmpPath , (aPathString copyFrom: startIdx to: aPathString size).
			tmpPath first = $/ ifFalse: [tmpPath := '/' , tmpPath]].
	^self printWithPath: tmpPath!

computeTotalDirUp: aPathString 
	"Return the total number of .. in aPathString."

	| total |
	total := 0.
	aPathString keysAndValuesDo: [:idx :elt | idx > 1 ifTrue: [(elt = $. and: [(aPathString at: idx - 1)
					= $.])
				ifTrue: [total := total + 1]]].
	^total!

lastDotDotIdx: aPathString 
	"Return the start index of the last occurence of .. in aPathString."

	| lastDotDotIdx |
	lastDotDotIdx := 0.
	aPathString keysAndValuesDo: [:idx :elt | idx > 1 ifTrue: [(elt = $. and: [(aPathString at: idx - 1)
					= $.])
				ifTrue: [lastDotDotIdx := idx]]].
	^lastDotDotIdx!

move: aPathString upDirLevel: anInteger 
	| slashIndexes  endIdx tmpStr slashIdx |
	tmpStr := aPathString.
	slashIdx := aPathString findLast: [:each | each = $/].
	slashIdx > 0 ifTrue: [tmpStr := tmpStr copyFrom: 1 to: slashIdx].
	anInteger < 1 ifTrue: [^tmpStr].
	slashIndexes := OrderedCollection new.
	tmpStr keysAndValuesDo: [:idx :elt | elt = $/ ifTrue: [slashIndexes add: idx]].
	endIdx := slashIndexes at:  (slashIndexes size - anInteger).
	^tmpStr copyFrom: 1 to: endIdx! !

!Url methodsFor: 'printing'!

printContentOn: aStream
	"Print the content of a url after 'scheme://'. "

	^self subclassResponsibility!

printOn: aStream
	aStream nextPutAll: self scheme, ':/'.
	self printContentOn: aStream! !

!Url methodsFor: 'comparing'!

= aUrl
	^(self printString) = aUrl printString!

hash
	^self printString hash! !

Url subclass: #UrlHttp
	instanceVariableNames: 'host path port search '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-URL'!


!UrlHttp methodsFor: 'accessing'!

host
	^host!

host: aString
	host := aString!

path
	path isNil ifTrue: [path := ''].
	^path!

path: aString
	path := aString!

port
	^port!

port: aString
	port := aString!

scheme
	^#http!

search
	search isNil ifTrue: [search := ''].
	^search!

search: aString
	search := aString! !

!UrlHttp methodsFor: 'printing'!

printContentOn: aStream 
	aStream nextPutAll: '/' , host.
	port notNil ifTrue: [aStream nextPutAll: ':' , port].
	self path isEmpty
		ifFalse: 
			[path first = $/ ifFalse: [aStream nextPutAll: '/'].
			aStream nextPutAll: self path].
	search notNil ifTrue: [aStream nextPutAll: self search]!

printWithPath: aPathString 
	| output |
	output := 'http://' , host.
	port notNil ifTrue: [output := output , ':' , port].
	path notNil ifTrue: [output := output , aPathString].
	search notNil ifTrue: [output := output , search].
	^output! !

Object subclass: #UrlBuilder
	instanceVariableNames: 'scanner '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-URL'!
UrlBuilder comment:
'I am a url parser. 
'!


!UrlBuilder methodsFor: 'accessing'!

url: aUrlString 
	"Create a Url corresponds to the scheme in aUrlString."

	| tokens idx url stringWithoutPound poundIdx poundStr |
	tokens := scanner scanTokens: aUrlString.
	poundIdx := aUrlString indexOf: $# ifAbsent: 0.
	poundIdx = 0
		ifTrue: 
			[stringWithoutPound := aUrlString.
			poundStr := '']
		ifFalse: 
			[self halt.
			stringWithoutPound := aUrlString copyFrom: 1 to: poundIdx - 1.
			poundStr := aUrlString copyFrom: poundIdx to: aUrlString size].
	idx := stringWithoutPound findString: ':' startingAt: 1.
	url := self perform: (tokens at: 1)
				with: (stringWithoutPound copyFrom: idx + 3 to: stringWithoutPound size).
	url index: poundStr.
	^url! !

!UrlBuilder methodsFor: 'scheme dependent'!

file: aString
	|aUrl|
	aUrl := UrlFile new.
	self fillPathFor: aUrl from: aString.
	^aUrl!

http: aNoSchemeUrlStr 
	| startIdx idx hostportStr pathStr searchStr length aUrl |
	length := aNoSchemeUrlStr size.
	aUrl := UrlHttp new.
	idx := aNoSchemeUrlStr findString: '/' startingAt: 1.
	idx = 0
		ifTrue: [hostportStr := aNoSchemeUrlStr copyFrom: 1 to: length.
				startIdx := length + 1]
		ifFalse: [hostportStr := aNoSchemeUrlStr copyFrom: 1 to: idx - 1.
				startIdx := idx + 1].
	idx := aNoSchemeUrlStr findString: '?' startingAt: startIdx.
	idx > 0
		ifTrue: 
			[pathStr := aNoSchemeUrlStr copyFrom: startIdx to: idx - 1.
			searchStr := aNoSchemeUrlStr copyFrom: idx to: length]
		ifFalse: [pathStr := aNoSchemeUrlStr copyFrom: startIdx to: length].
	self fillHostPortFor: aUrl from: hostportStr.
	self fillPathFor: aUrl from: pathStr.
	self fillSearchFor: aUrl from: searchStr.
	^aUrl! !

!UrlBuilder methodsFor: 'initialize-release'!

initialize
	scanner := Scanner new! !

!UrlBuilder methodsFor: 'private'!

fillHostPortFor: aUrl from: aString
	(aString isNil or: [ aString isEmpty])
		ifFalse: [ |idx|
			idx := aString findString: ':' startingAt: 1.
			idx = 0 ifTrue: [ aUrl host: aString]
				ifFalse: [ aUrl host: (aString copyFrom: 1 to: (idx - 1)).
						aUrl port: (aString copyFrom: (idx + 1) to: aString size)]]!

fillPathFor: aUrl from: aString 
	(aString isNil or: [aString isEmpty])
		ifFalse: [aUrl path: aString]!

fillSearchFor: aUrl from: aString 
	(aString isNil or: [aString isEmpty])
		ifFalse: [aUrl search: aString]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

UrlBuilder class
	instanceVariableNames: ''!


!UrlBuilder class methodsFor: 'instance creation'!

new
	^super new initialize! !

Url subclass: #UrlFile
	instanceVariableNames: 'path '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-URL'!


!UrlFile methodsFor: 'accessing'!

path
	path isNil ifTrue: [path := ''].
	^path!

path: aString
	path := aString!

scheme
	^#file! !

!UrlFile methodsFor: 'printing'!

printContentOn: aStream
	path notNil ifTrue: [ aStream nextPutAll:  path ]!

printWithPath: aPathString 
	^'file:/' , aPathString , self index! !

HyperLink subclass: #UrlLink
	instanceVariableNames: 'url request '
	classVariableNames: 'UrlParser '
	poolDictionaries: ''
	category: 'HyperTalk-Link Resolving Components'!


!UrlLink methodsFor: 'comparing'!

= aUrlLink
	^url = (aUrlLink url)!

hash
	^url hash! !

!UrlLink methodsFor: 'accessing'!

getStreamBy: aProtocol
	"Executes the default protocol of this link and put the result into aStream."

	^aProtocol executes: request!

linkRelativeBy: aRelativeUrlString 
	"Return a new link with aUrlStringOrFilenameString relative to me."

	|  newLink  |
	newLink := self copy.
	newLink url: (url urlRelativeBy: aRelativeUrlString).
	^newLink!

protocolType
	^url scheme!

request
	^request!

url
	^url!

url: aUrl 
	url := aUrl.
	self makeRequestFor: url scheme from: aUrl! !

!UrlLink methodsFor: 'printing'!

printOn: aStream
	aStream nextPutAll: url printString! !

!UrlLink methodsFor: 'private'!

defaultPortFor: aSymbol
	aSymbol == #http ifTrue: [^'80'].!

defaultProtocolFor: aSymbol
	aSymbol == #http ifTrue: [^HttpProtocol new].
	aSymbol == #file ifTrue: [^FileProtocol new].
	^nil!

getProtocol
	^self defaultProtocolFor: url scheme!

isUrl: aString
	| idx |
	idx := aString findString: ':' startingAt: 1.
	^(idx = 0) not!

makeFileRequestFrom: aUrl
	request := UnixFileRequest new.
	request path: aUrl path.
	^request!

makeHttpRequestFrom: aHttpUrl 
	| port path |
	request := HttpRequest new.
	port := aHttpUrl port.
	port isNil ifTrue: [port := self defaultPortFor: #http].
	path := aHttpUrl path.
	(path isNil or: [path isEmpty])
		ifTrue: [path := '/']
		ifFalse: [path first = $/ ifFalse: [path := '/' , path]].
	request host: aHttpUrl host; port: port; path: path; search: aHttpUrl search.
	^request!

makeRequestFor: aSymbol from: aUrl
	aSymbol == #http ifTrue: [^self makeHttpRequestFrom: aUrl].
	aSymbol == #file ifTrue: [^self makeFileRequestFrom: aUrl].
	^nil! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

UrlLink class
	instanceVariableNames: ''!


!UrlLink class methodsFor: 'instance creation'!

urlString: aString 
	| link url |
	url := UrlParser url: aString.
	link := super new url: url.
	link makeRequestFor: url scheme from: url.
	^link! !

!UrlLink class methodsFor: 'class initialization'!

initialize
	"self initialize"

	UrlParser := UrlBuilder new! !

!UrlLink class methodsFor: 'testing'!

isUrlString: aString
	| idx |
	idx := aString findString: ':' startingAt: 1.
	^(idx = 0) not! !

Object subclass: #LinkResolver
	instanceVariableNames: 'aspectSymbol '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Link Resolving Components'!
LinkResolver comment:
'I am  resposible for retrieving a link from a UserActionState. If a link can be retrieved, then I will report it to a HypertextModel. Subclass decides the type of link to generate.

Subclass should implement:
	aspectSymbol
	retrieveLink:

instance variables:
	aspectSymbol	<Symbol> If a link is found, this symbol is broadcast to the subscribers of a HypertextModel. The subscribers use this symbol to determine if the link retrieved is useful for them.  	automaticReport <Boolean> If automaticReoprt is true, everytime a new link is retrieved, the hypertextModel is notified immediately. '!


!LinkResolver methodsFor: 'accessing'!

aspectSymbol
	aspectSymbol isNil ifTrue: [^self defaultAspectSymbol].
	^aspectSymbol!

aspectSymbol: aSymbol
	aspectSymbol := aSymbol!

retrieveLink: aUserActionState for: aHyperApp 
	"First, find the most top wrapper contained in the view at that point. The wrapper contains a VisualLink which is used to retrieve the link. The link can be a HyperLink or any other objects such as a Character."

	| view point wrapper link |
	view := aUserActionState visualComponent.
	point := aUserActionState point.
	wrapper := view hitDetect: point.
	wrapper notNil
		ifTrue: 
			[| visualLink localPoint |
			visualLink := wrapper component.
			localPoint := point translatedBy: wrapper translation negated.
			link := self retrieveLink: visualLink at: localPoint.
			link notNil ifTrue: [aHyperApp reportLink: link aspect: self aspectSymbol]]! !

!LinkResolver methodsFor: 'updating'!

update: anAspectSymbol with: aParameter from: aSender
	anAspectSymbol == #retrieveLink ifTrue: [ self retrieveLink: aParameter for: aSender]! !

!LinkResolver methodsFor: 'private'!

defaultAspectSymbol
	^self subclassResponsibility! !

LinkResolver subclass: #TextResolver
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Link Resolving Components'!
TextResolver comment:
'I can retrieve the whole paragraph  on a HyperView from a Point.'!


!TextResolver methodsFor: 'private'!

defaultAspectSymbol
	^#text!

retrieveLink: aVisualLink at: aPoint
	^aVisualLink textAt: aPoint! !

LinkResolver subclass: #UrlResolver
	instanceVariableNames: 'currentLink '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Link Resolving Components'!
UrlResolver comment:
'I retrieve a UrlLink.


instance variables:
	lastLink		<HypertextLink>	The last link retrieved. Useful when a relative HREF is supplied instead of a URL.'!


!UrlResolver methodsFor: 'private'!

completeUrl: aFilenameString 
	| currentPath idx lastChar targetChar dir request protocol address |
	request := currentLink request.
	currentPath := request path.
	(currentPath findString: '/' startingAt: 1)
		> 0
		ifTrue: [targetChar := $/]
		ifFalse: [targetChar := $\].
	lastChar := currentPath last.
	lastChar = targetChar ifTrue: [currentPath := currentPath copyFrom: 1 to: currentPath size - 1].
	idx := currentPath lastIndexOf: targetChar.
	idx > 0
		ifTrue: 
			[dir := currentPath copyFrom: 1 to: idx.
			dir first = '/' ifFalse: [dir := '/' , dir]]
		ifFalse: [ dir := '/'].
	protocol := request protocol.
	address := request address.
	^protocol , '://' , address , dir , aFilenameString!

defaultAspectSymbol
	^#url!

isUrl: aString
	| idx |
	idx := aString findString: ':' startingAt: 1.
	^(idx = 0) not!

retrieveLink: aVisualLink at: aPoint 
	"The hypertext component at that point is retrieved from aVisualLink. The #href attribute of that component is the key to the link. I can handle relative link such as '../hello.html' or a url such as 'http://st-www.cs.uiuc.edu'."

	| htComponent attribute |
	htComponent := (aVisualLink allStructuralComponentsAt: aPoint) 
						detect: [:each | each isAnchor ] ifNone: nil.
	htComponent isNil ifTrue: [^nil].
	attribute := htComponent findAttribute: #href.
	attribute notNil
		ifTrue: 
			[|dest|
			dest := attribute value.
			(self isUrl: dest)
				ifFalse: [^currentLink linkRelativeBy: dest].
			^UrlLink urlString: dest].
	^nil!

updateLink: aParameter
	currentLink := aParameter! !

!UrlResolver methodsFor: 'updating'!

update: anAspectSymbol with: aParameter from: aSender
	super update: anAspectSymbol with: aParameter from: aSender.
	anAspectSymbol == #currentLink ifTrue: [ self updateLink: aParameter]! !

LinkResolver subclass: #CharResolver
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Link Resolving Components'!
CharResolver comment:
'I can retrieve the character on a HyperView from a point. '!


!CharResolver methodsFor: 'private'!

defaultAspectSymbol
	^#char!

retrieveLink: aVisualLink at: aPoint
	^aVisualLink charAt: aPoint! !
UrlLink initialize!


Stream subclass: #TStream
	instanceVariableNames: 'inputStream outputStream '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!


!TStream methodsFor: 'accessing'!

atEnd
	^inputStream atEnd!

inputStream: anInputStream outputStream: anOutputStream
	inputStream := anInputStream.
	outputStream := anOutputStream!

next
	| t |
	t := inputStream next.
	outputStream nextPut: t.
	^t! !

Object subclass: #ActionEntry
	instanceVariableNames: 'filter viewer subtypeActionMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
ActionEntry comment:
'I am the entry of the dictionary in ActionMap.

Instance Variables:
	type 	<Symbol> of a type.
	filter 	<Symbol> of the class name of a StreamFilter.
	viewer <Symbol> of the class name of a viewer.
	subtypeActionMap <ActionMap> of a subtype.
'!


!ActionEntry methodsFor: 'accessing'!

filter
	^filter!

filter: aSymbol
	filter := aSymbol!

subtypeActionMap
	^subtypeActionMap!

subtypeActionMap: anActionMap
	subtypeActionMap := anActionMap!

viewer
	^viewer!

viewer: aSymbol
	viewer := aSymbol! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ActionEntry class
	instanceVariableNames: ''!


!ActionEntry class methodsFor: 'instance creation'!

filter: aFilterClassSymbol viewer: aViewerClassSymbol subtypeActionMap: anActionMap 
	| entry |
	entry := super new.
	entry filter: aFilterClassSymbol; viewer: aViewerClassSymbol;  subtypeActionMap: anActionMap.
	^entry! !

Object subclass: #Viewer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
Viewer comment:
'Viewer is a simple abstract super class for all external viewers. Basically, it takes a file name and then spawn a new window to display that file. Currently, the only abstract subclass is ImageViewer which delegates to an ImageReader to view different image files such as gif and bitmap files.  <P>

Viewer can also acts as an adaptor for other external viewers. A concrete subclass may be a PostScriptViewer which delegates Ghostscript to display a postscript file. '!


!Viewer methodsFor: 'testing'!

isBinary
	^self subclassResponsibility! !

!Viewer methodsFor: 'private'!

configure: aBinaryStream filename: aFilename 
	self isBinary
		ifTrue: 
			[aBinaryStream binary.
			^aFilename writeStream binary]
		ifFalse: 
			[aBinaryStream text.
			^aFilename writeStream text]! !

!Viewer methodsFor: 'accessing'!

save: aBinaryStream into: aFilename
	"Save aBinaryStream into a temporary file."
	|writeStream pos|
	pos := aBinaryStream position.
	writeStream := self configure: aBinaryStream filename: aFilename.
	writeStream nextPutAll: aBinaryStream; close.
	aBinaryStream position: pos.!

viewFile: aFilename
	"Open and display a new window that view aFilename."
	^self subclassResponsibility! !

Viewer subclass: #ImageViewer
	instanceVariableNames: 'imageReader '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
ImageViewer comment:
'I can display an image file.'!


!ImageViewer methodsFor: 'accessing'!

viewFile: aFilename
	imageReader := ImageReader displayFromFile: aFilename! !

!ImageViewer methodsFor: 'testing'!

isBinary
	^true! !

Object subclass: #LinkAccessor
	instanceVariableNames: 'outputStream cache '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
LinkAccessor comment:
'Given a link, I probably can access the destinatio hypertext component. If a stream is returned from the access, then it can be accessed by #outputStream.
'!


!LinkAccessor methodsFor: 'accessing'!

cache: aCache
	cache := aCache!

get: aHyperLink 
	| cacheFilename  |
	cacheFilename := cache filenameAtLink: aHyperLink.
	cacheFilename isNil
		ifTrue: [outputStream := aHyperLink getStream]
		ifFalse: [outputStream := cacheFilename readStream]!

outputStream
	^outputStream! !

!LinkAccessor methodsFor: 'testing'!

isLinkInCache: aHypertextLink
	"Check if aHypertextLink is in the cache. It depends on the subclass to implement the caching mechanism."

	^false! !

Object subclass: #ActionMap
	instanceVariableNames: 'actionEntries '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
ActionMap comment:
'I am used by StreamManager to store some mapping information.

Instance Variables:
	actionEntries	<Dictionary> of ActionEntry.

'!


!ActionMap methodsFor: 'accessing'!

at: aSymbol put: anActionEntry 
	actionEntries at: aSymbol put: anActionEntry!

filterFor: aTypeSymbol subtype: aSubtypeSymbol 
	| actionEntry filter |
	actionEntry := actionEntries at: aTypeSymbol ifAbsent: nil.
	actionEntry isNil
		ifTrue: [filter := nil]
		ifFalse: 
			[filter := actionEntry subtypeActionMap filterFor: aSubtypeSymbol subtype: nil.
			filter isNil ifTrue: [filter := actionEntry filter]].
	^filter!

viewerFor: aTypeSymbol subtype: aSubtypeSymbol 
	| actionEntry viewer |
	actionEntry := actionEntries at: aTypeSymbol ifAbsent: nil.
	actionEntry isNil
		ifTrue: [viewer := nil]
		ifFalse: 
			[viewer := actionEntry subtypeActionMap viewerFor: aSubtypeSymbol subtype: nil.
			viewer isNil ifTrue: [viewer := actionEntry viewer]].
	^viewer! !

!ActionMap methodsFor: 'initialize-release'!

initialize
	actionEntries := Dictionary new.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ActionMap class
	instanceVariableNames: ''!


!ActionMap class methodsFor: 'instance creation'!

new
	^super new initialize! !

ActionMap subclass: #EmptyActionMap
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!


!EmptyActionMap methodsFor: 'accessing'!

filterFor: aTypeSymbol subtype: aSubtypeSymbol
	^nil!

viewerFor: aTypeSymbol subtype: aSubtypeSymbol
	^nil! !

ComposingComposite subclass: #RecursiveComposite
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
RecursiveComposite comment:
'RecursiveComposite overwrites the hitDetect: method of its superclass. Instead of returning an immediate child from hiDetect:, RecursiveComposite return the youngest generation child. '!


!RecursiveComposite methodsFor: 'hit detection'!

hitDetect: aPoint
	"Answer a component that contains point aPoint or nil. The component may be a component of a component, a comopnent of a component of a component..."
	|c|
	c := super hitDetect: aPoint.
	c notNil ifTrue: [ ^c hitDetect: aPoint].
	^c! !

RecursiveComposite subclass: #HyperView
	instanceVariableNames: 'model controller '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!


!HyperView methodsFor: 'control'!

objectWantingControlbackup
	components == nil ifFalse: [^self].
	^nil! !

!HyperView methodsFor: 'model access'!

model
	^model!

model: aModel
	(model notNil and: [model ~~ aModel])
		ifTrue: [model removeDependent: self].
	(aModel notNil and: [aModel ~~ model])
		ifTrue: [aModel addDependent: self].
	model := aModel! !

!HyperView methodsFor: 'controller accessing'!

controller
	^controller!

controller: aController 
	self setController: aController!

defaultController
	^self defaultControllerClass new! !

!HyperView methodsFor: 'initialize-release'!

initializeSpacing
	super initializeSpacing.
	leftSpace := 0.
	extraSpaceTop := 5.
	spaceBetweenItems := 0! !

!HyperView methodsFor: 'private'!

defaultControllerClass
	^WebController!

getController
	controller == nil ifTrue: [self setController: self defaultController].
	^controller!

setController: aController 
	"Set the receiver's controller to aController. If aController is not nil, its view is set to the receiver and its model is set to aModel."

	aController == nil
		ifFalse: 
			[aController view: self.
			aController model: model].
	controller := aController! !

!HyperView methodsFor: 'accessing'!

componentAt: aPoint 
	^self hitDetect: aPoint!

flush
	"self layoutComponentsForBounds: self bounds."
"	self repairDamage"! !

!HyperView methodsFor: 'updating'!

update: t1 with: t2 
	t1 == #resize ifTrue: [self processResize].
	t1 == #startFilling
		ifTrue: 
			[self initialize.
			^self endFilling: false].
	t1 == #endFilling ifTrue: [^self flush].
	t1 == #newPM ifTrue: [  t2 view: self ].! !

Model subclass: #HyperApp
	instanceVariableNames: 'inputStream linkAccessor renderer currentLink resolvers '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
HyperApp comment:
'I am an abstract class for different kinds of hypertext application models.

HyperApp is the abstract super class for hypertext domain models. Its main function is to coordinate, initialize and delegate functionalities to its different components. HyperApp is a Facade object for the following components:
	LinkResolver
	LinkAccessor
	StreamManager
	StreamFilter & HyperRenderer
	Viewer

When HyperApp is initialized, it also initializes its HyperRenderer,  LinkAccessor, and StreamManager. HyperRenderer is used to create VisualComponents that represents the HyperComponent in the main window of the application.  LinkAccessor is used to retrieve the destination HyperComponent specified by a HyperLink. Besides, one or more LinkResolvers are also registered as dependents of HyperApp.

Subclass needs to implement the following:
	class methods:
		#initStyleSheet

Instance Variables:
	linkAccessor	<LinkAccessor>
	inputStream 		<aPositionableStream>
	renderer			<HyperRenderer>
	currentLink		<HyperLink>
	resolvers		<LinkResolvers>'!


!HyperApp methodsFor: 'initialize-release'!

addDefaultResolvers
	^self subclassResponsibility!

initialize
	self initRenderer.
	linkAccessor := self defaultLinkAccessor.
	resolvers := OrderedCollection new.
	self addDefaultResolvers.!

initRenderer
	renderer := self defaultRenderer.
	renderer model: self.!

initStyleSheet
	self subclassResponsibility! !

!HyperApp methodsFor: 'testing'!

isRelevant: aSymbol
	"Test if this symbol specifies a link type in which the receiver is interested in."
	^false! !

!HyperApp methodsFor: 'accessing'!

currentLink
	^currentLink!

currentLink: aHyperLink
	currentLink := aHyperLink!

jumpTo: aHypertextLink 
	self currentLink: aHypertextLink.
	renderer initForRedraw.
	linkAccessor get: aHypertextLink.!

registerLinkResolver: aLinkResolver 
	resolvers add: aLinkResolver.
	self addDependent: aLinkResolver.!

registerSubscriber: anObject 
	^self addDependent: anObject!

renderer
	^renderer!

reportLink: anObject aspect: anAspectSymbol
	"The receiver first check if the link reported is relevant to itself. Then, it broadcasts the new link." 
	(self isRelevant: anAspectSymbol) ifTrue: [self jumpTo: anObject].
	self changed: anAspectSymbol with: anObject!

retrieveLink: aUserActionState
"Some external object (CmdClick for example) sent a request to the receiver to retreive a link after the user has done something 'meaningful'. The receiver doesn't know how to retrieve a link, so it delegates to all its LinkResolvers  to do it. When the LinkResolvers can find it, it reports back to the receiver by #reportLink:aspect:. The link retrieved can be HyperLink or anything. UrlResovler returns a UrlLink. CharResolver returns a character.  TextResolver  returns a text. "

	resolvers do: [:each | each retrieveLink: aUserActionState for: self].! !

!HyperApp methodsFor: 'private'!

broadcastToResolvers: anAspectSymbol with: anObject
	resolvers do: [:each | each update: anAspectSymbol with: anObject from: self]!

defaultLinkAccessor
	^self subclassResponsibility!

defaultRenderer
	^self subclassResponsibility! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HyperApp class
	instanceVariableNames: 'StreamActionMap StyleMap '!


!HyperApp class methodsFor: 'instance creation'!

new
	^super new initialize! !

!HyperApp class methodsFor: 'accessing'!

defaultStyleSheet
	^StyleMap! !

!HyperApp class methodsFor: 'class initialization'!

initActionMap
	"Initialize the class instance variable StreamActionMap"!

initialize
	"self initialize"
	
	self initActionMap.
	self initStyleMap!

initStyleMap
	"Subclass may want to initialize the StyleMap by StyleMap at: emphasis: style: "

	StyleMap := StyleSheet defaultStyle: #htmlDefault.! !

Object subclass: #StreamManager
	instanceVariableNames: 'outputStream model link tmpFilename spawnFlag cache '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
StreamManager comment:
'Given an input stream, I either find a parser for it, or I will spawn another process to handle it.  The output stream is nil if I don''t find a parser, otherwise it is a stream of hypertext components resulting from parsing the input stream.

Currently, for WWWBrowser, I use the responseHeader information to help me make a decision. For example, if it is of MIME type text/html, then I will use a hypertextParser to parse the inputStream. I also need to tell the W3Model what kind of responseHeader I just parsed. 

Instance Variables:
	outputStream 	<Stream>
	model			<W3Model>
	saveInTmpFile	<Boolean> True means remove the responseHeader from the inputStream and
							    then save the rest of them in a tmpFile. Otherwise, the filtered
							    stream is parsed to the outputStream.

Class Variables:
	FiltersMap		<Dictionary> (#type,  actions)
'!


!StreamManager methodsFor: 'private'!

getFilterFor: aTypeSymbol
	^self class filterFor: aTypeSymbol and: nil!

getViewerFor: aTypeSymbol
	^self class viewerFor: aTypeSymbol and: nil!

process: aBinaryStream by: aStreamFilter
	aStreamFilter save: aBinaryStream into: tmpFilename.
	aBinaryStream close.
	aStreamFilter needTmpFile
		ifFalse: 
			[[aStreamFilter inputStream: tmpFilename readStream] fork.
			outputStream := aStreamFilter outputStream].!

view: aBinaryStream by: aViewer
	aViewer save: aBinaryStream into: tmpFilename.
	aViewer viewFile: tmpFilename.
	outputStream := nil! !

!StreamManager methodsFor: 'accessing'!

inputStream: aBinaryStream 
	"Assign either a Filter or Viewer to process aBinaryStream."

	^self subclassResponsibility!

link
	^link!

link: aHyperLink	
	link := aHyperLink!

model
	^model!

model: aW3Model
	model := aW3Model!

outputStream
	^outputStream!

spawn
	^spawnFlag!

spawn: aBoolean
	spawnFlag := aBoolean!

tmpFilename
	^tmpFilename!

tmpFilename: aFilename
	tmpFilename := aFilename! !

!StreamManager methodsFor: 'initialize-release'!

initialize
	spawnFlag := false.!

putNilOutStream
	outputStream := nil.
	^nil! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

StreamManager class
	instanceVariableNames: 'TypeMap '!


!StreamManager class methodsFor: 'class initialization'!

initialize
	"self initialize"! !

!StreamManager class methodsFor: 'accessing'!

filterFor: typeSymbol and: subtypeSymbol 
	| filter |
	filter := TypeMap filterFor: typeSymbol subtype: subtypeSymbol.
	filter isNil
		ifTrue: [^DummyFilter new]
		ifFalse: [^(Smalltalk at: filter) new]!

viewerFor: typeSymbol and: subtypeSymbol 
	| viewer  |
	viewer  := TypeMap viewerFor: typeSymbol subtype: subtypeSymbol.
	viewer  isNil
		ifTrue: [^nil]
		ifFalse: [^(Smalltalk at: viewer ) new]! !

!StreamManager class methodsFor: 'instance creation'!

new
	^super new initialize! !

!StreamManager class methodsFor: 'private'!

actionEntryFor: aCollection 
	"aCollection is in the form of (type, filter, viewer, subtypecollection). 
	subtypecollection has the same format of aCollection."

	|  subCollection subMap |
	subCollection := aCollection at: 4.
	subMap := self actionMapFor: subCollection.
	^ActionEntry
		filter: (aCollection at: 2)
		viewer: (aCollection at: 3)
		subtypeActionMap: subMap!

actionMapFor: aCollection 
	"aCollection is a collection of quadruples (type, filter, viewer, 
	subtypecollection). 
	subtypecollection has the same format of aCollection."

	| map entry |
	map := ActionMap new.
	aCollection
		do: 
			[:each | 
			entry := self actionEntryFor: each.
			map at: (each at: 1)
				put: entry].
	^map!

fillMap
	"Fill the content of TypeMap."

	|c|
	c :=#(
			#( #text #PlainTextFilter nil #(
					#(#html #HtmlParser nil #())
					#(#mchung #CodeFilter nil #())
				)
			)
			#( #image #BinaryFilter #ImageViewer #())
			).
	^self actionMapFor: c! !

Object subclass: #StreamFilter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
StreamFilter comment:
'I am an abstract class who works with StreamManager to parse inputStream. I may need to broadcast to my dependents of what I have built. If there is an outputStream, remember to flush the outputStream when
you are done. 

'!


!StreamFilter methodsFor: 'accessing'!

inputStream: aStream
	"self subclassResponsibility"!

outputStream
	"Return the outputStream. If my subclass wants to spawn another process instead of passing the outputStream for someone else, then returns nil."!

outputStream: aStream
	"self subclassResponsibility"!

save: aBinaryStream into: aFilename
	"Save aBinaryStream into a temporary file."
	|writeStream pos|
	writeStream := self configure: aBinaryStream filename: aFilename.
	pos := aBinaryStream position.
	writeStream nextPutAll: aBinaryStream; close.
	aBinaryStream position: pos.!

tmpFilename: aFilename
	"Some of my subclasses may need to save the inputStream as a tmpFile. This method provides a tmp Filename. "! !

!StreamFilter methodsFor: 'testing'!

needTmpFile
	^true! !

StreamFilter subclass: #PlainTextFilter
	instanceVariableNames: 'outputStream '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!


!PlainTextFilter methodsFor: 'accessing'!

inputStream: aBinaryStream 
	| hComp |
	aBinaryStream text.
	hComp := WebComponent new hTextFlag: false; type: #text.
	hComp content: aBinaryStream contents.
	outputStream nextPut: hComp.
	outputStream flush.
	"outputStream := aBinaryStream"!

needTmpFile
	^false!

next
	^WebComponent new 
		hTextFlag: false; 
		type: #text;
		content: outputStream text contents.!

outputStream
	outputStream isNil ifTrue: [ outputStream := self defaultOutputStream].
	^outputStream!

outputStream: aStream
	outputStream := aStream! !

!PlainTextFilter methodsFor: 'testing'!

isBinary
	^false! !

!PlainTextFilter methodsFor: 'private'!

configure: aBinaryStream filename: aFilename
	aBinaryStream text.
	^aFilename writeStream text!

defaultOutputStream
	"^W3Hypertext new"
	^HyperComposite new! !

StreamFilter subclass: #ImageFilter
	instanceVariableNames: 'imageReader tmpFile '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
ImageFilter comment:
'
Instance Variables: 
	imageReader	<ImageReader>
	tmpFile			<Filename>'!


!ImageFilter methodsFor: 'accessing'!

image
	^imageReader image!

inputStream: aBinaryStream!

needTmpFile
	^true!

outputStream
	^nil!

tmpFilename: aFilename
	tmpFile := aFilename! !

!ImageFilter methodsFor: 'testing'!

isBinary
	^true!

spawnable
	^true! !

StreamFilter subclass: #DummyFilter
	instanceVariableNames: 'inStream outStream '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!


!DummyFilter methodsFor: 'accessing'!

inputStream: aBinaryStream
	inStream := aBinaryStream.
	outStream := aBinaryStream!

needTmpFile
	^false!

outputStream
	^outStream!

outputStream: aStream 
	outStream := aStream.
	outStream nextPutAll: inStream! !

PlainTextFilter subclass: #CodeFilter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
CodeFilter comment:
'I can file in the current smalltalk code in the inputStream.'!


!CodeFilter methodsFor: 'accessing'!

inputStream: aBinaryStream 
	| returnValue |
	returnValue := Dialog confirm: 'The incoming file is smalltalk codes. You can\choose to file that into your image directly.\However, you are advised to save your image\first. Do you want to file in the incoming code now?' withCRs initialAnswer: false.
	"aBinaryStream text."
	returnValue
		ifTrue: [aBinaryStream text.
			aBinaryStream fileIn]
		ifFalse: [super inputStream: aBinaryStream]! !

StreamFilter subclass: #BinaryFilter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperTalk-Framework'!
BinaryFilter comment:
'I am an abstract class which configures a stream and filename writeStream to binary.
'!


!BinaryFilter methodsFor: 'private'!

configure: aBinaryStream filename: aFilename
	aBinaryStream binary.
	^aFilename writeStream binary! !

!BinaryFilter methodsFor: 'testing'!

needTmpFile
	^true! !
HyperApp initialize!

StreamManager initialize!


Object subclass: #HtmlScannerState
	instanceVariableNames: 'scanner '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!
HtmlScannerState comment:
'HTMLScannerState is an abstract class for all the states in an HTMLScanner. All subclass must implement handle. Together, all the states consititue a state machine. 


Instance Variables:
	scanner		<HTMLScanner> The scanner which operates on this state.'!


!HtmlScannerState methodsFor: 'public access'!

handle
	"Activates self"

	^self subclassResponsibility!

scanner: aHTMLScanner
	scanner := aHTMLScanner! !

!HtmlScannerState methodsFor: 'private'!

changeState: aHTMLScannerStateClass
	scanner changeState: (aHTMLScannerStateClass newWithScanner: scanner)!

getAnyChar
	scanner hereChar: scanner nextChar.
	scanner hereChar isNil ifTrue: [^scanner hereChar: Character space].
	^scanner hereChar!

getNextUsefulChar
	"Set HereChar from inputStream which is not linefeed or carriage return or 
	space, if the previous 
	character is a space."

	| aChar |
	aChar := scanner nextChar.
	[aChar = Character lf or: [aChar = Character cr or: [scanner hereChar = Character space and: [aChar = Character space]]]]
		whileTrue: [aChar := scanner nextChar].
	aChar = nil ifTrue: [^scanner processEndOfInput].
	scanner hereChar: aChar!

getNonBlankChar
	"Set HereChar from inputStream which is not linefeed or carriage return or 
	space, if the previous 
	character is a space."

	| aChar |
	aChar := scanner nextChar.
	[aChar = Character lf or: [aChar = Character cr or: [aChar = Character space]]]
		whileTrue: [aChar := scanner nextChar].
	aChar = nil ifTrue: [^scanner processEndOfInput].
	scanner hereChar: aChar! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HtmlScannerState class
	instanceVariableNames: ''!


!HtmlScannerState class methodsFor: 'instance creation'!

new
	self error: 'Use the method "newWithScanner" instead of new.'!

newWithScanner: aHTMLScanner 
	^super new scanner: aHTMLScanner! !

HtmlScannerState subclass: #StateAttrValue
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateAttrValue methodsFor: 'accessing'!

handle
	"Just read the Attribute field. Now is the attribute value."

	| hereChar |
	self getAnyChar.
	hereChar := scanner hereChar.
	hereChar = $>
		ifTrue: 
			[self changeState: StateText.
			^scanner endOneBlockWithType: #attributeValue].
	hereChar = Character space
		ifTrue: 
			[self changeState: StateTagGap.
			^scanner endOneBlockWithType: #attributeValue].
	^scanner appendHereCharToBuffer! !

HtmlScannerState subclass: #StateComment
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateComment methodsFor: 'accessing'!

handle
	| stream position |
	stream := scanner inputStream.
	position := stream position.
	(stream skipToAll: '-->') isNil
		ifTrue: 
			[scanner reset.
			stream position: position.
			scanner state: scanner initialState]
		ifFalse: [scanner skipInput: 3]! !

HtmlScannerState subclass: #StateReference
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateReference methodsFor: 'accessing'!

handle
	"Have just seen a '&', starts a character reference or entity 
	reference."
	"self getNextUsefulChar."

	self getAnyChar.
	scanner hereChar = $# ifTrue: [^self changeState: StateCharRef].
	scanner hereChar isAlphabetic
		ifFalse: 
			[scanner appendBuffer: $&.
			scanner appendBuffer: scanner hereChar.
			^self changeState: StateText].
	^self changeState: StateEntRef! !

HtmlScannerState subclass: #StateTagGap
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateTagGap methodsFor: 'accessing'!

handle
	"Expecting an attribute or '>'"

	self getNextUsefulChar.
	scanner hereChar = $>
		ifTrue: 
			[scanner  isTokenFound ifFalse: [^self changeState: StateText].
			^scanner endOneBlock].
	self changeState: StateAttr.
	^scanner appendHereCharToBuffer! !

HtmlScannerState subclass: #StateDQ
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateDQ methodsFor: 'accessing'!

handle
	"Accumulating a double-quoted value string."

	self getNextUsefulChar.
	scanner hereChar = $"
		ifTrue: 
			[self changeState: StateTagGap.
			^scanner endOneBlockWithType: #attributeValue value: scanner buffer].
	^scanner appendHereCharToBuffer! !

HtmlScannerState subclass: #StateJunkTag
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateJunkTag methodsFor: 'accessing'!

handle
	"Forget the tag just read."

"	tag := '</' , scanner buffer , '>'.
	inputStream := scanner inputStream. 
	oPosition := inputStream position.
	inputStream throughAll: tag.
	inputStream atEnd ifTrue: [ inputStream position: oPosition]."
	scanner reset.
	self changeState: StateText! !

HtmlScannerState subclass: #StateText
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateText methodsFor: 'accessing'!

handle
	"The initial state. In this state we are recognizing text, not markup. Special characters '&' 
	and '<' may be the start of some SGML markup. Otherwise, just send all characters 
	through to the target."

	self getNextUsefulChar.
	scanner hereChar = $&
		ifTrue: 
			[self changeState: StateReference.
			^scanner endOneBlockWithType: #pcdata].
	scanner hereChar = $<
		ifTrue: 
			[self changeState: StateAfterSmallerThan.
			scanner isBufferEmpty ifTrue: [^self].
			scanner isBufferAllSpace ifTrue: [^scanner reset].
			^scanner endOneBlockWithType: #text].
	^scanner appendHereCharToBuffer! !

!StateText methodsFor: 'private'!

getNextUsefulChar
	"Set HereChar from inputStream which is not linefeed or carriage return or 
	space, if the previous 
	character is a space."

	| aChar |
	aChar := scanner nextChar.
	[aChar = Character lf or: [aChar = Character cr or: [scanner hereChar = Character space and: [aChar = Character space]]]]
		whileTrue: [^scanner hereChar: Character space "scanner nextChar"].
	aChar = nil ifTrue: [^scanner processEndOfInput].
	scanner hereChar: aChar! !

HtmlScannerState subclass: #StateCData
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateCData methodsFor: 'accessing'!

handle
	"The current context is cdata (character data)."

	self getNextUsefulChar.
	scanner hereChar = $< ifTrue: [^self doAfterSmallerThan].
	^scanner appendHereCharToBuffer! !

!StateCData methodsFor: 'private'!

checkForEnd
	"'</' has been seen. Check if the next character is '/'..."

	self getNextUsefulChar.
	scanner hereChar isAlphabetic
		ifTrue: 
			[scanner endOneBlockWithType: #pcdata.
			scanner skipInput: -1. 
			^self changeState: StateEndTag].
	scanner appendBuffer: $<.
	^scanner appendBuffer: $/!

doAfterSmallerThan
	"A '<' has been seen. Check if the next character is '/'..."

	self getNextUsefulChar.
	scanner hereChar = $/ ifTrue: [^self checkForEnd].
	scanner appendBuffer: $<.
	^scanner appendHereCharToBuffer!

getNextUsefulChar
	"Any character is useful in this context."

	scanner hereChar: scanner nextChar.
	scanner hereChar isNil ifTrue: [^scanner hereChar: Character space].
	^scanner hereChar! !

StateCData subclass: #StateRCData
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateRCData methodsFor: 'accessing'!

handle
	self getNextUsefulChar.
	scanner hereChar = $< ifTrue: [^self doAfterSmallerThan].
	scanner hereChar = $& ifTrue: [^self doAfterAmp].
	^scanner appendHereCharToBuffer! !

!StateRCData methodsFor: 'private'!

doAfterAmp
	"'&' has been seen. Check if the next char is '#'..."

	self getNextUsefulChar.
	scanner hereChar isAlphabetic
		ifTrue: 
			[self pushBackChar.
			^self changeState: StateRCDataEntRef].
	scanner hereChar = $# ifTrue: [^self doMaybeEntity].
	scanner appendBuffer: $&.
	^scanner appendHereCharToBuffer!

doMaybeEntity
	self getNextUsefulChar.
	scanner hereChar isDigit
		ifTrue: 
			[self pushBackChar.
			^self changeState: StateCharRef].
	scanner appendBuffer: $&.
	^scanner appendBuffer: $#!

pushBackChar
	scanner skipInput: -1! !

HtmlScannerState subclass: #StateSQ
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateSQ methodsFor: 'accessing'!

handle
	"Accumulating a single-quoted value string."

	self getNextUsefulChar.
	scanner hereChar = $'
		ifTrue: 
			[self changeState: StateTagGap.
			^scanner endOneBlockWithType: #attributeValue value: scanner buffer].
	^scanner appendHereCharToBuffer! !

HtmlScannerState subclass: #StateEndTag
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateEndTag methodsFor: 'accessing'!

handle
	"'<' & '\' was read before. Accumulates the end tag."

	self getNextUsefulChar.
	scanner hereChar isAlphaNumeric ifTrue: [^scanner appendHereCharToBuffer].
	scanner hereChar = $>
		ifTrue: 
			[ |element|
			element := scanner atElement: (scanner buffer asUppercase).
			element isNil ifTrue: [^self changeState: StateJunkTag].
			self changeState: StateText.
			^scanner endOneBlockWithType: #endTag value: scanner buffer].
	self changeState: StateTagGap.
	^scanner endOneBlock! !

HtmlScannerState subclass: #StateStart
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateStart methodsFor: 'accessing'!

handle
	"The initial state. The first few characters are read and check if the source 
	document contains the status line from the server. If it is, then the next state is 
	StateStatusLine. Otherwise, StateText is used. Currently, if the first 5 
	characters are 'HTTP/', then it is assumed to be a status line."

	| buffer |
	self getNextUsefulChar.
	buffer := scanner buffer.
	buffer size = 5
		ifTrue: [buffer asUppercase = 'HTTP/'
				ifTrue: [self changeState: StateStatusLine]
				ifFalse: [scanner resetInputStream.	
						scanner reset.
						^self changeState: StateText]].
	scanner appendHereCharToBuffer! !

HtmlScannerState subclass: #StateAfterSmallerThan
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!
StateAfterSmallerThan comment:
'The character ''<'' has just read.
'!


!StateAfterSmallerThan methodsFor: 'private'!

checkForComment
	self getNextUsefulChar.
	scanner hereChar = $- ifTrue:[ ^self changeState: StateComment].
	scanner reset.
	^self backToPrevState! !

!StateAfterSmallerThan methodsFor: 'accessing'!

handle
	self getNextUsefulChar.
	scanner hereChar = $!! ifTrue: [^self checkForComment].
	scanner hereChar = $/ ifTrue: [^self changeState: StateEndTag ].
	scanner skipInput: -1.
	^self changeState: StateTag! !

HtmlScannerState subclass: #StateEntRef
	instanceVariableNames: 'buffer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateEntRef methodsFor: 'private'!

appendLocalBuffer: aChar 
	^buffer nextPut: aChar!

buffer
	^buffer contents asString! !

!StateEntRef methodsFor: 'accessing'!

handle
	"Handles an entity, until aCharacter is not alphanumeric. If a space is encountered before a ';', that means the document is not a correct HTML 1.0 document. Just treat all the char in buffer as text."

	| aChar |
	buffer isEmpty ifTrue: [ self appendLocalBuffer: scanner hereChar].
	self getAnyChar.
	scanner hereChar = $;
		ifTrue: 
			[
			self changeState: StateText.
			aChar := scanner dtd atEntity: self buffer.
			aChar isNil ifTrue: [^self].
			^scanner appendBuffer: aChar].
	scanner hereChar = Character space
		ifTrue: 
			[self changeState: StateText.
			scanner appendBuffer: $&.
			self buffer do: [:each | scanner appendBuffer: each].
			scanner appendBuffer: scanner hereChar].
	^self appendLocalBuffer: scanner hereChar! !

!StateEntRef methodsFor: 'initialize-release'!

initBuffer
	buffer := WriteStream on: (String new: 10)! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

StateEntRef class
	instanceVariableNames: ''!


!StateEntRef class methodsFor: 'instance creation'!

newWithScanner: aHTMLScanner 
	|instance|
	instance := super newWithScanner: aHTMLScanner. 
	instance initBuffer.
	^instance! !

StateEntRef subclass: #StateCharRef
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateCharRef methodsFor: 'accessing'!

handle
	"A &# has been read."

	| aChar |
	self getNextUsefulChar.
	scanner hereChar = $;
		ifTrue: 
			[scanner backToPrevState.
			self buffer isNumeric
				ifTrue: 
					[aChar := Character value: self buffer asNumber.
					 aChar isNil ifTrue: [^self].
					^scanner appendBuffer: aChar]
			"	ifFalse: [^scanner reset]"].
	^self appendLocalBuffer: scanner hereChar! !

HtmlScannerState subclass: #StateTag
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!
StateTag comment:
'	In this state, we are recognizing characters in the tag name of an 
	element, ie, just after the opening ''<''. If aCharacter is 
	alphanumeric, simply add it to the accumulation. If aCharacter is 
	''/'', then it should be the first character after the ''<''. Otherwise, the 
	tag name has ended, so check to see if it is a valid tag. If 
	aCharacter is ''>'', then we have reached the end of the ''<...>'' markup.'!


!StateTag methodsFor: 'private'!

getNextUsefulChar
	"Set HereChar from inputStream which is not linefeed or carriage return or 
	space, if the previous 
	character is a space."

	| aChar |
	aChar := scanner nextChar.
	[aChar = Character lf or: [aChar = Character cr or: [scanner hereChar = Character space and: [aChar = Character space]]]]
		whileTrue: [^scanner hereChar: Character space "scanner nextChar"].
	aChar = nil ifTrue: [^scanner processEndOfInput].
	scanner hereChar: aChar!

selectState: aString 
	| element |
	element := scanner atElement: aString.
	element isNil ifTrue: [^self changeState: StateJunkTag].
	scanner endOneBlockWithType: #tag value: aString.
	(element contentIs: #rcdata)
		ifTrue: [^self changeState: StateRCData].
	(element contentIs: #cdata)
		ifTrue: [^self changeState: StateCData].
	^self changeState: StateText! !

!StateTag methodsFor: 'accessing'!

handle
	"A < was read. Accumulate the first word as the tag."

	| tag element |
	self getNextUsefulChar.
	scanner hereChar isAlphaNumeric ifTrue: [^scanner appendHereCharToBuffer].
	scanner hereChar = $>
		ifTrue: 
			[tag := scanner buffer asUppercase.
			^self selectState: tag].
	element := scanner atElement: scanner buffer asUppercase.
	element isNil
		ifTrue: [^self changeState: StateJunkTag]
		ifFalse: 
			[self changeState: StateTagGap.
			^scanner endOneBlockWithType: #tag value: scanner buffer asLowercase]! !

HtmlScannerState subclass: #StateAttr
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateAttr methodsFor: 'accessing'!

handle
	"Accumulating an attribute, until '=' or '>' ."

	self getNonBlankChar.
	scanner hereChar = $>
		ifTrue: 
			[self changeState: StateText.
			^scanner endOneBlockWithType: #attribute value: scanner buffer asLowercase].
	scanner hereChar = $=
		ifTrue: 
			[scanner endOneBlockWithType: #attribute value: scanner buffer asLowercase.
			^self changeState: StateEquals].
	^scanner appendHereCharToBuffer! !

HtmlScannerState subclass: #StateEquals
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateEquals methodsFor: 'accessing'!

handle
	"Have seen the '=' after an attribute. Expect a value to start."

	self getNonBlankChar.
	scanner hereChar = $> ifTrue: [^self error: 'syntax error in tag attributes'].
	scanner hereChar = $" ifTrue: [^self changeState: StateDQ ].
	scanner hereChar = $' ifTrue: [^self changeState: StateSQ].
	scanner appendHereCharToBuffer.
	^self changeState: StateAttrValue! !

StateEntRef subclass: #StateRCDataEntRef
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Scanner States'!


!StateRCDataEntRef methodsFor: 'accessing'!

handle
	"Handles an entity, until aCharacter is not alphanumeric. If a space is encountered before a ';', that means the document is not a correct HTML 1.0 document. Just treat all the char in buffer as text."

	| aChar |
	buffer isEmpty ifTrue: [ self appendLocalBuffer: scanner hereChar].
	self getAnyChar.
	scanner hereChar = $;
		ifTrue: 
			[
			self changeState: StateRCData.
			aChar := scanner dtd atEntity: self buffer.
			aChar isNil ifTrue: [^self].
			^scanner appendBuffer: aChar].
	scanner hereChar = Character space
		ifTrue: 
			[self changeState: StateText.
			scanner appendBuffer: $&.
			self buffer do: [:each | scanner appendBuffer: each].
			scanner appendBuffer: scanner hereChar].
	^self appendLocalBuffer: scanner hereChar! !

Object subclass: #HtmlScanner
	instanceVariableNames: 'currentState buffer currentToken dtd elementStack endOfInput hereChar inputStream isEndToken prevState '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Parsing'!
HtmlScanner comment:
'HTMLScanner interacts with  HTMLScannerState to form aHTMLScanner. 
All the tags that is not defined in dtd will be ignored. 

Instance Variables:
	currentState		<HTMLScannerState> keeps track of the current HTMLScannerState.
	buffer 			<WriteStream> stores the character that will be sent to the outputStream.
	dtd				<HTMLDTD> defines the grammer. 
	currentToken 		<Token> defines the token that will be sent to the outputStream.
	endOfInput 		<Boolean> a flag.
	hereChar 		<Character> the character that is currently processing.
	inputStream 		<Stream> 
	isEndToken 		<Boolean> a flag.
	prevState			<HTMLScannerState> the previous HTMLScannerState.'!


!HtmlScanner methodsFor: 'accessing by states'!

appendBuffer: aChar 
	^buffer nextPut: aChar!

appendHereCharToBuffer
	self appendBuffer: hereChar!

atElement: aString
	^dtd atElement: aString asLowercase asSymbol ifAbsent: nil!

backToPrevState
	| state |
	state := currentState.
	self state: prevState.
	prevState := state!

buffer
	^buffer contents asString!

changeState: aScannerState
	prevState := currentState.
	self state: aScannerState!

endOneBlock
	"A block of characters are scanned. A token is set. The buffer is reset"

	isEndToken := true.
	self setToken.
	self resetBuffer!

endOneBlockWithType: aSymbol 
	"Similar to endOneBlock but this time, the type of the token is specified."

	isEndToken := true.
	self setTokenWithType: aSymbol.
	self resetBuffer!

endOneBlockWithType: aSymbol value: anObject 
	"Similar to endOneBlock but the type and value of the token is set explicitly"

	isEndToken := true.
	aSymbol = #text
		ifTrue: [self setTokenWithType: aSymbol value: anObject]
		ifFalse: [self setTokenWithType: aSymbol value: anObject "asUppercase"].
	self resetBuffer!

hereChar
	^hereChar!

hereChar: aChar
	hereChar := aChar!

inputStream
	^inputStream!

nextChar
	^inputStream next!

processEndOfInput
	hereChar := Character space.
	endOfInput := true.
	^self endOneBlockWithType: #pcdata!

skipInput: anInteger
	inputStream skip: anInteger!

state: aSGMLScannerState 
	currentState := aSGMLScannerState!

token
	^currentToken! !

!HtmlScanner methodsFor: 'accessing'!

defaultDTD
	^HtmlDtd new!

dtd
	^dtd!

dtd: aDTD
	dtd := aDTD!

input: aStream 
	"set the input Stream. Reset the states."

	self state: (self initialState).
	self reset.
	inputStream := aStream!

nextToken
	"Returns the next token from the inputStream."

	self clearToken.
	currentState handle.
	[self isTokenFound]
		whileFalse: [currentState handle].
	self isEndOfInput ifTrue: [inputStream close.
							^nil].
	^self token! !

!HtmlScanner methodsFor: 'token accessing'!

setToken
	|type|
	type := currentToken type.
	isEndToken := true.
	(type = #text or: [type = #attributeValue])
		ifTrue: [currentToken value: self buffer]
		ifFalse: [currentToken value: self buffer asUppercase].
	self resetBuffer.
	^currentToken!

setTokenWithType: aSymbol 
	^currentToken value: self buffer type: aSymbol!

setTokenWithType: aSymbol value: aString 

	(aSymbol = #text or: [aSymbol = #attributeValue])
		ifTrue: [^currentToken value: self buffer type: aSymbol]
		ifFalse: [^currentToken value: self buffer asUppercase type: aSymbol].
"	aSymbol = #text ifTrue: [^currentToken value: aString type: aSymbol].
	^currentToken value: aString asUppercase type: aSymbol"! !

!HtmlScanner methodsFor: 'testing'!

inputStreamAtEnd
	^inputStream atEnd!

isBufferAllSpace
	| content |
	content := buffer contents.
	content size = 0 ifTrue: [^false].
	content do: [:each | each = Character space
			ifFalse: [^false]].
	^true!

isBufferEmpty
	"Returns true if buffer is empty"

	^buffer size = 0!

isEndOfInput
	^endOfInput!

isTokenFound
	"Returns true if end of stream or a token is found."

	^isEndToken! !

!HtmlScanner methodsFor: 'initialize-release'!

clearToken
	currentToken := Token new.
	isEndToken := false!

initialize
	self state: self initialState.
	dtd := self defaultDTD.
	self reset.!

initialState
	"^StateStart newWithScanner: self"
	^StateText newWithScanner: self!

reset
	endOfInput := false.
	self resetBuffer.
	self clearToken!

resetBuffer
	buffer := WriteStream on: (String new: 100)!

resetInputStream
	inputStream reset.! !

!HtmlScanner methodsFor: 'printing'!

printOn: aStream
	aStream nextPutAll: '(Scanner '.
	hereChar isNil ifFalse: [ aStream nextPut: hereChar].
	aStream nextPutAll: ') '.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HtmlScanner class
	instanceVariableNames: ''!


!HtmlScanner class methodsFor: 'instance-creation'!

new
	^super new initialize! !

Object subclass: #HtmlElement
	instanceVariableNames: 'name attributes content parents mappedClassName hTextFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Parsing'!
HtmlElement comment:
'SGMLElement is used to define the characteristic of a SGML element defined in
DTD. This class also specifies the class to be mapped from parsing this element.

Instance Variables:
	name 					<Symbol>		The name of the element.
	attributes 				<Collection>	Collection of attributes names in symbol.
	content					<Symbol>
	parents				<Collection>
	mappedClassName	<aSymbol>'!


!HtmlElement methodsFor: 'printing'!

printOn: aStream 
	aStream nextPut: $<; nextPutAll: name; nextPut: $>! !

!HtmlElement methodsFor: 'testing'!

at: aString ifAbsent: aBlock 
	| key |
	key := aString.
	(attributes includes: key)
		ifFalse: [^self error: 'No such attribute - ' , key].
	^values at: key ifAbsent: aBlock!

isParentType: aSymbol
	parents isEmpty ifTrue: [^true].
	^parents includes: aSymbol! !

!HtmlElement methodsFor: 'accessing'!

at: aString 
	^self at: aString ifAbsent: [nil]!

at: aString put: anObject 
	| key |
	key := aString asString asUppercase.
	(attributes includes: key)
		ifTrue: [values at: key put: anObject]
		ifFalse: [self error: 'No such attribute - ' , key]!

attributes
	^attributes!

attributes: aCollection 
	attributes := aCollection collect: [:each | each asString asUppercase].
	"self values: Dictionary new"!

content
	^content!

content: anObject 
	content := anObject!

contentIs: aSymbol
	^content = aSymbol!

hasAttribute: aString 
	^attributes includes: aString!

hasAttributeValue: aString 
	(attributes includes: aString)
		ifFalse: [^false].
	values at: aString ifAbsent: [^false]!

hTextFlag
	^hTextFlag!

hTextFlag: aBoolean
	hTextFlag := aBoolean!

mappedClassName: anObject 
	mappedClassName := anObject!

mappedObject
	|obj |
	obj := (Smalltalk at: mappedClassName) new.
	obj hTextFlag: hTextFlag.
	^obj!

name
	^name!

name: anObject 
	name := anObject asString asUppercase asSymbol!

newCopy
	| tmp |
	(tmp := self copy) values: Dictionary new.
	^tmp!

parents
	^parents!

parents: aSymbolOrArray
	parents := aSymbolOrArray! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HtmlElement class
	instanceVariableNames: ''!


!HtmlElement class methodsFor: 'instance creation'!

name: nameSymbol attributes: attrCollection content: contentSymbol parents: aSymbolOrArray mappedClassName: aClassName hTextFlag: aBoolean
	| instance |
	(instance := self new) name: nameSymbol; attributes: attrCollection; content: contentSymbol; parents: aSymbolOrArray; mappedClassName: aClassName; hTextFlag: aBoolean.
	^instance! !

Object subclass: #Token
	instanceVariableNames: 'value type '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Parsing'!
Token comment:
'Token is passed from a scanner to a parser.

Instance Variables:
	value		<aString>
	type		<aSymbol>

'!


!Token methodsFor: 'initialize-release'!

initialize
	value := nil.
	type := nil! !

!Token methodsFor: 'printing'!

printOn: aStream 
	aStream nextPutAll: 'Token ('.
	type printOn: aStream.
	aStream space.
	value printOn: aStream.
	aStream nextPut: $)! !

!Token methodsFor: 'accessing'!

type
	^type!

type: aStringOrSymbol 
	type := aStringOrSymbol asSymbol!

value
	^value!

value: anObject 
	value := anObject!

value: anObject type: aSymbol 
	value := anObject.
	type := aSymbol! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Token class
	instanceVariableNames: ''!


!Token class methodsFor: 'instance creation'!

new

	^super new initialize! !

Object subclass: #HtmlDtd
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Parsing'!
HtmlDtd comment:
'HTMLDTD defines the grammer and object mapping for HTML. If another SGML document
type is needed, e.g. HTML+, then the method initElements & initEntities needs to be 
overwritten. Actually, adding SGMLDTD as an abstract class may be a better idea. I may
create it where there is a need. 

Note: the keys to the dictionaries Elements and Entities are stored in symbols with lowercase chars. 


Class InstanceVariableNames: 
	Elements 		<Dictionary> defines the grammer and object mapping. 
	Entities 		<Dictionary> defines the entities in HTML. 
	instance 		<HTMLDTD> '!


!HtmlDtd methodsFor: 'accessing'!

atElement: aTagSymbol
	"Returns nil or an SGMLElement with name = aString."

	^self atElement: aTagSymbol ifAbsent: nil!

atElement: aTagSymbol ifAbsent: anObject
	"Returns anObject or an SGMLElement with name = aTagSymbol."

	^(self elements) at: aTagSymbol ifAbsent: anObject!

atEntity: aTagSymbol
	"Returns nil or an entity for  aString."

	^self atEntity: aTagSymbol ifAbsent: nil!

atEntity: aTagSymbol ifAbsent: anObject
	"Returns nil or an entity for  aTagSymbol."

	^(self entities) at: aTagSymbol ifAbsent: anObject!

contentFor: aTagSymbol 
	| element |
	element := self atElement: aTagSymbol.
	element isNil
		ifTrue: [^nil]
		ifFalse: [^element content]!

defaultMappedObject
	^WebComponent new type: #text!

elements
	^HtmlDtd elements!

entities
	^HtmlDtd entities!

mapObject: aSymbol
	|elt|
	elt := self elements at: aSymbol ifAbsent: nil.
	elt isNil ifFalse: [ ^elt mappedObject  ].
	^nil!

parentsFor: aTagSymbol
	^(self atElement: aTagSymbol) parents! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HtmlDtd class
	instanceVariableNames: 'Elements Entities instance '!


!HtmlDtd class methodsFor: 'instance creation'!

new
	instance isNil ifTrue: [ instance := super new ].
	^instance! !

!HtmlDtd class methodsFor: 'class initialization'!

initElements
	"Each entry contains (name, content, attributes, parents, 
	mappedObjectClass hTextFlag). HTMLDTD initElements. 'Name', 'content', 
	'attributes' are defined by the dtd at 
	http://www11.w3.org/hypertext/WWW/MarkUp/HTML.dtd.html. 'Parents' is 
	the set of possible tags that can be the parent of name. 
	MappedObjectClass is the class created for mapping 'name'."

	| t |
	Elements := Dictionary new.
	t := #(
#(#a #mixed #(#HREF #NAME #TITLE #TYPE #URN) #() #WebComposite true) 
#(#address #mixed #() #() #WebComposite false) 
#(#b #mixed #() #() #WebComposite true) 
#(#base #mixed #() #(#head) #WebComposite false) 
#(#blockquote #mixed #() #() #WebComposite false) 
#(#body #mixed #() #() #WebComposite false) 
#(#br #empty #() #() #WebComponent false) 
#(#cite #mixed #() #() #WebComposite true) 
#(#code #mixed #() #() #WebComposite true) 
#(#comment #mixed #() #() #WebComposite false) 
#(#dd #empty #() #(#dt) #WebComposite false) 
#(#dfn #mixed #() #() #WebComposite true) 
#(#dir #mixed #(#COMPACT) #() #WebComposite false) 
#(#dl #mixed #(#COMPACT) #() #WebComposite false) 
#(#dlc #mixed #(#COMPACT) #() #WebComposite false) 
#(#dt #empty #() #(#dl) #WebComposite false) 
#(#em #mixed #() #() #WebComposite true) 
#(#form #mixed #(#ACTION #METHOD) #() #WebComposite false) 
#(#head #mixed #() #() #WebComposite false) 
#(#h1 #mixed #() #() #WebComposite false) 
#(#h2 #mixed #() #() #WebComposite false) 
#(#h3 #mixed #() #() #WebComposite false) 
#(#h4 #mixed #() #() #WebComposite false) 
#(#h5 #mixed #() #() #WebComposite false)
 #(#h6 #mixed #() #() #WebComposite false) 
#(#h7 #mixed #() #() #WebComposite false) 
#(#hr #empty #() #() #WebComponent false) 
#(#i #mixed #() #() #WebComposite true) 
#(#img #empty #(#ALT #SRC) #() #WebComponent true) 
#(#input #empty #(#CHECKED #MAXLENGTH #NAME #SIZE #TYPE #VALUE) #() #WebComponent false) 
#(#isindex #empty #() #(#head) #WebComponent false) 
#(#kbd #mixed #() #() #WebComposite true) 
#(#key #mixed #() #() #WebComposite true) 
#(#li #empty #(#COMPACT) #(#ul #ol #menu #dir) #WebComposite false) 
#(#link #empty #(#HREF #REL #REV) #(#head) #WebComponent false) 
#(#listing #cdata #() #() #WebComposite false) 
#(#menu #mixed #(#COMPACT) #() #WebComposite false) 
#(#nextid #empty #(#N) #(#head) #WebComponent false) 
#(#ol #mixed #(#COMPACT) #() #WebComposite false) 
#(#option #empty #(#SELECTED) #() #WebComponent false) 
#(#p #empty #() #() #WebComponent false) 
#(#plaintext #cdata #() #() #WebComposite false) 
#(#pre #rcdata #() #() #WebComposite false) 
#(#samp #mixed #() #() #WebComposite true) 
#(#select #mixed #(#MULTIPLE #NAME) #() #WebComposite false) 
#(#strong #mixed #() #() #WebComposite true) 
#(#textarea #mixed #(#COLS #NAME #ROWS) #() #WebComposite false) 
#(#title #rcdata #() #(#head) #WebComposite false) 
#(#tt #mixed #() #() #WebComposite true) 
#(#u #mixed #() #() #WebComposite true) 
#(#ul #mixed #(#COMPACT) #() #WebComposite false) 
#(#var #mixed #() #() #WebComposite true) 
#(#xmp #cdata #() #() #WebComposite false)).
	t do: [:each | self addElement: (HtmlElement
				name: (each at: 1)
				attributes: (each at: 3)
				content: (each at: 2)
				parents: (each at: 4)
				mappedClassName: (each at: 5)
				hTextFlag: (each at: 6))]!

initEntities
	| t |
	Entities := Dictionary new.
	t := #(#AElig 198 #Aacute 193 #Acirc 194 #Agrave 192 #Aring 197 #Atilde 195 #Auml 196 #Ccedil 199 #ETH 208 #Eacute 201 #Ecirc 202 #Egrave 200 #Euml 203 #Iacute 205 #Icirc 206 #Igrave 204 #Iuml 207 #Ntilde 209 #Oacute 211 #Ocirc 212 #Ograve 210 #Oslash 216 #Otilde 213 #Ouml 214 #THORN 222 #Uacute 218 #Ucirc 219 #Ugrave 217 #Uuml 220 #Yacute 221 #aacute 225 #acirc 226 #aelig 230 #agrave 224 #amp 38 #aring 229 #atilde 227 #auml 228 #ccedil 231 #eacute 233 #ecirc 234 #egrave 232 #emsp 0 #ensp 0 #eth 240 #euml 235 #gt 62 #iacute 237 #icirc 238 #igrave 236 #iuml 239 #lt 60 #nbsp 0 #ntilde 241 #oacute 243 #ocirc 244 #ograve 242 #oslash 248 #otilde 245 #ouml 246 #quote 39 #szlig 223 #thorn 254 #uacute 250 #ucirc 251 #ugrave 249 #uuml 252 #yacute 253 #yuml 255 ).
	1
		to: t size
		by: 2
		do: [:i | self addEntity: (t at: i)
				value: (t at: i + 1) asCharacter]!

initialize
	"self initialize"

	self initElements.
	self initEntities! !

!HtmlDtd class methodsFor: 'accessing'!

addElement: anElement
	"Elements at: anElement name asString asUppercase put: anElement"
	Elements at: anElement name asString asLowercase asSymbol put: anElement!

addEntity: aSymbol value: aChar
	Entities at: aSymbol asString asLowercase asSymbol put: aChar!

elements
	^Elements!

entities
	^Entities! !

PlainTextFilter subclass: #HtmlParser
	instanceVariableNames: 'elementStack scanner currentToken dtd optimizeFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-HTML Parsing'!
HtmlParser comment:
'I accept a stream of characters of HTML document and then asks a HtmlScanner to read it. The scanner returns a stream of Tokens back and then HtmlParser buids the parse tree. It sends the parse tree to outputStream. For each token type, a method with the same name as that type needs to be defined.  See the category ''token type actions''. 

Instance Variables:
	scanner	<HTMLScanner>	The scanner that supplies the token. It must 
									respond to the message nextToken.
	elementStack		<Stack>	A stack of elements to store the nodes temporarily .
	outputStream 		<Stream>			
	currentToken 		<Token>
	dtd 			 	<SGMLDTD>	The place where the grammar and mapping 										info is defined.
	optimizeFlag		<Boolean>	 optimization mode.
'!


!HtmlParser methodsFor: 'accessing'!

defaultDTD
	^HtmlDtd new!

defaultScanner
	^HtmlScanner new!

inputStream: aCharStream 
	self parse: aCharStream!

needTmpFile
	^false!

optimize
	^optimizeFlag!

optimize: aBoolean
	optimizeFlag := aBoolean!

outputStream
	^outputStream!

outputStream: aStream 
	outputStream := aStream!

parse: aStream 
	"Parse aStream and sends the output to outputStream."

	scanner input: aStream. 
	[(currentToken := scanner nextToken) isNil]
		whileFalse: [self perform: currentToken type withArguments: #()].
	self flush.! !

!HtmlParser methodsFor: 'token type actions'!

attribute
	|anAttribute|
	elementStack isEmpty ifTrue: [^self].
	anAttribute := (Attribute new ) name: currentToken value asLowercase asSymbol.
	elementStack lastElement addAttribute: anAttribute!

attributeValue
	elementStack isEmpty ifTrue: [^self].
	elementStack lastElement  lastAttribute value: currentToken value!

endTag
	| tag |
	tag := currentToken value asLowercase asSymbol.
	currentToken value: tag.
	self optimize ifTrue: [tag = #body ifTrue: [^self]].
	elementStack isEmpty ifFalse: [self outputThisTagBlock: tag]
		ifTrue: ["^self error: 'error in HTMLParser ENDTAG'"
				"Transcript show: 'parsing error in source document'; cr.
				self halt."]!

pcdata
	"Output a default Text object or find a parent for it."

	| mappedObject |
	mappedObject := self defaultTextObject.
	mappedObject content: currentToken value.
	self processText: mappedObject!

responseHeader
	"Do nothing... to be removed"
	self halt.
	outputStream responseHeader: currentToken value!

statusline
	"Do nothing... To be removed"
	outputStream statusLine: currentToken value!

tag
	| mappedObject tag emptyElement lastElt |
	tag := currentToken value asLowercase asSymbol.
	currentToken value: tag.
	self optimize ifTrue: [tag = #body ifTrue: [^self]].
	(dtd contentFor: tag)
		= #empty
		ifTrue: 
			[emptyElement := self searchForElement: tag.
			emptyElement notNil
				ifTrue: 
					[currentToken type: #ENDTAG.
					self endTag.
					currentToken type: #TAG]].
	mappedObject := self mapObject: tag.
	elementStack isEmpty
		ifTrue: [^elementStack push: mappedObject]
		ifFalse: 
			[lastElt := elementStack lastElement.
			(lastElt isComposite and: [(dtd atElement: tag)
					isParentType: lastElt type])
				ifTrue: [^self addLeafAndPush: mappedObject]
				ifFalse: 
					[self removeLastElement.
					^self addLeafAndPush: mappedObject]]!

text
	"Output a MediaText object or find a parent for it."

	| mappedObject |
	mappedObject := self defaultTextObject.
	mappedObject content: currentToken value.
	self processText: mappedObject! !

!HtmlParser methodsFor: 'initialize-release'!

initialize
	scanner := self defaultScanner.
	dtd := self defaultDTD.
	self initStack.
	self optimize: true.
	outputStream := self defaultOutputStream!

initStack
	elementStack := Stack new! !

!HtmlParser methodsFor: 'private-optimized'!

processTextOptimized: aHypertextComponent 
	elementStack isEmpty
		ifTrue: 
			[| composite |
			composite := WebComposite new type: #text.
			elementStack push: composite.
			self addLeaf: aHypertextComponent]
		ifFalse: [elementStack lastElement isComposite
				ifTrue: [^self addLeaf: aHypertextComponent]
				ifFalse: 
					[self removeLastElement.
					elementStack lastElement isNil
						ifTrue: [^outputStream nextPut: aHypertextComponent]
						ifFalse: [^self addLeaf: aHypertextComponent]]]! !

!HtmlParser methodsFor: 'private'!

addLeaf: mappedObject 
	elementStack isEmpty
		ifFalse: 
			[| last |
			last := elementStack lastElement.
			last add: mappedObject]!

addLeafAndPush: mappedObject 
	"Add a leaf to the parse tree and put it into the elementStack."

	self addLeaf: mappedObject.
	elementStack push: mappedObject!

defaultOutputStream
	^HyperComposite new!

defaultTextObject
	^WebComponent new hTextFlag: true; type: #text.!

flush
	"Output all the elements in the elementStack to outputStream."

	elementStack isEmpty
		ifFalse: 
			[outputStream nextPut: elementStack firstElement.
			self initStack].
	outputStream flush.!

mapObject: aSymbol
	"Find the object mapped from aSymbol."

	|anObject|
	anObject := dtd mapObject: aSymbol.
	anObject type: aSymbol.
	^anObject!

outputThisTagBlock: tag 
	"Beginning from the top of elementStack, search for a node with tag = tag. If 
	that node is at the bottom of the stack, then put that node into outputStream. 
	Otherwise, pop all nodes until that node is popped."

	| mappedObject root |
	root := elementStack firstElement.
	elementStack isEmpty
		ifFalse: 
			[[(mappedObject := elementStack pop) isNil or: [mappedObject type == tag]] whileFalse.
			(mappedObject notNil and: [elementStack size = 0])
				ifTrue: [outputStream nextPut: mappedObject]
				ifFalse: [(root notNil and: [elementStack size = 0])
						ifTrue: [outputStream nextPut: root]]]!

processText: aHypertextComponent 
	elementStack isEmpty
		ifTrue: [outputStream nextPut: aHypertextComponent]
		ifFalse: [elementStack lastElement isComposite
				ifTrue: [self addLeaf: aHypertextComponent]
				ifFalse: 
					[self removeLastElement.
					elementStack lastElement isNil
						ifTrue: [outputStream nextPut: aHypertextComponent]
						ifFalse: [self addLeaf: aHypertextComponent]]]!

removeLastElement
	"Decide if the last element already in the stack needs to be output. It needs to be output only if it is not composite and it is the only element in the stack."

	| theElement |
	elementStack isEmpty ifTrue: [^nil].
	theElement := elementStack pop.
	(elementStack size > 0 or: [theElement isComposite])
		ifFalse: [outputStream nextPut: theElement]!

searchForElement: aTagSymbol 
	"From the top of the stack, search for the node with tag = aString. "

	|  parentTagCollection parent|
	elementStack isEmpty ifTrue: [^nil].
	parentTagCollection := dtd parentsFor: aTagSymbol.
	parentTagCollection isNil 
			ifTrue: [^self searchForLastElementIn: elementStack withTag: aTagSymbol]
			ifFalse: [ parent := self searchForLastElementThatContains: parentTagCollection].
	parent notNil ifTrue: [ ^self searchForLastElementIn:( parent content) withTag: aTagSymbol]
			     ifFalse: [^nil]!

searchForElementIn: aCollectionOrStack withTag: aSymbol 
	| elements |
	elements := OrderedCollection new.
	(aCollectionOrStack isNil or: [aCollectionOrStack isEmpty])
		ifTrue: [^nil].
	aCollectionOrStack do: [:each | each type notNil ifTrue: [each type == aSymbol ifTrue: [elements add: each]]].
	elements isEmpty ifTrue: [^nil].
	^elements!

searchForElementThatContains: aCollection 
	"Search elementStack for all the elements with tag in aCollection."

	| elements |
	elements := OrderedCollection new.
	elementStack do: [:each | each type notNil ifTrue: [(aCollection includes: each type)
				ifTrue: [elements add: each]]].
	elements isEmpty ifTrue: [^nil].
	^elements!

searchForLastElementIn: aCollectionOrStack withTag: aSymbol

	|aCollection|
	aCollection := self searchForElementIn: aCollectionOrStack withTag: aSymbol.
	aCollection isNil ifTrue: [ ^nil].
	^aCollection last!

searchForLastElementThatContains: aCollection 
	"Search elementStack for the last element with tag included in aCollection."

	| elements |
	elements := self searchForElementThatContains: aCollection.
	elements isNil ifFalse: [^elements last].
	^nil! !

!HtmlParser methodsFor: 'testing'!

isBinary
	^false! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HtmlParser class
	instanceVariableNames: ''!


!HtmlParser class methodsFor: 'instance-creation'!

new
	^super new initialize! !
HtmlDtd initialize!


Object subclass: #WebCache
	instanceVariableNames: 'cacheItems maxItems maxVisuals totalVisuals '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!


!WebCache methodsFor: 'private'!

addCacheItem: aW3CacheItem 
	self isFull ifTrue: [self releaseFirstItem].
	cacheItems add: aW3CacheItem!

addVisualComponent: aVisualComponent for: item
	self isImagesFull
		ifTrue: [ self removeFirstVisualComponent].
	item visualComponent: aVisualComponent.
	totalVisuals := totalVisuals + 1.!

at: aHyperLink 
	^cacheItems detect: [:each | each link = aHyperLink]
		ifNone: nil!

atFile: aFilename
	^cacheItems detect: [:each | each filename = aFilename]
		ifNone: nil!

cacheItemFor: aHyperLink 
	"Return the cache Item in cacheItems. If not found, then create one."

	| item |
	item := self at: aHyperLink.
	item isNil
		ifTrue: 
			[item := WebCacheItem new link: aHyperLink.
			self addCacheItem: item].
	^item!

cacheItemForFile: aFilename 
	"Return the cache Item in cacheItems. If not found, then create one."

	| item |
	item := self atFile: aFilename.
	item isNil
		ifTrue: 
			[item := WebCacheItem new filename: aFilename.
			self addCacheItem: item].
	^item!

processCacheItem: aW3CacheItem
	|item|
	self at: aW3CacheItem link putFilename: aW3CacheItem filename.
	item := self at: aW3CacheItem link.
	aW3CacheItem copyTo: item.! !

!WebCache methodsFor: 'updating'!

update: anAspectSymbol with: anObject 
	anAspectSymbol == #builtVisualComponent
		ifTrue: 
			[| vc filename |
			filename := anObject at: 1.
			vc := anObject at: 2.
			self atFilename: filename putVisualComponent: vc].
	anAspectSymbol == #retrievedLink ifTrue: [self processCacheItem: anObject]! !

!WebCache methodsFor: 'printing'!

printOn: aStream
	cacheItems printOn: aStream! !

!WebCache methodsFor: 'accessing'!

at: aHyperLink putFilename: aFilename 
	| item |
	item := self cacheItemFor: aHyperLink.
	item filename = aFilename ifFalse: [ item releaseFilename].
	item filename: aFilename!

atFilename: aFilename putVisualComponent: aVisualComponent 
	| item |
	item := self atFile: aFilename.
	item isNil
		ifTrue: 
			[item := self cacheItemForFile: aFilename.
			self addVisualComponent: aVisualComponent for: item]
		ifFalse: 
			[item visualComponent isNil ifTrue: [totalVisuals := totalVisuals + 1].
			item visualComponent: aVisualComponent]!

clear
	cacheItems
		do: 
			[:each | 
			| file |
			file := each filename.
			file notNil ifTrue: [file delete]].
	self initialize!

filenameAtLink: aHyperLink 
	| item |
	item := self at: aHyperLink.
	item notNil ifTrue: [^item filename].
	^nil!

maxItems: anInteger
	maxItems := anInteger!

maxVisuals: anInteger
	maxVisuals := anInteger!

responseHeaderAtLink: aHyperLink 
	| item |
	item := self at: aHyperLink.
	item notNil ifTrue: [^item responseHeader].
	^nil!

totalItems
	^cacheItems size!

totalVisuals
	^totalVisuals!

visualComponentAtFile: aFilename 
	| item |
	item := self atFile: aFilename.
	item notNil ifTrue: [^item visualComponent].
	^nil!

visualComponentAtLink: aHyperLink 
	| item |
	item := self at: aHyperLink.
	item notNil ifTrue: [^item visualComponent].
	^nil! !

!WebCache methodsFor: 'initialize-release'!

initialize
	cacheItems := OrderedCollection new.
	self maxVisuals: 7.
	self maxItems: 20.
	totalVisuals := 0!

releaseFirstItem
	cacheItems size > 0 ifTrue: [self releaseItem: cacheItems removeFirst]!

releaseItem: aW3CacheItem 
	Transcript show: aW3CacheItem printString , ' removed from cache'.
	aW3CacheItem release!

removeFirstVisualComponent
	| item |
	item := cacheItems detect: [:each | each visualComponent notNil].
	item notNil
		ifTrue: 
			[
			Transcript show: item printString , ' visualcomponent removed from cache'.
			item visualComponent: nil.
			totalVisuals := totalVisuals - 1]! !

!WebCache methodsFor: 'testing'!

isFull
	^self totalItems >= maxItems!

isImagesFull
	^self totalVisuals >= maxVisuals! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

WebCache class
	instanceVariableNames: ''!


!WebCache class methodsFor: 'instance creation'!

new
	^super new initialize! !

Object subclass: #WebCacheItem
	instanceVariableNames: 'link filename visualComponent responseHeader '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!


!WebCacheItem methodsFor: 'accessing'!

filename
	^filename!

filename: aFilename
	filename := aFilename!

link
	^link!

link: aHyperLink
	link := aHyperLink!

responseHeader
	^responseHeader!

responseHeader: aResponseHeader
	responseHeader := aResponseHeader!

visualComponent
	^visualComponent!

visualComponent: aVisualComponent
	visualComponent := aVisualComponent! !

!WebCacheItem methodsFor: 'initialize-release'!

release
	self releaseFilename!

releaseFilename
	filename notNil ifTrue: [filename delete]! !

!WebCacheItem methodsFor: 'printing'!

printOn: aStream
	aStream nextPutAll: self class printString, '  '.
	link printOn: aStream! !

!WebCacheItem methodsFor: 'copying'!

copyTo: aW3CacheItem
	aW3CacheItem link: self link.
	aW3CacheItem filename: self filename.
	aW3CacheItem visualComponent: self visualComponent.
	aW3CacheItem responseHeader: self responseHeader.! !

Object subclass: #WebGUIAction
	instanceVariableNames: 'point visualComponent actionType '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
WebGUIAction comment:
'W3UserActionState keeps track of the useful information from a user''s action. Currently, it just keeps track of a click action. 

instance variables:
	point				<aPoint> The point where the user has clicked.
	visualComponent	<aContainer> The view where the user has clicked on.
	actionType			<aSymbol>	The type of action that the user does.'!


!WebGUIAction methodsFor: 'accessing'!

actionType
	^actionType!

actionType: aSymbol
	actionType := aSymbol!

point
	^point!

point: aPoint
	point := aPoint!

visualComponent
	^visualComponent!

visualComponent: aVisualComponent
	visualComponent := aVisualComponent! !

Object subclass: #TestModel
	instanceVariableNames: 'resolver '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
TestModel comment:
'This class is just a test model for a being dependent agent for a HyperApp. Modify the initialize method of NetFish and test me.'!


!TestModel methodsFor: 'private'!

defaultResolver
	^CharResolver new! !

!TestModel methodsFor: 'accessing'!

registerTo: aHypertextModel
	aHypertextModel registerSubscriber: self.
	aHypertextModel registerLinkResolver: resolver!

resolver
	resolver isNil ifTrue: [resolver := self defaultResolver].
	^resolver!

resolver: aLinkResolver
	resolver := aLinkResolver! !

!TestModel methodsFor: 'updating'!

update: anAspectSymbol with: aParameter 
	anAspectSymbol == resolver defaultAspectSymbol ifTrue: [DialogView warn: aParameter printString]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TestModel class
	instanceVariableNames: ''!


!TestModel class methodsFor: 'instance creation'!

resolver: aLinkResolver
	^self new resolver: aLinkResolver! !

Object subclass: #LinkHistorian
	instanceVariableNames: 'historyList currentPos aspect '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
LinkHistorian comment:
'I am an observer that keeps track of the access history list of NetFish. 
'!


!LinkHistorian methodsFor: 'initialize-release'!

initialize
	historyList := OrderedCollection new.
	currentPos := 0.! !

!LinkHistorian methodsFor: 'private'!

updateHistoryList: anObject 
	self current = anObject ifFalse: [self add: anObject]! !

!LinkHistorian methodsFor: 'updating'!

update: anAspectSymbol with: anObject
	anAspectSymbol == aspect ifTrue: [ self updateHistoryList: anObject ]! !

!LinkHistorian methodsFor: 'accessing'!

add: anObject
	historyList add: anObject.
	currentPos := historyList size.!

aspect: anAspectSymbol
	aspect := anAspectSymbol!

current
	historyList isEmpty ifTrue: [^nil].
	^historyList at: currentPos!

next
	historyList size  > currentPos
		ifTrue: 
			[currentPos := currentPos + 1.
			^historyList at: currentPos]
		ifFalse: [^nil]!

prev
	(historyList size > 1 and: [currentPos > 1])
		ifTrue: 
			[currentPos := currentPos - 1.
			^historyList at: currentPos]
		ifFalse: [^nil]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

LinkHistorian class
	instanceVariableNames: ''!


!LinkHistorian class methodsFor: 'instance creation'!

aspect: anAspectSymbol
	^self new aspect: anAspectSymbol!

new
	^super new initialize! !

ApplicationModel subclass: #NetFish
	instanceVariableNames: 'url model hyperView homepage historian '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
NetFish comment:
'NetFish inherits from ApplicationModel. Most of its codes are generated by the Canvas Tool of VisualWorks.  NetFish delegates all of its hypertext and Web related tasks to <A HREF="webclient.html">WebClient</A>, which is a subclass of HyperApp. NetFish also uses LinkHistorian to handle caching. The relationship between the LinkHistorian and NetFish matches the Memento pattern [ralph''s book] in which  NetFish is the originator, LinkHistorian is the caretaker, and UrlLink is the memento.

Instance Variables:
	url 			<URL>
	model 		<WebClient>
	hyperView 	<HyperView>
	homepage 	<String>
	historian 	<LinkHistorian>
'!


!NetFish methodsFor: 'actions'!

copy
	self url dependents first controller copy.!

cut
	self url dependents first controller cut.!

exit
	self closeRequest.
	model clearCache.!

fileIn
	(model cacheStreamFor: model currentLink) fileIn!

jumpToNextLink
	|link|
	link := historian next.
	link notNil ifTrue: [self updateLink: link]!

jumpToPrevLink
	| link |
	link := historian prev.
	link notNil ifTrue: [self updateLink: link]!

openUrl!

paste
	self url dependents first controller paste.!

setPreference
	^Dialog warn: 'Sorry. Not ready yet. '! !

!NetFish methodsFor: 'accessing'!

defaultView
	^HyperView new!

homepage: aString
	homepage := aString!

hypertextView
	hyperView isNil ifTrue: [ hyperView := self defaultView].
	^hyperView!

tmpDirName: aString 
	model tmpDirName: aString! !

!NetFish methodsFor: 'aspects'!

url
	"This method was generated by UIDefiner.  Any edits made here
	may be lost whenever methods are automatically defined.  The
	initialization provided below may have been preempted by an
	initialize method."

	^url isNil
		ifTrue:
			[url := String new asValue]
		ifFalse:
			[url]! !

!NetFish methodsFor: 'private'!

changedUrl
	| link |
	link := UrlLink urlString: self url value.
	model jumpTo: link!

defaultTmpDir
	^'/tmp/'.!

defaultUrl
	^'http://st-www.cs.uiuc.edu'!

updateLink: aHypertextLink 
	| currentUrl newUrl |
	currentUrl := self url value.
	newUrl := aHypertextLink printString.
	currentUrl = newUrl ifFalse: [self url value: newUrl.
								model jumpTo: aHypertextLink].!

updateUrl: aHypertextLink 
	| currentUrl newUrl |
	currentUrl := self url value.
	newUrl := aHypertextLink printString.
	currentUrl = newUrl ifFalse: [self url value: newUrl.].! !

!NetFish methodsFor: 'updating'!

update: aspectSymbol with: anObject
	aspectSymbol == #currentLink ifTrue: [  self updateUrl: anObject].! !

!NetFish methodsFor: 'initialize-release'!

initialize
	super initialize.
	historian := LinkHistorian aspect: #currentLink.
	model := WebClient new.
	model addDependent: self.
	model addDependent: historian.
	model tmpDirName: self defaultTmpDir.
	"(TestModel resolver: TextResolver new) registerTo: model.
	(TestModel resolver: CharResolver new) registerTo: model."
	self hypertextView model: model.
	model renderer view: self hypertextView! !

!NetFish methodsFor: 'interface opening'!

postBuildWith: aBuilder 
	aBuilder window damageRepairPolicy: (DoubleBufferingWindowDisplayPolicy new).
	homepage isNil ifTrue: [homepage := self defaultUrl].
	self url value: homepage.
	self changedUrl! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

NetFish class
	instanceVariableNames: ''!


!NetFish class methodsFor: 'interface specs'!

windowSpec
	"UIPainter new openOnClass: self andSelector: #windowSpec"

	<resource: #canvas>
	^#(#FullSpec 
		#window: 
		#(#WindowSpec 
			#label: 'NetFish' 
			#min: #(#Point 589 395 ) 
			#max: #(#Point 1024 875 ) 
			#bounds: #(#Rectangle 409 299 1039 885 ) 
			#flags: 4 
			#menu: #fileMenu ) 
		#component: 
		#(#SpecCollection 
			#collection: #(
				#(#InputFieldSpec 
					#layout: #(#Rectangle 92 16 592 40 ) 
					#model: #url 
					#callbacksSpec: 
					#(#UIEventCallbackSubSpec 
						#valueChangeSelector: #changedUrl ) 
					#tabable: false 
					#menu: #fileMenu 
					#style: #systemDefault ) 
				#(#LabelSpec 
					#layout: #(#Point 20 16 ) 
					#label: 'Location' ) 
				#(#ArbitraryComponentSpec 
					#layout: #(#LayoutFrame 0 0.026534 80 0 0 0.976783 0 0.972752 ) 
					#flags: 9 
					#component: #hypertextView ) 
				#(#ActionButtonSpec 
					#layout: #(#Rectangle 88 40 172 80 ) 
					#model: #jumpToNextLink 
					#label: 'Forward' 
					#defaultable: true ) 
				#(#ActionButtonSpec 
					#layout: #(#Rectangle 12 40 96 80 ) 
					#model: #jumpToPrevLink 
					#label: 'BackWard' 
					#defaultable: true ) 
				#(#ActionButtonSpec 
					#layout: #(#Rectangle 164 40 248 80 ) 
					#model: #fileIn 
					#label: 'FileIn' 
					#defaultable: true ) ) ) )! !

!NetFish class methodsFor: 'resources'!

fileMenu
	"UIMenuEditor new openOnClass: self andSelector: #fileMenu"

	<resource: #menu>
	^#(#Menu #(
			#(#MenuItem 
				#label: 'File' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#label: 'Exit' 
							#accessCharacterPosition: 2 ) ) #(1 ) #(#exit ) ) ) 
			#(#MenuItem 
				#label: 'Edit' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#label: 'cut' ) 
						#(#MenuItem 
							#label: 'copy' ) 
						#(#MenuItem 
							#label: 'paste' ) ) #(3 ) #(#cut #copy #paste ) ) ) 
			#(#MenuItem 
				#label: 'Navigate' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#label: 'Forward' ) 
						#(#MenuItem 
							#label: 'Backward' ) ) #(2 ) #(#jumpToNextLink #jumpToPrevLink ) ) ) 
			#(#MenuItem 
				#label: 'Options' 
				#submenu: #(#Menu #(
						#(#MenuItem 
							#label: 'Preference' ) ) #(1 ) #(#setPreference ) ) ) ) #(4 ) #(nil nil nil nil ) ) decodeAsLiteralArray! !

!NetFish class methodsFor: 'examples'!

example1
	"You need to modify the tmp directory.  Temporary files will be written in the temp directory you supply. These files are deleted when you exit Netfish through the File|exit menu. You may also want to use another 
homepage of your preference."
	"Other url you may want to try are
	file://.../somelocalfilename
	http://st-www.cs.uiuc.edu/users/mchung/mcheung05.gif
	http://st-www.cs.uiuc.edu/users/mchung/test.mchung"
	"NetFish example1"

	| browser |
	browser := NetFish new tmpDirName: '/tmp/'.
	browser homepage: 'http://st-www.cs.uiuc.edu/users/johnson/'.
	NetFish openOn: browser! !

ControllerWithMenu subclass: #WebController
	instanceVariableNames: 'command '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
WebController comment:
'I am the controller for  a Web browser.'!


!WebController methodsFor: 'basic control sequence'!

controlActivity
	| aSensor    |
	(aSensor := self sensor) redButtonPressed & self viewHasCursor
		ifTrue: 
			[command at: aSensor cursorPoint.
			command execute].
	super controlActivity!

controlInitialize
	super controlInitialize.
	command := model command.
	command view: view.! !

StreamManager subclass: #SMWeb
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
SMWeb comment:
'I am the StreamManager for WebClient.'!


!SMWeb methodsFor: 'updating'!

broadcastForCache: aResponseHeader 
	| item |
	item := WebCacheItem new.
	item link: self link; responseHeader: aResponseHeader; filename: self tmpFilename.
	self changed: #retrievedLink with: item!

update: anAspectSymbol with: aCollection
	anAspectSymbol == #builtVisualComponent ifTrue: [	
		self changed: #builtVisualComponent with: aCollection
	]! !

!SMWeb methodsFor: 'testing'!

isResponseOK: aResponseHeader 
	| c |
	c := aResponseHeader statusCode asNumber.
	^c > 199 or: [c < 400]! !

!SMWeb methodsFor: 'private'!

defaultHeader
	^ResponseHeaderBuilder new buildFrom: 'HTTP/1.0 200 OK
MIME-Version: 1.0
Content-Type: text
Content-Length: 1' readStream delimiters: Character cr asString!

determineEndOfLine: aBinaryStream 
	"Some server returns responseHeader with crlf as endofline but some uses cr. If there is a lf on the first line, then crlf is the endofline character, otherwise cr is used. Reset the stream after testing."

	|endOfLine|
	aBinaryStream skipThrough: Character lf asInteger.
	(aBinaryStream nextMatchFor: Character cr asInteger)
		ifTrue: [endOfLine := ByteArray with: (Character lf asInteger) with: (Character cr asInteger)]
		ifFalse: [endOfLine := ByteArray with: (Character lf asInteger)].
	aBinaryStream reset.
	^endOfLine!

getFilterFor: aTypeSymbol subType: aSubTypeSymbol
	^self class filterFor: aTypeSymbol and: aSubTypeSymbol!

getFilterFrom: aResponseHeader 
	| type subType |
	type := aResponseHeader mimeType.
	subType := aResponseHeader mimeSubType.
	^self getFilterFor: type subType: subType!

getResponseHeader: aBinaryStream 
	"Test the first few characters of the stream and determine the type of the 
	stream. If headers are present in the stream, then a responseHeader is 
	returned. The position of the stream is moved to the start of the body part."

	| string headerStream responseHeader |
	string := String new.
	string := (aBinaryStream nextAvailable: 5) asString.
	string = 'HTTP/'
		ifTrue: 
			[| endOfLine headerDelimiter |
			endOfLine := self determineEndOfLine: aBinaryStream.
			headerDelimiter := endOfLine , endOfLine.
			headerStream := (aBinaryStream throughAll: headerDelimiter) asString readStream.
			responseHeader := ResponseHeaderBuilder new buildFrom: headerStream delimiters: endOfLine asString]
		ifFalse: 
			[aBinaryStream reset.
			responseHeader := self tryMyBest].
	^responseHeader!

getViewerFor: aTypeSymbol subType: aSubTypeSymbol
	^self class viewerFor: aTypeSymbol and: aSubTypeSymbol!

getViewerFrom: aResponseHeader 
	| type subType |
	type := aResponseHeader mimeType.
	subType := aResponseHeader mimeSubType.
	^self getViewerFor: type subType: subType!

retrieveResponseHeaderFor: aHyperApp from: aBinaryStream
	| header |
	header := self getResponseHeader: aBinaryStream.
	model responseHeader: header.
	^header!

tryMyBest
	|r|
	r := cache responseHeaderAtLink: self link.
	r isNil ifTrue: [ r := self defaultHeader].
	^r! !

!SMWeb methodsFor: 'initialize-release'!

initFilter: aResponseHeader 
	"Assign a filter based on the MIME content type contained in aResponseHeader."

	| filter |
	filter := self getFilterFrom: aResponseHeader.
	filter notNil
		ifTrue: 
			[self tmpFilename: (model randomFile nextWithSuffix: '.' , aResponseHeader mimeSubType).
			filter tmpFilename: self tmpFilename.
			filter addDependent: self].
	^filter!

initViewer: aResponseHeader 
	| viewer |
	viewer := self getViewerFrom: aResponseHeader.
	viewer notNil
		ifTrue: 
			[self tmpFilename: (model randomFile nextWithSuffix: '.' , aResponseHeader mimeSubType).
			viewer addDependent: self].
	^viewer! !

!SMWeb methodsFor: 'accessing'!

cache
	^cache!

cache: aCache
	cache := aCache!

inputStream: aBinaryStream 
	| filter header viewer |
	header := self retrieveResponseHeaderFor: model from: aBinaryStream.
	(self isResponseOK: header)
		ifFalse: [^self putNilOutStream].	"filter isNil ifTrue: [^self putNilOutStream]."
	viewer := self initViewer: header.
	self spawn & viewer notNil
		ifTrue: [self view: aBinaryStream by: viewer]
		ifFalse: 
			[filter := self initFilter: header.
			self process: aBinaryStream by: filter].
	self broadcastForCache: header! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SMWeb class
	instanceVariableNames: ''!


!SMWeb class methodsFor: 'private'!

fillMap
	"Fill the content of TypeMap."

	|c|
	c :=#(
			#( #text #PlainTextFilter nil #(
					#(#html #HtmlParser nil #())
					#(#mchung #CodeFilter nil #())
				)
			)
			#( #image #BinaryFilter #ImageViewer #())
			).
	^self actionMapFor: c! !

!SMWeb class methodsFor: 'class initialization'!

initialize
	TypeMap := self fillMap! !

HyperApp subclass: #WebClient
	instanceVariableNames: 'optimizeFlag command streamMgr randomFileGenerator cache responseHeader '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NetFish-Model'!
WebClient comment:
'I am a model for a web browser.

Instance Variables:
	process 		<Process> The process that possibly is executing in the 								background.
	optimizeFlag 	<Boolean> mode of optimization.
	command		<Command> The current command that will be used by the controller. 
	tmpDir			<Filename>

'!


!WebClient methodsFor: 'initialize-release'!

addDefaultResolvers
	self registerLinkResolver: UrlResolver new!

initialize
	cache := WebCache new.
	super initialize.
	linkAccessor cache: cache.
	command := CmdClick new model: self.
	self optimize: true.
	streamMgr := self defaultStreamManager.
	self addDependent: cache! !

!WebClient methodsFor: 'cache accessing'!

cache
	cache isNil ifTrue: [cache := self defaultCache].
	^cache!

cacheStreamFor: aLink 
	|file|
	file := cache filenameAtLink: aLink.
	file isNil ifTrue: [^String new readStream].
	^file readStream!

cacheVisualComponentFor: aLink 
	^cache visualComponentAtLink: aLink!

clearCache
	self cache clear!

defaultCache
	^WebCache new! !

!WebClient methodsFor: 'accessing'!

command
	^command!

jumpTo: aHyperLink 
	"Setup all the steps for retrieving and parsing..."

	| parsedStream |
	super jumpTo: aHyperLink.
	streamMgr spawn: true; link: aHyperLink; inputStream: linkAccessor outputStream.
	parsedStream := streamMgr outputStream.
	parsedStream isNil
		ifTrue: [self handleEmptyStream]
		ifFalse: 
			[renderer inputStream: parsedStream.
			self changed: #currentLink with: aHyperLink]!

optimize: aBoolean 
	optimizeFlag := aBoolean.
	renderer optimize: aBoolean!

randomFile
	^randomFileGenerator!

responseHeader
	^responseHeader!

responseHeader: aResponseHeader
	responseHeader := aResponseHeader!

retrieve: aHypertextLink 
	"Retrieve the destination of the link and saved it in a tmp file. Return the 
	tmpFilename."

	| cacheFilename |
	cacheFilename := cache filenameAtLink: aHypertextLink.
	cacheFilename isNil
		ifTrue: 
			[linkAccessor get: aHypertextLink.
			streamMgr spawn: false; link: aHypertextLink; inputStream: linkAccessor outputStream.
			^streamMgr tmpFilename]
		ifFalse: [^cacheFilename]!

tmpDirName: aDirString 
	randomFileGenerator := RandomFile dirName: aDirString!

url: aString
	self jumpTo: aString!

visualComponentForFile: aFilename
	^cache visualComponentAtFile: aFilename! !

!WebClient methodsFor: 'private'!

componentsMap
	^componentsMap!

defaultLinkAccessor
	^LinkAccessor new cache: self cache!

defaultRenderer
	| r |
	r := HyperRenderer model: self styleSheet: (self class) defaultStyleSheet.
	r addDependent: cache.
	^r!

defaultStreamManager
	|s|
	s := SMWeb new model: self; cache: self cache.
	s addDependent: self cache.
	^s!

handleEmptyStream
	"responseHeader statusCode = '200' ifFalse: [Dialog warn: responseHeader firstLine]"!

optimize
	^optimizeFlag!

windowEvent: t1 from: t2 
	super windowEvent: t1 from: t2! !

!WebClient methodsFor: 'testing'!

isRelevant: aSymbol
	^aSymbol == #url! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

WebClient class
	instanceVariableNames: ''!


!WebClient class methodsFor: 'instance creation'!

new
	^super new initialize! !

!WebClient class methodsFor: 'class initialization'!

initialize

	^super initialize!

initStreamActionMap!

initStyleMap
	super initStyleMap.
	StyleMap at: #h1 emphasis: #veryLarge style: nil. 
	StyleMap at: #h2 emphasis:  #large  style: nil. 
	StyleMap at: #h3 emphasis: #large style: nil. 
	StyleMap at: #h4 emphasis: #large style: nil. 
	StyleMap at: #a emphasis: (Array with: (#color->ColorValue blue) with: #underline) style: nil. 
	StyleMap at: #li emphasis: (#color->ColorValue darkGreen) style: nil. 
	StyleMap at: #b emphasis: #bold style: nil. 

	StyleMap at: #em emphasis: #italic style: nil. 
	StyleMap at: #i emphasis:  #italic style: nil. 
	StyleMap at: #u emphasis: #underline style: nil. 
	StyleMap at: #strong emphasis: #bold style: nil. 
	StyleMap at: #dfn emphasis: #italic style: nil. 
	StyleMap at: #cite emphasis: #italic style: nil. 
	StyleMap at: #address emphasis: (Array with: (#color->ColorValue green) with: #italic) style: nil! !
WebClient initialize!

SMWeb initialize!