Commits

Ryan Macnak committed e2b15a3

Hide 'as exe' from deploy menu since we are regressing on this feature.

Comments (0)

Files changed (2)

-Newspeak3
+Newspeak3
+'Mock'
+class Hello packageUsing: ns = NewspeakObject (
+"I am an example application."|
 
-'Mock'
-
-
-
-class Hello packageUsing: ns = NewspeakObject (
-"Describe the class in this comment."
-|
-	slot1
-	slot2
-|
-)
-
-('as yet unclassified'
-
-main: p args: argv = (
-
-
-
-)
+|)
+('as yet unclassified'
+main: p args: argv = (
+	p brazil containers Window new title: 'Hello'; open
+))

Newspeak3Browsing.ns3

-Newspeak3
+Newspeak3
+'HopscotchIDE'
+class Newspeak3Browsing usingPlatform: p ide: ide = NewspeakObject (
+"
+Class browsing for NS3 using new mirrors.
 
-'HopscotchIDE'
+It would be nice to additionally support:
+	
+	renaming existing classes
+	editing a class header to a different name makes a copy a la the classic browser
+	pull a nested class up as a sibling of its parent
+	push a nested class down into one of its siblings
+	
+	auto-initialization of new slots in existing instances
+	(but if it depends on a factory argument, what can we do?)
+	
+	senders/implementors restricted to the same module?
+"|
+	OrderedCollection = p collections OrderedCollection.
+	Set = p collections Set.
+	Subject = p hopscotch core Subject.
+	Color = p hopscotch Color.
+	EditableLinePresenter =p hopscotch fragments EditableLinePresenter.
+	HopscotchImages = p hopscotch HopscotchImages.
+	ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder.
+	MixinBuilder = p mirrors MixinBuilder.
+	Duct = p brazil plumbing Duct.
+	cachedPlatform = p.
 
-
+	ProgrammingPresenter = ide tools ProgrammingPresenter.
+	CodeEditorFragment = ide tools CodeEditorFragment.
+	DefinitionListPresenter = ide tools DefinitionListPresenter.
+	DefinitionTemplate = ide tools DefinitionTemplate.
+	SuperMethodSubject = ide browsing MethodSubject.
+	SuperClassSubject = ide browsing ClassSubject.
+	SuperduperMethodSubject = ide browsing MethodSubject.
+	SelectorSubject = ide browsing SelectorSubject.
+	AssortedMethodsPresenter = ide browsing AssortedMethodsPresenter.
+	ClassCommentPresenter = ide browsingMisc ClassCommentPresenter.
+	DeletedClassSubject = ide browsingMisc DeletedClassSubject.
+	SuperMethodInheritanceSubject = ide browsingST MethodInheritanceSubject.
+	EditableNSClassNamePresenter = ide browsing EditableNSClassNamePresenter.
+	DeploymentInstructionsPresenter = ide browsingMisc DeploymentInstructionsPresenter.
+	languageUiDescriptionRegistry = ide languageUiDescriptionRegistry.
+	minitestUI = ide minitestUI.
+	minitest = ide minitest.
 
-class Newspeak3Browsing usingPlatform: p ide: ide = NewspeakObject (
-"
-Class browsing for NS3 using new mirrors.
-
-It would be nice to additionally support:
-	
-	renaming existing classes
-	editing a class header to a different name makes a copy a la the classic browser
-	pull a nested class up as a sibling of its parent
-	push a nested class down into one of its siblings
-	
-	auto-initialization of new slots in existing instances
-	(but if it depends on a factory argument, what can we do?)
-	
-	senders/implementors restricted to the same module?
-"
-|
-	OrderedCollection = p collections OrderedCollection.
-	Set = p collections Set.
-	Subject = p hopscotch core Subject.
-	Color = p hopscotch Color.
-	EditableLinePresenter =p hopscotch fragments EditableLinePresenter.
-	HopscotchImages = p hopscotch HopscotchImages.
-	ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder.
-	MixinBuilder = p mirrors MixinBuilder.
-	Duct = p brazil plumbing Duct.
-	cachedPlatform = p.
-
-	ProgrammingPresenter = ide tools ProgrammingPresenter.
-	CodeEditorFragment = ide tools CodeEditorFragment.
-	DefinitionListPresenter = ide tools DefinitionListPresenter.
-	DefinitionTemplate = ide tools DefinitionTemplate.
-	SuperMethodSubject = ide browsing MethodSubject.
-	SuperClassSubject = ide browsing ClassSubject.
-	SuperduperMethodSubject = ide browsing MethodSubject.
-	SelectorSubject = ide browsing SelectorSubject.
-	AssortedMethodsPresenter = ide browsing AssortedMethodsPresenter.
-	ClassCommentPresenter = ide browsingMisc ClassCommentPresenter.
-	DeletedClassSubject = ide browsingMisc DeletedClassSubject.
-	SuperMethodInheritanceSubject = ide browsingST MethodInheritanceSubject.
-	EditableNSClassNamePresenter = ide browsing EditableNSClassNamePresenter.
-	DeploymentInstructionsPresenter = ide browsingMisc DeploymentInstructionsPresenter.
-	languageUiDescriptionRegistry = ide languageUiDescriptionRegistry.
-	minitestUI = ide minitestUI.
-	minitest = ide minitest.
-
-	Smalltalk = p Smalltalk.
-	PackageOrganizer = p PackageOrganizer.
-	SystemOrganization = p SystemOrganization.
-	MessageNotUnderstood = p MessageNotUnderstood.
-	Language = p Language.
-	Deployment = p blackMarket Deployment.
-	blackMarket = p blackMarket.
-	
-	NS3Colorizer = Language newspeak3 browserColorizer.
-|
-)
+	Smalltalk = p Smalltalk.
+	PackageOrganizer = p PackageOrganizer.
+	SystemOrganization = p SystemOrganization.
+	MessageNotUnderstood = p MessageNotUnderstood.
+	Language = p Language.
+	Deployment = p blackMarket Deployment.
+	blackMarket = p blackMarket.
+	
+	NS3Colorizer = Language newspeak3 browserColorizer.
+|)
+(
+class ClassPresenter onSubject: s = ProgrammingPresenter onSubject: s (
+"Presents a Newspeak class, as a full view that includes slots, nested classes, methods, etc. The subject is an NSClassSubject."| slotsSubject slotsPresenterX classNamePresenter summaryOrEditor |)
+('accessing'
+extraInformationMetapresenter = (
+	| enclosingClasses |
+	enclosingClasses:: subject enclosingClasses.
+	^enclosingClasses isEmpty
+		ifTrue: [nothing]
+		ifFalse:
+			[ | labelStream |
+			labelStream:: (String new: 50) writeStream.
+			enclosingClasses do:
+				[:each |
+				labelStream
+					nextPutAll: ' in ';
+					nextPutAll: each name].
+			(label: labelStream contents) color: (Color gray: 0.5)]
+)
+icon = (
+^subject classUiDescription classIcon
+)
+nestingInformationLine = (
+	| enclosingClasses |
+	enclosingClasses:: subject enclosingClasses.
+	^enclosingClasses isEmpty
+		ifTrue: [label: 'top level class']
+		ifFalse:
+			[ | rowElements |
+			rowElements:: OrderedCollection new.
 
-(
+			enclosingClasses do:
+				[:each |
+				rowElements add: (label: ' in ').
+				rowElements add: (linkToBrowseEnclosingClass: each)].
+			row: rowElements asArray]
+)
+preambleLine = (
+	"The line showing the class constructor syntax, e.g. 'Foo foo: x = Bar'. The superclass clause, if present, becomes a link to browse the superclass."
 
-
+	| preamble equalIndex prefix suffix |
+	preamble:: subject model header preamble.
+	equalIndex:: preamble indexOf: $=.
+	equalIndex = 0
+		ifTrue:
+			[prefix:: preamble withBlanksTrimmed.
+			suffix:: '']
+		ifFalse:
+			[prefix:: (preamble copyFrom: 1 to: equalIndex - 1)
+				withBlanksTrimmed.
+			suffix:: (preamble copyFrom: equalIndex + 1 to: preamble size)
+				withBlanksTrimmed].
+	^suffix isEmpty 
+		ifTrue: 
+			[label: prefix]
+		ifFalse:
+			[row: {
+				label: prefix, ' = '.
+				link: suffix action: [respondToBrowseSuperclass]
+				}]
+)
+slotsPresenter = (
+^slotsPresenterX
+)
+slotsPresenter: aPresenter = (
+"Users of this expect that we answer the presenter rather than the receiver."
 
-class ClassPresenter onSubject: s = ProgrammingPresenter onSubject: s (
-"Presents a Newspeak class, as a full view that includes slots, nested classes, methods, etc. The subject is an NSClassSubject." 
-| slotsSubject slotsPresenterX classNamePresenter summaryOrEditor |
-)
+slotsPresenterX:: aPresenter.
+^aPresenter
+)'actions'
+acceptClassDefinition: editor = (
+	"This class's definition has been changed in the definition editor."
 
-('as yet unclassified'
+	^majorUpdate:
+		[subject acceptClassDefinition: editor textBeingAccepted]
+)
+classActionsMenu = (
 
-addOutlineItemsTo: parentItem = (
+	^menuWithLabelsAndActions: {
+		'Open in Squeak Browser' -> 
+			[StandardToolSet browse: subject implementationClass selector: nil].
+		#separator.
+		'Save to File' -> [respondToSave].
+		#separator.
+		'Inspect Class' -> [inspect: subject implementationClass].
+		'Inspect Mirror' -> [inspect: subject classMirror].
+		#separator.
+		'Move up' -> [respondToMoveUp].
+		'Move down' -> [respondToMoveDown].
+		#separator.
+		'Convert to NS1' -> [respondToConvertToNS1].
+		'Convert to NS3' -> [respondToConvertToNS3].
+		'Delete' -> [respondToDelete] }, 
+		(subject isTestCase 
+			ifTrue:[
+				{#separator.
+				'Run Tests' -> [respondToRunTests]. 
+				#separator }
+			] ifFalse:[{#separator}]),
+		{'Inspect Presenter' -> [respondToInspectPresenter]}
+)
+respondToConvertToNS1 = (
 
-
+	subject 
+		convertToNS1IfSuccess: [requestChangeToSTPresentation]
+		ifFail: [alert: 'The class has nested classes and cannot be converted.']
+)
+respondToDelete = (
+	| deletedName |
+	deletedName:: subject deleteClass.
+	requestPresentationChange: 
+		(DeletedClassSubject onModel: deletedName) presenter.
+)
+respondToMoveDown = (
+"Refactoring: move class to a nested class of its enclosing class"
+halt. "Not yet implemented"
+)
+respondToSave = (
 
-browseNSClassReferences: className = (
+	subject implementationClass
+		ifNotNil: [:iclass | iclass printClass]
+		ifNil: [error: 'no class; is this reasonable?']
+)'as yet unclassified'
+addOutlineItemsTo: parentItem = (
+| selfItem |
+selfItem:: (OutlineItem onModel: self)
+	text: subject className;
+	image: icon.
+substance addOutlineItemsTo: selfItem.
+parentItem addChild: selfItem
+)
+browseNSClassReferences: className = (
 
-
+	sendUp navigatorDo:
+		[:shell | shell enterSubject: (ClassReferencesSubject onModel: className)]
+)
+linkToBrowseEnclosingClass: mirror <NSClassStencilMirror> = (
+	^link: mirror simpleName asText allBold
+		action: [enterSubject:: ClassSubject onModel: mirror]
+)
+parentClassSubjectDo: action = (
+^action value: subject
+)
+requestChangeToSTPresentation = (
+| newPresenter |
+newPresenter:: STClassPresenter onSubject: 
+	(subjectForClass: subject implementationClass).
+parent
+	replaceChild: self
+	with: newPresenter
+)
+requestPresentationChange: newPresenter = (
+	parent
+		replaceChild: self
+		with: newPresenter
+)
+respondToBrowseSuperclass = (
 
-linkToBrowseEnclosingClass: mirror <NSClassStencilMirror> = (
+	browseClass: subject superclass
+)
+respondToConvertToNS3 = (
+	subject convertToNS3IfSuccess: [ :ns3Class <Class> |
+		requestPresentationChange: 
+			(NSClassPresenter onSubject: (subjectForClass: ns3Class)) ]
+		ifFail: [ alert: 'This class cannot be converted to Newspeak3.' ].
+)
+respondToMoveUp = (
+"Refactoring: move class to enclosing class of its enclosing class"
+notYetImplemented
+)
+respondToRename = (
 
-
+	classNamePresenter enterEditState
+)
+respondToRunApp = (
+	|appDef app|
+	appDef:: Smalltalk at: subject model simpleName.
+	app:: appDef packageUsing: blackMarket.
+	
+	[app main: cachedPlatform args: {}] forkNamed: app class name.
+	
+)
+respondToRunTests = (
+	enterSubject:: minitestUI TestingInProgressSubject
+		onConfiguration: (Smalltalk at: subject model simpleName)
+		platform: cachedPlatform
+		minitest: minitest
+)
+showHeaderEditor = (
+	summaryOrEditor expand.
+)'definition'
+applicationActionsIfNeeded = (
 
-parentClassSubjectDo: action = (
+	^subject isAppDefinition
+		ifTrue:
+			[row: {
+				smallBlank.
+				(link: '[deploy]' action: [
+					openMenu:: menuWithLabelsAndActions: {
+						'as NOF' -> [subject makeNof].
+						'as IMAGE (warning: closes this image)' -> [subject makeImage].
+						"'as EXE' -> [subject makeExe]."}					
+				]) tinyFont.
+				smallBlank.
+				(link: '[run]' action: [respondToRunApp]) tinyFont.
+			}]
+		ifFalse: [nothing]
+)
+classCategoryLink = (
 
-
+	^(subject classCategoryName
+		ifNil: [label: '(uncategorized)']
+		ifNotNil:
+			[:cat | 
+			link: cat action: [browseClassCategory: cat]])
+				tinyFont
+)
+classDefinitionEditor = (
+	| editor |
+^
+	column: {
+		smallBlank.
+		classNameAndContainmentDefinition.
+		mediumBlank.
+		editor:: CodeEditorFragment new
+			text: subject classMirror header source;
+			colorizerBlock: [ :text | subject colorizeSource: text];
+			acceptResponse: 
+				[(acceptClassDefinition: editor)
+					ifTrue: [editor defaultAcceptResponse]].
+		}
+)
+classIconAndNameHeading = (
+^
+	column: {
+		smallBlank.
+		row:
+			{image: icon.
+			smallBlank.
+			link: subject className asText allBold 
+				action: [browseClassMirror: subject classMirror].
+			largeBlank.
+			itemReferencesButtonWithAction:
+				[browseNSClassReferences: subject className].
+			}.
+		smallBlank
+		}
+)
+classNameAndContainmentDefinition = (
+	^row: {
+		draggableImage: icon forSubject: subject.
+		smallBlank.
+		elastic:: column: {
+			row: {
+				[classNamePresenter:: EditableNSClassNamePresenter onSubject: subject.
+					classNamePresenter] value.
+				smallBlank.
+				linkImage: HopscotchImages default editImage action: [respondToRename].
+				smallBlank.
+				nestingInformationLine.
+				filler.
+				"right hand side begins"
+				testActionsIfNeeded.
+				applicationActionsIfNeeded.
+				smallBlank.
+				itemReferencesButtonWithAction:
+					[browseNSClassReferences: subject className].
+				smallBlank.
+				dropDownMenu: [classActionsMenu].
+				}.
+			row: {
+				(label: 'Category: ') tinyFont.
+				classCategoryLink.
+				mediumBlank.
+				(label: ' Package: ') tinyFont.
+				classPackageLink.
+				}
+			}
+		}.
+)
+classPackageLink = (
 
-requestChangeToSTPresentation = (
+	^(subject classPackageName
+		ifNil: [label: '(no package)']
+		ifNotNil:
+			[:packageName | 
+			link: packageName action: [browsePackage: packageName]])
+				tinyFont
+)
+classSummaryDefinition = (
+^
+	column: {
+		smallBlank.
+		classNameAndContainmentDefinition.
+		mediumBlank.
+		preambleLine.
+		mediumBlank.
+		ClassCommentPresenter onSubject: subject.
+		mediumBlank.
+		row: {
+			label: 'Slots' asText allBold.
+			largeBlank.
+			addButtonWithAction: [slotsPresenter addNewItemTemplate].
+			}.
+		mediumBlank.
+		slotsPresenter:: subject slotsSubject presenter.
+		mediumBlank.
+		initializerDefinition.
+		}
+)
+definition = (
+	| classesPresenter |
+^
+	column: {
+		headingDefinition.
+		sectionLabelled: 'Classes' presenting: subject nestedClassesSubject allowSwitch: false.
+		sectionLabelled: 'Methods' presenting: subject methodsSubject allowSwitch: true.
+		sectionLabelled: 'Class Methods' presenting: subject classMethodsSubject allowSwitch: true.
+	}
+)
+definitionSummaryAndEditorPanel = (
+	summaryOrEditor::
+		less: [classSummaryDefinition] label: 'show definition'
+		more: [classDefinitionEditor] label: 'show summary'.
+	^summaryOrEditor
+)
+headingDefinition = (
+^
+	(row: {
+		elastic:
+			(expanded: definitionSummaryAndEditorPanel
+			collapsed: classIconAndNameHeading).
+		smallBlank
+	}) 
+		color: majorHeadingColor
+)
+initializerDefinition = (
+	| editor fragment success |
+	
+	^nothing
+"	
+	editor:: CodeEditorFragment new
+		text: subject initExprs;
+		colorizerBlock: [ :text | NS2BrowserColorizer new
+			parseText: text asString
+			fromClass: subject classMirror
+			usingSelector: #initExprs];
+		acceptResponse: [[
+			success:: true.
+			subject initExprs: editor textBeingAccepted]
+				ifError: [:err |
+					success:: false.
+					editor showMessage: err].
+			success ifTrue: [
+				editor defaultAcceptResponse.
+				fragment refresh]].
+	
+	^fragment:: column: {
+		holder: [ |additionalText|
+			additionalText:: subject hasInitExprs ifTrue: [''] ifFalse:[' (empty)'].
+			heading: (row: {
+				label: 'Initializer ' asText allBold.
+				label: additionalText.
+				})
+			details: editor.]	
+		}"
+)
+testActionsIfNeeded = (
+	^subject isMinitestTestConfiguration 
+		ifTrue:
+			[(link: '[run tests]' action: [respondToRunTests]) tinyFont]
+		ifFalse:
+			[nothing]
+)'private'
+sectionLabelled: title <String> presenting: groupSubject <MirrorGroupSubject> = (
 
-
+	| groupPresenter |
+^
+	column: {
+		minorClassHeadingBlock: (
+			row: {
+				label: title.
+				largeBlank.
+				addButtonWithAction: [groupPresenter addNewItemTemplate].
+				filler.
+				expandButtonWithAction: [groupPresenter expandAll].
+				blank: 3.
+				collapseButtonWithAction: [groupPresenter collapseAll].
+				blank: 3.
+				reorderButtonWithAction: [groupPresenter switchSortOrder].
+				}
+			).
+		groupPresenter:: groupSubject presenter.
+		}
+)
+sectionLabelled: title <String> presenting: groupSubject <MirrorGroupSubject> allowSwitch: allowSwitch = (
 
-requestPresentationChange: newPresenter = (
+	| groupPresenter |
+^
+	column: {
+		minorClassHeadingBlock: (
+			row: {
+				label: title.
+				largeBlank.
+				addButtonWithAction: [groupPresenter addNewItemTemplate].
+				filler.
+				expandButtonWithAction: [groupPresenter expandAll].
+				blank: 3.
+				collapseButtonWithAction: [groupPresenter collapseAll].
+				blank: 3.
+				allowSwitch 
+					ifTrue: [reorderButtonWithAction: [groupPresenter switchSortOrder]]
+					ifFalse: [nothing]
+				}
+			).
+		groupPresenter:: groupSubject presenter.
+		}
+))
+class ClassReferencesPresenter onSubject: s = ProgrammingPresenter onSubject: s (
+"The subject is an NSClassReferencesSubject. Displays the list of methods provided by the subject, which are those that seem to reference an NS class."|  |)
+('as yet unclassified'
+definition = (
 
-
+	| references |
+	^column: {
+		minorHeadingBlock: (
+			row: {
+				label: subject className asText allBold.
+				label: ' references'.
+				filler.
+				expandButtonWithAction: [references expandAll].
+				blank: 3.
+				collapseButtonWithAction: [references collapseAll]
+				}
+			).
+		blank: 10.
+		row: {
+			blank: 10.
+			elastic:
+				(references::
+				AssortedMethodsPresenter onSubject: (subject referencesSubjects)).
+			}.
+		blank: 10
+		}
+))
+class ClassReferencesSubject onModel: m = Subject onModel: m (
+"The model is the class name. Provides access to methods that are likely to reference the class because they are sending that name as a message."| nameSelectorSubject |nameSelectorSubject:: SelectorSubject onModel: className)
+('as yet unclassified'
+= anotherSubject = (
+	^(anotherSubject class = self class)
+		and: [anotherSubject model = model]
+)
+className = (
 
-respondToBrowseSuperclass = (
+	^model
+)
+createPresenter = (
 
-
+	^ClassReferencesPresenter onSubject: self
+)
+hash = (
+	^model hash
+)
+referencesSubjects = (
 
-respondToConvertToNS3 = (
+	^nameSelectorSubject senderSubjects
+)
+title = (
+	^className, ' References'
+))
+class ClassSubject onModel: m = SuperClassSubject onModel: m (
+"Represents the ''normal'' perspective of looking at an NS class, so that its details such as slots, nested classes, and methods are visible. The model is the mirror on the class. By default presented by NSClassPresenter."| commentPresenter nestedClassesPresenter methodsPresenter guessedSuperclass guessedSubclasses |)
+('accessing'
+classCategoryName ^<Symbol | nil> = (
 
-
+	^Smalltalk organization categoryOfElement: className
+)
+classCommentText ^<String> = (
+	^model header classComment ifNil: ['']
+)
+classCommentText: newComment = (
 
-respondToMoveUp = (
+	notYetImplemented.
+)
+classMethodsSubject = (
 
-
+	^MethodGroupSubject onModel: classMirror classSide methods
+)
+classMirror = (
+	"A synonym of #model, for readability."
 
-respondToRename = (
+	^model
+)
+className = (
 
-
+	^classMirror simpleName
+)
+classPackageName ^<String | nil> = (
+	"Answer the name of the package the class belongs to."
 
-respondToRunApp = (
+	^[(PackageOrganizer default packageOfClass: implementationClass ifNone: [^nil])
+		packageName]
+			on: MessageNotUnderstood
+			do: [:ex | ex return: nil]
+					
+)
+enclosingClass ^ <NS2ClassStencilMirror> = (
+	^classMirror enclosingClass
+)
+enclosingClasses ^<List[NSClassMirror]> = (
+"Returns all classes the model is nested in, beginning with the immediately enclosing class and up to the top level."
+	| classes currentClass |
+	classes:: OrderedCollection new.
+	currentClass:: classMirror enclosingClass.
+	[currentClass notNil] whileTrue:
+		[classes add: currentClass.
+		currentClass:: currentClass enclosingClass].
+	^classes
+)
+enclosingModule ^ <NS2ClassStencilMirror> = (
+	| m <NS2ClassStencilMirror> em <NS2ClassStencilMirror> |
+	m:: classMirror.
+	[m isNil] whileFalse:[em:: m.  m:: m enclosingClassStencil].
+	^em
+)
+implementationClass = (
+"The Smalltalk class behind the scenes."
+^model reflectee definingClass
+)
+initExprs = (
+	^classMirror initExprs
+)
+initExprs: newInitExprs = (
+	^classMirror initExprs: newInitExprs
+)
+methodsSubject = (
 
-
+	^MethodGroupSubject onModel: model instanceSide methods
+)
+nestedClassesSubject = (
 
-respondToRunTests = (
+	^NestedClassGroupSubject onModel: model instanceSide nestedClasses
+)
+slotsSubject = (
 
-
+	^SlotGroupSubject onModel: classMirror instanceSide slots
+)
+subclasses = (
+"guessedSubclasses ifNotNil: [ :sc | ^sc].
+flag: #BOGUS. 
+guessedSubclasses:: model guessSubclassesIfFail: [^NewspeakObject].
+^guessedSubclasses"
+	^Object
+)
+superclassName = (
 
-showHeaderEditor = (
+	^classMirror superclassName
+)
+title = (
+	^className asString
+)'actions'
+acceptClassDefinition: aString = (
 
-
+	| builder |
+	builder:: ClassDeclarationBuilder reflecting: model reflectee.
+	builder headerFromSource: aString.
+	builder install.
+	^true
+)
+convertToNS1IfSuccess: successBlock <[]> ifFail: failBlock <[]> = (
+canBeConvertedToNS1 ifFalse: [^failBlock value].
+classMirror convertToNS1.
+^successBlock value
+)
+convertToNS3IfSuccess: successBlock <[Class]> ifFail: failBlock <[]> = (
+	canBeConvertedToNS3 
+		ifFalse: [ ^ failBlock value]
+		ifTrue: [ | stream ns3Class | 
+			stream:: classAsString readStream.
+			deleteClass.
+			ns3Class:: Language newspeak3 compiler new compileUnit: stream. 
+			^ successBlock valueWithPossibleArgument: ns3Class ] 
+)
+makeExe = (
+	|appDef app|
+	Deployment canMakeExe ifFalse: [
+		^presenter enterPresenter: DeploymentInstructionsPresenter new.
+	].
+	
+	appDef:: Smalltalk at: model simpleName.
+	app:: appDef packageUsing: blackMarket.
+	Deployment appToExe: app
+)
+makeNof = (
+	|appDef app|
+	appDef:: Smalltalk at: model simpleName.
+	app:: appDef packageUsing: blackMarket.
+	Deployment appToNof: app.
+)'as yet unclassified'
+classAsString ^ <String> = (
+	^ (String streamContents: [:s | implementationClass printClassOn: s])
+)
+classLanguage = (
+	^Language newspeak3
+)
+colorizeSource: sourceText <String | Text> ^<Text> = (
+	^NS3Colorizer new
+		parseText: sourceText asString
+		fromClass: model reflectee definingClass
+		usingSelector: #classHeader
+)
+deleteClass = (
 
-'definition'
+	model enclosingClass = nil ifTrue: [
+		
+		Smalltalk removeKey: model simpleName ifAbsent: [].
+		SystemOrganization removeMissingClasses.		
 
-applicationActionsIfNeeded = (
+	] ifFalse: [
+	
+		| builder |
+		builder:: ClassDeclarationBuilder reflecting: model enclosingClass reflectee.
+		builder instanceSide nestedClasses removeMirrorNamed: model simpleName.
+		builder install.
+	].
 
-
+	^ model simpleName
+)
+isMinitestTestConfiguration = (
+	^isTopLevel and: [model classSide canUnderstand: #packageTestsUsing:]
+)
+isTopLevel = (
+	^model enclosingClass == nil
+)
+makeImage = (
+	|appDef app|
+	appDef:: Smalltalk at: model simpleName.
+	app:: appDef packageUsing: blackMarket.
+	Deployment makeDeploymentImageFor: app.
+)
+methodCount = (
 
-classCategoryLink = (
+	|instanceCount classCount|
+	flag: #BOGUS. 
+	instanceCount:: model instanceSide methods size.
+	classCount:: model classSide methods size.
+	^instanceCount + classCount
+	"^0"
+)
+superclass = (
+	| applications |
+	applications:: model instanceSide applications.
+	applications 
+		detect: [:any <ClassMirror> | ^any superclass mixin reflectee definingClass]
+		ifNone: [^Object]
+)
+totalSubclassCount = (
 
-
+	"flag: #BOGUS.
+	^(classMirror guessSubclassesIfFail: [Array new]) size"
+	^0
+)'private'
+createPresenter = (
 
-classDefinitionEditor = (
+	^ClassPresenter onSubject: self
+)'testing'
+canBeConvertedToNS1 = (
+^classMirror mixin classes isEmpty
+)
+canBeConvertedToNS3 = (
+	implementationClass language isNewspeakLanguage2 ifFalse: [ ^ false ].
+	[ Language newspeak3 parser new classDefinition 
+		parse: classAsString readStream. ] on: Error do: [ ^ false ].
+	^ true
+)
+hasInitExprs = (
+	^((initExprs select: [:each | each isSeparator]) size = initExprs size) not
+)
+isAppDefinition = (
+	^isTopLevel and: [model classSide canUnderstand: #packageUsing:]
+))
+class ExpandableClassPresenter onSubject: s = ProgrammingPresenter onSubject: s (
+"Presents the subject (an NSClassSubject) as a line displaying the class name and expandable into a full-blown class view."|  |)
+('as yet unclassified'
+collapse = (
 
-
+	substance collapse
+)
+definition = (
 
-classIconAndNameHeading = (
+	| toggle |
+	toggle::
+		collapsed: (NestedClassPresenter onSubject: subject)
+		expanded: [ClassPresenter onSubject: subject classSubject].
+	toggle onUserToggled: [requestVisibility].
+	^toggle
+)
+expand = (
 
-
+	substance expand
+))
+class MethodGroupPresenter onSubject: s = MirrorGroupPresenter onSubject: s (
+"Presents the subject, an NSMethodGroup, as a column of presenters for the methods in the group. Automatically gets updated after the subject mirror group. Anything that has to do with adding, editing or deleting NS methods goes here."| groupedByCategory::=false. |)
+('actions'
+switchSortOrder = (
 
-classNameAndContainmentDefinition = (
+	groupedByCategory: groupedByCategory not.
+	refresh
+)'as yet unclassified'
+addMethodIn: cls proposedSource: src = (
+subject model declaringMixin enclosingClassStencil implementationClass == cls ifTrue:
+	[| template |
+	template:: addNewItemTemplate: src.
+	"turnOnTemplateEditorMode: src in: template"]
+)
+addNewItemTemplate = (
+"Handle a user's request to create a new method by displaying a new method template."
+||
+addNewItemTemplate: subject methodTemplateText
+)
+addNewItemTemplate: src = (
+	"Handle a user's request to create a new method by displaying a new method template."
 
-
+	| template |
+	template:: DefinitionTemplate new
+		caption: 'Adding new method:';
+		initialText: src;
+		colorizerBlock: [ :text | subject colorizeSource: text];
+		acceptResponse:
+			[createNewMethodFromTemplate: template];
+		cancelResponse:
+			[prefixes remove: template].
+	prefixes add: template.
+	^template
+)
+compileMethod: source <String> inPresenter: requestor <Presenter> ifCompiledAsSame: successResponse <Block> ifCompiledAsNew: successNewResponse <Block> ifFailed: failureResponse <Block> = (
 
-classPackageLink = (
+	majorUpdate:
+		[subject
+			compileSource: source
+			ifSuccess: 
+				[:newSelector |
+				newSelector = requestor subject selector
+					ifTrue: [successResponse value]
+					ifFalse: [successNewResponse value].
+				content refresh.
+				(content detectPresenter: [:some | some subject selector = newSelector]) 
+					expand]
+			ifFailure: failureResponse]
+)
+createNewMethodFromTemplate: template <DefinitionTemplate> = (
 
-
+	subject 
+		compileSource: template text
+		ifSuccess:
+			[:newSelector |
+			prefixes remove: template.
+			(content detectPresenter: [:some | some subject selector = newSelector]) expand]
+		ifFailure:[:message | template editor showMessage: message]
+)
+deleteMethodInPresenter: presenter <Presenter> ifSuccess: successResponse <Block> ifFailure: failureResponse <Block> = (
 
-classSummaryDefinition = (
+	subject deleteMethodWithSubject: presenter subject.
+	successResponse value
+)
+recategorizeMethodIn: presenter <Presenter> under: newCategoryName <String> ifSuccess: successResponse <Block> ifFailed: failureResponse <Block> = (
 
-
+	| newName |
+	newName:: newCategoryName withBlanksTrimmed.
+	newName isEmpty ifTrue: [^failureResponse value].
+	presenter subject
+		changeCategoryTo: newName asSymbol
+		ifSuccess: successResponse
+		ifFailure: failureResponse
+)
+repondToEnter: template defaultAction: defaultAction = (
+| src index indexType range pos end |
+range:: template editor editor selectionInterval.
+pos:: range isEmpty ifTrue: [range first] ifFalse: [range last].
+src:: (template editor editedText ifNil: [template editor text]) asString.
+index:: src asString findString: 'argument' startingAt: pos.
+indexType:: src indexOf: $< startingAt: pos.
+(index ~= 0 and: [indexType ~= 0]) ifTrue:
+	[index:: index min: indexType].
+index = 0 ifTrue:
+	[index:: indexType].
+index = 0 ifTrue:
+	[template editor enterKeyResponse: nil.
+	index:: src indexOf: Character tab startingAt: pos.
+	index ~= 0 ifTrue:
+		[template editor editor
+			selectFrom: index + 1
+			to: index].
+	^self].
+end:: index = indexType
+	ifTrue:
+		[index:: index + 1.
+		(src indexOf: $> startingAt: pos) - 1]
+	ifFalse: ['argument' size + index].
+template editor editor
+	selectFrom: index
+	to: end
+)
+turnOnTemplateEditorMode: src in: template = (
+| indexOfFirstArg |
+indexOfFirstArg:: src findString: 'argument1'.
+indexOfFirstArg > 0 ifTrue:
+	[template editor enterKeyResponse:
+		[:defaultAction |
+		repondToEnter: template defaultAction: defaultAction].
+	template editor editor
+		selectFrom: indexOfFirstArg
+		to: 'argument1' size + indexOfFirstArg - 1]
+)'private'
+contentPresenters = (
 
-definition = (
+	| subjects |
+	subjects:: groupedByCategory
+		ifTrue: [subject sortedCategories]
+		ifFalse: [subject elements].
+	^subjects collect: 
+		[:each | createPresenterForSubject: each]
+))
+class MethodGroupSubject onModel: m = MirrorGroupSubject onModel: m (
+"Represents the collection of methods of a Newspeak class. Holds onto the mirror group for the methods."|  |)
+('actions'
+methodTemplateText = (
+^
+'messageSelector = (
+	
+)'
+)'as yet unclassified'
+colorizeSource: sourceText <String | Text> ^<Text> = (
+	^NS3Colorizer new
+		parseText: sourceText asString
+		fromClass: model enclosingMixin declaration reflectee definingClass
+		usingSelector: #methodDecl
+)
+compileSource: aString ifSuccess: successBlock ifFailure: failureBlock = (
 
-
+	"| builder newMirror |
+	builder:: model reflection methodBuilderFromSource: aString.
+	builder validateIfError:
+		[:message :pos |
+		^failureBlock valueWithPossibleArgument: message ].
+	newMirror:: builder asMirror.
+	model addMirror: newMirror.
+	successBlock value: newMirror selector"
+	
+	| builder newMirror |
+	builder:: MixinBuilder reflecting: model enclosingMixin reflectee.
+	newMirror:: builder methods addFromSource: aString.
+	builder declaration install.
+	successBlock value: newMirror simpleName.
+)
+createPresenter = (
+^MethodGroupPresenter onSubject: self
+)
+deleteMethodWithSubject: methodSubject = (
 
-definitionSummaryAndEditorPanel = (
+	| builder |
+	builder:: MixinBuilder reflecting: model enclosingMixin reflectee.
+	builder methods removeMirrorNamed: methodSubject selector.
+	builder declaration install.
+)
+elementSubjectClass = (
 
-
+	^MethodSubject
+)
+methodSubjectsInCategory: categoryName <Symbol> ^<Collection[MethodSubject]> = (
 
-headingDefinition = (
+	| matches |
+	matches:: (modelMirrorCollection select: [:each | each category = categoryName]).
+	^matches collect: [:mirrorMethod | elementSubjectClass onModel: mirrorMethod].
+)
+modelMirrorCollection = (
+	^super modelMirrorCollection asSortedList: [:a :b | a simpleName < b simpleName]
+)
+sortedCategories = (
+"Answer a collection of method subjects sorted by their category names found in the class, sorted with initialization first and private categories last."
 
-
+| categories init privateCategories unclassified lineup |
+categories:: modelMirrorCollection inject: Set new into: [:s :m | s add: m category. s].
+init:: categories select: [:each | 'init*' match: each].
+categories:: categories reject: [:each | init includes: each].
+privateCategories:: categories select: [:each | 'private*' match: each].
+categories:: categories reject: [:each | privateCategories includes: each].
+(categories includes: #'as yet unclassified')
+	ifTrue:
+		[unclassified:: {#'as yet unclassified'}.
+		categories remove: #'as yet unclassified']
+	ifFalse:
+		[unclassified:: {}].
+lineup:: OrderedCollection new: categories size.
+lineup 
+	addAll: unclassified;
+	addAll: init asSortedList;
+	addAll: categories asSortedList;
+	addAll: privateCategories asSortedList.
+^lineup 
+	inject: OrderedCollection new
+	into: 
+		[:collection :each |
+		collection addAll: (methodSubjectsInCategory: each).
+		collection]
+))
+class MethodInheritanceSubject onModel: m = SuperMethodInheritanceSubject onModel: m (
+""|  |)
+('as yet unclassified'
+implementingClass = (
 
-initializerDefinition = (
+	self halt
+)
+methodTitle = (
 
-
+	^model enclosingClassStencil name, '>>', selector
+)
+selector = (
 
-testActionsIfNeeded = (
+	^model selector
+))
+class MethodSubject onModel: m = SuperduperMethodSubject onModel: m (
+""|  |)
+('accessing'
+messages = (
 
-
+	^(model reflectee) messages
+)
+methodCategory = (
+	^methodMirror category
+)
+methodMirror = (
 
-'accessing'
+	^model
+)
+selector = (
 
-extraInformationMetapresenter = (
+	^model name
+)
+source = (
 
-
+	^model source
+)
+variableBindingKeys = (
 
-icon = (
+	| result |
+	result:: OrderedCollection new.
+	(model reflectee) literalsDo:
+		[:each |
+		(each isVariableBinding and:[each key notNil]) ifTrue:
+			[result add: each key]].
+	^result
+)'as yet unclassified'
+=  other <Object> ^<Boolean> = (
 
-
+	^self class = other class and: [model = other model]
+)
+allMethodCategories ^<Collection[Symbol]> = (
+"Answer a collection of all category names used in the implementor class, plus some common names."
 
-nestingInformationLine = (
+| names |
+names:: super allMethodCategories.
+names addAll: (model definingMixin methods collect: [:ea | ea category]).
+^names
 
-
+)
+asMethodInheritanceSubject = (
+^NSMethodInheritanceSubject onModel: model
+)
+changeCategoryTo: newName ifSuccess: successBlock ifFailure: failureBlock = (
 
-preambleLine = (
+	| builder |
+	builder:: MixinBuilder reflecting: model definingMixin reflectee.
+	(builder methods findMirrorNamed: model simpleName) category: newName.
+	builder declaration install.
+	#BOGUS. "Do this non atomicly?"
 
-
+	successBlock value
+)
+className = (
 
-slotsPresenter = (
+	^model definingMixin name 
+)
+colorizeMethodSource: sourceText = (
+	^NS3Colorizer new
+		parseText: sourceText asString
+		fromClass: model reflectee methodClass
+		usingSelector: #methodDecl
+)
+compileNewSource: source <String> ifSuccess: successBlock ifNewMethod: newBlock1arg ifFailure: failureBlock = (
 
-
+	| builder newMirror |
+	builder:: MixinBuilder reflecting: model definingMixin reflectee.
+	newMirror:: builder methods addFromSource: source.
+	builder declaration install.
+	newMirror simpleName = model simpleName
+		ifTrue: ["same" successBlock value]
+		ifFalse: ["new" newBlock1arg value: newMirror simpleName].
+)
+compiledMethod = (
 
-slotsPresenter: aPresenter = (
+	^model reflectee
+)
+hash ^<SmallInteger> = (
 
-
+	^self class hash bitXor: model hash
+)
+implementingClass = (
 
-'actions'
+	^model reflectee methodClass
+)
+isAnOverride = (
 
-acceptClassDefinition: editor = (
+	^superclass canUnderstand: self selector
+)
+isAnOverrideIn: classSubject <NSClassSubject | nil> = (
 
-
+^(classSubject ifNil: [^isAnOverride]) superclass canUnderstand: self selector
+)
+isOverridden = (
 
-classActionsMenu = (
+	flag: #BOGUS. 
+	^false.
+)
+isOverriddenIn: classSubject <NSClassSubject | nil> = (
+"(classSubject ifNil: [^isOverridden]) subclasses do: [ :ea |
+	(ea mixin methods includesMirrorNamed: selector)
+		ifTrue: [^true]]."
+^false
+)
+isPrivate ^<Boolean> = (
+^methodMirror isPrivate
+)
+isValid = (
 
-
+	flag: #BOGUS.
+	^true
+)
+prettyPrint = (
+| language ast |
+language:: implementingClass language.
+ast:: language parser new methodDef parse: source readStream.
+^ASTPrinter new visit: ast
+)
+superclass = (
+	#BOGUS.
+	^Object
+))
+class MirrorGroupPresenter onSubject: s = DefinitionListPresenter onSubject: s (
+""| elementPresenterClass |)
+('actions'
+addNewItemTemplate = (
+	"A subclass must redefine this to show a template for the user to fill out to create a new item in the group."
 
-respondToConvertToNS1 = (
+	subclassResponsibility
+)'initialize-release'
+subject: aMirrorGroupSubject = (
 
-
+	super subject: aMirrorGroupSubject.
+	subject changedChannel => [:whatever | content refresh]
+)'private'
+contentPresenters = (
 
-respondToDelete = (
+	^subject elements collect: 
+		[:each | createPresenterForSubject: each]
+)
+createPresenterForSubject: aSubject = (
+	"Let the subject create its default unless elementPresenterClass is set to specify our preference."
 
-
+	^elementPresenterClass
+		ifNil: [aSubject presenter]
+		ifNotNil: [:pclass | pclass onSubject: aSubject]
+))
+class MirrorGroupSubject onModel: m = Subject onModel: m (
+"An abstract superclass of subjects on mirror groups. Registers to receive update events from the mirror group and broadcasts its own update events through its 'changedChannel' when that happens. The presenter will listen to those and update itself when needed."| 
+mirrorGroupChangesOutlet
+changedChannel::= Duct owner: self.
+|self model: m)
+('as yet unclassified'
+elementSubjectClass = (
+	"Answer the class of the subjects we create on individual elements of our subject group."
 
-respondToMoveDown = (
+	subclassResponsibility
+)
+elements ^<Collection[Subject]> = (
+	"Answer a collection of subjects on individual elements of the group which is our subject."
 
-
+	^modelMirrorCollection collect: [:each | elementSubjectClass onModel: each]
+)
+modelMirrorCollection ^<Collection[Mirror]> = (
 
-respondToSave = (
+	^(model collect: [:x|x]) asOrderedCollection
+)'initialize-release'
+model: mirrorGroup = (
 
-
+	super model: mirrorGroup.
+	"We expect the mirror group changes channel to be weak so we are retaining the outlet and expect that the old one, if any, will get garbage-collected."
+	
+	mirrorGroupChangesOutlet::
+		model channelForChanges => [:x | changedChannel send: true].
+))
+class NestedClassGroupPresenter onSubject: s = MirrorGroupPresenter onSubject: s (
+"Presents nested classes of an NS class and takes care of their creation and deletion."|  |)
+('as yet unclassified'
+acceptNewClassDefinitionFrom: aTemplate = (
 
-'private'
+	subject
+		addClassFromDefinition: aTemplate text
+		ifSuccess:
+			[prefixes remove: aTemplate]
+		ifFailure:
+			[:msg | aTemplate editor showMessage: msg]
+)
+addNewItemTemplate = (
 
-sectionLabelled: title <String> presenting: groupSubject <MirrorGroupSubject> = (
+	| template |
+	template:: DefinitionTemplate new
+		caption: 'Adding new class:';
+		initialText: subject classDefinitionHeaderPartTemplate;
+		colorizerBlock: [ :text | subject colorizeSource: text];
+		acceptResponse:
+			[acceptNewClassDefinitionFrom: template];
+		cancelResponse:
+			[prefixes remove: template].
+	prefixes add: template
+))
+class NestedClassGroupSubject onModel: m = MirrorGroupSubject onModel: m (
+"Represents the collection of classes nested in a Newspeak class. Holds onto the mirror group for the classes.
+"|  |)
+('as yet unclassified'
+addClassFromDefinition: aString ifSuccess: successBlock ifFailure: failureBlock = (
 
-
+	| builder newMirror |
+	builder:: MixinBuilder reflecting: model enclosingMixin reflectee.
+	builder nestedClasses addFromSource:
+			(classDefinitionFromHeaderPart: aString).
+	builder declaration install.
+			
+	successBlock value
+)
+colorizeSource: sourceText <Text | String> ^<Text> = (
+	^NS3Colorizer new
+		parseText: sourceText asString
+		fromClass: model enclosingMixin declaration reflectee definingClass
+		usingSelector: #classDefinitionTemplate
+)
+createPresenter = (
+^NestedClassGroupPresenter onSubject: self
+)
+modelMirrorCollection = (
+	^super modelMirrorCollection asSortedList: [:a :b | a simpleName < b simpleName]
+)'private'
+classDefinitionFromHeaderPart: headerPart <String> ^<String> = (
 
-sectionLabelled: title <String> presenting: groupSubject <MirrorGroupSubject> allowSwitch: allowSwitch = (
+	^headerPart, ' ()'
+)
+classDefinitionHeaderPartTemplate = (
+^
+'class ClassNameHere = (
+"Describe the class in this comment."
+|
+	slot1
+	slot2
+|
+)'
+)
+elementSubjectClass = (
 
-
+	^NestedClassSubject
+))
+class NestedClassPresenter onSubject: s = ProgrammingPresenter onSubject: s (
+"Presents an NSClassSubject as link that browses the class."|  |)
+('as yet unclassified'
+definition = (
+^
+	link: subject classMirror simpleName
+	action: [	browseClassMirror: subject classMirror]
+))
+class NestedClassSubject onModel: m = Subject onModel: m (
+"Represents a class nested inside another class. The default presenter renders this as a link that enters the class definition when clicked."|  |)
+('accessing'
+classMirror = (
 
-)
+	^model
+)'as yet unclassified'
+classSubject = (
 
-
+	^ClassSubject onModel: classMirror
+)'private'
+createPresenter = (
 
-class MethodGroupPresenter onSubject: s = MirrorGroupPresenter onSubject: s (
-"Presents the subject, an NSMethodGroup, as a column of presenters for the methods in the group. Automatically gets updated after the subject mirror group. Anything that has to do with adding, editing or deleting NS methods goes here." 
-| groupedByCategory::=false. |
-)
+	^ExpandableClassPresenter onSubject: self
+))
+class SlotGroupPresenter onSubject: s = MirrorGroupPresenter onSubject: s (
+"Displays the slots of a Newspeak class and handles their definiting, editing and removal. The subject is an NSSlotGroupSubject."|  |)
+('as yet unclassified'
+acceptNewSlotDefinitionFrom: aTemplate = (
 
-('as yet unclassified'
+	majorUpdate:
+		[subject
+			acceptSlotDefinition: aTemplate text
+			ifSuccess:
+				[prefixes remove: aTemplate]
+			ifFailure: 
+				[:message |
+				error: message]]
+)
+addNewItemTemplate = (
 
-addMethodIn: cls proposedSource: src = (
+	sendUp showHeaderEditor
+)
+defineSlot: definition <String> ifSuccess: successResponse <Block> ifFailure: failureResponse <Block> = (
 
-
+	majorUpdate:
+		[subject
+			acceptSlotDefinition: definition
+			ifSuccess: successResponse
+			ifFailure: failureResponse]
+)
+deleteSlotInPresenter: presenter <NSSlotPresenter> = (
 
-addNewItemTemplate = (
+	|  slotSubject residue |
+	slotSubject:: presenter subject.
+	residue:: DefinitionResidue new
+		caption: 'Deleted slot ', slotSubject slotName;
+		definitionText: slotSubject definitionText;
+		restoreResponse: [error: 'unimplemented'];
+		forgetResponse: [suffixes remove: residue].
+	subject deleteSlotSubject: slotSubject.
+	suffixes add: residue
+))
+class SlotGroupSubject onModel: m = MirrorGroupSubject onModel: m (
+""|  |)
+('as yet unclassified'
+acceptSlotDefinition: definitionString ifSuccess: successBlock0 ifFailure: failureBlock1 = (
 
-
+	self unimplemented.  "Does it make sense to edit slots in isolation?"
+)
+colorizeSource: sourceText <Text | String> ^<Text> = (
+^NS2BrowserColorizer new
+	parseText: sourceText asString
+	fromClass: model declaringMixin
+	usingSelector: #slotDef
+)
+createPresenter = (
+^SlotGroupPresenter onSubject: self
+)
+deleteSlotSubject: aSlotSubject = (
 
-addNewItemTemplate: src = (
+	model removeMirrorNamed: aSlotSubject slotName
+)
+elementSubjectClass = (
 
-
+	^SlotSubject
+))
+class SlotPresenter onSubject: s = ProgrammingPresenter onSubject: s (
+"The subject is an NSSlotSubject. Presents the slot as a link expandable into a full definition."| editor |)
+('as yet unclassified'
+goToMessages = (
 
-compileMethod: source <String> inPresenter: requestor <Presenter> ifCompiledAsSame: successResponse <Block> ifCompiledAsNew: successNewResponse <Block> ifFailed: failureResponse <Block> = (
+	| messagesAndActions messageItems classItems |
+	messagesAndActions:: OrderedCollection new.
+	messagesAndActions 
+		add: subject slotName -> [browseSelector: subject slotName];
+		add: (subject slotName, ':') -> [browseSelector: subject slotName, ':'].
+	"messageItems:: referencesMenuMessageItems.
+	classItems:: referencesMenuClassItems.
+	messageItems notEmpty ifTrue:
+		[messagesAndActions 
+			add: #separator;
+			addAll: messageItems].
+	classItems notEmpty ifTrue:
+		[messagesAndActions 
+			add: #separator;
+			addAll: classItems]."
+	openMenuWithLabelsAndActions: messagesAndActions
+)'definition'
+definition = (
+	^row: {
+		link: subject slotNameAndInitializerString action: [sendUp showHeaderEditor].
+		filler.
+		itemReferencesMenuButtonWithAction: [goToMessages].
+		}
+)'private'
+definitionText = (
 
-
+	^subject slotDefinitionString
+)
+visibilityIcon = (
 
-createNewMethodFromTemplate: template <DefinitionTemplate> = (
+	subject slotIsPublic ifTrue: [^'( )'].
+	subject slotIsProtected ifTrue: [^'(r)'].
+	^'(p)'
+))
+class SlotSubject onModel: m = Subject onModel: m (
+""| deleteResponse |)
+('accessing'
+acceptSlotDefinition: definitionString ifSuccess: successBlock0 ifFailure: failureBlock1 = (
 
-
+	flag:: #BOGUS. "do something!"
+	failureBlock1 value: 'Sorry, saving is not implemented yet'
+)
+definitionText = (
 
-deleteMethodInPresenter: presenter <Presenter> ifSuccess: successResponse <Block> ifFailure: failureResponse <Block> = (
+	^slotDefinitionString
+)
+slotDefinitionString = (
 
-
+	^slotMirror source copy
+)
+slotInitializer = (
 
-recategorizeMethodIn: presenter <Presenter> under: newCategoryName <String> ifSuccess: successResponse <Block> ifFailed: failureResponse <Block> = (
+	^slotMirror initializer
+)
+slotIsPrivate = (
 
-
+	^slotMirror isPrivate
+)
+slotIsProtected = (
 
-repondToEnter: template defaultAction: defaultAction = (
+	^slotMirror isProtected
+)
+slotIsPublic = (
 
-
+	^slotMirror isPublic
+)
+slotMirror = (
+"A synonym of #model, for readability."
 
-turnOnTemplateEditorMode: src in: template = (
+^model
+)
+slotName = (
 
-
+	^slotMirror name
+)
+slotNameAndInitializerString ^<String> = (
+	"Answer a string that includes the name of the slot and some information from its initializer. The initializer information does not have to be complete; rather it should be formatted so as to look nice as a single line."
 
-'actions'
+	| stream initializer |
+	stream:: (String new: 30) writeStream.
+	stream nextPutAll: slotMirror name.
+	"initializer:: slotMirror initializer.
+	initializer notEmpty ifTrue:
+		[stream nextPutAll: ' = ', (shorten: initializer toFirstCROrCharacters: 40)]."
+	^stream contents
+)
+slotVisibility = (
 
-switchSortOrder = (
+	slotMirror isPrivate ifTrue: [^'private'].
+	slotMirror isProtected ifTrue: [^'protected'].
+	slotMirror isPublic ifTrue: [^'public'].
+	^''
+)'colorization'
+colorizeSource: sourceText <Text | String> ^<Text> = (
+^NS2BrowserColorizer new
+	parseText: sourceText asString
+	fromClass: model enclosingMixin
+	usingSelector: #slotDef
+)'private'
+createPresenter = (
 
-
+	^SlotPresenter onSubject: self
+)
+shorten: aString toFirstCROrCharacters: maxCharacters <Integer> ^<String> = (
 
-'private'
-
-contentPresenters = (
-
-
-
-)
-
-
-
-class NestedClassGroupPresenter onSubject: s = MirrorGroupPresenter onSubject: s (
-"Presents nested classes of an NS class and takes care of their creation and deletion." 
-|  |
-)
-
-('as yet unclassified'
-
-acceptNewClassDefinitionFrom: aTemplate = (
-
-
-
-addNewItemTemplate = (
-
-
-
-)
-
-
-
-class MethodInheritanceSubject onModel: m = SuperMethodInheritanceSubject onModel: m (
-"" 
-|  |
-)
-
-('as yet unclassified'
-
-implementingClass = (
-
-
-
-methodTitle = (
-
-
-
-selector = (
-
-
-
-)
-
-
-
-class ClassSubject onModel: m = SuperClassSubject onModel: m  (
-"Represents the ''normal'' perspective of looking at an NS class, so that its details such as slots, nested classes, and methods are visible. The model is the mirror on the class. By default presented by NSClassPresenter." 
-| commentPresenter nestedClassesPresenter methodsPresenter guessedSuperclass guessedSubclasses |
-)
-
-('as yet unclassified'
-
-classAsString ^ <String> = (
-
-
-
-classLanguage = (
-
-
-
-colorizeSource: sourceText <String | Text> ^<Text> = (
-
-
-
-deleteClass = (
-
-
-
-isMinitestTestConfiguration = (
-
-
-
-isTopLevel = (
-
-
-
-makeImage = (
-
-
-
-methodCount = (
-
-
-
-superclass = (
-
-
-
-totalSubclassCount = (
-
-
-
-'accessing'
-
-classCategoryName ^<Symbol | nil> = (
-
-
-
-classCommentText ^<String> = (
-
-
-
-classCommentText: newComment = (
-
-
-
-classMethodsSubject = (
-
-
-
-classMirror = (
-
-
-
-className = (
-
-
-
-classPackageName ^<String | nil> = (
-
-
-
-enclosingClass ^ <NS2ClassStencilMirror> = (
-
-
-
-enclosingClasses ^<List[NSClassMirror]> = (
-
-
-
-enclosingModule ^ <NS2ClassStencilMirror> = (
-
-
-
-implementationClass = (
-
-
-
-initExprs = (
-
-
-
-initExprs: newInitExprs = (
-
-
-
-methodsSubject = (
-
-
-
-nestedClassesSubject = (
-
-
-
-slotsSubject = (
-
-
-
-subclasses = (
-
-
-
-superclassName = (
-
-
-
-title = (
-
-
-
-'testing'
-
-canBeConvertedToNS1 = (
-
-
-
-canBeConvertedToNS3 = (
-
-
-
-hasInitExprs = (
-
-
-
-isAppDefinition = (
-
-
-
-'actions'
-
-acceptClassDefinition: aString = (
-
-
-
-convertToNS1IfSuccess: successBlock <[]> ifFail: failBlock <[]> = (
-
-
-
-convertToNS3IfSuccess: successBlock <[Class]> ifFail: failBlock <[]> = (
-
-
-
-makeExe = (
-
-
-
-makeNof = (
-
-
-
-'private'
-
-createPresenter = (
-
-
-
-)
-
-
-
-class NestedClassSubject onModel: m = Subject onModel: m (
-"Represents a class nested inside another class. The default presenter renders this as a link that enters the class definition when clicked." 
-|  |
-)
-
-('as yet unclassified'
-
-classSubject = (
-
-
-
-'accessing'
-
-classMirror = (
-
-
-
-'private'
-
-createPresenter = (
-
-
-
-)
-
-
-
-class MethodSubject onModel: m = SuperduperMethodSubject onModel: m  (
-"" 
-|  |
-)
-
-('as yet unclassified'
-
-=  other <Object> ^<Boolean> = (
-
-
-
-allMethodCategories ^<Collection[Symbol]> = (
-
-
-
-asMethodInheritanceSubject = (
-
-
-
-changeCategoryTo: newName ifSuccess: successBlock ifFailure: failureBlock = (
-
-
-
-className = (
-
-
-
-colorizeMethodSource: sourceText = (
-
-
-
-compileNewSource: source <String> ifSuccess: successBlock ifNewMethod: newBlock1arg ifFailure: failureBlock = (
-
-
-
-compiledMethod = (
-
-
-
-hash ^<SmallInteger> = (
-
-
-
-implementingClass = (
-
-
-
-isAnOverride = (
-
-
-
-isAnOverrideIn: classSubject <NSClassSubject | nil> = (
-
-
-
-isOverridden = (
-
-
-
-isOverriddenIn: classSubject <NSClassSubject | nil> = (
-
-
-
-isPrivate ^<Boolean> = (
-
-
-
-isValid = (
-
-
-
-prettyPrint = (
-
-
-
-superclass = (
-
-
-
-'accessing'
-
-messages = (
-
-
-
-methodCategory = (
-
-
-
-methodMirror = (
-
-
-
-selector = (
-
-
-
-source = (
-
-
-
-variableBindingKeys = (
-
-
-
-)
-
-
-
-class SlotGroupSubject onModel: m = MirrorGroupSubject onModel: m (
-"" 
-|  |
-)
-
-('as yet unclassified'
-
-acceptSlotDefinition: definitionString ifSuccess: successBlock0 ifFailure: failureBlock1 = (
-
-
-
-colorizeSource: sourceText <Text | String> ^<Text> = (
-
-
-
-createPresenter = (
-
-
-
-deleteSlotSubject: aSlotSubject = (
-
-
-
-elementSubjectClass = (
-
-
-
-)
-
-
-
-class SlotGroupPresenter onSubject: s = MirrorGroupPresenter onSubject: s (
-"Displays the slots of a Newspeak class and handles their definiting, editing and removal. The subject is an NSSlotGroupSubject." 
-|  |
-)
-
-('as yet unclassified'
-
-acceptNewSlotDefinitionFrom: aTemplate = (
-
-
-
-addNewItemTemplate = (
-
-
-
-defineSlot: definition <String> ifSuccess: successResponse <Block> ifFailure: failureResponse <Block> = (
-
-
-
-deleteSlotInPresenter: presenter <NSSlotPresenter> = (
-
-
-
-)
-
-
-
-class ExpandableClassPresenter onSubject: s = ProgrammingPresenter onSubject: s (
-"Presents the subject (an NSClassSubject) as a line displaying the class name and expandable into a full-blown class view." 
-|  |
-)
-
-('as yet unclassified'
-
-collapse = (
-
-
-
-definition = (
-
-
-
-expand = (
-
-
-
-)
-
-
-
-class NestedClassGroupSubject onModel: m = MirrorGroupSubject onModel: m (
-"Represents the collection of classes nested in a Newspeak class. Holds onto the mirror group for the classes.
-" 
-|  |
-)
-
-('as yet unclassified'
-
-addClassFromDefinition: aString ifSuccess: successBlock ifFailure: failureBlock = (
-
-
-
-colorizeSource: sourceText <Text | String> ^<Text> = (
-
-
-
-createPresenter = (
-
-
-
-modelMirrorCollection = (
-
-
-
-'private'
-
-classDefinitionFromHeaderPart: headerPart <String> ^<String> = (
-
-
-
-classDefinitionHeaderPartTemplate = (
-
-
-
-elementSubjectClass = (
-
-
-
-)
-
-
-
-class MirrorGroupPresenter onSubject: s = DefinitionListPresenter onSubject: s (
-"" 
-| elementPresenterClass |
-)
-
-('initialize-release'
-
-subject: aMirrorGroupSubject = (
-
-
-
-'actions'
-
-addNewItemTemplate = (
-
-
-
-'private'
-
-contentPresenters = (
-
-
-
-createPresenterForSubject: aSubject = (
-
-
-
-)
-
-
-
-class ClassReferencesPresenter onSubject: s = ProgrammingPresenter onSubject: s (
-"The subject is an NSClassReferencesSubject. Displays the list of methods provided by the subject, which are those that seem to reference an NS class." 
-|  |
-)
-
-('as yet unclassified'
-
-definition = (
-
-
-
-)
-
-
-
-class ClassReferencesSubject onModel: m = Subject onModel: m (
-"The model is the class name. Provides access to methods that are likely to reference the class because they are sending that name as a message." 
-| nameSelectorSubject |
-
-	nameSelectorSubject:: SelectorSubject onModel: className
-)
-
-('as yet unclassified'
-
-= anotherSubject = (
-
-
-
-className = (
-
-
-
-createPresenter = (
-
-
-
-hash = (
-
-
-
-referencesSubjects = (
-
-
-
-title = (
-
-
-
-)
-
-
-
-class SlotPresenter onSubject: s = ProgrammingPresenter onSubject: s (
-"The subject is an NSSlotSubject. Presents the slot as a link expandable into a full definition." 
-| editor |
-)
-
-('as yet unclassified'
-
-goToMessages = (
-
-
-
-'private'
-
-definitionText = (
-
-
-
-visibilityIcon = (
-
-
-
-'definition'
-
-definition = (
-
-
-
-)
-
-
-
-class SlotSubject onModel: m = Subject onModel: m  (
-"" 
-| deleteResponse |
-)
-
-('accessing'
-
-acceptSlotDefinition: definitionString ifSuccess: successBlock0 ifFailure: failureBlock1 = (
-
-
-
-definitionText = (
-
-
-
-slotDefinitionString = (
-
-
-
-slotInitializer = (
-
-
-
-slotIsPrivate = (
-
-
-
-slotIsProtected = (
-
-
-
-slotIsPublic = (
-
-
-
-slotMirror = (
-
-
-
-slotName = (
-
-
-
-slotNameAndInitializerString ^<String> = (
-
-
-
-slotVisibility = (
-
-
-
-'colorization'