'From Squeak3.1alpha of 28 February 2001 [latest update: #4250] on 16 August 2001 at 1:06:04 pm'! "Change Set: AltWindowLook Date: 15 August 2001 Author: Andreas Raab Add an alternative window look allowing us to use clean white backgrounds while keeping colors for fast identification around." Preferences addPreference: #alternativeWindowLook category:'browsing' default: true balloonHelp:'If true, use an alternative window look.'! BorderedMorph subclass: #BorderedSubpaneDividerMorph instanceVariableNames: 'resizingEdge ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !CodeHolder methodsFor: 'annotation' stamp: 'ar 8/15/2001 23:28'! addOptionalAnnotationsTo: window at: fractions plus: verticalOffset "Add an annotation pane to the window if preferences indicate a desire for it, and return the incoming verticalOffset plus the height of the added pane, if any" | aTextMorph divider delta | self wantsAnnotationPane ifFalse: [^ verticalOffset]. aTextMorph _ PluggableTextMorph on: self text: #annotation accept: nil readSelection: nil menu: #annotationPaneMenu:shifted:. aTextMorph askBeforeDiscardingEdits: false; borderWidth: 0; hideScrollBarIndefinitely. divider _ BorderedSubpaneDividerMorph forBottomEdge. Preferences alternativeWindowLook ifTrue:[ divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2. ]. delta _ self defaultAnnotationPaneHeight. window addMorph: aTextMorph fullFrame: (LayoutFrame fractions: fractions offsets: (0@verticalOffset corner: 0@(verticalOffset + delta - 1))). window addMorph: divider fullFrame: (LayoutFrame fractions: fractions offsets: (0@(verticalOffset + delta - 1) corner: 0@(verticalOffset + delta))). ^ verticalOffset + delta! ! !CodeHolder methodsFor: 'controls' stamp: 'ar 8/15/2001 23:28'! addOptionalButtonsTo: window at: fractions plus: verticalOffset "If the receiver wishes it, add a button pane to the window, and answer the verticalOffset plus the height added" | delta buttons divider | self wantsOptionalButtons ifFalse: [^verticalOffset]. delta _ self defaultButtonPaneHeight. buttons _ self optionalButtonRow color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]); borderWidth: 0. Preferences alternativeWindowLook ifTrue:[buttons color: Color transparent]. divider _ BorderedSubpaneDividerMorph forBottomEdge. Preferences alternativeWindowLook ifTrue:[ divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2. ]. window addMorph: buttons fullFrame: (LayoutFrame fractions: fractions offsets: (0@verticalOffset corner: 0@(verticalOffset + delta - 1))). window addMorph: divider fullFrame: (LayoutFrame fractions: fractions offsets: (0@(verticalOffset + delta - 1) corner: 0@(verticalOffset + delta))). ^ verticalOffset + delta! ! !Browser methodsFor: 'initialize-release' stamp: 'ar 8/15/2001 23:28'! addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset | row switchHeight divider | row _ AlignmentMorph newColumn hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 1; layoutPolicy: ProportionalLayout new. switchHeight _ 25. row addMorph: aListPane fullFrame: ( LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@0 corner: 0@switchHeight negated) ). divider _ BorderedSubpaneDividerMorph forTopEdge. Preferences alternativeWindowLook ifTrue:[ divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2. ]. row addMorph: divider fullFrame: ( LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@switchHeight negated corner: 0@(1-switchHeight)) ). self addMorphicSwitchesTo: row at: ( LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@(1-switchHeight) corner: 0@0) ). window addMorph: row fullFrame: ( LayoutFrame fractions: nominalFractions offsets: (0@verticalOffset corner: 0@0) ). row on: #mouseEnter send: #paneTransition: to: window. row on: #mouseLeave send: #paneTransition: to: window. ! ! !Browser methodsFor: 'initialize-release' stamp: 'ar 8/15/2001 23:40'! buildMorphicSwitches | instanceSwitch divider1 divider2 commentSwitch classSwitch row aColor | instanceSwitch _ PluggableButtonMorph on: self getState: #instanceMessagesIndicated action: #indicateInstanceMessages. instanceSwitch label: 'instance'; askBeforeChanging: true; borderWidth: 0. commentSwitch _ PluggableButtonMorph on: self getState: #classCommentIndicated action: #plusButtonHit. commentSwitch label: '?' asText allBold; askBeforeChanging: true; setBalloonText: 'class comment'; borderWidth: 0. classSwitch _ PluggableButtonMorph on: self getState: #classMessagesIndicated action: #indicateClassMessages. classSwitch label: 'class'; askBeforeChanging: true; borderWidth: 0. divider1 := BorderedSubpaneDividerMorph vertical. divider2 := BorderedSubpaneDividerMorph vertical. Preferences alternativeWindowLook ifTrue:[ divider1 extent: 4@4; borderWidth: 2; borderRaised; color: Color transparent. divider2 extent: 4@4; borderWidth: 2; borderRaised; color: Color transparent. ]. row _ AlignmentMorph newRow hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 0; addMorphBack: instanceSwitch; addMorphBack: divider1; addMorphBack: commentSwitch; addMorphBack: divider2; addMorphBack: classSwitch. aColor _ Color colorFrom: self defaultBackgroundColor. Preferences alternativeWindowLook ifTrue:[aColor _ Color white]. {instanceSwitch. commentSwitch. classSwitch} do: [:m | m color: aColor; onColor: aColor darker offColor: aColor; hResizing: #spaceFill; vResizing: #spaceFill. ]. ^ row ! ! !Color methodsFor: 'other' stamp: 'ar 8/16/2001 12:47'! raisedColor ^ self! ! !CornerRounder methodsFor: 'all' stamp: 'ar 8/16/2001 12:47'! tweakCornersOf: aMorph on: aCanvas borderWidth: w corners: cornerList "This variant has a cornerList argument, to allow some corners to be rounded and others not" | offset corner saveBits c fourColors c14 c23 insetColor mask outBits shadowColor | shadowColor _ aCanvas shadowColor. aCanvas shadowColor: nil. "for tweaking it's essential" w > 0 ifTrue: [c _ shadowColor ifNil:[aMorph borderColor]. fourColors _ Array new: 4 withAll: c. c == #raised ifTrue: [c14 _ aMorph raisedColor lighter. c23 _ aMorph raisedColor darker. fourColors _ Array with: c14 with: c23 with: c23 with: c14]. (c == #inset and: [aMorph owner notNil]) ifTrue: [insetColor _ aMorph owner colorForInsets. c14 _ insetColor lighter. c23 _ insetColor darker. fourColors _ Array with: c14 with: c23 with: c23 with: c14]]. mask _ Form extent: cornerMasks first extent depth: aCanvas depth. 1 to: 4 do:[:i | (cornerList includes: i) ifTrue: [corner _ aMorph bounds corners at: i. saveBits _ underBits at: i. i = 1 ifTrue: [offset _ 0@0]. i = 2 ifTrue: [offset _ 0@saveBits height negated]. i = 3 ifTrue: [offset _ saveBits extent negated]. i = 4 ifTrue: [offset _ saveBits width negated@0]. "Mask out corner area (painting saveBits won't clear if transparent)." mask copyBits: mask boundingBox from: (cornerMasks at: i) at: 0@0 clippingBox: mask boundingBox rule: Form over fillColor: nil map: (Bitmap with: 0 with: 16rFFFFFFFF). outBits _ aCanvas contentsOfArea: (corner + offset extent: mask extent). mask displayOn: outBits at: 0@0 rule: Form and. "Paint back corner bits." saveBits displayOn: outBits at: 0@0 rule: Form paint. "Paint back corner bits." aCanvas drawImage: outBits at: corner + offset. w > 0 ifTrue: ["Paint over with border if any" aCanvas stencil: (cornerOverlays at: i) at: corner + offset color: (fourColors at: i)]]]. aCanvas shadowColor: shadowColor. "restore shadow color" ! ! !Debugger methodsFor: 'initialize' stamp: 'ar 8/16/2001 11:27'! buttonRowForPreDebugWindow: aDebugWindow | aRow aButton | aRow _ AlignmentMorph newRow hResizing: #spaceFill. aRow beSticky. aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer. self preDebugButtonQuads do: [:quad | aButton _ SimpleButtonMorph new target: aDebugWindow. aButton color: Color transparent; borderWidth: 1. aButton actionSelector: quad second. aButton label: quad first. aButton submorphs first color: (Color colorFrom: quad third). aButton setBalloonText: quad fourth. Preferences alternativeWindowLook ifTrue:[aButton borderWidth: 2; borderColor: #raised]. aRow addMorphBack: aButton. aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer]. ^ aRow! ! !Debugger methodsFor: 'initialize' stamp: 'ar 8/16/2001 11:26'! optionalButtonRow "Answer a button pane affording the user one-touch access to certain functions; the pane is given the formal name 'buttonPane' by which it can be retrieved by code wishing to send messages to widgets residing on the pane" | aRow aButton | aRow _ AlignmentMorph newRow beSticky. aRow setNameTo: 'buttonPane'. aRow clipSubmorphs: true. aButton _ SimpleButtonMorph new target: self. aButton color: Color lightRed; borderWidth: 1; borderColor: Color red darker. aRow addTransparentSpacerOfSize: (5@0). self optionalButtonPairs do: [:pair | aButton _ PluggableButtonMorph on: self getState: nil action: pair second. aButton hResizing: #spaceFill; vResizing: #spaceFill; useRoundedCorners; label: pair first asString; askBeforeChanging: true; onColor: Color transparent offColor: Color transparent. Preferences alternativeWindowLook ifTrue:[aButton borderWidth: 2; borderColor: #raised]. aRow addMorphBack: aButton. aRow addTransparentSpacerOfSize: (3 @ 0)]. ^ aRow! ! !FileContentsBrowser methodsFor: 'creation' stamp: 'ar 8/15/2001 23:28'! addLowerPanesTo: window at: nominalFractions with: editString | verticalOffset row innerFractions codePane infoPane infoHeight divider | row _ AlignmentMorph newColumn hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 1; borderColor: Color black; layoutPolicy: ProportionalLayout new. codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. infoPane _ PluggableTextMorph on: self text: #infoViewContents accept: nil readSelection: nil menu: nil. verticalOffset _ 0. innerFractions _ 0@0 corner: 1@0. ">>not with this browser--- at least not yet --- verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset. verticalOffset _ self addOptionalButtonsTo: row at: innerFractions plus: verticalOffset. <<<<" infoHeight _ 20. row addMorph: (codePane borderWidth: 0) fullFrame: ( LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@verticalOffset corner: 0@infoHeight negated) ). divider _ BorderedSubpaneDividerMorph forTopEdge. Preferences alternativeWindowLook ifTrue:[ divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2. ]. row addMorph: divider fullFrame: ( LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@infoHeight negated corner: 0@(1-infoHeight)) ). row addMorph: (infoPane borderWidth: 0; hideScrollBarIndefinitely) fullFrame: ( LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@(1-infoHeight) corner: 0@0) ). window addMorph: row frame: nominalFractions. row on: #mouseEnter send: #paneTransition: to: window. row on: #mouseLeave send: #paneTransition: to: window. ! ! !InfiniteForm methodsFor: 'displaying' stamp: 'ar 8/16/2001 12:47'! raisedColor ^ Color transparent! ! !Morph methodsFor: 'accessing' stamp: 'ar 8/15/2001 22:40'! colorForInsets "Return the color to be used for shading inset borders. The default is my own color, but it might want to be, eg, my owner's color. Whoever's color ends up prevailing, the color itself gets the last chance to determine, so that when, for example, an InfiniteForm serves as the color, callers won't choke on some non-Color object being returned" (color isColor and:[color isTransparent and:[owner notNil]]) ifTrue:[^owner colorForInsets]. ^ color colorForInsets ! ! !Morph methodsFor: 'accessing' stamp: 'ar 8/16/2001 12:47'! raisedColor "Return the color to be used for shading raised borders. The default is my own color, but it might want to be, eg, my owner's color. Whoever's color ends up prevailing, the color itself gets the last chance to determine, so that when, for example, an InfiniteForm serves as the color, callers won't choke on some non-Color object being returned" (color isColor and:[color isTransparent and:[owner notNil]]) ifTrue:[^owner raisedColor]. ^ color raisedColor! ! !BorderedMorph methodsFor: 'drawing' stamp: 'ar 8/16/2001 12:47'! drawOn: aCanvas "Draw a rectangle with a solid, inset, or raised border. Note: the raised border color is generated from the receiver's own color, while the inset border color is generated from the color of its owner. This behavior is visually more consistent. Thanks to Hans-Martin Mosner." | insetColor | borderWidth = 0 ifTrue: [ "no border" "Note: This is the hook for border styles. When converting to the new borders we'll just put 0 into the borderWidth" super drawOn: aCanvas. ^ self]. borderColor == #raised ifTrue: [ "Use a hack for now" aCanvas fillRectangle: self bounds fillStyle: self fillStyle. ^ aCanvas frameAndFillRectangle: bounds fillColor: Color transparent borderWidth: borderWidth topLeftColor: (borderWidth = 1 ifTrue: [self raisedColor twiceLighter] ifFalse: [self raisedColor lighter]) bottomRightColor: (borderWidth = 1 ifTrue: [self raisedColor twiceDarker] ifFalse: [self raisedColor darker])]. borderColor == #inset ifTrue: [ insetColor _ owner ifNil: [Color black] ifNotNil: [owner colorForInsets]. aCanvas fillRectangle: self bounds fillStyle: self fillStyle. ^ aCanvas frameAndFillRectangle: bounds fillColor: Color transparent borderWidth: borderWidth topLeftColor: (borderWidth = 1 ifTrue: [insetColor twiceDarker] ifFalse: [insetColor darker]) bottomRightColor: (borderWidth = 1 ifTrue: [insetColor twiceLighter] ifFalse: [insetColor lighter])]. "solid color border" aCanvas fillRectangle: (self bounds insetBy: borderWidth) fillStyle: self fillStyle. aCanvas frameAndFillRectangle: bounds fillColor: Color transparent borderWidth: borderWidth borderColor: borderColor.! ! !BorderedSubpaneDividerMorph methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! firstEnter: evt "The first time this divider is activated, find its window and redirect further interaction there." | window | window := self firstOwnerSuchThat: [:m | m respondsTo: #secondaryPaneTransition:divider:]. window ifNil: [ self suspendEventHandler. ^ self ]. "not working out" window secondaryPaneTransition: evt divider: self. self on: #mouseEnter send: #secondaryPaneTransition:divider: to: window. ! ! !BorderedSubpaneDividerMorph methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! horizontal self hResizing: #spaceFill.! ! !BorderedSubpaneDividerMorph methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! initialize super initialize. self extent: 1@1; color: Color black; borderWidth: 0.! ! !BorderedSubpaneDividerMorph methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! resizingEdge ^resizingEdge ! ! !BorderedSubpaneDividerMorph methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! resizingEdge: edgeSymbol (#(top bottom) includes: edgeSymbol) ifFalse: [ self error: 'resizingEdge must be #top or #bottom' ]. resizingEdge := edgeSymbol. self on: #mouseEnter send: #firstEnter: to: self. ! ! !BorderedSubpaneDividerMorph methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! vertical self vResizing: #spaceFill.! ! !BorderedSubpaneDividerMorph class methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:24'! forBottomEdge ^self new horizontal resizingEdge: #bottom! ! !BorderedSubpaneDividerMorph class methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:25'! forTopEdge ^self new horizontal resizingEdge: #top! ! !BorderedSubpaneDividerMorph class methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:25'! horizontal ^self new horizontal! ! !BorderedSubpaneDividerMorph class methodsFor: 'as yet unclassified' stamp: 'ar 8/15/2001 23:25'! vertical ^self new vertical! ! !PluggableButtonMorph methodsFor: 'events' stamp: 'ar 8/16/2001 11:24'! mouseUp: evt showSelectionFeedback _ false. borderColor isColor ifFalse:[borderColor _ #raised]. allButtons ifNil: [^ self]. allButtons do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m performAction]]. allButtons _ nil. self changed. ! ! !PluggableButtonMorph methodsFor: 'events' stamp: 'ar 8/16/2001 11:24'! updateFeedbackForEvt: evt | newState | newState _ self containsPoint: evt cursorPoint. newState = showSelectionFeedback ifFalse: [ borderColor isColor ifTrue:[showSelectionFeedback _ newState] ifFalse:[borderColor _ newState ifTrue:[#inset] ifFalse:[#raised]]. self changed]. ! ! !Preferences class methodsFor: 'preferences panel' stamp: 'ar 8/15/2001 23:47'! 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 prefObjects cc | 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 listOfCategories do: [:aCat | controlPage _ AlignmentMorph newColumn beSticky color: aColor. controlPage on: #mouseDown send: #yourself to: #(). controlPage dropEnabled: false. Preferences alternativeWindowLook ifTrue:[ cc _ Color transparent. controlPage color: cc]. controlPage borderColor: aColor; layoutInset: 4. (prefObjects _ self preferenceObjectsInCategory: aCat) do: [:aPreference | controlPage addMorphBack: (aPreference representativeButtonWithColor: cc inPanel: aPanel)]. controlPage setNameTo: aCat asString. aCat = '?' ifTrue: [aPanel addHelpItemsTo: controlPage]. aCat == #halos ifTrue: [aPanel addHaloControlsTo: controlPage]. tabbedPalette addTabFor: controlPage font: aFont. aCat = 'search results' ifTrue: [(tabbedPalette tabNamed: aCat) setBalloonText: 'Use the ? category to find preferences by keyword; the results of your search will show up here']. maxEntriesPerCategory _ maxEntriesPerCategory max: prefObjects 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.! ! !PreferencesPanel methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:49'! findPreferencesMatching: incomingTextOrString "find all preferences matching incomingTextOrString" | result aList aPalette controlPage cc | result _ incomingTextOrString asString asLowercase. result _ result asLowercase withBlanksTrimmed. result isEmptyOrNil ifTrue: [^ self]. aList _ Preferences allPreferenceObjects select: [:aPreference | (aPreference name includesSubstring: result caseSensitive: false) or: [aPreference helpString includesSubstring: result caseSensitive: false]]. aPalette _ (self containingWindow ifNil: [^ self]) 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). Preferences alternativeWindowLook ifTrue:[ cc _ Color transparent. controlPage color: cc]. aList _ aList asSortedCollection: [:a :b | a name < b name]. aList do: [:aPreference | controlPage addMorphBack: (aPreference representativeButtonWithColor: cc inPanel: self)]. aPalette world startSteppingSubmorphsOf: aPalette! ! !ProjectViewMorph methodsFor: 'drawing' stamp: 'ar 8/15/2001 23:53'! borderColor ^Color black! ! !ProjectViewMorph methodsFor: 'drawing' stamp: 'ar 8/15/2001 23:52'! borderColor: cc ! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:19'! addCloseBox "If I have a labelArea, add a close box to it" | frame | labelArea ifNil: [^ self]. closeBox _ SimpleButtonMorph new borderWidth: 0; label: 'X' font: Preferences standardButtonFont; color: Color transparent; actionSelector: #closeBoxHit; target: self; extent: 14@14; setBalloonText: 'close this window'. frame _ LayoutFrame new. frame leftFraction: 0; leftOffset: 4; topFraction: 0; topOffset: 1. closeBox layoutFrame: frame. labelArea addMorph: closeBox.! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:19'! addExpandBox "If I have a labelArea, add a close box to it" | frame | labelArea ifNil: [^ self]. expandBox _ IconicButton new borderWidth: 0; labelGraphic: (ScriptingSystem formAtKey: 'expandBox'); color: Color transparent; actWhen: #buttonUp; actionSelector: #expandBoxHit; target: self; setBalloonText: 'expand to full screen'. frame _ LayoutFrame new. frame leftFraction: 1; leftOffset: -30; topFraction: 0; topOffset: 0. expandBox layoutFrame: frame. labelArea addMorph: expandBox.! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:20'! addLabel "Add a label latterly. Does not yet get layouts right" | aFont | label _ StringMorph contents: (labelString ifNil: ['Untitled']) font: Preferences windowTitleFont emphasis: 1. "Add collapse box so #labelHeight will work" aFont _ Preferences standardButtonFont. collapseBox _ SimpleButtonMorph new borderWidth: 0; label: 'O' font: aFont; color: Color transparent; actionSelector: #collapseOrExpand; target: self; extent: 14@14; setBalloonText: 'collapse this window'. stripes _ Array with: (RectangleMorph newBounds: bounds) "see extent:" with: (RectangleMorph newBounds: bounds). self addLabelArea. labelArea addMorph: (stripes first borderWidth: 1). labelArea addMorph: (stripes second borderWidth: 2). self setLabelWidgetAllowance. self addCloseBox. self addMenuControl. labelArea addMorph: label. labelArea addMorph: collapseBox. self setFramesForLabelArea. label on: #mouseDown send: #relabelEvent: to: self. Preferences noviceMode ifTrue: [closeBox ifNotNil: [closeBox setBalloonText: 'close window']. menuBox ifNotNil: [menuBox setBalloonText: 'window menu']. collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']]! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:20'! addMenuControl "If I have a label area, add a menu control to it. " | frame | labelArea ifNil: [^ self]. "No menu if no label area" menuBox ifNotNil: [menuBox delete]. menuBox _ IconicButton new borderWidth: 0; labelGraphic: (ScriptingSystem formAtKey: 'TinyMenu'); color: Color transparent; actWhen: #buttonUp; actionSelector: #offerWindowMenu; target: self; setBalloonText: 'window menu'. frame _ LayoutFrame new. frame leftFraction: 0; leftOffset: 17; topFraction: 0; topOffset: 0. menuBox layoutFrame: frame. labelArea addMorph: menuBox! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:29'! initialize "Initialize a system window. Add label, stripes, etc., if desired" | aFont | super initialize. allowReframeHandles := true. labelString ifNil: [labelString _ 'Untitled Window']. isCollapsed _ false. activeOnlyOnTop _ true. paneMorphs _ Array new. Preferences alternativeWindowLook ifFalse:[ borderColor _ Color black. borderWidth _ 1. color _ Color black. ] ifTrue:[ borderColor _ #raised. borderWidth _ 2. color _ Color white. ]. self layoutPolicy: ProportionalLayout new. self wantsLabel ifTrue: [label _ StringMorph new contents: labelString; font: Preferences windowTitleFont emphasis: 1. "Add collapse box so #labelHeight will work" aFont _ Preferences standardButtonFont. collapseBox _ SimpleButtonMorph new borderWidth: 0; label: 'O' font: aFont; color: Color transparent; actionSelector: #collapseOrExpand; target: self; extent: 14@14; setBalloonText: 'collapse this window'. stripes _ Array with: (RectangleMorph newBounds: bounds) "see extent:" with: (RectangleMorph newBounds: bounds). self addLabelArea. labelArea addMorph: (stripes first borderWidth: 1). labelArea addMorph: (stripes second borderWidth: 2). self setLabelWidgetAllowance. self addCloseBox. self addMenuControl. labelArea addMorph: label. self wantsExpandBox ifTrue: [self addExpandBox]. labelArea addMorph: collapseBox. self setFramesForLabelArea. label on: #mouseDown send: #relabelEvent: to: self. Preferences noviceMode ifTrue: [closeBox ifNotNil: [closeBox setBalloonText: 'close window']. menuBox ifNotNil: [menuBox setBalloonText: 'window menu']. collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']]]. self on: #mouseEnter send: #spawnReframeHandle: to: self. self on: #mouseLeave send: #spawnReframeHandle: to: self. self extent: 300@200. mustNotClose _ false. updatablePanes _ Array new.! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 22:16'! model: anObject super model: anObject. self paneColor: nil.! ! !SystemWindow methodsFor: 'initialization' stamp: 'ar 8/15/2001 23:29'! setFramesForLabelArea "an aid to converting old instances, but then I found convertAlignment (jesse welton's note)" | frame | labelArea ifNil: [^ self]. frame _ LayoutFrame new. frame leftFraction: 0.5; topFraction: 0; leftOffset: label width negated // 2. label layoutFrame: frame. frame _ LayoutFrame new. frame rightFraction: 1; topFraction: 0; rightOffset: -1; topOffset: 1. collapseBox ifNotNilDo: [:cb | cb layoutFrame: frame]. stripes isEmptyOrNil ifFalse: [frame _ LayoutFrame new. frame leftFraction: 0; topFraction: 0; rightFraction: 1; leftOffset: 1; topOffset: 1; rightOffset: -1. stripes first layoutFrame: frame. stripes first height: self labelHeight - 2. stripes first hResizing: #spaceFill. frame _ LayoutFrame new. frame leftFraction: 0; topFraction: 0; rightFraction: 1; leftOffset: 3; topOffset: 3; rightOffset: -3. stripes last layoutFrame: frame. stripes last height: self labelHeight - 6. stripes last hResizing: #spaceFill]. labelArea ifNotNil: [frame _ LayoutFrame new. frame leftFraction: 0; topFraction: 0; rightFraction: 1; topOffset: self labelHeight negated. Preferences alternativeWindowLook ifTrue:[ frame leftOffset: -1; rightOffset: 1; topOffset: self labelHeight negated - 1; bottomFraction: 0; bottomOffset: 1. ]. labelArea layoutFrame: frame] ! ! !SystemWindow methodsFor: 'label' stamp: 'ar 8/16/2001 11:15'! setStripeColorsFrom: paneColor "Set the stripe color based on the given paneColor" Preferences alternativeWindowLook ifTrue:[labelArea ifNotNil:[labelArea color: paneColor lighter]]. stripes ifNil: [^ self]. Preferences alternativeWindowLook ifFalse:[ self isActive ifTrue: [stripes second color: paneColor; borderColor: stripes second color darker. stripes first color: stripes second borderColor darker; borderColor: stripes first color darker] ifFalse: ["This could be much faster" stripes second color: paneColor; borderColor: paneColor. stripes first color: paneColor; borderColor: paneColor]. ] ifTrue:[ self isActive ifTrue: [stripes first borderColor: paneColor lighter; color: stripes first borderColor. stripes second borderColor: stripes first color lighter; color: stripes second borderColor] ifFalse: ["This could be much faster" stripes second color: paneColor; borderColor: paneColor. stripes first color: paneColor; borderColor: paneColor]. ].! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 23:29'! addMorph: aMorph fullFrame: aLayoutFrame super addMorph: aMorph fullFrame: aLayoutFrame. paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph). Preferences alternativeWindowLook ifFalse:[ aMorph borderWidth: 1. aMorph color: self paneColor. ] ifTrue:[ aMorph borderWidth: 2; borderColor: #inset; color: Color transparent. ].! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 23:29'! existingPaneColor "Answer the existing pane color for the window, obtaining it from the first paneMorph if any, and fall back on using the second stripe color if necessary." | aColor | Preferences alternativeWindowLook ifTrue:[ aColor _ self valueOfProperty: #paneColor. aColor ifNil:[self setProperty: #paneColor toValue: (aColor _ self paneColor)]. ^aColor]. paneMorphs isEmptyOrNil ifFalse: [((aColor _ paneMorphs first color) isKindOf: Color) ifTrue: [^ aColor]]. ^ stripes ifNotNil: [stripes second color] ifNil: [Color blue lighter]! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 23:58'! paneColor | cc | (cc _ self valueOfProperty: #paneColor) ifNotNil:[^cc]. Display depth > 2 ifTrue:[ model ifNotNil: [ model isInMemory ifTrue: [ cc _ Color colorFrom: model defaultBackgroundColor. Preferences alternativeWindowLook ifTrue:[ (cc = Color lightYellow or:[cc = Color white]) ifTrue:[cc _ Color gray] ifFalse:[cc _ cc darker]]. ]. ]. cc ifNil:[cc _ paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]]. cc ifNil:[cc _ Color white]. self paneColor: cc. ^cc! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 22:13'! paneColor: aColor self setProperty: #paneColor toValue: aColor.! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 22:14'! paneColorToUse ^ Display depth <= 2 ifTrue: [Color white] ifFalse: [self paneColor]! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 23:43'! replacePane: oldPane with: newPane "Make newPane exactly occupy the position and extent of oldPane" | aLayoutFrame hadDep | hadDep _ model dependents includes: oldPane. oldPane owner replaceSubmorph: oldPane by: newPane. newPane position: oldPane position; extent: oldPane extent. aLayoutFrame _ oldPane layoutFrame. paneMorphs _ paneMorphs collect: [:each | each == oldPane ifTrue: [newPane] ifFalse: [each]]. aLayoutFrame ifNotNil: [newPane layoutFrame: aLayoutFrame]. Preferences alternativeWindowLook ifTrue:[newPane color: Color transparent] ifFalse:[oldPane color = self paneColor ifTrue: [newPane color: self paneColor]]. hadDep ifTrue: [model removeDependent: oldPane. model addDependent: newPane]. self changed ! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 23:44'! restoreDefaultPaneColor "Useful when changing from monochrome to color display" self setStripeColorsFrom: self paneColor. Preferences alternativeWindowLook ifFalse:[ paneMorphs do: [:p | p color: self paneColor]].! ! !SystemWindow methodsFor: 'panes' stamp: 'ar 8/15/2001 23:42'! updatePaneColors "Useful when changing from monochrome to color display" self setStripeColorsFrom: self paneColorToUse. Preferences alternativeWindowLook ifFalse:[ paneMorphs do: [:p | p color: self paneColorToUse]].! ! !SystemWindow methodsFor: 'drawing' stamp: 'ar 8/15/2001 21:55'! colorForInsets ^self paneColor colorForInsets! ! !SystemWindow methodsFor: 'drawing' stamp: 'ar 8/16/2001 12:47'! raisedColor ^self paneColor raisedColor! ! !SystemWindow methodsFor: 'menu' stamp: 'ar 8/15/2001 23:29'! setWindowColor: incomingColor | existingColor aColor | incomingColor ifNil: [^ self]. "it happens" aColor _ incomingColor asNontranslucentColor. (aColor = ColorPickerMorph perniciousBorderColor or: [aColor = Color black]) ifTrue: [^ self]. existingColor _ self paneColorToUse. existingColor ifNil: [^ self beep]. Preferences alternativeWindowLook ifFalse:[ (self allMorphs copyWithout: self) do:[:aMorph | ((aMorph isKindOf: PluggableButtonMorph) and: [aMorph offColor = existingColor]) ifTrue: [aMorph onColor: aColor darker offColor: aColor]. aMorph color = existingColor ifTrue: [aMorph color: aColor]]]. self paneColor: aColor. self setStripeColorsFrom: aColor. self changed.! ! SystemWindow removeSelector: #colorForRaised! Morph removeSelector: #colorForRaised! InfiniteForm removeSelector: #colorForRaised! Color removeSelector: #colorForRaised! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." !