MiscBrowsing.ns

Newspeak3
'HopscotchIDE'
class MiscBrowsing usingPlatform: p ide: ide = (
(* Copyright 2008 Cadence Design Systems, Inc.
Copyright 2009-2011 Ryan Macnak and other contributors.
Copyright 2012 Cadence Design Systems, Inc.

Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0 *)
||
	private Smalltalk = p squeak Smalltalk.
	private Preferences = p squeak Preferences.
	private SmalltalkImage = p squeak SmalltalkImage.
	private Undeclared = p squeak Undeclared.
	private Utilities = p squeak Utilities.
	private HopscotchImages = p squeak HopscotchImages.
	private PackageOrganizer = p squeak PackageOrganizer.
	private MCPackage = p squeak MCPackage.
	private MCWorkingCopy = p squeak MCWorkingCopy.
	private MCWorkingCopyBrowser = p squeak MCWorkingCopyBrowser.
	private PackageInfo = p squeak PackageInfo.
	private SystemOrganization = p squeak SystemOrganization.
	private FileDirectory = p squeak FileDirectory.
	private MultiByteFileStream = p squeak MultiByteFileStream.
	private TextConverter = p squeak TextConverter.
	private PNGReadWriter = p squeak PNGReadWriter.
	private SqueakSet = p squeak Set.
	private NewspeakGlobalState = p squeak NewspeakGlobalState.
	private VFSerializer = p victoryFuel Serializer.
	private VFDeserializer = p victoryFuel Deserializer.
	private VMMirror = p squeak VMMirror.

	private Color = p graphics Color.
	private ObjectMirror = p mirrors ObjectMirror.
	private Time = p time Time.
	private Subject = p hopscotch core Subject.
	private Presenter = p hopscotch core Presenter.
	private TextEditorFragment = p hopscotch fragments TextEditorFragment.
	private TextDisplayFragment = p hopscotch fragments TextDisplayFragment.
	private EditableLinePresenter = p hopscotch fragments EditableLinePresenter.
	private List = p collections List.
	private Map = p collections Map.
	private Set = p collections Set.
	private Gradient = p brazil plumbing Gradient.
	private NewspeakObject = Object.
	private ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder.
	private platform = p.

	private ide = ide.
	private systemScope = ide systemScope.
	private workspaceManager = ide theWorkspaceManager.
	private EditableDefinitionPresenter = ide tools EditableDefinitionPresenter.
	private DefinitionListPresenter = ide tools DefinitionListPresenter.
	private ProgrammingPresenter = ide tools ProgrammingPresenter.
	private AssortedMethodsPresenter = ide browsing AssortedMethodsPresenter.
	private AssortedMethodsSubject = ide browsing AssortedMethodsSubject.
	private MethodSubject = ide browsing MethodSubject.
	private SelectorPresenter = ide browsing SelectorPresenter.
	private SelectorSubject = ide browsing SelectorSubject.
	public (* BOGUS *) ClassCommentPresenter = ide tools ClassCommentPresenter.
	private ClassNamePresenter = ide tools ClassNamePresenter.
	private DefinitionTemplate = ide tools DefinitionTemplate.
	private OneLineDefinitionTemplate = ide tools OneLineDefinitionTemplate.
	private ClassActionsPresenter = ide browsingNS ClassActionsPresenter.
||#ACCESSBOGUS) (
public class BitOfWisdom = (|
	public text
	public image
	public actionLabel
	public actionBlock
|) (
) : (
public text: aString = (
	^self new text: aString
)
public text: aString actionLabel: labelString actionBlock: aBlock = (
	^self new
		text: aString;
		actionLabel: labelString;
		actionBlock: aBlock
)
public text: aString image: aForm = (
	^self new
		text: aString;
		image: aForm
)
)
class ClassCategoryPresenter onSubject: s = DefinitionListPresenter onSubject: s (
(* Displays a class category as a collection of lines identifying the classes in the category, expandable into full class presenters. *)
| categoryNamePresenter |) (
brightnessForN: n midpoint: gamma = (
	(* Return the value of brightness to use for the number of elements n, with the constraints that the brightness for 0 is 1, the brightness for gamma is 0.5 and the brighness asymptotically approaches 0 as n increases. *)

	^(gamma / (gamma + n)) asFloat
)
captionForClassSubject: aSubject = (
	^row: {
		ClassNamePresenter onSubject: aSubject.
		maybeShowRunTestLinkFor: (Array with: aSubject).
		filler.
		(deferred: [subclassCountLabelFor: aSubject]) width: 25.
		blank: 5.
		(deferred: [methodCountLabelFor: aSubject]) width: 30.
		}
)
contentPresenters = (
	^(subject classSubjects) collect:
		[:each |
		expandableLineForClassSubject: each]
)
definition = (
^
	column: {
		minorHeadingBlock: (
			row: {
				[categoryNamePresenter:: EditableClassCategoryPresenter onSubject: subject.
				categoryNamePresenter] value.
				mediumBlank.
				linkImage: HopscotchImages default editImage
					action: [respondToRename].
				largeBlank.
				packageLink.
				largeBlank.
				(* addButtonWithAction: [addClassTemplate]. *)
				deferred: [maybeShowRunTestLink].
				filler.
				expandButtonWithAction: [expandAll].
				blank: 3.
				collapseButtonWithAction: [collapseAll].
				}
			).
		mediumBlank.
		super definition.
		mediumBlank.
		}
)
expandableLineForClassSubject: aSubject = (
	| toggle |
	toggle::
		collapsed: [captionForClassSubject: aSubject]
		expanded: [aSubject presenter].
	toggle onUserToggled: [toggle requestVisibility].
	^toggle
)
maybeShowRunTestLink = (
	^nothing

	(* | subjects |
	subjects:: subject classSubjectsUsingReflection: reflection.
	^maybeShowRunTestLinkFor: subjects *)
)
maybeShowRunTestLinkFor: collectionOfSubjects = (
	^nothing
	(* | testCases |
	testCases:: (collectionOfSubjects select: [:aSubject | aSubject isTestCase]).
	testCases:: (testCases collect: [:aSubject | aSubject model]) asSet.

	^testCases notEmpty
		ifTrue:
			[row: {
				smallBlank.
				(link: 'tests' action: [respondToRunTestsUsing: (testCases)]) tinyFont
			}]
		ifFalse: [nothing] *)
)
methodCountLabelFor: aSubject = (
	| count brightness caption holder |
	count:: aSubject methodCount.
	brightness:: brightnessForN: count midpoint: 40.
	caption:: (label: count printString) tinyFont.
	caption color: ((brightness < 0.7)
		ifTrue: [Color white]
		ifFalse: [Color black]).
	^(row: {filler. caption. blank: 5})
		color: (patchColorWithHue: 170 value: brightness)
)
packageLink = (
^
	(subject packageName
		ifNil: [label: '(no package)']
		ifNotNil:
			[:packageName |
			link: packageName action: [browsePackage: packageName]])
				tinyFont
)
patchColorWithHue: hue value: brightness = (
	^Color h: hue s: 1 - brightness v: brightness
)
respondToRename = (
categoryNamePresenter enterEditState
)
subclassCountLabelFor: aSubject = (
	| count brightness caption holder |
	count:: aSubject totalSubclassCount.
	brightness:: brightnessForN: count midpoint: 20.
	caption:: (label: count printString) tinyFont.
	caption color: ((brightness < 0.8)
		ifTrue: [Color white]
		ifFalse: [Color black]).
	^(row: {filler. caption. blank: 5})
		color: (patchColorWithHue: 210 value: brightness)
)
) : (
)
public class ClassCategorySubject onModel: m = Subject onModel: m (
(* Represents a viewpoint of a class category as a collection of classes. The model is the category name. *)
) (
public = anotherSubject = (
	^anotherSubject class == self class
		and: [anotherSubject categoryName = categoryName]
)
public categoryName = (
	^model asSymbol
)
public classSubjects = (
	^retrieveClasses collect:
		[:each |
		flag: #BOGUS. (* calling onto the presenter may not be right *)
		presenter subjectForClass: each]
)
public classTemplateText = (
^
'class ClassNameHere = (
|
	slot1
	slot2
|
) ()'
)
public colorizeClassSource: sourceText <String | Text> ^<Text> = (
	^ide newspeakColorization NS3BrowserColorizer new
		parseText: sourceText asString
		fromClass: Object mixin
		usingSelector: #classDeclaration
)
public createPresenter = (
	^ClassCategoryPresenter onSubject: self
)
public hash = (
	^model hash
)
public name = (
	^model
)
public packageName ^<String | nil> = (
	^(PackageInfo allPackages
		detect: [:some | some includesSystemCategory: model]
		ifNone: [^nil])
			packageName
)
rename: newName ifSuccessful: successAction ifFailed: failAction = (
	(SystemOrganization categories includes: newName)
		ifTrue: [^failAction value: newName asString, ' already exist'].
	(newName select: [:each | Character lf = each or: [Character cr = each]]) isEmpty not
		ifTrue: [^failAction value: 'Cannot contain newlines.'].
	SystemOrganization renameCategory: model toBe: newName.
	model:: newName.
	^successAction value
)
retrieveClasses = (
	^((Smalltalk organization listAtCategoryNamed: model)
		collect: [:each | Smalltalk at: each])
		reject: [:each | each isNil]
)
public title = (
	^model, ' category'
)
) : (
)
class DeletedClassPresenter onSubject: s = ProgrammingPresenter onSubject: s (
) (
definition = (
^
	majorHeadingBlock:
		(label: 'Class ', subject className, ' has been deleted.    * sniff *')
)
) : (
)
public class DeletedClassSubject onModel: m = Subject onModel: m (
(* Represents a class that has been deleted from the system. The model is the name of the class. *)
) (
public className = (
	^model
)
public createPresenter = (
	^DeletedClassPresenter onSubject: self
)
public title = (
	^className, ' (deleted class)'
)
) : (
)
class EditableClassCategoryPresenter onSubject: s = EditableLinePresenter onSubject: s (
(* Presents an editory for renaming a class category. *)
) (
browseClassCategory: categoryName <Symbol> = (
	ide defaultPopularityRecord
		rememberCategoryVisit: categoryName.
	enterSubject: (ClassCategorySubject onModel: categoryName)
)
definitionText = (
	^subject model asString
)
respondToAccept = (
(* A subclass must redefine this to do whatever is needed to be done with <editor text> to save its as the new state of the subject, and send #leaveEditState if the save was successful. *)
| newName |
newName:: editor text asString asSymbol.
subject rename: newName ifSuccessful: [leaveEditState] ifFailed: [:reason |]
)
viewerDefinition = (
	^link: [subject title asText allBold]
		action: [browseClassCategory: subject model]
)
) : (
)
class HomePresenter onSubject: s = ProgrammingPresenter onSubject: s (
| helpHolder |) (
aboutSystemDefinition = (
	^(link: 'About this system' action: [respondToAboutSystem]) smallFont.
)
column1: definitions1 column2: definitions2 column3: definitions3 = (
^row: {
	(column: definitions1) width: 0 elasticity: 1.
	(column: definitions2) width: 0 elasticity: 1.
	(column: definitions3) width: 0 elasticity: 1.
	}
)
definition = (
	^homePageDefinition
)
didYouKnow = (
	| wisdom |
	wisdom:: subject randomBitOfWisdom.
	wisdom actionLabel notNil ifTrue:
		[^textAndActionWisdom: wisdom].
	wisdom image notNil ifTrue:
		[^textAndImageWisdom: wisdom].
	^TextDisplayFragment new text: wisdom text
)
helpButton = (
^helpText isNil
	ifTrue: [nothing]
	ifFalse: [(link: '[?]' action: [respondToHelp]) tinyFont]
)
helpText ^<String | nil> = (
(* If this method answers a string, a help button will appear on the Home page. Clicking on that button will display the string. *)
^'This is the home page. You can always return to the home page of a Newspeak browser by clicking on the home icon at the top of the browser.
The home page includes links to a variety of useful places, like recently visited classes and packages, the source control page and more.
If you look at the list of classes, you will see each class has a round icon next to it. The icon tells you which language the class is written in; the current system mixes Smalltalk and Newspeak code. So, for example, a gray icon represents Smalltalk. Golden icons represent Newspeak3, which is the currently operational dialect of Newspeak.'
)
homePageDefinition = (
	helpHolder:: list.
^
	column: {
		helpHolder.
		majorHeadingBlock: (
			row: {
				label: 'Navigation' asText allBold.
				filler.
				helpButton.
			}
		).
		mediumBlank.

		indentedBlock:
			(column1: {
				link: 'Newspeak Source' asText allBold
					action: [enterSubject:: NamespaceSubject new].
				link: 'Smalltalk Source' asText allBold
					action: [browseSystem].
				link: 'Repositories' asText allBold
					action: [enterSubject: ide vcs ui mainSubject]
				}
			column2: {
				link: 'Workspaces'
						action: [navigateToWorkspaces].
				link: 'Pasteboard'
					action: [navigateToPasteboard].
				}
			column3: {
					link: 'Under the Hood'
						action: [navigateToInternals].
					undeclaredDefinition.
				}
			).
		mediumBlank.

		majorHeadingBlock: (label: 'Recently Visited' asText allBold).
		mediumBlank.
		indentedBlock:
			(holder: [recentStuffDefinition]).
		largeBlank.

		majorHeadingBlock: (label: 'Did you know?' asText allBold).
		smallBlank.
		indentedBlock:
			(holder: [didYouKnow]).
		mediumBlank.
		indentedBlock: aboutSystemDefinition.
		}
)
navigateToInternals = (
	enterSubject:: InternalsSubject new
)
navigateToPasteboard = (
	enterSubject:: PasteboardSubject new
)
navigateToWorkspaces = (
	enterSubject:: ide theWorkspaceManager AllWorkspacesSubject new
)
public noticeExposure = (
	(* Whenever the page is revisited we want the recent stuff and the 'did you know' sections updated. They are created in holders, so a simple refresh will do that. *)

	refresh
)
recentStuffDefinition = (
^
	column1: {
		label: 'Packages' asText allBold.
		mediumBlank.
		column: (subject recentPackages collect:
			[:each | link: each action: [browsePackage: each]]).
		mediumBlank.
		label: 'Categories' asText allBold.
		mediumBlank.
		column: (subject recentCategories collect:
			[:each | linkToBrowseCategory: each]).
		}
	column2: {
		label: 'Namespaces' asText allBold.
		mediumBlank.
		column: (subject recentNamespaces collect:
			[:each | linkToBrowseNamespace: (ide namespacing categoryNamespace: each) key: each]).
		}
	column3: {
		label: 'Classes' asText allBold.
		mediumBlank.
		list:
			((subject recentClassesForPresenter: self) collect:
				[:each |
				(ClassNamePresenter onSubject: each)
					highlightIfRecent: false]).
		}
)
respondToAboutSystem = (
	enterSubject: (SystemInformationSubject onModel: SmalltalkImage current)
)
respondToHelp = (
helpHolder setPresenters: {
	row: {
		filler.
		(link: 'close help' action: [helpHolder setPresenters: {}]) tinyFont.
	}.
	textDisplay: helpText.
}
)
respondToUndeclared = (
	enterSubject::
		UndeclaredReferencesSubject on: systemScope allUsersOfUndeclared
)
textAndActionWisdom: wisdom = (
^
	column: {
		TextDisplayFragment new text: wisdom text.
		(link: wisdom actionLabel action: wisdom actionBlock) tinyFont
		}
)
textAndImageWisdom: wisdom = (
^
	row: {
		image: wisdom image.
		mediumBlank.
		elastic:
			(TextDisplayFragment new text: wisdom text).
		}
)
undeclaredDefinition = (
Undeclared isEmpty ifTrue: [^nothing].
^link: 'Unresolved references (', Undeclared size asString, ')' action: [respondToUndeclared]
)
) : (
)
public class HomeSubject onModel: m = Subject onModel: m () (
public = anotherSubject = (
(* As there is just one possible logical home of the system, all subjects representing it are considered equal. *)

^self class = anotherSubject class
)
bitsOfWisdom = (
	(* This defines the bits of wisdom displayed at the bottom of the Hopscotch home page. Each time a page opens a new element is selected at random. An element may evaluate to nil, which will select another element at random. *)

^
	{
	[BitOfWisdom text: 'Holding down the Shift key and clicking a link opens the link target in a new window. This also works for menu items and navigation buttons.'].

	[BitOfWisdom
		text: 'Hold down the Shift key while clicking the "new window" toolbar button to open a copy of the current page instead of the default home page.'
		image: HopscotchImages default hsNewImage].

	[BitOfWisdom
		text: 'The Refresh toolbar button rebuilds the current page from scratch. Use it if you suspect the current page got out of sync with the data it displays.'
		image: HopscotchImages default hsRefreshImage].

	[Undeclared size > 0
		ifTrue:
			[BitOfWisdom
				text: 'There are ', Undeclared size printString, ' entries in the Undeclared dictionary right now.'
				actionLabel: 'show them'
				actionBlock: [Undeclared inspect]]
		ifFalse: [nil]].

	[BitOfWisdom
		text: 'The following packages have unsaved modifications: ',
			(String streamContents:
				[:s |
				(MCWorkingCopy registry select: [:each | each modified]) do:
					[:each | s cr; nextPutAll: each package name]])].

	[BitOfWisdom
		text: 'This icon identifies a class whose language does not yet have a dedicated icon.'
		image: HopscotchImages default classUnknownImage].

	[BitOfWisdom
		text: 'This is the "expand all" button which appears in headers of expandable item groups.'
		image: HopscotchImages default hsExpandImage].

	[BitOfWisdom
		text: 'This is the "collapse all" button which appears in headers of expandable item groups.'
		image: HopscotchImages default hsCollapseImage].

	[BitOfWisdom
		text: 'This is the "add" button which appears in headers of groups of items you can add to, such as methods of a class or classes of a package.'
		image: HopscotchImages default hsAddImage].

	[BitOfWisdom
		text: 'This is the "reorder" button. It appears in lists of methods and switches the method sort order. The default is to group methods by category, the alternative is to sort them alphabetically by selector ignoring the category.'
		image: HopscotchImages default hsReorderImage].

	[BitOfWisdom
		text: 'Recently visited classes are highlighted in yellow in category and package views to make them easier to notice.'].

	[BitOfWisdom
		text: 'This icon indicates that the method is overridden in one of the subclasses.'
		image: HopscotchImages default itemSubOverride].

	[BitOfWisdom
		text: 'This icon indicates that the method overrides one defined in a superclass.'
		image: HopscotchImages default itemSuperOverride].

	[BitOfWisdom
		text: 'This icon indicates that the method both overrides one defined in a superclass and is overridden in one of the subclasses.'
		image: HopscotchImages default itemBothOverride].

	[BitOfWisdom
		text: 'You can search for multiple patterns simultaneously by separating the patterns with a semicolon. For example: "includes;contains".'].

	[BitOfWisdom
		text: 'By default, the search function finds anything that contains the search term. For example, a search for "foo" will find all of the following: "foo", "foos", "afoo" and "afoos". For a different match policy, include explicit wildcards. A * will match any number of any characters; a # will match any single character.'].

	[BitOfWisdom
		text: 'The colored bars on the right of class names in the category and package views are "heat maps" of the number of subclasses (blue) and the number of methods (green) of the classes. They make "important" and "big" classes easy to spot.'].

	[BitOfWisdom
		text: 'Expressions evaluated in debuggers and inspectors can access a workspace via the name _. This allows you to bypass modularity during development and access values you forgot to import, e.g. _ collections List.'].

	[BitOfWisdom
		text: 'War is peace. Freedom is slavery. Ignorance is strength.'].
	},
	ide languageUiDescriptionRegistry bitsOfWisdom
)
public createPresenter = (
	^HomePresenter onSubject: self
)
lateNightWisdom = (
	^BitOfWisdom
		text: 'It''s ', Time now printString, '. Go get some rest!'
)
public randomBitOfWisdom = (
	| bits |
	Time now hour < 5 ifTrue: [^lateNightWisdom].
	bits:: bitsOfWisdom.
	^bits atRandom value ifNil: [randomBitOfWisdom]
)
public recentCategories = (
	^ide defaultPopularityRecord categoryVisits asSortedList
)
public recentClassesForPresenter: presenter <Presenter> = (
	^ide defaultPopularityRecord classVisits collect:
		[:each |
		presenter subjectForClass: each]
)
public recentNamespaces = (
	^ide defaultPopularityRecord namespaceVisits asSortedList
)
public recentPackages = (
	^ide defaultPopularityRecord packageVisits asSortedList
)
public title = (
	^'Home'
)
) : (
public new = (
	^onModel: nil
)
)
class InternalsPresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* A presenter for queries such as browseAllSelect: *)
| queries |) (
definition = (
	^column: {
		majorHeadingBlock: headingDefinition.
		mediumBlank.
		inspect: platform yourself name: 'platform' initiallyExpanded: false.
		inspect: ide yourself name: 'ide' initiallyExpanded: false.
		inspect: ide vcs yourself name: 'memoryHole' initiallyExpanded: false.
		inspect: ide settings yourself name: 'settings' initiallyExpanded: true.

		mediumBlank.
		holder: [installationStatus].
		largeBlank.
		queries:: list: {QuerySubject new presenter}.
		button: 'Add Query' action: [respondToAddQuery] }
)
headingDefinition = (
	^row: {
		label: 'Under the Hood' asText allBold.
		filler.
		dropDownMenu: [menuWithLabelsAndActions: {
			'Inspect Presenter' -> [respondToInspectPresenter].
		}].
	}
)
inspect: object name: name initiallyExpanded: initiallyExpanded = (
	| toggle |
	^toggle::
		collapsed: [(link: name action: [toggle expand]) color: actionLinkColor]
		expanded: [(objectSubjectFor: object) presenter selfCaption: name]
		initiallyExpanded: initiallyExpanded
)
installationStatus = (
	shell isDebugger & shell isInNamespace ifTrue:
		[^column: {
			textDisplay: 'This is an ordinary IDE instance. It is affected by changes to the IDE and platform code in the namespace and is the debugger of unhandled exceptions.'.
			link: 'Open a supervisor IDE.' action: [respondToOpenSupervisorIDE]}].

	shell isDebugger & shell isInNamespace not ifTrue:
		[^column: {
			textDisplay: 'This is the supervisor IDE instance. It IS NOT affected by changes to the IDE and platform code in the namespace and IS the debugger of unhandled exceptions.'.
			link: 'Open a supervisee window.' action: [respondToOpenSuperviseeWindow]}].

	shell isDebugger not & shell isInNamespace ifTrue:
		[^column: {
			textDisplay: 'This is a supervisee IDE instance. It IS affected by changes to the IDE and platform code in the namespace and IS NOT the debugger of unhandled exceptions.'.
			link: 'Open a supervisor window.' action: [respondToOpenSupervisorWindow].
			link: 'Takeover debugging (become ordinary IDE instance).' action: [respondToBecomeDebugger]}].

	^column: {
		textDisplay: 'This is an orphaned IDE instance. It IS NOT affected by changes to the IDE and platform code in the namespace and IS NOT the debugger of unhandled exceptions.'.
		link: 'Open a supervisor/ordinary window.' action: [respondToOpenSupervisorWindow].
		link: 'Takeover debugging (become ordinary IDE instance).' action: [respondToBecomeDebugger]
	}
)
respondToAddQuery = (
	queries add: QuerySubject new presenter
)
respondToBecomeDebugger = (
	NewspeakGlobalState ide: ide.
	refresh.
	shell updateToolbar.
)
respondToOpenSuperviseeWindow = (
	|
	manifest = ide namespacing manifestForSqueak.
	|
	((manifest HopscotchIDEApp packageUsing: manifest)
		main: platform args: {})
			IDEWindow open.
	refresh.
	shell updateToolbar.
)
respondToOpenSupervisorIDE = (
	subject openSupervisorIDE.
	refresh.
	shell updateToolbar.
)
respondToOpenSupervisorWindow = (
	NewspeakGlobalState ide IDEWindow open.
	refresh.
	shell updateToolbar.
)
) : (
)
class InternalsSubject onModel: m = Subject onModel: m (
(* A subject for queries such as browseAllSelect: *)
) (
public = other = (
	^self class = other class
)
public createPresenter = (^InternalsPresenter onSubject: self)
deepCopy: object = (
	| globals stream serializer deserializer bytes |
	globals:: platform squeak Smalltalk globals.
	stream:: ByteArray new writeStream.
	serializer:: VFSerializer over: stream withGlobals: globals.
	serializer serialize: object.
	serializer:: nil.
	stream:: stream contents readStream.
	deserializer:: VFDeserializer over: stream withGlobals: globals.
	^deserializer deserialize
)
public hash = (
	^self class hash
)
public openSupervisorIDE = (
	|
	manifest = ide namespacing manifestForSqueak.
	HopscotchIDEApp = manifest HopscotchIDEApp.
	RuntimeForSqueak = manifest RuntimeForSqueak.
	runtime = (RuntimeForSqueak packageUsing: manifest).
	ideapp = (HopscotchIDEApp packageUsing: manifest).
	copy = deepCopy: {runtime. ideapp}.
	runtimeCopy = copy at: 1.
	ideappCopy = copy at: 2.
	platformCopy = runtimeCopy using: VMMirror new.
	ideCopy = ideappCopy main: platformCopy args: {}.
	|
	NewspeakGlobalState ide: ideCopy.
	ideCopy IDEWindow open.
)
public title = (
	^'Under the Hood'
)
) : (
public new = (
	^self onModel: nil
)
)
class NamespacePresenter onSubject: s = DefinitionListPresenter onSubject: s (
) (
class ClassEntryPresenter onSubject: s = EntryPresenter onSubject: s (| nameLink |) (
collapsedDefinition = (
	(* BOGUS: we are displaying the class's name. we should display its key *)
	| part |
	part:: row1: {
		image: subject classUiDescription classIcon.
		smallBlank.
		nameLink:: row: {link: [subject className] action: [browseClassMirror: subject classMirror]}.
	} row2: {
		(row: {deferred: [(label: subject classCommentText withBlanksTrimmed)
			smallFont;
			color: secondaryTextColor]})
				compressibility: 1.
		filler
			compressibility: 0.

		(* In the face of namespace nesting, should application and test configuration be invoked with the root namespace or the local namespace? If the local namespace, these links only make sense in the context of the namespace view and should not be part of the class presenter itself. *)
		ClassActionsPresenter onSubject: subject.
		mediumBlank.
		dropDownMenu: [entryActionsMenuFor: subject className].
	}.
	(* subject isRecentlyVisited ifTrue: [part color: recentlyVisitedColor]. *)
	^part
)
expandedDefinition = (
	^subject presenter
)
public noticeExposure = (
	nameLink visual color:
		(subject isRecentlyVisited ifTrue: [recentlyVisitedColor] ifFalse: [Color transparent]).
	^super noticeExposure
)
) : (
)
class EntryPresenter onSubject: s = ProgrammingPresenter onSubject: s () (
public collapse = (
	substance collapse
)
definition = (
	^collapsed: [collapsedDefinition] expanded: [expandedDefinition]
)
public expand = (
	substance expand
)
) : (
)
class NamespaceEntryPresenter onSubject: s = EntryPresenter onSubject: s (| nameLink |) (
collapsedDefinition = (
	^row1: {
        defaultBlank.
		image: HopscotchImages default classPresenterImage.
		defaultBlank.
		nameLink:: row: {link: subject key action: [
			ide defaultPopularityRecord
			rememberNamespaceVisit: subject key. (* Should be the namespace itself, but non-strings break the home page. *)
			enterSubject:: subject refreshmentSubject]}.
	} row2: {
		(label: subject summaryText)
				smallFont;
				compressibility: 1;
				color: secondaryTextColor.
		filler
			compressibility: 0.
		mediumBlank.
		dropDownMenu: [entryActionsMenuFor: subject key]
	}.
)
expandedDefinition = (
	^subject presenter
)
public noticeExposure = (
	nameLink visual color:
		(subject isRecentlyVisited ifTrue: [recentlyVisitedColor] ifFalse: [Color transparent]).
	^super noticeExposure
)
) : (
)
class ValueEntryPresenter onSubject: s = EntryPresenter onSubject: s (|
	public key
|) (
collapsedDefinition = (
	^row1: {
		image: HopscotchImages default classUnknownImage.
		smallBlank.
		link: key action: [enterPresenter:: subject createPresenter selfCaption: key].
	} row2: {
		(label: subject title)
			smallFont;
			compressibility: 1;
			color: secondaryTextColor.
		filler
			compressibility: 0.
		mediumBlank.
		dropDownMenu: [entryActionsMenuFor: key]
	}
)
definition = (
	(* Should provide someway to edit the value. Possibly like the slots experiment with the inspectors. Evaluate in the context of a workspace. *)
	^collapsed: [collapsedDefinition]
	expanded: [subject presenter selfCaption: key]
)
expandedDefinition = (
	(* Should provide someway to edit the value. Possibly like the slots experiment with the inspectors. Evaluate in the context of a workspace. *)
	^subject presenter selfCaption: key
)
) : (
)
acceptNewClassDefinitionFrom: aTemplate = (
	subject
		addClassFromDefinition: aTemplate text
		ifSuccess:
			[prefixes remove: aTemplate. refresh]
		ifFailure:
			[:msg | aTemplate editor showMessage: msg]
)
acceptNewNamespaceDefinitionFrom: aTemplate = (
	subject
		addNamespaceFromDefinition: aTemplate text
		ifSuccess:
			[prefixes remove: aTemplate. refresh]
		ifFailure:
			[:msg | aTemplate editor showMessage: msg]
)
addClassTemplate = (
	prefixes add:
		(DefinitionTemplate new
			caption: 'Defining a new class:';
			initialText: subject classTemplateText;
			colorizerBlock: [:text | subject colorizeClassSource: text];
			acceptResponse:
				[:template | acceptNewClassDefinitionFrom: template];
			cancelResponse:
				[:template | prefixes remove: template])
)
addNamespaceTemplate = (
	prefixes add:
		(DefinitionTemplate new
			caption: 'Defining a new namespace:';
			initialText: 'NewNamespace';
			colorizerBlock: [:text | ];
			acceptResponse:
				[:template | acceptNewNamespaceDefinitionFrom: template];
			cancelResponse:
				[:template | prefixes remove: template])
)
contentList = (
	^zebra: super contentList
)
contentPresenters = (
	^subject namespace keys asSortedList collect: [:key | presenterForEntryAt: key]
)
definition = (
	^column: {
		minorHeadingBlock: (row: {
			label: subject key asText allBold.
			largeBlank.
			subject namespace isCategoryNamespace
				ifTrue: [addButtonWithAction: [respondToAddForCategory]]
				ifFalse: [addButtonWithAction: [respondToAddForRoot]].
			filler.
			expandButtonWithAction: [expandAll].
			blank: 3.
			collapseButtonWithAction: [collapseAll].
			blank: 3.
			dropDownMenu: [namespaceMenu].
		}).
		smallBlank.
		super definition.
	}
)
entryActionsMenuFor: key = (
	^menuWithLabelsAndActions: {
		'Remove ', key -> [ide namespacing removeKey: key.  refresh].
	}
)
public icon = (
	^HopscotchImages default classPresenterImage
)
namespaceMenu = (
	^menuWithLabelsAndActions: {
		'Inspect Presenter' -> [respondToInspectPresenter].
	}
)
presenterForEntryAt: key = (
	| entry = subject namespace at: key. |
	entry isBehavior
		ifTrue: [^ClassEntryPresenter onSubject: (subjectForClass: entry)].

	([entry isNamespace] ifError: [false])
		ifTrue: [^NamespaceEntryPresenter onSubject: (NamespaceSubject onModel: entry key: key)].

	^(ValueEntryPresenter onSubject: (objectSubjectFor: entry)) key: key
)
respondToAddForCategory = (
	openMenuWithLabelsAndActions: {
		'Add Class' -> [addClassTemplate].
		(* 'Add Namespace' -> [addNamespaceTemplate]. *)
		'Add Image From File' -> [respondToAddImage].
		'Add Text From File' -> [respondToAddText].
		(* 'Add Value' -> [Error signal: 'Unimplemented']. *)
	}
)
respondToAddForRoot = (
	openMenuWithLabelsAndActions: {
		'Add Namespace' -> [addNamespaceTemplate].
	}
)
respondToAddImage = (
	| fileRequester |
	fileRequester:: request File new.
	fileRequester allowedFileTypes: {'Image files (*.png)' ->'*.png'}.
	fileRequester initialDirectory: (FileDirectory default fullName).
	fileRequester openModal ifNotNil: [:fn |
		| key form |
		key:: (FileDirectory on: fn) localName allButLast: 4.
		key:: key select: [:letter | letter isAlphaNumeric].
		form:: PNGReadWriter formFromFileNamed: fn.
		subject namespace at: key asSymbol put: form.
	].
)
respondToAddText = (
	| fileRequester |
	fileRequester:: request File new.
	fileRequester allowedFileTypes: {'Text files (*.txt)' ->'*.txt'}.
	fileRequester initialDirectory: (FileDirectory default fullName).
	fileRequester openModal ifNotNil: [:fn |
		| key text |
		key:: (FileDirectory on: fn) localName allButLast: 4.
		key:: key select: [:letter | letter isAlphaNumeric].
		text:: ((MultiByteFileStream oldFileNamed: fn)
			converter: (TextConverter newForEncoding: 'utf8')) contents.
		subject namespace at: key asSymbol put: text.
	].
)
row1: row1 row2: row2 = (
	^row: {
		(row: row1) width: 0 elasticity: 1.
		(row: {mediumBlank}, row2) width: 0 elasticity: 2.
	}
)
) : (
)
public class NamespaceSubject onModel: m key: k = Subject onModel: m (|
	public key = k.
|ide namespacing refreshCategoryNamespaces) (
public = other ^<Boolean> = (
	^class = other class
		and: [namespace = other namespace]
		and: [key = other key].
)
public addClassFromDefinition: definitionString ifSuccess: successBlock ifFailure: failureBlock = (
	| builder mixin klass |
	[builder:: ClassDeclarationBuilder fromSource: definitionString]
		on: Error
		do: [:ex | ^failureBlock value: ex description].
	(namespace includesKey: builder name) ifTrue:
		[^failureBlock value: 'A class named ', builder simpleName, ' already exists in this namespace'].
	mixin:: builder install reflectee.
	klass:: mixin apply: Object withName: builder name.
	klass mixin category: #Unclassified.
	namespace at: klass name put: klass.
	successBlock value
)
public addNamespaceFromDefinition: definitionString ifSuccess: successBlock ifFailure: failureBlock = (
	| selector = definitionString asSymbol. |
	model = ide namespacing Categories ifFalse:
		[Error signal: 'Not supported yet, only categories for now.'].

	selector isUnary ifFalse:
		[^failureBlock value: 'Must be a unary selector'].
	(namespace includesKey: selector) ifTrue:
		[^failureBlock value: 'A class named ', definitionString, ' already exists in this namespace'].
	ide namespacing categoryNamespace: selector.
	(* namespace at: selector put: (ide namespacing Namespace new). *)
	successBlock value
)
public classTemplateText = (
^
'class ClassNameHere = (
|
	slot1
	slot2
|
) ()'
)
public colorizeClassSource: sourceText <String | Text> ^<Text> = (
	^ide newspeakColorization NS3BrowserColorizer new
		parseText: sourceText asString
		fromClass: Object mixin
		usingSelector: #classDeclaration
)
public createPresenter = (
	^NamespacePresenter onSubject: self
)
public hash ^<Integer> = (
	^model hash bitXor: key hash
)
public isRecentlyVisited = (
	(ide defaultPopularityRecord namespaceVisits includes: key)
		ifTrue: [^true].

	(* Should this be recursive? *)
	namespace keys do: [:key |
		(ide defaultPopularityRecord namespaceVisits includes: key) ifTrue: [^true]].
	^false
)
public namespace = (
	^self model
)
public refreshmentSubject = (
	^self class onModel: model key: key
)
public summaryText = (
	^String streamContents: [:stm |
		model keys
			do: [:k | stm nextPutAll: k]
			separatedBy: [stm nextPutAll: ', ']]
)
public title ^<String> = (
	^key
)
) : (
public new = (
	#NAMESPACEBOGUS.
	^self onModel: ide namespacing Categories key: 'Root'
)
)
class PackagePresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* Presents a PackageSubject as a block with the package name on the left and a list of package category names on the right. This presenter is used as an element of the ''systemscape'' view of packages and categories. *)
| categoriesManagerX prefixesManagerX |) (
addCategory = (
	prefixesManager add:
		(OneLineDefinitionTemplate new
			caption: definitionTemplateCaption;
			acceptResponse:
				[:template |
				createCategoryFromTemplate: template];
			cancelResponse:
				[:template | prefixesManager remove: template])
)
categoriesManager = (
	^categoriesManagerX
)
categoriesManager: list = (
	categoriesManagerX:: list.
	^list
)
categoryNameFromTemplateText: text = (
	^subject packageName, '-',  text asString
)
createCategoryFromTemplate: template = (
	| newName |
	newName:: categoryNameFromTemplateText: template text.
	(Smalltalk organization categories includes: newName) ifTrue:
		[^self].
	Smalltalk organization addCategory: newName.
	prefixesManager remove: template.
	categoriesManager refresh
)
definition = (
^
	row: {
		packagePart
			width: 0 elasticity: 4.
		smallBlank.
		(column: {
			prefixesManager:: list.
			categoriesManager:: list:
				[subject retrieveCategories collect:
					[:each | linkToBrowseCategory: each]].
			})
			width: 0 elasticity: 6.
		}
)
definitionTemplateCaption = (
	^subject packageName, '-'
)
linkToBrowseCategory: categoryName = (
	| link |
	link:: super linkToBrowseCategory: categoryName.
	^(ide defaultPopularityRecord categoryVisits
		includes: categoryName)
			ifTrue: [(row: {link}) color: recentlyVisitedColor]
			ifFalse: [link]
)
packagePart = (
	| part |
	part:: row: {
		link: subject packageName asText allBold
			action: [browsePackage: subject packageName].
		filler.
		(link: 'add' action: [addCategory]) tinyFont.
		(* addButtonWithAction: [addCategory]. *)
		}.
	^subject packageIsRecent
		ifTrue: [part color: recentlyVisitedColor]
		ifFalse: [part]
)
prefixesManager = (
	^prefixesManagerX
)
prefixesManager: list = (
	prefixesManagerX:: list.
	^list
)
) : (
)
public class PackageSubject onModel: m = Subject onModel: m (
(* Represents a perspective on a package as a collection of categories. The classes contained by the categories are not included. The model is the package name. *)
) (
public = anotherSubject = (
	^anotherSubject class == self class
		and: [anotherSubject packageName = model]
)
public createPresenter = (
	^PackagePresenter onSubject: self
)
public hash = (
	^model hash
)
public packageIsRecent = (
	^ide defaultPopularityRecord packageVisits
		includes: packageName
)
public packageName = (
	^model
)
postCopy = (
	super postCopy.
	categories:: nil
)
public retrieveCategories ^<Collection[Symbol]> = (
(* Answer a collection of category names contained by the package. *)
^withPackageDo: [:package | package systemCategories]
	ifAbsent: [Array new]
)
retrieveExtensions ^<Collection[MethodReference]> = (
(* Answer a collection of category names contained by the package. *)
^withPackageDo: [:package | package extensionMethods]
	ifAbsent: [Array new]
)
public title = (
	^packageName, ' package'
)
withPackageDo: action ifAbsent: absentAction = (
| organizer package |
organizer:: PackageOrganizer default.
package:: organizer packageNamed: model ifAbsent: [^absentAction value].
^action value: package
)
) : (
)
class PackageWithClassesPresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* Presents a package (as a PackageWithClassesSubject) as essentially a list of ClassCategoryPresenters. *)
| contentManager |) (
collapseAll = (
	majorUpdate: [contentManager presenters do: [:each | each collapse]]
)
definition = (
	contentManager:: list:
		[extensionMethodsDefinition,
		(subject categorySubjects collect:
			[:each | expandableViewOf: each])].
^
	column: {
		minorHeadingBlock: (
			row: {
				label: subject packageName asText allBold.
				largeBlank.
				(link: subject revisions action: [respondToScm]) tinyFont.
				largeBlank.
				addButtonWithAction: [respondToAddCategory].
				filler.
				expandButtonWithAction: [expandAll].
				blank: 3.
				collapseButtonWithAction: [collapseAll].
				}).
		smallBlank.
		contentManager
		}
)
expandAll = (
	majorUpdate: [contentManager presenters do: [:each | each expand]]
)
expandableViewOf: categorySubject = (
	| toggle |
	toggle::
		collapsed:
			(link: categorySubject name
			action: [browseClassCategory: categorySubject name])
		expanded:
			(ClassCategoryPresenter onSubject: categorySubject).
	^toggle
)
extensionMethodsDefinition = (
| toggle subjects |
subjects:: subject extensionMethodSubjects.
toggle::
	heading: (link: 'Extension Methods' action: [toggle toggle])
	details: (AssortedMethodsSubject onModel: subjects) presenter.
^subjects isEmpty ifTrue: [{}] ifFalse: [{toggle}]
)
respondToAcceptCategory: template <DefinitionTemplate> = (
| catname |
catname:: subject packageName, '-'.
catname:: catname, template text asString withBlanksTrimmed.
catname:: catname asSymbol.
Smalltalk organization addCategory: catname.
contentManager remove: template.
contentManager add: (expandableViewOf: (ClassCategorySubject onModel: catname))
)
respondToAddCategory = (
	| template |

	template:: OneLineDefinitionTemplate new
		caption: subject packageName, '-';
		acceptResponse: [:t | respondToAcceptCategory: t];
		cancelResponse: [contentManager remove: template].
	contentManager add: template
)
respondToScm = (
	MCWorkingCopyBrowser open
)
) : (
)
public class PackageWithClassesSubject onModel:m = PackageSubject onModel:m (
(* Extends the perspective of a package to be a collection of category subjects (and therefore classes of those categories) rather than just category names. Reports the categories it contains as #categorySubjects, where each category subject is a ClassCategorySubject. *)
) (
public categorySubjects = (
	^retrieveCategories collect:
		[:each | ClassCategorySubject onModel: each]
)
public createPresenter = (
	^PackageWithClassesPresenter onSubject: self
)
public extensionMethodSubjects ^ <Collection[MethodSubject]> = (
	^retrieveExtensions collect:
		[:each <MethodReference> | MethodSubject onMethod: each]
)
public revisions ^<String> = (
| pkg |
pkg:: MCPackage named: model asString.
^String streamContents: [:s |
	pkg hasWorkingCopy ifTrue: [
		pkg workingCopy ancestry ancestors
			do: [:ancestor | s nextPutAll: (ancestor name findTokens: '-') last]
			separatedBy: [s nextPutAll: ', ']	]]
)
) : (
)
class PasteboardItemPresenter onSubject:s = Presenter onSubject:s (
) (
backgroundColor = (
^Gradient
	from: (Color h: 40 s: 0 v: 0.95)
	to: (Color h: 40 s: 0 v: 0.88)
)
bodyBlock: definition = (
^(
padded:
	(row: {
		elastic: definition.
		blank: 5.
		closeButton.
	})
with: {3. 8. 5. 8}
)
	color: backgroundColor
)
closeButton = (
    ^imageButton: HopscotchImages default itemDeleteImage 
        action: [respondToClose]
)
definition = (
^column: {
	blank: 3.
	bodyBlock:
		(collapsed: (label: subject originalSubject title)
		expanded: originalContent).
	blank: 3
	}
)
originalContent = (
^(padded: subject originalPresenter with: {1. 1. 1. 1})
	color: Color white
)
respondToClose = (
sendUp deliveryOptional removePasteboardItem: self
)
) : (
)
class PasteboardItemSubject onModel:m = Subject onModel:m (
) (
public createPresenter = (
	^PasteboardItemPresenter onSubject: self
)
originalPresenter = (
^model presenter
)
originalSubject = (
(* Rename for clarity. *)
^model
)
public refreshmentSubject = (
	^super refreshmentSubject model: model refreshmentSubject
)
) : (
)
class PasteboardPresenter onSubject: s = Presenter onSubject: s (
| things |) (
areaColor = (
^Color gray: 0.9
)
clearPasteboard = (
subject removeAll.
things presenters: {}
)
collapsibleEntryFor: droppedSubject = (
| toggle |
toggle:: expanded: droppedSubject presenter
	collapsed: (link: droppedSubject title action: [toggle toggle]).
^toggle
)
definition = (
	things::
		list: [subject presenters]
		dropExpecting: #draggingHopscotchSubject:
		action: [:index :args | insertSubject: args first afterIndex: index].
	^column: {
		blank: 3.
		dropAreaLabelled: 'drag and drop here to add content'.
		blank: 3.
		things.
		}
)
dropAreaLabelled: labelString = (
^row: {
	elastic: (centered: ((label: labelString) color: labelColor)).
	button: 'Clear' action: [clearPasteboard].
}
)
entryFor: droppedSubject = (
^droppedSubject presenter
)
expandableEntryFor: droppedSubject = (
| toggle |
toggle:: collapsed: (link: droppedSubject title action: [toggle toggle])
	expanded: droppedSubject presenter.
^toggle
)
ifInterestedInDragAt: windowRelativePoint <Point>
forSession: session <DragDropSession>
doWithTarget: targetBlock = (
	(visual windowRelativeBounds containsPoint: windowRelativePoint) ifTrue:
		[targetBlock value: things target]
)
insertSubject: droppedSubject <Subject> afterIndex: index <Integer> = (
| itemSubject |
itemSubject:: PasteboardItemSubject onModel: droppedSubject refreshmentSubject.
subject add: itemSubject afterIndex: index.
things add: itemSubject presenter afterIndex: index
)
labelColor = (
^Color white
)
public receiveRequestFrom: dispatcher ^<Boolean> = (
	(* Receive and process a notice coming from one of the children (usually as the result of using #sendUp or #sendDown). *)

	(self respondsTo: dispatcher selector) ifTrue:
		[dispatcher message sendTo: self.
		^true].
	^false
)
removePasteboardItem: item = (
subject remove: item subject.
things remove: item
)
viewportColor = (
^Color gray: 0.5
)
) : (
)
class PasteboardSubject onModel:m = Subject onModel:m (
| |model:: List new) (
public = anotherSubject = (
	^self class = anotherSubject class
)
public add: itemSubject <PasteboardItemSubject> afterIndex: index <Integer> = (
	model add: itemSubject afterIndex: index
)
public createPresenter = (
	^PasteboardPresenter onSubject: self
)
public hash = (
	^1
)
public presenters = (
	^model collect: [:each | each presenter]
)
public refreshmentSubject = (
^super refreshmentSubject
	model: (model collect: [:each | each refreshmentSubject])
)
public remove: itemSubject <PasteboardItemSubject> = (
	model remove: itemSubject
)
public removeAll = (
	model:: List new.
)
public title = (
	^'Pasteboard'
)
) : (
public new = (
	^self onModel: nil
)
)
class QueryPresenter onSubject: s = ProgrammingPresenter onSubject: s ( (* A presenter for queries such as browseAllSelect: *)
) (
definition = (
	| mfwText |
	mfwText:: TextEditorFragment new text: '[:m | booleanExpression]'.
	mfwText changeResponse: [].
	^row: {
			button: 'methods for which'
				action: [respondToMethodsForWhichWith: mfwText].
			blank: 10.
			elastic: mfwText
		}
)
respondToMethodsForWhichWith: mfwText <TextEditorFragment> = (
	| text block results MethodReference |
	text:: mfwText textBeingAccepted.
	mfwText removeMessages.
	block:: ((ObjectMirror reflecting: mfwText editor)
		evaluate: text asString
		with: workspaceManager workspaceScope
		ifCompilerError: [:e | ^mfwText addMessage: e description]
		ifError: [:e | halt]) reflectee.
	block isClosure ifFalse: [^self].
	results:: systemScope allSelect: block.
	MethodReference:: MethodReference.
	enterSubject: ((AssortedMethodsSubject onModel: (results
		collect: [:pair|
			MethodSubject onMethod: (MethodReference class: pair first selector: pair last)]))
				title: 'Selected Methods';
				yourself)
)
) : (
)
class QuerySubject onModel: m = Subject onModel: m ( (* A subject for queries such as browseAllSelect: *)
) (
public createPresenter = (
	^QueryPresenter onSubject: self
)
) : (
public new = (
	^self onModel: nil
)
)
class SearchResultsPresenter onSubject:s = ProgrammingPresenter onSubject:s (
) (
classSearchResults = (
^
	incrementalList:
		[:s |
		subject classesMatches do:
			[:each | | classSubject |
			classSubject:: subjectForClass: each.
			s nextPut:
				(collapsed: (ClassNamePresenter onSubject: classSubject)
					expanded: [classSubject presenter])]]
)
classesSection = (
	^subject classesMatches isEmpty
		ifTrue: [nothing]
		ifFalse: [sectionWithHeader: 'Classes' andContents: classSearchResults]
)
definition = (
	^column: {
		( deferred: [searchFeedback]).
		( initially: (label: 'Searching namespaces') deferred: [namespacesSection] ).
		( initially: (label: 'Searching packages') deferred: [packagesSection] ).
		( initially: (label: 'Searching classes') deferred: [classesSection] ).
		( initially: (label: 'Searching selectors') deferred: [selectorsSection] ).
		}
)
namespaceSearchResults = (
	^incrementalList: [:s |
		subject namespaceMatches do: [:assoc |
			s nextPut: (linkToBrowseNamespace: assoc value key: assoc key)]]
)
namespacesSection = (
	^subject namespaceMatches isEmpty
		ifTrue: [nothing]
		ifFalse: [sectionWithHeader: 'Namespaces' andContents: namespaceSearchResults].
)
packageSearchResults = (
	^incrementalList: [:s |
		subject packageMatches do: [:packageInfo |
			s nextPut:
				(link: packageInfo packageName
				action: [browsePackage: packageInfo packageName])]]
)
packagesSection = (
	^subject packageMatches isEmpty
		ifTrue: [nothing]
		ifFalse: [sectionWithHeader: 'Packages' andContents: packageSearchResults]
)
searchFeedback = (
 subject searchSuggestions isEmpty
	ifTrue: [^ nothing]
	ifFalse: [
		^sectionWithHeader: 'Did you mean?' andContents: searchSuggestions.
	].
)
searchSuggestions = (
	^incrementalList: [:s |
		subject searchSuggestions do: [:suggestion |
			s nextPut:
				(link: suggestion
				action: [ enterSubject:(SearchResultsSubject onModel: suggestion)])]].
)
sectionWithHeader: theHeader andContents: theContents = (
^ column: {minorHeadingBlock: (label: (theHeader asText allBold)). indentedBlock: theContents. }
)
selectorSearchResults = (
	^incrementalList: [:s |
		subject selectorsMatches do: [:each |
			s nextPut:
				(collapsed: (linkToBrowseSelector: each)
				expanded: [SelectorPresenter onSubject: (SelectorSubject onModel: each)])]]
)
selectorsSection = (
	^subject selectorsMatches isEmpty
		ifTrue: [nothing]
		ifFalse: [sectionWithHeader: 'Selectors' andContents: selectorSearchResults]
)
) : (
)
public class SearchResultsSubject onModel: searchTerm <String> = Subject onModel: searchTerm (|
includeSynthetics <Boolean> ::= searchTerm includes: "`".
public classesMatches <List[Class | Mixin]>
public selectorsMatches <List[Symbol]>
public packageMatches <List[PackageInfo]>
public namespaceMatches <List[Symbol,Namespace]>
public searchSuggestions <List[Symbol]>
|findClassMatches.
	findSelectorMatches.
	findPackageMatches.
	findNamespaceMatches.
	createSuggestions) (
public createPresenter = (
	^SearchResultsPresenter onSubject: self
)
createSuggestions = (
	| foundNoResults <Boolean> names <Set[String]> |

	foundNoResults:: true.
	classesMatches isEmpty ifFalse: [foundNoResults:: false].
	selectorsMatches isEmpty ifFalse: [foundNoResults:: false].
	packageMatches isEmpty ifFalse: [foundNoResults:: false].
	namespaceMatches isEmpty ifFalse: [foundNoResults:: false].
	foundNoResults ifFalse: [searchSuggestions:: Set new. ^self].

	names:: SqueakSet new: 200.
	systemScope allClassesDo: [:each | names add: (each simpleName)].
	PackageOrganizer default packages do: [:each | names add: (each packageName)].
	Symbol allSymbols do: [:each | names add: each].

	searchSuggestions:: (model correctAgainst: names).
)
findClassMatches = (
	| collected patterns |
	collected:: Set new: 20.
	patterns:: searchPatterns. (* compute once *)
	systemScope allClassesDo:
		[:cls |
		patterns do:
			[:pattern | (pattern match: cls simpleName) ifTrue: [ collected add: cls ]]].
	classesMatches:: (collected asSortedList:
		[:a :b | a simpleName < b simpleName]) asArray
)
findNamespaceMatches = (
	| collected packages |
	collected:: Set new: 20.
	ide namespacing Categories keysAndValuesDo:
		[:k :v |
		searchPatterns do:
			[:pattern | (pattern match: k) ifTrue:
				[collected add: (k -> v)]]].
	namespaceMatches:: collected asSortedList: [:a :b | a key < b key].
)
findPackageMatches = (
	| collected packages |
	collected:: Set new: 20.
	packages:: PackageOrganizer default packages.
	searchPatterns do:
		[:pattern |
		collected addAll: (packages select:
			[:packageInfo | pattern match: packageInfo packageName])].
	packageMatches:: collected asSortedList: [:a :b | a packageName < b packageName].
)
findSelectorMatches = (
	| collected |
	collected:: Set new: 20.
	searchPatterns do:
		[:each |
		collected addAll: (Symbol selectorsMatching: each)].
	includeSynthetics ifFalse:
		[collected removeAllSuchThat: [:each | each includes: "`"].
		collected removeAllSuchThat: [:each | each includes: " "]].
	selectorsMatches:: properlySorted: collected.
)
properlySorted: selectors = (
	| lower upper |
	lower:: List new: selectors size.
	upper:: List new: selectors size // 2.
	selectors do:
		[:each |
		each first isUppercase
			ifTrue: [upper add: each ]
			ifFalse: [lower add: each]].
	^lower asSortedList asArray, upper asSortedList
)
searchPatterns ^<Array[String]> = (
(* Produce a collection of the specific search pattern to use. The model is the raw input provided by the user and may include multiple patterns. *)
| parts |
parts:: model findTokens: ';'.
parts:: parts collect: [:each | each withBlanksTrimmed].
parts:: parts select: [:each | each notEmpty].
parts:: parts collect:
	[:each |
	(each includesAnyOf: '*#')
		ifTrue: [each]
		ifFalse: [('"*"' match: each)
				ifTrue: [each copyFrom: 2 to: each size - 1]
				ifFalse: ['*', each, '*']]].
^parts
)
public title = (
	^'Search for "', model, '"'
)
) : (
)
class SystemInformationPresenter onSubject: s = Presenter onSubject: s (
(* Implements the 'About this system' page usually accessible from the start page.

   Copyright 2008 Cadence Design Systems, Inc.

   Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0
*)
) (
definition = (
	^holder: (* Everything is in a holder so that noticeExposure refreshes it *)
		[column: {
			title: 'System version:' text: subject systemName.
			title: 'Image path: ' text: subject imageFullPathName.
			title: 'OS version: ' text: subject osVersion.
			title: 'VM version: ' text: subject vmVersion.
			subject squeakVersion ifNotNil:
				[:sqv |
				title: 'Squeak version: ' text: sqv].
			title: 'VM path: ' text: subject vmFullPathName.
		}
	]
)
public noticeExposure = (
	(* Whenever the page is revisited we want the information updated. The send below ensures that anything created inside a holder is refreshed. *)

	refresh
)
title: title text: text = (
	^column: {
		label: title asText allBold.
		blank: 10.
		row: {
			blank: 15.
			textDisplay: text}.
		blank: 15.
		}
)
) : (
)
class SystemInformationSubject onModel: m = Subject onModel: m (
(* My model is a SmalltalkImage.

   Copyright 2008 Cadence Design Systems, Inc.

   Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0
*)
) (
public = somethingElse = (
	^somethingElse class = self class
)
public createPresenter = (
	^SystemInformationPresenter onSubject: self
)
public hash = (
	^self class hash
)
public imageFullPathName = (
	^model imageName asString
)
public osVersion ^ <String> = (
	^model osVersion asString
)
public squeakVersion = (
	#BOGUS yourself.
	^'?'
)
public systemName = (
	^SmalltalkImage current datedVersion asString
)
public title = (
	^'About ', vmName
)
public vmFullPathName = (
	^model getSystemAttribute: 0
)
vmName = (
	^systemScope systemName
)
public vmVersion = (
	^model vmVersion asString
)
) : (
)
class SystemscapePresenter onSubject: s = ProgrammingPresenter onSubject: s (
) (
definition = (
^
	column:
		headerElements,
		unpackagedElements,
		packageElements
)
headerElements = (
^
	{majorHeadingBlock:
		(label: 'Packages and Categories' asText allBold).
	mediumBlank}
)
packageElements = (
	| elements |
	elements:: List new.
	subject retrieveSortedPackageNames
		do: [:each | elements add: (PackageSubject onModel: each) presenter]
		separatedBy: [elements add: mediumBlank].
	^elements
)
unpackagedElements = (
^
	{UnpackagedCategoriesSubject new presenter.
	mediumBlank
	}
)
) : (
)
public class SystemscapeSubject onModel: m = Subject onModel: m () (
public createPresenter = (
	^SystemscapePresenter onSubject: self
)
public retrieveSortedPackageNames = (
	| names |
	names:: PackageInfo allPackages collect: [:each | each packageName].
	^names asSortedCollection
)
public title = (
	^'System Source'
)
) : (
public new = (
	^self onModel: nil
)
)
class UndeclaredReferencesPresenter onSubject:s = AssortedMethodsPresenter onSubject:s (
(* This presenter is simply a reimplementation of its superclass to ask its subject the subjects to create presenters for. *)
) (
methodsGroupedByPackage = (
	| packages |
	packages:: Map new.
	subject references do:
		[:aSubject |
		(packageOfMethod: aSubject) ifNotNil:
			[:aPackage |
			(packages
				at: aPackage packageName
				ifPresent: [:e|e]
				ifAbsentPut: [List new]) add: aSubject]].
	^packages
)
) : (
)
class UndeclaredReferencesSubject onModel:m = Subject onModel:m (
(* This subject provides the prespective on the references of Undeclared throughout the system.   Those methods in the system that are using Undeclared can be found by:

	SystemScope theModule allUsersOfUndeclared

This will return a collection of MethodReferences.   This subject's model holds onto this collection (it is the client of UndeclaredUsersSubject's responsibility to ask SystemScope). *)
) (
public = other = (
	^class = other class
)
public createPresenter = (
	^UndeclaredReferencesPresenter onSubject: self
)
public hash = (
	^class hash
)
public references ^ <Collection[MethodSubject]> = (
	^model collect: [:ea | MethodSubject onMethod: ea]
)
public refreshmentSubject = (
	^self class on: systemScope allUsersOfUndeclared
)
public title = (
	^'Undeclared References (', Undeclared size asString, ')'
)
) : (
public on: references <SequenceableCollection[MethodSubject]> = (
	^(onModel: references)
)
)
class UnpackagedCategoriesPresenter onSubject: s = PackagePresenter onSubject: s (
) (
categoryNameFromTemplateText: text = (
	^text asString
)
definitionTemplateCaption = (
	^'New category: '
)
packagePart = (
	^row: {
		label: '(unpackaged)'.
		filler.
		(link: 'add' action: [addCategory]) tinyFont.
		(* addButtonWithAction: [addCategory]. *)
		}
)
) : (
)
class UnpackagedCategoriesSubject onModel: m = Subject onModel: m (
(* Represents a perspective similar to PackageSubject, but for those categories that do not belong to a package. *)
) (
public createPresenter = (
	^UnpackagedCategoriesPresenter onSubject: self
)
public retrieveCategories = (
	| allCategories packageOrganizer |
	allCategories:: Smalltalk organization categories asSet.
	packageOrganizer:: PackageOrganizer default.
	packageOrganizer packages do:
		[:each |
		each systemCategories do:
			[:eachCategory |
			allCategories remove: eachCategory ifAbsent: []]].
	^allCategories asSortedCollection
)
) : (
public new = (
	^onModel: nil
)
)
public class UnsavedChangesPresenter onSubject: s = ProgrammingPresenter onSubject: s () (
definition = (
^
	column: {
		(column: {
			blank: 50.
			centered: (label: 'This browser contains unsaved edits.').
			largeBlank.
			centered:
				(row: {
					button: 'Show Them' action: [showHistory].
					mediumBlank.
					button: 'Close Anyway' action: [forceCloseBrowser]
					}).
			blank: 50.
			})
			color: (Gradient from:(Color h:0 s: 0.5 v: 0.8) to: (Color h:0 s: 0.5 v: 0.6)).
		centered: (label: '(this page is under construction)').
		mediumBlank.
		}
)
forceCloseBrowser = (
	sendUp navigatorDo: [:shell | shell forceCloseWindow]
)
public isTransient = (
	(* Should not be recorded in navigation history. *)
	^true
)
showHistory = (
	sendUp navigatorDo: [:shell | shell showHistory]
)
public title = (
	^'Unsaved Changes'
)
) : (
public new = (
	^self onSubject: nil
)
)
flag: x = (
)
) : (
)