[ENH]ProjectNavigationMorph.4Karl Ramberg karl.ramberg at chello.seSun Jun 25 14:37:18 UTC 2000
Hi, I have yet again added a little to the ProjectNavigationMorph. BalloonHelp ColorChanges FindMenu Karl -------------- next part -------------- 'From Squeak2.9alpha of 13 June 2000 [latest update: #2424] on 25 June 2000 at 4:29:58 pm'! AlignmentMorph subclass: #ProjectNavigationMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/23/2000 09:40'! addButton: aString balloonText: anotherString for: aSymbol | b a | b _ SimpleButtonMorph new target: self; borderColor: #raised; color: color darker; label: aString; setBalloonText: anotherString; actionSelector: aSymbol. a _ AlignmentMorph newColumn. a color: Color transparent; borderWidth: 0; inset: 2. a hResizing: #shrinkWrap; vResizing: #shrinkWrap. a addMorphBack: b. self addMorphBack: a. ! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 16:27'! addButtons self addButton: '< Prev' balloonText: 'Previous project' for: #previousProject; addButton: 'Next >' balloonText: 'Next project' for: #nextProject; addButton: '^ Publish' balloonText: 'Publish this project. Save it where it came from (server, hard disk, etc.) ' for: #publishProject; addButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable; addButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend; addButton: 'Find' balloonText: 'Find Classes, methods , windows, stuff on the internet.etc.' for: #findMenu. ! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 16:15'! buildFindMenu | aMenu subMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu add: 'Look up definition for ...' action: #lookUpDefinition. aMenu balloonTextForLastItem: 'Look up definition for a word on Internet'. aMenu add: 'Find Class' action: #findClass. aMenu balloonTextForLastItem: 'Find a class and open a browser for that class'. aMenu add: 'Find Method' action: #findMethod. aMenu balloonTextForLastItem:'Opens the MethodFinder'. aMenu add: 'Find On Internet' action: #findOnNet. aMenu balloonTextForLastItem:'Find stuff on internet using the seach engine specified in ProjectNavigationMorph>>findOnNet'. subMenu _ (MenuMorph new defaultTarget: self). subMenu add: 'Find Window' action: #findWindow. subMenu balloonTextForLastItem:'Present a menu of window titles, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen.'. subMenu add: 'Find changed Browser' action: #findDirtyBrowsers. subMenu balloonTextForLastItem:'Present a menu of window titles for browsers with changes, and activate the one that gets chosen.'. subMenu add: 'Find changed Window' action: #findDirtyWindows. subMenu balloonTextForLastItem:'Present a menu of window titles for all windows with changes, and activate the one that gets chosen.'. aMenu add:'Find Window' subMenu: subMenu. ^aMenu! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 14:11'! findClass "Search for a class by name." | pattern foundClass classNames index toMatch exactMatch potentialClassNames | potentialClassNames _ Smalltalk classNames. self okToChange ifFalse: [^ self]. pattern _ FillInTheBlank request: 'Class name or fragment?'. pattern isEmpty ifTrue: [^ self]. toMatch _ (pattern copyWithout: $.) asLowercase. potentialClassNames _ potentialClassNames asOrderedCollection. classNames _ pattern last = $. ifTrue: [potentialClassNames select: [:nm | nm asLowercase = toMatch]] ifFalse: [potentialClassNames select: [:n | n includesSubstring: toMatch caseSensitive: false]]. classNames isEmpty ifTrue: [^ self ]. exactMatch _ classNames detect: [:each | each asLowercase = toMatch] ifNone: [nil]. index _ classNames size = 1 ifTrue: [1] ifFalse: [exactMatch ifNil: [(PopUpMenu labelArray: classNames lines: #()) startUp] ifNotNil: [classNames addFirst: exactMatch. (PopUpMenu labelArray: classNames lines: #(1)) startUp]]. index = 0 ifTrue: [^ self ]. foundClass _ Smalltalk at: (classNames at: index) asSymbol. Browser newOnClass: foundClass. ! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 16:12'! findDirtyBrowsers "Present a menu of window titles for browsers with changes, and activate the one that gets chosen." | menu | self flag: #bob. "which world??" menu _ MenuMorph new. (SystemWindow windowsIn: self world satisfying: [:w | (w model isKindOf: Browser) and: [w model canDiscardEdits not]]) do: [:w | menu add: w label target: w action: #activate]. menu submorphs size > 0 ifTrue: [menu popUpForHand: self currentHand]! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 16:13'! findDirtyWindows "Present a menu of window titles for all windows with changes, and activate the one that gets chosen." | menu | self flag: #bob. "which world??" menu _ MenuMorph new. (SystemWindow windowsIn: self world satisfying: [:w | w model canDiscardEdits not]) do: [:w | menu add: w label target: w action: #activate]. menu submorphs size > 0 ifTrue: [menu popUpForHand: self currentHand]! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 14:04'! findMenu | aMenu | aMenu _ self buildFindMenu. aMenu popUpEvent: self currentEvent in: self world! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 14:06'! findMethod SelectorBrowser new morphicWindow openInWorld! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 14:07'! findOnNet Scamper openOnUrl: 'www.google.com'! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 16:18'! findWindow "Present a menu of window titles, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen." | menu expanded collapsed nakedMorphs | self flag: #bob. "which world??" menu _ MenuMorph new. expanded _ SystemWindow windowsIn: self world satisfying: [:w | w isCollapsed not]. collapsed _ SystemWindow windowsIn: self world satisfying: [:w | w isCollapsed]. nakedMorphs _ self world submorphsSatisfying: [:m | ((m isKindOf: SystemWindow) not and: [(m isKindOf: StickySketchMorph) not]) and: [(m isKindOf: FlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ self beep]. (expanded asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: w label target: w action: #activateAndForceLabelToShow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: w label target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs asSortedCollection: [:w1 :w2 | w1 externalName caseInsensitiveLessOrEqual: w2 externalName]) do: [:w | menu add: w externalName target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window'. menu popUpForHand: self currentHand! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/17/2000 18:57'! getNewerVersionIfAvailable (self world ifNil: [^1 beep]) project loadFromServer: true. ! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 12:40'! initialize super initialize. self useRoundedCorners. inset _ 6. color _ Color orange. hResizing _ #shrinkWrap. vResizing _ #shrinkWrap. self addButtons. ! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 14:07'! lookUpDefinition Utilities lookUpDefinition! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/17/2000 18:57'! nextProject Project advanceToNextProject. 1 beep.! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 6/3/2000 09:45'! previousProject Project returnToPreviousProject. CurrentProjectRefactoring exitCurrentProject. "go to parent if no previous" 1 beep.! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/17/2000 18:23'! publishProject (self world ifNil: [^1 beep]) project storeOnServer. ! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'kfr 6/25/2000 14:10'! step | delta testSubmorphColor | owner == self world ifFalse: [^ self]. (owner submorphs indexOf: self) = 1 ifFalse: [(owner firstSubmorph isMemberOf: BalloonMorph) | (owner firstSubmorph isMemberOf: MenuMorph) | (owner firstSubmorph isMemberOf: FillInTheBlankMorph) ifFalse: [owner addMorphFront: self]]. delta _ self bounds amountToTranslateWithin: self worldBounds. delta = (0 @ 0) ifFalse: [self position: self position + delta]. testSubmorphColor _ self firstSubmorph findA: SimpleButtonMorph. testSubmorphColor color ~~ self color ifTrue: [self submorphsDo: [:m | m submorphsDo: [:n | n color: self color darker]]]! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/18/2000 11:43'! stepTime ^1000! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 6/3/2000 10:54'! tellAFriend self world project tellAFriend! ! !ProjectNavigationMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/18/2000 11:43'! wantsSteps ^true! !
More information about the Squeak-dev mailing list |