[Pkg] The Trunk: Collections-mt.629.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 3 15:58:11 UTC 2015


Marcel Taeumel uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-mt.629.mcz

==================== Summary ====================

Name: Collections-mt.629
Author: mt
Time: 3 May 2015, 5:57:18.046 pm
UUID: a8c03faf-7161-bf42-8143-7fd4833709e9
Ancestors: Collections-ul.628

Introduced a TextReadWriter (abstract) and a HtmlReadWriter (concrete) similar to ImageReadWriter. The goal is to convert foreign data into Squeak's text format.

Possible additions: RtfReadWriter, DocReadWriter, ...

=============== Diff against Collections-ul.628 ===============

Item was added:
+ TextReadWriter subclass: #HtmlReadWriter
+ 	instanceVariableNames: 'count offset runStack runArray string'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Text'!

Item was added:
+ ----- Method: HtmlReadWriter>>mapATag: (in category 'mapping') -----
+ mapATag: aTag
+ 
+ 	| result startIndex stopIndex attribute |
+ 	result := OrderedCollection new.
+ 	
+ 	"<a href=""http://google.de"">"
+ 	attribute := 'href'.
+ 	startIndex := aTag findString: attribute.
+ 	startIndex > 0 ifTrue: [
+ 		startIndex := aTag findString: '"' startingAt: startIndex+attribute size.
+ 		stopIndex := aTag findString: '"' startingAt: startIndex+1.
+ 		result add: (TextURL new url: (aTag copyFrom: startIndex+1 to: stopIndex-1))].
+ 		
+ 	^ result!

Item was added:
+ ----- Method: HtmlReadWriter>>mapFontTag: (in category 'mapping') -----
+ mapFontTag: aTag
+ 
+ 	| result colorStartIndex colorStopIndex attribute |
+ 	result := OrderedCollection new.
+ 	
+ 	"<font color=""#00FFCC"">"
+ 	attribute := 'color'.
+ 	colorStartIndex := aTag findString: attribute.
+ 	colorStartIndex > 0 ifTrue: [
+ 		colorStartIndex := aTag findString: '#' startingAt: colorStartIndex+attribute size.
+ 		colorStopIndex := aTag findString: '"' startingAt: colorStartIndex+1.
+ 		result add: (TextColor color:
+ 			(Color fromString: (aTag copyFrom: colorStartIndex to: colorStopIndex-1)))].
+ 	
+ 	^ result!

Item was added:
+ ----- Method: HtmlReadWriter>>mapTagToAttribute: (in category 'mapping') -----
+ mapTagToAttribute: aTag
+ 
+ 	aTag = '<b>' ifTrue: [^ {TextEmphasis bold}].
+ 	aTag = '<i>' ifTrue: [^ {TextEmphasis italic}].
+ 	aTag = '<u>' ifTrue: [^ {TextEmphasis underlined}].
+ 	"aTag = '<code>' ifTrue: [^ {TextFontReference toFont: Preferences standardCodeFont}]."
+ 	(aTag beginsWith: '<font') ifTrue: [^ self mapFontTag: aTag].
+ 	(aTag beginsWith: '<a') ifTrue: [^ self mapATag: aTag].
+ 
+ 	^ {}!

Item was added:
+ ----- Method: HtmlReadWriter>>nextPutText: (in category 'accessing') -----
+ nextPutText: aText
+ 
+ 	aText runs
+ 		withStartStopAndValueDo: [:start :stop :attributes | 
+ 			| att str | 
+ 			att := aText attributesAt: start.
+ 			str := aText string copyFrom: start to: stop.
+ 			
+ 			att do: [:each | self writeStartTagFor: each].
+ 			self writeContent: str.
+ 			att reverse do: [:each | self writeEndTagFor: each]]!

Item was added:
+ ----- Method: HtmlReadWriter>>nextText (in category 'accessing') -----
+ nextText
+ 
+ 	count := 0.
+ 	offset := 0. "To ignore characters in the input string that are used by tags."
+ 	
+ 	runStack := Stack new.
+ 	
+ 	runArray := RunArray new.
+ 	string := OrderedCollection new.
+ 	
+ 	"{text attributes. start index. end index. number of open tags}"
+ 	runStack push: {OrderedCollection new. 1. nil. 0}.
+ 
+ 	[stream atEnd] whileFalse: [self processNextTag].
+ 	self processRunStackTop. "Add last run."
+ 
+ 	string := String withAll: string.
+ 	
+ 	^ Text
+ 		string: string
+ 		runs: runArray!

Item was added:
+ ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') -----
+ processEndTag: aTag
+ 
+ 	| index |
+ 	index := count - offset.
+ 	
+ 	"De-Accumulate adjacent tags."
+ 	runStack top at: 4 put: runStack top fourth - 1.
+ 	runStack top fourth > 0
+ 		ifTrue: [^ self "not yet"].
+ 		
+ 	self processRunStackTop.
+ 
+ 	runStack pop.
+ 	runStack top at: 2 put: index + 1.!

Item was added:
+ ----- Method: HtmlReadWriter>>processNextTag (in category 'reading') -----
+ processNextTag
+ 
+ 	| tag lookForNewTag escapeNextCharacter tagFound |
+ 	lookForNewTag := true.
+ 	tagFound := false.
+ 	tag := OrderedCollection new.
+ 	escapeNextCharacter := false.
+ 	
+ 	[stream atEnd not and: [tagFound not]] whileTrue: [
+ 		| character |
+ 		character := stream next.
+ 		count := count + 1.
+ 	
+ 		escapeNextCharacter
+ 			ifTrue: [string add: character. escapeNextCharacter := false]
+ 			ifFalse: [
+ 				character = $\
+ 					ifTrue: [offset := offset + 1. escapeNextCharacter := true]
+ 					ifFalse: [
+ 						character = $< ifTrue: [lookForNewTag := false].
+ 						character = $> ifTrue: [lookForNewTag := true].
+ 		
+ 						(lookForNewTag and: [character ~= $>])
+ 							ifTrue: [string add: character]
+ 							ifFalse: [tag add: character. offset := offset + 1]..
+ 			
+ 						(tag notEmpty and: [tag last = $>]) ifTrue: [
+ 							"Full tag like <b> or </b> found."
+ 							tag second ~= $/
+ 								ifTrue: [self processStartTag: (String withAll: tag)]
+ 								ifFalse: [self processEndTag: (String withAll: tag)].			
+ 							tagFound := true]]]].
+ !

Item was added:
+ ----- Method: HtmlReadWriter>>processRunStackTop (in category 'reading') -----
+ processRunStackTop
+ 	"Write accumulated attributes to run array."
+ 	
+ 	| index start end attrs |
+ 	index := count - offset.
+ 	
+ 	"Set end index."
+ 	runStack top at: 3 put: index.
+ 	"Write to run array."
+ 	start := runStack top second.
+ 	end := runStack top third.
+ 	attrs := runStack top first.
+ 	runArray
+ 		addLast: attrs asArray
+ 		times: end - start + 1.!

Item was added:
+ ----- Method: HtmlReadWriter>>processStartTag: (in category 'reading') -----
+ processStartTag: aTag
+ 
+ 	| index |
+ 	index := count - offset.
+ 	
+ 	"Accumulate adjacent tags."
+ 	(runStack size > 1 and: [runStack top second = (index + 1) "= adjacent start tags"])
+ 		ifTrue: [
+ 			runStack top at: 1 put: (runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself).
+ 			runStack top at: 4 put: (runStack top fourth + 1). "increase number of open tags"
+ 			^self].
+ 	
+ 	self processRunStackTop.
+ 
+ 	"Remove start/end info to reuse attributes later."
+ 	runStack top at: 2 put: nil.
+ 	runStack top at: 3 put: nil.
+ 	"Copy attr list and add new attr."
+ 	runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1. nil. 1}).!

Item was added:
+ ----- Method: HtmlReadWriter>>writeContent: (in category 'writing') -----
+ writeContent: aString
+ 
+ 	| html |
+ 	html := aString.
+ 	""
+ 	html := html copyReplaceAll: '&' with: '&amp;'.
+ 	html := html copyReplaceAll: '>' with: '&gt;'.
+ 	html := html copyReplaceAll: '<' with: '&lt;'.
+ 	""
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¦Ö' with: '&aacute;'.
+ 	html := html copyReplaceAll: '¬¨¬Ž¬¨¬©' with: '&eacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ë' with: '&iacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ü' with: '&oacute;'.
+ 	html := html copyReplaceAll: '¬¨¬Ž¬¨¦š' with: '&uacute;'.
+ 	html := html copyReplaceAll: '¬¨¬Ž¬¨¬±' with: '&ntilde;'.
+ 	""
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¶¦±' with: '&Aacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¬¢' with: '&Eacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¶¦º' with: '&Iacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¬Æ' with: '&Oacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¦©' with: '&Uacute;'.
+ 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¬·' with: '&Ntilde;'.
+ 	""
+ 	html := html copyReplaceAll: '
+ ' with: '<br>
+ '.
+ 	html := html copyReplaceAll: '	' with: '&nbsp;&nbsp;&nbsp;&nbsp;'.
+ 	""
+ 	stream nextPutAll: html!

Item was added:
+ ----- Method: HtmlReadWriter>>writeEndTagFor: (in category 'writing') -----
+ writeEndTagFor: aTextAttribute
+ 
+ 	aTextAttribute closeHtmlOn: stream.!

Item was added:
+ ----- Method: HtmlReadWriter>>writeStartTagFor: (in category 'writing') -----
+ writeStartTagFor: aTextAttribute
+ 
+ 	aTextAttribute openHtmlOn: stream.!

Item was added:
+ ----- Method: String>>asTextFromHtml (in category 'converting') -----
+ asTextFromHtml
+ 	"Answer a Text by interpreting the receiver as HTML."
+ 
+ 	^ (HtmlReadWriter on: self readStream) nextText!

Item was added:
+ ----- Method: Text>>asStringToHtml (in category 'converting') -----
+ asStringToHtml
+ 	"Inverse to String >> #asTextFromHtml"
+ 	
+ 	^ self printHtmlString!

Item was removed:
- ----- Method: Text>>closeHtmlAttributes:on: (in category 'html') -----
- closeHtmlAttributes: anArray on: aStream 
- 	anArray
- 		do: [:each | each closeHtmlOn: aStream].!

Item was removed:
- ----- Method: Text>>openHtmlAttributes:on: (in category 'html') -----
- openHtmlAttributes: anArray on: aStream 
- 	anArray
- 		do: [:each | each openHtmlOn: aStream ]!

Item was changed:
  ----- Method: Text>>printHtmlOn: (in category 'html') -----
  printHtmlOn: aStream 
+ 	
+ 	(HtmlReadWriter on: aStream)
+ 		nextPutText: self.!
- 	self runs
- 		withStartStopAndValueDo: [:start :stop :attributes | 
- 			| att str | 
- 			att := self attributesAt: start.
- 			str := self string copyFrom: start to: stop.
- 			""
- 			self openHtmlAttributes: att on: aStream.
- 			self printStringHtml: str on: aStream.
- 
- 			self closeHtmlAttributes: att on: aStream]!

Item was changed:
  ----- Method: Text>>printHtmlString (in category 'html') -----
  printHtmlString
  	"answer a string whose characters are the html representation 
  	of the receiver"
+ 	
+ 	^ String streamContents: [:stream |
+ 		self printHtmlOn: stream]!
- 	| html |
- 	html := String new writeStream.
- 	self printHtmlOn: html.
- 	^ html contents!

Item was removed:
- ----- Method: Text>>printStringHtml:on: (in category 'html') -----
- printStringHtml: aString on: aStream 
- 	| html |
- 	html := aString.
- 	""
- 	html := html copyReplaceAll: '&' with: '&amp;'.
- 	html := html copyReplaceAll: '>' with: '&gt;'.
- 	html := html copyReplaceAll: '<' with: '&lt;'.
- 	""
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¦Ö' with: '&aacute;'.
- 	html := html copyReplaceAll: '¬¨¬Ž¬¨¬©' with: '&eacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ë' with: '&iacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ü' with: '&oacute;'.
- 	html := html copyReplaceAll: '¬¨¬Ž¬¨¦š' with: '&uacute;'.
- 	html := html copyReplaceAll: '¬¨¬Ž¬¨¬±' with: '&ntilde;'.
- 	""
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¶¦±' with: '&Aacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¬¢' with: '&Eacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¶¦º' with: '&Iacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¬Æ' with: '&Oacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¦©' with: '&Uacute;'.
- 	html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬Ž¬¨¬·' with: '&Ntilde;'.
- 	""
- 	html := html copyReplaceAll: '
- ' with: '<br>
- '.
- 	html := html copyReplaceAll: '	' with: '&nbsp;&nbsp;&nbsp;&nbsp;'.
- 	""
- 	aStream nextPutAll: html!

Item was added:
+ Object subclass: #TextReadWriter
+ 	instanceVariableNames: 'stream'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Text'!

Item was added:
+ ----- Method: TextReadWriter class>>on: (in category 'instance creation') -----
+ on: stream
+ 
+ 	^ self new on: stream!

Item was added:
+ ----- Method: TextReadWriter>>nextPutText: (in category 'accessing') -----
+ nextPutText: aText
+ 	"Encoding aText on stream."
+ 	
+ 	self subclassResponsibility.!

Item was added:
+ ----- Method: TextReadWriter>>nextText (in category 'accessing') -----
+ nextText
+ 	"Decoding a text object on stream and answer that text object."
+ 	
+ 	^ self subclassResponsibility.!

Item was added:
+ ----- Method: TextReadWriter>>on: (in category 'initialize-release') -----
+ on: aStream
+ 
+ 	stream := aStream.!



More information about the Packages mailing list