'From Squeak3.1alpha of 5 February 2001 [latest update: #3641] on 18 February 2001 at 9:44:36 pm'! "Change Set: projectPrefsEtc-sw Date: 19 February 2001 Author: Scott Wallace CAUTION: the order of items in this update has been hand-jimmied; do not expect that simply filing this changeset out will result in a loadable update!! ¥ÊAdds a mechanism allowing preferences to be maintained on a project-by-project basis, yet still be accessed via the preferences protocol. ¥ In a preferences panel, there is now a menu associated with each preference item, allowing you to toggle the is-local-to-project setting, and to browse senders of the preference, and to determine which categories the preference is classified under. ¥ Initialize the project preferences of each new project to have the same values as the project from whence the new project springs. ¥ Expands the Search (Find) facility in the Preference panel so that it searches the balloon-help text of all preferences, as well as the formal names of the preferences, for matches. ¥ And much more..."! Object subclass: #Preferences instanceVariableNames: '' classVariableNames: 'CategoryInfo DesktopColor FlagDictionary FlagsHeldByProjects HelpDictionary Parameters SyntaxColorsAndStyles ' poolDictionaries: '' category: 'System-Support'! Model subclass: #Project instanceVariableNames: 'world changeSet transcript parentProject previousProject displayDepth viewSize thumbnail nextProject guards projectParameters isolatedHead inForce version urlList environment lastDirectory lastSavedAtSeconds projectPreferenceFlagDictionary ' classVariableNames: 'AllProjects CurrentProject GoalFreePercent GoalNotMoreThan UIProcess ' poolDictionaries: '' category: 'System-Support'! !MenuMorph methodsFor: 'control' stamp: 'sw 2/18/2001 00:52'! popUpInWorld "Present this menu in the current World" ^ self popUpInWorld: self currentWorld! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/16/2001 22:42'! compileAccessMethodFor: prefSymbol "Compile an accessor method for the given preference" self compileAccessMethodFor: prefSymbol defaultValue: false! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/18/2001 03:25'! compileAccessMethodFor: prefSymbol defaultValue: defaultValue "Compile an accessor method for the given preference" (self flagsHeldByProjects includesKey: prefSymbol) ifTrue: [self class compileProgrammatically: (prefSymbol, ' ^ Project current projectPreferenceAt: #', prefSymbol) classified: 'project-specific preferences'] ifFalse: [self class compileProgrammatically: (prefSymbol, ' ^ self valueOfFlag: #', prefSymbol, ' ifAbsent: [', defaultValue storeString, ']') classified: 'standard preferences']! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/18/2001 02:20'! makeIntoAProjectPreference: prefSymbol defaultValue: aValue "Make the given preference symbol be one maintained by each individual project" (self flagsHeldByProjects includesKey: prefSymbol) ifFalse: [FlagsHeldByProjects add: (prefSymbol -> aValue)]. self compileAccessMethodFor: prefSymbol defaultValue: aValue. "FlagDictionary removeKey: prefSymbol ifAbsent: []" "No -- keep the entry in the FlagDictionary, against the possibility that it becomes a globally-determined preference again and the right protocol is not gone through"! ! !Preferences class methodsFor: 'preferences dictionary' stamp: 'sw 2/18/2001 02:39'! globalOrDefaultValueOfFlag: aFlagName "Answer the value of the given flag as represented in the global dictionary, or, if it is not there but is thought to be one held in individual projects, get it from the directory of such. If no record of it is found anywhere, return false" ^ FlagDictionary at: aFlagName ifAbsent: [self flagsHeldByProjects at: aFlagName ifAbsent: [false]]! ! !Preferences class methodsFor: 'preferences dictionary' stamp: 'sw 2/18/2001 02:54'! noteThatFlag: prefSymbol justChangedTo: aBoolean "Provides a hook so that a user's toggling of a preference might precipitate some immediate action" | keep | prefSymbol == #useGlobalFlaps ifTrue: [aBoolean ifFalse: "Turning off use of flaps" [keep _ self confirm: 'Do you want to preserve the existing global flaps for future use?'. Utilities globalFlapTabsIfAny do: [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: keep. aFlapTab isInWorld ifTrue: [self error: 'Flap problem']]. keep ifFalse: [Utilities clobberFlapTabList]] ifTrue: "Turning on use of flaps" [Smalltalk isMorphic ifTrue: [self currentWorld addGlobalFlaps]]]. prefSymbol == #roundedWindowCorners ifTrue: [Display repaintMorphicDisplay]. prefSymbol == #optionalButtons ifTrue: [Utilities replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented model isKindOf: FileList]]] inGlobalFlapSatisfying: [:f1 | f1 wording = 'Tools'] with: FileList openAsMorph applyModelExtent]. (prefSymbol == #optionalButtons or: [prefSymbol == #annotationPanes]) ifTrue: [Utilities replaceBrowserInToolsFlap]. (prefSymbol == #smartUpdating) ifTrue: [SystemWindow allSubInstancesDo: [:aWindow | aWindow amendSteppingStatus]]. (prefSymbol == #eToyFriendly) ifTrue: [ScriptingSystem customizeForEToyUsers: aBoolean]. ((prefSymbol == #infiniteUndo) and: [aBoolean not]) ifTrue: [CommandHistory resetAllHistory]. (prefSymbol == #showProjectNavigator) ifTrue: [Project current assureNavigatorPresenceMatchesPreference]. prefSymbol == #universalTiles ifTrue: [(self isProjectPreference: prefSymbol) ifFalse: [^ self inform: 'This is bad -- you should not have done that, because the change will take effect for *all projects*, including pre-existing ones. Unfortunately this check is done after the damage is done, so you are hosed. Fortunately, however, you can simply reverse your choice right now and no deep damage will probably have been done.']. aBoolean ifFalse: [self inform: 'CAUTION -- this branch is not supported; once you go to universal tiles in a project, basically there is no going back, so kindly just toggle this preference back to true... sorry (If you really want to use "classic tile" open up a new project that does NOT have the universalTiles already set.)'] ifTrue: [Preferences capitalizedReferences ifFalse: [Preferences enable: #capitalizedReferences. self inform: 'Note that the "capitalizedReferences" flag has now been automatically set to true for you, since this is required for the use of universal tiles.']. World isMorph ifTrue: [World flapTabs do: [:ff | (ff isKindOf: ViewerFlapTab) ifTrue: [ff referent delete. ff delete]]]]]! ! !Preferences class methodsFor: 'preferences dictionary' stamp: 'sw 2/18/2001 21:39'! setPreference: prefSymbol toValue: aBoolean "Set the given preference to the given value, and answer that value" | existing | (self flagsHeldByProjects includesKey: prefSymbol) ifTrue: [Project current projectPreferenceAt: prefSymbol put: aBoolean. ^ aBoolean]. (existing _ FlagDictionary at: prefSymbol ifAbsent: [nil]) == aBoolean ifFalse: [FlagDictionary at: prefSymbol put: aBoolean. existing notNil ifTrue: [self noteThatFlag: prefSymbol justChangedTo: aBoolean]]. ^ aBoolean! ! !Preferences class methodsFor: 'pref buttons' stamp: 'sw 2/18/2001 15:20'! buttonRepresenting: prefSymbol wording: aString color: aColor inPanel: aPreferencesPanel "Return a button that controls the setting of prefSymbol. It will keep up to date even if the preference value is changed in a different place" | outerButton aButton str aHelp miniWrapper | ((FlagDictionary includesKey: prefSymbol) or: [self flagsHeldByProjects includesKey: prefSymbol]) ifFalse: [self error: 'Unknown preference: ', prefSymbol printString]. outerButton _ AlignmentMorph newRow height: 24. outerButton color: (aColor ifNil: [Color r: 0.645 g: 1.0 b: 1.0]). outerButton hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]). outerButton vResizing: #shrinkWrap. outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox). aButton target: self; actionSelector: #togglePreference:; arguments: (Array with: prefSymbol); target: Preferences; getSelector: prefSymbol. outerButton addTransparentSpacerOfSize: (2 @ 0). str _ StringMorph contents: aString font: (StrikeFont familyName: 'NewYork' size: 12). (self isProjectPreference: prefSymbol) ifTrue: [str emphasis: 1]. miniWrapper _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. miniWrapper beTransparent addMorphBack: str lock. aPreferencesPanel ifNotNil: [miniWrapper on: #mouseDown send: #prefMenu:rcvr:pref: to: aPreferencesPanel withValue: prefSymbol]. outerButton addMorphBack: miniWrapper. aButton setBalloonText: (aHelp _ Preferences helpMessageForPreference: prefSymbol). miniWrapper setBalloonText: aHelp; setProperty: #balloonTarget toValue: aButton. ^ outerButton "self currentHand attachMorph: (Preferences buttonRepresenting: #balloonHelpEnabled wording: 'Balloon Help' color: Color red muchLighter inPanel: nil) " ! ! !Preferences class methodsFor: 'pref buttons' stamp: 'sw 2/18/2001 00:58'! isProjectLocalString: sym | aStr | "Answer a string representing whether sym is a project-local preference or not" aStr _ 'each project has its own setting'. ^ (self isProjectPreference: sym) ifTrue: ['', aStr] ifFalse: ['', aStr]! ! !Preferences class methodsFor: 'pref buttons' stamp: 'sw 2/14/2001 02:30'! togglePreference: prefSymbol "Toggle the given preference" | curr | (self isProjectPreference: prefSymbol) ifTrue: [Project current toggleProjectPreference: prefSymbol] ifFalse: [curr _ (FlagDictionary at: prefSymbol ifAbsent: [^ self error: 'unknown pref: ', prefSymbol printString]). self setPreference: prefSymbol toValue: (curr == true) not] ! ! !Preferences class methodsFor: 'pref buttons' stamp: 'sw 2/18/2001 01:56'! toggleProjectLocalnessOf: aPreferenceSymbol "Toggle whether the given preference should be held project-by-project or globally" | currentValue | currentValue _ self valueOfFlag: aPreferenceSymbol. (self isProjectPreference: aPreferenceSymbol) ifTrue: "toggle it to become global" [FlagsHeldByProjects removeKey: aPreferenceSymbol ifAbsent: []. self compileAccessMethodFor: aPreferenceSymbol. FlagDictionary at: aPreferenceSymbol put: currentValue] ifFalse: "make it become a project preference" [self makeIntoAProjectPreference: aPreferenceSymbol defaultValue: currentValue]. PreferencesPanel allInstancesDo: [:aPanel | aPanel adjustProjectLocalEmphasisFor: aPreferenceSymbol]. ! ! !Preferences class methodsFor: 'misc' stamp: 'sw 2/18/2001 18:12'! giveHelpWithPreferences "Open up a workspace with explanatory info in it about Prefernces" | aString | aString _ 'Many aspects of the system are governed by the settings of various "Preferences". Click on any of brown tabs at the top of the panel to see all the preferences in that category. Or type in to the box above the Search button, then hit Search, and all Preferences matching whatever you typed in will appear in the "search results" category. A preference is considered to match your search if either its name matches the characters *or* if anything in the balloon help provided for the preferences matches the search text. To find out more about any particular Preference, hold the mouse over it for a moment and balloon help will appear. Preferences whose names are in bold are designated as being allowed to vary from project to project; those whose name are not in bold are "global", which is to say, they apply equally whatever project you are in. Click on the name of any preference to get a menu which allows you to *change* whether the preference should vary from project to project or should be global, and also allows you to browse all the senders of the preference, also to discover all the categories unde which the preference has been classified. If you like all your current Preferences settings, you may wish to hit the "Save Current Settings as my Personal Preferences" button. Once you have done that, you can at any point in the future hit "Restore my Personal Preferences" and all your saved settings will get restored immediately.'. (Workspace new contents: aString) openLabel: 'About Preferences'! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/18/2001 02:27'! allGlobalPreferenceFlagKeys "Answer a list of all the keys in the global FlagDictionary" ^ FlagDictionary keys asOrderedCollection "Preferences allGlobalPreferenceFlagKeys"! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/18/2001 02:33'! allPreferenceFlagKeys "Answer a sorted list of all preference keys, whether they be global or project-specific" | keys | keys _ self allGlobalPreferenceFlagKeys. keys addAll: self flagsHeldByProjects keys. ^ keys asSet asSortedArray "Preferences allPreferenceFlagKeys"! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/18/2001 03:53'! categoriesContainingPreference: prefSymbol "Return a list of all categories in which the preference occurs" ^ self factoredCategories select: [:pair | pair second includes: prefSymbol] thenCollect: [:pair | pair first]! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/18/2001 01:53'! initializePreferencePanel: aPanel in: aPasteUpMorph "Initialize the given Preferences panel. in the given pasteup, which is the top-level panel installed in the container window. Also used to reset it after some change requires reformulation" | tabbedPalette controlPage aColor aFont maxEntriesPerCategory tabsMorph anExtent | aPasteUpMorph removeAllMorphs. aFont _ StrikeFont familyName: 'NewYork' size: 19. aColor _ aPanel defaultBackgroundColor. tabbedPalette _ TabbedPalette newSticky. tabbedPalette dropEnabled: false. (tabsMorph _ tabbedPalette tabsMorph) color: aColor darker; highlightColor: Color red regularColor: Color brown darker darker. tabbedPalette on: #mouseDown send: #yourself to: #(). maxEntriesPerCategory _ 0. self factoredCategories do: [:aCat | controlPage _ AlignmentMorph newColumn beSticky color: aColor. controlPage on: #mouseDown send: #yourself to: #(). controlPage dropEnabled: false. controlPage borderColor: aColor; layoutInset: 4. aCat second do: [:aPrefSymbol | controlPage addMorphBack: (Preferences buttonRepresenting: aPrefSymbol wording: aPrefSymbol color: nil inPanel: aPanel)]. controlPage setNameTo: aCat first asString. aCat first = #? ifTrue: [aPanel addHelpItemsTo: controlPage]. aCat first == #halos ifTrue: [aPanel addHaloControlsTo: controlPage]. tabbedPalette addTabFor: controlPage font: aFont. aCat first = 'search results' ifTrue: [(tabbedPalette tabNamed: aCat first) setBalloonText: 'Use the ? category to find preferences by keyword; the results of your search will show up here']. maxEntriesPerCategory _ maxEntriesPerCategory max: aCat second size]. tabbedPalette selectTabNamed: '?'. tabsMorph rowsNoWiderThan: aPasteUpMorph width. aPasteUpMorph on: #mouseDown send: #yourself to: #(). anExtent _ aPasteUpMorph width @ (25 + tabsMorph height + (20 * maxEntriesPerCategory)). aPasteUpMorph extent: anExtent. aPasteUpMorph color: aColor. aPasteUpMorph addMorphBack: tabbedPalette.! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/18/2001 01:45'! openFactoredPanelWithWidth: aWidth "Open up a preferences panel of the given width" "Preferences openFactoredPanelWithWidth: 325" | window playfield aPanel | aPanel _ PreferencesPanel new. playfield _ PasteUpMorph new width: aWidth. playfield dropEnabled: false. self initializePreferencePanel: aPanel in: playfield. self couldOpenInMorphic ifTrue: [window _ (SystemWindow labelled: 'Preferences') model: aPanel. window on: #keyStroke send: #keyStroke: to: aPanel. window bounds: (100 @ 100 - (0 @ window labelHeight + window borderWidth) extent: playfield extent + (2 * window borderWidth)). window addMorph: playfield frame: (0 @ 0 extent: 1 @ 1). window updatePaneColors. window setProperty: #minimumExtent toValue: playfield extent + (12@15). self currentWorld addMorphFront: window. window center: self currentWorld center. window activateAndForceLabelToShow] ifFalse: [(window _ MVCWiWPasteUpMorph newWorldForProject: nil) addMorph: playfield. MorphWorldView openOn: window label: 'Preferences' extent: playfield extent]! ! !Preferences class methodsFor: 'project preferences' stamp: 'sw 2/18/2001 16:16'! flagsHeldByProjects "Answer a dictionary of (flagName -> defaultValue) associations characterizing the 'project-borne' preferences configured to be managed by Preferences but held in projects. Caution: this structure does not give current values of the flags, but rather the default values." ^ FlagsHeldByProjects ifNil: [FlagsHeldByProjects _ IdentityDictionary new] ! ! !Preferences class methodsFor: 'project preferences' stamp: 'sw 2/15/2001 15:19'! isProjectPreference: aSymbol "Answer whether aSymbol represents a project-specific preference" ^ self flagsHeldByProjects includesKey: aSymbol! ! !Preferences class methodsFor: 'project preferences' stamp: 'sw 2/18/2001 21:43'! 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" ^ (#(globalFlapsEnabledInProject) includes: prefSymbol) not "The unusual #globalFlapsEnabledInProject handling is historical and problematical"! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'sw 2/18/2001 02:13'! adjustProjectLocalEmphasisFor: aSymbol "Somewhere, the preference represented by aSymbol got changed from being one that is truly global to one that varies by project, or vice-versa. Get my panel right -- this involves changing the emphasis on the item" | aWindow toFixUp allMorphs | (aWindow _ self containingWindow) ifNil: [^ self]. allMorphs _ IdentitySet new. aWindow allMorphsAndBookPagesInto: allMorphs. toFixUp _ allMorphs select: [:m | (m isKindOf: StringMorph) and: [m contents = aSymbol]]. toFixUp do: [:aStringMorph | (Preferences isProjectPreference: aSymbol) ifTrue: [aStringMorph emphasis: 1] ifFalse: [aStringMorph emphasis: 0]] ! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'sw 2/18/2001 15:03'! findPreferencesMatching: incomingTextOrString "find all preferences matching incomingTextOrString" | result aList aPalette controlPage helpMsg | result _ incomingTextOrString asString asLowercase. result _ result asLowercase withBlanksTrimmed. result isEmptyOrNil ifTrue: [^ self]. aList _ Preferences allPreferenceFlagKeys select: [:aKey | (aKey includesSubstring: result caseSensitive: false) or: [(helpMsg _ Preferences helpMessageOrNilForPreference: aKey) notNil and: [helpMsg asString includesSubstring: result caseSensitive: false]]]. aPalette _ self dependents first containingWindow findDeeplyA: TabbedPalette. aPalette ifNil: [^ self]. aPalette selectTabNamed: 'search results'. aPalette currentPage ifNil: [^ self]. "bkwd compat" controlPage _ aPalette currentPage. controlPage removeAllMorphs. controlPage addMorph: (StringMorph contents: ('Preferences matching "', self searchString, '"') font: Preferences standardButtonFont). aList do: [:aPrefSymbol | controlPage addMorphBack: (Preferences buttonRepresenting: aPrefSymbol wording: aPrefSymbol color: nil inPanel: self)]. aPalette world startSteppingSubmorphsOf: aPalette! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'sw 2/18/2001 17:15'! prefMenu: anEvent rcvr: aMorph pref: prefSymbol "the user clicked on a preference name. put up a menu" | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addTitle: prefSymbol. (Preferences okayToChangeProjectLocalnessOf: prefSymbol) ifTrue: [aMenu addUpdating: #isProjectLocalString: enablementSelector: nil target: Preferences selector: #toggleProjectLocalnessOf: argumentList: {prefSymbol}]. aMenu balloonTextForLastItem: 'Some preferences are best applied uniformly to all projects, and others are best set by each individual project. If this item is checked, then this preference will be printed in bold and will have a separate value for each project'. aMenu add: 'browse senders' target: Smalltalk selector: #browseAllCallsOn: argument: prefSymbol. aMenu balloonTextForLastItem: 'This will open a method-list browser on all methods that the send the preference "', prefSymbol, '".'. aMenu add: 'show category...' target: self selector: #findCategoryFromPreference: argument: prefSymbol. aMenu balloonTextForLastItem: 'Allows you to find out which category, or categories, this preference belongs to.'. aMenu popUpInWorld! ! !PreferencesPanel methodsFor: 'category switch' stamp: 'sw 2/18/2001 04:02'! switchToCategoryNamed: aName event: anEvent "Switch the panel so that it looks at the category of the given name" | aPalette | aPalette _ self containingWindow findDeeplyA: TabbedPalette. aPalette ifNil: [^ self]. aPalette selectTabNamed: aName! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/18/2001 04:03'! findCategoryFromPreference: prefSymbol "Find all categories in which the preference occurs" | aMenu| aMenu _ MenuMorph new defaultTarget: self. (Preferences categoriesContainingPreference: prefSymbol) do: [:aCategory | aMenu add: aCategory target: self selector: #switchToCategoryNamed:event: argumentList: {aCategory. MorphicEvent new}]. aMenu popUpInWorld! ! !Project methodsFor: 'initialization' stamp: 'sw 2/18/2001 04:06'! initialize "Initialize the project, seting the CurrentProject as my parentProject and initializing my project preferences from those of the CurrentProject" changeSet _ ChangeSet new initialize. transcript _ TranscriptStream new. displayDepth _ Display depth. parentProject _ CurrentProject. isolatedHead _ false. self initializeProjectPreferences ! ! !Project methodsFor: 'file in/out' stamp: 'sw 2/15/2001 16:06'! exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it .extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder | "world == World ifTrue: [^ false]." "self inform: 'Can''t send the current world out'." world isMorph ifFalse: [ self projectParameters at: #isMVC put: true. ^ false]. "Only Morphic projects for now" world ifNil: [^ false]. world presenter ifNil: [^ false]. Utilities emptyScrapsBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState; releaseViewers. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [ self error: 'Still holding onto Global flaps']. world releaseSqueakPages. ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]). holder _ Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg _ self projectParameters at: #revertToMe ifAbsent: [nil]. self projectParameters removeKey: #revertToMe ifAbsent: []. roots _ OrderedCollection new. roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]). roots _ roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" catList do: [:sysCat | (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb | roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]]. is _ ImageSegment new copySmartRootsExport: roots asArray. "old way was (is _ ImageSegment new copyFromRootsForExport: roots asArray)" is state = #tooBig ifTrue: [^ false]. str _ ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [ str _ str, '\Project''s own world is not in the segment.' withCRs]. str isEmpty ifFalse: [ ans _ (PopUpMenu labels: 'Do not write file Write file anyway Debug') startUpWithCaption: str. ans = 1 ifTrue: [ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. ^ false]. ans = 3 ifTrue: [self halt: 'Segment not written']]. is writeForExportWithSources: aFileName inDirectory: aDirectory. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. holder. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. is arrayOfRoots do: [:obj | obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! ! !Project methodsFor: 'file in/out' stamp: 'sw 2/15/2001 14:33'! exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it .extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder | "An experimental version to fileout a changeSet first so that a project can contain its own classes" world isMorph ifFalse: [ self projectParameters at: #isMVC put: true. ^ false]. "Only Morphic projects for now" world ifNil: [^ false]. world presenter ifNil: [^ false]. Utilities emptyScrapsBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState; releaseViewers. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [ self error: 'Still holding onto Global flaps']. world releaseSqueakPages. ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]). holder _ Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg _ self projectParameters at: #revertToMe ifAbsent: [nil]. self projectParameters removeKey: #revertToMe ifAbsent: []. roots _ OrderedCollection new. roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. roots add: world activeHand. "; addAll: classList; addAll: (classList collect: [:cls | cls class])" roots _ roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" is _ ImageSegment new copySmartRootsExport: roots asArray. "old way was (is _ ImageSegment new copyFromRootsForExport: roots asArray)" is state = #tooBig ifTrue: [^ false]. str _ ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [ str _ str, '\Project''s own world is not in the segment.' withCRs]. str isEmpty ifFalse: [ ans _ (PopUpMenu labels: 'Do not write file Write file anyway Debug') startUpWithCaption: str. ans = 1 ifTrue: [ revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. ^ false]. ans = 3 ifTrue: [self halt: 'Segment not written']]. is writeForExportWithSources: aFileName inDirectory: aDirectory changeSet: aChangeSetOrNil. revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. holder. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. is arrayOfRoots do: [:obj | obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/18/2001 03:12'! initializeProjectParameters "Initialize the project parameters. The arcane globalFlapsEnabledInProject is a leftover that I am reluctant to mess with because of not understanding the battles being fought with the CurrentProjectRefactoring mechanism, so I did not make it into a simple Preference held by the Project." projectParameters _ IdentityDictionary new. projectParameters at: #globalFlapsEnabledInProject put: true. ^ projectParameters! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/18/2001 03:02'! 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. Preferences flagsHeldByProjects associationsDo: "in case we missed some" [:assoc | (projectPreferenceFlagDictionary includesKey: assoc key) ifFalse: [projectPreferenceFlagDictionary add: [assoc key -> assoc value]]]! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/16/2001 22:35'! noteThatParameter: prefSymbol justChangedTo: aBoolean "Provides a hook so that a user's toggling of a project parameter might precipitate some immediate action" ! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/15/2001 14:32'! projectParameterAt: aSymbol ifAbsent: aBlock "Answer the project parameter stored at the given symbol, or the result of evaluating the block" ^ self projectParameters at: aSymbol ifAbsent: [aBlock value]! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/17/2001 21:36'! projectParameterAt: aSymbol put: aValue "Set the given project parameter to the given value" self projectParameters at: aSymbol put: aValue. self noteThatParameter: aSymbol justChangedTo: aValue. ^ aValue! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/18/2001 02:40'! projectPreferenceAt: aSymbol "Answer the project preference stored at the given symbol. If there is none in the local preference dictionary, it must be because it was only latterly declared to be a project-local preference, so obtain its initial value instead from the last-known global or default setting" | aValue | ^ self projectPreferenceAt: aSymbol ifAbsent: [aValue _ Preferences globalOrDefaultValueOfFlag: aSymbol. self projectPreferenceFlagDictionary at: aSymbol put: aValue. ^ aValue]! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/16/2001 22:25'! projectPreferenceAt: aSymbol ifAbsent: aBlock "Answer the project preference stored at the given symbol, or the result of evaluating the block" ^ self projectPreferenceFlagDictionary at: aSymbol ifAbsent: [aBlock value]! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/18/2001 21:41'! projectPreferenceAt: aSymbol put: aValue "Set the given project preference to the given value. Notify interested parties of the change if it is indeed a flipflop of a boolean. Answer the value set." | existing | existing _ self projectPreferenceAt: aSymbol ifAbsent: [nil]. self projectPreferenceFlagDictionary at: aSymbol put: aValue. (existing notNil and: [aValue ~~ existing]) ifTrue: [Preferences noteThatFlag: aSymbol justChangedTo: aValue]. ^ aValue! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/16/2001 22:23'! projectPreferenceFlagDictionary "Answer the dictionary that holds the project preferences, creating it if necessary" ^ projectPreferenceFlagDictionary ifNil: [projectPreferenceFlagDictionary _ IdentityDictionary new]! ! !Project methodsFor: 'project parameters' stamp: 'sw 2/18/2001 04:11'! toggleProjectPreference: aSymbol "The user has requested that a preference of the given name, known to be one that is held on to by each project, be toggled" self projectPreferenceAt: aSymbol put: (Preferences valueOfFlag: aSymbol) not! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'sw 2/15/2001 14:25'! okToBeReplacedBy: aSyntaxMorph "Return true if it is OK to replace me with aSyntaxMorph. Enforce the type rules in the old EToy green tiles." | itsType myType | (Preferences eToyFriendly or: [Preferences typeCheckingInTileScripting]) ifFalse: [^ true]. "not checking unless one of those prefs is true" (parseNode class == BlockNode and: [aSyntaxMorph parseNode class == BlockNode]) ifTrue: [^ true]. (parseNode class == ReturnNode and: [aSyntaxMorph parseNode class == ReturnNode]) ifTrue: [^ true]. parseNode class == KeyWordNode ifTrue: [^ false]. aSyntaxMorph parseNode class == KeyWordNode ifTrue: [^ false]. parseNode class == SelectorNode ifTrue: [^ false]. aSyntaxMorph parseNode class == SelectorNode ifTrue: [^ false]. owner isSyntaxMorph ifFalse: [^ true]. "only within a script" "Transcript show: aSyntaxMorph resultType printString, ' dropped on ', self receiverOrArgType printString; cr. " (itsType _ aSyntaxMorph resultType) == #unknown ifTrue: [^ true]. (myType _ self receiverOrArgType) == #unknown ifTrue: [^ true]. "my type in enclosing message" ^ myType = itsType! ! !Preferences class methodsFor: 'preferences dictionary' stamp: 'sw 2/18/2001 04:09'! valueOfFlag: aFlagName "Answer the value of the given flag" ^ (self isProjectPreference: aFlagName) ifTrue: [Project current projectPreferenceAt: aFlagName] ifFalse: [FlagDictionary at: aFlagName ifAbsent: [false]]! ! !Preferences class methodsFor: 'preferences dictionary' stamp: 'sw 2/16/2001 22:46'! valueOfFlag: aFlagName ifAbsent: aBoolean "Answer the value of the given flag" ^ (self isProjectPreference: aFlagName) ifTrue: [Project current projectPreferenceAt: aFlagName ifAbsent: [aBoolean]] ifFalse: [FlagDictionary at: aFlagName ifAbsent: [aBoolean]]! ! Project removeSelector: #noteThatFlag:justChangedTo:! Project removeSelector: #noteThatProjectPreference:justChangedTo:! Preferences class removeSelector: #browseSendersOf:! Preferences class removeSelector: #buttonRepresenting:wording:color:! Preferences class removeSelector: #compileProjectAccessMethodFor:! Preferences class removeSelector: #globalValueOfFlag:! Preferences class removeSelector: #largeTiles!