[squeak-dev] The Trunk: Collections-topa.732.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 9 18:48:11 UTC 2017


Tobias Pape uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-topa.732.mcz

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

Name: Collections-topa.732
Author: topa
Time: 9 February 2017, 7:47:59.962131 pm
UUID: fd95461f-6d7f-4f24-b57a-dcc23e75cdb9
Ancestors: Collections-dtl.731

TextAttributes:
 - allow for attributes that should be treated as blocks
   even if they appear adajcent due to mixing with other attribues
  (Indent, Align, DoIt/PrintIt)
 - make DoIt/PrintIt _not_ appear Purple but just add underlining 
   to existing (mabye shout-generated) attributes.
 - let TextAction>>analyze: accept things like '3 > 4'. (Previously disallowed)
 - make DoIt/PrintIt be written AND read with HtmlReadWriter. 
   Convention for both ways: 
     - single-line DoIt/PrintIts are wrapped in '<code>...</code>'
     - multi-line DoIt/PrintIt are wrapped in
'<code>
<pre>..</pre></code>'
     - line-breaks within DoIt/PrintIt are not converted to '<br>' and vice versa.
HtmlReadWriter
 - emulates a WriteStream, so openHtmlOn: can be fed the HtmlReadWriter for configuration (eg, of line breaks).
 - honors the new blockish attributes.

Co-authored by Bert Freudenberg.

=============== Diff against Collections-dtl.731 ===============

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

Item was added:
+ ----- Method: HtmlReadWriter>>activateAttributesEnding:starting: (in category 'private') -----
+ activateAttributesEnding: ending starting: starting 
+ 
+ 	starting
+ 		select: [:attribute | attribute shouldFormBlocks]
+ 		thenDo: [: attribute |
+ 			(ending includes: attribute) ifFalse: [self writeStartTagFor: attribute]];
+ 		reject: [:attribute | attribute shouldFormBlocks]
+ 		thenDo: [: attribute | self writeStartTagFor: attribute].!

Item was added:
+ ----- Method: HtmlReadWriter>>breakLines (in category 'accessing') -----
+ breakLines
+ 
+ 	^ breakLines!

Item was added:
+ ----- Method: HtmlReadWriter>>breakLines: (in category 'accessing') -----
+ breakLines: aBoolean
+ 
+ 	breakLines := aBoolean!

Item was added:
+ ----- Method: HtmlReadWriter>>cr (in category 'stream emulation') -----
+ cr
+ 
+ 	self breakLines ifTrue: [stream nextPutAll: '<br>'].
+ 	^ stream cr!

Item was added:
+ ----- Method: HtmlReadWriter>>deactivateAttributesEnding:starting: (in category 'private') -----
+ deactivateAttributesEnding: ending starting: starting
+ 	
+ 	ending reversed
+ 		reject: [:attribute | attribute shouldFormBlocks]
+ 		thenDo: [: attribute | self writeEndTagFor: attribute];
+ 		select: [:attribute | attribute shouldFormBlocks]
+ 		thenDo: [: attribute |
+ 			(starting includes: attribute) ifFalse: [self writeEndTagFor: attribute]].!

Item was added:
+ ----- Method: HtmlReadWriter>>initialize (in category 'initialize-release') -----
+ initialize
+ 
+ 	super initialize.
+ 	self breakLines: true.!

Item was added:
+ ----- Method: HtmlReadWriter>>mapCloseCodeTag (in category 'mapping') -----
+ mapCloseCodeTag
+ 
+ 	| theDoIt |
+ 	theDoIt := runStack top first
+ 		detect: [:attribute | attribute isKindOf: TextDoIt]
+ 		ifNone: [^ self "nothing found, ignore"].
+ 	theDoIt evalString: (String withAll: (string copyFrom: runStack top second to: string size)).!

Item was added:
+ ----- Method: HtmlReadWriter>>mapCodeTag (in category 'mapping') -----
+ mapCodeTag
+ 
+ 	^ {TextDoIt new} "yet uninitialized"!

Item was changed:
  ----- 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: [^ self mapCodeTag].
+ 	aTag = '<pre>' ifTrue: [self breakLines: false. ^ {}].
- 	"aTag = '<code>' ifTrue: [^ {TextFontReference toFont: Preferences standardCodeFont}]."
  	(aTag beginsWith: '<font') ifTrue: [^ self mapFontTag: aTag].
  	(aTag beginsWith: '<a') ifTrue: [^ self mapATag: aTag].
  
  	"h1, h2, h3, ..."
  	(aTag second = $h and: [aTag third isDigit])
  		ifTrue: [^ {TextEmphasis bold}].
  
  	^ {}!

Item was added:
+ ----- Method: HtmlReadWriter>>nextPut: (in category 'stream emulation') -----
+ nextPut: aCharacter
+ 
+ 	^ stream nextPut: aCharacter!

Item was added:
+ ----- Method: HtmlReadWriter>>nextPutAll: (in category 'stream emulation') -----
+ nextPutAll: aCollection
+ 
+ 	^ stream nextPutAll: aCollection!

Item was changed:
  ----- Method: HtmlReadWriter>>nextPutText: (in category 'accessing') -----
  nextPutText: aText
  
+ 	| previous |
+ 	previous := #().
+ 	self activateAttributesEnding: #() starting: previous. "for consistency"
  	aText runs
  		withStartStopAndValueDo: [:start :stop :attributes | 
+ 			self
+ 				deactivateAttributesEnding: previous starting: attributes;
+ 				activateAttributesEnding: previous starting: attributes;
+ 				writeContent: (aText string copyFrom: start to: stop).
+ 			previous := attributes].
+ 	self deactivateAttributesEnding: previous starting: #().!
- 			| 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 changed:
  ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') -----
  processEndTag: aTag
  
+ 	| index tagName |
- 	| index |
  	index := count - offset.
+ 	tagName := aTag copyFrom: 3 to: aTag size - 1.
- 	
- 	(self ignoredTags includes: (aTag copyFrom: 3 to: aTag size -1))
- 		ifTrue: [^ self].
  
+ 	(self ignoredTags includes: tagName) ifTrue: [^ self].
+ 	tagName = 'code' ifTrue: [self mapCloseCodeTag].
+ 	tagName = 'pre' ifTrue: [self breakLines: true].
+ 
  	"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 changed:
  ----- Method: HtmlReadWriter>>processNextTag (in category 'reading') -----
  processNextTag
  
  	| tag htmlEscape lookForNewTag lookForHtmlEscape tagFound valid inComment inTagString |
  	lookForNewTag := true.
  	lookForHtmlEscape := false.
  	tagFound := false.
  	tag := OrderedCollection new.
  	htmlEscape := OrderedCollection new.
  	inComment := false.
  	inTagString := false.
  	
  	[stream atEnd not and: [tagFound not]] whileTrue: [
  		| character |
  		character := stream next.
  		valid := (#(10 13) includes: character asciiValue) not.
  		count := count + 1.
  	
  		character = $< ifTrue: [lookForNewTag := false].
  		character = $& ifTrue: [
  			inComment ifFalse: [lookForHtmlEscape := true]].
  		
  		lookForNewTag
  			ifTrue: [
  				lookForHtmlEscape
+ 					ifFalse: [
+ 						(valid or: [self breakLines not])
+ 							ifTrue: [string add: character]
+ 							ifFalse: [offset := offset + 1]]
- 					ifFalse: [valid ifTrue: [string add: character] ifFalse: [offset := offset + 1]]
  					ifTrue: [valid ifTrue: [htmlEscape add: character]. offset := offset + 1]]
  			ifFalse: [valid ifTrue: [tag add: character]. offset := offset + 1].
  
  		"Toggle within tag string/text."
  		(character = $" and: [lookForNewTag not])
  			ifTrue: [inTagString := inTagString not].
  		
  		inComment := ((lookForNewTag not and: [tag size >= 4])
  			and: [tag beginsWith: '<!!--'])
  			and: [(tag endsWith: '-->') not].
  
  		(((character = $> and: [inComment not]) and: [lookForNewTag not]) and: [inTagString not]) ifTrue: [
  			lookForNewTag := true.
  			(tag beginsWith: '<!!--')
  				ifTrue: [self processComment: (String withAll: tag)]
  				ifFalse: [tag second ~= $/
  					ifTrue: [
  						(tag atLast: 2) == $/
  							ifTrue: [self processEmptyTag: (String withAll: tag)]
  							ifFalse: [self processStartTag: (String withAll: tag)]]
  					ifFalse: [self processEndTag: (String withAll: tag)]].			
  			tagFound := true].
  
  		(((character = $; and: [lookForNewTag])
  			and: [htmlEscape notEmpty]) and: [htmlEscape first = $&]) ifTrue: [
  				lookForHtmlEscape := false.
  				self processHtmlEscape: (String withAll: htmlEscape).
  				htmlEscape := OrderedCollection new]].
  !

Item was changed:
  ----- Method: HtmlReadWriter>>writeContent: (in category 'writing') -----
  writeContent: aString
  
  	aString do: [:char |
  		(#(10 13) includes: char asciiValue)
+ 			ifTrue: [self cr]
- 			ifTrue: [stream nextPutAll: '<br>'; cr]
  			ifFalse: [char = Character tab
+ 				ifTrue: [self nextPutAll: '    ']
- 				ifTrue: [stream nextPutAll: '    ']
  				ifFalse: [(String htmlEntities keyAtValue: char ifAbsent: [])
+ 					ifNil: [self nextPut: char]
- 					ifNil: [stream nextPut: char]
  					ifNotNil: [:escapeSequence |
+ 						self
- 						stream
  							nextPut: $&;
  							nextPutAll: escapeSequence;
  							nextPut: $;]]]].!

Item was changed:
  ----- Method: HtmlReadWriter>>writeEndTagFor: (in category 'writing') -----
  writeEndTagFor: aTextAttribute
  
+ 	[aTextAttribute closeHtmlOn: self]
- 	[aTextAttribute closeHtmlOn: stream]
  		on: MessageNotUnderstood do: []!

Item was changed:
  ----- Method: HtmlReadWriter>>writeStartTagFor: (in category 'writing') -----
  writeStartTagFor: aTextAttribute
  
+ 	[aTextAttribute openHtmlOn: self]
- 	[aTextAttribute openHtmlOn: stream]
  		on: MessageNotUnderstood do: [].!

Item was changed:
  ----- Method: TextAction>>analyze: (in category 'as yet unclassified') -----
  analyze: aString
+ 	"Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection).  Does not return self!!.  May be multiline or of the form:
- 	"Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection).  Does not return self!!.  May be of the form:
  3+4
  <3+4>
  Click Here<3+4>
  <3+4>Click Here
  "
  	"Obtain the showing text and the instructions"
+ 	| b1 b2 singleLine trim param show |
- 	| b1 b2 trim param show |
  	b1 := aString indexOf: $<.
  	b2 := aString indexOf: $>.
+ 	singleLine := aString lineCount = 0.
+ 	(singleLine or: [(b1 < b2) & (b1 > 0)]) ifFalse: ["only one part"
- 	(b1 < b2) & (b1 > 0) ifFalse: ["only one part"
  		param := self validate: aString.
  		param ifNil: [ ^{ nil. nil } ].
+ 		^ Array with: param with: (param size = 0 ifFalse: [param])].
- 		^ Array with: param with: (param size = 0 ifTrue: [nil] ifFalse: [param])].
  	"Two parts"
  	trim := aString withBlanksTrimmed.
  	(trim at: 1) == $< 
  		ifTrue: [(trim last) == $>
  			ifTrue: ["only instructions" 
  				param := self validate: (aString copyFrom: b1+1 to: b2-1).
+ 				show := param size = 0 ifFalse: [param]]
- 				show := param size = 0 ifTrue: [nil] ifFalse: [param]]
  			ifFalse: ["at the front"
  				param := self validate: (aString copyFrom: b1+1 to: b2-1).
+ 				show := param size = 0 ifFalse: [aString copyFrom: b2+1 to: aString size]]]
- 				show := param size = 0 ifTrue: [nil] 
- 						ifFalse: [aString copyFrom: b2+1 to: aString size]]]
  		ifFalse: [(trim last) == $>
  			ifTrue: ["at the end"
  				param := self validate: (aString copyFrom: b1+1 to: b2-1).
+ 				show := param size = 0 ifFalse: [aString copyFrom: 1 to: b1-1]]
+ 			ifFalse: ["Arbitrary string. Let the compiler handle the complete string"
+ 				param := self validate: aString.
+ 				param ifNil: [ ^{ nil. nil }].
+ 				show := (param size = 0 ifFalse: [param])]].
- 				show := param size = 0 ifTrue: [nil] 
- 						ifFalse: [aString copyFrom: 1 to: b1-1]]
- 			ifFalse: ["Illegal -- <> has text on both sides"
- 				show := nil]].
  	^ Array with: param with: show
  !

Item was added:
+ ----- Method: TextAlignment>>shouldFormBlocks (in category 'as yet unclassified') -----
+ shouldFormBlocks
+ 	" whether this attribute should form larger blocks even if split up for combination with other attributes "
+ 	^ false!

Item was added:
+ ----- Method: TextAttribute>>shouldFormBlocks (in category 'html') -----
+ shouldFormBlocks
+ 	" whether this attribute should form larger blocks even if split up for combination with other attributes "
+ 	^ false!

Item was changed:
  ----- Method: TextDoIt>>analyze: (in category 'as yet unclassified') -----
  analyze: aString
  
  	| list |
  	list := super analyze: aString.
+ 	evalString := (list at: 1) asString.
- 	evalString := list at: 1.
  	^ list at: 2!

Item was added:
+ ----- Method: TextDoIt>>closeHtmlOn: (in category 'html') -----
+ closeHtmlOn: aStream 
+ 
+ 	self evalString lines size > 1 ifTrue: [
+ 		aStream 
+ 			breakLines: true;
+ 			nextPutAll: '</pre>'].
+ 	aStream nextPutAll: '</code>'.
+ !

Item was added:
+ ----- Method: TextDoIt>>emphasizeScanner: (in category 'as yet unclassified') -----
+ emphasizeScanner: scanner
+ 	scanner addEmphasis: 4!

Item was added:
+ ----- Method: TextDoIt>>openHtmlOn: (in category 'html') -----
+ openHtmlOn: aStream 
+ 
+ 	aStream nextPutAll: '<code>'.
+ 	self evalString lines size > 1 ifTrue: [
+ 		aStream 
+ 			breakLines: false;
+ 			cr; 
+ 			nextPutAll: '<pre>'].!

Item was added:
+ ----- Method: TextDoIt>>shouldFormBlocks (in category 'html') -----
+ shouldFormBlocks
+ 
+ 	^ true!

Item was added:
+ ----- Method: TextIndent>>shouldFormBlocks (in category 'nil') -----
+ shouldFormBlocks
+ 
+ 	^ true!



More information about the Squeak-dev mailing list