'From Cuis 1.0 of 16 July 2009 [latest update: #228] on 22 July 2009 at 4:28:39 pm'!

!Editor commentStamp: '<historical>' prior: 0!
New text editors.
TextEditor provides most of the functionality that used to be in TextMorphEditor. This class is no longer a Controller!!
SmalltalkEditor is has Smalltalk code specific features.
SimpleEditor provides basic functionality for single line text editing. It does not handle fonts and styles, aligning and Smalltalk utilities. It handles one single line.
CellStyleEditor allows entering alphabetic characters using only number keys, like most cell phones do.!
]style[(83 386)cblack;,f4cblack;!


!StringHolder commentStamp: 'jmv 7/21/2009 12:15' prior: 0!
I am a kind of Model that includes a piece of text.  In some cases, the text can be edited, and in some the text is a method.

Categories 'code pane menu' and 'message list menu' are messages that may be called by my menus when the text is a method, and when some pane is a list of methods.  Other of my subclasses may ignore these two catagories altogether.

See the comment in CodeHolder. When the Smalltalk code specific code in this class is moved down to CodeHolder, see inheritance of #paneMenu:shifted: and #editorClass. This method is redefined in subclasses that should perhaps be made subclasses of CodeHolder.!

!classDefinition: #TextEditor category: #'System-Text'!
Editor subclass: #TextEditor
	instanceVariableNames: 'model paragraph pointBlock markBlock beginTypeInBlock emphasisHere otherInterval lastParenLocation oldInterval '
	classVariableNames: 'ChangeText CmdActions FindText ShiftCmdActions TextEditorYellowButtonMenu UndoInterval UndoMessage UndoParagraph UndoSelection Undone '
	poolDictionaries: ''
	category: 'System-Text'!

!TextEditor commentStamp: '<historical>' prior: 0!
See comment in Editor.

My instances edit Text, this is, they support multiple lines and TextAttributes.
They have no specific facilities for editing Smalltalk code. Those are found in SmalltalkEditor.!

!classDefinition: #SmalltalkEditor category: #'System-Text'!
TextEditor subclass: #SmalltalkEditor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Text'!

!SmalltalkEditor commentStamp: '<historical>' prior: 0!
The editor built specifically for Smalltalk code!

!classDefinition: 'TextEditor class' category: nil!
TextEditor class
	instanceVariableNames: 'shiftedYellowButtonMenu yellowButtonMenu cmdActions shiftCmdActions '!

!TextLine commentStamp: '<historical>' prior: 0!
A TextLine embodies the layout of a line of composed text.
	left right top bottom		The full line rectangle
	firstIndex lastIndex		Starting and stopping indices in the full text
	internalSpaces				Number of spaces to share paddingWidth
	paddingWidth				Number of pixels of extra space in full line
	baseline					Distance of baseline below the top of the line
	leftMargin					Left margin due to paragraph indentation
TextLine's rather verbose message protocol is required for compatibility with the old CharacterScanners.!

!classDefinition: #TextMorph category: #'Morphic-OldText Support'!
RectangleMorph subclass: #TextMorph
	instanceVariableNames: 'textStyle text wrapFlag paragraph editor container backgroundColor margins '
	classVariableNames: 'CaretForm '
	poolDictionaries: ''
	category: 'Morphic-OldText Support'!

!Object methodsFor: 'testing' stamp: 'jmv 7/21/2009 15:08'!
is: aSymbol
	"A means for cleanly replacing all isXXX like methods.
	Please use judiciously!!
	Suggested by Igor Stasenko at
	http://lists.squeakfoundation.org/pipermail/squeak-dev/2009-June/136793.html"

	^false! !


!ChangeSet methodsFor: 'accessing' stamp: 'jmv 7/21/2009 12:59'!
editPostscript
	"edit the receiver's postscript, in a separate window.  "

	| deps found |
	self assurePostscriptExists.
	deps := postscript dependents 
				select: [:m | m isSystemWindow].
	deps size > 0 
		ifTrue: [
			found := deps detect: [:obj | obj isSystemWindow and: [obj world == self currentWorld]] ifNone: [nil].
			found ifNotNil: [^found activate].

			self 
				inform: 'Caution -- there' , (deps size isOrAreStringWith: 'other window') 
						, '
already open on this postscript elsewhere'].
	postscript openLabel: 'Postscript for ChangeSet named ' , name! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 7/21/2009 13:07'!
assurePostscriptExists
	"Make sure there is a StringHolder holding the postscript.  "

	"NOTE: FileIn recognizes the postscript by the line with Postscript: on it"
	postscript == nil ifTrue: [postscript _ CodeHolder new contents: '"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
']! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 7/21/2009 13:06'!
assurePreambleExists
	"Make sure there is a StringHolder holding the preamble; if it's found to have reverted to empty contents, put up the template"

	(preamble == nil or: [preamble contents isEmptyOrNil])
		ifTrue: [preamble _ CodeHolder new contents: self preambleTemplate]! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 7/21/2009 13:02'!
postscriptString: aString
	"Establish aString as the new contents of the postscript.  "

	postscript _ CodeHolder new contents: aString! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 7/21/2009 13:06'!
preambleString: aString
	"Establish aString as the new contents of the preamble.  "

	preamble _ CodeHolder new contents: aString! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 7/21/2009 13:06'!
setPreambleToSay: aString
	"Make aString become the preamble of this change set"

	preamble _ CodeHolder new contents: aString! !


!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 7/21/2009 11:23'!
createTextPaneExtent: answerExtent acceptBoolean: acceptBoolean
	"create the textPane"
	| result frame |
	result := PluggableTextMorph
				on: self
				text: #response
				accept: #response:
				readSelection: #selectionInterval
				menu: #paneMenu:shifted:.
	result extent: answerExtent.
	result borderWidth: 1.
	result hasUnacceptedEdits: true.
	result acceptOnCR: acceptBoolean.
	frame := LayoutFrame new.
	frame leftFraction: 0.0;
		 rightFraction: 1.0;
		 topFraction: 0.2;
		 bottomFraction: 0.7.
	result layoutFrame: frame.
	self addMorph: result.
	^ result! !

!FillInTheBlankMorph methodsFor: 'menu' stamp: 'jmv 7/21/2009 11:23'!
paneMenu: aMenu shifted: shifted

	^ StringHolder new paneMenu: aMenu shifted: shifted.
! !


!NewParagraph methodsFor: 'display' stamp: 'jmv 7/20/2009 17:03'!
caretWidth
	^ 1! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 7/21/2009 00:44'!
displayInsertionMarkAtX: x top: top bottom: bottom width: width emphasis: emphasis on: aCanvas
			
	| caretColor w2 e w x0 x1 x2 isBold isItalic |
	isBold _ emphasis allMask: 1.
	isItalic _ emphasis allMask: 2.
	caretColor _ self insertionPointColor.
	w _ width.
	isBold ifTrue: [ w _ w + 1 ].
	w2 _ w * 2.
	x0 _ x - w2 - 1.
	isItalic ifTrue: [
		x1 _ x0+w2.
		x2 _ x0-w2 ]
	ifFalse: [ x1 _ x2 _ x0 ].
	1 to: w2 do: [:i | 
		"Draw caret triangles at top and bottom"
		e _ (w2 - i) * 2 + 3 @ 1.
		aCanvas fillRectangle: (x1 + i @ (top + i - 1) extent: e)
			color: caretColor.
		aCanvas fillRectangle: (x2 + i @ (bottom - i) extent: e)
			color: caretColor].
	aCanvas fillRectangle: (x-w+1 @ top corner: x+w @ bottom)
		color: caretColor! !

!NewParagraph methodsFor: 'display' stamp: 'jmv 7/21/2009 00:46'!
displaySelectionInLine: line on: aCanvas 
	| leftX rightX idx caretFont t b caretEmphasis |
	selectionStart ifNil: [^self].	"No selection"
	selectionStart = selectionStop 
		ifTrue: [
			"Only show caret on line where clicked"
			selectionStart textLine ~= line ifTrue: [^self]]
		ifFalse: [
			"Test entire selection before or after here"
			(selectionStop stringIndex < line first 
				or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self].	"No selection on this line"
			(selectionStop stringIndex = line first 
				and: [selectionStop textLine ~= line]) ifTrue: [^self].	"Selection ends on line above"
			(selectionStart stringIndex = (line last + 1) 
				and: [selectionStop textLine ~= line]) ifTrue: [^self]].	"Selection begins on line below"
	leftX := (selectionStart stringIndex < line first 
				ifTrue: [line ]
				ifFalse: [selectionStart ]) left.
	rightX := (selectionStop stringIndex > (line last + 1) or: [
					selectionStop stringIndex = (line last + 1) 
						and: [selectionStop textLine ~= line]]) 
				ifTrue: [line right]
				ifFalse: [selectionStop left].
	selectionStart = selectionStop 
		ifTrue: [
			idx _ selectionStart stringIndex.
			caretFont _ text fontAt: idx withStyle: textStyle.
			caretEmphasis _ text emphasisAt: idx.
			b _ line top + line baseline + caretFont descent.
			t _ line top + line baseline - caretFont ascent.
			self
				displayInsertionMarkAtX: leftX
				top: t
				bottom: b
				width: self caretWidth
				emphasis: caretEmphasis
				on: aCanvas
			]
		ifFalse: [
			aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
				color: self selectionColor]! !

!NewParagraph methodsFor: 'fonts-display' stamp: 'jmv 7/20/2009 15:15'!
displayOn: aCanvas using: displayScanner at: somePosition
	"Send all visible lines to the displayScanner for display"
	| visibleRectangle offset leftInRun line |
	visibleRectangle _ aCanvas clipRect.
	offset _ (somePosition - positionWhenComposed) truncated.
	leftInRun _ 0.
	(self lineIndexForPoint: visibleRectangle topLeft)
		to: (self lineIndexForPoint: visibleRectangle bottomRight)
		do: [:i | line _ lines at: i.
			self displaySelectionInLine: line on: aCanvas.
			line first <= line last ifTrue: [
				leftInRun _ displayScanner displayLine: line offset: offset leftInRun: leftInRun]].
! !

!NewParagraph methodsFor: 'selection' stamp: 'jmv 7/20/2009 17:02'!
selectionRectsFrom: characterBlock1 to: characterBlock2 
	"Return an array of rectangles representing the area between the two character blocks given as arguments."
	| line1 line2 rects cb1 cb2 w |
	characterBlock1 <= characterBlock2
		ifTrue: [cb1 _ characterBlock1.  cb2 _ characterBlock2]
		ifFalse: [cb2 _ characterBlock1.  cb1 _ characterBlock2].
	cb1 = cb2 ifTrue:
		[w _ self caretWidth*2.
		^ Array with: (cb1 topLeft - (w@0) corner: cb1 bottomLeft + ((w+1)@0))].
	line1 _ self lineIndexForCharacter: cb1 stringIndex.
	line2 _ self lineIndexForCharacter: cb2 stringIndex.
	line1 = line2 ifTrue:
		[^ Array with: (cb1 topLeft corner: cb2 bottomRight)].
	rects _ OrderedCollection new.
	rects addLast: (cb1 topLeft corner: (lines at: line1) bottomRight).
	line1+1 to: line2-1 do: [ :i |
		| line |
		line := lines at: i.
		(line left = rects last left and: [ line right = rects last right ])
			ifTrue: [ "new line has same margins as old one -- merge them, so that the caller gets as few rectangles as possible"
					| lastRect |
					lastRect := rects removeLast.
					rects add: (lastRect bottom: line bottom) ]
			ifFalse: [ "differing margins; cannot merge"
					rects add: line rectangle ] ].

	rects addLast: ((lines at: line2) topLeft corner: cb2 bottomLeft).
	^ rects! !


!ObjectExplorer methodsFor: 'accessing' stamp: 'jmv 7/22/2009 15:41'!
editorClass
	^SmalltalkEditor! !

!ObjectExplorer methodsFor: 'accessing' stamp: 'jmv 7/21/2009 11:24'!
explorerFor: anObject 
	| window listMorph |
	rootObject := anObject.
	window := (SystemWindow labelled: (rootObject printStringLimitedTo: 64)) model: self.
	window addMorph: (listMorph := SimpleHierarchicalListMorph 
						on: self
						list: #getList
						selected: #getCurrentSelection
						changeSelected: #noteNewSelection:
						menu: #genericMenu:
						keystroke: #explorerKey:from:)
		frame: (0 @ 0 corner: 1 @ 0.8).
	window 
		addMorph: ((PluggableTextMorph 
				on: self
				text: #trash
				accept: #trash:
				readSelection: #contentsSelection
				menu: #paneMenu:shifted:) askBeforeDiscardingEdits: false)
		frame: (0 @ 0.8 corner: 1 @ 1).
	listMorph autoDeselect: false.
	^window! !

!ObjectExplorer methodsFor: 'menus' stamp: 'jmv 7/22/2009 15:40'!
paneMenu: aMenu shifted: shifted
	"Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items"
	^ CodeHolder basicNew paneMenu: aMenu shifted: shifted
! !

!ObjectExplorer methodsFor: 'testing' stamp: 'jmv 7/22/2009 15:40'!
is: aSymbol
	^ aSymbol = #knowsEditorClass or: [ super is: aSymbol ]! !


!PasteUpMorph methodsFor: 'errors on draw' stamp: 'jmv 7/20/2009 17:22'!
removeAllKnownFailing
	worldState removeAllKnownFailing.
	self changed! !


!PluggableTextMorph methodsFor: 'drawing' stamp: 'jmv 7/21/2009 15:14'!
wantsFrameAdornments
	"Answer whether the receiver wishes to have red borders, etc., used to show editing state"

	"A 'long-term temporary workaround': a nonmodular, unsavory, but expedient way to get the desired effect, sorry.  Clean up someday."

	(model is: #CodeHolder) ifFalse: [^false].
	^ (#(annotation searchString infoViewContents) includes: getTextSelector) not! !


!String methodsFor: 'user interface' stamp: 'jmv 7/22/2009 15:48'!
edit

	StringHolder new contents: self; openLabel: 'Text Editor'! !


!StringHolder methodsFor: 'initialize-release' stamp: 'jmv 7/21/2009 11:24'!
embeddedInMorphicWindowLabeled: labelString wrap: aBoolean
	| window |
	window _ (SystemWindow labelled: labelString) model: self.
	window addMorph: ((PluggableTextMorph 
		on: self 
		text: #contents 
		accept: #acceptContents:
		readSelection: nil 
		menu: #paneMenu:shifted:)
			wrapFlag: aBoolean)
				frame: (0@0 corner: 1@1).
	^ window! !

!StringHolder methodsFor: 'initialize-release' stamp: 'jmv 7/21/2009 11:24'!
openAsMorphLabel: labelString  inWorld: aWorld
	"Workspace new openAsMorphLabel: 'Workspace'"
	| window |
	window _ (SystemWindow labelled: labelString) model: self.

	window addMorph: (PluggableTextMorph on: self text: #contents accept: #acceptContents:
			readSelection: nil menu: #paneMenu:shifted:)
		frame: (0@0 corner: 1@1).

	window openInWorld: aWorld! !

!StringHolder methodsFor: 'code pane menu' stamp: 'jmv 7/21/2009 12:12'!
editorClass
	^TextEditor! !

!StringHolder methodsFor: 'code pane menu' stamp: 'jmv 7/21/2009 15:51'!
paneMenu: 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: [
			self editorClass shiftedYellowButtonMenu]
		ifFalse: [
			self editorClass yellowButtonMenu].
	aMenu labels: donorMenu labelString lines: donorMenu lineArray selections: donorMenu selections.
	aMenu addTitle: 'Text Editor'; addStayUpIcons.
	^aMenu! !

!StringHolder methodsFor: 'testing' stamp: 'jmv 7/21/2009 15:11'!
is: aSymbol
	^ aSymbol = #knowsEditorClass or: [ super is: aSymbol ]! !


!CodeHolder methodsFor: 'construction' stamp: 'jmv 7/21/2009 11:23'!
buildMorphicCodePaneWith: editString
	"Construct the pane that shows the code.
	Respect the Preference for standardCodeFont."

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

!CodeHolder methodsFor: 'testing' stamp: 'jmv 7/21/2009 15:14'!
is: aSymbol
	^ aSymbol = #CodeHolder or: [ super is: aSymbol ]! !

!CodeHolder methodsFor: 'code pane menu' stamp: 'jmv 7/21/2009 12:12'!
editorClass
	^SmalltalkEditor! !


!Browser methodsFor: 'class comment pane' stamp: 'jmv 7/21/2009 11:23'!
buildMorphicCommentPane
	"Construct the pane that shows the class comment.
	Respect the Preference for standardCodeFont."

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


!ChangeList methodsFor: 'menu actions' stamp: 'jmv 7/21/2009 11:23'!
buildMorphicCodePaneWith: editString

	| codePane |

	codePane _ AcceptableCleanTextMorph
		on: self
		text: #contents 
		accept: #contents:
		readSelection: #contentsSelection 
		menu: #paneMenu:shifted:.
	editString ifNotNil: [
		codePane editString: editString.
		codePane hasUnacceptedEdits: true
	].
	^codePane
! !


!Debugger methodsFor: 'initialize' stamp: 'jmv 7/21/2009 11:25'!
openFullMorphicLabel: aLabelString
	"Open a full morphic debugger with the given label"

	| window aListMorph oldContextStackIndex |
	oldContextStackIndex _ contextStackIndex.
	self expandStack. "Sets contextStackIndex to zero."

	window _ (SystemWindow labelled: aLabelString) model: self.
	aListMorph _ PluggableListMorph on: self list: #contextStackList
			selected: #contextStackIndex changeSelected: #toggleContextStackIndex:
			menu: #contextStackMenu:shifted: keystroke: #contextStackKey:from:.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0@0 corner: 1@0.25).

	self addLowerPanesTo: window at: (0@0.25 corner: 1@0.8) with: nil.

	window addMorph: (
		PluggableListMorph new
			doubleClickSelector: #inspectSelection;

			on: self receiverInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:)
		frame: (0@0.8 corner: 0.2@1).
	window addMorph: (PluggableTextMorph on: self receiverInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #paneMenu:shifted:)
		frame: (0.2@0.8 corner: 0.5@1).
	window addMorph: (
		PluggableListMorph new
			doubleClickSelector: #inspectSelection;

			on: self contextVariablesInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:)
		frame: (0.5@0.8 corner: 0.7@1).
	window addMorph: (PluggableTextMorph on: self contextVariablesInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #paneMenu:shifted:)
		frame: (0.7@0.8 corner: 1@1).
	window openInWorld.
	self toggleContextStackIndex: oldContextStackIndex.
	^ window ! !

!Debugger methodsFor: 'as yet unclassified' stamp: 'jmv 7/21/2009 11:23'!
paneMenu: aMenu shifted: shifted
	aMenu add: 'run to here' target: self selector: #runToSelection: argument: thisContext sender receiver selectionInterval.
	aMenu addLine.
	super paneMenu: aMenu shifted: shifted.
	^aMenu.! !


!FileContentsBrowser methodsFor: 'creation' stamp: 'jmv 7/21/2009 11:25'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset column codePane infoPane infoHeight divider |


	column _ AlignmentMorph proportional.

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #paneMenu:shifted:.
	infoPane _ PluggableTextMorph on: self text: #infoViewContents accept: nil
			readSelection: nil menu: nil.
	infoPane askBeforeDiscardingEdits: false.
	verticalOffset _ 0.

">>not with this browser--- at least not yet ---
	innerFractions _ 0@0 corner: 1@0.
	verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset.
	verticalOffset _ self addOptionalButtonsTo: row  at: innerFractions plus: verticalOffset.
<<<<"

	infoHeight _ 20.
	column 
		addMorph: (codePane borderWidth: 0)
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@verticalOffset corner: 0@infoHeight negated)
		).
	divider _ BorderedSubpaneDividerMorph forTopEdge.
	Preferences alternativeWindowLook ifTrue:[
		divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2.
	].
	column 
		addMorph: divider
		fullFrame: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@infoHeight negated corner: 0@(1-infoHeight))
		).
	column 
		addMorph: (infoPane borderWidth: 0; hideScrollBarsIndefinitely)
		fullFrame: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@(1-infoHeight) corner: 0@0)
		).
	window 
		addMorph: column
		frame: nominalFractions.

	column on: #mouseEnter send: #paneTransition: to: window.
	column on: #mouseLeave send: #paneTransition: to: window! !


!FileList methodsFor: 'file list menu' stamp: 'jmv 7/22/2009 16:28'!
editorClass
	^SmalltalkEditor! !

!FileList methodsFor: 'file list menu' stamp: 'jmv 7/22/2009 16:28'!
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 _ self editorClass 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! !


!Inspector methodsFor: 'code pane menu' stamp: 'jmv 7/21/2009 12:13'!
editorClass
	^SmalltalkEditor! !


!SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'jmv 7/21/2009 11:26'!
morphicWindow
	"Create a Browser that lets you type part of a selector, shows a list of selectors, shows the classes of the one you chose, and spawns a full browser on it.  Answer the window
	SelectorBrowser new open "

	| window typeInView selectorListView classListView |
	window := SystemWindow new model: self.
	selectorIndex := classListIndex := 0.
	typeInView := PluggableTextMorph 
				on: self
				text: #contents
				accept: #contents:notifying:
				readSelection: #contentsSelection
				menu: #paneMenu:shifted:.
	typeInView acceptOnCR: true.
	typeInView hideScrollBarsIndefinitely.
	window addMorph: typeInView frame: (0 @ 0 corner: 0.5 @ 0.14).
	selectorListView := PluggableListMorph 
				on: self
				list: #messageList
				selected: #messageListIndex
				changeSelected: #messageListIndex:
				menu: #selectorMenu:
				keystroke: #messageListKey:from:.
	selectorListView menuTitleSelector: #selectorMenuTitle.
	window addMorph: selectorListView frame: (0 @ 0.14 corner: 0.5 @ 0.6).
	classListView := PluggableListMorph 
				on: self
				list: #classList
				selected: #classListIndex
				changeSelected: #classListIndex:
				menu: nil
				keystroke: #arrowKey:from:.
	classListView menuTitleSelector: #classListSelectorTitle.
	window addMorph: classListView frame: (0.5 @ 0 corner: 1 @ 0.6).
	window 
		addMorph: ((PluggableTextMorph 
				on: self
				text: #byExample
				accept: #byExample:
				readSelection: #contentsSelection
				menu: #paneMenu:shifted:) askBeforeDiscardingEdits: false)
		frame: (0 @ 0.6 corner: 1 @ 1).
	window setLabel: 'Method Finder'.
	^window! !

!SelectorBrowser methodsFor: 'code pane menu' stamp: 'jmv 7/21/2009 12:13'!
editorClass
	^SmalltalkEditor! !


!StringHolder class methodsFor: 'instance creation' stamp: 'jmv 7/21/2009 12:22'!
open
	self new openLabel: 'Text Editor'! !


!Inspector class methodsFor: 'instance creation' stamp: 'jmv 7/21/2009 11:24'!
openAsMorphOn: anObject withLabel: aLabel
	"(Inspector openAsMorphOn: SystemOrganization) openInMVC"
	| window inspector |
	inspector _ self inspect: anObject.
	window _ (SystemWindow labelled: aLabel) model: inspector.
	window addMorph: (
		PluggableListMorph new
			doubleClickSelector: #inspectSelection;

			on: inspector list: #fieldList
			selected: #selectionIndex
			changeSelected: #toggleIndex:
			menu: ((inspector isMemberOf: DictionaryInspector)
					ifTrue: [#dictionaryMenu:]
					ifFalse: [#fieldListMenu:])
			keystroke: #inspectorKey:from:)
		frame: (0@0 corner: self horizontalDividerProportion @ self verticalDividerProportion).
	window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
				readSelection: #contentsSelection menu: #paneMenu:shifted:)
		frame: (self horizontalDividerProportion @0 corner: 1@self verticalDividerProportion).
	window addMorph: ((PluggableTextMorph on: inspector text: #trash accept: #trash:
				readSelection: #contentsSelection menu: #paneMenu:shifted:)
					askBeforeDiscardingEdits: false)
		frame: (0@self verticalDividerProportion corner: 1@1).
	window setUpdatablePanesFrom: #(fieldList).
	window position: 16@0.  "Room for scroll bar."
	^ window! !


!InspectorBrowser class methodsFor: 'as yet unclassified' stamp: 'jmv 7/21/2009 11:24'!
openAsMorphOn: anObject
	"(InspectorBrowser openAsMorphOn: SystemOrganization) openInMVC"
	| window inspector |
	inspector _ self inspect: anObject.
	window _ (SystemWindow labelled: anObject defaultLabelForInspector)
				model: inspector.

	window addMorph: (PluggableListMorph on: inspector list: #fieldList
				selected: #selectionIndex changeSelected: #toggleIndex: menu: #fieldListMenu:)
		frame: (0@0 corner: 0.3@0.5).
	window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
				readSelection: nil menu: #paneMenu:shifted:)
		frame: (0.3@0 corner: 1.0@0.5).
	window addMorph: (PluggableListMorph on: inspector list: #msgList
				selected: #msgListIndex changeSelected: #msgListIndex: menu: #msgListMenu:)
		frame: (0@0.5 corner: 0.3@1.0).
	window addMorph: (PluggableTextMorph on: inspector text: #msgText accept: #msgAccept:from:
				readSelection: nil menu: #msgPaneMenu:shifted:)
		frame: (0.3@0.5 corner: 1.0@1.0).
	
	window setUpdatablePanesFrom: #(fieldList msgList).
	window position: 16@0.  "Room for scroll bar."
	^ window! !


!SyntaxError class methodsFor: 'instance creation' stamp: 'jmv 7/21/2009 11:24'!
buildMorphicViewOn: aSyntaxError
	"Answer an Morphic view on the given SyntaxError."
	| window |
	window _ (SystemWindow labelled: 'Syntax Error') model: aSyntaxError.

	window addMorph: (PluggableListMorph on: aSyntaxError list: #list
			selected: #listIndex changeSelected: nil menu: #listMenu:)
		frame: (0@0 corner: 1@0.15).

	window addMorph: (PluggableTextMorph on: aSyntaxError text: #contents
			accept: #contents:notifying: readSelection: #contentsSelection
			menu: #paneMenu:shifted:)
		frame: (0@0.15 corner: 1@1).

	^ window openInWorldExtent: 380@220! !


!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 7/21/2009 10:25'!
presumedSentMessages   | sent |
"Smalltalk presumedSentMessages"

	"The following should be preserved for doIts, etc"
	sent _ IdentitySet new.
	#( rehashWithoutBecome compactSymbolTable rebuildAllProjects
		browseAllSelect:  lastRemoval
		vScrollBarValue: hScrollBarValue: 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 cmdActions) asSet do: [:sel | sent add: sel].
	(TextEditor shiftCmdActions) asSet do: [:sel | sent add: sel].
	(SmalltalkEditor cmdActions) asSet do: [:sel | sent add: sel].
	(SmalltalkEditor shiftCmdActions) asSet do: [:sel | sent add: sel].
	
	"methodsToKeep is never called, but any class can implement it to protect some methods from deletion.
	For example, if no senders appear to exist because the symbols are built and later performed
	Include the following comment when implementing it:"
	"Send to self messages for all the methods that should be kept in Smalltalk image shrinking.
	This method is not actually called, but will not be deleted and therefore messages sent here will not appear as unsent"

	#(beReadOnlyBinding beReadWriteBinding changeSetCategoryClass belongsInAll: methodsToKeep) do:
		[:sel | sent add: sel].
	^ sent! !


!Text methodsFor: 'user interface' stamp: 'jmv 7/22/2009 15:48'!
edit

	StringHolder new contents: self; openLabel: 'Text Editor'! !


!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 7/21/2009 01:03'!
addNullLineWithIndex: index andRectangle: r
	
	| f |
	f _ theText fontAt: theText size + 1 withStyle: theTextStyle.
	lines addLast: (
		(
			TextLine 
				start: index 
				stop: index - 1
				internalSpaces: 0 
				paddingWidth: 0
		)
			rectangle: r;
			lineHeight: f height baseline: f ascent
	)
! !

!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 11/6/2008 18:17'!
composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer

	lines _ argLinesCollection.
	theTextStyle _ argTextStyle.
	theText _ argText.
	theContainer _ argContainer.
	deltaCharIndex _ argDelta.
	currCharIndex _ startCharIndex _ argStart.
	stopCharIndex _ argStop.
	prevLines _ argPriorLines.
	currentY _ argStartY.
	defaultLineHeight _ theTextStyle lineGrid.
	maxRightX _ theContainer left.
	possibleSlide _ stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
	nowSliding _ false.
	prevIndex _ 1.
	scanner _ CompositionScanner new text: theText textStyle: theTextStyle.
	isFirstLine _ true.
	self composeAllLines.
	isFirstLine ifTrue: ["No space in container or empty text"
		self 
			addNullLineWithIndex: startCharIndex
			andRectangle: (theContainer topLeft extent: 0@defaultLineHeight)
	] ifFalse: [
		self fixupLastLineIfCR
	].
	^{lines asArray. maxRightX}

! !

!TextComposer methodsFor: 'as yet unclassified' stamp: 'RAA 5/4/2001 18:09'!
fixupLastLineIfCR
"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."

	(theText size > 1 and: [theText last = Character cr]) ifFalse: [^self].
	self addNullLineForIndex: theText size + 1.
! !


!TextEditor methodsFor: 'editing keys' stamp: 'jmv 7/21/2009 12:31'!
changeEmphasis: characterStream 
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors |
	keyCode := ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1.
	oldAttributes := paragraph text attributesAt: self pointIndex
				forStyle: paragraph textStyle.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	keyCode = 6 
		ifTrue: 
			[colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			index := (PopUpMenu 
						labelArray: colors , #('choose color...' )
						lines: (Array with: colors size + 1)) startUp.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: [
					index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: 
			[sensor leftShiftDown 
				ifTrue: 
					[keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: 
					[attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
	beginTypeInBlock ~~ nil 
		ifTrue: 
			["only change emphasisHere while typing"

			self insertTypeAhead: characterStream.
			emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
			^true].
	self replaceSelectionWith: (thisSel asText addAttribute: attribute).
	^true! !

!TextEditor methodsFor: 'typing support' stamp: 'jmv 7/21/2009 10:17'!
dispatchOnCharacter: char with: typeAheadStream
	"Carry out the action associated with this character, if any.
	Type-ahead is passed so some routines can flush or use it."

	| honorCommandKeys |
	((char == Character cr) and: [morph acceptOnCR])
		ifTrue: [
			sensor keyboard.  "Gobble cr -- probably unnecessary."
			self closeTypeIn.
			^ true].

	self clearParens.
  
	char asciiValue = 13 ifTrue: [
		sensor controlKeyPressed ifTrue: [
			^ self normalCharacter: typeAheadStream ].
		sensor leftShiftDown ifTrue: [
			^ self lf: typeAheadStream ].
		sensor commandKeyPressed ifTrue: [
			^ self crlf: typeAheadStream ].
		^ self crWithIndent: typeAheadStream ].

	((honorCommandKeys _ Preferences cmdKeysInText) and: [char = Character enter])
		ifTrue: [^ self dispatchOnEnterWith: typeAheadStream].

	"Special keys overwrite crtl+key combinations - at least on Windows. To resolve this
	conflict, assume that keys other than cursor keys aren't used together with Crtl." 
	((self class specialShiftCmdKeys includes: char asciiValue) and: [char asciiValue < 27])
		ifTrue: [^ sensor controlKeyPressed
			ifTrue: [self perform: (self class shiftCmdActions at: char asciiValue + 1) with: typeAheadStream]
			ifFalse: [self perform: (self class cmdActions at: char asciiValue + 1) with: typeAheadStream]].

	"backspace, and escape keys (ascii 8 and 27) are command keys"
	((honorCommandKeys and: [sensor commandKeyPressed]) or: [self class specialShiftCmdKeys includes: char asciiValue]) ifTrue:
		[^ sensor leftShiftDown
			ifTrue: [
				self perform: (self class shiftCmdActions at: char asciiValue + 1) with: typeAheadStream]
			ifFalse: [
				self perform: (self class cmdActions at: char asciiValue + 1) with: typeAheadStream]].

	"the control key can be used to invoke shift-cmd shortcuts"
	(honorCommandKeys and: [sensor controlKeyPressed])
		ifTrue: [
			^ self perform: (self class shiftCmdActions at: char asciiValue + 1) with: typeAheadStream].

	(')]}' includes: char)
		ifTrue: [self blinkPrevParen].

	^ self normalCharacter: typeAheadStream! !


!SmalltalkEditor methodsFor: 'editing keys' stamp: 'jmv 7/21/2009 11:48'!
changeEmphasis: characterStream 
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors extras |
	keyCode := ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1.
	oldAttributes := paragraph text attributesAt: self pointIndex
				forStyle: paragraph textStyle.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	keyCode = 6 
		ifTrue: 
			[colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			extras := #('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method').
			index := (PopUpMenu 
						labelArray: colors , #('choose color...' 'Do it' 'Print it') , extras 
								, #('be a web URL link' 'Edit hidden info' 'Copy hidden info')
						lines: (Array with: colors size + 1)) startUp.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: 
					[index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					index = 1 
						ifTrue: 
							[attribute := TextDoIt new.
							thisSel := attribute analyze: self selection asString].
					index = 2 
						ifTrue: 
							[attribute := TextPrintIt new.
							thisSel := attribute analyze: self selection asString].
					extras size = 0 & (index > 2) ifTrue: [index := index + 5].	"skip those"
					index = 3 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Comment'].
					index = 4 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Definition'].
					index = 5 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
					index = 6 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString].
					index = 7 
						ifTrue: 
							[attribute := TextURL new.
							thisSel := attribute analyze: self selection asString].
					index = 8 
						ifTrue: 
							["Edit hidden info"

							thisSel := self hiddenInfo.	"includes selection"
							attribute := TextEmphasis normal].
					index = 9 
						ifTrue: 
							["Copy hidden info"

							self copyHiddenInfo.
							^true].	"no other action"
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: 
			[sensor leftShiftDown 
				ifTrue: 
					[keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: 
					[attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
	beginTypeInBlock ~~ nil 
		ifTrue: 
			["only change emphasisHere while typing"

			self insertTypeAhead: characterStream.
			emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
			^true].
	self replaceSelectionWith: (thisSel asText addAttribute: attribute).
	^true! !


!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 7/21/2009 10:05'!
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"

	| 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"
			
	'0123456789-=' 
		do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:].
		
	'([{''"<' 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: $k #offerFontMenu: $u #align: $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 7/21/2009 10:19'!
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"
	
	| 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 7/21/2009 12:35'!
initializeShiftedYellowButtonMenu
	"Initialize the yellow button pop-up menu and corresponding messages."

	"TextEditor initialize"
	"
	shiftedYellowButtonMenu _ SelectionMenu fromArray: {
		{'set font... (k)' translated.					#offerFontMenu}.
		{'set style... (K)' translated.				#changeStyle}.
		{'set alignment...' translated.				#chooseAlignment}.
		#-.
		{'more...' translated.						#yellowButtonActivity}.
	}
	"
	shiftedYellowButtonMenu _ yellowButtonMenu! !

!TextEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 7/21/2009 12:34'!
initializeYellowButtonMenu
	"Initialize the yellow button pop-up menu and corresponding messages."

	"TextEditor initialize"

	yellowButtonMenu _ SelectionMenu fromArray: {
		{'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}.
		#-.
		{'set font... (k)' translated.			#offerFontMenu}.
		{'set style... (K)' translated.		#changeStyle}.
		{'set alignment...' translated.		#chooseAlignment}.
		"
		#-.
		{'more...' translated.				#shiftedTextPaneMenuRequest}.
		"
	}! !

!TextEditor class methodsFor: 'class initialization' stamp: 'jmv 7/21/2009 10:37'!
initialize 
	"Initialize the keyboard shortcut maps and the shared buffers
	for copying text across views and managing again and undo." 
 
	"TextEditor initialize"

	UndoSelection _ FindText _ ChangeText _ Text new.
	UndoMessage _ Message selector: #halt.

	self initializeCmdKeyShortcuts.
	self initializeShiftCmdKeyShortcuts.
	self initializeYellowButtonMenu.
	self initializeShiftedYellowButtonMenu! !

!TextEditor class methodsFor: 'class initialization' stamp: 'jmv 7/21/2009 10:37'!
shiftedYellowButtonMenu
	"Answer the menu to be presented when the yellow button is pressed while the shift key is down"

	^ shiftedYellowButtonMenu! !

!TextEditor class methodsFor: 'class initialization' stamp: 'jmv 7/21/2009 10:34'!
yellowButtonMenu

	^ yellowButtonMenu! !

!TextEditor class methodsFor: 'accessing' stamp: 'jmv 7/21/2009 10:07'!
cmdActions
	^cmdActions! !

!TextEditor class methodsFor: 'accessing' stamp: 'jmv 7/21/2009 10:17'!
shiftCmdActions
	^shiftCmdActions! !


!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 7/21/2009 10:05'!
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 |
	super initializeCmdKeyShortcuts.
	
	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 7/21/2009 10:16'!
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 |
	super initializeShiftCmdKeyShortcuts.
	
	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 7/21/2009 10:38'!
initializeShiftedYellowButtonMenu
	"Initialize the yellow button pop-up menu and corresponding messages."

	"SmalltalkEditor initialize"

	shiftedYellowButtonMenu _ SelectionMenu fromArray: {
		{'set font... (k)' translated.					#offerFontMenu}.
		{'set style... (K)' translated.				#changeStyle}.
		{'set alignment...' translated.				#chooseAlignment}.
		#-.
		{'explain' translated.						#explain}.
		{'pretty print' translated.					#prettyPrint}.
		{'pretty print with color' translated.		#prettyPrintWithColor}.
		{'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}.
	}! !

!SmalltalkEditor class methodsFor: 'keyboard shortcut tables' stamp: 'jmv 7/21/2009 10:34'!
initializeYellowButtonMenu
	"Initialize the yellow button pop-up menu and corresponding messages."

	"SmalltalkEditor initialize"

	yellowButtonMenu _ SelectionMenu fromArray: {
		{'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}.
		{'explore it (I)' translated.			#exploreIt}.
		{'debug it' translated.				#debugIt}.
		#-.	     
		{'accept (s)' translated.			#accept}.
		{'cancel (l)' translated.				#cancel}.
		#-.	     
		{'show bytecodes' translated.		#showBytecodes}.
		#-.	     
		{'more...' translated.				#shiftedTextPaneMenuRequest}.
	}! !


!TextMorph methodsFor: 'private' stamp: 'jmv 7/21/2009 11:50'!
editorClass
	^TextEditor! !

!TextMorph methodsFor: 'private' stamp: 'jmv 7/21/2009 11:51'!
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 := self editorClass new morph: self.
	editor changeParagraph: self paragraph.
	priorEditor ifNotNil: [ editor stateArrayPut: stateArray ].
	self selectionChanged.
	^editor! !


!TextMorphForEditView methodsFor: 'private' stamp: 'jmv 7/21/2009 15:13'!
editorClass
	 | m |
	m _ editView model.
	(m is: #knowsEditorClass) ifTrue: [
		^m editorClass ].
	^super editorClass! !


!TheWorldMenu methodsFor: 'commands' stamp: 'jmv 7/21/2009 12:23'!
openTextEditor

	StringHolder new openAsMorphLabel: 'Text Editor' inWorld: myWorld! !

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 7/21/2009 09:26'!
changesMenu
        "Build the changes menu for the world."

        | menu |
        menu _ self menu: 'changes...'.
        self fillIn: menu from: {
                { 'file out current change set' . { ChangeSet current . #verboseFileOut}.
                                'Write the current change set out to a file whose name reflects the change set name and the current date & time.'}.
                { 'create new change set...' . { ChangeSorter . #newChangeSet}. 'Create a new change set and make it the current one.'}.
                { 'browse changed methods' . { ChangeSet  . #browseChangedMessages}.  'Open a message-list browser showing all methods in the current change set'}.
                { 'check change set for slips' . { self  . #lookForSlips}.
                                'Check the current change set for halts, references to the Transcript, etc., and if any such thing is found, open up a message-list browser detailing all possible slips.'}.

                nil.
                { 'simple change sorter' . {self. #openChangeSorter1}.  'Open a 3-paned changed-set viewing tool'}.
                { 'dual change sorter' . {self. #openChangeSorter2}.
                                'Open a change sorter that shows you two change sets at a time, making it easy to copy and move methods and classes between them.'}.
                nil.
                { 'browse recent submissions' . { Utilities . #browseRecentSubmissions}.
                                'Open a new recent-submissions browser.  A recent-submissions browser is a message-list browser that shows the most recent methods that have been submitted.  If you submit changes within that browser, it will keep up-to-date, always showing the most recent submissions.'}.

                { 'find recent submissions' . { #myWorld . #openRecentSubmissionsBrowser:}.
                                'Make an open recent-submissions browser be the front-window, expanding a collapsed one or creating a new one if necessary.  A recent-submissions browser is a message-list browser that shows the most recent methods that have been submitted, latest first.  If you submit changes within that browser, it will keep up-to-date, always showing the most recent submissions at the top of the browser.'}.

			nil.
                { 'recently logged changes...' . { ChangeList . #browseRecentLog}.'Open a change-list browser on the latter part of the changes log.  You can use this browser to recover logged changes which were not saved in your image, in the event of a crash or other interruption.'}.

                { 'recent log file...' . { Smalltalk . #writeRecentToFile}.
                                'Create a file holding the logged changes (going as far back as you wish), and open a window on that file.'}.

                nil.
                { 'save world as morph file' . {self. #saveWorldInFile}. 'Save a file that, when reloaded, reconstitutes the current World.'}.
                nil.
        }.
        ^ menu! !

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 7/21/2009 09:29'!
debugMenu

        | menu |

        menu _ self menu: 'debug...'.
        ^self fillIn: menu from: { 
                { 'inspect world' . { #myWorld . #inspect } }.
                { 'explore world' . { #myWorld . #explore } }.
                { 'MessageTally all Processes' . { self . #startMessageTally } }.
                { 'MessageTally UI and browse' . { self . #startThenBrowseMessageTally } }.
                nil.
                { 'start drawing all again' . { #myWorld . #removeAllKnownFailing } }.
                { 'start stepping again' . { #myWorld . #resumeAfterStepError } }.
                { 'close all debuggers' . { Utilities . #closeAllDebuggers } }.
        }
! !

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 7/21/2009 12:23'!
openMenu
	"Build the open window menu for the world."

	| menu |
	menu _ self menu: 'open...'.
	self fillIn: menu from: {

		{'browser' . { self . #openBrowser}. 'A five-paned tool that lets you see all the code in the system'}.
		{'package-pane browser' . { PackagePaneBrowser . #openBrowser} . 'Similar to the regular browser, but adds an extra pane at top-left that groups class-categories that start with the same prefix' }.
		{'workspace' . {self . #openWorkspace}. 'A window for evaluating Smalltalk expressions' }.
		{'text editor' . {self . #openTextEditor}. 'A window for composing text' }.
		{'file list' . {self . #openFileList} . 'A tool allowing you to browse any file' }.
		{'file...' . { FileList . #openFileDirectly} . 'Lets you open a window on a single file'}.
		{'transcript' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }.
		{ 'process browser' . { ProcessBrowser . #open } }.
		"{'inner world' . { WorldWindow . #test1} }."
		nil.
		{'method finder' . { self . #openSelectorBrowser} . 'A tool for discovering methods' }.
		{'message names' . { self . #openMessageNames} . 'A tool for finding and editing methods that contain any given keyword in their names.'}.
			 nil.
		{'simple change sorter' . {self . #openChangeSorter1} . 'A tool allowing you to view the methods in a single change set' }.
		{'dual change sorter' . {self . #openChangeSorter2} . 'A tool allowing you to compare and manipulate two change sets concurrently' }.
		nil.
	}.
	self fillIn: menu from: self class registeredOpenCommands.
	^menu! !

!TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'jmv 7/21/2009 09:23'!
windowsMenu
        "Build the windows menu for the world."

        ^ self fillIn: (self menu: 'windows') from: {  
                { 'find window' . { #myWorld . #findWindow: }. 'Presents a list of all windows; if you choose one from the list, it becomes the active window.'}.

                { 'find changed browsers...' . { #myWorld . #findDirtyBrowsers: }. 'Presents a list of browsers that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}.

                { 'find changed windows...' . { #myWorld . #findDirtyWindows: }. 'Presents a list of all windows that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}.
			nil.

                { 'find a transcript' . { #myWorld . #findATranscript: }. 'Brings an open Transcript to the front, creating one if necessary, and makes it the active window'}.

               { 'find a fileList' . { #myWorld . #findAFileList: }. 'Brings an open fileList  to the front, creating one if necessary, and makes it the active window'}.

               { 'find a change sorter' . { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window'}.

			{ 'find message names' . { #myWorld . #findAMessageNamesWindow: }. 'Brings an open MessageNames window to the front, creating one if necessary, and makes it the active window'}.

			 nil.
                { #staggerPolicyString . { self . #toggleWindowPolicy }. 'stagger: new windows positioned so you can see a portion of each one.
                tile: new windows positioned so that they do not overlap others, if possible.'}.

                nil.
                { 'collapse all windows' . { #myWorld . #collapseAll }. 'Reduce all open windows to collapsed forms that only show titles.'}.
                { 'expand all windows' . { #myWorld . #expandAll }. 'Expand all collapsed windows back to their expanded forms.'}.
                { 'close top window' . { SystemWindow . #closeTopWindow }. 'Close the topmost window if possible.'}.
                { 'send top window to back' . { SystemWindow . #sendTopWindowToBack  }. 'Make the topmost window become the backmost one, and activate the window just beneath it.'}.
			 { 'move windows onscreen' . { #myWorld . #bringWindowsFullOnscreen }. 'Make all windows fully visible on the screen'}.

                nil.
                { 'delete unchanged windows' . { #myWorld . #closeUnchangedWindows }. 'Deletes all windows that do not have unsaved text edits.'}.
                { 'delete non-windows' . { #myWorld . #deleteNonWindows }. 'Deletes all non-window morphs lying on the world.'}.
                { 'delete both of the above' . { self . #cleanUpWorld }. 'deletes all unchanged windows and also all non-window morphs lying on the world, other than flaps.'}.

        }! !


!TranscriptStream methodsFor: 'initialization' stamp: 'jmv 7/21/2009 11:24'!
openAsMorphLabel: labelString 
	"Build a morph viewing this transcriptStream"
	| window |
	window _ (SystemWindow labelled: labelString) model: self.
	window addMorph: (PluggableTextMorph on: self text: nil accept: nil
			readSelection: nil menu: #paneMenu:shifted:)
		frame: (0@0 corner: 1@1).
	^ window! !

!TranscriptStream methodsFor: 'access' stamp: 'jmv 7/21/2009 15:12'!
editorClass
	^SmalltalkEditor! !

!TranscriptStream methodsFor: 'model protocol' stamp: 'jmv 7/21/2009 12:06'!
paneMenu: aMenu shifted: shifted
	"Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items"
	^ CodeHolder basicNew paneMenu: aMenu shifted: shifted
! !

!TranscriptStream methodsFor: 'testing' stamp: 'jmv 7/21/2009 15:12'!
is: aSymbol
	^ aSymbol = #knowsEditorClass or: [ super is: aSymbol ]! !


!Workspace methodsFor: 'code pane menu' stamp: 'jmv 7/21/2009 12:13'!
editorClass
	^SmalltalkEditor! !


!Workspace class methodsFor: 'instance creation' stamp: 'jmv 7/21/2009 12:21'!
open
	self new openLabel: 'Workspace'! !

TranscriptStream removeSelector: #codePaneMenu:shifted:!
TextMorph class removeSelector: #initialize!

!TextMorph class reorganize!
('new-morph participation' includeInNewMorphMenu)
!

!classDefinition: #TextMorph category: #'Morphic-OldText Support'!
RectangleMorph subclass: #TextMorph
	instanceVariableNames: 'textStyle text wrapFlag paragraph editor container backgroundColor margins'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldText Support'!
TextEditor initialize!
TextEditor class removeSelector: #initializeTextEditorMenus!
!classDefinition: 'TextEditor class' category: nil!
TextEditor class
	instanceVariableNames: 'cmdActions shiftCmdActions yellowButtonMenu shiftedYellowButtonMenu'!
!classDefinition: #TextEditor category: #'System-Text'!
Editor subclass: #TextEditor
	instanceVariableNames: 'model paragraph pointBlock markBlock beginTypeInBlock emphasisHere otherInterval lastParenLocation oldInterval'
	classVariableNames: 'ChangeText FindText UndoInterval UndoMessage UndoParagraph UndoSelection Undone'
	poolDictionaries: ''
	category: 'System-Text'!

!Text reorganize!
('accessing' append: at: at:put: embeddedMorphs embeddedMorphsFrom:to: findString:startingAt: findString:startingAt:caseSensitive: lineCount prepend: rangeOf:startingAt: rangeOf:startingAt:forStyle: replaceFrom:to:with: size string)
('comparing' = hash howManyMatch: isText)
('copying' copy copyFrom:to: copyReplaceFrom:to:with: copyReplaceTokens:with: deepCopy)
('converting' asDisplayText asNumber asParagraph asString asStringOrText asText removeAttributesThat:replaceAttributesThat:by: replaceFrom:to:with:startingAt: reversed withSqueakLineEndings)
('emphasis' addAttribute: addAttribute:from:to: alignmentAt:ifAbsent: allBold attributesAt: attributesAt:do: attributesAt:forStyle: emphasisAt: find: fontAt:withStyle: fontNumberAt: makeBoldFrom:to: makeSelectorBold makeSelectorBoldIn: removeAttribute:from:to: runLengthFor:)
('printing' printOn: storeOn:)
('private' runs setString:setRuns: setString:setRunsChecking:)
('attributes' askIfAddStyle:req: couldDeriveFromPrettyPrinting unembellished)
('user interface' edit)
!

Debugger removeSelector: #codePaneMenu:shifted:!
StringHolder removeSelector: #codePaneMenu:shifted:!
String removeSelector: #openInWorkspaceWithTitle:!
ObjectExplorer removeSelector: #codePaneMenu:shifted:!

!ObjectExplorer reorganize!
('accessing' contentsSelection doItContext doItReceiver editorClass explorerFor: getList object parentObject selector)
('menus' chasePointers defsOfSelection explorePointers exploreSelection explorerKey:from: genericMenu: inspectSelection objectReferencesToSelection paneMenu:shifted: referencesToSelection selectedClass trash trash:)
('user interface' initialExtent openBrowser: openExplorerFor:)
('error handling' doesNotUnderstand:)
('monitoring' monitor: monitorList release shouldGetStepsFrom: step stopMonitoring)
('testing' is:)
!

FillInTheBlankMorph removeSelector: #codePaneMenu:shifted:!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
TextEditor initialize.
SmalltalkEditor initialize!

