The Trunk: Collections-mt.629.mcz
Locked
 
|
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: '&'. + html := html copyReplaceAll: '>' with: '>'. + html := html copyReplaceAll: '<' with: '<'. + "" + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¦Ö' with: 'á'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¬©' with: 'é'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ë' with: 'í'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ü' with: 'ó'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¬ö' with: 'ú'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¬±' with: 'ñ'. + "" + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¶¦±' with: 'Á'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬¢' with: 'É'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¶¦º' with: 'Í'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬Æ' with: 'Ó'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¦©' with: 'Ú'. + html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬·' with: 'Ñ'. + "" + html := html copyReplaceAll: ' + ' with: '<br> + '. + html := html copyReplaceAll: ' ' with: ' '. + "" + 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: '&'. - html := html copyReplaceAll: '>' with: '>'. - html := html copyReplaceAll: '<' with: '<'. - "" - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¦Ö' with: 'á'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¬©' with: 'é'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ë' with: 'í'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¦ü' with: 'ó'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¶¬ö' with: 'ú'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬®¬¨¬±' with: 'ñ'. - "" - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¶¦±' with: 'Á'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬¢' with: 'É'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¶¦º' with: 'Í'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬Æ' with: 'Ó'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¦©' with: 'Ú'. - html := html copyReplaceAll: '¬¨¬®¬¨¬é¬¨¬¬¨¬·' with: 'Ñ'. - "" - html := html copyReplaceAll: ' - ' with: '<br> - '. - html := html copyReplaceAll: ' ' with: ' '. - "" - 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.! |
Re: The Trunk: Collections-mt.629.mcz
|
'Hello, World!' asTextFromHtml asMorph openInHand.
Best, Marcel |
«
Return to Squeak - Dev
|
1 view|%1 views
| Free forum by Nabble | Edit this page |