'From Squeak3.1alpha of 28 February 2001 [latest update: #3989] on 7 May 2001 at 1:21:59 pm'! "Change Set: flapRefactor-sw Date: 7 May 2001 Author: Scott Wallace A refactoring and cleanup of flaps. ¥ Flap-related code formerly in class Utilities is now factored out into a class called Flaps, and flap-related classes are gathered together in their own system category, 'Morphic-Flaps'. ¥ Menu items relating to flaps are factored out into a separate 'flaps' menu, which shows the status of all existing shared flaps, and as such subsumes the former 'which global flap...' menu. ¥ The show/hide-tabs command on the nav-bar is now synonymous with the corresponding command in the Flaps menu, and it functions as a first-class Preference, which can, at user option, be maintained on a system-wide basis or on a per-project basis. ¥ Control over the Stack Tools and Painting flaps now is exercised in a manner uniform with the other shared flaps. ¥ Instead of storing a list of locally-disabled shared flaps in the project parameters, a list of their names (the name seen in the halo of the flapTab) is stored. This clears up problems encountered when the list of actual flaps went out onto image segments, etc. ¥ When you launch a new flap, a menu for it is launched at the same time, so that you can immediately start changing its wording, etc. ¥ (as an aside... Assures presence of bulletproofed version of ControlManager.controllersSatisfying:, which was missing from images updated before update 3930 was hand-patched.)"! ReferenceMorph subclass: #FlapTab instanceVariableNames: 'flapShowing edgeToAdhereTo slidesOtherObjects popOutOnDragOver popOutOnMouseOver inboard dragged lastReferentThickness ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Flaps'! Object subclass: #Flaps instanceVariableNames: '' classVariableNames: 'SharedFlapTabs SharedFlapsAllowed ' poolDictionaries: '' category: 'Morphic-Flaps'! MenuMorph subclass: #UpdatingMenuMorph instanceVariableNames: 'updater updateSelector ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus'! FlapTab subclass: #ViewerFlapTab instanceVariableNames: 'scriptedPlayer ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Flaps'! !ControlManager methodsFor: 'accessing' stamp: 'sw 5/4/2001 23:20'! controllersSatisfying: aBlock "Return a list of scheduled controllers satisfying aBlock" ^ (scheduledControllers ifNil: [^ #()]) select: [:aController | (aBlock value: aController) == true]! ! !CurrentProjectRefactoring class methodsFor: 'as yet unclassified' stamp: 'sw 5/4/2001 23:22'! showSharedFlaps "Answer whether shared flaps are currently showing (true) or suppressed (false). The CurrentProjectRefactoring circumlocution is in service of making it possible for shared flaps to appear on the edges of an interior subworld, I believe." ^ self xxxCurrent showSharedFlaps! ! !CurrentProjectRefactoring class methodsFor: 'as yet unclassified' stamp: 'sw 5/5/2001 02:57'! suppressFlapsString "Answer a string characterizing whether flaps are suppressed at the moment or not" ^ self currentFlapsSuppressed ifFalse: ['show shared tabs'] ifTrue: ['show shared tabs']! ! !FlapTab methodsFor: 'initialization' stamp: 'sw 4/30/2001 18:50'! provideDefaultFlapIDBasedOn: aStem "Provide the receiver with a default flap id" | aNumber usedIDs anID | aNumber _ 0. usedIDs _ FlapTab allSubInstances select: [:f | f ~~ self] thenCollect: [:f | f flapIDOrNil]. anID _ aStem. [usedIDs includes: anID] whileTrue: [aNumber _ aNumber + 1. anID _ aStem, (aNumber asString)]. self flapID: anID! ! !FlapTab methodsFor: 'access' stamp: 'sw 4/30/2001 18:43'! acquirePlausibleFlapID "Give the receiver a flapID that is globally unique; try to hit the mark vis a vis the standard system flap id's, for the case when this method is invoked as part of the one-time transition" | wording | wording _ self wording. (wording isEmpty or: [wording = '---']) ifTrue: [wording _ 'Flap']. ^ self provideDefaultFlapIDBasedOn: wording! ! !FlapTab methodsFor: 'access' stamp: 'sw 4/30/2001 18:39'! flapID "Answer the receiver's flapID, creating it if necessary" ^ self knownName ifNil: [self acquirePlausibleFlapID]! ! !FlapTab methodsFor: 'access' stamp: 'sw 4/30/2001 18:39'! flapID: anID "Set the receiver's flapID" self setNameTo: anID! ! !FlapTab methodsFor: 'access' stamp: 'sw 5/4/2001 23:25'! flapIDOrNil "If the receiver has a flapID, answer it, else answer nil" ^ self knownName! ! !FlapTab methodsFor: 'menu' stamp: 'sw 4/24/2001 10:47'! addCustomMenuItems: aMenu hand: aHandMorph "Add further items to the menu as appropriate" aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo. aMenu addLine. aMenu addUpdating: #textualTabString action: #textualTab. aMenu addUpdating: #graphicalTabString action: #graphicalTab. aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab. aMenu addLine. (referent isKindOf: PasteUpMorph) ifTrue: [aMenu addUpdating: #partsBinString action: #togglePartsBinMode]. aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior. aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior. aMenu addLine. aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap. aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,'. aMenu addLine. aMenu add: 'destroy this flap' action: #destroyFlap. "aMenu addUpdating: #slideString action: #toggleSlideBehavior. aMenu addUpdating: #inboardString action: #toggleInboardness. aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness." ! ! !FlapTab methodsFor: 'menu' stamp: 'sw 4/30/2001 18:49'! destroyFlap "Destroy the receiver" | reply request | request _ self isGlobalFlap ifTrue: ['Caution -- this would permanently remove this flap, so it would no longer be available in this or any other project. Do you really want to this? '] ifFalse: ['Caution -- this is permanent!! Do you really want to do this? ']. reply _ self confirm: request orCancel: [^ self]. reply ifTrue: [self isGlobalFlap ifTrue: [Flaps removeFlapTab: self keepInList: false. self currentWorld reformulateUpdatingMenus] ifFalse: [referent isInWorld ifTrue: [referent delete]. self delete]]! ! !FlapTab methodsFor: 'menu' stamp: 'sw 4/24/2001 11:04'! sharedFlapsAllowed "Answer (for the benefit of a menu item for which I am the target) whether the system presently allows shared flaps" ^ Flaps sharedFlapsAllowed! ! !FlapTab methodsFor: 'textual tabs' stamp: 'sw 4/17/2001 12:13'! changeTabText "Allow the user to change the text on the tab" | reply | reply _ FillInTheBlank request: 'new wording for this tab:' initialAnswer: self existingWording. reply isEmptyOrNil ifTrue: [^ self]. self useStringTab: reply. submorphs first delete. self assumeString: reply font: Preferences standardFlapFont orientation: (Flaps orientationForEdge: edgeToAdhereTo) color: nil! ! !FlapTab methodsFor: 'globalness' stamp: 'sw 5/4/2001 23:25'! isGlobalFlap "Answer whether the receiver is currently a shared flap" ^ Flaps globalFlapTabsIfAny includes: self! ! !FlapTab methodsFor: 'globalness' stamp: 'sw 5/4/2001 23:26'! isGlobalFlapString "Answer a string to construct a menu item representing control over whether the receiver is or is not a shared flap" ^ (self isGlobalFlap ifTrue: [''] ifFalse: ['']), 'shared by all projects'! ! !FlapTab methodsFor: 'globalness' stamp: 'sw 4/30/2001 18:52'! toggleIsGlobalFlap "Toggle whether the receiver is currently a global flap or not" | oldWorld | self hideFlap. oldWorld _ self currentWorld. self isGlobalFlap ifTrue: [Flaps removeFromGlobalFlapTabList: self. oldWorld addMorphFront: self] ifFalse: [self delete. Flaps addGlobalFlap: self. self currentWorld addGlobalFlaps]. ActiveWorld reformulateUpdatingMenus ! ! !FlapTab methodsFor: 'miscellaneous' stamp: 'sw 5/4/2001 23:23'! balloonTextForFlapsMenu "Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project" | id | id _ self flapID. #( ('Squeak' 'A flap with various generally-useful controls for updating the system, navigating among projects, etc.') ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.') ('Supplies' 'A source for many basic types of objects') ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and rather undocumented') ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do: [:pair | id = pair first ifTrue: [^ pair second]]. ^ self balloonText! ! !FlapTab methodsFor: 'fileIn/out' stamp: 'sw 5/4/2001 23:27'! objectForDataStream: refStrm "I am about to be written on an object file. If I am a global flap, write a proxy instead." | dp | self isGlobalFlap ifTrue: [dp _ DiskProxy global: #Flaps selector: #globalFlapTabOrDummy: args: {self flapID}. refStrm replace: self with: dp. ^ dp]. ^ super objectForDataStream: refStrm! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 5/5/2001 00:08'! grabStateFromUtilities "Transitional -- given that the user's system still has the old Utilities-based global flaps, do our best to bootstrap from that" | existing | (existing _ Utilities globalFlapTabsIfAny) isEmptyOrNil ifTrue: [SharedFlapsAllowed _ false. SharedFlapTabs _ nil] ifFalse: [SharedFlapsAllowed _ true. SharedFlapTabs _ existing. existing do: [:aFlapTab | aFlapTab acquirePlausibleFlapID]]! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 4/17/2001 13:24'! orientationForEdge: anEdge "Answer the orientation -- #horizontal or #vertical -- that corresponds to the edge symbol" ^ (#(left right) includes: anEdge) ifTrue: [#vertical] ifFalse: [#horizontal]! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 4/17/2001 13:24'! paintFlapButton "Answer a button to serve as the paint flap" | pb oldArgs brush myButton m | pb _ PaintBoxMorph new submorphNamed: #paint:. pb ifNil: [(brush _ Form extent: 16@16 depth: 16) fillColor: Color red] ifNotNil: [oldArgs _ pb arguments. brush _ oldArgs third. brush _ brush copy: (2@0 extent: 42@38). brush _ brush scaledToSize: brush extent // 2]. myButton _ BorderedMorph new. myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderWidth: 2; borderColor: #raised. myButton addMorph: (m _ brush asMorph lock). myButton extent: m extent + (myButton borderWidth + 6). m position: myButton center - (m extent // 2). ^ myButton ! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 11/6/2000 14:23'! removeFromGlobalFlapTabList: aFlapTab "If the flap tab is in the global list, remove it" SharedFlapTabs remove: aFlapTab ifAbsent: []! ! !Flaps class methodsFor: 'flap mechanics' stamp: 'sw 2/16/1999 18:29'! clobberFlapTabList "Flaps clobberFlapTabList" SharedFlapTabs _ nil! ! !Flaps class methodsFor: 'flap mechanics' stamp: 'sw 4/30/2001 19:05'! reinstateDefaultFlaps "Get a fresh start with flaps -- remove all existing ones in the world, clear the global list, and reinitialize the standard flaps. To be called by doits in updates etc. This is a radical step, which is destructive of pre-existing flap content." "Flaps reinstateDefaultFlaps" self currentWorld deleteAllFlapArtifacts. self clobberFlapTabList. self initializeStandardFlaps. self disableGlobalFlapWithID: 'Painting'. self disableGlobalFlapWithID: 'Stack Tools'. self currentWorld addGlobalFlaps ! ! !Flaps class methodsFor: 'flap mechanics' stamp: 'sw 4/17/2001 14:47'! removeFlapTab: aFlapTab keepInList: aBoolean "Remove the given flap tab from the screen, and, if aBoolean is true, also from the global list" (SharedFlapTabs ~~ nil and: [SharedFlapTabs includes: aFlapTab]) ifTrue: [aBoolean ifFalse: [self removeFromGlobalFlapTabList: aFlapTab]]. aFlapTab ifNotNil: [aFlapTab referent delete. aFlapTab delete]! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 4/17/2001 13:31'! addGlobalFlap: aFlapTab "Add the given flap tab to the list of shared flaps" SharedFlapTabs ifNil: [SharedFlapTabs _ OrderedCollection new]. SharedFlapTabs add: aFlapTab! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 4/27/2001 16:34'! globalFlapTab: aName "Answer the global flap tab in the current system whose flapID is the same as aName, or nil if none found." | idToMatch | idToMatch _ (aName beginsWith: 'flap: ') ifTrue: "Ted's old scheme; this convention may still be found in pre-existing content that has been externalized" [aName copyFrom: 7 to: aName size] ifFalse: [aName]. ^ self globalFlapTabsIfAny detect: [:ft | ft flapID = idToMatch] ifNone: [nil]! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 4/27/2001 16:36'! globalFlapTabOrDummy: aName "Answer a global flap tab in the current image with the given name. If none is found, answer a dummy StringMorph for some reason (check with tk about the use of this)" | gg | (gg _ self globalFlapTab: aName) ifNil: [^ StringMorph contents: aName, ' can''t be found']. ^ gg! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 4/17/2001 09:44'! globalFlapTabWithID: aFlapID "answer the global flap tab with the given id, or nil if none" ^ self globalFlapTabsIfAny detect: [:aFlapTab | aFlapTab flapID = aFlapID] ifNone: [nil]! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 5/5/2001 02:41'! globalFlapTabs "Answer the list of shared flap tabs, creating it if necessary. Much less aggressive is #globalFlapTabsIfAny" SharedFlapTabs ifNil: [self initializeStandardFlaps]. ^ SharedFlapTabs copy! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 4/23/2001 18:04'! globalFlapTabsIfAny "Answer a list of the global flap tabs, but it they don't exist, just answer an empty list" ^ SharedFlapTabs copy ifNil: [Array new]! ! !Flaps class methodsFor: 'shared flaps' stamp: 'sw 4/24/2001 11:17'! sharedFlapsAllowed "Answer whether the shared flaps feature is allowed in this system" ^ SharedFlapsAllowed ifNil: [SharedFlapsAllowed _ SharedFlapTabs isEmptyOrNil not]! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 4/24/2001 11:03'! addIndividualGlobalFlapItemsTo: aMenu "Add items governing the enablement of specific global flaps to aMenu" | anItem | self globalFlapTabsIfAny do: [:aFlapTab | anItem _ aMenu addUpdating: #globalFlapWithIDEnabledString: enablementSelector: #showSharedFlaps target: self selector: #enableDisableGlobalFlapWithID: argumentList: {aFlapTab flapID}. anItem wordingArgument: aFlapTab flapID. anItem setBalloonText: aFlapTab balloonTextForFlapsMenu].! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 4/24/2001 10:57'! empowerSuppliesFlapOnly "Set up with only a Supplies flap -- for use with the plug-in launcher. SharedFlapTabs assumed to be nil coming in" self addGlobalFlap: self newSuppliesFlap! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 4/24/2001 10:49'! 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. ActiveWorld reformulateUpdatingMenus]]! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 4/17/2001 13:50'! globalFlapWithIDEnabledString: aFlapID "Answer the string to be shown in a menu to represent the status of the givne flap regarding whether it it should be shown in this project." | aFlapTab wording | aFlapTab _ self globalFlapTabWithID: aFlapID. wording _ aFlapTab ifNotNil: [aFlapTab wording] ifNil: ['(', aFlapID, ')']. ^ (Project current isFlapIDEnabled: aFlapID) ifTrue: ['', wording] ifFalse: ['', wording]! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 5/4/2001 23:14'! showSharedFlaps "Answer whether shared flaps are currently showing. Presumably it is in service of Alan's wishes to have flaps show sometimes on interior subprojects and sometomes on outer projects that Bob's CurrentProjectRefactoring is threaded into the logic here." ^ CurrentProjectRefactoring showSharedFlaps! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 5/5/2001 03:01'! suppressFlapsString "Answer the string to be shown in a menu to represent the suppress-flaps-in-this-project status" ^ CurrentProjectRefactoring suppressFlapsString! ! !Flaps class methodsFor: 'menu commands' stamp: 'sw 5/7/2001 13:15'! disableGlobalFlapWithID: aFlapID "Mark this project as having the given flapID disabled" | 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) ifFalse: [disabledFlapIDs add: aFlapID]. aFlapTab ifNotNil: [aFlapTab delete] ! ! !Flaps class methodsFor: 'menu commands' stamp: 'sw 5/5/2001 02:12'! disableGlobalFlaps "Clobber all the shared flaps structures. First read the user her Miranda rights." (self confirm: 'CAUTION!! This will destroy all the shared flaps, so that they will not be present in *any* project. If, later, you want them back, you will have to reenable them, from this same menu, whereupon the standard default set of shared flaps will be created. Do you really want to go ahead and clobber all shared flaps at this time?') ifFalse: [^ self]. self globalFlapTabsIfAny do: [:aFlapTab | self removeFlapTab: aFlapTab keepInList: false. aFlapTab isInWorld ifTrue: [self error: 'Flap problem']]. self clobberFlapTabList. SharedFlapsAllowed _ false. Smalltalk isMorphic ifTrue: [ActiveWorld restoreMorphicDisplay. ActiveWorld reformulateUpdatingMenus]! ! !Flaps class methodsFor: 'menu commands' stamp: 'sw 5/7/2001 13:15'! 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]] ! ! !Flaps class methodsFor: 'menu commands' stamp: 'sw 5/7/2001 13:15'! enableGlobalFlapWithID: aFlapID "Remove any memory of this flap being disabled in this project" | disabledFlapIDs currentProject | (currentProject _ Project current) assureFlapIntegrity. Smalltalk isMorphic ifFalse: [^ self]. disabledFlapIDs _ currentProject parameterAt: #disabledGlobalFlapIDs ifAbsent: [^ self]. disabledFlapIDs remove: aFlapID ifAbsent: [] ! ! !Flaps class methodsFor: 'menu commands' stamp: 'sw 4/25/2001 01:46'! explainFlaps "Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below. 'Shared flaps' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps. To get started using flaps, bring up the desktop menu and choose 'flaps...', and make the menu stay up by choosing 'keep this menu up'. If you see, in this flaps menu, a list of flap names such as 'Squeak', 'Tools', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to 'install default shared flaps'; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence. 'Project flaps' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project. If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it. If a flap is *not* set up as a parts bin (such as the default 'Squeak' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default 'Squeak' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs. Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options. You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen. Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area. If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu. The red-halo menu on a flap allows you to change the flap's properties. For greatest ease of use, request 'keep this menu up' here -- that way, you can easily explore all the options in the menu. tab color... Lets you change the color of the flap's tab. flap color... Lets you change the color of the flap itself. use textual tab... If the tab is not textual, makes it become textual. change tab wording... If the tab is already textual, allows you to edit its wording. use graphical tab... If the tab is not graphical, makes it become graphical. choose tab graphic... If the tab is already graphical, allows you to change the picture. use solid tab... If the tab is not solid, makes it become solid, i.e. appear as a solid band of color along the entire length or width of the screen. parts-bin behavior If set, then dragging an object from the flap tears off a new copy of the object. dragover If set, the flap opens on dragover and closes again on drag-leave. mouseover If set, the flap opens on mouseover and closes again on mouse-leave. cling to edge... Governs which edge (left, right, top, bottom) the flap adheres to. shared If set, the same flap will be available in all projects; if not, the flap will will occur only in one project. destroy this flap Deletes the flap. To define a new flap, use 'make a new flap', found in the 'flaps' menu. To reinstate the default system flaps, you can use 'destroy all shared flaps' from the 'flaps' menu, and once they are destroyed, choose 'install default shared flaps'. To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it. Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the 'flaps' menu -- one is called 'Stack Tools', which provides some tools useful for building stack-like content, the other is called 'Painting', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the 'flaps' menu will toggle the corresponding flap between being visible and not being visible in the project." "Open a window giving flap help." (StringHolder new contents: (self class firstCommentAt: #explainFlaps)) openLabel: 'Flaps' "Flaps explainFlaps" ! ! !Flaps class methodsFor: 'new flap' stamp: 'sw 5/5/2001 00:00'! addLocalFlap "Menu command -- let the user add a new project-local flap. Once the new flap is born, the user can tell it to become a shared flap. Obtain an initial name and edge for the flap, launch the flap, and also launch a menu governing the flap, so that the user can get started right away with customizing it." | aMenu reply aFlapTab aWorld edge | aMenu _ MVCMenuMorph entitled: 'Where should the new flap cling?'. aMenu defaultTarget: aMenu. #(left right top bottom) do: [:sym | aMenu add: sym selector: #selectMVCItem: argument: sym]. edge _ aMenu invokeAt: self currentHand position in: self currentWorld. edge ifNotNil: [reply _ FillInTheBlank request: 'Wording for this flap: ' initialAnswer: 'Flap'. reply isEmptyOrNil ifFalse: [aFlapTab _ self newFlapTitled: reply onEdge: edge. (aWorld _ self currentWorld) addMorphFront: aFlapTab. aFlapTab adaptToWorld: aWorld. aMenu _ aFlapTab buildHandleMenu: ActiveHand. aFlapTab addTitleForHaloMenu: aMenu. aMenu popUpEvent: ActiveEvent in: ActiveWorld]] ! ! !Flaps class methodsFor: 'new flap' stamp: 'sw 5/4/2001 23:59'! defaultColorForFlapBackgrounds "Answer the color to use, by default, in new flap backgrounds" ^ (Color blue mixed: 0.8 with: Color white) alpha: 0.6! ! !Flaps class methodsFor: 'new flap' stamp: 'sw 4/17/2001 13:24'! newFlapTitled: aString onEdge: anEdge "Create a new flap with the given title and place it on the given edge" ^ self newFlapTitled: aString onEdge: anEdge inPasteUp: self currentWorld ! ! !Flaps class methodsFor: 'new flap' stamp: 'sw 5/5/2001 00:12'! newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph "Add a flap with the given title, placing it on the given edge, in the given pasteup" | aFlapBody aFlapTab orientation | aFlapBody _ PasteUpMorph newSticky. aFlapTab _ FlapTab new referent: aFlapBody. orientation _ (#(left right) includes: anEdge) ifTrue: [#vertical] ifFalse: [#horizontal]. aFlapTab assumeString: aString font: Preferences standardFlapFont orientation: orientation color: (Color r: 0.516 g: 0.452 b: 1.0). aFlapTab edgeToAdhereTo: anEdge; inboard: false. anEdge == #left ifTrue: [aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top). aFlapBody extent: (200 @ aPasteUpMorph height)]. anEdge == #right ifTrue: [aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top). aFlapBody extent: (200 @ aPasteUpMorph height)]. anEdge == #top ifTrue: [aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top). aFlapBody extent: (aPasteUpMorph width @ 200)]. anEdge == #bottom ifTrue: [aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)). aFlapBody extent: (aPasteUpMorph width @ 200)]. aFlapBody beFlap: true. aFlapBody color: self defaultColorForFlapBackgrounds. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 4/30/2001 18:56'! addNewDefaultSharedFlaps "Add the stack tools flap and the painting flap to the global list, but do not have them showing initially. Transitional, called by the postscript of the flaps-refactoring update; probably dispensable afterwards." SharedFlapTabs ifNotNil: [SharedFlapTabs add: self newStackToolsFlap delete. SharedFlapTabs add: self newPaintingFlap delete. self disableGlobalFlapWithID: 'Stack Tools'. self disableGlobalFlapWithID: 'Painting']! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 4/30/2001 19:02'! initializeStandardFlaps "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed." SharedFlapTabs _ OrderedCollection new. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newStackToolsFlap delete. SharedFlapTabs add: self newPaintingFlap delete. self enableGlobalFlapWithID: 'Squeak'. self enableGlobalFlapWithID: 'Supplies'. self enableGlobalFlapWithID: 'Tools'. self disableGlobalFlapWithID: 'Stack Tools'. self disableGlobalFlapWithID: 'Painting'. SharedFlapTabs do: [:aFlapTab | aFlapTab setToPopOutOnMouseOver: false]. "The above amends some historic behavior imparted by the initializers of the individual flaps" ^ SharedFlapTabs "Flaps reinstateDefaultFlaps"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 4/30/2001 19:02'! newPaintingFlap "Add a flap with the paint palette in it" | aFlap aFlapTab | "Flaps reinstateDefaultFlaps. Flaps addPaintingFlap" aFlap _ PasteUpMorph new borderWidth: 0. aFlap color: Color transparent. aFlap layoutPolicy: TableLayout new. aFlap hResizing: #shrinkWrap. aFlap vResizing: #shrinkWrap. aFlap cellPositioning: #topLeft. aFlap clipSubmorphs: false. aFlap beSticky. "really?!!" aFlap addMorphFront: PaintBoxMorph new. aFlap setProperty: #flap toValue: true. aFlap fullBounds. "force layout" aFlapTab _ FlapTab new referent: aFlap. aFlapTab setNameTo: 'Painting'. aFlapTab setProperty: #priorWording toValue: 'Paint'. aFlapTab useGraphicalTab. aFlapTab removeAllMorphs. aFlapTab setProperty: #paintingFlap toValue: true. aFlapTab addMorphFront: "(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))" self paintFlapButton. aFlapTab cornerStyle: #rounded. aFlapTab edgeToAdhereTo: #right. aFlapTab setToPopOutOnDragOver: false. aFlapTab setToPopOutOnMouseOver: false. aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab. aFlapTab setBalloonText:'Click here to start or finish painting.'. aFlapTab fullBounds. "force layout" aFlapTab position: (0@6). self currentWorld addMorphFront: aFlapTab. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 5/5/2001 00:14'! newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb | aFlap _ PasteUpMorph newSticky borderWidth: 0. aFlapTab _ FlapTab new referent: aFlap. aFlapTab setNameTo: 'Squeak'. aFlapTab assumeString: 'Squeak' font: Preferences standardFlapFont orientation: #vertical color: Color brown lighter lighter. aFlapTab edgeToAdhereTo: #left; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: true. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 200 @ self currentWorld height. self addProjectNavigationButtonsTo: aFlap. anOffset _ 16. buttonColor _ Color green muchLighter. bb _ SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton _ bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.'. aButton label: 'snapshot'. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton _ bb copy target: Flaps. aButton actionSelector: #fileOutChanges. aButton label: 'file out changes'. aButton setBalloonText: 'File out the current change set to disk.'. aFlap addMorph: aButton. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton _ bb copy target: Flaps. aButton actionSelector: #browseRecentSubmissions. aButton setBalloonText: 'Open a message-list browser showing the 20 most-recently-submitted methods.'. aButton label: 'recent submissions'. aFlap addCenteredAtBottom: aButton offset: anOffset. aClock _ ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.'. aFlap addCenteredAtBottom: aClock offset: anOffset. aButton _ bb copy target: Preferences. aButton actionSelector: #openPreferencesInspector. aButton setBalloonText: 'Open a window allowing me to view and change various Preferences.'. aButton label: 'preferences...'. aButton color: Color cyan muchLighter. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton _ bb copy target: Utilities. aButton actionSelector: #updateFromServer. aButton label: 'load code updates'. aButton color: Color cyan muchLighter. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.'. aFlap addCenteredAtBottom: aButton offset: anOffset. self addSystemStatusLinesTo: aFlap. aButton _ TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab "Flaps reinstateDefaultFlaps"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 5/5/2001 00:22'! newStackToolsFlap "Add a flap with stack tools in it" | aFlap aFlapTab aTextMorph aSketch aMorph | aFlap _ self newPartsFlapPage beSticky. aFlap setProperty: #maximumThumbnailWidth toValue: 80. aFlap setProperty: #flap toValue: true. aFlap color: (Color green muchLighter lighter alpha: 0.3). aFlapTab _ FlapTab new referent: aFlap. aFlapTab setNameTo: 'Stack Tools'. aFlapTab assumeString: 'Stack Tools' font: Preferences standardFlapFont orientation: #horizontal color: Color brown lighter lighter. aFlapTab edgeToAdhereTo: #bottom; inboard: false. aFlapTab setToPopOutOnDragOver: false. aFlapTab setToPopOutOnMouseOver: false. aFlap addMorphBack: StackMorph authoringPrototype. aTextMorph _ TextMorph authoringPrototype. aTextMorph contents: 'background label' asText. aTextMorph beAllFont: (StrikeFont familyName: #NewYork size: 18). aTextMorph color: Color brown. aTextMorph setProperty: #shared toValue: true. aFlap addMorphBack: aTextMorph. "Ted's fields, maybe good point of departure... aTextMorph _ TextFieldMorph authoringPrototype. aTextMorph setProperty: #shared toValue: true. aFlap addMorphBack: aTextMorph." aFlap addMorphBack: ScriptableButton authoringPrototype markAsPartsDonor beSticky. "NB: Here is where we will put the prototype(s) for background/foreground fields; for the moment, vanilla TextMorphs are used, with the scrolling PTMWM temporarily commented out pending some more work. A successor to Ted's TextFieldMorph, or some new kind of carefully-thought-through morph that will generally serve the community as the archetypal 'Field', is ultimately needed" #(TextMorph "PluggableTextMorphWithModel" TextFieldMorph ) do: [:sym | aMorph _ (Smalltalk at: sym) authoringPrototype. aMorph contents: 'background field' asText allBold. aMorph setProperty: #shared toValue: true. aMorph setNameTo: (sym == #TextMorph ifTrue: ['field1'] ifFalse: ['scrollingField1']). aMorph setProperty: #holdsSeparateDataForEachInstance toValue: true. aFlap addMorphBack: aMorph]. "aFlap addMorphBack: ScriptableListMorph authoringPrototype beSticky -- SOON!!" #(CedarPic) do: [:sym | aSketch _ SketchMorph newSticky form: ((ScriptingSystem formAtKey: sym) ifNil: [ScriptingSystem formAtKey: #squeakyMouse]). aSketch setProperty: #shared toValue: true. aSketch setProperty: #holdsSeparateDataForEachInstance toValue: true. aFlap addMorphBack: aSketch]. "aCardReference _ CardReference authoringProtoype beSticky. aCardReference card: Card new. " aFlap addMorphBack: StackMorph previousCardButton markAsPartsDonor. aFlap addMorphBack: StackMorph nextCardButton markAsPartsDonor. #( PaintInvokingMorph "ImageMorph RectangleMorph EllipseMorph StarMorph CurveMorph PolygonMorph SimpleSliderMorph") do: [:sym | aFlap addMorphBack: (Smalltalk at: sym) authoringPrototype]. aFlap addMorphBack: TrashCanMorph new markAsPartsDonor. aFlap addMorphBack: ScriptingSystem scriptControlButtons markAsPartsDonor. aFlap replaceTallSubmorphsByThumbnails. aFlapTab position: ((2 * (self currentWorld width // 3)) @ (self currentWorld height - aFlapTab height)). aFlap setProperty: #flap toValue: true. aFlap color: (Color red muchLighter "alpha: 0.2"). aFlap extent: self currentWorld width @ 100. self currentWorld addMorphFront: aFlapTab. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 4/30/2001 19:04'! newSuppliesFlap "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen" | aFlapTab aPage | aPage _ self newPartsFlapPage. aPage setProperty: #maximumThumbnailWidth toValue: 80. aFlapTab _ FlapTab new referent: aPage beSticky. aFlapTab setNameTo: 'Supplies'. aFlapTab color: Color red lighter. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: true. aFlapTab assumeString: 'Supplies' font: Preferences standardFlapFont orientation: #horizontal color: Color red lighter. aFlapTab edgeToAdhereTo: #bottom; inboard: false. aPage extent: self currentWorld width @ 100. aPage addMorphBack: Command undoRedoButtons markAsPartsDonor. aPage addMorphBack: TrashCanMorph new markAsPartsDonor. aPage addMorphBack: ScriptingSystem scriptControlButtons markAsPartsDonor. #(PaintInvokingMorph RectangleMorph EllipseMorph StarMorph CurveMorph PolygonMorph TextMorph ) do: [:sym | aPage addMorphBack: (Smalltalk at: sym) authoringPrototype]. aPage addMorphBack: ScriptingSystem prototypicalHolder. aPage addMorphBack: RectangleMorph roundRectPrototype. #(ImageMorph ScriptableButton SimpleSliderMorph PasteUpMorph BookMorph TabbedPalette JoystickMorph ) do: [:sym | aPage addMorphBack: (Smalltalk at: sym) authoringPrototype]. aPage addMorphBack: Morph new previousPageButton markAsPartsDonor. aPage addMorphBack: Morph new nextPageButton markAsPartsDonor. aPage addMorphBack: ScriptingSystem holderWithAlphabet markAsPartsDonor. aPage addMorphBack: (ClockMorph authoringPrototype showSeconds: false) step. aPage replaceTallSubmorphsByThumbnails. aFlapTab position: ((Display width - aFlapTab width) // 2 @ (self currentWorld height - aFlapTab height)). aPage beFlap: true. aPage color: (Color red muchLighter "alpha: 0.2"). aPage extent: self currentWorld width @ 100. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 4/30/2001 19:04'! newToolsFlap "Answer a newly-created flap which adheres to the right edge of the screen and which holds prototypes of standard tools" | aFlapTab aPage | aPage _ self newPartsFlapPage. aFlapTab _ FlapTab new referent: aPage beSticky. aFlapTab setNameTo: 'Tools'. aFlapTab color: Color red lighter. aFlapTab assumeString: 'Tools' font: Preferences standardFlapFont orientation: #vertical color: Color orange lighter. aFlapTab edgeToAdhereTo: #right; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: false. aPage extent: (90 @ self currentWorld height). Utilities addSampleWindowsTo: aPage. aPage addMorphBack: ScriptingSystem newScriptingSpace. aPage addMorphBack: RecordingControlsMorph authoringPrototype. aPage replaceTallSubmorphsByThumbnails. "This hard-coded list is regrettable but expedient" #('System Browser' 'Package-Pane Browser' 'Workspace' 'File List' 'Dual Change Sorter' 'Single Change Sorter' 'Selector Browser' 'Assembly Area' 'Scripting Area' 'Sound Recorder') doWithIndex: [:help :index | (aPage submorphs at: index) setBalloonText: help]. aFlapTab position: (self currentWorld width - aFlapTab width) @ ((Display height - aFlapTab height) // 2). aPage beFlap: true. aPage color: (Color brown muchLighter alpha: 0.5). aPage extent: (90 @ self currentWorld height). ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 4/30/2001 20:49'! toolsFlapTab "Answer the tab that represents the shared tools flap, or nil if none." ^ self globalFlapTabWithID: 'Tools'! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 5/4/2001 23:52'! addMorph: aMorph asElementNumber: aNumber inGlobalFlapSatisfying: flapBlock "If any global flap satisfies flapBlock, add aMorph to it at the given position. Applies to flaps that are parts bins and that like thumbnailing" | aFlapTab flapPasteUp | aFlapTab _ self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. flapPasteUp _ aFlapTab referent. flapPasteUp addMorph: aMorph asElementNumber: aNumber. flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 5/4/2001 23:52'! addMorph: aMorph asElementNumber: aNumber inGlobalFlapWithID: anID "If any global flap satisfies flapBlock, add aMorph to it at the given position. No senders in the image -- intended to be invoked by doits in code updates only, and applies to flaps that are parts bins and that like thumbnailing" ^ self addMorph: aMorph asElementNumber: aNumber inGlobalFlapSatisfying: [:aFlap | aFlap flapID = anID]! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 5/4/2001 23:54'! addProjectNavigationButtonsTo: aMorph "Add prev, next, and go-to buttons at the top of aMorph. This is used to create the buttons at the top of the Squeak flap" | aButton aFont bb | bb _ SimpleButtonMorph new target: Project. bb actionSelector: #returnToPreviousProject. bb beTransparent. aFont _ StrikeFont familyName: #ComicBold size: 24. aButton _ SimpleButtonMorph new target: Project. aButton actionSelector: #returnToPreviousProject. aButton beTransparent. aButton label: '<' font: aFont; borderWidth: 0. aButton firstSubmorph color: Color red lighter. aButton position: 30 @ 12. aButton setBalloonText: 'previous project'. aMorph addMorph: aButton. aButton _ SimpleButtonMorph new target: Project. aButton actionSelector: #advanceToNextProject. aButton beTransparent. aButton label: '>' font: aFont; borderWidth: 0. aButton firstSubmorph color: Color red lighter. aButton position: 150 @ 14. aButton setBalloonText: 'next project'. aMorph addMorph: aButton. aButton _ SimpleButtonMorph new target: Project. aButton actWhen: #buttonDown. aButton actionSelector: #jumpToProject. aButton beTransparent. aButton label: 'Go...' font: (StrikeFont familyName: #ComicBold size: 19); borderWidth: 0. aButton position: 78 @ 16. aButton firstSubmorph color: Color red lighter. aButton setBalloonText: 'go directly to a project'. aMorph addMorph: aButton! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 2/8/2001 14:33'! addSystemStatusLinesTo: aPlayfield "Add system status info. In this version, we just add a button which can be called to deliver up status information on demand" | aButton | aButton _ SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; label: 'about this system'. aButton color: Color cyan muchLighter. aButton setBalloonText: 'click here to find out version information'. aPlayfield addCenteredAtBottom: aButton offset: 16.! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 4/30/2001 18:57'! addToSuppliesFlap: aMorph asElementNumber: aNumber "Add the given morph to the supplies flap. To be called by doits in updates, so don't be alarmed by its lack of senders." self addMorph: aMorph asElementNumber: aNumber inGlobalFlapWithID: 'Supplies'! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 5/5/2001 02:12'! deleteMorphsSatisfying: deleteBlock fromGlobalFlapSatisfying: flapBlock "If any global flap satisfies flapBlock, then delete objects satisfying from deleteBlock from it. Occasionally called from do-its in updates or other fileouts." | aFlapTab flapPasteUp | aFlapTab _ self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. flapPasteUp _ aFlapTab referent. flapPasteUp submorphs do: [:aMorph | (deleteBlock value: aMorph) ifTrue: [aMorph delete]]! ! !Flaps class methodsFor: 'construction support' stamp: 'sw 4/17/2001 13:20'! newPartsFlapPage "Answer a new page pasteup that will serve as a parts bin in a flap" | aPage | aPage _ PasteUpMorph new borderWidth: 0. aPage color: Color white; padding: 6. aPage autoLineLayout: true. aPage isPartsBin: true. aPage setProperty: #alwaysShowThumbnail toValue: true. ^ aPage! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 4/30/2001 19:06'! replaceBrowserInToolsFlap "Replace the browsers shown in the Tools flap, if any, with updated versions" self replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isMemberOf: Browser]]] inGlobalFlapWithID: 'Tools' with: ((Browser new openAsMorphEditing: nil) applyModelExtent; setLabel: 'System Browser'; setBalloonText: 'System Browser'; yourself). self replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isMemberOf: PackagePaneBrowser]]] inGlobalFlapWithID: 'Tools' with: ((PackagePaneBrowser new openAsMorphEditing: nil) applyModelExtent; setLabel: 'Package Browser'; setBalloonText: 'Package browser'; yourself) "Flaps replaceBrowserInToolsFlap" ! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 4/30/2001 19:06'! replaceChangeSortersInToolsFlap "Get prototypes of the latest versions of the the Change Sorters into the Tools flap. Occasionally called by do-its in fileouts" self replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isMemberOf: ChangeSorter]]] inGlobalFlapWithID: 'Tools' with: (ChangeSorter new morphicWindow applyModelExtent; setBalloonText: 'Single Change Sorter'; yourself). self replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isMemberOf: DualChangeSorter]]] inGlobalFlapWithID: 'Tools' with: (DualChangeSorter new morphicWindow applyModelExtent; setBalloonText: 'Dual Change Sorter'; yourself) ! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 5/3/1999 22:44'! replacePartSatisfying: elementBlock inGlobalFlapSatisfying: flapBlock with: replacement "If any global flap satisfies flapBlock, look in it for a part satisfying elementBlock; if such a part is found, replace it with the replacement morph, make sure the flap's layout is made right, etc." | aFlapTab flapPasteUp anElement | aFlapTab _ self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. flapPasteUp _ aFlapTab referent. anElement _ flapPasteUp submorphs detect: [:aMorph | elementBlock value: aMorph] ifNone: [^ self]. flapPasteUp replaceSubmorph: anElement by: replacement. flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true. "Flaps replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented label = 'scripting area']]] inGlobalFlapSatisfying: [:fl | (fl submorphs size > 0) and: [(fl submorphs first isKindOf: TextMorph) and: [(fl submorphs first contents string copyWithout: Character cr) = 'Tools']]] with: ScriptingSystem newScriptingSpace"! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 4/17/2001 13:15'! replacePartSatisfying: elementBlock inGlobalFlapWithID: aFlapID with: replacement "If a global flapl exists with the given flapID, look in it for a part satisfying elementBlock; if such a part is found, replace it with the replacement morph, make sure the flap's layout is made right, etc." ^ self replacePartSatisfying: elementBlock inGlobalFlapSatisfying: [:fl | fl flapID = aFlapID] with: replacement! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 4/30/2001 20:11'! replaceToolsFlap "if there is a global tools flap, replace it with an updated one." | aFlapTab | aFlapTab _ self toolsFlapTab ifNil: [^ self]. self removeFlapTab: aFlapTab keepInList: false. self addGlobalFlap: self newToolsFlap. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps] "Flaps replaceToolsFlap"! ! !MenuItemMorph methodsFor: 'events' stamp: 'sw 5/5/2001 00:25'! mouseLeave: evt "The mouse has left the interior of the receiver..." owner ifNotNil: [owner stayUp ifFalse: [self mouseLeaveDragging: evt]]! ! !MenuMorph methodsFor: 'construction' stamp: 'sw 4/30/2001 20:15'! addStayUpItem "Append a menu item that can be used to toggle this menu's persistence." self add: (stayUp == true ifTrue: ['dismiss this menu'] ifFalse: ['keep this menu up']) target: self selector: #toggleStayUp: argumentList: EmptyArray. self addLine! ! !MenuMorph methodsFor: 'control' stamp: 'sw 4/24/2001 11:11'! popUpEvent: evt in: aWorld "Present this menu in response to the given event." | aHand aPosition | aHand _ evt ifNotNil: [evt hand] ifNil: [ActiveHand]. aPosition _ aHand position truncated. ^ self popUpAt: aPosition forHand: aHand in: aWorld ! ! !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: 'misc' stamp: 'sw 4/17/2001 12:11'! viewerFlapTabFor: anObject "Open up a Viewer on aMorph in its own flap, creating it if necessary" | bottomMost aPlayer aFlapTab | bottomMost _ self top. aPlayer _ anObject isMorph ifTrue: [anObject assuredPlayer] ifFalse: [anObject objectRepresented]. self flapTabs do: [:aTab | ((aTab isKindOf: ViewerFlapTab) or: [aTab hasProperty: #paintingFlap]) ifTrue: [bottomMost _ aTab bottom max: bottomMost. ((aTab isKindOf: ViewerFlapTab) and: [aTab scriptedPlayer == aPlayer]) ifTrue: [^ aTab]]]. "Not found; make a new one" aFlapTab _ (Flaps newFlapTitled: anObject nameForViewer onEdge: #right inPasteUp: self) as: ViewerFlapTab. aFlapTab initializeFor: aPlayer topAt: bottomMost + 2. aFlapTab referent color: (Color green muchLighter alpha: 0.5). aFlapTab referent borderWidth: 0. aFlapTab referent setProperty: #automaticPhraseExpansion toValue: true. Preferences compactViewerFlaps ifTrue: [aFlapTab makeFlapCompact: true]. self addMorphFront: aFlapTab. aFlapTab adaptToWorld: self. ^ aFlapTab! ! !PasteUpMorph methodsFor: 'flaps' stamp: 'sw 4/30/2001 20:31'! addGlobalFlaps "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps." | use thisWorld | use _ Flaps sharedFlapsAllowed. CurrentProjectRefactoring currentFlapsSuppressed ifTrue: [use _ false]. "Smalltalk isMorphic ifFalse: [use _ false]." thisWorld _ use ifTrue: [self] ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner" WorldState new; bounds: (0@0 extent: 4000@4000); viewBox: (0@0 extent: 4000@4000)]. Flaps globalFlapTabsIfAny do: [:aFlapTab | (CurrentProjectRefactoring isFlapEnabled: aFlapTab) ifTrue: [(aFlapTab world == thisWorld) ifFalse: [thisWorld addMorphFront: aFlapTab. aFlapTab adaptToWorld: thisWorld]. "always do" use ifTrue: [aFlapTab spanWorld. aFlapTab adjustPositionAfterHidingFlap. aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]! ! !PasteUpMorph methodsFor: 'flaps' stamp: 'sw 5/5/2001 00:27'! deleteGlobalFlapArtifacts "Delete all flap-related detritus from the world" | localFlaps | localFlaps _ self localFlapTabs collect: [:m | m referent]. self submorphs do: [:m | ((m isFlapTab) and: [m isGlobalFlap]) ifTrue: [m delete]. m isFlap ifTrue:[(localFlaps includes: m) ifFalse: [m delete]]] "ActiveWorld deleteGlobalFlapArtifacts" ! ! !PasteUpMorph methodsFor: 'flaps' stamp: 'sw 4/17/2001 11:23'! enableGlobalFlaps "Restore saved global flaps, or obtain brand-new system defaults if necessary" Flaps globalFlapTabs. "If nil, creates new ones" self addGlobalFlaps "put them on screen"! ! !PasteUpMorph methodsFor: 'flaps' stamp: 'sw 4/17/2001 11:22'! localFlapTabs "Answer a list of local flap tabs in the current project" | globalList aList aFlapTab | globalList _ Flaps globalFlapTabsIfAny. aList _ OrderedCollection new. submorphs do: [:m | ((m isFlapTab) and: [(globalList includes: m) not]) ifTrue: [aList add: m] ifFalse: [((m isFlap) and: [(aFlapTab _ m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil]) ifTrue: [aList add: aFlapTab]]]. ^ aList! ! !PasteUpMorph methodsFor: 'world state' stamp: 'sw 5/7/2001 13:15'! installFlaps "Get flaps installed within the bounds of the receiver" Project current assureFlapIntegrity. self addGlobalFlaps. self localFlapTabs do: [:aFlapTab | aFlapTab adaptToWorld]. self assureFlapTabsFitOnScreen. self bringFlapTabsToFront! ! !PasteUpMorph methodsFor: 'world state' stamp: 'sw 4/24/2001 10:38'! restoreFlapsDisplay "Restore the display of flaps" (Flaps sharedFlapsAllowed and: [CurrentProjectRefactoring currentFlapsSuppressed not]) ifTrue: [Flaps globalFlapTabs do: [:aFlapTab | aFlapTab adaptToWorld]]. self localFlapTabs do: [:aFlapTab | aFlapTab adaptToWorld]. self assureFlapTabsFitOnScreen. self bringFlapTabsToFront! ! !PopUpMenu class methodsFor: 'class initialization' stamp: 'sw 4/17/2001 13:12'! setMenuFontTo: aFont "Set the menu font as indicated" MenuStyle _ aFont textStyle copy consistOnlyOf: aFont. MenuStyle gridForFont: 1 withLead: 0; centered. self allSubInstancesDo: [:m | m rescan]! ! !Preference methodsFor: 'initialization' stamp: 'sw 4/29/2001 23:51'! categoryList: aList "Set the receiver's categoryList" categoryList _ aList! ! !Preferences class methodsFor: 'add preferences' stamp: 'sw 4/29/2001 23:54'! setCategoryList: aCategoryList forPreferenceNamed: aPreferenceSymbol "Set the category list for the given preference symbol as specified." (self preferenceAt: aPreferenceSymbol ifAbsent: [self error: 'Preference not found: ', aPreferenceSymbol]) categoryList: aCategoryList! ! !Preferences class methodsFor: 'reacting to change' stamp: 'sw 4/30/2001 12:53'! annotationPanesChanged "The setting of the annotationPanes preference changed; react" Flaps replaceBrowserInToolsFlap. Flaps replaceChangeSortersInToolsFlap! ! !Preferences class methodsFor: 'reacting to change' stamp: 'sw 5/2/2001 15:13'! optionalButtonsChanged "The setting of the optionalButtons preference changed; react" Flaps replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isKindOf: FileList]]] inGlobalFlapWithID: 'Tools' with: FileList openAsMorph applyModelExtent. Flaps replaceBrowserInToolsFlap! ! !Preferences class methodsFor: 'reacting to change' stamp: 'sw 5/5/2001 00:30'! setNotificationParametersForStandardPreferences "Set up the notification parameters for the standard preferences that require need them. When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are: Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: and Preference changeInformee:changeSelector:" "Preferences setNotificationParametersForStandardPreferences" | aPreference | #( (annotationPanes annotationPanesChanged) (eToyFriendly eToyFriendlyChanged) (infiniteUndo infiniteUndoChanged) (largeTiles largeTilesSettingToggled) (optionalButtons optionalButtonsChanged) (roundedWindowCorners roundedWindowCornersChanged) (showProjectNavigator showProjectNavigatorChanged) (smartUpdating smartUpdatingChanged) (universalTiles universalTilesSettingToggled) (showSharedFlaps sharedFlapsSettingChanged)) do: [:pair | aPreference _ self preferenceAt: pair first. aPreference changeInformee: self changeSelector: pair second]! ! !Preferences class methodsFor: 'reacting to change' stamp: 'sw 4/30/2001 20:39'! sharedFlapsSettingChanged "The current value of the showSharedFlaps flag has changed; now react" self showSharedFlaps "viz. the new setting" ifFalse: [Flaps globalFlapTabsIfAny do: [:aFlapTab | Flaps removeFlapTab: aFlapTab keepInList: true]] ifTrue: [Smalltalk isMorphic ifTrue: [self currentWorld addGlobalFlaps]]! ! !Preferences class methodsFor: 'misc' stamp: 'sw 4/24/2001 12:02'! okayToChangeProjectLocalnessOf: prefSymbol "Answer whether it would be okay to allow the user to switch the setting of whether or not the preference symbol is local to a project. Formerly useful and perhaps again will be, though to be sure this is a non-modular design." ^ (#() includes: prefSymbol) not! ! !Preferences class methodsFor: 'personalization' stamp: 'sw 5/5/2001 02:59'! personalizeUserMenu: aMenu "The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world. In this method, you are invited to add items to the menu as per personal preferences. The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates" aMenu addTitle: 'personal'. "Remove or modify this as per personal choice" aMenu addStayUpItem. aMenu add: 'previous project' action: #goBack. aMenu add: 'load latest code updates' target: Utilities action: #updateFromServer. aMenu add: 'about this system...' target: Smalltalk action: #aboutThisSystem. aMenu addUpdating: #suppressFlapsString target: CurrentProjectRefactoring action: #currentToggleFlapsSuppressed. aMenu balloonTextForLastItem: 'Whether prevailing flaps should be shown in the project right now or not.'! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 4/17/2001 11:39'! windowSpecificationPanel "Put up a panel for specifying window colors" "Preferences windowSpecificationPanel" | aPanel buttonRow aButton aRow aSwatch aColor aWindow aMiniWorld | aPanel _ AlignmentMorph newColumn hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 0. aPanel addMorph: (buttonRow _ AlignmentMorph newRow color: (aColor _ Color tan lighter)). buttonRow addTransparentSpacerOfSize: 2@0. buttonRow addMorphBack: (SimpleButtonMorph new label: '?'; target: self; actionSelector: #windowColorHelp; setBalloonText: 'Click for an explanation of this panel'; color: Color veryVeryLightGray; yourself). buttonRow addTransparentSpacerOfSize: 8@0. #( ('Bright' installBrightWindowColors yellow 'Use standard bright colors for all windows.') ('Pastel' installPastelWindowColors paleMagenta 'Use standard pastel colors for all windows.') ('White' installUniformWindowColors white 'Use white backgrounds for all standard windows.')) do: [:quad | aButton _ (SimpleButtonMorph new target: self) label: quad first; actionSelector: quad second; color: (Color colorFrom: quad third); setBalloonText: quad fourth; yourself. buttonRow addMorphBack: aButton. buttonRow addTransparentSpacerOfSize: 10@0]. self windowColorClasses do: [:aClassName | aRow _ AlignmentMorph newRow color: aColor. aSwatch _ ColorSwatch new target: self; getSelector: #windowColorFor:; putSelector: #setWindowColorFor:to:; argument: aClassName; extent: (40 @ 20); yourself. aRow addMorphFront: aSwatch. aRow addTransparentSpacerOfSize: (12 @ 1). aRow addMorphBack: (StringMorph contents: aClassName font: TextStyle defaultFont). aPanel addMorphBack: aRow]. Smalltalk isMorphic ifTrue: [buttonRow _ AlignmentMorph newRow color: aColor. buttonRow addTransparentSpacerOfSize: 25@0. aButton _ SimpleButtonMorph new target: self. aButton color: Color tan muchLighter. aButton label: 'Update Tools Flap'; target: Flaps; actionSelector: #replaceToolsFlap. buttonRow addMorphBack: aButton. aButton setBalloonText: 'Press here to place tools which use the above window-color choices into the Tools flap.'. aPanel addMorphBack: buttonRow. aWindow _ aPanel wrappedInWindowWithTitle: 'Window Colors'. self currentWorld addMorphCentered: aWindow. aWindow activateAndForceLabelToShow ] ifFalse: [(aMiniWorld _ MVCWiWPasteUpMorph newWorldForProject: nil) addMorph: aPanel. aMiniWorld startSteppingSubmorphsOf: aPanel. MorphWorldView openOn: aMiniWorld label: 'Window Colors' extent: aMiniWorld fullBounds extent]! ! !Preferences class methodsFor: 'fonts' stamp: 'sw 5/5/2001 00:29'! setCodeFontTo: aFont "Not currently sent, but once protocols are sorted out so that we can discriminate on whether a text object being launched is for code or not, might deserve to be reincorporated" Parameters at: #standardCodeFont put: aFont. Flaps replaceToolsFlap! ! !Preferences class methodsFor: 'fonts' stamp: 'sw 4/17/2001 11:34'! setListFontTo: aFont "Set the list font as indicated" Parameters at: #standardListFont put: aFont. ListParagraph initialize. Flaps replaceToolsFlap! ! !Preferences class methodsFor: 'fonts' stamp: 'sw 4/17/2001 11:34'! setSystemFontTo: aFont "Establish the default text font and style" | aStyle newDefaultStyle | aFont ifNil: [^ self]. aStyle _ aFont textStyle ifNil: [^ self]. newDefaultStyle _ aStyle copy. newDefaultStyle defaultFontIndex: (aStyle fontIndexOf: aFont). TextConstants at: #DefaultTextStyle put: newDefaultStyle. Flaps replaceToolsFlap. ScriptingSystem resetStandardPartsBin! ! !Preferences class methodsFor: 'fonts' stamp: 'sw 4/17/2001 13:28'! setWindowTitleFontTo: aFont "Set the window-title font to be as indicated" Parameters at: #windowTitleFont put: aFont. StandardSystemView setLabelStyle. Flaps replaceToolsFlap! ! !Project methodsFor: 'menu messages' stamp: 'sw 4/30/2001 20:41'! finalEnterActions "Perform the final actions necessary as the receiver project is entered" | navigator armsLengthCmd navType thingsToUnhibernate | 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 showProjectNavigator & 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: 'project parameters' stamp: 'sw 5/7/2001 13:21'! assureFlapIntegrity "Make certain that the items on the disabled-global-flap list are actually global flaps, and if not, get rid of them. Also, old (and damaging) parameters that held references to actual disabled flaps are cleansed" | disabledFlapIDs currentGlobalIDs oldList | Smalltalk isMorphic ifTrue: [disabledFlapIDs _ self parameterAt: #disabledGlobalFlapIDs ifAbsent: [Set new]. currentGlobalIDs _ Flaps globalFlapTabsIfAny collect: [:f | f flapID]. oldList _ Project current projectParameterAt: #disabledGlobalFlaps ifAbsent: [nil]. oldList ifNotNil: [disabledFlapIDs _ oldList collect: [:aFlap | aFlap flapID]. disabledFlapIDs addAll: #('Stack Tools' 'Painting')]. disabledFlapIDs _ disabledFlapIDs select: [:anID | currentGlobalIDs includes: anID]. self projectParameterAt: #disabledGlobalFlapIDs put: disabledFlapIDs asSet]. projectParameters ifNotNil: [projectParameters removeKey: #disabledGlobalFlaps ifAbsent: []]. ! ! !Project methodsFor: 'project parameters' stamp: 'sw 5/7/2001 12:48'! cleanseDisabledGlobalFlapIDsList "Make certain that the items on the disabled-global-flap list are actually global flaps, and if not, get rid of them" | disabledFlapIDs currentGlobalIDs oldList | Smalltalk isMorphic ifTrue: [disabledFlapIDs _ self parameterAt: #disabledGlobalFlapIDs ifAbsent: [Set new]. currentGlobalIDs _ Flaps globalFlapTabsIfAny collect: [:f | f flapID]. oldList _ Project current projectParameterAt: #disabledGlobalFlaps ifAbsent: [nil]. oldList ifNotNil: [disabledFlapIDs _ oldList select: [:aFlap | aFlap flapID]]. disabledFlapIDs _ disabledFlapIDs select: [:anID | currentGlobalIDs includes: anID]. self projectParameterAt: #disabledGlobalFlapIDs put: disabledFlapIDs]. projectParameters ifNotNil: [projectParameters removeKey: #disabledGlobalFlaps ifAbsent: []]. ! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/29/2001 23:45'! enableDisableGlobalFlap: aFlapTab "For the benefit of pre-existing which-global-flap buttons from a design now left behind." self flag: #toRemove. ^ self inform: 'Sorry, this is an obsolete menu; please dismiss it and get a fresh menu. Thanks.'.! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/24/2001 11:03'! flapsSuppressed "Answer whether flaps are suppressed in this project" ^ self showSharedFlaps not! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/25/2001 01:28'! flapsSuppressed: aBoolean "Make the setting of the flag that governs whether global flaps are suppressed in the project be as indicated and add or remove the actual flaps" self projectPreferenceFlagDictionary at: #showSharedFlaps put: aBoolean not. self == Project current "Typical case" ifTrue: [Preferences setPreference: #showSharedFlaps toValue: aBoolean not] ifFalse: "Anomalous case where this project is not the current one." [aBoolean ifTrue: [Flaps globalFlapTabsIfAny do: [:aFlapTab | Flaps removeFlapTab: aFlapTab keepInList: true]] ifFalse: [Smalltalk isMorphic ifTrue: [self currentWorld addGlobalFlaps]]]! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/30/2001 20:42'! globalFlapWithIDEnabledString: aFlapID "Answer the string to be shown in a menu to represent the status of the given flap regarding whether it it should be shown in this project." | aFlapTab | aFlapTab _ Flaps globalFlapTabWithID: aFlapID. ^ (self isFlapEnabled: aFlapTab) ifTrue: ['', aFlapTab wording] ifFalse: ['', aFlapTab wording]! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/24/2001 11:58'! initializeProjectParameters "Initialize the project parameters." projectParameters _ IdentityDictionary new. ^ projectParameters! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/24/2001 11:59'! initializeProjectPreferences "Initialize the project's preferences from currently-prevailing preferences that are currently being held in projects in this system" projectPreferenceFlagDictionary _ Project current projectPreferenceFlagDictionary deepCopy. "Project overrides in the new project start out being the same set of overrides in the calling project" Preferences allPreferenceObjects do: "in case we missed some" [:aPreference | aPreference localToProject ifTrue: [(projectPreferenceFlagDictionary includesKey: aPreference name) ifFalse: [projectPreferenceFlagDictionary at: aPreference name put: aPreference preferenceValue]]]. (Project current projectParameterAt: #disabledGlobalFlapIDs ifAbsent: [nil]) ifNotNilDo: [:idList | self projectParameterAt: #disabledGlobalFlapIDs put: idList copy] ! ! !Project methodsFor: 'project parameters' stamp: 'sw 5/5/2001 00:37'! isFlapEnabled: aFlapTab "Answer whether the given flap tab is enabled in this project" ^ self isFlapIDEnabled: aFlapTab flapID! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/17/2001 12:49'! isFlapIDEnabled: aFlapID "Answer whether a flap of the given ID is enabled in this project" | disabledFlapIDs | disabledFlapIDs _ self parameterAt: #disabledGlobalFlapIDs ifAbsent: [^ true]. ^ (disabledFlapIDs includes: aFlapID) not! ! !Project methodsFor: 'project parameters' stamp: 'sw 4/24/2001 11:02'! showSharedFlaps "Answer whether shared flaps are shown or suppressed in this project" | result | result _ Preferences showSharedFlaps. ^ self == Project current ifTrue: [result] ifFalse: [self projectPreferenceAt: #showSharedFlaps ifAbsent: [result]]! ! !ProjectViewMorph class methodsFor: 'project window creation' stamp: 'sw 4/24/2001 12:00'! newMVCProject "Create an instance of me on a new MVC project (in a SystemWindow)." | proj window | proj _ Project new. window _ (SystemWindow labelled: proj name) model: proj. window addMorph: (self on: proj) frame: (0@0 corner: 1.0@1.0). ^ window ! ! !RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'sw 4/30/2001 20:44'! assignCollapseFrameFor: aSSView "Offer up a location along the left edge of the screen for a collapsed SSView. Make sure it doesn't overlap any other collapsed frames." | grid otherFrames topLeft viewBox collapsedFrame extent newFrame verticalBorderDistance top | grid _ 8. verticalBorderDistance _ 8. aSSView isMorph ifTrue: [ otherFrames _ (SystemWindow windowsIn: aSSView world satisfying: [:w | w ~= aSSView]) collect: [:w | w collapsedFrame] thenSelect: [:rect | rect notNil]. viewBox _ aSSView world viewBox. Flaps sharedFlapsAllowed ifTrue: [viewBox _ viewBox insetBy: 16]] ifFalse: [otherFrames _ ScheduledControllers scheduledWindowControllers collect: [:aController | aController view ~= aSSView ifTrue: [aController view collapsedFrame]] thenSelect: [:rect | rect notNil]. viewBox _ Display boundingBox]. collapsedFrame _ aSSView collapsedFrame. extent _ collapsedFrame notNil ifTrue: [collapsedFrame extent] ifFalse: [aSSView isMorph ifTrue: [aSSView getRawLabel width + aSSView labelWidgetAllowance @ (aSSView labelHeight + 2)] ifFalse: [(aSSView labelText extent x + 70) @ aSSView labelHeight min: aSSView labelDisplayBox extent]]. collapsedFrame notNil ifTrue: [(otherFrames anySatisfy: [:f | collapsedFrame intersects: f]) ifFalse: ["non overlapping" ^ collapsedFrame]]. top _ viewBox top + verticalBorderDistance. [topLeft _ viewBox left @ top. newFrame _ topLeft extent: extent. newFrame bottom <= (viewBox height - verticalBorderDistance)] whileTrue: [(otherFrames anySatisfy: [:w | newFrame intersects: w]) ifFalse: ["no overlap" ^ newFrame]. top _ top + grid]. "If all else fails... (really to many wins here)" ^ 0 @ 0 extent: extent! ! !RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'sw 4/30/2001 20:44'! assignCollapsePointFor: aSSView "Offer up a location along the left edge of the screen for a collapsed SSView. Make sure it doesn't overlap any other collapsed frames." | grid otherFrames y free topLeft viewBox | grid _ 24. "should be mult of 8, since manual move is gridded by 8" aSSView isMorph ifTrue: [otherFrames _ (SystemWindow windowsIn: aSSView world satisfying: [:w | true]) collect: [:w | w collapsedFrame] thenSelect: [:rect | rect notNil]. viewBox _ aSSView world viewBox. Flaps sharedFlapsAllowed ifTrue: [viewBox _ viewBox insetBy: 16]] ifFalse: [otherFrames _ ScheduledControllers scheduledWindowControllers collect: [:aController | aController view collapsedFrame] thenSelect: [:rect | rect notNil]. viewBox _ Display boundingBox]. y _ viewBox top. [(y _ y + grid) <= (viewBox height - grid)] whileTrue: [topLeft _ viewBox left@y. free _ true. otherFrames do: [:w | free _ free & (topLeft ~= w topLeft)]. free ifTrue: [^ topLeft]]. "If all else fails..." ^ 0 @ 0! ! !RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'sw 4/30/2001 20:44'! strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld "This method implements a staggered window placement policy that I (di) like. Basically it provides for up to 4 windows, staggered from each of the 4 corners. The windows are staggered so that there will always be a corner visible." | allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel | allowedArea _(self maximumUsableAreaInWorld: aWorld) insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0@0). (Smalltalk isMorphic and: [Flaps sharedFlapsAllowed]) ifTrue: [allowedArea _ allowedArea insetBy: 16]. "Number to be staggered at each corner (less on small screens)" maxLevel _ allowedArea area > 300000 ifTrue: [3] ifFalse: [2]. "Amount by which to stagger (less on small screens)" grid _ allowedArea area > 500000 ifTrue: [40] ifFalse: [20]. initialFrame _ 0@0 extent: ((initialExtent "min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2)))) min: 600@400")). otherFrames _ Smalltalk isMorphic ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) collect: [:w | w bounds]] ifFalse: [ScheduledControllers scheduledWindowControllers select: [:aController | aController view ~~ nil] thenCollect: [:aController | aController view isCollapsed ifTrue: [aController view expandedFrame] ifFalse: [aController view displayBox]]]. 0 to: maxLevel do: [:level | 1 to: 4 do: [:ci | cornerSel _ #(topLeft topRight bottomRight bottomLeft) at: ci. corner _ allowedArea perform: cornerSel. "The extra grid//2 in delta helps to keep title tabs distinct" delta _ (maxLevel-level*grid+(grid//2)) @ (level*grid). 1 to: ci-1 do: [:i | delta _ delta rotateBy: #right centerAt: 0@0]. "slow way" putativeCorner _ corner + delta. free _ true. otherFrames do: [:w | free _ free & ((w perform: cornerSel) ~= putativeCorner)]. free ifTrue: [^ (initialFrame align: (initialFrame perform: cornerSel) with: putativeCorner) squishedWithin: allowedArea]]]. "If all else fails..." ^ (self scrollBarSetback @ self screenTopSetback extent: initialFrame extent) squishedWithin: allowedArea! ! !ScreenController methodsFor: 'menu messages' stamp: 'sw 4/24/2001 12:00'! openProject "Create and schedule a Project." | proj | Smalltalk at: #ProjectView ifPresent: [:c | proj _ Project new. c open: proj]. ! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'sw 4/17/2001 12:01'! discardMorphic "Discard Morphic. Updated for 2.8 TPR" "Smalltalk discardMorphic" | subs | "Check that we are in an MVC Project and that there are no Morphic Projects or WorldMorphViews." Flaps clobberFlapTabList. Smalltalk discardFlash. Smalltalk discardTrueType. subs _ OrderedCollection new. Morph allSubclassesWithLevelDo: [:c :i | subs addFirst: c] startingLevel: 0. subs do: [:c | c removeFromSystem]. Smalltalk removeClassNamed: #CornerRounder. Smalltalk removeKey: #BalloonEngineConstants ifAbsent: []. SystemOrganization removeCategoriesMatching: 'Balloon-*'. SystemOrganization removeCategoriesMatching: 'Morphic-*'. SystemOrganization removeSystemCategory: 'Graphics-Transformations'. SystemOrganization removeSystemCategory: 'ST80-Morphic'. ScriptingSystem _ nil. ! ! !SystemWindow methodsFor: 'menu' stamp: 'sw 4/30/2001 20:46'! fullScreen "Zoom Window to Full World size with possible DeskMargins" "SystemWindow fullScreen" | left right possibleBounds | left _ right _ 0. self paneMorphs do: [:pane | ((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) ifTrue: [pane scrollBarOnLeft ifTrue: [left _ left max: pane scrollbarWidth] ifFalse: [right _ right max: pane scrollbarWidth]]]. possibleBounds _ self worldBounds insetBy: (left @ 0 corner: right @ 0). ((Flaps sharedFlapsAllowed and: [CurrentProjectRefactoring currentFlapsSuppressed not]) or: [Preferences fullScreenLeavesDeskMargins]) ifTrue: [possibleBounds _ possibleBounds insetBy: 22]. self bounds: possibleBounds! ! !TheWorldMenu methodsFor: 'construction' stamp: 'sw 4/30/2001 20:46'! buildWorldMenu "Build the menu that is put up when the screen-desktop is clicked on" | menu | menu _ MenuMorph new defaultTarget: self. self colorForDebugging: menu. menu addStayUpItem. self fillIn: menu from: { {'previous project' . { #myWorld . #goBack } }. {'jump to project...' . { #myWorld . #jumpToProject } }. {'save project on file...' . { #myWorld . #saveOnFile } }. {'load project from file...' . { self . #loadProject } }. nil}. myWorld addUndoItemsTo: menu. self fillIn: menu from: { {'restore display (r)' . { World . #restoreMorphicDisplay } }. nil}. Preferences simpleMenus ifFalse: [self fillIn: menu from: { {'open...' . { self . #openWindow } }. {'windows...' . { self . #windowsDo } }. {'changes...' . { self . #changesDo } }}]. self fillIn: menu from: { {'help...' . { self . #helpDo } }. {'appearance...' . { self . #appearanceDo } }}. Preferences simpleMenus ifFalse: [self fillIn: menu from: { {'do...' . { Utilities . #offerCommonRequests} } }]. self fillIn: menu from: { nil. {'new morph...' . { self . #newMorph } }. {'authoring tools...' . { self . #scriptingDo } }. {'playfield options...' . { self . #playfieldDo } }. {'flaps...'. { self . #flapsDo } }. {'projects...' . { self . #projectDo } }}. Preferences simpleMenus ifFalse: [self fillIn: menu from: { {'print PS to file...' . { self . #printWorldOnFile } }. {'debug...' . { self . #debugDo } }}]. self fillIn: menu from: { nil. {'save' . { self . #saveSession } }. {'save as...' . { Smalltalk . #saveAs } }. {'save and quit' . { self . #saveAndQuit } }. {'quit' . { self . #quitSession } }}. ^ menu! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/24/2001 10:29'! flapsDo "Put up the flaps menu for the world." self doPopUp: self flapsMenu! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/23/2001 11:24'! flapsMenu "Build the flaps menu for the world." | aMenu | aMenu _ UpdatingMenuMorph new updater: self updateSelector: #formulateFlapsMenu:. self formulateFlapsMenu: aMenu. ^ aMenu! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/24/2001 10:26'! formulateFlapsMenu: aMenu "Fill aMenu with appropriate content" aMenu addTitle: 'flaps'. aMenu addStayUpItem. Flaps sharedFlapsAllowed ifTrue: [self fillIn: aMenu from: {{#suppressFlapsString. {CurrentProjectRefactoring. #currentToggleFlapsSuppressed}. 'Whether prevailing flaps should be shown in the project right now or not.'}. nil}. 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: [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.'}}. ! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/24/2001 10:42'! globalFlapsEnabled "Answer whether global flaps are enabled. Retained for the benefit of preexisting menus/butons that may call this" ^ Flaps sharedFlapsAllowed! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/30/2001 10:31'! newGlobalFlapString "Answer a string for the new-global-flap item in the flap menu. Obsolete; retained momentarily for the benefit of preexisting persistent menus." self flag: #toRemove. ^ 'make a new shared flap'! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 5/5/2001 03:06'! suppressFlapsString "Answer the wording of the suppress-flaps item" ^ CurrentProjectRefactoring suppressFlapsString! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/30/2001 20:47'! useGlobalFlapsString "Answer the wording for the use-global-flaps command" self flag: #toRemove. ^ 'This is an an obsolete menu -- please discard!!'! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/29/2001 23:17'! whichGlobalFlapsString "Obsolete, retained momentarily for bkwrd compatibility with existing menu-item morphs lingering in image segments, etc." self flag: #toRemove. ^ 'This is an obsolete menu -- please dismiss it'! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 4/17/2001 15:02'! windowsMenu "Build the windows menu for the world." ^ self fillIn: (self menu: 'windows') from: { { 'find window' . { #myWorld . #findWindow: }. 'Presents a list of all windows; if you choose one from the list, it becomes the active window.'}. { 'find changed browsers...' . { #myWorld . #findDirtyBrowsers: }. 'Presents a list of browsers that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}. { 'find changed windows...' . { #myWorld . #findDirtyWindows: }. 'Presents a list of all windows that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}. nil. { 'find a transcript (t)' . { #myWorld . #findATranscript: }. 'Brings an open Transcript to the front, creating one if necessary, and makes it the active window'}. { 'find a change sorter (C)' . { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window'}. nil. { #staggerPolicyString . { self . #toggleWindowPolicy }. 'stagger: new windows positioned so you can see a portion of each one. tile: new windows positioned so that they do not overlap others, if possible.'}. nil. { 'collapse all windows' . { #myWorld . #collapseAll }. 'Reduce all open windows to collapsed forms that only show titles.'}. { 'expand all windows' . { #myWorld . #expandAll }. 'Expand all collapsed windows back to their expanded forms.'}. { 'close top window (w)' . { SystemWindow . #closeTopWindow }. 'Close the topmost window if possible.'}. { 'send top window to back (\)' . { SystemWindow . #sendTopWindowToBack }. 'Make the topmost window become the backmost one, and activate the window just beneath it.'}. { 'move windows onscreen' . { #myWorld . #bringWindowsFullOnscreen }. 'Make all windows fully visible on the screen'}. nil. { 'delete unchanged windows' . { #myWorld . #closeUnchangedWindows }. 'Deletes all windows that do not have unsaved text edits.'}. { 'delete non-windows' . { #myWorld . #deleteNonWindows }. 'Deletes all non-window morphs lying on the world.'}. { 'delete both of the above' . { self . #cleanUpWorld }. 'deletes all unchanged windows and also all non-window morphs lying on the world, other than flaps.'}. }! ! !TheWorldMenu methodsFor: 'action' stamp: 'sw 4/30/2001 20:47'! toggleFlapSuppressionInProject "Toggle whether global flaps are suppressed in this project. Obsolete, retained for bkwrd compatibility with preexisting persistent menus." self flag: #toRemove. self inform: 'This is an obsolete menu -- please delete it'! ! !UpdatingMenuItemMorph methodsFor: 'world' stamp: 'sw 4/17/2001 09:37'! updateContents "Update the receiver's contents" | newString enablement nArgs | ((wordingProvider == nil) or: [wordingSelector == nil]) ifTrue: [^ self]. newString _ contents. nArgs _ wordingSelector numArgs. newString _ nArgs == 0 ifTrue: [wordingProvider perform: wordingSelector] ifFalse: [(nArgs == 1 and: [wordingArgument notNil]) ifTrue: [wordingProvider perform: wordingSelector with: wordingArgument] ifFalse: [nArgs == arguments size ifTrue: [wordingProvider perform: wordingSelector withArguments: arguments]]]. newString = contents ifFalse: [self contents: newString]. enablementSelector ifNotNil: [(enablement _ self enablement) == isEnabled ifFalse: [self isEnabled: enablement]]! ! !UpdatingMenuMorph methodsFor: 'initialization' stamp: 'sw 4/23/2001 11:02'! updater: anObject updateSelector: aSelector "Set the receiver's updater and updateSelector" updater _ anObject. updateSelector _ aSelector! ! !UpdatingMenuMorph methodsFor: 'update' stamp: 'sw 4/23/2001 11:13'! updateMenu "Reconstitute the menu by first removing the contents and then building it afresh" self removeAllMorphs. updater perform: updateSelector with: self ! ! !Utilities class methodsFor: 'debugging' stamp: 'sw 4/29/2001 23:42'! doesNotUnderstand: aMessage "A temporary expedient for revectoring various messages formerly sent to Utilities that now are instead implemented by Flaps; this is only for the benefit of pre-existing buttons and menu items that were set up to call the old interface" | aSelector | aSelector _ aMessage selector. (#(addLocalFlap explainFlaps addMenuFlap addPaintingFlap addStackToolsFlap addGlobalFlap offerGlobalFlapsMenu toggleWhetherToUseGlobalFlaps ) includes: aSelector) ifTrue: [^ self inform: 'Sorry, this is an obsolete menu. Please dismiss it and get a fresh one. Thank you']. ^ super doesNotUnderstand: aMessage! ! !Utilities class methodsFor: 'flaps' stamp: 'sw 4/17/2001 12:08'! globalFlapTabOrDummy: aName "Find a global flap tab by name. May be either 'flap: Tools' or 'Tools'. Retained in Utilities for possible benefit of existing image segments" ^ Flaps globalFlapTabOrDummy: aName! ! !Utilities class methodsFor: 'flaps' stamp: 'sw 4/29/2001 23:17'! globalFlapTabsIfAny "Answer a list of the global flap tabs, but it they don't exist, just answer an empty list" self flag: #toRemove. ^ FlapTabs copy ifNil: [Array new]! ! !WiWPasteUpMorph methodsFor: 'activation' stamp: 'sw 4/25/2001 01:55'! becomeTheActiveWorldWith: evt "Make the receiver become the active world, and give its hand the event provided, if not nil" | outerWorld | World == self ifTrue: [^ self]. worldState resetDamageRecorder. "since we may have moved, old data no longer valid" hostWindow setStripeColorsFrom: Color green. worldState canvas: nil. "safer to start from scratch" displayChangeSignatureOnEntry _ Display displayChangeSignature. "Messy stuff to clear flaps from outer world" Flaps globalFlapTabsIfAny do: [:f | f changed]. outerWorld _ World. World _ self. self installFlaps. World _ outerWorld. outerWorld displayWorld. World _ self. self viewBox: hostWindow panelRect. self startSteppingSubmorphsOf: self. self changed. pendingEvent _ nil. evt ifNotNil: [self primaryHand handleEvent: (evt setHand: self primaryHand)]. ! ! Utilities class removeSelector: #addGlobalFlap! Utilities class removeSelector: #addGlobalFlap:! Utilities class removeSelector: #addLocalFlap! Utilities class removeSelector: #addMenuFlap! Utilities class removeSelector: #addMorph:asElementNumber:inGlobalFlapSatisfying:! Utilities class removeSelector: #addPaintingFlap! Utilities class removeSelector: #addProjectNavigationButtonsTo:! Utilities class removeSelector: #addStackToolsFlap! Utilities class removeSelector: #addSystemStatusLinesTo:! Utilities class removeSelector: #addToSuppliesFlap:asElementNumber:! Utilities class removeSelector: #bringFlapsToFront! Utilities class removeSelector: #clobberFlapTabList! Utilities class removeSelector: #currentMenuFlap! Utilities class removeSelector: #deleteMorphsSatisfying:fromGlobalFlapSatisfying:! Utilities class removeSelector: #explainFlaps! Utilities class removeSelector: #globalFlapTab:! Utilities class removeSelector: #globalFlapTabWithID:! Utilities class removeSelector: #globalFlapTabs! Utilities class removeSelector: #initializeStandardFlaps! Utilities class removeSelector: #newFlapTitled:onEdge:! Utilities class removeSelector: #newFlapTitled:onEdge:inPasteUp:! Utilities class removeSelector: #newPartsFlapPage! Utilities class removeSelector: #offerGlobalFlapsMenu! Utilities class removeSelector: #orientationForEdge:! Utilities class removeSelector: #paintFlapButton! Utilities class removeSelector: #reinstateDefaultFlaps! Utilities class removeSelector: #removeFlapTab:keepInList:! Utilities class removeSelector: #removeFromGlobalFlapTabList:! Utilities class removeSelector: #replaceBrowserInToolsFlap! Utilities class removeSelector: #replaceChangeSortersInToolsFlap! Utilities class removeSelector: #replaceMenuFlap! Utilities class removeSelector: #replacePartSatisfying:inGlobalFlapSatisfying:with:! Utilities class removeSelector: #replaceScriptingAreaInToolsFlap! Utilities class removeSelector: #replaceToolsFlap! Utilities class removeSelector: #showingGlobalFlapsString! Utilities class removeSelector: #standardBottomFlap! Utilities class removeSelector: #standardLeftFlap! Utilities class removeSelector: #standardRightFlap! Utilities class removeSelector: #suppressFlapsString! Utilities class removeSelector: #toggleFlapSuppressionInProject! Utilities class removeSelector: #toggleWhetherToShowFlaps! Utilities class removeSelector: #toggleWhetherToUseGlobalFlaps! Utilities class removeSelector: #updateMenuFlap! Utilities class removeSelector: #useGlobalFlapsString! TheWorldMenu removeSelector: #allowFlaps! TheWorldMenu removeSelector: #toggleWhetherToUseGlobalFlaps! Project removeSelector: #cleanseDisabledGlobalFlapsList! Project removeSelector: #enableDisableGlobalFlapWithID:! Preferences class removeSelector: #allowFlaps! Preferences class removeSelector: #flapsAllowed! Preferences class removeSelector: #globalFlapsSettingChanged! Preferences class removeSelector: #useGlobalFlaps! PasteUpMorph removeSelector: #flapsNowAllowed! PasteUpMorph removeSelector: #viewerFlapTabForObject:! FlapTab removeSelector: #isGlobal! FlapTab removeSelector: #useGlobalFlaps! "Postscript:" Flaps grabStateFromUtilities. Preferences addPreference: #showSharedFlaps categories: #(flaps) default: true balloonHelp: 'Whether shared flaps should be shown or not; note that in addition, each project can selectively disable particular shared flaps.' projectLocal: true changeInformee: Preferences changeSelector: #sharedFlapsSettingChanged. Preferences expungePreferenceNamed: #useGlobalFlaps. Utilities class removeSelector: #globalFlapTabsIfAny. Object subclass: #Utilities instanceVariableNames: '' classVariableNames: 'AuthorInitials AuthorName CommonRequestStrings LastStats RecentSubmissions ScrapsBook UpdateDownloader UpdateUrlLists ' poolDictionaries: '' category: 'System-Support'. #(showSharedFlaps oneViewerFlapAtATime viewersInFlaps compactViewerFlaps okToReinitializeFlaps) do: [:sym | Preferences setCategoryList: { #flaps } forPreferenceNamed: sym]. PreferencesPanel deleteAllPreferencesPanels. (FlapTab allInstances select: [:t | t isGlobalFlap not]) do: [:t | (#('Stack Tools' '---') includes: t wording) ifTrue: [t delete]]. Flaps addNewDefaultSharedFlaps. Smalltalk isMorphic ifTrue: [self currentWorld addGlobalFlaps].!