The Trunk: Collections-mt.629.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Collections-mt.629.mcz

commits-2
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.!


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Collections-mt.629.mcz

marcel.taeumel (old)
'Hello, World!' asTextFromHtml asMorph openInHand.

Best,
Marcel