'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 6 November 2008 at 8:29:29 am'!

!OldPluggableTextMorph methodsFor: 'updating' stamp: 'jmv 11/5/2008 22:22'!
update: aSymbol 
	aSymbol ifNil: [^self].
	aSymbol == #flash ifTrue: [^self flash].
	aSymbol == getTextSelector 
		ifTrue: 
			[self setText: self getText.
			^self setSelection: self getSelection].
	aSymbol == getSelectionSelector 
		ifTrue: [^self setSelection: self getSelection].
	(aSymbol == #autoSelect and: [getSelectionSelector notNil]) 
		ifTrue: 
			[self handleEdit: 
					[TextEditor abandonChangeText.	"no replacement!!"
					(textMorph editor)
						setSearch: model autoSelectString;
						againOrSame: true]].
	aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false].
	aSymbol == #wantToChange 
		ifTrue: 
			[self canDiscardEdits ifFalse: [^self promptForCancel].
			^self].
	aSymbol == #appendEntry 
		ifTrue: 
			[self handleEdit: [self appendEntry].
			^self refreshWorld].
	aSymbol == #clearText 
		ifTrue: 
			[self handleEdit: [self changeText: Text new].
			^self refreshWorld].
	aSymbol == #bs 
		ifTrue: 
			[self handleEdit: [self bsText].
			^self refreshWorld].
	aSymbol == #codeChangedElsewhere 
		ifTrue: 
			[self hasEditingConflicts: true.
			^self changed]! !


!OldTextMorph methodsFor: 'private' stamp: 'jmv 11/6/2008 08:26'!
installEditorToReplace: priorEditor 
	"Install an editor for my paragraph.  This constitutes 'hasFocus'.
	If priorEditor is not nil, then initialize the new editor from its state.
	We may want to rework this so it actually uses the prior editor."

	| stateArray |
	priorEditor ifNotNil: [stateArray := priorEditor stateArray].
	editor := TextEditor new morph: self.
	editor changeParagraph: self paragraph.
	priorEditor ifNotNil: [editor stateArrayPut: stateArray].
	self selectionChanged.
	^editor! !


!Parser methodsFor: 'public access' stamp: 'jmv 11/6/2008 08:26'!
parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
	"Answer a MethodNode for the argument, sourceStream, that is the root of 
        a parse tree. Parsing is done with respect to the argument, class, to find 
        instance, class, and pool variables; and with respect to the argument, 
        ctxt, to find temporary variables. Errors in parsing are reported to the 
        argument, req, if not nil; otherwise aBlock is evaluated. The argument 
        noPattern is a Boolean that is true if the the sourceStream does not 
        contain a method header (i.e., for DoIts)."

	| methNode repeatNeeded myStream s p |
	myStream := sourceStream.
	
	[repeatNeeded := false.
	p := myStream position.
	s := myStream upToEnd.
	myStream position: p.
	self 
		init: myStream
		notifying: req
		failBlock: [^aBlock value].
	doitFlag := noPattern.
	failBlock := aBlock.
	
	[methNode := self 
				method: noPattern
				context: ctxt
				encoder: (Encoder new 
						init: class
						context: ctxt
						notifying: self)] 
			on: ParserRemovedUnusedTemps
			do: 
				[:ex | 
				repeatNeeded := (requestor isKindOf: TextEditor) not.
				myStream := ReadStream on: requestor text string.
				ex resume].
	repeatNeeded] 
			whileTrue.
	encoder := failBlock := requestor := parseNode := nil.	"break cycles & mitigate refct overflow"
	methNode sourceText: s.
	^methNode! !


!StringHolder methodsFor: 'code pane menu' stamp: 'jmv 11/6/2008 08:23'!
codePaneMenu: aMenu shifted: shifted
	"Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items in a text pane"
	| donorMenu |
	donorMenu _ shifted
		ifTrue:
			[TextEditor shiftedYellowButtonMenu]
		ifFalse:
			[TextEditor yellowButtonMenu].
	^ aMenu labels: donorMenu labelString lines: donorMenu lineArray selections: donorMenu selections! !


!FileList methodsFor: 'file list menu' stamp: 'jmv 11/6/2008 08:23'!
fileContentsMenu: aMenu shifted: shifted
	"Construct aMenu to have items appropriate for the file browser's code pane, given the shift state provided"

	| shiftMenu services maybeLine extraLines |
	shifted ifTrue:
		[shiftMenu _ TextEditor shiftedYellowButtonMenu.
		^ aMenu 
			labels: shiftMenu labelString 
			lines: shiftMenu lineArray
			selections: shiftMenu selections].
	fileName ifNotNil:
		[services _ OrderedCollection new.
		(#(briefHex briefFile needToGetBriefHex needToGetBrief) includes: brevityState) ifTrue:
			[services add: self serviceGet].
		(#(fullHex briefHex needToGetFullHex needToGetBriefHex) includes: brevityState) ifFalse:
			[services add: self serviceGetHex].
		maybeLine _ services size.
		(#('st' 'cs') includes: self suffixOfSelectedFile) ifTrue:
			[services addAll:
				(self servicesFromSelectorSpecs:
					#(fileIntoNewChangeSet: fileIn: browseChangesFile: browseFile:))].

		extraLines _ OrderedCollection new.
		maybeLine > 0 ifTrue: [extraLines add: maybeLine].
		services size > maybeLine ifTrue: [extraLines add: services size].
		aMenu 
			addServices: services
			for: self fullName
			extraLines: extraLines].

	aMenu addList: {
			{'find...(f)' translated.		#find}.
			{'find again (g)' translated.		#findAgain}.
			{'set search string (h)' translated.	#setSearchString}.
			#-.
			{'do again (j)' translated.		#again}.
			{'undo (z)' translated.			#undo}.
			#-.
			{'copy (c)' translated.			#copySelection}.
			{'cut (x)' translated.			#cut}.
			{'paste (v)' translated.		#paste}.
			{'paste...' translated.			#pasteRecent}.
			#-.
			{'do it (d)' translated.		#doIt}.
			{'print it (p)' translated.		#printIt}.
			{'inspect it (i)' translated.		#inspectIt}.
			{'fileIn selection (G)' translated.	#fileItIn}.
			#-.
			{'accept (s)' translated.		#accept}.
			{'cancel (l)' translated.		#cancel}.
			#-.
			{'more...' translated.			#shiftedYellowButtonActivity}}.


	^ aMenu
! !


!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 11/4/2008 00:41'!
discardOddsAndEnds
	"This method throws out lots of classes that are not frequently used."
	"Smalltalk discardOddsAndEnds"

	SystemOrganization removeSystemCategory: 'System-Serial Port'.
	SystemOrganization removeSystemCategory: 'ST80-Symbols'.
	SystemOrganization removeSystemCategory: 'Tools-File Contents Browser'.
	SystemOrganization removeSystemCategory: 'System-Compression'.
	SystemOrganization removeSystemCategory: 'Tools-Explorer'.
	SystemOrganization removeSystemCategory: 'System-Digital Signatures'.

	Form removeSelector: #edit.
	Smalltalk removeClassNamed: #FormEditorView.
	Smalltalk removeClassNamed: #FormEditor.
	SystemOrganization removeSystemCategory: 'ST80-Paths'.

	"bit editor (remove Form editor first):"
	Form removeSelector: #bitEdit.
	Form removeSelector: #bitEditAt:scale:.
	StrikeFont removeSelector: #edit:.
	Smalltalk removeClassNamed: #FormButtonCache.
	Smalltalk removeClassNamed: #FormMenuController.
	Smalltalk removeClassNamed: #FormMenuView.
	Smalltalk removeClassNamed: #BitEditor.

	"inspector for Dictionaries of Forms"
	Dictionary removeSelector: #inspectFormsWithLabel:.
	Smalltalk removeClassNamed: #FormHolderView.
	Smalltalk removeClassNamed: #FormInspectView.

	"experimental updating object viewer:"
	Object removeSelector: #evaluate:wheneverChangeIn:.
	Smalltalk removeClassNamed: #ObjectViewer.
	Smalltalk removeClassNamed: #ObjectTracer.

	"miscellaneous classes:"
	Smalltalk removeClassNamed: #Array2D.
	Smalltalk removeClassNamed: #DriveACar.
	Smalltalk removeClassNamed: #EventRecorder.
	Smalltalk removeClassNamed: #FindTheLight.
	Smalltalk removeClassNamed: #PluggableTest.
	Smalltalk removeClassNamed: #SystemMonitor.
	Smalltalk removeClassNamed: #DocLibrary.

	Smalltalk removeClassNamed: #ProtocolBrowser.
	Smalltalk removeClassNamed: #ObjectExplorerWrapper.
	Smalltalk removeClassNamed: #HierarchyBrowser.
	Smalltalk removeClassNamed: #LinkedMessageSet.
	Smalltalk removeClassNamed: #ObjectExplorer.
	Smalltalk removeClassNamed: #PackageBrowser.
	Smalltalk removeClassNamed: #AbstractHierarchicalList.
	Smalltalk removeClassNamed: #ChangeList.
	Smalltalk removeClassNamed: #VersionsBrowser.
	Smalltalk removeClassNamed: #ChangeRecord.
	Smalltalk removeClassNamed: #SelectorBrowser.
	Smalltalk removeClassNamed: #HtmlFileStream.
	Smalltalk removeClassNamed: #CrLfFileStream.
	Smalltalk removeClassNamed: #FXGrafPort.
	Smalltalk removeClassNamed: #FXBlt.

	Smalltalk at: #SampledSound ifPresent: [:c |c initialize].
	#(Helvetica Palatino Courier ComicBold ComicPlain) do:
		[:k | TextConstants removeKey: k ifAbsent: []].

Preferences setButtonFontTo:	(StrikeFont familyName: #NewYork size: 12).
Preferences setFlapsFontTo:	(StrikeFont familyName: #NewYork size: 12).

#(GZipConstants ZipConstants KlattResonatorIndices ) do:
	[:k | Smalltalk removeKey: k ifAbsent: []].
! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 11/6/2008 08:25'!
presumedSentMessages   | sent |
"Smalltalk presumedSentMessages"

	"The following should be preserved for doIts, etc"
	sent _ IdentitySet new.
	#( rehashWithoutBecome compactSymbolTable rebuildAllProjects
		browseAllSelect:  lastRemoval
		vScrollBarValue: scrollBarMenuButtonPressed: 
		withSelectionFrom:  to: removeClassNamed:
		dragon: hilberts: mandala: web test3 factorial tinyBenchmarks benchFib
		newDepth: restoreAfter: forgetDoIts zapAllMethods obsoleteClasses
		removeAllUnSentMessages abandonSources removeUnreferencedKeys
		reclaimDependents zapOrganization condenseChanges browseObsoleteReferences
		subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
		methodsFor:stamp: methodsFor:stamp:prior: instanceVariableNames:
		startTimerInterruptWatcher unusedClasses) do:
		[:sel | sent add: sel].
	"The following may be sent by perform: in dispatchOnChar..."
	(TextEditor classPool at: #CmdActions) asSet do:
		[:sel | sent add: sel].
	(TextEditor classPool at: #ShiftCmdActions) asSet do:
		[:sel | sent add: sel].
	^ sent! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 11/6/2008 08:25'!
removeAllUnSentMessages
	"Smalltalk removeAllUnSentMessages"
	"[Smalltalk unusedClasses do: [:c | (Smalltalk at: c) removeFromSystem]. 
	Smalltalk removeAllUnSentMessages > 0] whileTrue."
	"Remove all implementations of unsent messages."
	| sels n |
	sels _ self allUnSentMessages.
	"The following should be preserved for doIts, etc"
	"needed even after #majorShrink is pulled"
	#(#rehashWithoutBecome #compactSymbolTable #rebuildAllProjects #browseAllSelect:  #lastRemoval vScrollBarValue: #scrollBarMenuButtonPressed: #withSelectionFrom: #to: #removeClassNamed: #dragon: #hilberts: #mandala: #web #test3 #factorial #tinyBenchmarks #benchFib #newDepth: #restoreAfter: #forgetDoIts #zapAllMethods #obsoleteClasses #removeAllUnSentMessages #abandonSources #removeUnreferencedKeys #reclaimDependents #zapOrganization #condenseChanges #browseObsoleteReferences #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: #methodsFor:stamp: #methodsFor:stamp:prior: #instanceVariableNames: #startTimerInterruptWatcher #unusedClasses )
		do: [:sel | sels
				remove: sel
				ifAbsent: []].
	"The following may be sent by perform: in dispatchOnChar..."
	(TextEditor classPool at: #CmdActions) asSet
		do: [:sel | sels
				remove: sel
				ifAbsent: []].
	(TextEditor classPool at: #ShiftCmdActions) asSet
		do: [:sel | sels
				remove: sel
				ifAbsent: []].
	sels size = 0
		ifTrue: [^ 0].
	n _ 0.
	Smalltalk
		allBehaviorsDo: [:x | n _ n + 1].
	'Removing ' , sels size printString , ' messages . . .'
		displayProgressAt: Sensor cursorPoint
		from: 0
		to: n
		during: [:bar | 
			n _ 0.
			self
				allBehaviorsDo: [:class | 
					bar value: (n _ n + 1).
					sels
						do: [:sel | class basicRemoveSelector: sel]]].
	^ sels size! !


!TextEditor class methodsFor: 'class initialization' stamp: 'jmv 11/5/2008 22:21'!
abandonChangeText
	"Call this to get out of the maddening situation in which the system keeps aggressively trying to do a replacement that you no longer wish to make, every time you make choose a new method in a list."
	ChangeText _ FindText

	"
	TextEditor abandonChangeText
	"! !

