'From Squeak3.2alpha of 3 October 2001 [latest update: #4538] on 22 November 2001 at 11:06:43 am'! "Change Set: furtherToFlaps-sw Date: 22 November 2001 Author: Scott Wallace Fixes proportional relayout of flap tabs upon resize of squeak-app window. Offers a preference that governs whether flaps along the bottom of the screen should have their positions automatically be positioned, and two other preferences relating to flaps and navigators. Hopefully users will be happy with the settings provided by default. The intent is to allow the undiluted use of the old non-flap-based navigator for those who have bonded to it, while offering a completely flap-based alternative to it." FlapTab allInstancesDo: [:aFlapTab | aFlapTab computeEdgeFraction]. Preferences addPreference: #automaticFlapLayout categories: #(flaps) default: true balloonHelp: 'If true, then upon every resizing of the outer application window, flaps along the bottom of the screen are automatically laid out such that they do not overlap, whenever that is possible.' projectLocal: false changeInformee: #Flaps changeSelector: #doAutomaticLayoutOfFlapsIfAppropriate. Preferences addPreference: #navigatorOnLeftEdge categories: #(flaps) default: true balloonHelp: 'If true, then the navigator flap will be positioned at the left edge of the bottom of the screen.' projectLocal: false changeInformee: #Flaps changeSelector: #doAutomaticLayoutOfFlapsIfAppropriate. Preferences addPreference: #classicNavigatorEnabled categories: #(flaps) default: false balloonHelp: 'If true, then the classic project navigator used in 2000-1 is available quite separately from the Flaps regime; if false, then a flap-based navigator is used when a navigator is called for.' projectLocal: false changeInformee: #Flaps changeSelector: #enableClassicNavigatorChanged.! !FlapTab methodsFor: 'positioning' stamp: 'sw 11/22/2001 08:11'! mouseUp: evt "The mouse came back up, presumably after having dragged the tab. Caution: if not operating full-screen, this notification can easily be *missed*, which is why the edge-fraction-computation is also being done on mouseMove." super mouseUp: evt. (self referentThickness <= 0 or: [(referent isInWorld and: [(referent boundsInWorld intersects: referent owner boundsInWorld) not])]) ifTrue: [self hideFlap. flapShowing _ false]. self fitOnScreen. dragged ifTrue: [self computeEdgeFraction. dragged _ false]. Flaps doAutomaticLayoutOfFlapsIfAppropriate! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 11/22/2001 10:04'! automaticFlapLayoutChanged "Sent when the automaticFlapLayout preference changes. No senders in easily traceable in the image, but this is really sent by a Preference object!!" Preferences automaticFlapLayout ifTrue: [self positionNavigatorAndOtherFlapsAccordingToPreference]! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 11/22/2001 09:58'! doAutomaticLayoutOfFlapsIfAppropriate "Do automatic layout of flaps if appropriate" Preferences automaticFlapLayout ifTrue: [self positionNavigatorAndOtherFlapsAccordingToPreference]! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 11/22/2001 10:17'! enableClassicNavigatorChanged "The #classicNavigatorEnabled preference has changed. No senders in easily traceable in the image, but this is really sent by a Preference object!!" Preferences classicNavigatorEnabled ifTrue: [Flaps disableGlobalFlapWithID: 'Navigator'. Preferences enable: #showProjectNavigator. self disableGlobalFlapWithID: 'Navigator'.] ifFalse: [self enableGlobalFlapWithID: 'Navigator'. ActiveWorld addGlobalFlaps]. self doAutomaticLayoutOfFlapsIfAppropriate. Project current assureNavigatorPresenceMatchesPreference. ActiveWorld reformulateUpdatingMenus! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 11/22/2001 11:15'! enableGlobalFlaps "Start using global flaps, given that they were not present." Cursor wait showWhile: [SharedFlapsAllowed _ true. self globalFlapTabs. "This will create them" Smalltalk isMorphic ifTrue: [ActiveWorld addGlobalFlaps. self doAutomaticLayoutOfFlapsIfAppropriate. FlapTab allInstancesDo: [:aTab | aTab computeEdgeFraction]. ActiveWorld reformulateUpdatingMenus]]! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 11/22/2001 10:04'! makeNavigatorFlapResembleGoldenBar "At explicit request, make the flap-based navigator resemble the golden bar. No senders in the image, but sendable from a doit" "Flaps makeNavigatorFlapResembleGoldenBar" Preferences setPreference: #classicNavigatorEnabled toValue: false. Preferences setPreference: #showProjectNavigator toValue: false. (self globalFlapTabWithID: 'Navigator') ifNil: [SharedFlapTabs add: self newNavigatorFlap delete]. self enableGlobalFlapWithID: 'Navigator'. Preferences setPreference: #navigatorOnLeftEdge toValue: true. (self globalFlapTabWithID: 'Navigator') arrangeToPopOutOnMouseOver: true. ActiveWorld addGlobalFlaps. self doAutomaticLayoutOfFlapsIfAppropriate. Project current assureNavigatorPresenceMatchesPreference. ! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 11/22/2001 07:14'! positionNavigatorAndOtherFlapsAccordingToPreference "Lay out flaps along the designated edge right-to-left, possibly positioning the navigator flap, exceptionally, on the left." | ids | ids _ Preferences navigatorOnLeftEdge ifTrue: [#(Navigator)] ifFalse: [#()]. Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapsWithIDs: ids "Flaps positionNavigatorAndOtherFlapsAccordingToPreference"! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 11/22/2001 06:53'! positionVisibleFlapsRightToLeftOnEdge: edgeSymbol butPlaceAtLeftFlapsWithIDs: idList "Lay out flaps along the designated edge right-to-left, while laying left-to-right any flaps found in the exception list Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapWithIDs: #(Navigator Supplies) Flaps sharedFlapsAlongBottom" | leftX flapList flapsOnRight flapsOnLeft | flapList _ self globalFlapTabsIfAny select: [:aFlapTab | aFlapTab isInWorld and: [aFlapTab edgeToAdhereTo == edgeSymbol]]. flapsOnLeft _ flapList select: [:fl | idList includes: fl flapID]. flapList removeAll: flapsOnLeft. flapsOnRight _ flapList asSortedCollection: [:f1 :f2 | f1 left > f2 left]. leftX _ ActiveWorld width - 15. flapsOnRight do: [:aFlapTab | aFlapTab right: leftX - 3. leftX _ aFlapTab left]. leftX _ ActiveWorld left. flapsOnLeft _ flapsOnLeft asSortedCollection: [:f1 :f2 | f1 left > f2 left]. flapsOnLeft do: [:aFlapTab | aFlapTab left: leftX + 3. leftX _ aFlapTab right]. (flapsOnLeft asOrderedCollection, flapsOnRight asOrderedCollection) do: [:ft | ft computeEdgeFraction. ft flapID = 'Navigator' ifTrue: [ft referent left: (ft center x - (ft referent width//2) max: 0)]] ! ! !Flaps class methodsFor: 'menu commands' stamp: 'sw 11/22/2001 08:31'! enableDisableGlobalFlapWithID: aFlapID "Toggle the enable/disable status of the given global flap" | disabledFlapIDs aFlapTab currentProject | (currentProject _ Project current) assureFlapIntegrity. Smalltalk isMorphic ifFalse: [^ self]. disabledFlapIDs _ currentProject parameterAt: #disabledGlobalFlapIDs. (aFlapTab _ self globalFlapTabWithID: aFlapID) ifNotNil: [aFlapTab hideFlap]. (disabledFlapIDs includes: aFlapID) ifTrue: [disabledFlapIDs remove: aFlapID. self currentWorld addGlobalFlaps] ifFalse: [disabledFlapIDs add: aFlapID. aFlapTab ifNotNil: [aFlapTab delete]]. self doAutomaticLayoutOfFlapsIfAppropriate! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 11/22/2001 08:31'! newNavigatorFlap "Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. " | aFlapTab navBar aFlap | navBar _ ProjectNavigationMorph preferredNavigator new. aFlap _ PasteUpMorph newSticky borderWidth: 0; extent: navBar extent + (0@20); color: (Color orange alpha: 0.8); beFlap: true; addMorph: navBar beSticky. navBar fullBounds. "to establish width" aFlapTab _ FlapTab new referent: aFlap. aFlapTab setName: 'Navigator' edge: #bottom color: Color orange. aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2)) @ (self currentWorld height - aFlapTab height). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Navigator' " ! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 11/22/2001 11:21'! sharedFlapsAlongBottom "Flaps sharedFlapsAlongBottom" | leftX | leftX _ Display width-15. "Pace off in order from right to left, setting positions" #('Squeak' 'Navigator' 'Supplies' 'Widgets' 'Stack Tools' 'Tools') reverseDo: [:id | (self globalFlapTabWithID: id) ifNotNilDo: [:ft | ft setEdge: #bottom. ft right: leftX - 3. leftX _ ft left]]. "Put Nav Bar centered under tab if possible" (self globalFlapTabWithID: 'Navigator') ifNotNilDo: [:ft | ft referent left: (ft center x - (ft referent width//2) max: 0)]. self positionNavigatorAndOtherFlapsAccordingToPreference.! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'sw 4/23/2001 12:33'! reformulateUpdatingMenus "Give any updating menu morphs in the receiver a fresh kiss of life" (self submorphs select: [:m | m isKindOf: UpdatingMenuMorph]) do: [:m | m updateMenu] "NB: to do the perfect job here one might well want to extend across allMorphs here, but the expense upon project entry is seemingly too high a price to pay at this point"! ! !PasteUpMorph methodsFor: 'world state' stamp: 'sw 11/22/2001 07:57'! repositionFlapsAfterScreenSizeChange "Reposition flaps after screen size change" (Flaps globalFlapTabs, ActiveWorld localFlapTabs) do: [:aFlapTab | aFlapTab applyEdgeFractionWithin: self bounds]. Flaps doAutomaticLayoutOfFlapsIfAppropriate! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'sw 11/22/2001 08:18'! keystrokeInWorld: evt "A keystroke was hit when no keyboard focus was in set, so it is sent here to the world instead. This current implementation is regrettably hard-coded; until someone cleans this up, you may wish to edit this method to suit your personal taste in interpreting cmd-keys issued to the desktop." | aChar isCmd | aChar _ evt keyCharacter. isCmd _ evt commandKeyPressed and: [Preferences cmdKeysInText]. (evt commandKeyPressed and: [Preferences eToyFriendly]) ifTrue: [(aChar == $W) ifTrue: [^ self putUpWorldMenu: evt]]. (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue: [(aChar == $o) ifTrue: [^ ActiveWorld activateObjectsTool]. (aChar == $F) ifTrue: [^ CurrentProjectRefactoring currentToggleFlapsSuppressed]. (aChar == $N) ifTrue: [Preferences classicNavigatorEnabled ifTrue: [^ Preferences togglePreference: #showProjectNavigator]]. (aChar == $r) ifTrue: [^ ActiveWorld restoreMorphicDisplay]. Preferences eToyFriendly ifFalse: [(aChar == $\) ifTrue: [^ SystemWindow sendTopWindowToBack]. (aChar == $b) ifTrue: [^ Browser openBrowser]. (aChar == $k) ifTrue: [^ Workspace open]. (aChar == $m) ifTrue: [^ TheWorldMenu new adaptToWorld: World; newMorph]. (aChar == $t) ifTrue: [^ self findATranscript: evt]. (aChar == $w) ifTrue: [^ SystemWindow closeTopWindow]. (aChar == $z) ifTrue: [^ self commandHistory undoOrRedoCommand]. (aChar == $C) ifTrue: [^ self findAChangeSorter: evt]. (aChar == $R) ifTrue: [^ self openRecentSubmissionsBrowser: evt]. (aChar == $P) ifTrue: [^ self findAPreferencesPanel: evt]. (aChar == $W) ifTrue: [^ self findAMessageNamesWindow: evt]]]! ! !Preferences class methodsFor: 'get/set' stamp: 'sw 11/22/2001 09:02'! automaticFlapLayoutString "Answer a string for the automaticFlapLayout menu item" ^ (self automaticFlapLayout ifTrue: [''] ifFalse: ['']) , 'automatic flap layout' ! ! !Project methodsFor: 'menu messages' stamp: 'sw 11/22/2001 08:40'! assureNavigatorPresenceMatchesPreference "Make sure that the current project conforms to the presence/absence of the navigator" | navigator navType wantIt | Smalltalk isMorphic ifFalse: [^ self]. wantIt _ Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator]. navType _ ProjectNavigationMorph preferredNavigator. navigator _ world findA: navType. wantIt ifFalse: [navigator ifNotNil: [navigator delete]] ifTrue: [navigator isNil ifTrue: [(navigator _ navType new) bottomLeft: world bottomLeft; openInWorld: world]]! ! !Project methodsFor: 'menu messages' stamp: 'sw 11/22/2001 10:25'! finalEnterActions "Perform the final actions necessary as the receiver project is entered" | navigator armsLengthCmd navType thingsToUnhibernate | self projectParameters at: #projectsToBeDeleted ifPresent: [ :projectsToBeDeleted | self removeParameter: #projectsToBeDeleted. projectsToBeDeleted do: [ :each | Project deletingProject: each. each removeChangeSetIfPossible]]. thingsToUnhibernate _ world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()]. thingsToUnhibernate do: [:each | each unhibernate]. world removeProperty: #thingsToUnhibernate. navType _ ProjectNavigationMorph preferredNavigator. armsLengthCmd _ self parameterAt: #armsLengthCmd ifAbsent: [nil]. navigator _ world findA: navType. (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue: [(navigator _ navType new) bottomLeft: world bottomLeft; openInWorld: world]. navigator notNil & armsLengthCmd notNil ifTrue: [navigator color: Color lightBlue]. armsLengthCmd notNil ifTrue: [Preferences showFlapsWhenPublishing ifFalse: [self flapsSuppressed: true. navigator ifNotNil: [navigator visible: false]]. armsLengthCmd openInWorld: world]. Smalltalk isMorphic ifTrue: [world reformulateUpdatingMenus]. WorldState addDeferredUIMessage: [self startResourceLoading].! ! !Project methodsFor: 'menu messages' stamp: 'sw 11/22/2001 04:01'! navigatorFlapVisible "Answer whether a Navigator flap is visible" ^ (Flaps sharedFlapsAllowed and: [self flapsSuppressed not]) and: [self isFlapIDEnabled: 'Navigator']! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 11/22/2001 11:00'! formulateFlapsMenu: aMenu "Fill aMenu with appropriate content" aMenu addTitle: 'flaps'. aMenu addStayUpItem. Preferences classicNavigatorEnabled ifTrue: [aMenu addUpdating: #navigatorShowingString enablementSelector: #enableProjectNavigator target: Preferences selector: #togglePreference: argumentList: #(showProjectNavigator). aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString]. Flaps sharedFlapsAllowed ifTrue: [self fillIn: aMenu from: {{#suppressFlapsString. {CurrentProjectRefactoring. #currentToggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}}. aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #togglePreference: argumentList: #(automaticFlapLayout). aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString. aMenu addLine. Flaps addIndividualGlobalFlapItemsTo: aMenu]. self fillIn: aMenu from: { nil. {'make a new flap'. {Flaps. #addLocalFlap}. 'Create a new flap. You can later make it into a shared flap is you wish.'}. nil.}. Flaps sharedFlapsAllowed ifTrue: [aMenu addWithLabel: 'put shared flaps on bottom' enablementSelector: #showSharedFlaps target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen'. self fillIn: aMenu from: { {'destroy all shared flaps'. {Flaps. #disableGlobalFlaps}. 'Destroy all the shared flaps and disable their use in all projects.'}}] ifFalse: [aMenu add: 'install default shared flaps' target: Flaps action: #enableGlobalFlaps. aMenu balloonTextForLastItem: 'Create the default set of shared flaps'. aMenu addLine]. self fillIn: aMenu from: { nil. {'about flaps...'. {Flaps . #explainFlaps}. 'Gives a window full of details about how to use flaps.'}}! ! "Postscript:" (Preferences preferenceAt: #showProjectNavigator ifAbsent: [nil]) ifNotNilDo: [:pref | pref instVarNamed: 'helpString' put: 'showProjectNavigator: If true, then show a project navigator control partly off the bottom of the screen. Suppressed if the ''classicNavigatorEnabled'' preference is false']. Flaps makeNavigatorFlapResembleGoldenBar.!