'From Cuis 1.0 of 6 August 2009 [latest update: #258] on 19 August 2009 at 11:46:33 pm'!

!BalloonMorph class methodsFor: 'private' stamp: 'jmv 8/19/2009 22:45'!
getTextMorph: aStringOrMorph for: balloonOwner
	"Construct text morph."
	| m text fontToUse |
	aStringOrMorph isMorph
		ifTrue: [ m _ aStringOrMorph ]
		ifFalse: [
			text _ Text string: aStringOrMorph attribute: TextAlignment centered.
			(fontToUse _ balloonOwner balloonFont)
				ifNotNil: [
					text initialFont: fontToUse ].
			m _ TextMorph new contents: text].
	m setToAdhereToEdge: #adjustedCenter.
	^ m! !


!EntryField2LW methodsFor: 'drawing' stamp: 'jmv 8/19/2009 22:45'!
characterIndexAtPoint: aPoint

	| line block |
	
	line _ TextLine 
		start: 1
		stop: contents size
		internalSpaces: 0
		paddingWidth: 0.
	line
		rectangle: bounds;
		lineHeight: font height baseline: font ascent.
		
	block _ (CharacterBlockScanner new text: 
			(contents asText initialFont: font))
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !


!OneLineEditorMorph methodsFor: 'drawing' stamp: 'jmv 8/19/2009 22:45'!
characterIndexAtPoint: aPoint

	| line block f |
	f _ self fontToUse.
	
	line _ TextLine 
		start: 1
		stop: contents size
		internalSpaces: 0
		paddingWidth: 0.
	line
		rectangle: bounds;
		lineHeight: f height baseline: f ascent.
		
	block _ (CharacterBlockScanner new text: 
			(contents asText initialFont: font))
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !


!AcceptableCleanTextMorph methodsFor: 'shout' stamp: 'jmv 8/19/2009 23:36'!
okToStyle
	^false! !


!BrowserCommentTextMorph methodsFor: 'shout' stamp: 'jmv 8/19/2009 23:21'!
okToStyle
	^false! !


!Preferences class methodsFor: 'standard queries' stamp: 'jmv 8/19/2009 23:14'!
syntaxHighlightingAsYouType
	^ "self
		valueOfFlag: #syntaxHighlightingAsYouType
		ifAbsent: [true]" false not! !


!StringHolder methodsFor: 'accessing' stamp: 'jmv 8/19/2009 22:18'!
contents
	"Answer the contents that the receiver is holding--presumably a string."

	^self stringContents! !

!StringHolder methodsFor: 'accessing' stamp: 'jmv 8/19/2009 22:16'!
stringContents
	"Answer the contents that the receiver is holding--presumably a string."

	^contents! !


!CodeHolder methodsFor: 'contents' stamp: 'jmv 8/19/2009 22:39'!
contents
	"Answer the source code or documentation for the selected method"

	^ Text
		initialFont: Preferences standardCodeFont
		stringOrText: self stringContents! !

!CodeHolder methodsFor: 'contents' stamp: 'jmv 8/19/2009 22:16'!
stringContents
	"Answer the source code or documentation for the selected method"

	self showingByteCodes ifTrue:
		[^ self selectedBytecodes].

	self showingDocumentation ifTrue:
		[^ self commentContents].

	^ self selectedMessage! !

!CodeHolder methodsFor: 'construction' stamp: 'jmv 8/19/2009 22:57'!
buildMorphicCodePaneWith: editString
	"Construct the pane that shows the code.
	Respect the Preference for standardCodeFont."

	| codePane |
	codePane := PluggableTextMorph
				on: self
				editorClass: self editorClass
				text: #contents
				accept: #contents:notifying:
				readSelection: #contentsSelection
				menu: #paneMenu:shifted:editorClass:.
	editString
		ifNotNil: [
			codePane editString: editString.
			codePane hasUnacceptedEdits: true].
	^ codePane! !

!CodeHolder methodsFor: '*Shout-Styling' stamp: 'jmv 8/19/2009 23:31'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text.
	The default is to answer false to veto the styling"
	"jmv-Changed.  Answer false if showing difs."
	
	^self showingAnyKindOfDiffs not! !


!Browser methodsFor: 'accessing' stamp: 'jmv 8/19/2009 22:16'!
stringContents
	"Depending on the current selection, different information is retrieved.
	Answer a string description of that information. This information is the
	method of the currently selected class and message."

	| comment theClass latestCompiledMethod |
	latestCompiledMethod _ currentCompiledMethod.
	currentCompiledMethod _ nil.

	editSelection == #none ifTrue: [^ ''].
	editSelection == #editSystemCategories 
		ifTrue: [^ systemOrganizer printString].
	editSelection == #newClass 
		ifTrue: [^ (theClass _ self selectedClass)
			ifNil:
				[Class template: self selectedSystemCategoryName]
			ifNotNil:
				[Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]].
	editSelection == #editClass 
		ifTrue:
			[^ self classDefinitionText ].
	editSelection == #editComment 
		ifTrue:
			[(theClass _ self selectedClass) ifNil: [^ ''].
			comment _ theClass comment.
			currentCompiledMethod _ theClass organization commentRemoteStr.
			^ comment size = 0
				ifTrue: ['This class has not yet been commented.']
				ifFalse: [comment]].
	editSelection == #hierarchy 
		ifTrue: [^ self selectedClassOrMetaClass printHierarchy].
	editSelection == #editMessageCategories 
		ifTrue: [^ self classOrMetaClassOrganizer printString].
	editSelection == #newMessage
		ifTrue:
			[^ (theClass _ self selectedClassOrMetaClass) 
				ifNil: ['']
				ifNotNil: [theClass sourceCodeTemplate]].
	editSelection == #editMessage
		ifTrue:
			[self showingByteCodes ifTrue: [^ self selectedBytecodes].
			currentCompiledMethod _ latestCompiledMethod.
			^ self selectedMessage].

	self error: 'Browser internal error: unknown edit selection.'! !

!Browser methodsFor: 'class comment pane' stamp: 'jmv 8/19/2009 22:22'!
buildMorphicCommentPane
	"Construct the pane that shows the class comment.
	Respect the Preference for standardCodeFont."

	| commentPane |
	commentPane := BrowserCommentTextMorph
				on: self
				editorClass: self editorClass
				text: #classCommentText
				accept: #classComment:notifying:
				readSelection: nil
				menu: #paneMenu:shifted:editorClass:.
	^ commentPane! !

!Browser methodsFor: 'class functions' stamp: 'jmv 8/19/2009 23:13'!
classCommentText
	"return the text to display for the comment of the currently selected class"
	| theClass |
	theClass _ self selectedClassOrMetaClass.
	theClass ifNil: [ ^Text 
				initialFont: Preferences standardCodeFont 
				stringOrText: ''].

	^ theClass hasComment
		ifTrue: [ 
			Text 
				initialFont: Preferences standardCodeFont 
				stringOrText: theClass comment ]
		ifFalse: [
			Text 
				initialFont: Preferences standardCodeFont
				string: 'THIS CLASS HAS NO COMMENT!!' translated 
				attribute: TextColor red ]! !


!ChangeList methodsFor: 'menu actions' stamp: 'jmv 8/19/2009 23:27'!
compareToCurrentVersion
	"If the current selection corresponds to a method in the system, then spawn a window showing the diffs as text"

	| change class s1 s2 |
	listIndex = 0
		ifTrue: [^ self].
	change _ changeList at: listIndex.
	((class _ change methodClass) notNil
			and: [class includesSelector: change methodSelector])
		ifTrue: [s1 _ (class sourceCodeAt: change methodSelector) asString.
			s2 _ change string.
			s1 = s2
				ifTrue: [^ self inform: 'Exact Match'].
			(StringHolder new
				textContents: ((TextDiffBuilder buildDisplayPatchFrom: s1 to: s2 inClass: class  prettyDiffs: self showingPrettyDiffs) initialFont: Preferences standardCodeFont))
				openLabel: 'Comparison to Current Version']
		ifFalse: [self flash]! !

!ChangeList methodsFor: 'viewing access' stamp: 'jmv 8/19/2009 22:17'!
stringContents
	"Answer the contents string, obeying diffing directives if needed"

	^ self showingAnyKindOfDiffs
		ifFalse:
			[self undiffedContents]
		ifTrue:
			[self showsVersions
				ifTrue:
					[self diffedVersionContents]
				ifFalse:
					[self contentsDiffedFromCurrent]]! !


!Debugger methodsFor: 'accessing' stamp: 'jmv 8/19/2009 22:17'!
stringContents 
	"Depending on the current selection, different information is retrieved.
	Answer a string description of that information.  This information is the
	method in the currently selected context."

	contents == nil ifTrue: [^ String new].
	^ contents copy! !


!FileContentsBrowser methodsFor: 'accessing' stamp: 'jmv 8/19/2009 22:16'!
stringContents
	self updateInfoView.
	(editSelection == #newClass and:[self selectedPackage notNil])
		ifTrue: [^self selectedPackage packageInfo].
	editSelection == #editClass
		ifTrue:[^self modifiedClassDefinition].
	^super stringContents! !


!FileList methodsFor: 'private' stamp: 'jmv 8/19/2009 22:17'!
stringContents
	"Answer the contents of the file, reading it first if needed."
	"Possible brevityState values:
		FileList,
		fullFile, briefFile, needToGetFull, needToGetBrief,
		fullHex, briefHex, needToGetFullHex, needToGetBriefHex"

	(listIndex = 0) | (brevityState == #FileList) ifTrue: [^ self defaultContents].  "no file selected"
	brevityState == #fullFile ifTrue: [^ contents].
	brevityState == #fullHex ifTrue: [^ contents].
	brevityState == #briefFile ifTrue: [^ contents].
	brevityState == #briefHex ifTrue: [^ contents].

	brevityState == #needToGetFullHex ifTrue: [^ self readContentsHex: false].
	brevityState == #needToGetBriefHex ifTrue: [^ self readContentsHex: true].

	brevityState == #needToGetFull ifTrue: [^ self readContentsBrief: false].
	brevityState == #needToGetBrief ifTrue: [^ self readContentsBrief: true].  "default"

	self halt: 'unknown state ' , brevityState printString! !


!MessageSet methodsFor: 'contents' stamp: 'jmv 8/19/2009 22:16'!
stringContents
	"Answer the contents of the receiver"

	^ contents == nil
		ifTrue: [currentCompiledMethod _ nil. '']
		ifFalse: [messageListIndex = 0 
			ifTrue: [currentCompiledMethod _ nil. contents]
			ifFalse: [self showingByteCodes
				ifTrue: [self selectedBytecodes]
				ifFalse: [self selectedMessage]]]! !


!MethodHolder methodsFor: 'contents' stamp: 'jmv 8/19/2009 22:17'!
stringContents
	"Answer the contents, with due respect for my contentsSymbol"

	contents _ methodClass sourceCodeAt: methodSelector ifAbsent: [''].
	currentCompiledMethod _ methodClass compiledMethodAt: methodSelector ifAbsent: [nil].

	self showingDecompile ifTrue:
			[^ self decompiledSourceIntoContentsWithTempNames: Sensor leftShiftDown not ].

	self showingDocumentation ifTrue:
		[^ self commentContents].

	^ contents _ self sourceStringPrettifiedAndDiffed asText makeSelectorBoldIn: methodClass! !


!StringMorph methodsFor: 'editing' stamp: 'jmv 8/19/2009 22:50'!
launchMiniEditor: evt 
	| textMorph |
	hasFocus := true.	"Really only means edit in progress for this morph"
	textMorph := StringMorphEditor new contentsAsIs: 
		(Text initialFont: self fontToUse stringOrText: contents).
	textMorph bounds: (self bounds expandBy: 0 @ 2).
	self addMorphFront: textMorph.
	evt hand newMouseFocus: textMorph.
	self flag: #arNote.	"Why???"
"
	evt hand newKeyboardFocus: textMorph."
	textMorph editor selectFrom: 1 to: textMorph paragraph text string size! !


!Text methodsFor: 'accessing' stamp: 'jmv 8/19/2009 22:03'!
initialFont: aStrikeFont
	initialStyle _ aStrikeFont defaultTextStyle! !

!Text methodsFor: 'copying' stamp: 'jmv 8/19/2009 19:42'!
copy

	^ self class new setInitialStyle: initialStyle setString: string copy setRuns: runs copy
! !

!Text methodsFor: 'copying' stamp: 'jmv 8/19/2009 19:43'!
copyFrom: start to: stop 
	"Answer a copied subrange of the receiver."

	| realStart realStop |
	stop > self size
		ifTrue: [realStop _ self size]		"handle selection at end of string"
		ifFalse: [realStop _ stop].
	start < 1
		ifTrue: [realStart _ 1]			"handle selection before start of string"
		ifFalse: [realStart _ start].
	^Text 
		initialStyle: initialStyle
		string: (string copyFrom: realStart to: realStop)
		runs: (runs copyFrom: realStart to: realStop)! !

!Text methodsFor: 'converting' stamp: 'jmv 8/19/2009 19:43'!
reversed

	"Answer a copy of the receiver with element order reversed."

	^ self class initialStyle: initialStyle string: string reversed runs: runs reversed.

  "  It is assumed that  self size = runs size  holds. "! !

!Text methodsFor: 'private' stamp: 'jmv 8/19/2009 22:53'!
setInitialStyle: aTextStyle setString: aString setRuns: anArray

	initialStyle _ aTextStyle.
	string _ aString.
	runs _ anArray! !


!Text class methodsFor: 'instance creation' stamp: 'jmv 8/19/2009 22:08'!
initialFont: aStrikeFont string: aString attribute: att
	"Answer an instance of me whose characters are aString.
	att is a TextAttribute."

	^self initialStyle: aStrikeFont defaultTextStyle string: aString attributes: (Array with: att)! !

!Text class methodsFor: 'instance creation' stamp: 'jmv 8/19/2009 22:39'!
initialFont: aStrikeFont stringOrText: aStringOrText
	"Answer an instance of me whose characters are aString."

	(aStringOrText isKindOf: Text) ifTrue: [
		^ aStringOrText initialFont: aStrikeFont ].
	
	^self initialStyle: aStrikeFont defaultTextStyle string: aStringOrText attributes: #()! !

!Text class methodsFor: 'instance creation' stamp: 'jmv 8/19/2009 19:45'!
initialStyle: aTextStyle string: aString attributes: atts
	"Answer an instance of me whose characters are those of aString.
	atts is an array of TextAttributes."

	^self initialStyle: aTextStyle string: aString runs: (RunArray new: aString size withAll: atts)! !

!Text class methodsFor: 'instance creation' stamp: 'jmv 8/19/2009 21:56'!
string: aString attributes: atts
	"Answer an instance of me whose characters are those of aString.
	atts is an array of TextAttributes."

	^self initialStyle: TextStyle default string: aString runs: (RunArray new: aString size withAll: atts)! !

!Text class methodsFor: 'private' stamp: 'jmv 8/19/2009 21:51'!
initialStyle: aTextStyle string: aString runs: anArray
 
	^self basicNew 
		setInitialStyle: aTextStyle setString: aString setRuns: anArray! !


!TextMorph methodsFor: 'accessing' stamp: 'jmv 8/19/2009 19:45'!
newContents: stringOrText 
	"Accept new text contents."
	| newText embeddedMorphs |
	"If my text is all the same font, use the font for my new contents"
	newText _ stringOrText isString ifTrue: [ | textSize |
		(text notNil
		  and: [ (textSize _ text size) > 0
		    and: [ (text runLengthFor: 1) = textSize ]]) ifTrue: [ | attribs |
			attribs _ text attributesAt: 1.
			Text initialStyle: text initialStyle string: stringOrText copy attributes: attribs.
		]
		ifFalse: [ Text fromString: stringOrText copy ]
	]
	ifFalse: [ stringOrText copy asText.	"should be veryDeepCopy?" ].

	text = newText ifTrue: [^ self].	"No substantive change"
	text ifNotNil: [(embeddedMorphs _ text embeddedMorphs)
			ifNotNil: 
				[self removeAllMorphsIn: embeddedMorphs.
				embeddedMorphs do: [:m | m delete]]].

	text _ newText.

	"add all morphs off the visible region; they'll be moved into the right 
	place when they become visible. (this can make the scrollable area too 
	large, though)"
	newText embeddedMorphs do: 
		[:m | 
		self addMorph: m.
		m position: -1000 @ 0].
	self releaseParagraph.
	"update the paragraph cache"
	self paragraph.
	"re-instantiate to set bounds"
	self world ifNotNil: [self world startSteppingSubmorphsOf: self]! !

TextMorph removeSelector: #setTextStyle:!
Text class removeSelector: #string:runs:!
Text removeSelector: #setString:setRuns:!
Text removeSelector: #setString:setRunsChecking:!
MethodHolder removeSelector: #contents!
MessageSet removeSelector: #contents!
FileList removeSelector: #contents!
FileContentsBrowser removeSelector: #contents!
Debugger removeSelector: #contents!
ChangeList removeSelector: #contents!
Browser removeSelector: #contents!
PluggableTextMorph removeSelector: #font:!
