'From Squeak3.1alpha of 5 February 2001 [latest update: #3517] on 6 February 2001 at 5:03:31 am'! "Change Set: prefs-sw Date: 6 February 2001 Author: Scott Wallace Adds a ? category to the preferences panel, which has a type-in pane for searching, as well as a couple of control buttons. Cleans up initialization of preferences somewhat by consolidating the initializers into a single category. Consolidates all the accumulated automatically-generated preference initializer methods into a single big method, stripping out the dozens of former initializer methods."! !Preferences commentStamp: 'sw 2/6/2001 02:39' prior: 0! A general mechanism to store preference choices. The default setup treats any symbol as a potential boolean flag; flags unknown to the preference dictionary are always returned as false. To open the control panel: Preferences openFactoredPanel All messages are on the class side. To query a a preference: Preferences logDebuggerStackToFile or some people prefer the more verbose Preferences valueOfFlag: #logDebuggerStackToFile You can make up a new preference any time. Do not define a new message in Preferences class. Accessor methods are compiled automatically when you add a preference as illustrated below: To add a preference (e.g. in the Postscript of a fileout): Preferences addPreference: #samplePreference categories: #(general browsing) default: true balloonHelp: 'This is an example of a preference added by a do-it'. To change a preference programatically: Preferences disable: #logDebuggerStackToFile. Or to turn it on, Preferences enable: #logDebuggerStackToFile. ! Model subclass: #PreferencesPanel instanceVariableNames: 'searchString ' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !Model methodsFor: 'dependents' stamp: 'sw 2/6/2001 04:13'! containingWindow "Answer the window that holds the receiver. The dependents technique is odious and may not be airtight, if multiple windows have the same model." ^ self dependents detect: [:d | ((d isKindOf: SystemWindow orOf: StandardSystemView) or: [d isKindOf: MVCWiWPasteUpMorph]) and: [d model == self]] ifNone: [nil]! ! !Browser methodsFor: 'initialize-release' stamp: 'sw 2/6/2001 03:34'! optionalButtonPairs "Answer a tuple (formerly pairs) defining buttons, in the format: button label selector to send help message" ^ #( ('senders' browseSendersOfMessages 'browse senders of...') ('implementors' browseMessages 'browse implementors of...') ('versions' browseVersions 'browse versions')), (Preferences decorateBrowserButtons ifTrue: [{#('inheritance' methodHierarchy 'browse method inheritance green: sends to super tan: has override(s) mauve: both of the above' )}] ifFalse: [{#('inheritance' methodHierarchy 'browse method inheritance')}]), #( ('hierarchy' classHierarchy 'browse class hierarchy') ('inst vars' browseInstVarRefs 'inst var refs...') ('class vars' browseClassVarRefs 'class var refs...'))! ! !Morph methodsFor: 'e-toy support' stamp: 'sw 2/6/2001 04:21'! containingWindow "Answer a window or window-with-mvc that contains the receiver" ^ self ownerThatIsA: SystemWindow orA: MVCWiWPasteUpMorph! ! !PluggableTextMorph methodsFor: 'model access' stamp: 'sw 2/6/2001 01:24'! setTextColor: aColor "Set the color of my text to the given color" textMorph color: aColor! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/6/2001 03:54'! allPreferenceInitializationSpecs "Answer a list of all the preference initialization specs found in the 'initial values' category; overlay any initial values found there if requested to be #defaultOverridesForCertainPreferences " | aList additions overrides entryToAdd anOverride | overrides _ self defaultOverridesForCertainPreferences. aList _ OrderedCollection new. (self class organization listAtCategoryNamed: 'initial values' asSymbol) do: [:aSelector | aSelector numArgs = 0 ifTrue: [additions _ self perform: aSelector. (additions isKindOf: Collection) ifFalse: [self error: 'method in "initial values" categories must return collections']. additions do: [:anAddition | (aList detect: [:elem | elem first == anAddition first] ifNone: [nil]) ifNil: [entryToAdd _ (anOverride _ overrides detect: [:ov | ov first == anAddition first] ifNone: [nil]) ifNil: [anAddition] ifNotNil: [{anAddition first. anOverride second}, (anAddition copyFrom: 3 to: anAddition size)]. aList add: entryToAdd]]]]. ^ aList "Preferences allPreferenceInitializationSpecs size"! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/6/2001 04:08'! chooseInitialSettings "Restore the default choices for all of the standard Preferences." self allPreferenceInitializationSpecs do: [:aSpec | aSpec second == #true ifTrue: [self enable: aSpec first] ifFalse: [self disable: aSpec first]]. self resetCategoryInfo "Preferences chooseInitialSettings" ! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/6/2001 04:22'! constructMonolithicPreferencesInitializer "For transition to 3.0: Take a survey of all the preference initializers in the system; gather them in, then remove all the numerous initializer methods, and spit out a huge, monolithic initializer that characerizes the names, categories, and default values for all the Preferences as of the beginning of Squeak 3.0. This one-time do-it obtains the help messages currently in the image for the existing preferences, and factors them into the method thus exuded. The old mechanism of having help messages separately stored in a 'help' category is abandoned; the help-message initializers in the 'initial values' category now also include balloon-help info. Note that the default-value overrides specified in #defaultOverridesForCertainPreferences are honored here" "Preferences constructMonolithicPreferencesInitializer" | initializationArray stringToCompile | initializationArray _ self allPreferenceInitializationSpecs collect: [:triplet | Array with: triplet first "preference symbol" with: triplet second asSymbol "default value, as symbol #false or #true" with: triplet third "category list" with: (HelpDictionary at: triplet first ifAbsent: [''])]. "help msg" initializationArray _ (initializationArray asSortedCollection: [:a :b | a first <= b first]) asArray. "Sort by preference name for easy access in the source code" self class removeCategory: 'help'. self class removeCategory: 'initial values'. stringToCompile _ String streamContents: [:aStream | aStream nextPutAll: 'initialValuesThreePointOh'. aStream cr; tab. aStream nextPutAll: '^ '. initializationArray storeOn: aStream]. self class compileProgrammatically: stringToCompile classified: 'initial values'. self resetCategoryInfo ! ! !Preferences class methodsFor: 'initialization' stamp: 'sw 2/6/2001 03:42'! defaultOverridesForCertainPreferences "Answer a list of overrides to the default settings of certain preferences" ^ #((capitalizedReferences true) (clickOnLabelToEdit false) (decorateBrowserButtons false) (fastDragWindowForMorphic true) (infiniteUndo false) (menuColorFromWorld true) (mvcProjectsAllowed true) (optionalButtons true) (preserveTrash false) (roundedWindowCorners true) (scrollBarsNarrow true) (soundsEnabled true) (useGlobalFlaps true)) ! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/6/2001 04:05'! factoredCategories "Answer the list of categories, each with its corresponding list of elements" | prefsWithoutInits extraItem | "CategoryInfo _ nil" CategoryInfo ifNil: [CategoryInfo _ self initialCategoryInfo]. ((prefsWithoutInits _ self preferencesLackingInitializers) size > 0) ifTrue: [extraItem _ (Array with: 'uncategorized' with: prefsWithoutInits asSortedArray)]. ^ {{'?'. {}}}, (extraItem ifNil: [CategoryInfo] ifNotNil: [CategoryInfo, {extraItem}]) copyWith: {'search results'. OrderedCollection new} "Preferences factoredCategories" ! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/5/2001 22:38'! initialCategoryInfo "Answer an alphabetized array of pairs, each of which consists of: the name of a category a list of preferences belonging to that category This is done by scanning all the initializer methods found in category 'initial values' in Preferences class." | categories catList | categories _ IdentityDictionary new. self allPreferenceInitializationSpecs do: [:spec | spec size > 2 ifTrue: [spec third do: [:sym | (categories includesKey: sym) ifFalse: [categories at: sym put: OrderedCollection new]. ((catList _ categories at: sym) includes: spec first) ifFalse: [catList add: spec first]]]]. ^ categories keys asSortedArray collect: [:aKey | Array with: aKey with: (categories at: aKey) asSortedArray]! ! !Preferences class methodsFor: 'factored pref panel' stamp: 'sw 2/6/2001 02:14'! openFactoredPanelWithWidth: aWidth "Open up a preferences panel of the given width" "Preferences openFactoredPanelWithWidth: 325" | tabbedPalette controlPage window playfield aColor aFont maxEntriesPerCategory tabsMorph anExtent aPanel | aFont _ StrikeFont familyName: 'NewYork' size: 19. aPanel _ PreferencesPanel new. aColor _ aPanel defaultBackgroundColor. tabbedPalette _ TabbedPalette newSticky. (tabsMorph _ tabbedPalette tabsMorph) color: aColor darker; highlightColor: Color red regularColor: Color brown darker darker. maxEntriesPerCategory _ 0. self factoredCategories do: [:aCat | controlPage _ AlignmentMorph newColumn beSticky color: aColor. controlPage borderColor: aColor; layoutInset: 4. aCat second do: [:aPrefSymbol | controlPage addMorphBack: (Preferences buttonRepresenting: aPrefSymbol wording: aPrefSymbol color: nil)]. 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: 'general'. tabsMorph rowsNoWiderThan: aWidth. playfield _ Morph newSticky. anExtent _ aWidth @ (25 + tabsMorph height + (20 * maxEntriesPerCategory)). playfield extent: anExtent. playfield color: aColor. playfield addMorphBack: tabbedPalette. 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: anExtent + (2 @ 2). window position: 200 @ 20. self currentHand attachMorph: window. self currentWorld startSteppingSubmorphsOf: window] ifFalse: [(window _ MVCWiWPasteUpMorph newWorldForProject: nil) addMorph: playfield. window startSteppingSubmorphsOf: playfield. MorphWorldView openOn: window label: 'Preferences' extent: playfield extent]! ! !Preferences class methodsFor: 'add preferences' stamp: 'sw 2/5/2001 22:09'! addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. This approach was first suggested and implemented by Stephan Rudlof" | sourceString | sourceString _ String streamContents: [:aStream | aStream nextPutAll: 'initialValuesAddition'. aStream nextPutAll: categoryList first asString, prefSymbol. "conjure up a unique selector" aStream cr; tab. aStream nextPutAll: '^ #(('. prefSymbol printOn: aStream. aStream space. defaultValue storeOn: aStream. aStream space. categoryList storeOn: aStream. aStream space. helpString storeOn: aStream. aStream nextPutAll: '))']. self class compileProgrammatically: sourceString classified: 'initial values'. self absorbAdditions ! ! !Preferences class methodsFor: 'add preferences' stamp: 'sw 2/5/2001 22:20'! addPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add the given preference, putting it in the given category, with the given default value, and with the given balloon help" self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString ! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'sw 2/6/2001 02:13'! addModelItemsToWindowMenu: aMenu "aMenu is being constructed to be presented to the user in response to the user's pressing on the menu widget in the title bar of a morphic SystemWindow. Here, the model is given the opportunity to add any model-specific items to the menu, whose default target is the SystemWindow itself." true ifTrue: [^ self]. "The below are provisionally disenfranchised, because their function is now directly available in the ? category" aMenu addLine. aMenu add: 'find preference... (f)' target: self action: #findPreference:. aMenu add: 'inspect parameters' target: Preferences action: #inspectParameters! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 03:10'! addHelpItemsTo: panelPage "Add special items to the page" | aButton aTextMorph aMorph | aTextMorph _ TextMorph new contents: 'Search Preferences for:'. aTextMorph beAllFont: ((TextStyle default fontOfSize: 21) emphasized: 1). panelPage addMorphBack: aTextMorph lock. panelPage addTransparentSpacerOfSize: 0@10. aMorph _ RectangleMorph new clipSubmorphs: true; beTransparent; borderWidth: 2; borderColor: Color black; extent: 250 @ 36. aMorph vResizing: #rigid; hResizing: #rigid. aTextMorph _ PluggableTextMorph new on: self text: #searchString accept: #setSearchStringTo: readSelection: nil menu: nil. " aTextMorph hResizing: #rigid." aTextMorph borderWidth: 0. aTextMorph font: ((TextStyle default fontOfSize: 21) emphasized: 1); setTextColor: Color red. aMorph addMorphBack: aTextMorph. aTextMorph acceptOnCR: true. aMorph clipLayoutCells: true. aTextMorph width: 250. panelPage addMorphBack: aMorph. aTextMorph setBalloonText: 'Type what you want to search for here, then hit the "Search" button'. panelPage addTransparentSpacerOfSize: 0@10. aButton _ SimpleButtonMorph new target: self; color: Color transparent; actionSelector: #initiateSearch:; arguments: {aTextMorph}; label: 'Search'. panelPage addMorphBack: aButton. aButton setBalloonText: 'Type what you want to search for in the box above, then click here (or hit RETURN or ENTER) to start the search; results will appear in the "search results" category.'. panelPage addTransparentSpacerOfSize: 0@50. panelPage addMorphBack: (SimpleButtonMorph new color: Color transparent; label: 'Restore All System Defaults'; target: Preferences; actionSelector: #chooseInitialSettings; setBalloonText: 'Click here to reset all the preferences to their standard default values.'; yourself). panelPage addTransparentSpacerOfSize: 0@10. panelPage addMorphBack: (SimpleButtonMorph new color: Color transparent; label: 'Inspect Parameters'; target: Preferences; actionSelector: #inspectParameters; setBalloonText: 'Click here to view all the values stored in the system Parameters dictionary'; yourself).! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/4/2001 03:31'! findPreference: evt "Allow the user to submit a selector fragment; search for that among preference names; put up a list of qualifying preferences; if the user selects one of those, redirect the preferences panel to reveal the chosen preference" self findPreferencesMatching: (FillInTheBlank request: 'Search for preferences containing:' initialAnswer: 'color')! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 04:16'! findPreferencesMatching: incomingTextOrString "find all preferences matching incomingTextOrString" | result aList aPalette controlPage | result _ incomingTextOrString asString asLowercase. result _ result asLowercase copyWithout: $ . result isEmptyOrNil ifTrue: [^ self]. aList _ Preferences allPreferenceFlagKeys select: [:aKey | aKey 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)]. aPalette world startSteppingSubmorphsOf: aPalette. " result _ (SelectionMenu selections: aList) startUpWithCaption: 'Choose which Preference you want to find'. Preferences factoredCategories do: [:aCategoryPair | (aCategoryPair second includes: result) ifTrue: [^ self switchToCategoryNamed: aCategoryPair first event: evt]]"! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 02:01'! findPreferencesMatchingSearchString "find all preferences matching incomingTextOrString" self findPreferencesMatching: self searchString! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 02:03'! initiateSearch: morphHoldingSearchString "Carry out the action of the Search button in the Preferences panel" searchString _ morphHoldingSearchString text. self findPreferencesMatchingSearchString! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 02:06'! keyStroke: anEvent "Handle a keystroke event in the panel; we map f (for find) into a switch to the ? category" (anEvent keyCharacter == $f) ifTrue: [^ self switchToCategoryNamed: #? event: nil]! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 02:18'! searchString "Answer the current searchString, initializing it if need be" ^ searchString ifNil: [searchString _ 'brows']! ! !PreferencesPanel methodsFor: 'find' stamp: 'sw 2/6/2001 01:45'! setSearchStringTo: aText "The user submitted aText as the search string; now search for it" searchString _ aText asString. self findPreferencesMatching: searchString. ^ true! ! PreferencesPanel removeSelector: #defaultSearchString! !PreferencesPanel reorganize! ('initialization' addModelItemsToWindowMenu: defaultBackgroundColor) ('category switch' switchToCategoryNamed:event:) ('halo pane' addHaloControlsTo: haloThemeRadioButtons) ('find' addHelpItemsTo: findPreference: findPreferencesMatching: findPreferencesMatchingSearchString initiateSearch: keyStroke: searchString setSearchStringTo:) ! "Postscript:" Preferences constructMonolithicPreferencesInitializer. !