[squeak-dev] The Inbox: Collections-dtl.556.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jan 2 20:55:04 UTC 2014


David T. Lewis uploaded a new version of Collections to project The Inbox:
http://source.squeak.org/inbox/Collections-dtl.556.mcz

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

Name: Collections-dtl.556
Author: dtl
Time: 2 January 2014, 3:54:39.379 pm
UUID: c115b70b-d18c-4f60-b218-2f48af79d653
Ancestors: Collections-fbs.555

Simplify RunArray class>>scanFrom: by arranging for TextAttribute to create the appropriate instance. Remove explicit references to TextAttribute subclasses from RunArray.

TextSqkProjectLink is a text attribute that controls project entry and is thus associated with Project.. Move it from Collections-Text to System-Support.

=============== Diff against Collections-fbs.555 ===============

Item was changed:
+ ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'event handling') -----
- ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'clicking') -----
  actOnClickFor: anObject
  	evalBlock ifNil: [ ^self ].
  	evalBlock numArgs = 0 ifTrue: [ evalBlock value.  ^true ].
  	evalBlock numArgs = 1 ifTrue: [ evalBlock value: anObject.  ^true ].
  	self error: 'evalBlock should have 0 or 1 arguments'!

Item was changed:
  ----- Method: RunArray class>>scanFrom: (in category 'instance creation') -----
  scanFrom: strm
  	"Read the style section of a fileOut or sources file.  nextChunk has already been done.  We need to return a RunArray of TextAttributes of various kinds.  These are written by the implementors of writeScanOn:"
  	| runs values attrList char |
  	(strm peekFor: $( ) ifFalse: [^ nil].
  	runs := OrderedCollection new.
  	[strm skipSeparators.
  	 strm peekFor: $)] whileFalse: 
  		[runs add: (Number readFrom: strm)].
  	values := OrderedCollection new.	"Value array"
  	attrList := OrderedCollection new.	"Attributes list"
+ 	[(char := strm peek) == nil] whileFalse: [
+ 		char isSeparator
+ 			ifTrue: [strm next "space, cr do nothing"]
+ 			ifFalse: [char == $,
+ 					ifTrue: [strm next.
+ 						values add: attrList asArray.
+ 						attrList := OrderedCollection new]
+ 					ifFalse: [attrList add:  (TextAttribute newFrom: strm)]
+ 				]
- 	[(char := strm next) == nil] whileFalse: [
- 		char == $, ifTrue: [values add: attrList asArray.  attrList := OrderedCollection new].
- 		char == $a ifTrue: [attrList add: 
- 			(TextAlignment new alignment: (Integer readFrom: strm ifFail: [0]))].
- 		char == $f ifTrue: [attrList add: 
- 			(TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0]))].
- 		char == $F ifTrue: [attrList add: (TextFontReference toFont: 
- 			(StrikeFont familyName: (strm upTo: $#) size: (Integer readFrom: strm ifFail: [0])))].
- 		char == $b ifTrue: [attrList add: (TextEmphasis bold)].
- 		char == $i ifTrue: [attrList add: (TextEmphasis italic)].
- 		char == $u ifTrue: [attrList add: (TextEmphasis underlined)].
- 		char == $= ifTrue: [attrList add: (TextEmphasis struckOut)].
- 		char == $n ifTrue: [attrList add: (TextEmphasis normal)].
- 		char == $- ifTrue: [attrList add: (TextKern kern: -1)].
- 		char == $+ ifTrue: [attrList add: (TextKern kern: 1)].
- 		char == $c ifTrue: [attrList add: (TextColor scanFrom: strm)]. "color"
- 		char == $L ifTrue: [attrList add: (TextLink scanFrom: strm)].	"L not look like 1"
- 		char == $R ifTrue: [attrList add: (TextURL scanFrom: strm)].
- 				"R capitalized so it can follow a number"
- 		char == $q ifTrue: [attrList add: (TextSqkPageLink scanFrom: strm)].
- 		char == $p ifTrue: [attrList add: (TextSqkProjectLink scanFrom: strm)].
- 		char == $P ifTrue: [attrList add: (TextPrintIt scanFrom: strm)].
- 		char == $d ifTrue: [attrList add: (TextDoIt scanFrom: strm)].
- 		"space, cr do nothing"
  		].
  	values add: attrList asArray.
  	^ self runs: runs asArray values: (values copyFrom: 1 to: runs size) asArray
  "
  RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i')
  "!

Item was added:
+ ----- Method: TextAlignment class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$a!

Item was added:
+ ----- Method: TextAlignment class>>scanFrom: (in category 'fileIn/Out') -----
+ scanFrom: strm
+ 	^self new alignment: (Integer readFrom: strm ifFail: [0])!

Item was changed:
+ ----- Method: TextAlignment>>= (in category 'comparing') -----
- ----- Method: TextAlignment>>= (in category 'as yet unclassified') -----
  = other 
  	^ (other class == self class) 
  		and: [other alignment = alignment]!

Item was changed:
+ ----- Method: TextAlignment>>alignment (in category 'accessing') -----
- ----- Method: TextAlignment>>alignment (in category 'as yet unclassified') -----
  alignment
  	^alignment!

Item was changed:
+ ----- Method: TextAlignment>>alignment: (in category 'accessing') -----
- ----- Method: TextAlignment>>alignment: (in category 'as yet unclassified') -----
  alignment: aNumber
  	alignment := aNumber.!

Item was changed:
+ ----- Method: TextAlignment>>hash (in category 'comparing') -----
- ----- Method: TextAlignment>>hash (in category 'as yet unclassified') -----
  hash
  	"#hash is re-implemented because #= is re-implemented"
  	^ alignment hash!

Item was changed:
+ ----- Method: TextAlignment>>writeScanOn: (in category 'scanning') -----
- ----- Method: TextAlignment>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
+ 	strm nextPut: self class scanCharacter.
- 	strm nextPut: $a.
  	alignment printOn: strm.!

Item was added:
+ ----- Method: TextAttribute class>>classFor: (in category 'fileIn/Out') -----
+ classFor: scanCharacter
+ 	"Answer the class that uses scanCharacter to identify itself in a text fileout" 
+ 	^ self allSubclasses detect: [:cls | cls scanCharacters includes: scanCharacter]
+ !

Item was added:
+ ----- Method: TextAttribute class>>consumeIdentifierFrom: (in category 'fileIn/Out') -----
+ consumeIdentifierFrom: scanStream.
+ 	"When scanning, a subclass may require access to the identifier character.
+ 	Otherwise, consume it here."
+ 	scanStream next!

Item was added:
+ ----- Method: TextAttribute class>>newFrom: (in category 'instance creation') -----
+ newFrom: scanStream
+ 	"scanStream contains a class identifier character possibly followed by data"
+ 	| cls |
+ 	cls := self classFor: scanStream peek.
+ 	cls consumeIdentifierFrom: scanStream.
+ 	^cls scanFrom: scanStream!

Item was added:
+ ----- Method: TextAttribute class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^nil!

Item was added:
+ ----- Method: TextAttribute class>>scanCharacters (in category 'fileIn/Out') -----
+ scanCharacters
+ 	"All scan characters corresponding to the given class. Usually this is an array of one."
+ 	^Array with: self scanCharacter!

Item was added:
+ ----- Method: TextColor class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$c!

Item was changed:
+ ----- Method: TextColor class>>scanFrom: (in category 'fileIn/Out') -----
- ----- Method: TextColor class>>scanFrom: (in category 'instance creation') -----
  scanFrom: strm
  	"read a color in the funny format used by Text styles on files. c125000255 or cblue;"
  
  	| r g b |
  	strm peek isDigit
  		ifTrue:
  			[r := (strm next: 3) asNumber.
  			g := (strm next: 3) asNumber.
  			b := (strm next: 3) asNumber.
  			^ self color: (Color r: r g: g b: b range: 255)].
  	"A name of a color"
  	^ self color: (Color perform: (strm upTo: $;) asSymbol)!

Item was changed:
  ----- Method: TextColor>>writeScanOn: (in category 'scanning') -----
  writeScanOn: strm
  	"Two formats.  c125000255 or cblue;"
  
  	| nn |
+ 	strm nextPut: self class scanCharacter.
- 	strm nextPut: $c.
  	(nn := color name) ifNotNil: [
  		(self class respondsTo: nn) ifTrue: [
  			^ strm nextPutAll: nn; nextPut: $;]].
  	(Array with: color red with: color green with: color blue) do: [:float |
  		| str |
  		str := '000', (float * 255) asInteger printString.
  		strm nextPutAll: (str copyFrom: str size-2 to: str size)]!

Item was changed:
+ ----- Method: TextDoIt class>>evalString: (in category 'instance creation') -----
- ----- Method: TextDoIt class>>evalString: (in category 'as yet unclassified') -----
  evalString: str
  	^ self new evalString: str!

Item was added:
+ ----- Method: TextDoIt class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$d!

Item was changed:
+ ----- Method: TextDoIt class>>scanFrom: (in category 'fileIn/Out') -----
- ----- Method: TextDoIt class>>scanFrom: (in category 'as yet unclassified') -----
  scanFrom: strm
  	"read a doit in the funny format used by Text styles on files. d10 factorial;;  end with two semicolons"
  
  	| pos end doit |
  	pos := strm position.
  	[strm skipTo: $;. strm peek == $;] whileFalse.
  	end := strm position - 1.
  	strm position: pos.
  	doit := strm next: end-pos.
  	strm skip: 2.  ";;"
  	^ self evalString: doit!

Item was added:
+ ----- Method: TextDoIt>>= (in category 'comparing') -----
+ = textAttribute
+ 	^ textAttribute class == self class
+ 		and: [textAttribute evalString = evalString]!

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

Item was changed:
+ ----- Method: TextDoIt>>evalString: (in category 'accessing') -----
- ----- Method: TextDoIt>>evalString: (in category 'as yet unclassified') -----
  evalString: str
  	evalString := str !

Item was added:
+ ----- Method: TextDoIt>>hash (in category 'comparing') -----
+ hash
+ 	^evalString hash!

Item was changed:
  ----- Method: TextDoIt>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
+ 	strm nextPut: self class scanCharacter; nextPutAll: evalString; nextPutAll: ';;'!
- 	strm nextPut: $d; nextPutAll: evalString; nextPutAll: ';;'!

Item was changed:
+ ----- Method: TextEmphasis class>>bold (in category 'instance creation') -----
- ----- Method: TextEmphasis class>>bold (in category 'as yet unclassified') -----
  bold
  	^ self new emphasisCode: 1!

Item was added:
+ ----- Method: TextEmphasis class>>consumeIdentifierFrom: (in category 'fileIn/Out') -----
+ consumeIdentifierFrom: scanStream.
+ 	"Do not consume the identifier character. Leave it in the stream
+ 	for use in identifying the type of emphasis."
+ !

Item was changed:
+ ----- Method: TextEmphasis class>>italic (in category 'instance creation') -----
- ----- Method: TextEmphasis class>>italic (in category 'as yet unclassified') -----
  italic
  	^ self new emphasisCode: 2!

Item was changed:
+ ----- Method: TextEmphasis class>>narrow (in category 'instance creation') -----
- ----- Method: TextEmphasis class>>narrow (in category 'as yet unclassified') -----
  narrow
  	^ TextKern kern: -1!

Item was changed:
+ ----- Method: TextEmphasis class>>normal (in category 'instance creation') -----
- ----- Method: TextEmphasis class>>normal (in category 'as yet unclassified') -----
  normal
  	^ self new emphasisCode: 0!

Item was added:
+ ----- Method: TextEmphasis class>>scanCharacters (in category 'fileIn/Out') -----
+ scanCharacters
+ 	"All scan characters corresponding to this class. See writeScanOn:"
+ 	^ #( $b $i $n $= $u )!

Item was added:
+ ----- Method: TextEmphasis class>>scanFrom: (in category 'fileIn/Out') -----
+ scanFrom: strm
+ 	^strm next
+ 		caseOf: {
+ 			[ $b ] -> [ self bold ] .	
+ 			[ $i ] -> [ self italic ] .	
+ 			[ $u ] -> [ self underlined ] .	
+ 			[ $= ] -> [ self struckOut ] .	
+ 			[ $n ] -> [ self normal ]
+ 		}
+ 		otherwise: [self error: 'unrecognized identifier ']!

Item was changed:
+ ----- Method: TextEmphasis class>>struckOut (in category 'instance creation') -----
- ----- Method: TextEmphasis class>>struckOut (in category 'as yet unclassified') -----
  struckOut
  	^ self new emphasisCode: 16!

Item was changed:
+ ----- Method: TextEmphasis class>>underlined (in category 'instance creation') -----
- ----- Method: TextEmphasis class>>underlined (in category 'as yet unclassified') -----
  underlined
  	^ self new emphasisCode: 4!

Item was changed:
+ ----- Method: TextFontChange class>>defaultFontChange (in category 'instance creation') -----
- ----- Method: TextFontChange class>>defaultFontChange (in category 'as yet unclassified') -----
  defaultFontChange
  	"Answer a TextFontChange that represents the default font"
  
  	^ self new fontNumber: TextStyle default defaultFontIndex!

Item was changed:
+ ----- Method: TextFontChange class>>font1 (in category 'instance creation') -----
- ----- Method: TextFontChange class>>font1 (in category 'as yet unclassified') -----
  font1
  	^ self new fontNumber: 1!

Item was changed:
+ ----- Method: TextFontChange class>>font2 (in category 'instance creation') -----
- ----- Method: TextFontChange class>>font2 (in category 'as yet unclassified') -----
  font2
  	^ self new fontNumber: 2!

Item was changed:
+ ----- Method: TextFontChange class>>font3 (in category 'instance creation') -----
- ----- Method: TextFontChange class>>font3 (in category 'as yet unclassified') -----
  font3
  	^ self new fontNumber: 3!

Item was changed:
+ ----- Method: TextFontChange class>>font4 (in category 'instance creation') -----
- ----- Method: TextFontChange class>>font4 (in category 'as yet unclassified') -----
  font4
  	^ self new fontNumber: 4!

Item was changed:
+ ----- Method: TextFontChange class>>fontNumber: (in category 'instance creation') -----
- ----- Method: TextFontChange class>>fontNumber: (in category 'as yet unclassified') -----
  fontNumber: n
  	^ self new fontNumber: n!

Item was added:
+ ----- Method: TextFontChange class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$f!

Item was added:
+ ----- Method: TextFontChange class>>scanFrom: (in category 'fileIn/Out') -----
+ scanFrom: strm
+ 	^self fontNumber: (Integer readFrom: strm ifFail: [0])!

Item was changed:
  ----- Method: TextFontChange>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
+ 	strm nextPut: self class scanCharacter.
- 	strm nextPut: $f.
  	fontNumber printOn: strm.!

Item was added:
+ ----- Method: TextFontReference class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$F!

Item was added:
+ ----- Method: TextFontReference class>>scanFrom: (in category 'fileIn/Out') -----
+ scanFrom: strm
+ 	^self toFont: 
+ 		(StrikeFont familyName: (strm upTo: $#) size: (Integer readFrom: strm ifFail: [0]))!

Item was changed:
  ----- Method: TextFontReference>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
+ 	strm nextPut: self class scanCharacter.
- 	strm nextPut: $F.
  	strm nextPutAll: font familyName; nextPut: $#.
  	font height printOn: strm.!

Item was added:
+ ----- Method: TextKern class>>consumeIdentifierFrom: (in category 'fileIn/Out') -----
+ consumeIdentifierFrom: scanStream.
+ 	"Do not consume the identifier character. Leave it in the stream
+ 	for use in identifying the kern value."
+ !

Item was changed:
+ ----- Method: TextKern class>>kern: (in category 'instance creation') -----
- ----- Method: TextKern class>>kern: (in category 'as yet unclassified') -----
  kern: kernValue
  	^ self new kern: kernValue!

Item was added:
+ ----- Method: TextKern class>>scanCharacters (in category 'fileIn/Out') -----
+ scanCharacters
+ 	"All scan characters corresponding to this class. See writeScanOn:"
+ 	^ #( $- $+ )!

Item was added:
+ ----- Method: TextKern class>>scanFrom: (in category 'fileIn/Out') -----
+ scanFrom: strm
+ 	| char k |
+ 	char := strm next.
+ 	char = $+
+ 		ifTrue: [
+ 			k := 1.
+ 			[strm atEnd not and: [strm peek = char]]
+ 				whileTrue: [strm next. k := k + 1].
+ 			^ self kern: k].
+ 	char = $-
+ 		ifTrue: [
+ 			k := -1.
+ 			[strm atEnd not and: [strm peek = char]]
+ 				whileTrue: [strm next. k := k - 1].
+ 			^ self kern: k].
+ 	self error: 'invalid identifier character'
+ 			
+ 	
+ !

Item was changed:
+ ----- Method: TextKern>>= (in category 'comparing') -----
- ----- Method: TextKern>>= (in category 'as yet unclassified') -----
  = other 
  	^ (other class == self class) 
  		and: [other kern = kern]!

Item was changed:
+ ----- Method: TextKern>>couldDeriveFromPrettyPrinting (in category 'testing') -----
- ----- Method: TextKern>>couldDeriveFromPrettyPrinting (in category 'as yet unclassified') -----
  couldDeriveFromPrettyPrinting
  	^ false!

Item was changed:
+ ----- Method: TextKern>>dominatedByCmd0 (in category 'testing') -----
- ----- Method: TextKern>>dominatedByCmd0 (in category 'as yet unclassified') -----
  dominatedByCmd0
  	"Cmd-0 should turn off kerning"
  	^ true!

Item was changed:
+ ----- Method: TextKern>>dominates: (in category 'testing') -----
- ----- Method: TextKern>>dominates: (in category 'as yet unclassified') -----
  dominates: other
  	"NOTE: The use of active in this code is specific to its use in the method
  		Text class addAttribute: att toArray: others"
  	(active and: [other class == self class and: [other kern + kern = 0]])
  		ifTrue: [active := false.  ^ true].  "can only dominate once"
  	^ false!

Item was changed:
+ ----- Method: TextKern>>emphasizeScanner: (in category 'kerning') -----
- ----- Method: TextKern>>emphasizeScanner: (in category 'as yet unclassified') -----
  emphasizeScanner: scanner
  	"Augment (or diminish) the kerning offset for text display"
  	scanner addKern: kern!

Item was changed:
+ ----- Method: TextKern>>hash (in category 'comparing') -----
- ----- Method: TextKern>>hash (in category 'as yet unclassified') -----
  hash
  	"#hash is re-implemented because #= is re-implemented"
  	^kern hash!

Item was changed:
+ ----- Method: TextKern>>kern (in category 'accessing') -----
- ----- Method: TextKern>>kern (in category 'as yet unclassified') -----
  kern
  	^ kern!

Item was changed:
+ ----- Method: TextKern>>kern: (in category 'initialize-release') -----
- ----- Method: TextKern>>kern: (in category 'as yet unclassified') -----
  kern: kernValue
  	kern := kernValue.
  	self reset.!

Item was changed:
+ ----- Method: TextKern>>reset (in category 'initialize-release') -----
- ----- Method: TextKern>>reset (in category 'as yet unclassified') -----
  reset
  	active := true!

Item was changed:
+ ----- Method: TextKern>>set (in category 'initialize-release') -----
- ----- Method: TextKern>>set (in category 'as yet unclassified') -----
  set
  	^ active!

Item was changed:
+ ----- Method: TextKern>>writeScanOn: (in category 'scanning') -----
- ----- Method: TextKern>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
  	kern > 0 ifTrue: [
  		1 to: kern do: [:kk | strm nextPut: $+]].
  	kern < 0 ifTrue: [
  		1 to: 0-kern do: [:kk | strm nextPut: $-]].!

Item was added:
+ ----- Method: TextLink class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$L!

Item was changed:
+ ----- Method: TextLink class>>scanFrom: (in category 'fileIn/Out') -----
- ----- Method: TextLink class>>scanFrom: (in category 'as yet unclassified') -----
  scanFrom: strm
  	"read a link in the funny format used by Text styles on files. LPoint +;LPoint Comment;"
  
  	^ self new classAndMethod: (strm upTo: $;)!

Item was added:
+ ----- Method: TextLink>>= (in category 'comparing') -----
+ = other 
+ 	^ (other class == self class) 
+ 		and: [other info = self info]!

Item was changed:
+ ----- Method: TextLink>>actOnClickFor: (in category 'event handling') -----
- ----- Method: TextLink>>actOnClickFor: (in category 'as yet unclassified') -----
  actOnClickFor: aMessageSet
  	"Add to the end of the list.  'aClass selector', 'aClass Comment', 'aClass Definition', 'aClass Hierarchy' are the formats allowed."
  
  	aMessageSet addItem: classAndMethod.
  	^ true!

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

Item was changed:
+ ----- Method: TextLink>>analyze:with: (in category 'initialize-release') -----
- ----- Method: TextLink>>analyze:with: (in category 'as yet unclassified') -----
  analyze: aString with: nonMethod
  	"Initalize this attribute holder with a piece text the user typed into a paragraph.  Returns the text to emphesize (may be different from selection)  Does not return self!!.  nonMethod is what to show when clicked, i.e. the last part of specifier (Comment, Definition, or Hierarchy).  May be of the form:
  Point
  <Point>
  Click Here<Point>
  <Point>Click Here
  "
  	"Obtain the showing text and the instructions"
  	| b1 b2 trim |
  	b1 := aString indexOf: $<.
  	b2 := aString indexOf: $>.
  	(b1 < b2) & (b1 > 0) ifFalse: ["only one part"
  		classAndMethod := self validate: aString, ' ', nonMethod.
  		^ classAndMethod ifNotNil: [aString]].
  	"Two parts"
  	trim := aString withBlanksTrimmed.
  	(trim at: 1) == $< 
  		ifTrue: [(trim last) == $>
  			ifTrue: ["only instructions" 
  				classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
  				^ classAndMethod ifNotNil: [classAndMethod]]
  			ifFalse: ["at the front"
  				classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
  				^ classAndMethod ifNotNil: [aString copyFrom: b2+1 to: aString size]]]
  		ifFalse: [(trim last) == $>
  			ifTrue: ["at the end"
  				classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
  				^ classAndMethod ifNotNil: [aString copyFrom: 1 to: b1-1]]
  			ifFalse: ["Illegal -- <> has text on both sides"
  				^ nil]]
  !

Item was changed:
+ ----- Method: TextLink>>classAndMethod: (in category 'accessing') -----
- ----- Method: TextLink>>classAndMethod: (in category 'as yet unclassified') -----
  classAndMethod: aString
  	classAndMethod := aString!

Item was added:
+ ----- Method: TextLink>>hash (in category 'comparing') -----
+ hash
+ 	"#hash is re-implemented because #= is re-implemented"
+ 	^classAndMethod hash!

Item was changed:
+ ----- Method: TextLink>>info (in category 'accessing') -----
- ----- Method: TextLink>>info (in category 'as yet unclassified') -----
  info
  	^ classAndMethod!

Item was changed:
+ ----- Method: TextLink>>validate: (in category 'initialize-release') -----
- ----- Method: TextLink>>validate: (in category 'as yet unclassified') -----
  validate: specString
  	"Can this string be decoded to be Class space Method (or Comment, Definition, Hierarchy)? If so, return it in valid format, else nil" 
  
  	| list first mid last |
  	list := specString findTokens: ' 	.|'.
  	list isEmpty ifTrue: [ ^nil ].
  	last := list last.
  	last first isUppercase ifTrue: [
  		(#('Comment' 'Definition' 'Hierarchy') includes: last) ifFalse: [^ nil].
  		"Check for 'Rectangle Comment Comment' and remove last one"
  		(list at: list size - 1 ifAbsent: [^nil]) = last ifTrue: [list := list allButLast]].
  	list size > 3 ifTrue: [^ nil].
  	list size < 2 ifTrue: [^ nil].
  	Symbol hasInterned: list first ifTrue: [:sym | first := sym].
  	first ifNil: [^ nil].
  	Smalltalk at: first ifAbsent: [^ nil].
  	mid := list size = 3 
  		ifTrue: [(list at: 2) = 'class' ifTrue: ['class '] ifFalse: [^ nil]]
  		ifFalse: [''].
  	"OK if method name is not interned -- may not be defined yet"
  	^ first, ' ', mid, last!

Item was changed:
+ ----- Method: TextLink>>writeScanOn: (in category 'scanning') -----
- ----- Method: TextLink>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
+ 	strm nextPut: self class scanCharacter; nextPutAll: classAndMethod; nextPut: $;!
- 	strm nextPut: $L; nextPutAll: classAndMethod; nextPut: $;!

Item was added:
+ ----- Method: TextPrintIt class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$P!

Item was removed:
- ----- Method: TextPrintIt>>writeScanOn: (in category 'as yet unclassified') -----
- writeScanOn: strm
- 
- 	strm nextPut: $P; nextPutAll: evalString; nextPutAll: ';;'!

Item was added:
+ ----- Method: TextSqkPageLink class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$q!

Item was removed:
- ----- Method: TextSqkPageLink>>writeScanOn: (in category 'as yet unclassified') -----
- writeScanOn: strm
- 
- 	strm nextPut: $q; nextPutAll: url; nextPut: $;!

Item was removed:
- TextURL subclass: #TextSqkProjectLink
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Collections-Text'!

Item was removed:
- ----- Method: TextSqkProjectLink>>actOnClickFor: (in category 'as yet unclassified') -----
- actOnClickFor: textMorph
- 
- 	Project current enterIfThereOrFind: url.
- 	^ true!

Item was removed:
- ----- Method: TextSqkProjectLink>>analyze: (in category 'as yet unclassified') -----
- analyze: aString
- 
- 	^url := aString!

Item was removed:
- ----- Method: TextSqkProjectLink>>writeScanOn: (in category 'as yet unclassified') -----
- writeScanOn: strm
- 
- 	strm nextPut: $p; nextPutAll: url; nextPut: $;!

Item was added:
+ ----- Method: TextURL class>>scanCharacter (in category 'fileIn/Out') -----
+ scanCharacter
+ 	"The character used to identify a subclass of TextAttribute for filein and fileout"
+ 	^$R!

Item was changed:
+ ----- Method: TextURL class>>scanFrom: (in category 'fileIn/Out') -----
- ----- Method: TextURL class>>scanFrom: (in category 'as yet unclassified') -----
  scanFrom: strm
  	"read a link in the funny format used by Text styles on files. Rhttp://www.disney.com;"
  
  	^ self new url: (strm upTo: $;)!

Item was added:
+ ----- Method: TextURL>>= (in category 'comparing') -----
+ = other 
+ 	^ (other class == self class) 
+ 		and: [other info = self info]!

Item was added:
+ ----- Method: TextURL>>hash (in category 'comparing') -----
+ hash
+ 	"#hash is re-implemented because #= is re-implemented"
+ 	^url hash!

Item was changed:
  ----- Method: TextURL>>writeScanOn: (in category 'as yet unclassified') -----
  writeScanOn: strm
  
+ 	strm nextPut: self class scanCharacter; nextPutAll: url; nextPut: $;!
- 	strm nextPut: $R; nextPutAll: url; nextPut: $;!



More information about the Squeak-dev mailing list