'From Squeak3.3alpha of 12 January 2002 [latest update: #4777] on 26 February 2002 at 3:02:56 pm'! "Change Set: windowColors-sw Date: 26 February 2002 Author: Scott Wallace A revisiting of the window-color-preference panel. * Now modular and easily extensible -- just implement #windowColorSpec on the class-side of any tool whose window color you wish to have governed by the panel, and remove any residual #defaultBackgroundColor implementation in that class at the same time. * Instead of class-names you now see the more familiar names for the various tools; thus, instead of 'TranscriptStream' you will see simply 'Transcript', and instead of 'StringHolder' you will see 'Workspace', etc. * Several more window types are now governed by the panel, including the message-names tool, versions browser, package-pane browser, preferences panel, lexicon, and instance browser. * Balloon help is provided both for the color swatches and for the tool names in the panel. * The update-tools-flap button is eliminated from the panel -- it was no longer relevant. * The panel window is no longer draggable via interior clicks (thanks to Jim Benson) * The help-message obtained via hitting the ? button is modernized, and is now borne in a string literal in the method rather than in a comment, so that it will be now available in a sourceless image such as the one used for Squeakland. Note the extension of Color.colorFrom: so that it can now also feed off an rgb triplet."! Object subclass: #WindowColorSpec instanceVariableNames: 'classSymbol wording brightColor pastelColor helpMessage ' classVariableNames: '' module: #(Squeak Technology Support)! !Color class methodsFor: 'instance creation' stamp: 'sw 2/26/2002 10:46'! colorFrom: parm "Return an instantiated color from parm. If parm is already a color, return it, else return the result of my performing it if it's a symbol or, if it is a list, it can either be an array of three numbers, which will be interpreted as RGB values, or a list of symbols, the first of which is sent to me and then the others of which are in turn sent to the prior result, thus allowing entries of the form #(blue darker). Else just return the thing" | aColor firstParm | (parm isKindOf: Color) ifTrue: [^ parm]. (parm isKindOf: Symbol) ifTrue: [^ self perform: parm]. ((parm isKindOf: SequenceableCollection) and: [parm size > 0]) ifTrue: [firstParm _ parm first. (firstParm isKindOf: Number) ifTrue: [^ self fromRgbTriplet: parm]. aColor _ self colorFrom: firstParm. parm doWithIndex: [:sym :ind | ind > 1 ifTrue: [aColor _ aColor perform: sym]]. ^ aColor]. ^ parm " Color colorFrom: #(blue darker) Color colorFrom: Color blue darker Color colorFrom: #blue Color colorFrom: #(0.0 0.0 1.0) "! ! !DualChangeSorter class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:12'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Dual Change Sorter' brightColor: #lightBlue pastelColor: #paleBlue helpMessage: 'Lets you view and manipulate two change sets concurrently.'! ! !Lexicon methodsFor: 'control buttons' stamp: 'sw 2/26/2002 12:06'! mostGenericButton "Answer a button that reports on, and allow the user to modify, the most generic class to show" | aButton | aButton _ UpdatingSimpleButtonMorph newWithLabel: 'All'. aButton setNameTo: 'limit class'. aButton target: self; wordingSelector: #limitClassString; actionSelector: #chooseLimitClass. aButton setBalloonText: 'Governs which classes'' methods should be shown. If this is the same as the viewed class, then only methods implemented in that class will be shown. If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'. aButton actWhen: #buttonDown. aButton color: Color transparent. aButton borderColor: Color black. ^ aButton! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 13:56'! installBrightWindowColors "Install the factory-provided default window colors for all tools" "Preferences installBrightWindowColors" self installWindowColorsVia: [:aSpec | aSpec brightColor]! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 13:51'! installMissingWindowColors "Install the factory-provided bright window colors for tools not yet in the dictionary -- a one-time bootstrap" "Preferences installMissingWindowColors" | windowColorDict | (Parameters includesKey: #windowColors) ifFalse: [Parameters at: #windowColors put: IdentityDictionary new]. windowColorDict _ Parameters at: #windowColors. self windowColorTable do: [:colorSpec | (windowColorDict includesKey: colorSpec classSymbol) ifFalse: [windowColorDict at: colorSpec classSymbol put: (Color colorFrom: colorSpec brightColor)]]! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 13:55'! installPastelWindowColors "Install the factory-provided default pastel window colors for all tools" "Preferences installBrightWindowColors" self installWindowColorsVia: [:aSpec | aSpec pastelColor]! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 12:55'! installUniformWindowColors "Install the factory-provided uniform window colors for all tools" "Preferences installUniformWindowColors" self installWindowColorsVia: [:aQuad | #white]! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 13:59'! installWindowColorsVia: colorSpecBlock "Install windows colors using colorSpecBlock to deliver the color source for each element; the block is handed a WindowColorSpec object" "Preferences installBrightWindowColors" | windowColorDict | (Parameters includesKey: #windowColors) ifFalse: [Parameters at: #windowColors put: IdentityDictionary new]. windowColorDict _ Parameters at: #windowColors. self windowColorTable do: [:aColorSpec | windowColorDict at: aColorSpec classSymbol put: (Color colorFrom: (colorSpecBlock value: aColorSpec))]! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 14:28'! windowColorHelp "Provide help for the window-color panel" | helpString | helpString _ 'The "Window Colors" panel lets you select colors for many kinds of standard Squeak windows. You can change your color preference for any particular tool by clicking on the color swatch and then selecting the desired color from the resulting color-picker. The three buttons entitled "Bright", "Pastel", and "White" let you revert to any of three different standard color schemes. The choices you make in the Window Colors panel only affect the colors of new windows that you open. You can make other tools have their colors governed by this panel by simply implementing #windowColorSpecification on the class side of the model -- consult implmentors of that method to see examples of how to do this.'. (StringHolder new contents: helpString) openLabel: 'About Window Colors' "Preferences windowColorHelp"! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 14:14'! windowColorTable "Answer a list of WindowColorSpec objects, one for each tool to be represented in the window-color panel" ^ (((Smalltalk allClassesImplementing: #windowColorSpecification) collect: [:aClass | aClass theNonMetaClass windowColorSpecification]) asSortedCollection: [:specOne :specTwo | specOne wording < specTwo wording]) asArray "Preferences windowColorTable"! ! !Preferences class methodsFor: 'window colors' stamp: 'sw 2/26/2002 14:15'! windowSpecificationPanel "Put up a panel for specifying window colors" "Preferences windowSpecificationPanel" | aPanel buttonRow aButton aRow aSwatch aColor aWindow aMiniWorld aStringMorph | 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 windowColorTable do: [:colorSpec | aRow _ AlignmentMorph newRow color: aColor. aSwatch _ ColorSwatch new target: self; getSelector: #windowColorFor:; putSelector: #setWindowColorFor:to:; argument: colorSpec classSymbol; extent: (40 @ 20); setBalloonText: 'Click here to change the standard color to be used for ', colorSpec wording, ' windows.'; yourself. aRow addMorphFront: aSwatch. aRow addTransparentSpacerOfSize: (12 @ 1). aRow addMorphBack: (aStringMorph _ StringMorph contents: colorSpec wording font: TextStyle defaultFont). aStringMorph setBalloonText: colorSpec helpMessage. aPanel addMorphBack: aRow]. Smalltalk isMorphic ifTrue: [aWindow _ aPanel wrappedInWindowWithTitle: 'Window Colors'. " don't allow the window to be picked up by clicking inside " aPanel on: #mouseDown send: #yourself to: aPanel. 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]! ! !PreferencesPanel class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:41'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Preferences Panel' brightColor: #(0.645 1.0 1.0) pastelColor: #(0.886 1.0 1.0) helpMessage: 'A tool for expressing personal preferences for numerous options.'! ! !StringHolder class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:44'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Workspace' brightColor: #lightYellow pastelColor: #paleYellow helpMessage: 'A place for text in a window.'! ! !Browser class methodsFor: 'window color' stamp: 'sw 2/26/2002 13:46'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Browser' brightColor: #lightGreen pastelColor: #paleGreen helpMessage: 'The standard "system browser" tool that allows you to browse through all the code in the system'! ! !ChangeList class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:07'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Change List' brightColor: #lightBlue pastelColor: #paleBlue helpMessage: 'A tool that presents a list of all the changes found in an external file.'! ! !ChangeSorter class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:09'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Change Sorter' brightColor: #lightBlue pastelColor: #paleBlue helpMessage: 'A tool that lets you see the code for one change set at a time.'! ! !Debugger class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:10'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Debugger' brightColor: #lightRed pastelColor: #veryPaleRed helpMessage: 'The system debugger.'! ! !FileContentsBrowser class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:25'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'File Contents Browser' brightColor: #tan pastelColor: #paleTan helpMessage: 'Lets you view the contents of a file as code, in a browser-like tool.'! ! !FileList class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:04'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'File List' brightColor: #lightMagenta pastelColor: #paleMagenta helpMessage: 'A tool for looking at files'! ! !MessageSet class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:37'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Message List' brightColor: #lightBlue pastelColor: #paleBlue helpMessage: 'A list of messages (e.g. senders, implementors)'! ! !Lexicon class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:35'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Lexicon' brightColor: #(0.878 1.000 0.878) pastelColor: #(0.925 1.000 0.925) helpMessage: 'A tool for browsing the full protocol of a class.'! ! !InstanceBrowser class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:31'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Instance Browser' brightColor: #(0.806 1.0 1.0) pastelColor: #(0.925 1.000 1.0) helpMessage: 'A tool for browsing the full protocol of an instance.'! ! !MessageNames class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:35'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Message Names' brightColor: #(0.645 1.0 0.452) pastelColor: #(0.843 0.976 0.843) helpMessage: 'A tool finding, viewing, and editing all methods whose names contiane a given character sequence.'! ! !PackagePaneBrowser class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:39'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Package Browser' brightColor: #(1.0 1.0 0.6) pastelColor: #(0.976 0.976 0.835) helpMessage: 'A system browser with an extra pane at top-left for module.'! ! !SelectorBrowser class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:43'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Method Finder' brightColor: #lightCyan pastelColor: #palePeach helpMessage: 'A tool for finding methods by giving sample arguments and values.'! ! !TranscriptStream class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:46'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Transcript' brightColor: #lightOrange pastelColor: #paleOrange helpMessage: 'The system transcript'! ! !VersionsBrowser class methodsFor: 'window color' stamp: 'sw 2/26/2002 14:48'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Versions Browser' brightColor: #(0.869 0.753 1.0) pastelColor: #(0.919 0.853 1.0) helpMessage: 'A tool for viewing prior versions of a method.'! ! !WindowColorSpec methodsFor: 'initialization' stamp: 'sw 2/26/2002 13:39'! classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol helpMessage: hlpMsg "Initialize the receiver's instance variables" classSymbol _ sym. wording _ wrd. brightColor _ brCol. pastelColor _ paCol. helpMessage _ hlpMsg! ! !WindowColorSpec methodsFor: 'access' stamp: 'sw 2/26/2002 15:00'! brightColor "Answer the brightColor" ^ brightColor! ! !WindowColorSpec methodsFor: 'access' stamp: 'sw 2/26/2002 14:59'! classSymbol "Answer the classSymbol" ^ classSymbol! ! !WindowColorSpec methodsFor: 'access' stamp: 'sw 2/26/2002 15:00'! helpMessage "Answer the helpMessage" ^ helpMessage! ! !WindowColorSpec methodsFor: 'access' stamp: 'sw 2/26/2002 15:00'! pastelColor "Answer the pastelColor" ^ pastelColor! ! !WindowColorSpec methodsFor: 'access' stamp: 'sw 2/26/2002 14:59'! wording "Answer the wording" ^ wording! ! !WindowColorSpec class methodsFor: 'instance creation' stamp: 'sw 2/26/2002 13:40'! classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol helpMessage: hlpMsg "Answer a new instance of the receiver with the given slots filled in" ^ self new classSymbol: sym wording: wrd brightColor: brCol pastelColor: paCol helpMessage: hlpMsg! ! PreferencesPanel removeSelector: #defaultBackgroundColor! Preferences class removeSelector: #windowColorClasses! PackagePaneBrowser removeSelector: #defaultBackgroundColor! MessageNames removeSelector: #defaultBackgroundColor! InstanceBrowser removeSelector: #defaultBackgroundColor! Lexicon removeSelector: #defaultBackgroundColor! "Postscript:" Preferences installMissingWindowColors.!