IDETools.ns

Newspeak3
'HopscotchIDE'
class IDETools 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 *)
||
	(* Ungood imports *)

	private Semaphore = p squeak Semaphore.
	private Processor = p squeak Processor.
	private WorldState = p squeak WorldState.
	private NewsqueakDockingBar = p squeak NewsqueakDockingBar.
	private NativeSession = p squeak NativeSession.
	private OSProcess = p squeak OSProcess.
	private Smalltalk = p squeak Smalltalk.
	private FileDirectory = p squeak FileDirectory.
	private FileStream = p squeak FileStream.
	private StandardFileStream = p squeak StandardFileStream.
	private NewspeakGlobalState = p squeak NewspeakGlobalState.

	private Request = p namespace Request. (* An instance should probably live in Brazil or Hopscotch. *)
	private Color = p graphics Color.
	private Cursor = p graphics Cursor.
	private ActiveIcon = p brazil widgets ActiveIcon.
	private Gradient = p brazil plumbing Gradient.
	private Label = p brazil widgets Label.
	private Menu = p brazil menus Menu.
	private MenuItem = p brazil menus MenuItem.
	private SeparatorItem = p brazil menus SeparatorItem.
	private TextView = p brazil widgets TextView.
	private List = p collections List.
	private TextEditorFragment = p hopscotch fragments TextEditorFragment.
	private HopscotchImages = p hopscotch HopscotchImages.
	private HopscotchWindow = p hopscotch core HopscotchWindow.
	private Presenter = p hopscotch core Presenter.
	public (*bogus*) ObjectMirror = p mirrors ObjectMirror.
	private VFDeserializer = p victoryFuel Deserializer.
	private ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder.
	private cachedPlatform = p.

	private ide = ide.
	private SystemscapeSubject = ide browsingMisc SystemscapeSubject.
	private ClassCategorySubject = ide browsingMisc ClassCategorySubject.
	private PackageWithClassesSubject = ide browsingMisc PackageWithClassesSubject.
	private SelectorSubject = ide browsing SelectorSubject.
	private GlobalReferencesSubject = ide browsingST GlobalReferencesSubject.
	private HomeSubject = ide browsingMisc HomeSubject.
	private UnsavedChangesPresenter = ide browsingMisc UnsavedChangesPresenter.
	private SearchResultsSubject = ide browsingMisc SearchResultsSubject.
	private NamespaceSubject = ide browsingMisc NamespaceSubject.
	private Root = ide namespacing Root.
	||
) (
public class ClassCommentPresenter onSubject: s <ClassSubject> = EditableDefinitionPresenter onSubject: s (
(* The subject is a ClassSubject. Displays a static text view with the text of the class comment and an ''edit'' control on the right. Clicking the control switches the view to edit mode. *)
|
  showPartialIfLong ::= true.
  showingPartial
|) (
definitionText = (
	(* In this class, only used by the editor side of the presenter to get the text to show in the editor. *)

	^fullCommentText
)
fullCommentText = (
	^subject classCommentText asString withBlanksTrimmed
)
maybePartialCommentText ^<String> = (
	(* Answer the comment text, but not more than one paragraph, and set the value of the showingPartial slot accordingly. *)

	| text paragraphs result |
	text:: fullCommentText.
	paragraphs:: text findTokens: {Character cr. Character lf}.
	result:: paragraphs
		detect: [:some | some withBlanksTrimmed notEmpty]
		ifNone: [String new].
	showingPartial:: (paragraphs select:
		[:any |
		any notEmpty and: [any ~= result]]) isEmpty not.
	^showingPartial
		ifTrue: [result, ' [...]']
		ifFalse: [result]
)
presentationDefinition = (
	| textToDisplay |
	textToDisplay:: retrieveComment.
	textToDisplay isEmpty ifTrue:
		[textToDisplay:: '(no comment)'].
	^column:
		{textDisplay: textToDisplay.
		showingPartial
			ifTrue: [(link: 'show full comment' action: [showFullComment]) tinyFont]
			ifFalse: [(link: 'hide full comment' action: [showLessComment]) tinyFont].
		}
)
respondToAccept = (
	subject classCommentText: editor textBeingAccepted. leaveEditState.
)
retrieveComment ^<String> = (
	(* Get the text to display--either the whole thing or the first paragraph, depending on the text and the settings--and set the showingPartial slot accordingly. *)

	^showPartialIfLong
		ifTrue:
			[maybePartialCommentText]
		ifFalse:
			[showingPartial:: false.
			fullCommentText]
)
showFullComment = (
	showPartialIfLong:: false.
	refresh
)
showLessComment = (
	showPartialIfLong:: true.
	refresh
)
) : (
)
public class ClassNamePresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* The subject is a ClassSubject. Displays as a row with a class icon and the name of the class as a clickable link that navigates to the class. *)
| public highlightIfRecent ::= true. |) (
classLanguageIcon = (
	^subject classUiDescription classIcon
)
definition = (
	^row: {
		draggableImage: classLanguageIcon forSubject: subject.
		smallBlank.
		holder: [namePart]. (* this makes it dynamically updatable *)
		smallBlank.
		deferred:
			[holder:
				[subject isAbstract
					ifTrue: [image: HopscotchImages default tinySubclassResponsibilityImage]
					ifFalse: [nothing]]]
		}.
)
namePart = (
	| result |
	result:: row: {
		linkToBrowseClassOrMirror: subject classOrMirror.
		smallBlank}.
	(highlightIfRecent and: [subject isRecentlyVisited]) ifTrue:
		[result:: result color: recentlyVisitedColor].
	^result
)
) : (
)
public class CodeEditorFragment new = TextEditorFragment (
(* Same as TextEditorFragment, but with an editor widget specializing in displaying code (possibly with syntax highlighting). *)
|
	colorizerBlockX
|) (
public colorizerBlock = (
	^colorizerBlockX
)
public colorizerBlock: oneArgBlock = (
	colorizerBlockX:: oneArgBlock.
	hasVisual ifTrue: [editor colorizerBlock: oneArgBlock]
)
createEditor = (
	(* We create a colorizing CodeView rather than the stock TextView. *)
	^super createEditor
		colorizerBlock: colorizerBlockX;
		yourself
)
editorWidgetClass = (
	^CodeView
)
) : (
)
class CodeView = TextView (
(* Enhances TextView with the ability to color the text it displays. Colorization is performed by colorizerBlock set by the client of the view. The block accepts the text to colorize and returning the same text (but not necessarily the same instance of Text) colorized. *)
|
	colorizerBlockX
	colorizationProcess
	colorizationMutex ::= Semaphore forMutualExclusion.
|) (
public acceptTextFromAgent: newText <Text | String> = (
	(* The text has been changed in the view by the user and the agent gives us the current content. *)

	| tweakedText |
	flag: #BOGUS. (* the following should not be necessary when we have proper text support, but for now we should expect that an agent may pass us a naked String while the visual is holding onto a Text it wants to colorize. in that case promote the text from agent to a Text so colorization isn't disabled. *)
	tweakedText:: (newText isText not and: [text isText])
		ifTrue: [newText asText]
		ifFalse: [newText].
	super acceptTextFromAgent: tweakedText.
	maybeColorize
)
backgroundProcessPriority ^<Integer> = (
(* The priority colorization runs on. We want it to be lower than the regular UI priority, but higher than the background (which deferred content installers run on). *)

^Processor userBackgroundPriority + 1
)
public colorizerBlock = (
	^colorizerBlockX
)
public colorizerBlock: oneArgBlock = (
	colorizerBlockX:: oneArgBlock.
	maybeColorize.
)
createAgentUsing: aMapping = (
	super createAgentUsing: aMapping.
	maybeColorize
)
doColorize = (
	(* Expects that the sender ensures that the colorizerBlock is present and the current text is a Text and schedules this as a background process saved in the colorizationProcess slot. *)

	| startingContent newText |
	agent isNil ifTrue: [^self].
	startingContent:: text asString.
	newText:: colorizerBlock value: startingContent asText.
	colorizationMutex critical:
		[(newText isText and: [isMapped]) ifTrue:
			[desktop scheduleUIAction:
				[(startingContent = text asString)  ifTrue:
					[isMapped ifTrue: [agent reemphasizeText: newText].
					 text runs: newText runs]]].
		colorizationProcess:: nil]
)
public maybeColorize = (
	(* Invoked after a character has been typed and the content of the view changed. *)

	agent isNil ifTrue: [^self].
	colorizerBlock notNil & text isText & text isEmpty not ifTrue:
		[colorizationMutex critical:
			[colorizationProcess ifNotNil:
				[colorizationProcess terminate].
			colorizationProcess::
				[doColorize] forkAt: backgroundProcessPriority]]
)
public text: newText = (
	super text: newText asText.
	maybeColorize
)
) : (
)
public class DefinitionListPresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* DefinitionListPresenter is an abstract superclass of presenters that displays helper ''transient'' presenters that visually appear to belong to the main list of subject presenters. One common example is a method list presenter which can at times include presenters for methods being added or residue presenters of removed methods. *)
| prefixes content suffixes |) (
public collapseAll = (
	(* Collapse all presenters in the content list. This operation depends on the type of content elements, so it is applicable often but not always. Still, it's handy to have it here available for reuse. *)

	majorUpdate:
		[content presenters do: [:each | each collapse]]
)
contentList = (
	^list: [contentPresenters]
)
contentPresenters ^<Collection[Presenter]> = (
	^List new
)
definition = (
	prefixes:: list.
	content:: contentList.
	suffixes:: list.
	^column: {
		prefixes.
		content.
		suffixes.
		}
)
public expandAll = (
	(* Expand all presenters in the content list. This operation depends on the type of content elements, so it is applicable often but not always. Still, it's handy to have it here available for reuse. *)

	majorUpdate:
		[content presenters do: [:each | each expand]]
)
) : (
)
public class DefinitionResidue = ProgrammingPresenter onSubject: nil (|
	public caption
	public definitionText
	public extraData
	public restoreResponse
	public forgetResponse
|) (
public = anotherPresenter = (
	^self == anotherPresenter
)
definition = (
	^heading:
		(row: {
			(label: caption) color: (Color gray: 0.7).
			largeBlank.
			})
	details:
		[TextEditorFragment new
			text: definitionText;
			acceptLabelText: 'restore';
			cancelLabelText: 'forget';
			acceptResponse: [restoreResponse valueWithPossibleArgument: self];
			cancelResponse: [forgetResponse valueWithPossibleArgument: self];
			updateEditState]
)
public hash = (
	^self identityHash
)
) : (
)
public class DefinitionTemplate = ProgrammingPresenter onSubject: nil (|
	public caption
	public initialText ::= String new.
	public initiallyInEditState ::= true.
	public acceptResponse
	public cancelResponse
	public editor
	public colorizerBlock ::= [:text | text asString asText]. (* default: remove any formatting *)
|) (
definition = (
	^(row: {
		mediumBlank.
		elastic:
			(column: {
				smallBlank.
				label: [caption ifNil: [String new]].
				editorDefinition.
				mediumBlank.
 			}).
		smallBlank.
		})
			color: (Gradient from: (Color h: 100 s: 0.3 v: 0.9) to: (Color h: 100 s: 0.3 v: 0.8))
)
editorDefinition = (
	editor:: CodeEditorFragment new
		text: initialText;
		acceptLabelText: 'save';
		cancelLabelText: (cancelResponse ifNil: [nil] ifNotNil: ['cancel']);
		controlBarColor: nil;
		acceptResponse: [acceptResponse valueWithPossibleArgument: self];
		cancelResponse: [cancelResponse valueWithPossibleArgument: self];
		colorizerBlock: colorizerBlock.
	initiallyInEditState ifTrue: [editor updateEditState].
	^editor
)
public text = (
	^editor textBeingAccepted
)
) : (
)
class EditableDefinitionPresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* An abstract superclass of presenters that display some kind of a static (non-interactive) representation of their subject that can be transformed into a text editor allowing to edit the subject. It is the subclass' responsibility to define what the static representation actually looks like, how the edit state is entered, and how the text of the definition is mapped back onto the model state. *)
| editor
isEditing ::= false. |) (
= anotherPresenter = (
	^self == anotherPresenter
)
definition = (
	^holder:
		[isEditing
			ifTrue: [editorDefinition]
			ifFalse: [viewerDefinition]]
)
definitionText = (
	subclassResponsibility
)
editorDefinition = (
editor:: TextEditorFragment new.
editor
	text: definitionText;
	cancelResponse: [respondToCancel];
	acceptResponse: [respondToAccept];
	updateEditState.
^editor
)
updateEditState = (
	isEditing:: true.
	refresh
)
hash = (
	^self identityHash
)
public leaveEditState = (
	isEditing:: false.
	refresh
)
presentationDefinition = (
	subclassResponsibility
)
respondToAccept = (
	subclassResponsibility
)
respondToCancel = (
	leaveEditState
)
respondToEdit = (
	updateEditState
)
viewerDefinition = (
^
	row: {
		elastic:
			presentationDefinition.
        defaultBlank.
		linkImage: HopscotchImages default editImage action: [respondToEdit]
		}
)
) : (
)
public class IDEWindow = HopscotchWindow (
(* The HopscotchWindow specific to Smalltalk/Newspeak programming tools. Provides additional navigational aids such as the search field, as well as convenient instance creation and opening messages on the class side. For historical reasons, this is considered THE Hopscotch class. *)
|
	supervisorLabel
	searchStringField
	metaMenuButton
	operateMenuButton
|initialExtent: 920 @ 800.
	homeSubject: HomeSubject new) (
addFileMenuItemsTo: menu = (
operateMenuItemDefinitions do:
	[:each | | item |
	item:: each = nil
		ifTrue: [SeparatorItem new]
		ifFalse: [MenuItem label: each key action: [WorldState addDeferredUIMessage: [each value value]]].
	menu add: item].
)
addMenuBarItemsTo: menu <Menu> = (
| fileMenu <Menu> |
	fileMenu:: Menu new.
	addFileMenuItemsTo: fileMenu.
	menu add: (SubmenuItem new
		label: '&File';
		submenu: fileMenu
		).
	super addMenuBarItemsTo: menu.
	menu 	add: (SubmenuItem new
		label: '&Meta';
		submenu: metaMenu).
)
addToolbarItemsTo: toolbar = (
	super addToolbarItemsTo: toolbar.

	toolbar addElasticBlank.
	toolbar add: (supervisorLabel:: Label new text: '').
	toolbar addElasticBlank.

	buildSearchStringField.
	toolbar add: buildFindButton.

	toolbar addBlankSize: 5.
	toolbar add: buildMetaMenuButton.
	toolbar add: buildOperateMenuButton.
)
authorizeUnsavedChanges = (
	enterPresenter: UnsavedChangesPresenter new.
	^false
)
buildFindButton = (
	| button images |
	button:: ActiveIcon new.
	images:: HopscotchImages default.
	button
		image: images findImage;
		action: [find].
	^button
)
buildMenuBar = (
(* It's the brave new world. *)
^nil
)
buildOperateMenuButton = (
	| images |
	operateMenuButton:: ActiveIcon new.
	images:: HopscotchImages default.
	operateMenuButton
		actOnMouseDown: true;
		image: images operateMenuImage;
		hoverImage: images operateMenuOverImage;
		downImage: images operateMenuDownImage;
		action: [openOperateMenu].
	^operateMenuButton
)
buildSearchStringField = (
	searchStringField:: toolbar addNew: TextView setup:
		[:field |
		field text: ''.
		field enterKeyResponse: [:defaultK | find].
		field area width: 200].
	^searchStringField
)
confirmQuit = (
| answer |
answer:: MessageBox new
	yesNoCancel: 'Save changes before quitting?';
	open.
answer == #yes ifTrue: [saveThenQuit].
answer == #no ifTrue: [quit].
)
find = (
	| term |
	Cursor wait showWhile:
		[term:: searchStringField text asString withBlanksTrimmed.
		term isEmpty ifTrue:
			[^searchStringField
				flash;
				text: 'type search term here'].
		enterSubject: (SearchResultsSubject onModel: term)]
)
public inspection = (
	#BOGUS.
	^ide inspection
)
public isDebugger ^<Boolean> = (
	^NewspeakGlobalState ide yourself == ide yourself
)
public isInNamespace ^<Boolean> = (
	^(Root at: #IDETools) mixin == outer IDETools class mixin.
)
metaMenu ^ <Menu> = (
	^Menu new
			add: (MenuItem label: 'Inspect Current Presenter'
					action: [respondToInspectPresenter]);
			add: (MenuItem label: 'Inspect Hopscotch Shell'
					action: [respondToInspectShell]);
			add: (MenuItem label: 'Inspect Brazil Window'
					action: [respondToInspectWindow]);
			yourself
)
openMetaMenu = (
| menu |
menu:: metaMenu.
menu ownerVisual: window.
menu
	openIn: window desktop
	at: (0 @ metaMenuButton extent y
			translateFrom: metaMenuButton
			to: window desktop)
)
openOperateMenu = (
| menu |
menu:: Menu forVisual: window.
operateMenuItemDefinitions do:
	[:each | | item |
	item:: each = nil
		ifTrue: [SeparatorItem new]
		ifFalse: [MenuItem label: each key action: [WorldState addDeferredUIMessage: [each value value]]].
	menu add: item].
menu
	openIn: window desktop
	at: (0 @ operateMenuButton extent y
			translateFrom: operateMenuButton
			to: window desktop)
)
operateMenuItemDefinitions ^ <Association[String, [] ]> = (
	^Array streamContents: [:s |
		s nextPut: 'Run App' -> [respondToRunApp].
		s nextPut: 'Open File' -> [NewsqueakDockingBar someInstance openFile].
		s nextPut: 'Open File List'  -> [NewsqueakDockingBar someInstance openFileList].
		s nextPut: 'Open OS File Browser' -> [NewsqueakDockingBar someInstance openOsFileBrowser].
		s nextPut: 'Compile File' -> [respondToCompileFile].
		OSProcess isWindows ifTrue:
			[s nextPut: nil.
			s nextPut: 'Show Console Window' -> [NativeSession soleInstance focusSqueakWindow]].
		s nextPut: nil.
		s nextPut: 'Save Image'  ->[NewsqueakDockingBar someInstance saveImage].
		s nextPut: 'Save Image As...' -> [NewsqueakDockingBar someInstance saveImageAs].
		s nextPut: 'Quit' -> [NewsqueakDockingBar someInstance quit]
	]
)
quit = (
	(* Must be in Morphic UI process *)
	WorldState addDeferredUIMessage:
		[Smalltalk snapshot: false andQuit: true]
)
request = (
	^Request usingPlatform: cachedPlatform
)
respondToCompileFile = (
	| fileRequester |
	fileRequester:: request File new.
	fileRequester allowedFileTypes: {'Newspeak source files (*.ns)' ->'*.ns'}.
	fileRequester initialDirectory: (FileDirectory default fullName).
	fileRequester openModal ifNotNil: [:fn |
		| source builder mirror klass |
		FileStream oldFileNamed: fn do: [:stm | source:: stm contents].
		builder:: ClassDeclarationBuilder fromUnitSource: source.
		#BOGUS yourself. (* The mirror API should provide a non-cheat way to give both the source for a whole module and an existing module to mutate. *)
		Root
			at: builder name
			ifPresent: [:it | klass:: it. builder prvtExistingMixin: klass mixin].
		mirror:: builder install.
		(Root includesKey: mirror name) ifFalse: [
			klass:: mirror applyToObject reflectee.
			Root at: klass name put: klass.
		].
		IDEWindow openOnClass: klass.
	].
)
respondToInspectPresenter = (
	IDEWindow openOnObject: currentPresenter
)
respondToInspectShell = (
	IDEWindow openOnObject: self
)
respondToInspectWindow = (
	IDEWindow openOnVisual: window
)
respondToRunApp = (
	| fileRequester |
	fileRequester:: request File new.
	fileRequester allowedFileTypes: {'VictoryFuel files (*.vfuel)' ->'*.vfuel'}.
	fileRequester initialDirectory: (FileDirectory default fullName).
	fileRequester openModal ifNotNil: [:fn |
		| app |
		StandardFileStream oldFileNamed: fn do: [:stm |
			| deserializer |
			deserializer:: VFDeserializer over: stm binary withGlobals: Smalltalk globals.
			app:: deserializer deserialize].
		app main: cachedPlatform args: {}.
	].
)
saveThenQuit = (
	(* Must be in Morphic UI process *)
	WorldState addDeferredUIMessage:
		[Smalltalk snapshot: true andQuit: true]
)
public updateToolbar = (
	super updateToolbar.
	isDebugger & isInNamespace ifTrue:
		[^supervisorLabel text: ''].
	isDebugger & isInNamespace not ifTrue:
		[^supervisorLabel text: 'SUPERVISOR'; color: (Color r: 0 g: 0.5 b: 0)].
	isDebugger not & isInNamespace ifTrue:
		[^supervisorLabel text: 'SUPERVISEE'; color: (Color r: 0.7 g: 0 b: 0)].
	supervisorLabel text: 'ORPHANED'
)
) : (
public onClass: aClass = (
	^withSubjectFromBlock:
		[:shell | subjectForClass: aClass]
)
public open = (
	^openSubjectFromBlock: [:me | HomeSubject new]
)
public openOnClass: aClass = (
	^(onClass: aClass) open
)
public openOnObject: anObject = (
	openSubjectFromBlock:
		[:shell |
		shell inspection ObjectSubject onModel: (ObjectMirror reflecting: anObject)]
)
public openOnSelector: selector = (
	openSubjectFromBlock: [:shell | SelectorSubject onModel: selector]
)
public openOnVisual: aVisual = (
	openSubjectFromBlock:
		[:shell | shell inspection BrazilVisualTreeSubject onModel: aVisual]
)
public openSubject: aSubject <Subject> = (
	^openSubjectFromBlock: [:instance | aSubject]
)
public openSubjectFromBlock: aBlock = (
	^(withSubjectFromBlock: aBlock) open
)
public subjectForClass: aClass = (
	^aClass language classSubjectFor: aClass using: ide
)
public withSubjectFromBlock: aBlock = (
	| instance |
	#BOGUS yourself. (* copied from HopscotchShell *)

	instance:: self new.
	instance subject: (aBlock value: instance).
	^instance
)
)
public class OneLineDefinitionTemplate new = DefinitionTemplate (
) (
definition = (
^row: {
	(elastic: (padded: (
		row: {
			label: [caption ifNil: [String new]].
			elastic: (column: {editorDefinition})
		}) with: {10. 5. 10. 5}))
			color: (Gradient from: (Color h: 100 s: 0.3 v: 0.9) to: (Color h: 100 s: 0.3 v: 0.8))}
)
) : (
)
public class PopularityRecord = (
(* PopularityRecord keeps track of most recently visited packages, categories and classes. *)
|
	public packageVisits ::= List new: 10.
	public categoryVisits ::= List new: 10.
	public namespaceVisits ::= List new: 10.
	public classVisits ::= List new: 10.
	public repositoryVisits ::= List new: 10.
 |) (
public rememberCategoryVisit: categoryName = (
	self rememberVisit: categoryName in: categoryVisits
)
public rememberClassVisit: clazz = (
	self rememberVisit: clazz in: classVisits
)
public rememberNamespaceVisit: namespaceName = (
	self rememberVisit: namespaceName in: namespaceVisits
)
public rememberPackageVisit: packageName = (
	self rememberVisit: packageName in: packageVisits
)
public rememberRepositoryVisit: repositoryUri = (
	self rememberVisit: repositoryUri in: repositoryVisits
)
rememberVisit: name <Symbol> in: records <List> = (
	(records includes: name)
		ifTrue:
			[records remove: name.
			records addFirst: name]
		ifFalse:
			[[records size > 14] whileTrue: [records removeLast].
			records addFirst: name]
)
) : (
)
public class ProgrammingPresenter onSubject: s = Presenter onSubject: s (
(* An abstract superclass of all presenters used in programming tools. Defines all kinds of methods useful for navigation between code artifacts or their consistent display. *)
) (
acceptButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default accept16px action: aBlock
)
actionLinkColor = (
	^Color black
)
addButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default hsAddImage action: aBlock
)
public browseClass: aClass = (
	| theClass classSubject |
	theClass:: aClass theNonMetaClass mixin definingClass.
	classSubject:: subjectForClass: theClass.
	classSubject rememberVisit.
	sendUp
		ifUndelivered: [IDEWindow openSubject: classSubject];
		navigateTo: classSubject.
)
browseClassCategory: categoryName <Symbol> = (
	ide defaultPopularityRecord
		rememberCategoryVisit: categoryName.
	enterSubject: (ClassCategorySubject onModel: categoryName)
)
public browseClassMirror: aMirror = (
	| classSubject = ide browsingNS classSubjectOn: aMirror. |
	classSubject rememberVisit.
	enterSubject:: classSubject.
)
browseClassNamed: aSymbol = (
	| theClass |
	theClass:: Smalltalk at: aSymbol ifAbsent: [nil].
	theClass isNil ifTrue:
		[^enterSubject: (SearchResultsSubject onModel: aSymbol)].
	theClass isBehavior ifFalse: [theClass:: theClass class].
	browseClass: theClass
)
browseClassReferences: aClass = (
	self browseReferencesToKey: aClass theNonMetaClass name
)
browsePackage: packageName <String> = (
	ide defaultPopularityRecord
		rememberPackageVisit: packageName.
	enterSubject: (PackageWithClassesSubject onModel: packageName)
)
browseReferencesToKey: aSymbol = (
	enterSubject: (GlobalReferencesSubject onModel: aSymbol)
)
browseSelector: selector = (
	enterSubject: (SelectorSubject onModel: selector)
)
browseSystem = (
	sendUp
		navigatorDo: [:navigator | navigator enterSubject: SystemscapeSubject new]
)
cancelButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default cancel16px action: aBlock
)
collapseButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default hsCollapseImage action: aBlock
)
confirm: label ifConfirmed: block = (
	| menu |
	menu:: Menu forVisual: visual.
	menu add: (MenuItem key: #ok label: label action: block).
	menu openIn: visual desktop
)
dangerColor = (
	^Color h: 0 s: 0.5 v: 1
)
darkerBlock: body = (
	^(column: {
		mediumBlank.
		row: {
			mediumBlank.
			elastic: body
			}.
		mediumBlank
		})
			color: (Color gray: 0.9)
)
expandButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default hsExpandImage action: aBlock
)
farIndentedBlock: body = (
	^column: {
		mediumBlank.
		row: {
			largeBlank.
			elastic: body
			}.
		mediumBlank
		}
)
headingBlock: body = (
	^(column: {
		mediumBlank.
		row: {
			mediumBlank.
			elastic: body
			}.
		mediumBlank
	})
		color: (Gradient from: (Color gray: 0.92) to: (Color gray: 0.85))
)
iconForAccessModifier: am = (
	am ==#private ifTrue: [^ HopscotchImages default privateImage].
	am == #protected ifTrue: [^ HopscotchImages default protectedImage].
	^HopscotchImages default publicImage
)
iconForClass: aClass = (
	^(ide languageUiDescriptionRegistry descriptionForClass: aClass) classIcon
)
indentedBlock: body = (
	^column: {
		mediumBlank.
		row: {
			mediumBlank.
			elastic: body
			}.
		mediumBlank
		}
)
inspect: anObject = (
	enterSubject:: objectSubjectFor: anObject
)
inspectObjectMirror: objectMirror <ObjectMirror> = (
	enterSubject:: objectSubjectForMirror: objectMirror
)
public inspection = (
	#BOGUS.
	^shell inspection
)
itemReferencesButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default itemReferencesImage action: aBlock
)
itemReferencesMenuButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default itemReferencesImage
        action: aBlock
	    actOnMouseDown: true
)
largeBlank = (
	^blank: 20
)
linkToBrowseCategory: categoryName = (
	^link: categoryName action: [browseClassCategory: categoryName]
)
linkToBrowseClass: aClass = (
	^link: aClass name action: [browseClass: aClass]
)
linkToBrowseClassMirror: aMirror = (
|	cs = aMirror qualifiedName subStrings: '`'.
	legibleClassName = cs reverse reduce: [:m :o | m, ' in ', o]. |
	^link: legibleClassName action: [browseClassMirror: aMirror]
)
linkToBrowseClassOrMirror: aClassOrMirror = (
^aClassOrMirror isBehavior
	ifTrue: [linkToBrowseClass: aClassOrMirror]
	ifFalse: [linkToBrowseClassMirror: aClassOrMirror]
)
linkToBrowseNamespace: ns key: key = (
	^row: {
        defaultBlank.
		image: HopscotchImages default classPresenterImage.
		defaultBlank.
		link: key
		action: [enterSubject:: NamespaceSubject onModel: ns key: key]}.
)
linkToBrowseSelector: selector = (
	^link: selector action: [browseSelector: selector]
)
majorHeadingBlock: body = (
	^(padded: body with: {10. 10. 5. 10.})
		color: majorHeadingColor
)
majorHeadingColor = (
	(* This color is used for major definitions such as class headings. *)

	^Gradient
		from: (Color h: 240 s: 0.05 v: 0.92)
		to: (Color h: 240 s: 0.05 v: 0.86)
)
methodHeadingColor ^<Color> = (
	(* This is the color of expanded methods headings. It should agree with majorHeadingColor and minorClassHeadingColor to establish a clear visual hierarchy in a class presenter. *)

	^Color gray: 0.95
)
minorClassHeadingBlock: body = (
	^(padded: body with: {10. 5. 5. 5.})
		color: minorClassHeadingColor
)
minorClassHeadingColor = (
	(* This color is used for sections headings of a class presentation, such as instance and class method lists. It should agree with majorHeadingColor and methodHeadingColor to establish a clear visual hierarchy in a class presenter. *)

	^Gradient
		from: (Color h: 240 s: 0.02 v: 0.94)
		to: (Color h: 240 s: 0.02 v: 0.9)
)
minorHeadingBlock: body = (
	^(padded: body with: {10. 5. 5. 5.})
		color: minorHeadingColor
)
minorHeadingColor = (
^Gradient
	from: (Color h: 240 s: 0.02 v: 0.94)
	to: (Color h: 240 s: 0.02 v: 0.9)
)
public objectSubjectFor: anObject = (
	^objectSubjectForMirror: (ObjectMirror reflecting: anObject)
)
objectSubjectForMirror: objectMirror <ObjectMirror> = (
	^inspection ObjectSubject onModel: objectMirror
)
recentlyVisitedColor = (
	(* Recently visited things are highlighted using this color. *)

	^Color h: 60 s: 0.35 v: 1
)
reorderButtonWithAction: aBlock = (
	^imageButton: HopscotchImages default hsReorderImage action: aBlock
)
respondToInspectPresenter = (
	inspect: self
)
secondaryTextColor = (
	^Color gray: 0.6
)
smallBlank = (
	^blank: 5
)
public subjectForClass: aClass = (
	(* Manufacture a subject appropriate for the given class object. *)

	^aClass language classSubjectFor: aClass using: ide
)
tertiaryTextColor = (
	^Color gray: 0.8
)
) : (
)
) : (
)