SystemOrganization addCategory: #'OB-Tabs-Core'! SystemOrganization addCategory: #'OB-Tabs-Morphic'! OBGroupingMorph subclass: #OBTabSheetMorph instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'OB-Tabs-Morphic'! !OBTabSheetMorph class methodsFor: 'instance-creation' stamp: 'lr 1/22/2008 19:31'! model: aModel ^ self new model: aModel! ! !OBTabSheetMorph methodsFor: 'initialization' stamp: 'lr 1/22/2008 20:09'! initialize super initialize. self layoutPolicy: TableLayout new. self vResizing: #spaceFill; hResizing: #spaceFill! ! !OBTabSheetMorph methodsFor: 'accessing' stamp: 'lr 1/22/2008 19:40'! model ^ model! ! !OBTabSheetMorph methodsFor: 'accessing' stamp: 'lr 1/22/2008 20:38'! model: aModel model ifNotNil: [ model removeDependent: self ]. model := aModel. model addDependent: self! ! !OBTabSheetMorph methodsFor: 'accessing' stamp: 'lr 1/22/2008 20:48'! tabMorph ^ self owner tabMorphs detect: [ :each | each referent = self ]! ! !OBTabSheetMorph methodsFor: 'updating' stamp: 'lr 1/22/2008 20:53'! update: aSymbol aSymbol = #relabel ifTrue: [ self tabMorph shortName: model labelString ]! ! Object subclass: #OBTabBrowser instanceVariableNames: 'browsers' classVariableNames: '' poolDictionaries: '' category: 'OB-Tabs-Core'! !OBTabBrowser class methodsFor: 'instance creation' stamp: 'lr 1/22/2008 18:04'! new ^ self basicNew initialize! ! !OBTabBrowser class methodsFor: 'instance creation' stamp: 'lr 1/22/2008 18:04'! open ^ self new open! ! !OBTabBrowser methodsFor: 'actions' stamp: 'lr 1/22/2008 18:45'! activate: aBrowser self changed: #activate: with: aBrowser! ! !OBTabBrowser methodsFor: 'actions' stamp: 'lr 1/22/2008 19:00'! add: aBrowser self changed: #add: with: aBrowser! ! !OBTabBrowser methodsFor: 'building' stamp: 'lr 1/22/2008 20:39'! buildOn: aBuilder ^ aBuilder window: self with: [ aBuilder tabPanel: self with: [ ] ]! ! !OBTabBrowser methodsFor: 'opening' stamp: 'lr 1/22/2008 17:50'! close ^ OBCloseRequest signal: self! ! !OBTabBrowser methodsFor: 'configuration' stamp: 'lr 1/22/2008 20:35'! defaultBackgroundColor ^ Color orange! ! !OBTabBrowser methodsFor: 'configuration' stamp: 'lr 1/22/2008 18:06'! defaultLabel ^ 'Tab Browser'! ! !OBTabBrowser methodsFor: 'initialize' stamp: 'lr 1/22/2008 20:24'! initialize browsers := OrderedCollection new! ! !OBTabBrowser methodsFor: 'configuration' stamp: 'lr 5/11/2009 11:33'! labelString ^ self defaultLabel! ! !OBTabBrowser methodsFor: 'opening' stamp: 'lr 1/22/2008 17:50'! open ^ OBBrowseRequest signal: self! ! !OBTabBrowser methodsFor: 'actions' stamp: 'lr 1/22/2008 18:45'! remove: aBrowser self changed: #remove: with: aBrowser! ! !ReferenceMorph methodsFor: '*ob-tabs' stamp: 'lr 1/22/2008 20:58'! shortName: aString | index string | index := aString indexOfSubCollection: ': '. string := index = 0 ifTrue: [ aString ] ifFalse: [ aString copyFrom: index + 2 to: aString size ]. string size > 20 ifTrue: [ string := (aString first: 20) , '...' ]. self setNameTo: string! ! TabbedPalette subclass: #OBTabPanelMorph instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'OB-Tabs-Morphic'! !OBTabPanelMorph class methodsFor: 'instance-creation' stamp: 'lr 1/22/2008 19:31'! model: aModel ^ self new model: aModel! ! !OBTabPanelMorph methodsFor: 'actions' stamp: 'lr 1/22/2008 20:21'! activate: aBrowser | tab | tab := self tabMorphs detect: [ :each | each referent model = aBrowser ] ifNone: [ nil ]. tab ifNotNil: [ self selectTab: tab ]! ! !OBTabPanelMorph methodsFor: 'actions' stamp: 'lr 1/22/2008 21:03'! add: aBrowser | builder | builder := OBMorphBuilder new. builder current: self; color: model defaultBackgroundColor. builder tabSheet: aBrowser with: [ aBrowser buildGroup: aBrowser panels on: builder ]! ! !OBTabPanelMorph methodsFor: 'initialization' stamp: 'lr 1/22/2008 20:34'! initialize super initialize. self hResizing: #spaceFill. self tabsMorph color: Color lightGray; highlightColor: Color black; regularColor: Color veryDarkGray! ! !OBTabPanelMorph methodsFor: 'accessing' stamp: 'lr 1/22/2008 19:40'! model ^ model! ! !OBTabPanelMorph methodsFor: 'accessing' stamp: 'lr 1/22/2008 20:34'! model: aModel model ifNotNil: [ model removeDependent: self ]. model := aModel. model addDependent: self. model ifNotNil: [ self tabsMorph color: model defaultBackgroundColor ]! ! !OBTabPanelMorph methodsFor: 'events' stamp: 'lr 1/22/2008 18:44'! update: aSymbol with: aBrowser ^ self perform: aSymbol with: aBrowser! ! !OBMorphBuilder methodsFor: '*ob-tabs' stamp: 'lr 1/22/2008 19:19'! color: aColor color := aColor! ! !OBMorphBuilder methodsFor: '*ob-tabs' stamp: 'lr 1/22/2008 19:47'! tabPanel: aModel with: aBlock | morph | morph := OBTabPanelMorph model: aModel. current ifNotNil: [ current addMorph: morph frame: (0 @ 0 corner: 1 @ 1) ]. ^ self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: '*ob-tabs' stamp: 'lr 1/22/2008 21:04'! tabSheet: aModel with: aBlock | morph | morph := self current: (OBTabSheetMorph model: aModel) do: aBlock. current ifNotNil: [ (current addTabFor: morph font: TextStyle defaultFont) shortName: aModel labelString ]. ^ morph! ! OBMorphicPlatform subclass: #OBTabPlatform instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tabs-Core'! !OBTabPlatform class methodsFor: 'initialization' stamp: 'lr 5/11/2009 11:35'! initialize self current: self default! ! !OBTabPlatform class methodsFor: 'initialization' stamp: 'lr 5/11/2009 11:35'! unload self current: OBMorphicPlatform default! ! !OBTabPlatform methodsFor: 'interaction' stamp: 'lr 1/22/2008 18:55'! handleBrowseRequest: aRequest | window | (Sensor shiftPressed or: [ aRequest browser class = OBTabBrowser ]) ifTrue: [ ^ super handleBrowseRequest: aRequest ]. window := SystemWindow topWindow. window model class = OBTabBrowser ifFalse: [ window := OBTabBrowser open ]. window model add: aRequest browser; activate: aRequest browser. ^ window! ! OBTabPlatform initialize!