[ENH]ProjectNavigationMorph.4
Karl Ramberg
karl.ramberg at chello.se
Sun 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
|