'From Squeak3.1alpha of 28 February 2001 [latest update: #4185] on 30 June 2001 at 1:27:10 pm'! "Change Set: ViewerFlapWidth-ar Date: 30 June 2001 Author: Andreas Raab Ensure that the width of a flap containing a viewer will be at least as wide as the viewer."! !Morph methodsFor: 'classification' stamp: 'ar 6/30/2001 13:13'! isStandardViewer ^false! ! !CategoryViewer methodsFor: 'categories' stamp: 'ar 6/30/2001 13:15'! categoryWording: aCategoryWording "Make the category with the given wording be my current one." | bin actualPane | (actualPane _ namePane renderedMorph) firstSubmorph contents: aCategoryWording; color: Color black. actualPane extent: actualPane firstSubmorph extent. bin _ PhraseWrapperMorph new borderWidth: 0; listDirection: #topToBottom. bin addAllMorphs: ((scriptedPlayer tilePhrasesForCategory: chosenCategorySymbol inViewer: self) collect: [:aViewerRow | self viewerEntryFor: aViewerRow]). bin enforceTileColorPolicy. submorphs size < 2 ifTrue: [self addMorphBack: bin] ifFalse: [self replaceSubmorph: self listPane by: bin]. self secreteCategorySymbol. self world ifNotNil: [self world startSteppingSubmorphsOf: self]. owner isStandardViewer ifTrue:[owner fitFlap]. ! ! !PasteUpMorph methodsFor: 'accessing' stamp: 'ar 6/30/2001 13:21'! assureFlapWidth: requestedWidth | tab | self width: requestedWidth. tab _ self flapTab ifNil:[^self]. tab flapShowing ifTrue:[tab hideFlap; showFlap].! ! !PasteUpMorph methodsFor: 'accessing' stamp: 'ar 6/30/2001 13:26'! flapTab self isFlap ifFalse:[^nil]. ^self world flapTabs detect:[:any| any referent == self] ifNone:[nil]! ! !StandardViewer methodsFor: 'categories' stamp: 'ar 6/30/2001 13:24'! addCategoryViewerFor: catSymbol "Add a category viewer for the given category" | aViewer | self addMorphBack: (aViewer _ CategoryViewer new). aViewer initializeFor: scriptedPlayer categoryChoice: catSymbol. self world ifNotNil: [self world startSteppingSubmorphsOf: aViewer]. self fitFlap.! ! !StandardViewer methodsFor: 'initialization' stamp: 'ar 6/30/2001 13:23'! fitFlap (owner notNil and:[owner isFlap]) ifTrue:[ owner width < self fullBounds width ifTrue:[ owner assureFlapWidth: self fullBounds width + 25. ]. ].! ! !StandardViewer methodsFor: 'testing' stamp: 'ar 6/30/2001 13:13'! isStandardViewer ^true! !