'From Squeak6.0alpha of 19 January 2018 [latest update: #17698] on 21 January 2018 at 9:48:15 am'!
CodeHolder subclass: #Browser
	instanceVariableNames: 'environment systemOrganizer classOrganizer metaClassOrganizer editSelection metaClassIndicated selectedSystemCategory selectedClassName selectedMessageName selectedMessageCategoryName classDefinition metaClassDefinition '
	classVariableNames: 'ListClassesHierarchically RecentClasses ShowClassIcons ShowMessageIcons SortMessageCategoriesAlphabetically ShowExtensionClasses '
	poolDictionaries: ''
	category: 'Tools-Browser'!

!Browser methodsFor: 'class list' stamp: 'mt 1/20/2018 09:43'!
classList

	^ self class listClassesHierarchically
		ifTrue: [self hierarchicalClassList]
		ifFalse: [self flatClassList].! !

!Browser methodsFor: 'class list' stamp: 'mt 1/20/2018 09:49'!
extensionClasses
	"Returns all classes that have extension methods for the selected system category (resp. package). For example, #'Balloon-Fills' looks for #'*Balloon' prefixed message categories (resp. protocols) if there is a package named #Balloon.
	
	Note that this method is not called #extensionClassList but #extensionClasses because it returns classes not class names like #classList does."
	
	^ self hasSystemCategorySelected
		ifFalse: [Array new]
		ifTrue: [self selectedSystemCategory = SystemOrganizer allCategory
			ifTrue: [#()]
			ifFalse: [
				(PackageOrganizer default
					packageOfSystemCategory: self selectedSystemCategory
					ifNone: [])
						ifNil: [#()]
						ifNotNil: [:pkg | pkg extensionClasses select: [:cls | cls isMeta = self metaClassIndicated]]]]! !

!Browser methodsFor: 'class list' stamp: 'mt 1/20/2018 10:27'!
flatClassList
	
	^ (Browser showExtensionClasses
		and: [self selectedSystemCategory ~= SystemOrganizer allCategory])
			ifFalse: [self defaultClassList]
			ifTrue: [
				self defaultClassList, (self extensionClasses collect: [:ea | 
					ea theNonMetaClass name asText
						addAttribute: (TextColor color: (self userInterfaceTheme extensionClassColor ifNil: [Color gray: 0.75]));
						yourself])]! !

!Browser methodsFor: 'class list' stamp: 'mt 1/20/2018 10:27'!
hierarchicalClassList
	"classNames are an arbitrary collection of classNames of the system.
	Reorder those class names so that they are sorted and indended by inheritance"
	
	| classes flatTree |
	
	self flag: #performance. "mt: Creating the hierarchy is *really slow* for the full class list. Skip it for now."
	self selectedSystemCategory = SystemOrganizer allCategory
		ifTrue: [^ self defaultClassList].
		
	classes := self defaultClassList collect: [:sym | self selectedEnvironment classNamed: sym].
	flatTree := OrderedCollection new.
	
	self
		flattenHierarchyTree: (self createHierarchyTreeOf: classes)
		on: flatTree
		indent: ''.
	
	Browser showExtensionClasses ifTrue: [
		| extensionClasses extensionFlatTree |
		extensionClasses := self extensionClasses collect: [:ea | ea theNonMetaClass].
		extensionFlatTree := OrderedCollection new.
		self
			flattenHierarchyTree: (self createHierarchyTreeOf: extensionClasses)
			on: extensionFlatTree
			indent: ''.
		extensionFlatTree := extensionFlatTree collect: [:ea |
			ea asText
				addAttribute: (TextColor color: (self userInterfaceTheme extensionClassColor ifNil: [Color gray: 0.75]));
				yourself].
		flatTree addAll: extensionFlatTree].
		
	^ flatTree
	
	! !

!Browser methodsFor: 'metaclass' stamp: 'mt 1/20/2018 09:46'!
metaClassIndicated: trueOrFalse 
	"Indicate whether browsing instance or class messages."

	metaClassIndicated := trueOrFalse.
	self setClassOrganizer.
	self hasSystemCategorySelected ifTrue:
		[self editSelection: (self hasClassSelected
			ifFalse: [metaClassIndicated
				ifTrue: [#none]
				ifFalse: [#newClass]]
			ifTrue: [#editClass])].
	selectedMessageCategoryName := nil.
	selectedMessageName := nil.
	contents := nil.
	self changed: #classSelectionChanged.
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #contents.
	self changed: #annotation.
	self changed: #classList.
	self decorateButtons
! !

!Browser methodsFor: 'user interface' stamp: 'mt 1/20/2018 10:33'!
applyUserInterfaceTheme

	super applyUserInterfaceTheme.

	self changed: #classList.! !


!Browser class methodsFor: 'preferences' stamp: 'mt 1/20/2018 09:36'!
showExtensionClasses
	<preference: 'Show extension classes'
		category: 'browsing'
		description: 'When enabled, the class list will show not only the classes in the current category but also classes that contain extension methods for that category/package.'
		type: #Boolean>
	^ ShowExtensionClasses ifNil: [true]
! !

!Browser class methodsFor: 'preferences' stamp: 'mt 1/21/2018 09:47'!
showExtensionClasses: aBoolean

	ShowExtensionClasses := aBoolean.
	Browser allInstancesDo: [:ea | ea changed: #classList].! !


!CommunityTheme class methodsFor: 'instance creation' stamp: 'mt 1/20/2018 10:46'!
addDarkToolColors: theme
	"Tool-specific colors."
	
	theme 
		set: #failureColor for: #TestRunner to: self dbYellow;
		set: #errorColor for: #TestRunner to: self dbRed;
		set: #passColor for: #TestRunner to: self dbGreen.
		
	theme
		set: #extensionClassColor for: #Browser to: self dbGray.! !


!LazyListMorph methodsFor: 'drawing' stamp: 'mt 1/20/2018 10:40'!
colorForRow: row default: defaultColor

	^(selectedRow notNil and: [ row = selectedRow])
		ifTrue: [ self selectionTextColor ]
		ifFalse: [ defaultColor ].! !

!LazyListMorph methodsFor: 'drawing' stamp: 'mt 1/20/2018 10:41'!
display: item atRow: row on: canvas
	"display the given item at row row"

	| drawBounds emphasized rowColor itemAsText |
	itemAsText := item asStringOrText.
	
	"If it is a text, we will only use the first character's emphasis."
	emphasized := itemAsText isText 
		ifTrue: [font emphasized: (itemAsText emphasisAt: 1)] 
		ifFalse: [font].
	
	rowColor := self
		colorForRow: row
		default: (itemAsText isText
			ifTrue: [itemAsText colorAt: 1 ifNone: [self color]]
			ifFalse: [self color]).
	
	drawBounds := (self drawBoundsForRow: row) translateBy: (self hMargin @ 0).
	drawBounds := drawBounds intersect: self bounds.

	"Draw icon if existing. Adjust draw bounds in that case."
	(self icon: row) ifNotNil: [ :icon || top |
		top := drawBounds top + ((drawBounds height - icon height) // 2).
		canvas translucentImage: icon at: drawBounds left @ top.
		drawBounds := drawBounds left: drawBounds left + icon width + 2 ].
		
	"We will only draw strings here."
	canvas
		drawString: itemAsText asString
		in: drawBounds
		font: emphasized
		color: rowColor.

	"Draw filter matches if any."
	self
		displayFilterOn: canvas
		for: row
		in: drawBounds
		font: emphasized.! !


!MonokaiTheme class methodsFor: 'instance creation' stamp: 'mt 1/20/2018 10:44'!
addDarkToolColors: theme
	"Tool-specific colors."
	
	theme 
		set: #failureColor for: #TestRunner to: self yellow;
		set: #errorColor for: #TestRunner to: self red;
		set: #passColor for: #TestRunner to: self green;
		
		set: #failureTextColor for: #TestRunner to: self backgroundColor;
		set: #errorTextColor for: #TestRunner to: self backgroundColor;
		set: #passTextColor for: #TestRunner to: self backgroundColor.
		
	theme
		set: #ignoredOperationAttributes for: #MCOperationsBrowser to: {TextColor color: self grayLight}.

	theme
		set: #extensionClassColor for: #Browser to: self grayLight.! !


!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 1/20/2018 10:43'!
addDarkToolColors: theme
	"Tool-specific colors."
	
	theme 
		set: #failureColor for: #TestRunner to: self yellow;
		set: #errorColor for: #TestRunner to: self red;
		set: #passColor for: #TestRunner to: self green;
		
		set: #failureTextColor for: #TestRunner to: self darkBackground;
		set: #errorTextColor for: #TestRunner to: self darkBackground;
		set: #passTextColor for: #TestRunner to: self darkBackground.
		
	theme
		set: #ignoredOperationAttributes for: #MCOperationsBrowser to: {TextColor color: self darkContentSecondary}.
		
	theme
		set: #extensionClassColor for: #Browser to: self darkContentSecondary.! !

!SolarizedTheme class methodsFor: 'instance creation' stamp: 'mt 1/20/2018 10:42'!
addLightToolColors: theme
	"Tool-specific colors."
	
	theme 
		set: #failureColor for: #TestRunner to: self yellow;
		set: #errorColor for: #TestRunner to: self red;
		set: #passColor for: #TestRunner to: self green;

		set: #failureTextColor for: #TestRunner to: self lightBackground;
		set: #errorTextColor for: #TestRunner to: self lightBackground;
		set: #passTextColor for: #TestRunner to: self lightBackground.
		
	theme
		set: #ignoredOperationAttributes for: #MCOperationsBrowser to: {TextColor color: self lightContentSecondary}.
		
	theme
		set: #extensionClassColor for: #Browser to: self lightContentSecondary.! !


!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 1/20/2018 10:20'!
addDullerToolColors: theme
	"Tool-specific colors."

	"Browser"
	theme set: #extensionClassColor for: #Browser to: (Color gray: 0.75) duller.
	
	"TestRunner"
	theme 
		set: #failureColor for: #TestRunner to: Color yellow duller;
		set: #errorColor for: #TestRunner to: Color red duller;
		set: #passColor for: #TestRunner to: Color green duller.! !

!SqueakTheme class methodsFor: 'instance creation' stamp: 'mt 1/20/2018 10:20'!
addToolColors: theme
	"Tool-specific colors."
	
	"Browser"
	theme set: #extensionClassColor for: #Browser to: (Color gray: 0.75).
	
	"SUnit's TestRunner."
	theme 
		set: #failureColor for: #TestRunner to: Color yellow;
		set: #errorColor for: #TestRunner to: Color red;
		set: #passColor for: #TestRunner to: Color green;
		
		derive: #failureTextColor for: #TestRunner from: #PluggableTextMorph at: #textColor;
		derive: #errorTextColor for: #TestRunner from: #PluggableTextMorph at: #textColor;
		derive: #passTextColor for: #TestRunner from: #PluggableTextMorph at: #textColor.
		
	"Monticello Tools."
	theme
		set: #revertedOperationAttributes for: #MCOperationsBrowser to: {TextEmphasis struckOut};
		set: #ignoredOperationAttributes for: #MCOperationsBrowser to: {TextColor color: Color gray}.
		"set: #rejectedOperationAttributes for: #MCOperationsBrowser to: {TextEmphasis struckOut};
		set: #acceptedOperationAttributes for: #MCOperationsBrowser to: {TextEmphasis underlined};
		set: #conflictingOperationAttributes for: #MCOperationsBrowser to: {TextEmphasis bold}."
		
	"Halos."
	theme
		derive: #borderColor for: #HaloMorph from: #MenuItemMorph at: #selectionColor do: [:c | c alpha: 0.8];
		derive: #borderColor for: #SelectionMorph from: #MenuItemMorph at: #selectionColor do: [:c | c twiceDarker alpha: 0.75];
		derive: #color for: #SelectionMorph from: #MenuItemMorph at: #selectionColor do: [:c | c alpha: 0.08].! !


!Text methodsFor: 'converting' stamp: 'mt 1/20/2018 10:04'!
asSymbol

	^ self asString asSymbol
! !

!Text methodsFor: 'converting' stamp: 'mt 1/20/2018 10:03'!
withoutLeadingBlanks
	"Return a copy of the receiver from which leading blanks have been trimmed."

	| first |
	first := string indexOfAnyOf: CharacterSet nonSeparators startingAt: 1.
	first = 0 ifTrue: [ ^'' ].  "no non-separator character"
	first = 1 ifTrue: [ ^self copy ].
	^self
		copyFrom: first
		to: self size
! !

CodeHolder subclass: #Browser
	instanceVariableNames: 'environment systemOrganizer classOrganizer metaClassOrganizer editSelection metaClassIndicated selectedSystemCategory selectedClassName selectedMessageName selectedMessageCategoryName classDefinition metaClassDefinition'
	classVariableNames: 'ListClassesHierarchically RecentClasses ShowClassIcons ShowExtensionClasses ShowMessageIcons SortMessageCategoriesAlphabetically'
	poolDictionaries: ''
	category: 'Tools-Browser'!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."

| prevTheme |
prevTheme := UserInterfaceTheme current name.
UserInterfaceTheme cleanUp: true.
(UserInterfaceTheme named: prevTheme) apply.!

