'From Cuis 1.0 of 6 August 2009 [latest update: #258] on 18 August 2009 at 6:27:27 pm'!

!RemoteString commentStamp: 'jmv 8/18/2009 17:44' prior: 0!
My instances provide an external file reference to a piece of text.  It may be the sourceCode of a method, or the class comments of a class.

The changes file or file-in file usually has a chunk that is just the source string of a method:

max: aNumber
	^ self > aNumber ifTrue: [self] ifFalse: [aNumber]!!

I can return either a String or a Text.  Some a chunk is followed by a second chunk (beginning with ]style[) containing style information.  The encoding is like this:

max: aNumber
	^ self > aNumber ifTrue: [self] ifFalse: [aNumber]!!
]style[(14 50 312)f1,f1b,f1LInteger +;i!!

Allowed TextAttributes are TextFontChange, TextEmphasis, TextColor, TextDoIt, TextKern, TextLink, TextURL.  TextFontReference and TextAnchor are not supported.

See PositionableStream nextChunkText and RunArray class scanFrom:.

Text support in code was removed.
If source contains a ]style[ chunk, it is ignored!


!ClassDescription methodsFor: 'fileIn/Out' stamp: 'jmv 8/18/2009 17:55'!
reformatMethodAt: selector 
	| newCodeString method | 
	newCodeString _ (self compilerClass new)
		format: (self sourceCodeAt: selector)
		in: self
		notifying: nil.
	method _ self compiledMethodAt: selector.
	method
		putSource: newCodeString
		fromParseNode: nil
		class: self
		category: (self organization categoryOfElement: selector)
		inFile: 2 priorMethod: method! !

!ClassDescription methodsFor: 'private' stamp: 'jmv 8/18/2009 17:08'!
logMethodSource: aText forMethodWithNode: aCompiledMethodWithNode inCategory: category withStamp: changeStamp notifying: requestor
	| priorMethodOrNil |
	priorMethodOrNil := self compiledMethodAt: aCompiledMethodWithNode selector ifAbsent: [].
	aCompiledMethodWithNode method putSource: aText asString
		fromParseNode: aCompiledMethodWithNode node
		class: self category: category withStamp: changeStamp 
		inFile: 2 priorMethod: priorMethodOrNil.! !


!CodeHolder methodsFor: 'contents' stamp: 'jmv 8/18/2009 17:50'!
contentsSymbol
	"Answer a symbol indicating what kind of content should be shown for the method; for normal showing of source code, this symbol is #source.  A nil value in the contentsSymbol slot will be set to #source by this method"

	^ contentsSymbol ifNil: [
		contentsSymbol _ Preferences browseWithPrettyPrint
					ifTrue:
						[#prettyPrint]
					ifFalse:
						[#source]]! !

!CodeHolder methodsFor: 'controls' stamp: 'jmv 8/18/2009 18:06'!
contentsSymbolQuints
	"Answer a list of quintuplets representing information on the alternative views available in the code pane
		first element:	the contentsSymbol used
		second element:	the selector to call when this item is chosen.
		third element:	the selector to call to obtain the wording of the menu item.
		fourth element:	the wording to represent this view
		fifth element:	balloon help
	A hypen indicates a need for a seperator line in a menu of such choices"

	^ #(
(source			togglePlainSource 			showingPlainSourceString		'source'			'the textual source code as writen')
(documentation	toggleShowDocumentation	showingDocumentationString	'documentation'	'the first comment in the method')
-
(prettyPrint		togglePrettyPrint 			prettyPrintString				'prettyPrint'		'the method source presented in a standard text format')
-
(showDiffs		toggleRegularDiffing		showingRegularDiffsString		'showDiffs'		'the textual source diffed from its prior version')
(prettyDiffs		togglePrettyDiffing		showingPrettyDiffsString		'prettyDiffs'	'formatted textual source diffed from formatted form of prior version')
-
(decompile		toggleDecompile			showingDecompileString		'decompile'		'source code decompiled from byteCodes')
(byteCodes		toggleShowingByteCodes	showingByteCodesString		'byteCodes'	'the bytecodes that comprise the compiled method'))! !

!CodeHolder methodsFor: 'message list' stamp: 'jmv 8/18/2009 18:08'!
sourceStringPrettifiedAndDiffed
	"Answer a copy of the source code for the selected message, transformed by diffing and pretty-printing exigencies"

	| class selector sourceString |
	class _ self selectedClassOrMetaClass.
	selector _ self selectedMessageName.
	(class isNil or: [selector isNil]) ifTrue: [^ 'missing'].

	sourceString _ class ultimateSourceCodeAt: selector ifAbsent: [^ 'error'].
	self validateMessageSource: sourceString forSelector: selector.

	(#(prettyPrint prettyDiffs) includes: contentsSymbol) ifTrue: [
		sourceString _ class compilerClass new
						format: sourceString 
						in: class 
						notifying: nil].
	self showingAnyKindOfDiffs ifTrue:
		[sourceString _ self diffFromPriorSourceFor: sourceString].

	^ sourceString! !


!ChangeSorter methodsFor: 'code pane' stamp: 'jmv 8/18/2009 18:08'!
setContents
	"return the source code that shows in the bottom pane"

	| sel class strm changeType |
	self clearUserEditFlag.
	currentClassName ifNil: [^ contents _ myChangeSet preambleString ifNil: ['']].
	class _ self selectedClassOrMetaClass.
	(sel _ currentSelector) == nil
		ifFalse: [changeType _ (myChangeSet atSelector: (sel _ sel asSymbol) class: class).
			changeType == #remove
				ifTrue: [^ contents _ 'Method has been removed (see versions)'].
			changeType == #addedThenRemoved
				ifTrue: [^ contents _ 'Added then removed (see versions)'].
			class ifNil: [^ contents _ 'Method was added, but cannot be found!!'].
			(class includesSelector: sel)
				ifFalse: [^ contents _ 'Method was added, but cannot be found!!'].
			contents _ class sourceCodeAt: sel.
			(#(prettyPrint prettyDiffs) includes: contentsSymbol) ifTrue:
				[contents _ class compilerClass new
						format: contents 
						in: class 
						notifying: nil].
			self showingAnyKindOfDiffs
				ifTrue: [contents _ self diffFromPriorSourceFor: contents].
			^ contents _ contents asText makeSelectorBoldIn: class]
		ifTrue: [strm _ WriteStream on: (String new: 100).
			(myChangeSet classChangeAt: currentClassName) do:
				[:each |
				each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.'; cr].
				each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.'].
				each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.'; cr].
				each = #add ifTrue: [strm nextPutAll: 'Class definition was added.'; cr].
				each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.'; cr].
				each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.'; cr].
				each = #comment ifTrue: [strm nextPutAll: 'New class comment.'; cr.
				]].
			^ contents _ strm contents].! !


!CompiledMethod methodsFor: 'decompiling' stamp: 'jmv 8/18/2009 17:57'!
methodNodeFormatted
	"Return the parse tree that represents self"

	^ self methodNodeFormattedDecompileClass: nil selector: nil! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'jmv 8/18/2009 17:56'!
methodNodeFormattedDecompileClass: aClass selector: selector
	"Return the parse tree that represents self, using pretty-printed source text if possible."
	| source sClass node |
	source := self getSourceFromFile.
	sClass _ aClass ifNil: [self sourceClass].
	source ifNil: [ ^self decompileClass: sClass selector: selector].
	source _ sClass compilerClass new
						format: source
						in: sClass
						notifying: nil.
	node _ sClass parserClass new
				parse: source
				class: sClass.
	node sourceText: source.
	^node! !


!ContextPart methodsFor: 'accessing' stamp: 'jmv 8/18/2009 17:57'!
methodNodeFormatted
	"Answer a method node made from pretty-printed (and colorized, if decorate is true) source text."

	| selector methodClass |
	selector _ self receiver class
		selectorAtMethod: self method
		setClass: [:mclass | methodClass _ mclass].
	^ self method methodNodeFormattedDecompileClass: methodClass selector: selector! !


!Debugger methodsFor: 'accessing' stamp: 'jmv 8/18/2009 17:57'!
contents: aText notifying: aController 
	"The retrieved information has changed and its source must now be  
	updated. In this case, the retrieved information is the method of the  
	selected context."
	| selector classOfMethod category h ctxt |
	contextStackIndex = 0
		ifTrue: [^ false].
	self selectedContext isExecutingBlock
		ifTrue: [h := self selectedContext finalBlockHome.
			h
				ifNil: [self inform: 'Method not found for block, can''t edit'.
					^ false].
			(self confirm: 'I will have to revert to the method from
which this block originated.  Is that OK?')
				ifTrue: [self resetContext: h]
				ifFalse: [^ false]].
	classOfMethod := self selectedClass.
	category := self selectedMessageCategoryName.
	selector := self selectedClass parserClass new parseSelector: aText.
	selector == self selectedMessageName
		ifFalse: [self inform: 'can''t change selector'.
			^ false].
	selector := classOfMethod
				compile: aText
				classified: category
				notifying: aController.
	selector
		ifNil: [^ false].
	"compile cancelled"
	contents := aText.
	ctxt := interruptedProcess popTo: self selectedContext.
	ctxt == self selectedContext ifFalse: [
		self inform: 'Method saved, but current context unchanged
because of unwind error. Click OK to see error'.
	] ifTrue: [
		interruptedProcess
			restartTopWith: (classOfMethod compiledMethodAt: selector);
		 	stepToSendOrReturn.
		contextVariablesInspector object: nil.
		theMethodNode := Preferences browseWithPrettyPrint
			ifTrue: [ctxt methodNodeFormatted]
			ifFalse: [ctxt methodNode].
		sourceMap := theMethodNode sourceMap.
		tempNames := theMethodNode tempNames.
	].
	self resetContext: ctxt.
	^ true! !

!Debugger methodsFor: 'private' stamp: 'jmv 8/18/2009 17:58'!
contextStackIndex: anInteger oldContextWas: oldContext 
	"Change the context stack index to anInteger, perhaps in response to user selection."

	| newMethod |
	contextStackIndex := anInteger.
	anInteger = 0
		ifTrue: [currentCompiledMethod := theMethodNode := tempNames := sourceMap := contents := nil.
			self changed: #contextStackIndex.
			self decorateButtons.
			self contentsChanged.
			contextVariablesInspector object: nil.
			receiverInspector object: self receiver.
			^ self].
	(newMethod := oldContext == nil
					or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)])
		ifTrue: [tempNames := sourceMap := nil.
			theMethodNode := Preferences browseWithPrettyPrint
				ifTrue: [ self selectedContext methodNodeFormatted]
				ifFalse: [	self selectedContext methodNode ].
			contents := self selectedMessage.
			self contentsChanged.
			self pcRange
			"will compute tempNamesunless noFrills"].
	self changed: #contextStackIndex.
	self decorateButtons.
	tempNames == nil
		ifTrue: [tempNames := self selectedClassOrMetaClass parserClass new parseArgsAndTemps: contents notifying: nil].
	contextVariablesInspector object: self selectedContext.
	receiverInspector object: self receiver.
	newMethod
		ifFalse: [self changed: #contentsSelection]! !


!FileContentsBrowser methodsFor: 'edit pane' stamp: 'jmv 8/18/2009 17:59'!
selectedMessage
	"Answer a copy of the source code for the selected message selector."

	| class selector |
	class _ self selectedClassOrMetaClass.
	selector _ self selectedMessageName.
	contents _ class sourceCodeAt: selector.
	Preferences browseWithPrettyPrint ifTrue: [
		contents _ Compiler new
					format: contents
					in: class
					notifying: nil].
	self showingAnyKindOfDiffs ifTrue: [
		contents _ self
			methodDiffFor: contents
			class: self selectedClass
			selector: self selectedMessageName
			meta: self metaClassIndicated].
	^ contents asText makeSelectorBoldIn: class! !


!PositionableStream methodsFor: 'fileIn/Out' stamp: 'jmv 8/18/2009 17:11'!
copyMethodChunkFrom: aStream
	"Copy the next chunk from aStream (must be different from the receiver)."
	| chunk |
	chunk _ aStream nextChunkText.
	self nextChunkPut: chunk asString! !

!PositionableStream methodsFor: 'fileIn/Out' stamp: 'jmv 8/18/2009 17:36'!
nextChunkText
	"Deliver the next chunk as a Text.  Decode the following ]style[ chunk if present.  Position at start of next real chunk."
	"Actually ignore the style chunk if present, and answer a String"
	
	| string |
	
	"Read the plain text"
	string _ self nextChunk.
	self skipStyleChunk.
	^string! !


!Preferences class methodsFor: 'misc' stamp: 'jmv 8/18/2009 17:49'!
defaultValueTableForCurrentRelease
	"Answer a table defining default values for all the preferences in the release.  Returns a list of (pref-symbol, boolean-symbol) pairs"

	^  #(
		(abbreviatedBrowserButtons false)
		(alternativeBrowseIt false)
		(alternativeWindowLook true)
		(annotationPanes false)
		(automaticFlapLayout true)
		(automaticPlatformSettings true)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying false)
		(caseSensitiveFinds false)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(conversionMethodsAtFileOut false)
		(cpuWatcherEnabled false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(higherPerformance false)
		(honorDesktopCmdKeys true)
		(inboardScrollbars true)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)  
		(modalColorPickers true)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(projectsSentToDisk false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(simpleMenus false)
		(smartUpdating true)
		(soundQuickStart false)
		(soundStopWhenDone false)
		(soundsEnabled true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(twentyFourHourFileStamps true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))


"
Preferences defaultValueTableForCurrentRelease do:
	[:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo:
			[:pref | pref defaultValue: (pair last == #true)]].
Preferences chooseInitialSettings.
"! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 8/18/2009 17:49'!
brightSqueak
	"The classic bright Squeak look.  Windows have saturated colors and relatively low contrast; scroll-bars are of the flop-out variety and are on the left.  Many power-user features are enabled."

	self setPreferencesFrom:
	#(
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(inboardScrollbars false)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(simpleMenus false)
		(smartUpdating true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 8/18/2009 17:49'!
juans

	self setPreferencesFrom:

	#(
		(alternativeWindowLook true)
		(annotationPanes true)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips true)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(inboardScrollbars true)
		(menuColorFromWorld false)
		(menuKeyboardControl true)
		(optionalButtons true)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow true)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating true)
		(subPixelRenderFonts true)
		(thoroughSenders true)
	)! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 8/18/2009 17:49'!
paloAlto
	"Similar to the brightSqueak theme, but with a number of idiosyncratic personal settings.   Note that caseSensitiveFinds is true"


	self setPreferencesFrom:
	#(
		(abbreviatedBrowserButtons false)
		(accessOnlineModuleRepositories noOpinion)
		(alternativeBrowseIt noOpinion)
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(automaticPlatformSettings noOpinion)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying noOpinion)
		(caseSensitiveFinds true)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(conservativeModuleDeActivation noOpinion)
		(conversionMethodsAtFileOut true)
		(cpuWatcherEnabled noOpinion)
		(debugHaloHandle true)
		(debugPrintSpaceLog true)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose true)
		(duplicateControlAndAltKeys false)
		(extraDebuggerButtons true)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(higherPerformance noOpinion)
		(honorDesktopCmdKeys true)
		(inboardScrollbars false)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)  
		(modalColorPickers true)
		(modularClassDefinitions noOpinion)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(projectsSentToDisk noOpinion)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(simpleMenus false)
		(smartUpdating true)
		(soundQuickStart noOpinion)
		(soundsEnabled true)
		(soundStopWhenDone noOpinion)
		(strongModules noOpinion)
		(swapControlAndAltKeys noOpinion)
		(swapMouseButtons  noOpinion)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(twentyFourHourFileStamps false)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 8/18/2009 17:49'!
slowMachine

	self setPreferencesFrom:

	#(
		(alternativeWindowLook false)
		(annotationPanes false)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(diffsInChangeList false)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(inboardScrollbars true)
		(menuColorFromWorld false)
		(menuKeyboardControl false)
		(optionalButtons false)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating false)
		(subPixelRenderFonts false)
		(thoroughSenders false)
	)! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 8/18/2009 17:49'!
smalltalk80
	"A traditional monochrome Smalltalk-80 look and feel, clean and austere, and lacking many features added to Squeak in recent years. Caution: this theme removes the standard Squeak flaps, turns off the 'smartUpdating' feature that keeps multiple browsers in synch, and much more."

	self setPreferencesFrom:

	#(
		(alternativeWindowLook false)
		(annotationPanes false)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(diffsInChangeList false)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(inboardScrollbars false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)
		(optionalButtons false)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating false)
		(thoroughSenders false)
	)! !


!PrettyTextDiffBuilder methodsFor: 'initialize' stamp: 'jmv 8/18/2009 17:59'!
split: aString 
	| formatted |
	formatted _ sourceClass compilerClass new
		format: aString
		in: sourceClass
		notifying: nil.
	^super split: formatted! !


!RemoteString methodsFor: 'private' stamp: 'jmv 8/18/2009 17:12'!
string: aStringOrText onFileNumber: fileNumber toFile: aFileStream 
	"Store this as the receiver's text if source files exist."

	| position |
	position _ aFileStream position.
	self fileNumber: fileNumber position: position.
	aFileStream nextChunkPut: aStringOrText asString
	"^ self		(important)"! !


!SmalltalkEditor methodsFor: 'menu messages' stamp: 'jmv 8/18/2009 18:00'!
prettyPrint
	"Reformat the contents of the receiver's view (a Browser)."

	| selectedClass newText |
	model selectedMessageName ifNil: [^ morph flash].
	selectedClass _ model selectedClassOrMetaClass.
	newText _ selectedClass compilerClass new
		format: self text
		in: selectedClass
		notifying: self.
	newText ifNotNil:
		[self deselect; selectInvisiblyFrom: 1 to: paragraph text size.
		self replaceSelectionWith: (newText asText makeSelectorBoldIn: selectedClass).
		self selectAt: 1]! !


!SystemDictionary methodsFor: 'housekeeping' stamp: 'jmv 8/18/2009 18:01'!
testFormatter    "Smalltalk testFormatter"
	"Reformats the source for every method in the system, and then compiles that source and verifies that it generates identical code.
	The formatting used will be classic monochrome."

	 | newCodeString methodNode oldMethod newMethod badOnes n |
	badOnes _ OrderedCollection new.
	Smalltalk forgetDoIts.
'Formatting all classes...'
displayProgressAt: Sensor cursorPoint
from: 0 to: CompiledMethod instanceCount
during: [:bar | n _ 0.
	Smalltalk allBehaviorsDo:
		[:cls | 
		"Transcript cr; show: cls name."
		cls selectors do:
			[:selector | (n _ n+1) \\ 100 = 0 ifTrue: [bar value: n].
			newCodeString _ (cls compilerClass new)
				format: (cls sourceCodeAt: selector)
				in: cls notifying: nil.
			methodNode _ cls compilerClass new
						compile: newCodeString
						in: cls notifying: nil ifFail: [].
			newMethod _ methodNode generate: #(0 0 0 0).
			oldMethod _ cls compiledMethodAt: selector.
			oldMethod = newMethod ifFalse: [Transcript cr; show: '***' , cls name , ' ' , selector.
											badOnes add: cls name , ' ' , selector]]].
].
	Smalltalk browseMessageList: badOnes asSortedCollection name: 'Formatter Discrepancies'! !

!SystemDictionary methodsFor: 'housekeeping' stamp: 'jmv 8/18/2009 18:01'!
testFormatter2    "Smalltalk testFormatter2"
	"Reformats the source for every method in the system, and then verifies that the order of source tokens is unchanged.
	The formatting used will be classic monochrome"

	 | newCodeString badOnes n oldCodeString oldTokens newTokens |
	badOnes _ OrderedCollection new.
	Smalltalk forgetDoIts.
'Formatting all classes...'
displayProgressAt: Sensor cursorPoint
from: 0 to: CompiledMethod instanceCount
during: [:bar | n _ 0.
	Smalltalk allBehaviorsDo:
		[:cls | 
		"Transcript cr; show: cls name."
		cls selectors do:
			[:selector | (n _ n+1) \\ 100 = 0 ifTrue: [bar value: n].
			oldCodeString _ (cls sourceCodeAt: selector) asString.
			newCodeString _ (cls compilerClass new)
				format: oldCodeString
				in: cls notifying: nil.
			oldTokens _ oldCodeString findTokens: Character separators.
			newTokens _ newCodeString findTokens: Character separators.
			oldTokens = newTokens ifFalse:
					[Transcript cr; show: '***' , cls name , ' ' , selector.
					badOnes add: cls name , ' ' , selector]]].
].
	Smalltalk browseMessageList: badOnes asSortedCollection name: 'Formatter Discrepancies'! !


!Text methodsFor: 'attributes' stamp: 'jmv 8/18/2009 17:27'!
unembellished 
	"Return true if the only emphases are  bold"
	| bold |
	bold _ TextEmphasis bold.

	"Ignore any  bold"
	runs withStartStopAndValueDo: [ :start :stop :emphArray |
		emphArray do: [:emph | 
			(bold = emph) ifFalse: [^ false]]].
	^ true! !


!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:21'!
initializeBasicCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table."

	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"

	"TextEditor initialize"

	| cmdMap cmds |
	cmdMap := Array new: 256 withAll: #noop:.		"use temp in case of a crash"
	cmdMap at: 1 + 1 put: #cursorHome:.				"home key"
	cmdMap at: 4 + 1 put: #cursorEnd:.				"end key"
	cmdMap at: 8 + 1 put: #backspace:.				"ctrl-H or delete key"
	cmdMap at: 11 + 1 put: #cursorPageUp:.			"page up key"
	cmdMap at: 12 + 1 put: #cursorPageDown:.		"page down key"
	cmdMap at: 13 + 1 put: #crWithIndent:.			"cmd-Return"
	cmdMap at: 27 + 1 put: #offerMenuFromEsc:.		"escape key"
	cmdMap at: 28 + 1 put: #cursorLeft:.				"left arrow key"
	cmdMap at: 29 + 1 put: #cursorRight:.			"right arrow key"
	cmdMap at: 30 + 1 put: #cursorUp:.				"up arrow key"
	cmdMap at: 31 + 1 put: #cursorDown:.			"down arrow key"
	cmdMap at: 32 + 1 put: #selectWord:.			"space bar key"
	cmdMap at: 127 + 1 put: #forwardDelete:.		"del key"
		
	'([{''"<' do: [:char | cmdMap at: char asciiValue + 1 put: #enclose:].
	
	cmdMap at: $, asciiValue + 1 put: #shiftEnclose:.
	
	cmds := #($a #selectAll: $c #copySelection: $e #exchange: $f #find: $g #findAgain: $h #setSearchString: $v #paste: $w #backWord: $x #cut: $y #swapChars: $z #undo:).
	1 to: cmds size
		by: 2
		do: [:i | cmdMap at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)].
		
	cmdActions := cmdMap! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:22'!
initializeBasicShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."
	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
	"wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the 
	capitalized versions of the letters.
	TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."

	"TextEditor initialize"
	
	| cmdMap cmds |

	"shift-command and control shortcuts"
	cmdMap _ Array new: 256 withAll: #noop:.  		"use temp in case of a crash"
	cmdMap at: ( 1 + 1) put: #cursorHome:.			"home key"
	cmdMap at: ( 4 + 1) put: #cursorEnd:.				"end key"
	cmdMap at: ( 8 + 1) put: #forwardDelete:.			"ctrl-H or delete key"
	cmdMap at: (11 + 1) put: #cursorPageUp:.			"page up key"
	cmdMap at: (12 + 1) put: #cursorPageDown:.		"page down key"
	cmdMap at: (13 + 1) put: #crWithIndent:.			"ctrl-Return"
	cmdMap at: (27 + 1) put: #offerMenuFromEsc:.	"escape key"
	cmdMap at: (28 + 1) put: #cursorLeft:.			"left arrow key"
	cmdMap at: (29 + 1) put: #cursorRight:.			"right arrow key"
	cmdMap at: (30 + 1) put: #cursorUp:.				"up arrow key"
	cmdMap at: (31 + 1) put: #cursorDown:.			"down arrow key"
	cmdMap at: (32 + 1) put: #selectWord:.			"space bar key"
	cmdMap at: (45 + 1) put: #changeEmphasis:.		"cmd-sh-minus"
	cmdMap at: (61 + 1) put: #changeEmphasis:.		"cmd-sh-plus"
	cmdMap at: (127 + 1) put: #forwardDelete:.		"del key"

	"Note: Command key overrides shift key, so, for example, cmd-shift-9 produces $9 not $("
	'9[,''' do: [ :char | cmdMap at: (char asciiValue + 1) put: #shiftEnclose: ].	"({< and double-quote"
	"Note: Must use cmd-9 or ctrl-9 to get '()' since cmd-shift-9 is a Mac FKey command."

	"NB: sw 12/9/2001 commented out the idiosyncratic line just below, which was grabbing shift-esc in the text editor and hence which argued with the wish to have shift-esc be a universal gesture for escaping the local context and calling up the desktop menu."  
	"cmdMap at: (27 + 1) put: #shiftEnclose:." 	"ctrl-["

	"'""''(' do: [ :char | cmdMap at: (char asciiValue + 1) put: #enclose:]."

	cmds _ #(
		$c	compareToClipboard:
		$d	duplicate:
		$h	cursorTopHome:
		$j	doAgainMany:
		$k	changeStyle:
		$l	outdent:
		$m	selectCurrentTypeIn:
		$r	indent:
		$s	search:
		$u	changeLfToCr:
		$x	makeLowercase:
		$y	makeUppercase:
		$z	makeCapitalized:
	).
	1 to: cmds size by: 2 do: [ :i |
		cmdMap at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1).			"plain keys"
		cmdMap at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1).		"shifted keys"
		cmdMap at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1).		"ctrl keys"
	].
	shiftCmdActions _ cmdMap! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:21'!
initializeCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table."

	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"

	"TextEditor initialize"

	| cmds |
	self initializeBasicCmdKeyShortcuts.
			
	'0123456789-=' 
		do: [:char | cmdActions at: char asciiValue + 1 put: #changeEmphasis:].
	
	cmds := #($k #offerFontMenu: $u #align: ).
	1 to: cmds size
		by: 2
		do: [:i | cmdActions at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)]! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:25'!
initializeShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."
	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
	"wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the 
	capitalized versions of the letters.
	TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."

	"TextEditor initialize"
	
	| cmds |

	self initializeBasicShiftCmdKeyShortcuts.
	shiftCmdActions at: (45 + 1) put: #changeEmphasis:.		"cmd-sh-minus"
	shiftCmdActions at: (61 + 1) put: #changeEmphasis:.		"cmd-sh-plus"

	cmds _ #(
		$k	changeStyle:
	).
	1 to: cmds size by: 2 do: [ :i |
		shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1).			"plain keys"
		shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1).		"shifted keys"
		shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1).		"ctrl keys"
	].! !


!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:21'!
initializeCmdKeyShortcuts
	"Initialize the (unshifted) command-key (or alt-key) shortcut table."

	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"

	"SmalltalkEditor initialize"

	| cmds |
	self initializeBasicCmdKeyShortcuts.
	
	cmds := #($b #browseIt: $d #doIt: $i #inspectIt: $j #doAgainOnce: $l #cancel: $m #implementorsOfIt: $n #sendersOfIt: $o #spawnIt: $p #printIt: $q #querySymbol: $s #save: ).
	1 to: cmds size
		by: 2
		do: [:i | cmdActions at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)]! !

!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:25'!
initializeShiftCmdKeyShortcuts 
	"Initialize the shift-command-key (or control-key) shortcut table."
	"NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
	"wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the 
	capitalized versions of the letters.
	TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."

	"SmalltalkEditor initialize"

	| cmds |
 	self initializeBasicShiftCmdKeyShortcuts.
	
	cmds _ #(
		$a	argAdvance:
		$b	browseItHere:
		$e	methodStringsContainingIt:
		$f	displayIfFalse:
		$g	fileItIn:
		$i	exploreIt:
		$n	referencesToIt:
		$t	displayIfTrue:
		$v	pasteInitials:
		$w	methodNamesContainingIt:
	).
	1 to: cmds size by: 2 do: [ :i |
		shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1).			"plain keys"
		shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1).		"shifted keys"
		shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1).		"ctrl keys"
	].! !

!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 8/18/2009 18:26'!
initializeShiftedYellowButtonMenu
	"Initialize the yellow button pop-up menu and corresponding messages."

	"SmalltalkEditor initialize"

	shiftedYellowButtonMenu _ SelectionMenu fromArray: {
		{'explain' translated.					#explain}.
		{'pretty print' translated.				#prettyPrint}.
		{'file it in (G)' translated.					#fileItIn}.
		{'spawn (o)' translated.					#spawn}.
		#-.
		{'browse it (b)' translated.				#browseIt}.
		{'senders of it (n)' translated.			#sendersOfIt}.
		{'implementors of it (m)' translated.		#implementorsOfIt}.
		{'references to it (N)' translated.			#referencesToIt}.
		#-.
		{'selectors containing it (W)' translated.	#methodNamesContainingIt}.
		{'method strings with it (E)' translated.	#methodStringsContainingit}.
		{'method source with it' translated.		#methodSourceContainingIt}.
		{'class names containing it' translated.	#classNamesContainingIt}.
		{'class comments with it' translated.		#classCommentsContainingIt}.
		{'change sets with it' translated.			#browseChangeSetsWithSelector}.
		#-.
		{'save contents to file...' translated.		#saveContentsInFile}.
		#-.
		{'more...' translated.						#yellowButtonActivity}.
	}! !


!TimeProfileBrowser methodsFor: 'message list' stamp: 'jmv 8/18/2009 18:01'!
selectedMessage
	"Answer the source method for the currently selected message."
	| source |
	self setClassAndSelectorIn: [:class :selector | 
		source _ class sourceMethodAt: selector ifAbsent: [^ 'Missing'].
		Preferences browseWithPrettyPrint ifTrue:
			[source _ class compilerClass new
				format: source in: class notifying: nil ].
		self selectedClass: class.
		self selectedSelector: selector.
		^ source asText makeSelectorBoldIn: class].
	^''! !

WriteStream removeSelector: #nextChunkPutWithStyle:!
TextURL class removeSelector: #scanFrom:!
TextSqkPageLink removeSelector: #writeScanOn:!
TextURL removeSelector: #writeScanOn:!
TextPrintIt removeSelector: #writeScanOn:!
TextLink class removeSelector: #scanFrom:!
TextLink removeSelector: #writeScanOn:!
TextKern removeSelector: #couldDeriveFromPrettyPrinting!
TextKern removeSelector: #writeScanOn:!
TextFontReference removeSelector: #couldDeriveFromPrettyPrinting!
TextFontReference removeSelector: #writeScanOn:!
TextEmphasis removeSelector: #writeScanOn:!
TextDoIt class removeSelector: #scanFrom:!
TextDoIt removeSelector: #writeScanOn:!
TextColor class removeSelector: #scanFrom:!
TextColor removeSelector: #writeScanOn:!
TextAnchor removeSelector: #couldDeriveFromPrettyPrinting!
TextAlignment removeSelector: #writeScanOn:!
TextAction removeSelector: #couldDeriveFromPrettyPrinting!
TextAttribute removeSelector: #couldDeriveFromPrettyPrinting!
Text removeSelector: #askIfAddStyle:req:!
Text removeSelector: #couldDeriveFromPrettyPrinting!
String removeSelector: #askIfAddStyle:req:!
SmalltalkEditor removeSelector: #prettyPrint:!
SmalltalkEditor removeSelector: #prettyPrintWithColor!
RunArray class removeSelector: #scanFrom:!
RunArray removeSelector: #writeScanOn:!
Preferences class removeSelector: #colorWhenPrettyPrinting!
Preferences class removeSelector: #confirmFirstUseOfStyle!
Preferences class removeSelector: #ignoreStyleIfOnlyBold!
PositionableStream removeSelector: #fileInFor:announcing:!
PositionableStream removeSelector: #skipSeparatorsAndPeekNext!
PluggableTextMorph removeSelector: #prettyPrintWithColor!
MethodNode removeSelector: #decompileText!
ContextPart removeSelector: #methodNodeFormattedAndDecorated:!
Compiler removeSelector: #format:in:notifying:decorated:!
CompiledMethod removeSelector: #methodNodeFormattedAndDecorated:!
CompiledMethod removeSelector: #methodNodeFormattedDecompileClass:selector:decorate:!
CodeHolder removeSelector: #colorPrintString!
CodeHolder removeSelector: #showingColorPrint!
CodeHolder removeSelector: #toggleColorPrint!
