Packages July 2016

packages@lists.squeakfoundation.org

1 participants
141 discussions

The Trunk: Morphic-mt.1213.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1213.mcz ==================== Summary ==================== Name: Morphic-mt.1213 Author: mt Time: 31 July 2016, 11:20:50.02449 am UUID: c742cfa9-9c98-5a44-a7ad-28b28510a158 Ancestors: Morphic-mt.1212 *** Widget Refactorings and UI Themes (Part 6 of 11) *** Some fixes and refactorings for lists, trees, text boxes --- including added support for UI theming. =============== Diff against Morphic-mt.1212 =============== Item was added: + ----- Method: IndentingListItemMorph>>colorToUse (in category 'drawing') ----- + colorToUse + + ^ (self valueOfProperty: #wasRefreshed ifAbsent: [false]) + ifTrue: [complexContents highlightColor ifNil: [self highlightTextColor]] + ifFalse: [ + self isSelected ifTrue: [^ self selectionTextColor]. + complexContents preferredColor ifNil: [self color]]! Item was added: + ----- Method: IndentingListItemMorph>>drawHoverOn: (in category 'drawing') ----- + drawHoverOn: aCanvas + + aCanvas + fillRectangle: self bounds + color: self hoverColor.! Item was changed: ----- Method: IndentingListItemMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | tRect sRect columnScanner columnLeft | self backgroundColor ifNotNil: [:c | aCanvas fillRectangle: self innerBounds color: c]. tRect := self toggleRectangle. self drawToggleOn: aCanvas in: tRect. sRect := bounds withLeft: tRect right + self hMargin. sRect := sRect top: sRect top + sRect bottom - self fontToUse height // 2. (container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [ icon ifNotNil: [ aCanvas translucentImage: icon at: sRect left @ (self top + (self height - icon height // 2)). sRect := sRect left: sRect left + icon width + 2. ]. + aCanvas drawString: contents asString in: sRect font: self fontToUse color: self colorToUse. - aCanvas drawString: contents asString in: sRect font: self fontToUse color: color. ] ifFalse: [ columnLeft := sRect left. columnScanner := ReadStream on: contents asString. container columns withIndexDo: [ :widthSpec :column | | columnRect columnData columnWidth | "Draw icon." column = self class iconColumnIndex ifTrue: [ icon ifNotNil: [ aCanvas translucentImage: icon at: columnLeft @ (self top + (self height - icon height // 2)). columnLeft := columnLeft + icon width + 2]]. columnWidth := self widthOfColumn: column. columnRect := columnLeft @ sRect top extent: columnWidth @ sRect height. columnData := columnScanner upTo: Character tab. "Draw string." columnData ifNotEmpty: [ + aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse]. - aCanvas drawString: columnData in: columnRect font: self fontToUse color: color]. "Compute next column offset." columnLeft := columnRect right + 5. column = 1 ifTrue: [columnLeft := columnLeft - tRect right + self left]. ]. ]! Item was added: + ----- Method: IndentingListItemMorph>>drawSelectionOn: (in category 'drawing') ----- + drawSelectionOn: aCanvas + + | fill | + fill := self selectionColor isColor + ifTrue: [SolidFillStyle color: self selectionColor] + ifFalse: [self selectionColor]. + fill isGradientFill ifTrue: [ + fill origin: self topLeft. + fill direction: 0@ self height]. + + aCanvas + fillRectangle: self bounds + fillStyle: fill.! Item was added: + ----- Method: IndentingListItemMorph>>filterColor (in category 'accessing') ----- + filterColor + + ^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]! Item was added: + ----- Method: IndentingListItemMorph>>filterColor: (in category 'accessing') ----- + filterColor: aColor + + | cc fill | + cc := aColor. + + MenuMorph gradientMenu + ifFalse: [fill := SolidFillStyle color: cc] + ifTrue: [ + fill := GradientFillStyle ramp: { + 0.0 -> cc twiceLighter. + 1 -> cc twiceDarker }]. + + self setProperty: #filterColor toValue: fill.! Item was added: + ----- Method: IndentingListItemMorph>>filterTextColor (in category 'accessing') ----- + filterTextColor + + ^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]! Item was added: + ----- Method: IndentingListItemMorph>>filterTextColor: (in category 'accessing') ----- + filterTextColor: aColor + + self setProperty: #filterTextColor toValue: aColor.! Item was added: + ----- Method: IndentingListItemMorph>>fitContents (in category 'accessing') ----- + fitContents + + super fitContents. + self width: container preferredSubmorphWidth.! Item was changed: + ----- Method: IndentingListItemMorph>>highlight (in category 'drawing') ----- - ----- Method: IndentingListItemMorph>>highlight (in category 'container protocol - private') ----- highlight - (self valueOfProperty: #wasRefreshed ifAbsent: [false]) - ifFalse: [self color: complexContents highlightingColor] - ifTrue: [self color: self color negated]. - self changed. ! Item was added: + ----- Method: IndentingListItemMorph>>highlightTextColor (in category 'accessing') ----- + highlightTextColor + + ^ self valueOfProperty: #highlightTextColor ifAbsent: [Color red]! Item was added: + ----- Method: IndentingListItemMorph>>highlightTextColor: (in category 'accessing') ----- + highlightTextColor: aColor + + self setProperty: #highlightTextColor toValue: aColor.! Item was added: + ----- Method: IndentingListItemMorph>>hoverColor (in category 'accessing') ----- + hoverColor + + ^ self valueOfProperty: #hoverColor ifAbsent: [Color veryLightGray]! Item was added: + ----- Method: IndentingListItemMorph>>hoverColor: (in category 'accessing') ----- + hoverColor: aColor + + self setProperty: #hoverColor toValue: aColor.! Item was added: + ----- Method: IndentingListItemMorph>>isSelected (in category 'testing') ----- + isSelected + + ^ container ifNil: [false] ifNotNil: [container selectedMorph == self]! Item was changed: ----- Method: IndentingListItemMorph>>refresh (in category 'initialization') ----- refresh self contents: self getLabel. icon := self getIcon. - self width: container preferredSubmorphWidth. (self valueOfProperty: #wasRefreshed ifAbsent: [false]) ifFalse: [ + self setProperty: #wasRefreshed toValue: true].! - self setProperty: #wasRefreshed toValue: true. - self color: Color yellow. "Indicate refresh operation."].! Item was added: + ----- Method: IndentingListItemMorph>>selectionColor (in category 'accessing') ----- + selectionColor + + ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]! Item was added: + ----- Method: IndentingListItemMorph>>selectionColor: (in category 'accessing') ----- + selectionColor: aColor + + | cc fill | + cc := aColor. + + MenuMorph gradientMenu + ifFalse: [fill := SolidFillStyle color: cc] + ifTrue: [ + fill := GradientFillStyle ramp: { + 0.0 -> cc twiceLighter. + 1 -> cc twiceDarker }]. + + self setProperty: #selectionColor toValue: fill.! Item was added: + ----- Method: IndentingListItemMorph>>selectionTextColor (in category 'accessing') ----- + selectionTextColor + + ^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]! Item was added: + ----- Method: IndentingListItemMorph>>selectionTextColor: (in category 'accessing') ----- + selectionTextColor: aColor + + self setProperty: #selectionTextColor toValue: aColor.! Item was changed: ----- Method: IndentingListItemMorph>>unhighlight (in category 'drawing') ----- unhighlight - (self valueOfProperty: #wasRefreshed ifAbsent: [false]) - ifFalse: [self color: complexContents preferredColor] - ifTrue: [self color: self color negated]. - self changed. ! Item was changed: Morph subclass: #LazyListMorph instanceVariableNames: 'listItems listIcons listFilterOffsets font selectedRow selectedRows preSelectedRow listSource maxWidth' + classVariableNames: '' - classVariableNames: 'ListPreSelectionColor ListSelectionColor ListSelectionTextColor' poolDictionaries: '' category: 'Morphic-Widgets'! !LazyListMorph commentStamp: 'efc 8/6/2005 11:34' prior: 0! The morph that displays the list in a PluggableListMorph. It is "lazy" because it will only request the list items that it actually needs to display. I will cache the maximum width of my items in maxWidth to avoid this potentially expensive and frequent computation.! Item was removed: - ----- Method: LazyListMorph class>>listFilterHighlightColor (in category 'preferences') ----- - listFilterHighlightColor - - ^ Color yellow paler alpha: 0.5! Item was removed: - ----- Method: LazyListMorph class>>listPreSelectionColor (in category 'preferences') ----- - listPreSelectionColor - <preference: 'List Pre Selection Color' - category: 'colors' - description: 'Governs the color of pre selection highlight in lists' - type: #Color> - ^ ListPreSelectionColor ifNil: [Color r: 0.9 g: 0.9 b: 0.9]! Item was removed: - ----- Method: LazyListMorph class>>listPreSelectionColor: (in category 'preferences') ----- - listPreSelectionColor: aColor - - ListPreSelectionColor := aColor. - World invalidRect: World bounds from: World.! Item was removed: - ----- Method: LazyListMorph class>>listSelectionColor (in category 'preferences') ----- - listSelectionColor - <preference: 'List Selection Color' - category: 'colors' - description: 'Governs the selection background in lists' - type: #Color> - ^ ListSelectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]! Item was removed: - ----- Method: LazyListMorph class>>listSelectionColor: (in category 'preferences') ----- - listSelectionColor: aColor - - ListSelectionColor := aColor. - World invalidRect: World bounds from: World.! Item was removed: - ----- Method: LazyListMorph class>>listSelectionTextColor (in category 'preferences') ----- - listSelectionTextColor - <preference: 'List Selection Text Color' - category: 'colors' - description: 'Governs the color of selected text in lists' - type: #Color> - ^ ListSelectionTextColor ifNil: [Color black]! Item was removed: - ----- Method: LazyListMorph class>>listSelectionTextColor: (in category 'preferences') ----- - listSelectionTextColor: aColor - - ListSelectionTextColor := aColor. - World invalidRect: World bounds from: World.! Item was changed: ----- Method: LazyListMorph>>colorForRow: (in category 'drawing') ----- colorForRow: row ^(selectedRow notNil and: [ row = selectedRow]) + ifTrue: [ self selectionTextColor ] - ifTrue: [ self class listSelectionTextColor ] ifFalse: [ self color ].! Item was changed: ----- Method: LazyListMorph>>display:atRow:on: (in category 'drawing') ----- display: item atRow: row on: canvas "display the given item at row row" | drawBounds emphasized rowColor itemAsText | itemAsText := item asStringOrText. "If it is a text, we will only use the first character's emphasis." emphasized := itemAsText isText ifTrue: [font emphasized: (itemAsText emphasisAt: 1)] ifFalse: [font]. rowColor := itemAsText isText ifTrue: [itemAsText colorAt: 1 ifNone: [self colorForRow: row]] ifFalse: [self colorForRow: row]. drawBounds := (self drawBoundsForRow: row) translateBy: (self hMargin @ 0). drawBounds := drawBounds intersect: self bounds. "Draw icon if existing. Adjust draw bounds in that case." (self icon: row) ifNotNil: [ :icon || top | top := drawBounds top + ((drawBounds height - icon height) // 2). canvas translucentImage: icon at: drawBounds left @ top. drawBounds := drawBounds left: drawBounds left + icon width + 2 ]. - - "Draw filter matches if any." - (self filterOffsets: row) do: [:offset | - canvas - frameAndFillRoundRect: ((drawBounds left + offset first) @ drawBounds top corner: (drawBounds left + offset last) @ drawBounds bottom) - radius: 3 - fillStyle: self class listFilterHighlightColor - borderWidth: 1 - borderColor: self class listFilterHighlightColor twiceDarker]. "We will only draw strings here." canvas drawString: itemAsText asString in: drawBounds font: emphasized + color: rowColor. + + "Draw filter matches if any." + self + displayFilterOn: canvas + for: row + in: drawBounds + font: emphasized.! - color: rowColor.! Item was added: + ----- Method: LazyListMorph>>displayFilterOn:for:in:font: (in category 'drawing') ----- + displayFilterOn: canvas for: row in: drawBounds font: font + "Draw filter matches if any." + + | fill | + fill := self filterColor isColor + ifTrue: [SolidFillStyle color: self filterColor] + ifFalse: [self filterColor]. + fill isGradientFill ifTrue: [ + fill origin: drawBounds topLeft. + fill direction: 0@ drawBounds height]. + + (self filterOffsets: row) do: [:offset | | r | + r := ((drawBounds left + offset first first) @ drawBounds top corner: (drawBounds left + offset first last) @ drawBounds bottom). + canvas + frameAndFillRoundRect: (r outsetBy: 1@0) + radius: 3 + fillStyle: fill + borderWidth: 1 + borderColor: fill asColor twiceDarker. + canvas + drawString: offset second + in: r + font: font + color: self filterTextColor].! Item was changed: ----- Method: LazyListMorph>>drawBackgroundForMulti:on: (in category 'drawing') ----- drawBackgroundForMulti: row on: aCanvas "shade the background paler, if this row is selected, but not the current selected row" + | selectionDrawBounds | + selectedRow = row ifTrue: [^ self]. - | selectionDrawBounds thisColor | - thisColor := selectedRow = row - ifTrue: [ self class listSelectionColor twiceDarker ] - ifFalse: [ self class listSelectionColor ]. selectionDrawBounds := self drawBoundsForRow: row. selectionDrawBounds := selectionDrawBounds intersect: self bounds. aCanvas fillRectangle: selectionDrawBounds + color: self multiSelectionColor! - color: thisColor! Item was removed: - ----- Method: LazyListMorph>>drawBackgroundForPotentialDrop:on: (in category 'drawing') ----- - drawBackgroundForPotentialDrop: row on: aCanvas - | selectionDrawBounds | - "shade the background darker, if this row is a potential drop target" - - selectionDrawBounds := self drawBoundsForRow: row. - selectionDrawBounds := selectionDrawBounds intersect: self bounds. - aCanvas fillRectangle: selectionDrawBounds color: self color muchLighter darker! Item was changed: ----- Method: LazyListMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | topRow bottomRow | listItems ifEmpty: [ ^self ]. + + self drawPreSelectionOn: aCanvas. + - - self - drawPreSelectionOn: aCanvas; - drawSelectionOn: aCanvas. - topRow := self topVisibleRowForCanvas: aCanvas. bottomRow := self bottomVisibleRowForCanvas: aCanvas. "Draw multi-selection." topRow to: bottomRow do: [ :row | (listSource itemSelectedAmongMultiple: row) ifTrue: [ self drawBackgroundForMulti: row on: aCanvas ] ]. + self drawSelectionOn: aCanvas. "Draw hovered row if preference enabled." PluggableListMorph highlightHoveredRow ifTrue: [ listSource hoverRow > 0 ifTrue: [ self highlightHoverRow: listSource hoverRow on: aCanvas ] ]. "Draw all visible rows." topRow to: bottomRow do: [ :row | self display: (self item: row) atRow: row on: aCanvas ]. "Finally, highlight drop row for drag/drop operations.." listSource potentialDropRow > 0 ifTrue: [ self highlightPotentialDropRow: listSource potentialDropRow on: aCanvas ].! Item was changed: ----- Method: LazyListMorph>>drawPreSelectionOn: (in category 'drawing') ----- drawPreSelectionOn: aCanvas self drawSelectionFor: preSelectedRow + withColor: self preSelectionColor - withColor: self class listPreSelectionColor on: aCanvas! Item was changed: ----- Method: LazyListMorph>>drawSelectionFor:withColor:on: (in category 'drawing') ----- drawSelectionFor: index withColor: color on: aCanvas + | selectionDrawBounds fill | - | selectionDrawBounds | index ifNil: [ ^self ]. index = 0 ifTrue: [ ^self ]. selectionDrawBounds := self drawBoundsForRow: index. selectionDrawBounds := selectionDrawBounds intersect: self bounds. + + fill := color isColor + ifTrue: [SolidFillStyle color: color] + ifFalse: [color]. + fill isGradientFill ifTrue: [ + fill origin: selectionDrawBounds topLeft. + fill direction: 0@ selectionDrawBounds height]. + + aCanvas fillRectangle: selectionDrawBounds fillStyle: fill.! - aCanvas fillRectangle: selectionDrawBounds color: color.! Item was changed: ----- Method: LazyListMorph>>drawSelectionOn: (in category 'drawing') ----- drawSelectionOn: aCanvas self drawSelectionFor: selectedRow + withColor: self selectionColor - withColor: self class listSelectionColor on: aCanvas! Item was added: + ----- Method: LazyListMorph>>filterColor (in category 'accessing') ----- + filterColor + ^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]! Item was added: + ----- Method: LazyListMorph>>filterColor: (in category 'accessing') ----- + filterColor: aColor + + | cc fill | + cc := aColor. + + MenuMorph gradientMenu + ifFalse: [fill := SolidFillStyle color: cc] + ifTrue: [ + fill := GradientFillStyle ramp: { + 0.0 -> cc twiceLighter. + 1 -> cc twiceDarker }]. + + self setProperty: #filterColor toValue: fill! Item was added: + ----- Method: LazyListMorph>>filterTextColor (in category 'accessing') ----- + filterTextColor + ^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]! Item was changed: ----- Method: LazyListMorph>>getFilterOffsets: (in category 'list access') ----- getFilterOffsets: row "Calculate matching character indexes for the current filter term." + | item filter offsets currentIndex sub | - | item filter offsets currentIndex | filter := listSource filterTerm. filter ifEmpty: [^ Array empty]. item := (self item: row) asStringOrText asString. "See row drawing. Strings only." offsets := OrderedCollection new. currentIndex := 1. [currentIndex > 0] whileTrue: [ currentIndex := item findString: filter startingAt: currentIndex caseSensitive: false. currentIndex > 0 ifTrue: [ | left width | left := font widthOfString: item from: 1 to: currentIndex-1. + sub := item copyFrom: currentIndex to: currentIndex + filter size - 1. + width := font widthOfString: sub. + offsets addLast: {(left to: left + width). sub}. - width := font widthOfString: item from: currentIndex to: currentIndex + filter size - 1. - offsets addLast: (left to: left + width). currentIndex := currentIndex + 1] ]. ^ offsets! Item was changed: ----- Method: LazyListMorph>>highlightHoverRow:on: (in category 'drawing') ----- highlightHoverRow: row on: aCanvas | drawBounds | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. + aCanvas fillRectangle: drawBounds color: self hoverColor.! - aCanvas fillRectangle: drawBounds color: (self class listSelectionColor darker alpha: 0.3).! Item was changed: ----- Method: LazyListMorph>>highlightPotentialDropRow:on: (in category 'drawing') ----- highlightPotentialDropRow: row on: aCanvas | drawBounds | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. + aCanvas frameRectangle: drawBounds color: self selectionColor asColor! - aCanvas frameRectangle: drawBounds color: Color blue! Item was added: + ----- Method: LazyListMorph>>hoverColor (in category 'accessing') ----- + hoverColor + ^ self valueOfProperty: #hoverColor ifAbsent: [Color veryVeryLightGray]! Item was added: + ----- Method: LazyListMorph>>multiSelectionColor (in category 'accessing') ----- + multiSelectionColor + + ^ self valueOfProperty: #multiSelectionColor ifAbsent: [self selectionColor asColor]! Item was added: + ----- Method: LazyListMorph>>multiSelectionColor: (in category 'accessing') ----- + multiSelectionColor: aColor + + self setProperty: #multiSelectionColor toValue: aColor.! Item was added: + ----- Method: LazyListMorph>>preSelectionColor (in category 'accessing') ----- + preSelectionColor + ^ self valueOfProperty: #preSelectionColor ifAbsent: [Color gray]! Item was added: + ----- Method: LazyListMorph>>resetFilterOffsets (in category 'list access') ----- + resetFilterOffsets + + listFilterOffsets := nil.! Item was added: + ----- Method: LazyListMorph>>selectionColor (in category 'accessing') ----- + selectionColor + ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]! Item was added: + ----- Method: LazyListMorph>>selectionColor: (in category 'accessing') ----- + selectionColor: aColor + + | cc fill | + cc := aColor. + + MenuMorph gradientMenu + ifFalse: [fill := SolidFillStyle color: cc] + ifTrue: [ + fill := GradientFillStyle ramp: { + 0.0 -> cc twiceLighter. + 1 -> cc twiceDarker }]. + + self setProperty: #selectionColor toValue: fill! Item was added: + ----- Method: LazyListMorph>>selectionTextColor (in category 'accessing') ----- + selectionTextColor + ^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]! Item was added: + ----- Method: ListItemWrapper>>highlightColor (in category 'accessing') ----- + highlightColor + "You can override the current theme's default with a custom value." + + ^ nil! Item was removed: - ----- Method: ListItemWrapper>>highlightingColor (in category 'accessing') ----- - highlightingColor - - ^ LazyListMorph listSelectionColor makeForegroundColor! Item was changed: ----- Method: ListItemWrapper>>preferredColor (in category 'accessing') ----- preferredColor + "You can override the current theme's default with a custom value." + + ^ nil! - ^ Color black! Item was changed: Object subclass: #NewParagraph + instanceVariableNames: 'text textStyle firstCharacterIndex container lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop wantsColumnBreaks focused caretRect showCaret caretColor selectionColor unfocusedSelectionColor' - instanceVariableNames: 'text textStyle firstCharacterIndex container lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop wantsColumnBreaks focused caretRect showCaret' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Text Support'! !NewParagraph commentStamp: '<historical>' prior: 0! A Paragraph represents text that has been laid out, or composed, in some container. text A Text with encoded per-character emphasis. textStyle A TextStyle with font set, line height and horizontal alignment. firstCharacterIndex The starting index in text for this paragraph, allowing composition of a long text into a number of containers. container A Rectangle or TextContainer that determines where text can go. lines An Array of TextLines comprising the final layout of the text after it has been composed within its container. positionWhenComposed As its name implies. Allows display at new locations without the need to recompose the text. Lines are ordered vertically. However, for a given y, there may be several lines in left to right order. Lines must never be empty, even if text is empty. Notes on yet another hack - 5 Feb 2001 We really need to clean up #composeLinesFrom:to:delta:into:priorLines:atY:!!!!!! I added one more habdful of code to correct: This is an annoying bug that's been around for a couple of years, but I finally figured out how to duplicate the problem, so I figured I'd just report it now. (It doesn't necessarily have to be fixed for 3.0 if it looks messy, but if it's a simple fix, it would be worth it.) In Morphic, if you have the following text in a workspace: This is line 1 This is line 2 **and** you have a return character after line 2, you will normally be able to click the mouse two times below line 2 in order to select all the text. If you edit line 2 (e.g. so that it reads "line number 2"), you can still select all the text by clicking below the second line. However, if you edit line 1, you will not be able to select all the text from the bottom in the same way. Things get messed up such that the last return character seems to be gone. In this state, if you position the cursor immediately after the 2, and press the right arrow, the cursor jumps to the beginning of line 2... oof. (report by Doug Way) While I don't have a very deep understanding of the above mentioned method, I was able to determine that text ending in a CR worked better in the editor when the last entry in <lines> had a start of text size + 1 and a stop of text size. I have accordingly added code near the end to ensure this. It seems to have fixed the problem, but we do need to clean this baby up some day. - Bob ! Item was added: + ----- Method: NewParagraph>>caretColor (in category 'access') ----- + caretColor + ^ caretColor ifNil: [Color red]! Item was added: + ----- Method: NewParagraph>>caretColor: (in category 'access') ----- + caretColor: aColor + caretColor := aColor.! Item was changed: ----- Method: NewParagraph>>caretWidth (in category 'access') ----- caretWidth ^ Editor dumbbellCursor ifTrue: [ 3 ] + ifFalse: [ 2 ]! - ifFalse: [ 1 ]! Item was added: + ----- Method: NewParagraph>>displayDumbbellCursorOn:at:in: (in category 'display') ----- + displayDumbbellCursorOn: aCanvas at: leftX in: line + + | w | + w := 2. + self focused ifFalse: [^ w]. + + 1 to: w + do: + [:i | + "Draw caret triangles at top and bottom" + + aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) + extent: ((w - i) * 2 + 3) @ 1) + color: self caretColor. + aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) + extent: ((w - i) * 2 + 3) @ 1) + color: self caretColor]. + + aCanvas + line: leftX @ line top + to: leftX @ (line bottom-1) + color: self caretColor. + + ^ w! Item was changed: ----- Method: NewParagraph>>displaySelectionInLine:on: (in category 'display') ----- displaySelectionInLine: line on: aCanvas + | leftX rightX w | - | leftX rightX w caretColor | selectionStart ifNil: [^self]. "No selection" aCanvas isShadowDrawing ifTrue: [ ^self ]. "don't draw selection with shadow" selectionStart = selectionStop ifTrue: ["Only show caret on line where clicked" selectionStart textLine ~= line ifTrue: [^self]] + ifFalse: - ifFalse: ["Test entire selection before or after here" (selectionStop stringIndex < line first or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self]. "No selection on this line" (selectionStop stringIndex = line first and: [selectionStop textLine ~= line]) ifTrue: [^self]. "Selection ends on line above" (selectionStart stringIndex = (line last + 1) and: [selectionStop textLine ~= line]) ifTrue: [^self]]. "Selection begins on line below" leftX := (selectionStart stringIndex < line first ifTrue: [line ] ifFalse: [selectionStart ])left. rightX := (selectionStop stringIndex > (line last + 1) or: [selectionStop stringIndex = (line last + 1) and: [selectionStop textLine ~= line]]) ifTrue: [line right] ifFalse: [selectionStop left]. selectionStart = selectionStop + ifTrue: [ + rightX := rightX + 1. + caretRect := (leftX-2) @ line top corner: (rightX+2)@ line bottom. "sigh..." + self showCaret ifFalse: [^self]. + w := (Editor dumbbellCursor + ifTrue: [self displayDumbbellCursorOn: aCanvas at: leftX in: line] + ifFalse: [self displaySimpleCursorOn: aCanvas at: leftX in: line]). + caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom] + ifFalse: [ + caretRect := nil. - ifTrue: - [rightX := rightX + 1. - w := self caretWidth-1. - caretRect := (leftX-w) @ line top corner: (rightX+w)@ line bottom. - self showCaret ifFalse:[^self]. - caretColor := self insertionPointColor. - 1 to: w - do: - [:i | - "Draw caret triangles at top and bottom" - - aCanvas fillRectangle: ((leftX - w + i - 1) @ (line top + i - 1) - extent: ((w - i) * 2 + 3) @ 1) - color: caretColor. - aCanvas fillRectangle: ((leftX - w + i - 1) @ (line bottom - i) - extent: ((w - i) * 2 + 3) @ 1) - color: caretColor]. aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom) + color: (self focused ifTrue: [self selectionColor] ifFalse: [self unfocusedSelectionColor])]! - color: caretColor] - ifFalse: - [caretRect := nil. - aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom) - color: self selectionColor]! Item was added: + ----- Method: NewParagraph>>displaySimpleCursorOn:at:in: (in category 'display') ----- + displaySimpleCursorOn: aCanvas at: leftX in: line + + self focused ifFalse: [^ 1]. + + aCanvas + line: leftX @ (line top+1) + to: leftX @ (line bottom-1) + color: self caretColor. + + aCanvas + line: leftX+1 @ (line top+1) + to: leftX+1 @ (line bottom-1) + color: (self caretColor alpha: 0.3). + + ^ 1! Item was removed: - ----- Method: NewParagraph>>insertionPointColor (in category 'display') ----- - insertionPointColor - self focused ifFalse: [^ Color transparent]. - ^ Display depth <= 2 - ifTrue: [Color black] - ifFalse: [Preferences insertionPointColor]! Item was changed: + ----- Method: NewParagraph>>selectionColor (in category 'access') ----- - ----- Method: NewParagraph>>selectionColor (in category 'display') ----- selectionColor + ^ selectionColor ifNil: [Color blue muchLighter]! - | color | - Display depth = 1 ifTrue: [^ Color veryLightGray]. - Display depth = 2 ifTrue: [^ Color gray]. - color := Preferences textHighlightColor. - self focused ifFalse: [color := Color gray: 0.9]. - ^ color! Item was added: + ----- Method: NewParagraph>>selectionColor: (in category 'access') ----- + selectionColor: aColor + selectionColor := aColor.! Item was added: + ----- Method: NewParagraph>>unfocusedSelectionColor (in category 'access') ----- + unfocusedSelectionColor + ^ unfocusedSelectionColor ifNil: [Color gray: 0.9]! Item was added: + ----- Method: NewParagraph>>unfocusedSelectionColor: (in category 'access') ----- + unfocusedSelectionColor: aColor + unfocusedSelectionColor := aColor.! Item was added: + ----- Method: PluggableListMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #font. 'Fonts'. 'Font of the list items.' }. + { #textColor. 'Colors'. 'Color of the list items.' }. + { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }. + { #multiSelectionColor. 'Colors'. 'Colors used for items that are selected among others.'}. + { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }. + { #filterColor. 'Colors'. 'Color used for items to indicate the matching filter.' }. + { #filterTextColor. 'Colors'. 'Color used for items to indicate the matching filter.' }. + + { #preSelectionModifier. 'Colors'. 'How to derive the pre-selection color from the selection color.'}. + { #hoverSelectionModifier. 'Colors'. 'How to derive the hover color from the selection color.'}. + }! Item was added: + ----- Method: PluggableListMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme.! Item was changed: ----- Method: PluggableListMorph>>indicateUnfiltered (in category 'filtering') ----- indicateUnfiltered + ! - self color: Color white! Item was removed: - ----- Method: PluggableListMorph>>listItemHeight (in category 'initialization') ----- - listItemHeight - "This should be cleaned up. The list should get spaced by this parameter." - ^ 12! Item was changed: ----- Method: PluggableListMorph>>on:list:selected:changeSelected:menu:keystroke: (in category 'initialization') ----- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel self model: anObject. getListSelector := getListSel. getIndexSelector := getSelectionSel. setIndexSelector := setSelectionSel. getMenuSelector := getMenuSel. keystrokeActionSelector := keyActionSel. autoDeselect := true. - self borderWidth: 1. self updateList. self selectionIndex: self getCurrentSelectionIndex. self initForKeystrokes! Item was added: + ----- Method: PluggableListMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + super setDefaultParameters. + + self + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]). + + self setListParameters.! Item was added: + ----- Method: PluggableListMorph>>setListParameters (in category 'initialization') ----- + setListParameters + + self listMorph + selectionColor: (self userInterfaceTheme selectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]); + multiSelectionColor: (self userInterfaceTheme multiSelectionColor ifNil: [(Color r: 0.72 g: 0.72 b: 0.9) lighter]); + setProperty: #selectionTextColor + toValue: (self userInterfaceTheme selectionTextColor ifNil: [Color black]); + filterColor: (self userInterfaceTheme filterColor ifNil: [Color yellow paler]); + setProperty: #filterTextColor + toValue: (self userInterfaceTheme filterTextColor ifNil: [Color black]); + + setProperty: #preSelectionColor + toValue: ((self userInterfaceTheme preSelectionModifier ifNil: [ [:c | Color gray: 0.9] ]) value: self listMorph selectionColor asColor); + setProperty: #hoverColor + toValue: ((self userInterfaceTheme hoverSelectionModifier ifNil: [ [:c | c darker alpha: 0.3] ]) value: self listMorph selectionColor asColor)! Item was changed: ----- Method: PluggableTextMorph class>>adornmentWithColor: (in category 'frame adornments') ----- adornmentWithColor: aColor "Create and return a frame adornment with the given color" | size box form fillStyle | ^self adornmentCache at: aColor ifAbsentPut:[ + size := 20. - size := 25. box := 0@0 extent: size asPoint. form := Form extent: size@size depth: 32. + fillStyle := MenuMorph gradientMenu ifFalse: [SolidFillStyle color: aColor] ifTrue: [ + (GradientFillStyle ramp: { + 0.0->(aColor alpha: 0.01). + 0.8->aColor. + 1.0->aColor}) + origin: box topRight - (size@0); + direction: (size @ size negated) // 4; + radial: false]. - fillStyle := (GradientFillStyle ramp: { - 0.0->(Color white alpha: 0.01). - 0.8->aColor. - 1.0->aColor}) - origin: box topRight - (size@0); - direction: (size @ size negated) // 4; - radial: false. form getCanvas drawPolygon: { box topRight. box topRight + (0@size). box topRight - (size@0) } fillStyle: fillStyle. form]. ! Item was added: + ----- Method: PluggableTextMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #font. 'Fonts'. 'Font for text if not styled.' }. + { #textColor. 'Colors'. 'Color for text if not styled.' }. + { #caretColor. 'Colors'. 'The color of the text cursor.' }. + { #selectionColor. 'Colors'. 'The color of the text selection.' }. + { #unfocusedSelectionModifier. 'Colors'. 'How to derive the text selection color if not focused.' }. + + { #adornmentReadOnly. 'Color'. 'How to indicate read-only contents.' }. + { #adornmentRefuse. 'Color'. 'How to indicate that the model refuses to accept.' }. + { #adornmentConflict. 'Color'. 'How to indicate that there are editing conflicts.' }. + { #adornmentDiff. 'Color'. 'How to indicate that the model wants diff feedback.' }. + { #adornmentNormalEdit. 'Color'. 'How to indicate that there are unaccepted edits.' }. + { #adornmentDiffEdit. 'Color'. 'How to indicate that there are unaccepted edits in a diff view.' }. + + { #wrapBorderColorModifier. 'Color'. 'How to indicate a specific wrap border.' }. + }! Item was added: + ----- Method: PluggableTextMorph>>adoptPaneColor: (in category 'accessing') ----- + adoptPaneColor: aColor + + super adoptPaneColor: aColor. + + self wrapBorderColor: ((self userInterfaceTheme wrapBorderColorModifier ifNil: [ [:c | c muchLighter alpha: 0.3] ]) + value: self borderColor).! Item was added: + ----- Method: PluggableTextMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self textMorph releaseParagraph; paragraph.! Item was changed: ----- Method: PluggableTextMorph>>drawFrameAdornmentsOn: (in category 'drawing') ----- drawFrameAdornmentsOn: aCanvas "Include a thin red inset border for unaccepted edits, or, if the unaccepted edits are known to conflict with a change made somewhere else to the same method (typically), put a thick red frame" self wantsFrameAdornments ifFalse: [^ self]. + self readOnly ifTrue: [^ self drawFrameAdornment: (self valueOfProperty: #adornmentReadOnly ifAbsent: [Color black]) on: aCanvas]. - self readOnly ifTrue: [^ self drawFrameAdornment: Color black on: aCanvas]. (model notNil and: [model refusesToAcceptCode]) ifTrue: [ "Put up feedback showing that code cannot be submitted in this state" + ^ self drawFrameAdornment: (self valueOfProperty: #adornmentRefuse ifAbsent: [Color tan]) on: aCanvas]. - ^ self drawFrameAdornment: Color tan on: aCanvas]. self hasEditingConflicts + ifTrue: [^ self drawFrameAdornment: (self valueOfProperty: #adornmentConflict ifAbsent: [Color red]) on: aCanvas]. - ifTrue: [^ self drawFrameAdornment: Color red on: aCanvas]. self hasUnacceptedEdits ifTrue: [ model wantsDiffFeedback + ifTrue: [self drawFrameAdornment: (self valueOfProperty: #adornmentDiffEdit ifAbsent: [Color yellow]) on: aCanvas] + ifFalse: [self drawFrameAdornment: (self valueOfProperty: #adornmentNormalEdit ifAbsent: [Color orange]) on: aCanvas]. - ifTrue: [self drawFrameAdornment: Color yellow on: aCanvas] - ifFalse: [self drawFrameAdornment: Color orange on: aCanvas]. ^ self]. model wantsDiffFeedback + ifTrue: [self drawFrameAdornment: (self valueOfProperty: #adornmentDiff ifAbsent: [Color green]) on: aCanvas].! - ifTrue: [self drawFrameAdornment: Color green on: aCanvas].! Item was changed: ----- Method: PluggableTextMorph>>drawWrapBorderOn: (in category 'drawing') ----- drawWrapBorderOn: aCanvas | offset rect | self wantsWrapBorder ifFalse: [^ self]. textMorph ifNil: [^ self]. offset := textMorph margins isRectangle ifTrue: [textMorph margins left] ifFalse: [textMorph margins isPoint ifTrue: [textMorph margins x] ifFalse: [textMorph margins]]. offset := offset + ((textMorph textStyle defaultFont widthOf: $x) * self class visualWrapBorderLimit). offset > self width ifTrue: [^ self]. rect := scroller topLeft + (offset @ 0) corner: scroller bottomRight. aCanvas fillRectangle: rect + color: self wrapBorderColor. - color: (self borderStyle color muchLighter alpha: 0.3). aCanvas line: rect topLeft to: rect bottomLeft width: self borderStyle width + color: (self wrapBorderColor muchDarker alpha: 0.5).! - color: (self borderStyle color alpha: 0.5).! Item was changed: ----- Method: PluggableTextMorph>>initialize (in category 'initialization') ----- initialize + + self initializeTextMorph. - "initialize the state of the receiver" super initialize. + hasUnacceptedEdits := false. hasEditingConflicts := false. askBeforeDiscardingEdits := true. + self minimumWidth: (TextStyle defaultFont widthOf: $m) * 10. + + scroller addMorph: textMorph. + + "Reset minExtent because only now we can anser #isAutoFit correctly." + self minimumExtent: 0@0; updateMinimumExtent.! - self minimumWidth: (TextStyle defaultFont widthOf: $m) * 10.! Item was added: + ----- Method: PluggableTextMorph>>initializeTextMorph (in category 'initialization') ----- + initializeTextMorph + + textMorph := self textMorphClass new + margins: (3@0 corner: 0@0); + setEditView: self; + autoFit: true; + setProperty: #indicateKeyboardFocus toValue: #never; + yourself.! Item was changed: ----- Method: PluggableTextMorph>>on:text:accept:readSelection:menu: (in category 'initialization') ----- on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel self model: anObject. getTextSelector := getTextSel. setTextSelector := setTextSel. getSelectionSelector := getSelectionSel. getMenuSelector := getMenuSel. - self borderWidth: 1. self setText: self getText. self setSelection: self getSelection.! Item was added: + ----- Method: PluggableTextMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + super setDefaultParameters. + + self + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + setTextColor: (self userInterfaceTheme textColor ifNil: [Color black]). + + self wrapBorderColor: ((self userInterfaceTheme wrapBorderColorModifier ifNil: [ [:c | c muchLighter alpha: 0.3] ]) + value: self borderColor). + + self + setProperty: #adornmentReadOnly + toValue: (self userInterfaceTheme adornmentReadOnly ifNil: [Color black]); + setProperty: #adornmentRefuse + toValue: (self userInterfaceTheme adornmentRefuse ifNil: [Color tan]); + setProperty: #adornmentConflict + toValue: (self userInterfaceTheme adornmentConflict ifNil: [Color red]); + setProperty: #adornmentDiff + toValue: (self userInterfaceTheme adornmentDiff ifNil: [Color green]); + setProperty: #adornmentNormalEdit + toValue: (self userInterfaceTheme adornmentNormalEdit ifNil: [Color orange]); + setProperty: #adornmentDiffEdit + toValue: (self userInterfaceTheme adornmentDiffEdit ifNil: [Color yellow]). + + textMorph + setProperty: #caretColor + toValue: (self userInterfaceTheme caretColor ifNil: [Color red]); + setProperty: #selectionColor + toValue: (self userInterfaceTheme selectionColor ifNil: [TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2]); + setProperty: #unfocusedSelectionColor + toValue: ((self userInterfaceTheme unfocusedSelectionModifier ifNil: [ [:c | Color gray: 0.9] ]) + value: textMorph selectionColor).! Item was changed: ----- Method: PluggableTextMorph>>setText: (in category 'model access') ----- setText: aText + + textMorph newContents: aText. - textMorph - ifNil: [textMorph := self textMorphClass new - contents: aText - wrappedTo: self innerBounds width. - textMorph - margins: (3@0 corner: 0@0); - setEditView: self; - autoFit: true; - setProperty: #indicateKeyboardFocus toValue: #never. - scroller addMorph: textMorph. - "Reset minExtent because only now we can anser #isAutoFit correctly." - self minimumExtent: 0@0; updateMinimumExtent] - ifNotNil: [textMorph newContents: aText]. self hasUnacceptedEdits: false. + self setScrollDeltas. - self setScrollDeltas. - self changed. "Redraw the whole area. For example, it might not be necssary to draw the help text anymore."! Item was added: + ----- Method: PluggableTextMorph>>wrapBorderColor (in category 'accessing') ----- + wrapBorderColor + + ^ self valueOfProperty: #wrapBorderColor ifAbsent: [Color gray alpha: 0.3]! Item was added: + ----- Method: PluggableTextMorph>>wrapBorderColor: (in category 'accessing') ----- + wrapBorderColor: aColor + + self setProperty: #wrapBorderColor toValue: aColor. + self changed.! Item was removed: - ----- Method: ScrollBar class>>createArrowOfDirection:in: (in category 'images') ----- - createArrowOfDirection: aSymbol in: aRectangle - "PRIVATE - create an arrow bounded in aRectangle" - - | arrow vertices | - vertices := Preferences alternativeButtonsInScrollBars - ifTrue: [self verticesForComplexArrow: aRectangle] - ifFalse: [self verticesForSimpleArrow: aRectangle]. - "" - arrow := PolygonMorph - vertices: vertices - color: Color transparent - borderWidth: 0 - borderColor: Color black. - "" - arrow bounds: (arrow bounds insetBy: (aRectangle width / 6) rounded). - "" - Preferences alternativeButtonsInScrollBars - ifTrue: [arrow rotationDegrees: 45]. - "" - aSymbol == #right - ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 90]. - aSymbol == #bottom - ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 180]. - aSymbol == #left - ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 270]. - "" - ^arrow! Item was changed: ----- Method: ScrollBar class>>createArrowOfDirection:size:color: (in category 'images') ----- + createArrowOfDirection: aSymbolDirection size: size color: aColor + "PRIVATE - create an arrow with aSymbolDirectionDirection, finalSizeInteger and aColor - createArrowOfDirection: aSymbolDirection size: finalSizeInteger color: aColor - "PRIVATE - create an arrow with aSymbolDirectionDirection, - finalSizeInteger and aColor - aSymbolDirectionDirection = #top, #bottom. #left or #right + ScrollBar initializeImagesCache. + Try with: + (ScrollBar createArrowOfDirection: #right size: 14 color: Color lightGreen) asMorph openInHand." + + | form canvas vertices margin | + form := Form extent: size asPoint depth: 32. + canvas := form getCanvas. + margin := size < 14 ifTrue: [2] ifFalse: [3]. + vertices := { + size // 2 @ margin. + size asPoint - margin asPoint. + margin @ (size-margin). + size // 2 @ margin}. + + "Preferences gradientScrollBars + ifTrue: [ + fillStyle := GradientFillStyle ramp: { + 0.0 -> (aColor adjustBrightness: 0.5). + 0.1-> (aColor adjustBrightness: 0.05). + 0.6 -> (aColor darker)}. + fillStyle origin: size // 2 @ margin. + fillStyle direction: 0 @ size] + ifFalse: [ + fillStyle := SolidFillStyle color: aColor]. " + + canvas + drawPolygon: vertices + fillStyle: (SolidFillStyle color: aColor). + + ^ (form rotateBy: (aSymbolDirection caseOf: { + [#top] -> [0]. + [#bottom] -> [180]. + [#left] -> [270]. + [#right] -> [90]})) clippedToSize: size asPoint! - - Try with: - (ScrollBar createArrowOfDirection: #top size: 32 color: Color - lightGreen) asMorph openInHand. - " - | resizeFactor outerBox arrow resizedForm gradient | - resizeFactor := 4. - outerBox := RectangleMorph new - extent: finalSizeInteger asPoint * resizeFactor; - borderWidth: 0; - color: aColor. - - self gradientScrollBar ifTrue: [ - gradient := GradientFillStyle ramp: { - 0 -> (Color gray: 0.95). - 0.49 -> (Color gray: 0.9). - 0.5 -> (Color gray: 0.87). - 1 -> (Color gray: 0.93). - }. - gradient origin: outerBox topLeft. - (aSymbolDirection == #left or:[aSymbolDirection == #right]) - ifTrue:[gradient direction: 0@ outerBox height] - ifFalse:[gradient direction: outerBox width @ 0]. - outerBox fillStyle: gradient]. - outerBox borderStyle: (BorderStyle width: 4 color: Color lightGray). - - "" - arrow := self createArrowOfDirection: aSymbolDirection in: (outerBox bounds expandBy: -4). - self updateScrollBarButtonAspect: arrow color: aColor muchDarker. - outerBox addMorphCentered: arrow. - "" - resizedForm := outerBox imageForm - magnify: outerBox imageForm boundingBox - by: 1 / resizeFactor - smoothing: 4. - "" - ^ (resizedForm replaceColor: aColor withColor: Color transparent) - trimBordersOfColor: Color transparent! Item was removed: - ----- Method: ScrollBar class>>createBoxIn: (in category 'images') ----- - createBoxIn: aRectangle - "PRIVATE - create an box bounded in aRectangle" - | box | - box := RectangleMorph new. - box extent: (aRectangle scaleBy: 1 / 2) extent rounded; - borderWidth: 0. - "" - ^ box! Item was changed: ----- Method: ScrollBar class>>createBoxOfSize:color: (in category 'images') ----- + createBoxOfSize: anInteger color: aColor + "PRIVATE - create a box with anInteger and aColor - createBoxOfSize: finalSizeInteger color: aColor - "PRIVATE - create a box with finalSizeInteger and aColor Try with: + (ScrollBar createBoxOfSize: 32 color: Color gray) asMorph - (ScrollBar createBoxOfSize: 32 color: Color lightGreen) asMorph openInHand. " + + | form canvas margin | + form := Form extent: anInteger asPoint depth: 32. + canvas := form getCanvas. + margin := anInteger < 14 ifTrue: [3] ifFalse: [4]. + + "Preferences gradientScrollBars + ifTrue: [ + fillStyle := GradientFillStyle ramp: { + 0.0 -> (aColor adjustBrightness: 0.5). + 0.1-> (aColor adjustBrightness: 0.05). + 0.6 -> (aColor darker)}. + fillStyle origin: margin asPoint. + fillStyle direction: anInteger @ 0] + ifFalse: [ + fillStyle := SolidFillStyle color: aColor]. " + + canvas + fillRectangle: ((0@0 extent: anInteger asPoint) insetBy: margin) + fillStyle: (SolidFillStyle color: aColor). + + ^ form! - | resizeFactor outerBox innerBox resizedForm gradient | - resizeFactor := 4. - outerBox := RectangleMorph new - extent: finalSizeInteger asPoint * resizeFactor; - borderWidth: 0; - color: aColor. - self gradientScrollBar ifTrue: [ - gradient := GradientFillStyle ramp: { - 0 -> (Color gray: 0.95). - 0.49 -> (Color gray: 0.9). - 0.5 -> (Color gray: 0.87). - 1 -> (Color gray: 0.93). - }. - gradient origin: outerBox topLeft. - gradient direction: outerBox width @ 0. - outerBox fillStyle: gradient]. - outerBox borderStyle: (BorderStyle width: 4 color: Color lightGray). - "" - innerBox := self createBoxIn: (outerBox bounds expandBy: -4). - self updateScrollBarButtonAspect: innerBox color: aColor muchDarker. - outerBox addMorphCentered: innerBox. - "" - resizedForm := outerBox imageForm - magnify: outerBox imageForm boundingBox - by: 1 / resizeFactor - smoothing: 4. - "" - ^ (resizedForm replaceColor: aColor withColor: Color transparent) - trimBordersOfColor: Color transparent! Item was changed: ----- Method: ScrollBar class>>roundedScrollBarLook: (in category 'preferences') ----- roundedScrollBarLook: aBoolean + RoundedScrollBarLook = aBoolean ifTrue: [^ self]. + RoundedScrollBarLook := aBoolean. + + ScrollBar allSubInstancesDo: [:ea | ea updateSliderCornerStyle].! - RoundedScrollBarLook := aBoolean.! Item was added: + ----- Method: ScrollBar class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #pagingAreaColorModifier. 'Colors'. 'How to modify the paging area color when adopting a pane color.' }. + { #thumbColorModifier. 'Colors'. 'How to modify the thumb color when adopting a pane color.' }. + { #borderColorModifier. 'Colors'. 'How to modify the border color when adopting a pane color.' }. + }! Item was removed: - ----- Method: ScrollBar class>>updateScrollBarButtonAspect:color: (in category 'coloring morphs') ----- - updateScrollBarButtonAspect: aMorph color: aColor - "update aMorph with aColor" - | fill direction | - aMorph isNil - ifTrue: [^ self]. - "" - aMorph color: aColor. - self gradientScrollBar - ifFalse: [^ self]. - "" - fill := GradientFillStyle ramp: { - 0.0 -> aColor twiceLighter twiceLighter. - 1.0 -> aColor twiceDarker}. - "" - direction := ((aMorph width min: aMorph height) - + ((aMorph width - aMorph height) abs * 0.3)) rounded. - "" - fill origin: aMorph topLeft + (direction // 8). - fill direction: direction @ direction. - fill radial: true. - "" - aMorph fillStyle: fill! Item was removed: - ----- Method: ScrollBar class>>updateScrollBarButtonsAspect:color: (in category 'coloring morphs') ----- - updateScrollBarButtonsAspect: aCollection color: aColor - "update aCollection of morphs with aColor" - - - aCollection - do: [:each | self updateScrollBarButtonAspect: each color: aColor]! Item was removed: - ----- Method: ScrollBar class>>verticesForComplexArrow: (in category 'images') ----- - verticesForComplexArrow: aRectangle - "PRIVATE - answer a collection of vertices to draw a complex arrow" - | vertices aux | - vertices := OrderedCollection new. - "" - vertices add: aRectangle bottomLeft. - vertices add: aRectangle topLeft. - vertices add: aRectangle topRight. - "" - aux := (aRectangle width / 3) rounded. - vertices add: aRectangle topRight + (0 @ aux). - vertices add: aRectangle topLeft + aux. - vertices add: aRectangle bottomLeft + (aux @ 0). - "" - ^ vertices! Item was removed: - ----- Method: ScrollBar class>>verticesForSimpleArrow: (in category 'images') ----- - verticesForSimpleArrow: aRectangle - "PRIVATE - answer a collection of vertices to draw a simple arrow" - | vertices | - vertices := OrderedCollection new. - "" - vertices add: aRectangle bottomLeft. - vertices add: aRectangle center x @ (aRectangle top + (aRectangle width / 8)). - vertices add: aRectangle bottomRight. - "" - ^ vertices! Item was changed: + ----- Method: ScrollBar>>adoptPaneColor: (in category 'updating') ----- - ----- Method: ScrollBar>>adoptPaneColor: (in category 'access') ----- adoptPaneColor: aColor "Adopt the given pane color" aColor ifNil:[^self]. self sliderColor: aColor.! Item was added: + ----- Method: ScrollBar>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme.! Item was changed: + ----- Method: ScrollBar>>boundsForDownButton (in category 'geometry') ----- - ----- Method: ScrollBar>>boundsForDownButton (in category 'initialize') ----- boundsForDownButton ^ self innerBounds bottomRight - self buttonExtent extent: self buttonExtent! Item was changed: + ----- Method: ScrollBar>>boundsForMenuButton (in category 'geometry') ----- - ----- Method: ScrollBar>>boundsForMenuButton (in category 'initialize') ----- boundsForMenuButton ^ self innerBounds topLeft extent: self buttonExtent! Item was changed: + ----- Method: ScrollBar>>boundsForUpButton (in category 'geometry') ----- - ----- Method: ScrollBar>>boundsForUpButton (in category 'initialize') ----- boundsForUpButton ^ (self menuButton visible ifFalse: [self innerBounds topLeft] ifTrue: [self orientation == #horizontal ifTrue: [self menuButton bounds topRight - (1@0)] ifFalse: [self menuButton bounds bottomLeft - (0@1)]]) extent: self buttonExtent! Item was removed: - ----- Method: ScrollBar>>defaultBorderWidth (in category 'initialize') ----- - defaultBorderWidth - ^ 0! Item was added: + ----- Method: ScrollBar>>downButton (in category 'accessing') ----- + downButton + ^ downButton! Item was changed: + ----- Method: ScrollBar>>downImage (in category 'images') ----- - ----- Method: ScrollBar>>downImage (in category 'initialize') ----- downImage "answer a form to be used in the down button" ^ self class arrowOfDirection: (self orientation == #horizontal ifTrue: [#right] ifFalse: [#bottom]) size: (self buttonExtent x min: self buttonExtent y) + color: self imageColor! - color: self thumbColor! Item was changed: ----- Method: ScrollBar>>extent: (in category 'geometry') ----- extent: p + + (bounds extent closeTo: p) ifTrue: [^ self]. + p x > p y ifTrue: [super extent: (p max: 8 @ 4)] ifFalse: [super extent: (p max: 4 @ 8)]. + + self updateSliderColor. ! Item was changed: ----- Method: ScrollBar>>finishedScrolling (in category 'scrolling') ----- finishedScrolling self stopStepping. self scrollBarAction: nil. - self class roundedScrollBarLook ifTrue:[ - upButton borderStyle: (BorderStyle complexRaised width: upButton borderWidth). - downButton borderStyle: (BorderStyle complexRaised width: downButton borderWidth). - ] ifFalse:[ - downButton borderStyle: BorderStyle thinGray. - upButton borderStyle: BorderStyle thinGray. - ]. - ! Item was added: + ----- Method: ScrollBar>>imageColor (in category 'accessing') ----- + imageColor + + ^ slider ifNil: [Color black] ifNotNil: [:s | s borderColor]! Item was changed: ----- Method: ScrollBar>>initialize (in category 'initialize') ----- initialize interval := 0.2. - - super initialize. - scrollDelta := 0.02. pageDelta := 0.2. + + super initialize.! - - self color: Color transparent. - - self class roundedScrollBarLook - ifFalse: [self borderWidth: 0] - ifTrue:[self borderStyle: ((BorderStyle complexFramed width: 2) "baseColor: Color gray")].! Item was changed: ----- Method: ScrollBar>>initializeDownButton (in category 'initialize') ----- initializeDownButton "initialize the receiver's downButton" + downButton := RectangleMorph newBounds: self boundsForDownButton. - downButton := RectangleMorph - newBounds: self boundsForDownButton - color: self thumbColor. downButton on: #mouseDown send: #scrollDownInit to: self. downButton on: #mouseUp send: #finishedScrolling to: self. + self updateDownButtonImage. + self addMorphFront: downButton. - self updateDownButtonImage. - self class roundedScrollBarLook - ifTrue: - [downButton color: Color veryLightGray. - downButton borderStyle: (BorderStyle complexRaised width: 3)] - ifFalse: [downButton setBorderWidth: 1 borderColor: Color lightGray]. - - self addMorph: downButton. downButton visible: self class scrollBarsWithoutArrowButtons not.! Item was removed: - ----- Method: ScrollBar>>initializeEmbedded: (in category 'initialize') ----- - initializeEmbedded: aBool - "aBool == true => inboard scrollbar - aBool == false => flop-out scrollbar" - self class roundedScrollBarLook ifFalse:[^self]. - aBool ifTrue:[ - self borderStyle: (BorderStyle inset width: 2). - self cornerStyle: #square. - ] ifFalse:[ - self borderStyle: (BorderStyle width: 1 color: Color black). - self cornerStyle: #rounded. - ]. - self removeAllMorphs. - self initializeSlider.! Item was changed: ----- Method: ScrollBar>>initializeMenuButton (in category 'initialize') ----- initializeMenuButton "initialize the receiver's menuButton" "Preferences disable: #scrollBarsWithoutMenuButton" "Preferences enable: #scrollBarsWithoutMenuButton" + menuButton := RectangleMorph newBounds: self boundsForMenuButton. - menuButton := RectangleMorph - newBounds: self boundsForMenuButton - color: self thumbColor. menuButton on: #mouseEnter send: #menuButtonMouseEnter: to: self. menuButton on: #mouseDown send: #menuButtonMouseDown: to: self. menuButton on: #mouseLeave send: #menuButtonMouseLeave: to: self. "menuButton addMorphCentered: (RectangleMorph newBounds: (0 @ 0 extent: 4 @ 2) color: Color black)." self updateMenuButtonImage. + self addMorphFront: menuButton. - self class roundedScrollBarLook - ifTrue: [menuButton color: Color veryLightGray. - menuButton - borderStyle: (BorderStyle complexRaised width: 3)] - ifFalse: [menuButton setBorderWidth: 1 borderColor: Color lightGray]. - - self addMorph: menuButton. menuButton visible: (self class scrollBarsWithoutMenuButton or: [self orientation == #horizontal]) not.! Item was changed: ----- Method: ScrollBar>>initializePagingArea (in category 'initialize') ----- initializePagingArea "Appearance" + pagingArea := RectangleMorph newBounds: self totalSliderArea. - pagingArea := RectangleMorph - newBounds: self totalSliderArea - color: (self class roundedScrollBarLook - ifTrue: [Color gray: 0.9] - ifFalse: [Color r: 0.6 g: 0.6 b: 0.8]). - self class gradientScrollBar - ifTrue: [pagingArea setBorderWidth: 1 borderColor: (Color lightGray alpha: 0.5)] - ifFalse: [pagingArea borderWidth: 0]. self addMorphBack: pagingArea. "Interactions" pagingArea on: #mouseDown send: #scrollPageInit: to: self. pagingArea on: #mouseUp send: #finishedScrolling to: self. ! Item was changed: ----- Method: ScrollBar>>initializeSlider (in category 'initialize') ----- initializeSlider self initializeMenuButton; initializeUpButton; initializeDownButton; initializePagingArea. super initializeSlider. - self expandSlider. + self expandSlider.! - self class roundedScrollBarLook ifTrue: [ - slider cornerStyle: #rounded. - sliderShadow cornerStyle: #rounded. - - Preferences menuAppearance3d ifTrue: [ - slider borderStyle: (BorderStyle complexRaised width: 1)]]. - - self sliderColor: self sliderColor.! Item was changed: ----- Method: ScrollBar>>initializeUpButton (in category 'initialize') ----- initializeUpButton "initialize the receiver's upButton" upButton := RectangleMorph newBounds: self boundsForUpButton. - upButton color: self thumbColor. upButton on: #mouseDown send: #scrollUpInit to: self. upButton on: #mouseUp send: #finishedScrolling to: self. self updateUpButtonImage. - self class roundedScrollBarLook - ifTrue: [upButton color: Color veryLightGray. - upButton - borderStyle: (BorderStyle complexRaised width: 3)] - ifFalse: [upButton setBorderWidth: 1 borderColor: Color lightGray]. - self addMorph: upButton. upButton visible: self class scrollBarsWithoutArrowButtons not.! Item was changed: + ----- Method: ScrollBar>>interval (in category 'accessing') ----- - ----- Method: ScrollBar>>interval (in category 'access') ----- interval ^ interval ifNil: [interval := 0.2]! Item was changed: + ----- Method: ScrollBar>>interval: (in category 'accessing') ----- - ----- Method: ScrollBar>>interval: (in category 'access') ----- interval: d "Supply an optional floating fraction so slider can expand to indicate range" interval := d min: 1.0. self expandSlider. self computeSlider.! Item was changed: + ----- Method: ScrollBar>>menuButton (in category 'accessing') ----- - ----- Method: ScrollBar>>menuButton (in category 'access') ----- menuButton ^ menuButton ifNil: [menuButton := RectangleMorph new]! Item was changed: + ----- Method: ScrollBar>>menuButtonMouseDown: (in category 'event handling') ----- - ----- Method: ScrollBar>>menuButtonMouseDown: (in category 'other events') ----- menuButtonMouseDown: event event hand showTemporaryCursor: nil. self use: menuSelector orMakeModelSelectorFor: 'MenuButtonPressed:' in: [:sel | menuSelector := sel. model perform: sel with: event]! Item was changed: + ----- Method: ScrollBar>>menuImage (in category 'images') ----- - ----- Method: ScrollBar>>menuImage (in category 'initialize') ----- menuImage "answer a form to be used in the menu button" ^ self class boxOfSize: (self buttonExtent x min: self buttonExtent y) + color: self imageColor! - color: self thumbColor! Item was changed: + ----- Method: ScrollBar>>menuSelector (in category 'accessing') ----- - ----- Method: ScrollBar>>menuSelector (in category 'access') ----- menuSelector ^ menuSelector! Item was changed: + ----- Method: ScrollBar>>menuSelector: (in category 'accessing') ----- - ----- Method: ScrollBar>>menuSelector: (in category 'access') ----- menuSelector: aSymbol menuSelector := aSymbol.! Item was changed: + ----- Method: ScrollBar>>mouseDownInSlider: (in category 'event handling') ----- - ----- Method: ScrollBar>>mouseDownInSlider: (in category 'other events') ----- mouseDownInSlider: event + + "make the entire scrollable area visible if a full scrollbar is clicked on" + self interval = self maximumValue ifTrue: [ - self interval = self maximumValue ifTrue: - ["make the entire scrollable area visible if a full scrollbar is clicked on" self setValue: 0. + self model hideOrShowScrollBars]. + + self showSliderShadow.! - self model hideOrShowScrollBars.]. - " super mouseDownInSlider: event" - ! Item was changed: + ----- Method: ScrollBar>>pagingArea (in category 'accessing') ----- - ----- Method: ScrollBar>>pagingArea (in category 'access') ----- pagingArea ^pagingArea! Item was changed: + ----- Method: ScrollBar>>scrollDelta (in category 'accessing') ----- - ----- Method: ScrollBar>>scrollDelta (in category 'access') ----- scrollDelta ^ scrollDelta! Item was changed: + ----- Method: ScrollBar>>scrollDelta:pageDelta: (in category 'accessing') ----- - ----- Method: ScrollBar>>scrollDelta:pageDelta: (in category 'access') ----- scrollDelta: d1 pageDelta: d2 "Supply optional increments for better scrolling of, eg, text" scrollDelta := d1. pageDelta := d2.! Item was removed: - ----- Method: ScrollBar>>scrollDown (in category 'scrolling') ----- - scrollDown - self flag: #obsolete. - downButton eventHandler: nil. - downButton on: #mouseDown send: #scrollDownInit to: self. - downButton on: #mouseUp send: #finishedScrolling to: self. - ^self scrollDownInit! Item was changed: ----- Method: ScrollBar>>scrollDownInit (in category 'scrolling') ----- scrollDownInit - downButton borderInset. self resetTimer. self scrollBarAction: #doScrollDown. self startStepping.! Item was removed: - ----- Method: ScrollBar>>scrollUp (in category 'scrolling') ----- - scrollUp - self flag: #obsolete. - upButton eventHandler: nil. - upButton on: #mouseDown send: #scrollUpInit to: self. - upButton on: #mouseUp send: #finishedScrolling to: self. - ^self scrollUpInit! Item was changed: ----- Method: ScrollBar>>scrollUpInit (in category 'scrolling') ----- scrollUpInit - upButton borderInset. self resetTimer. self scrollBarAction: #doScrollUp. self startStepping.! Item was added: + ----- Method: ScrollBar>>setDefaultParameters (in category 'initialize') ----- + setDefaultParameters + + "Compared to generic sliders, I am not my own paging area. Thus, make me transparent." + self + color: Color transparent; + borderWidth: 0. + + pagingArea + color: (self userInterfaceTheme color ifNil: [Color veryVeryLightGray darker alpha: 0.35]); + borderWidth: 0. "no border for the paging area" + + slider + color: (self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]); + borderColor: (self userInterfaceTheme thumbBorderColor ifNil: [Color gray: 0.6]); + borderWidth: (self userInterfaceTheme thumbBorderWidth ifNil: [1]). + + self updateSliderCornerStyle. + + sliderShadow + cornerStyle: slider cornerStyle; + borderWidth: slider borderWidth; + borderColor: Color transparent. + + sliderColor := slider color. + self updateSliderColor: slider color.! Item was changed: + ----- Method: ScrollBar>>sliderColor: (in category 'accessing') ----- - ----- Method: ScrollBar>>sliderColor: (in category 'access') ----- sliderColor: aColor "Change the color of the scrollbar to go with aColor." + - | buttonColor | super sliderColor: aColor. + self updateSliderColor: aColor.! - self updateSliderColor: aColor. - buttonColor := self thumbColor. - - self menuButton color: aColor. - upButton color: aColor. - downButton color: aColor. - - self class updateScrollBarButtonsAspect: {self menuButton. upButton. downButton} color: aColor. - - self flag: #performance. "mt: This is slow..." - self updateMenuButtonImage. - self updateUpButtonImage. - self updateDownButtonImage.! Item was removed: - ----- Method: ScrollBar>>sliderShadowColor (in category 'access') ----- - sliderShadowColor - ^ self class roundedScrollBarLook - ifTrue: [self sliderColor darker] - ifFalse: [super sliderShadowColor] - ! Item was removed: - ----- Method: ScrollBar>>thumbColor (in category 'access') ----- - thumbColor - "Problem: Part of the ScrollBar/Slider code uses 'slider' to mean the entire scrollbar/slider widget, and part of it uses 'slider' to mean only the draggable 'thumb'. This should be cleaned up so that 'thumb' is used instead of 'slider' where appropriate. For now, the meaning of thumbColor is clear, at least." - - ^ self sliderColor alphaMixed: 0.5 with: (Color gray: 0.95) - ! Item was changed: + ----- Method: ScrollBar>>upArrow8Bit (in category 'images') ----- - ----- Method: ScrollBar>>upArrow8Bit (in category 'initialize') ----- upArrow8Bit "convert to 8-bit and convert white to transparent to avoid gratuitous conversion every time we put one in an ImageMorph" ^UpArrow8Bit ifNil: [ UpArrow8Bit := (ColorForm mappingWhiteToTransparentFrom: UpArrow) asFormOfDepth: 8 ]! Item was added: + ----- Method: ScrollBar>>upButton (in category 'accessing') ----- + upButton + ^ upButton! Item was changed: + ----- Method: ScrollBar>>upImage (in category 'images') ----- - ----- Method: ScrollBar>>upImage (in category 'initialize') ----- upImage "answer a form to be used in the up button" ^ self class arrowOfDirection: (self orientation == #horizontal ifTrue: [#left] ifFalse: [#top]) size: (self buttonExtent x min: self buttonExtent y) + color: self imageColor! - color: self thumbColor! Item was changed: + ----- Method: ScrollBar>>updateDownButtonImage (in category 'updating') ----- - ----- Method: ScrollBar>>updateDownButtonImage (in category 'initialize') ----- updateDownButtonImage "update the receiver's downButton. put a new image inside" downButton removeAllMorphs. + downButton addMorphCentered: (ImageMorph new image: self downImage).! - downButton - addMorphCentered: (ImageMorph new image: self downImage)! Item was changed: + ----- Method: ScrollBar>>updateMenuButtonImage (in category 'updating') ----- - ----- Method: ScrollBar>>updateMenuButtonImage (in category 'initialize') ----- updateMenuButtonImage "update the receiver's menuButton. put a new image inside" self menuButton removeAllMorphs. self menuButton addMorphCentered: (ImageMorph new image: self menuImage).! Item was changed: + ----- Method: ScrollBar>>updateSlider (in category 'updating') ----- - ----- Method: ScrollBar>>updateSlider (in category 'initialize') ----- updateSlider | imagesNeedUpdate | imagesNeedUpdate := upButton width ~= (self orientation == #horizontal ifTrue: [self height] ifFalse: [self width]). self menuButton visible: (self orientation == #horizontal or: [self class scrollBarsWithoutMenuButton]) not; bounds: self boundsForMenuButton. upButton visible: self class scrollBarsWithoutArrowButtons not; bounds: self boundsForUpButton. downButton visible: self class scrollBarsWithoutArrowButtons not; bounds: self boundsForDownButton. super updateSlider. pagingArea bounds: self totalSliderArea. self expandSlider. imagesNeedUpdate ifTrue: [ self menuButton visible ifTrue: [self updateMenuButtonImage]. upButton visible ifTrue: [self updateUpButtonImage]. downButton visible ifTrue: [self updateDownButtonImage]].! Item was changed: + ----- Method: ScrollBar>>updateSliderColor (in category 'updating') ----- - ----- Method: ScrollBar>>updateSliderColor (in category 'access') ----- updateSliderColor self updateSliderColor: self sliderColor.! Item was changed: + ----- Method: ScrollBar>>updateSliderColor: (in category 'updating') ----- - ----- Method: ScrollBar>>updateSliderColor: (in category 'access') ----- updateSliderColor: aColor + self class gradientScrollBar + ifFalse: [self updateSliderColorSolid: aColor] + ifTrue: [self updateSliderColorGradient: aColor]. + + self flag: #performance. "mt: This is slow..." + self updateMenuButtonImage. + self updateUpButtonImage. + self updateDownButtonImage.! - | gradient | - self class gradientScrollBar ifFalse: [ - slider - borderColor: (aColor adjustBrightness: -0.3); - color: aColor. - pagingArea - borderColor: (aColor muchDarker alpha: pagingArea borderStyle color alpha); - color: (aColor darker alpha: 0.35). - ^ self]. - - slider borderStyle: (BorderStyle width: 1 color: Color lightGray). - - "Fill the slider." - gradient := GradientFillStyle ramp: { - 0 -> (Color gray: 0.95). - 0.49 -> (Color gray: 0.9). - 0.5 -> (Color gray: 0.87). - 1 -> (Color gray: 0.93). - }. - gradient origin: slider topLeft. - gradient direction: (self orientation == #horizontal - ifTrue:[0@slider height] - ifFalse:[slider width@0]). - slider fillStyle: gradient. - - "Fill the paging area." - gradient := GradientFillStyle ramp: { - 0 -> (Color gray: 0.65). - 0.6 -> (Color gray: 0.82). - 1 -> (Color gray: 0.88). - }. - gradient origin: self topLeft. - gradient direction: (self orientation == #horizontal - ifTrue:[0@self height] - ifFalse:[self width@0]). - pagingArea fillStyle: gradient.! Item was added: + ----- Method: ScrollBar>>updateSliderColorGradient: (in category 'updating') ----- + updateSliderColorGradient: aColor + + | gradient cc | + pagingArea color: ((self userInterfaceTheme pagingAreaColorModifier + ifNil: [ [:c | c darker alpha: 0.35] ]) value: aColor). + slider borderColor: ((self userInterfaceTheme borderColorModifier + ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: aColor). + + cc := ((self userInterfaceTheme thumbColorModifier + ifNil: [ [:c | c] ]) value: aColor). + + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.1-> (cc adjustBrightness: 0.05). + 0.6 -> (cc darker)}. + + "Fill the thumb" + gradient origin: slider topLeft. + gradient direction: (self orientation == #horizontal + ifTrue:[0@slider height] + ifFalse:[slider width@0]). + slider fillStyle: gradient. + + "Fill the buttons" + {self menuButton. self upButton. self downButton} do: [:ea | + gradient := gradient copy. + gradient origin: ea topLeft. + gradient direction: (self orientation == #horizontal + ifTrue:[0@ea height] + ifFalse:[ea width@0]). + ea + fillStyle: gradient; + borderWidth: slider borderWidth; + borderColor: slider borderColor].! Item was added: + ----- Method: ScrollBar>>updateSliderColorSolid: (in category 'updating') ----- + updateSliderColorSolid: aColor + + sliderShadow color: self sliderShadowColor. + + slider color: ((self userInterfaceTheme thumbColorModifier + ifNil: [ [:c | c] ]) value: aColor). + + slider borderColor: ((self userInterfaceTheme borderColorModifier + ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: aColor). + + pagingArea color: ((self userInterfaceTheme pagingAreaColorModifier + ifNil: [ [:c | c darker alpha: 0.35] ]) value: aColor). + + {self menuButton. self upButton. self downButton} do: [:ea | + ea + color: slider color; + borderWidth: slider borderWidth; + borderColor: slider borderColor].! Item was added: + ----- Method: ScrollBar>>updateSliderCornerStyle (in category 'updating') ----- + updateSliderCornerStyle + "Right now, only the slider's corner style is affected. Buttons and paging area remain square. Looks better somehow... :-)" + + slider cornerStyle: (self class roundedScrollBarLook ifTrue: [#rounded] ifFalse: [#square]).! Item was changed: + ----- Method: ScrollBar>>updateUpButtonImage (in category 'updating') ----- - ----- Method: ScrollBar>>updateUpButtonImage (in category 'initialize') ----- updateUpButtonImage "update the receiver's upButton. put a new image inside" upButton removeAllMorphs. + upButton addMorphCentered: (ImageMorph new image: self upImage).! - upButton - addMorphCentered: (ImageMorph new image: self upImage)! Item was added: + ----- Method: ScrollPane class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the pane''s border.' }. + { #borderWidth. 'Borders'. 'Width of the pane''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the pane.' }. + }! Item was added: + ----- Method: ScrollPane>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was changed: ----- Method: ScrollPane>>borderWidth: (in category 'accessing') ----- borderWidth: aNumber super borderWidth: aNumber. + self resizeScroller; setScrollDeltas! - self setScrollDeltas! Item was removed: - ----- Method: ScrollPane>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color black! Item was removed: - ----- Method: ScrollPane>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - - ^ 1 ! Item was removed: - ----- Method: ScrollPane>>defaultColor (in category 'initialization') ----- - defaultColor - - ^ Color white ! Item was changed: ----- Method: ScrollPane>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self initializePreferences. hasFocus := false. self initializeScrollBars. "" self extent: self defaultExtent. self resizeScrollBars; resizeScroller; hideOrShowScrollBars; updateMinimumExtent. + + self setDefaultParameters. - self addKeyboardCaptureFilter: self.! Item was changed: ----- Method: ScrollPane>>initializeScrollBars (in category 'initialization') ----- initializeScrollBars "Initialize vertical and horizontal scroll bars." (scrollBar := ScrollBar on: self getValue: nil setValue: #vScrollBarValue:) menuSelector: #vScrollBarMenuButtonPressed:; orientation: #vertical; extent: 1@1. (hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:) menuSelector: #hScrollBarMenuButtonPressed:; orientation: #horizontal; extent: 1@1. "" scroller := TransformMorph new color: Color transparent. scroller offset: 0 @ 0. self addMorph: scroller. "" - scrollBar initializeEmbedded: retractableScrollBar not. - hScrollBar initializeEmbedded: retractableScrollBar not. retractableScrollBar ifFalse: [self addMorph: scrollBar; addMorph: hScrollBar]. self updateMinimumExtent.! Item was added: + ----- Method: ScrollPane>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color white]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray: 0.6]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]).! Item was changed: ScrollPane subclass: #SimpleHierarchicalListMorph + instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor font textColor' - instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor' classVariableNames: 'WrappedNavigation' poolDictionaries: '' category: 'Morphic-Explorer'! SimpleHierarchicalListMorph class instanceVariableNames: 'expandedForm notExpandedForm'! !SimpleHierarchicalListMorph commentStamp: 'ls 3/1/2004 12:15' prior: 0! Display a hierarchical list of items. Each item should be wrapped with a ListItemWrapper. For a simple example, look at submorphsExample. For beefier examples, look at ObjectExplorer or FileList2.! SimpleHierarchicalListMorph class instanceVariableNames: 'expandedForm notExpandedForm'! Item was added: + ----- Method: SimpleHierarchicalListMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #font. 'Fonts'. 'Font of the list items.' }. + { #textColor. 'Colors'. 'Color of the list items.' }. + { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }. + { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }. + + { #filterColor. 'Colors'. 'Color used for items to indicate the matching filter.' }. + { #filterTextColor. 'Colors'. 'Color used for items to indicate the matching filter.' }. + { #highlightTextColor. 'Colors'. 'Color used for highlighted items.' }. + + { #hoverSelectionModifier. 'Colors'. 'How to derive the hover color from the selection color.'}. + + { #lineColor. 'Colors'. 'How the lines are drawn.' }. + }! Item was changed: ----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') ----- addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent | priorMorph newCollection firstAddition | priorMorph := nil. newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [ (aCollection asSortedCollection: [ :a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection ] ifFalse: [ aCollection ]. firstAddition := nil. newCollection do: [:item | priorMorph := self indentingItemClass basicNew initWithContents: item prior: priorMorph forList: self indentLevel: newIndent. + priorMorph + color: self textColor; + font: self font; + selectionColor: self selectionColor; + selectionTextColor: self selectionTextColor; + hoverColor: self hoverColor; + highlightTextColor: self highlightTextColor; + filterColor: self filterColor; + filterTextColor: self filterTextColor. firstAddition ifNil: [firstAddition := priorMorph]. morphList add: priorMorph. ((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [ priorMorph isExpanded: true. priorMorph addChildrenForList: self addingTo: morphList withExpandedItems: expandedItems. ]. ]. ^firstAddition ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') ----- addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean | priorMorph morphList newCollection | priorMorph := nil. newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [ (aCollection asSortedCollection: [ :a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection ] ifFalse: [ aCollection ]. morphList := OrderedCollection new. newCollection do: [:item | priorMorph := self indentingItemClass basicNew initWithContents: item prior: priorMorph forList: self indentLevel: parentMorph indentLevel + 1. + priorMorph + color: self textColor; + font: self font; + selectionColor: self selectionColor; + selectionTextColor: self selectionTextColor; + hoverColor: self hoverColor; + highlightTextColor: self highlightTextColor; + filterColor: self filterColor; + filterTextColor: self filterTextColor. morphList add: priorMorph. ]. scroller addAllMorphs: morphList after: parentMorph. ^morphList ! Item was added: + ----- Method: SimpleHierarchicalListMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>drawHoverOn: (in category 'drawing') ----- drawHoverOn: aCanvas self hoveredMorph ifNil: [^ self]. PluggableListMorph highlightHoveredRow ifFalse: [^ self]. aCanvas + transformBy: scroller transform + clippingTo: scroller innerBounds + during: [:c | self hoveredMorph drawHoverOn: c].! - fillRectangle: (((scroller transformFrom: self) - invertBoundsRect: self hoveredMorph bounds) - intersect: scroller bounds) - color: (LazyListMorph listSelectionColor darker alpha: 0.3).! Item was changed: ----- Method: SimpleHierarchicalListMorph>>drawSelectionOn: (in category 'drawing') ----- drawSelectionOn: aCanvas + self selectedMorph ifNotNil: [:m | + aCanvas + transformBy: scroller transform + clippingTo: scroller innerBounds + during: [:c | m drawSelectionOn: c] ].! - self selectedMorph ifNil: [^ self]. - - aCanvas - fillRectangle: (((scroller transformFrom: self) - invertBoundsRect: selectedMorph bounds) - intersect: scroller bounds) - color: LazyListMorph listSelectionColor.! Item was added: + ----- Method: SimpleHierarchicalListMorph>>filterColor (in category 'accessing') ----- + filterColor + + ^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>filterColor: (in category 'accessing') ----- + filterColor: aColor + + self setProperty: #filterColor toValue: aColor. + scroller submorphsDo: [:ea | ea filterColor: aColor].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>filterTextColor (in category 'accessing') ----- + filterTextColor + + ^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>filterTextColor: (in category 'accessing') ----- + filterTextColor: aColor + + self setProperty: #filterTextColor toValue: aColor. + scroller submorphsDo: [:ea | ea filterTextColor: aColor].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>font (in category 'accessing') ----- + font + ^ font ifNil: [TextStyle defaultFont]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>font: (in category 'accessing') ----- + font: aFont + font := aFont. + scroller submorphsDo: [:ea | ea font: font].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>highlightTextColor (in category 'accessing') ----- + highlightTextColor + + ^ self valueOfProperty: #highlightTextColor ifAbsent: [Color red]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>highlightTextColor: (in category 'accessing') ----- + highlightTextColor: aColor + + self setProperty: #highlightTextColor toValue: aColor. + scroller submorphsDo: [:ea | ea highlightTextColor: aColor].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>hoverColor (in category 'accessing') ----- + hoverColor + + ^ self valueOfProperty: #hoverColor ifAbsent: [Color veryLightGray]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>hoverColor: (in category 'accessing') ----- + hoverColor: aColor + + self setProperty: #hoverColor toValue: aColor. + scroller submorphsDo: [:ea | ea setProperty: #hoverColor toValue: aColor].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>selectionColor (in category 'accessing') ----- + selectionColor + + ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>selectionColor: (in category 'accessing') ----- + selectionColor: aColor + + self setProperty: #selectionColor toValue: aColor. + scroller submorphsDo: [:ea | ea selectionColor: aColor].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>selectionTextColor (in category 'accessing') ----- + selectionTextColor + + ^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>selectionTextColor: (in category 'accessing') ----- + selectionTextColor: aColor + + self setProperty: #selectionTextColor toValue: aColor. + scroller submorphsDo: [:ea | ea selectionTextColor: aColor].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + super setDefaultParameters. + + self + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]). + + self + selectionColor: (self userInterfaceTheme selectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]); + selectionTextColor: (self userInterfaceTheme selectionTextColor ifNil: [Color black]); + filterColor: (self userInterfaceTheme filterColor ifNil: [Color yellow paler]); + filterTextColor: (self userInterfaceTheme filterTextColor ifNil: [Color black]); + lineColor: (self userInterfaceTheme lineColor ifNil: [Color veryLightGray]); + hoverColor: ((self userInterfaceTheme hoverSelectionModifier ifNil: [ [:c | c darker alpha: 0.3] ]) value: self selectionColor); + highlightTextColor: (self userInterfaceTheme highlightTextColor ifNil: [Color red]).! Item was added: + ----- Method: SimpleHierarchicalListMorph>>textColor (in category 'accessing') ----- + textColor + ^ textColor ifNil: [Color black]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + textColor := aColor. + scroller submorphsDo: [:ea | ea color: textColor].! Item was added: + ----- Method: Slider class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the slider''s border.' }. + { #borderWidth. 'Borders'. 'Width of the slider''s border.' }. + { #color. 'Colors'. 'Background color of the slider.' }. + + { #thumbBorderColor. 'Colors'. 'Color of the slider thumb''s border.' }. + { #thumbBorderWidth. 'Borders'. 'Width of the slider thumb''s border.' }. + { #thumbColor. 'Colors'. 'Background color of the slider thumb.' }. + + { #thumbShadowModifier. 'Colors'. 'How to modify the thumb color to get the shadow color.' }. + }! Item was changed: ----- Method: Slider>>adoptPaneColor: (in category 'accessing - ui') ----- adoptPaneColor: paneColor super adoptPaneColor: paneColor. + paneColor ifNotNil: [:c | self sliderColor: c].! - - paneColor ifNotNil: [:c | - self color: c. - self thumb color: c].! Item was added: + ----- Method: Slider>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was removed: - ----- Method: Slider>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ #inset! Item was removed: - ----- Method: Slider>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: Slider>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was added: + ----- Method: Slider>>hideSliderShadow (in category 'other events') ----- + hideSliderShadow + + sliderShadow hide.! Item was changed: ----- Method: Slider>>initialize (in category 'initialization') ----- initialize + - "initialize the state of the receiver" super initialize. + - "" value := 0.0. descending := false. + + self initializeSlider. + self setDefaultParameters.! - self initializeSlider! Item was changed: ----- Method: Slider>>initializeSlider (in category 'initialization') ----- initializeSlider + + slider := RectangleMorph + newBounds: self totalSliderArea + color: self thumbColor. + + sliderShadow := RectangleMorph + newBounds: self totalSliderArea + color: self pagingArea color. + - slider := RectangleMorph newBounds: self totalSliderArea color: self thumbColor. - sliderShadow := RectangleMorph newBounds: self totalSliderArea - color: self pagingArea color. slider on: #mouseMove send: #scrollAbsolute: to: self. slider on: #mouseDown send: #mouseDownInSlider: to: self. slider on: #mouseUp send: #mouseUpInSlider: to: self. + + self addMorphFront: sliderShadow. + self addMorphFront: slider. + - slider setBorderWidth: 1 borderColor: Color lightGray.. - sliderShadow setBorderWidth: 1 borderColor: #inset. - "(the shadow must have the pagingArea as its owner to highlight properly)" - self pagingArea addMorph: sliderShadow. - sliderShadow hide. - self addMorph: slider. self computeSlider. + self hideSliderShadow.! - ! Item was changed: ----- Method: Slider>>mouseDownInSlider: (in category 'other events') ----- mouseDownInSlider: event slider borderStyle style == #raised ifTrue: [slider borderColor: #inset]. + self showSliderShadow.! - sliderShadow color: self sliderShadowColor. - sliderShadow cornerStyle: slider cornerStyle. - sliderShadow bounds: slider bounds. - sliderShadow show! Item was changed: ----- Method: Slider>>mouseUpInSlider: (in category 'other events') ----- mouseUpInSlider: event slider borderStyle style == #inset ifTrue: [slider borderColor: #raised]. + self hideSliderShadow.! - sliderShadow hide! Item was added: + ----- Method: Slider>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color lightGray]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]). + + slider + color: (self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]); + borderColor: (self userInterfaceTheme thumbBorderColor ifNil: [Color gray: 0.6]); + borderWidth: (self userInterfaceTheme thumbBorderWidth ifNil: [0]). + + sliderShadow + borderWidth: slider borderWidth; + borderColor: Color transparent. + + sliderColor := slider color. + self updateSliderColor: slider color.! Item was added: + ----- Method: Slider>>showSliderShadow (in category 'other events') ----- + showSliderShadow + + sliderShadow color: self sliderShadowColor. + sliderShadow cornerStyle: slider cornerStyle. + sliderShadow bounds: slider bounds. + sliderShadow show.! Item was changed: ----- Method: Slider>>sliderColor (in category 'accessing - ui') ----- sliderColor "color scheme for the whole slider widget" + + ^ sliderColor ifNil: [self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]]! - sliderColor ifNil: [^ (color alphaMixed: 0.7 with: Color white) slightlyLighter]. - ^ sliderColor! Item was changed: ----- Method: Slider>>sliderColor: (in category 'accessing - ui') ----- sliderColor: newColor sliderColor := newColor. + self updateSliderColor: sliderColor.! - slider ifNotNil: [slider color: sliderColor]! Item was changed: ----- Method: Slider>>sliderShadowColor (in category 'accessing - ui') ----- sliderShadowColor + + ^ ((self userInterfaceTheme thumbShadowModifier + ifNil: [ [:c | c alpha: 0.7 ] ]) value: self sliderColor)! - ^ self sliderColor alphaMixed: 0.2 with: self pagingArea color! Item was changed: + ----- Method: Slider>>updateSlider (in category 'updating') ----- - ----- Method: Slider>>updateSlider (in category 'initialization') ----- updateSlider "Updates layout properties of the slider." slider bounds: self totalSliderArea. sliderShadow bounds: slider bounds. self computeSlider. ! Item was added: + ----- Method: Slider>>updateSliderColor: (in category 'updating') ----- + updateSliderColor: aColor + + slider color: aColor. + sliderShadow color: self sliderShadowColor.! Item was added: + ----- Method: TextMorph>>createParagraph (in category 'private') ----- + createParagraph + + self setProperty: #CreatingParagraph toValue: true. + + [ + self setDefaultContentsIfNil. + + "...Code here to recreate the paragraph..." + paragraph := (self paragraphClass new textOwner: self owner). + paragraph wantsColumnBreaks: successor notNil. + paragraph + compose: text + style: textStyle copy + from: self startingIndex + in: self container. + wrapFlag ifFalse: + ["Was given huge container at first... now adjust" + paragraph adjustRightX]. + paragraph focused: (self currentHand keyboardFocus == self). + + self fit. + ] ensure: [self removeProperty: #CreatingParagraph]. + + ^ paragraph! Item was changed: ----- Method: TextMorph>>paragraph (in category 'private') ----- paragraph "Paragraph instantiation is lazy -- create it only when needed" - paragraph ifNotNil: [^ paragraph]. + ^ paragraph ifNil: [self createParagraph]! - self setProperty: #CreatingParagraph toValue: true. - - self setDefaultContentsIfNil. - - "...Code here to recreate the paragraph..." - paragraph := (self paragraphClass new textOwner: self owner). - paragraph wantsColumnBreaks: successor notNil. - paragraph - compose: text - style: textStyle copy - from: self startingIndex - in: self container. - wrapFlag ifFalse: - ["Was given huge container at first... now adjust" - paragraph adjustRightX]. - paragraph focused: (self currentHand keyboardFocus == self). - self fit. - self removeProperty: #CreatingParagraph. - - - ^ paragraph! Item was added: + ----- Method: TextMorphForEditView>>caretColor (in category 'accessing') ----- + caretColor + ^ self valueOfProperty: #caretColor ifAbsent: [Color red]! Item was added: + ----- Method: TextMorphForEditView>>createParagraph (in category 'private') ----- + createParagraph + + super createParagraph. + + paragraph + caretColor: self caretColor; + selectionColor: self selectionColor; + unfocusedSelectionColor: self unfocusedSelectionColor. + + ^ paragraph! Item was added: + ----- Method: TextMorphForEditView>>selectionColor (in category 'accessing') ----- + selectionColor + ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue muchLighter]! Item was added: + ----- Method: TextMorphForEditView>>unfocusedSelectionColor (in category 'accessing') ----- + unfocusedSelectionColor + ^ self valueOfProperty: #unfocusedSelectionColor ifAbsent: [Color blue muchLighter]! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'ScrollBar initializeImagesCache. + LazyListMorph allSubInstancesDo: [:ea | ea resetFilterOffsets]. + PluggableTextMorph flushAdornmentCache.'! - (PackageInfo named: 'Morphic') postscript: 'SystemProgressMorph reset.'!

1 0

The Trunk: ToolBuilder-Morphic-mt.174.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.174.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.174 Author: mt Time: 31 July 2016, 11:17:03.77049 am UUID: f9224283-fd0c-3e47-8895-a070844b3e2a Ancestors: ToolBuilder-Morphic-mt.173 *** Widget Refactorings and UI Themes (Part 6 of 11) *** Some fixes and refactorings for buttons including added support for UI theming. =============== Diff against ToolBuilder-Morphic-mt.173 =============== Item was changed: PluggableButtonMorph subclass: #PluggableButtonMorphPlus + instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap disabledColor disabledTextColor' - instanceVariableNames: 'enabled action getColorSelector getEnabledSelector updateMap' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Morphic'! !PluggableButtonMorphPlus commentStamp: 'ar 2/11/2005 21:53' prior: 0! An extended version of PluggableButtonMorph supporting enablement, color and block/message actions.! Item was added: + ----- Method: PluggableButtonMorphPlus class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #disabledColor. 'Colors'. 'Color when button cannot be clicked.' }. + { #disabledTextColor. 'Colors'. 'Color for label when button cannot be clicked.' }. + }! Item was added: + ----- Method: PluggableButtonMorphPlus>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme.! Item was changed: ----- Method: PluggableButtonMorphPlus>>enabled: (in category 'accessing') ----- enabled: aBool enabled := aBool. + self updateFillStyle.! - enabled - ifFalse:[self color: Color gray] - ifTrue:[self getModelState - ifTrue: [self color: onColor] - ifFalse: [self color: offColor]]! Item was changed: ----- Method: PluggableButtonMorphPlus>>getEnabledSelector: (in category 'accessing') ----- getEnabledSelector: aSymbol getEnabledSelector := aSymbol. + self update: getEnabledSelector.! - self update: aSymbol.! Item was added: + ----- Method: PluggableButtonMorphPlus>>handlesMouseDown: (in category 'event handling') ----- + handlesMouseDown: evt + ^ enabled! Item was added: + ----- Method: PluggableButtonMorphPlus>>handlesMouseOver: (in category 'event handling') ----- + handlesMouseOver: evt + ^ enabled! Item was added: + ----- Method: PluggableButtonMorphPlus>>handlesMouseOverDragging: (in category 'event handling') ----- + handlesMouseOverDragging: evt + ^ enabled! Item was changed: ----- Method: PluggableButtonMorphPlus>>initialize (in category 'initialize-release') ----- initialize + - super initialize. enabled := true. + super initialize.! - onColor := Color veryLightGray. - offColor := Color white! Item was removed: - ----- Method: PluggableButtonMorphPlus>>mouseDown: (in category 'action') ----- - mouseDown: evt - enabled ifFalse:[^self]. - ^super mouseDown: evt! Item was removed: - ----- Method: PluggableButtonMorphPlus>>mouseMove: (in category 'action') ----- - mouseMove: evt - enabled ifFalse:[^self]. - ^super mouseMove: evt! Item was removed: - ----- Method: PluggableButtonMorphPlus>>mouseUp: (in category 'action') ----- - mouseUp: evt - enabled ifFalse:[^self]. - ^super mouseUp: evt! Item was removed: - ----- Method: PluggableButtonMorphPlus>>onColor:offColor: (in category 'accessing') ----- - onColor: colorWhenOn offColor: colorWhenOff - "Set the fill colors to be used when this button is on/off." - - onColor := colorWhenOn. - offColor := colorWhenOff. - self update: getStateSelector.! Item was added: + ----- Method: PluggableButtonMorphPlus>>setDefaultParameters (in category 'initialize-release') ----- + setDefaultParameters + + disabledColor := (self userInterfaceTheme disabledColor ifNil: [Color transparent]). + disabledTextColor := (self userInterfaceTheme disabledTextColor ifNil: [Color gray: 0.6]). + + super setDefaultParameters. + ! Item was added: + ----- Method: PluggableButtonMorphPlus>>textColorToUse (in category 'drawing') ----- + textColorToUse + + ^ self enabled + ifTrue: [super textColorToUse] + ifFalse: [disabledTextColor ifNil: [Color gray: 0.6]]! Item was changed: ----- Method: PluggableButtonMorphPlus>>update: (in category 'updating') ----- update: what + super update: what. + + getColorSelector ifNotNil: [:sel | + what == sel ifTrue: [self offColor: (model perform: sel)]]. - self getModelState - ifTrue: [self color: onColor] - ifFalse: [self color: offColor]. + getEnabledSelector ifNotNil: [:sel | + what == sel ifTrue: [self enabled: (model perform: sel)]]. - what ifNil:[^self]. - what == getLabelSelector ifTrue: [ - self label: (model perform: getLabelSelector)]. - what == getEnabledSelector ifTrue:[^self enabled: (model perform: getEnabledSelector)]. - - getColorSelector ifNotNil: [ | cc | - color = (cc := model perform: getColorSelector) ifFalse:[ - color := cc. - self onColor: color offColor: color. - self changed. - ]. - ]. - - getEnabledSelector ifNotNil:[ - self enabled: (model perform: getEnabledSelector). - ]. updateMap ifNotNil: [(updateMap at: what ifAbsent: []) + ifNotNilDo: [ :newTarget | self update: newTarget]]. - ifNotNilDo: [ :newTarget | ^self update: newTarget]]. ! Item was added: + ----- Method: PluggableButtonMorphPlus>>updateFillStylePressing:hovering: (in category 'initialize-release') ----- + updateFillStylePressing: isPressing hovering: isHovering + + enabled ifFalse: [ + self color: (disabledColor ifNil: [Color transparent]). + self borderStyle color: Color transparent. + ^ self]. + + super updateFillStylePressing: isPressing hovering: isHovering.!

1 0

The Trunk: Morphic-mt.1212.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1212.mcz ==================== Summary ==================== Name: Morphic-mt.1212 Author: mt Time: 31 July 2016, 11:16:13.00249 am UUID: 33cfd9c4-1799-954f-a7fd-b73579490169 Ancestors: Morphic-mt.1211 *** Widget Refactorings and UI Themes (Part 6 of 11) *** Some fixes and refactorings for buttons including added support for UI theming. =============== Diff against Morphic-mt.1211 =============== Item was changed: + Morph subclass: #PluggableButtonMorph + instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style hoverColor borderColor textColor labelOffset' - AlignmentMorph subclass: #PluggableButtonMorph - instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback allButtons arguments argumentsProvider argumentsSelector style' classVariableNames: 'GradientButton RoundedButtonCorners' poolDictionaries: '' category: 'Morphic-Pluggable Widgets'! !PluggableButtonMorph commentStamp: '<historical>' prior: 0! A PluggableButtonMorph is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are: getStateSelector fetch a boolean value from the model actionSelector invoke this button's action on the model getLabelSelector fetch this button's lable from the model getMenuSelector fetch a pop-up menu for this button from the model Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false. The model informs its view(s) of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector. If the actionSelector takes one or more arguments, then the following are relevant: arguments A list of arguments to provide when the actionSelector is called. argumentsProvider The object that is sent the argumentSelector to obtain arguments, if dynamic argumentsSelector The message sent to the argumentProvider to obtain the arguments. Options: askBeforeChanging have model ask user before allowing a change that could lose edits triggerOnMouseDown do this button's action on mouse down (vs. up) transition shortcutCharacter a place to record an optional shortcut key ! Item was changed: ----- Method: PluggableButtonMorph class>>gradientButton: (in category 'preferences') ----- gradientButton: aBoolean + GradientButton = aBoolean ifTrue: [^ self]. + GradientButton := aBoolean. + + PluggableButtonMorph allSubInstancesDo: [:ea | ea updateFillStyle].! - GradientButton := aBoolean.! Item was added: + ----- Method: PluggableButtonMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the button''s border.' }. + { #borderWidth. 'Borders'. 'Width of the button''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the button.' }. + + { #font. 'Fonts'. 'Font for button title.' }. + { #textColor. 'Colors'. 'Color for the button title label.' }. + }! Item was added: + ----- Method: PluggableButtonMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was removed: - ----- Method: PluggableButtonMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: PluggableButtonMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color gray: 0.7! Item was removed: - ----- Method: PluggableButtonMorph>>drawBackgroundOn: (in category 'drawing') ----- - drawBackgroundOn: aCanvas - | cc gradient borderColor fill | - cc := self color. - cc isTransparent ifTrue:[cc := Color gray: 0.9]. - self enabled ifFalse:[cc := Color lightGray]. - cc brightness > 0.9 ifTrue:[cc := cc adjustBrightness: 0.9 - cc brightness]. - showSelectionFeedback ifTrue:[ - borderColor := cc muchDarker. - gradient := GradientFillStyle ramp: { - 0.0 -> cc muchDarker. - 0.1-> (cc adjustBrightness: -0.2). - 0.5 -> cc. - 0.9-> (cc adjustBrightness: -0.1). - 1 -> cc muchDarker}. - cc := cc muchDarker. - ] ifFalse:[ - borderColor := Color lightGray. - gradient := GradientFillStyle ramp: { - 0.0 -> Color white. - 0.1-> (cc adjustBrightness: 0.05). - 0.6 -> (cc darker)}. - ]. - gradient origin: bounds topLeft. - gradient direction: 0@self height. - - PluggableButtonMorph gradientButton - ifFalse: [fill := SolidFillStyle color: cc] - ifTrue: [fill := gradient]. - - ^ self wantsRoundedCorners - ifTrue: [aCanvas - frameAndFillRoundRect: self bounds - radius: self cornerRadius - fillStyle: fill - borderWidth: 1 - borderColor: borderColor] - ifFalse: [aCanvas - frameAndFillRectangle: self bounds - fillColor: fill asColor - borderWidth: 1 - borderColor: borderColor darker; - fillRectangle: self innerBounds - fillStyle: fill]! Item was changed: ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') ----- drawLabelOn: aCanvas + | fontToUse labelToUse colorToUse labelWidth layoutBounds drawBlock | - | fontToUse labelToUse labelWidth layoutBounds drawBlock | self label ifNil: [^ self]. layoutBounds := self layoutBounds. labelToUse := self label asString. fontToUse := self font. + colorToUse := self textColorToUse. "Support very narrow buttons. Shrink text to monogram then." (layoutBounds width < self labelShrinkThreshold and: [labelToUse size > 3]) ifTrue: [ labelToUse := labelToUse first asString. "Show first character only." fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode]. labelWidth := fontToUse widthOfString: labelToUse. drawBlock := [:c | c drawString: labelToUse at: (layoutBounds center x - (labelWidth // 2) max: (layoutBounds left)) @ (layoutBounds center y - (fontToUse height // 2)) font: fontToUse + color: colorToUse]. - color: Color black]. self clipSubmorphs ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock] ifFalse: [drawBlock value: aCanvas]! Item was changed: ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + (self fillStyle isColor not and: [self fillStyle isGradientFill]) + ifTrue: [self fillStyle origin: self topLeft; direction: 0@ self height]. + + super drawOn: aCanvas. - self drawBackgroundOn: aCanvas. + aCanvas + translateBy: self labelOffset + during: [:c | + self label isMorph + ifTrue: [self drawMorphLabelOn: c] + ifFalse: [self drawLabelOn: c]].! - self label isMorph - ifTrue: [self drawMorphLabelOn: aCanvas] - ifFalse: [self drawLabelOn: aCanvas].! Item was added: + ----- Method: PluggableButtonMorph>>feedbackColor (in category 'accessing') ----- + feedbackColor + ^ feedbackColor! Item was changed: + ----- Method: PluggableButtonMorph>>initialize (in category 'initialization') ----- - ----- Method: PluggableButtonMorph>>initialize (in category 'initialize-release') ----- initialize super initialize. "Layout properties." self extent: 20 @ 15; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: (4@0 corner: 4@0); clipSubmorphs: true; wrapCentering: #center; cellPositioning: #topCenter. - "Visuals." - self borderStyle: BorderStyle thinGray. - "Initialize instance variables." model := nil. label := nil. getStateSelector := nil. actionSelector := nil. getLabelSelector := nil. getMenuSelector := nil. shortcutCharacter := nil. askBeforeChanging := false. triggerOnMouseDown := false. - onColor := self color darker. - offColor := self color. - feedbackColor := Color red. - showSelectionFeedback := false. allButtons := nil. argumentsProvider := nil. + argumentsSelector := nil. + + self setDefaultParameters. + ! - argumentsSelector := nil.! Item was changed: ----- Method: PluggableButtonMorph>>label: (in category 'accessing') ----- label: aStringOrTextOrMorph label = aStringOrTextOrMorph ifTrue: [^ self]. + label := aStringOrTextOrMorph isString + ifFalse: [aStringOrTextOrMorph asMorph] + ifTrue: [aStringOrTextOrMorph]. - label := aStringOrTextOrMorph isText - ifTrue: [aStringOrTextOrMorph asMorph] - ifFalse: [aStringOrTextOrMorph]. self updateMinimumExtent. self changed.! Item was added: + ----- Method: PluggableButtonMorph>>labelOffset (in category 'accessing') ----- + labelOffset + ^ labelOffset ifNil: [0@0]! Item was added: + ----- Method: PluggableButtonMorph>>labelOffset: (in category 'accessing') ----- + labelOffset: aPoint + labelOffset := aPoint.! Item was changed: ----- Method: PluggableButtonMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt "Details: If this button is triggered on mouse down or the event is the menu gesture, handle it immediately. Otherwise, make a list of buttons (including the receiver) for mouseMove feedback. This allows a simple radio-button effect among the button submorphs of a given morph." allButtons := nil. evt yellowButtonPressed ifTrue: [^ self invokeMenu: evt]. triggerOnMouseDown ifTrue: [self performAction] ifFalse: [ allButtons := owner submorphs select: [:m | m class = self class]. + self updateFillStyle: evt]. - self updateFeedbackForEvt: evt]. ! Item was changed: ----- Method: PluggableButtonMorph>>mouseEnter: (in category 'event handling') ----- mouseEnter: evt + self updateFillStyle: evt.! - "0.09375 is exact in floating point so no cumulative rounding error will occur" - self color: (self color adjustBrightness: -0.09375)! Item was changed: ----- Method: PluggableButtonMorph>>mouseLeave: (in category 'event handling') ----- mouseLeave: evt + self updateFillStyle: evt.! - "0.09375 is exact in floating point so no cumulative rounding error will occur" - self color: (self color adjustBrightness: 0.09375). - self update: nil! Item was changed: ----- Method: PluggableButtonMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt allButtons ifNil: [^ self]. + allButtons do: [:m | m updateFillStyle: evt].! - allButtons do: [:m | m updateFeedbackForEvt: evt]. - ! Item was changed: ----- Method: PluggableButtonMorph>>mouseUp: (in category 'event handling') ----- mouseUp: evt + self updateFillStyle: 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. ! Item was changed: ----- Method: PluggableButtonMorph>>offColor: (in category 'accessing') ----- offColor: colorWhenOff "Set the fill colors to be used when this button is off." + | cc | + cc := colorWhenOff isTransparent ifTrue: [(Color gray: 0.9) alpha: 0.5] ifFalse: [colorWhenOff]. + self + onColor: ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c adjustBrightness: -0.2] ]) value: cc) + offColor: cc - self onColor: onColor offColor: colorWhenOff ! Item was changed: + ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialization') ----- - ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialize-release') ----- on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel self model: anObject. getStateSelector := getStateSel. actionSelector := actionSel. getLabelSelector := labelSel. getMenuSelector := menuSel. + self update: labelSel. + self update: getStateSel. + self updateFillStyle.! - ! Item was changed: ----- Method: PluggableButtonMorph>>onColor:offColor: (in category 'accessing') ----- onColor: colorWhenOn offColor: colorWhenOff "Set the fill colors to be used when this button is on/off." onColor := colorWhenOn. offColor := colorWhenOff. + + hoverColor := (self userInterfaceTheme hoverModifier ifNil: [ [:c | c adjustBrightness: -0.1] ]) value: offColor. + feedbackColor := (self userInterfaceTheme feedbackModifier ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: offColor. + + self updateFillStyle.! - self update: nil. - ! Item was added: + ----- Method: PluggableButtonMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color gray: 0.91]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]); + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]). + + borderColor := self borderColor. + self offColor: self color.! Item was added: + ----- Method: PluggableButtonMorph>>textColor (in category 'accessing') ----- + textColor + ^ textColor ifNil: [Color black "old instances"]! Item was added: + ----- Method: PluggableButtonMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + textColor := aColor. + self changed.! Item was added: + ----- Method: PluggableButtonMorph>>textColorToUse (in category 'drawing') ----- + textColorToUse + + ^ self textColor! Item was changed: ----- Method: PluggableButtonMorph>>update: (in category 'updating') ----- update: aParameter + getLabelSelector ifNotNil: [:sel | + aParameter == sel ifTrue: [self label: (model perform: sel)]]. + getStateSelector ifNotNil: [:sel | + aParameter == sel ifTrue: [self updateFillStyle]].! - getLabelSelector ifNotNil: [ - aParameter == getLabelSelector ifTrue: [ - self label: (model perform: getLabelSelector)]]. - self getModelState - ifTrue: [self color: onColor] - ifFalse: [self color: offColor]. - ! Item was removed: - ----- Method: PluggableButtonMorph>>updateFeedbackForEvt: (in category 'events') ----- - 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]. - ! Item was added: + ----- Method: PluggableButtonMorph>>updateFillStyle (in category 'updating') ----- + updateFillStyle + + self + updateFillStylePressing: false + hovering: false.! Item was added: + ----- Method: PluggableButtonMorph>>updateFillStyle: (in category 'updating') ----- + updateFillStyle: evt + + self + updateFillStylePressing: (evt redButtonPressed and: [self containsPoint: evt position]) + hovering: (evt redButtonPressed not and: [self containsPoint: evt position]).! Item was added: + ----- Method: PluggableButtonMorph>>updateFillStylePressing:hovering: (in category 'updating') ----- + updateFillStylePressing: isPressing hovering: isHovering + + | gradient cc | + "Migrate old instances." + hoverColor ifNil: [hoverColor := onColor darker]. + + self labelOffset: (isPressing ifTrue: [1@1] ifFalse: [0@0]). + + self getModelState + ifTrue: [self color: onColor] + ifFalse: [self color: offColor]. + self borderColor: borderColor. + + self class gradientButton ifFalse: [ + isPressing ifTrue: [ + self color: feedbackColor. + self borderColor: feedbackColor muchDarker]. + isHovering ifTrue: [ + self color: hoverColor. + self borderColor: borderColor]. + ^ self]. + + isPressing ifTrue: [ + cc := feedbackColor. + self borderColor: feedbackColor muchDarker. + gradient := GradientFillStyle ramp: { + 0.0 -> cc muchDarker. + 0.1-> (cc adjustBrightness: -0.2). + 0.5 -> cc. + 0.9-> (cc adjustBrightness: -0.1). + 1 -> cc muchDarker}]. + isHovering ifTrue: [ + cc := hoverColor. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.1-> (cc adjustBrightness: 0.05). + 0.6 -> (cc darker)}]. + gradient ifNil: [ + cc := self color. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.1-> (cc adjustBrightness: 0.05). + 0.6 -> (cc darker)}]. + + gradient origin: bounds topLeft. + gradient direction: 0@self height. + + self fillStyle: gradient.! Item was changed: ----- Method: PluggableButtonMorph>>veryDeepInner: (in category 'copying') ----- veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. "model := model. Weakly copied" label := label veryDeepCopyWith: deepCopier. "getStateSelector := getStateSelector. a Symbol" "actionSelector := actionSelector. a Symbol" "getLabelSelector := getLabelSelector. a Symbol" "getMenuSelector := getMenuSelector. a Symbol" shortcutCharacter := shortcutCharacter veryDeepCopyWith: deepCopier. askBeforeChanging := askBeforeChanging veryDeepCopyWith: deepCopier. triggerOnMouseDown := triggerOnMouseDown veryDeepCopyWith: deepCopier. offColor := offColor veryDeepCopyWith: deepCopier. onColor := onColor veryDeepCopyWith: deepCopier. feedbackColor := feedbackColor veryDeepCopyWith: deepCopier. + hoverColor := hoverColor veryDeepCopyWith: deepCopier. + borderColor := borderColor veryDeepCopyWith: deepCopier. + textColor := textColor veryDeepCopyWith: deepCopier. + labelOffset := labelOffset veryDeepCopyWith: deepCopier. - showSelectionFeedback := showSelectionFeedback veryDeepCopyWith: deepCopier. allButtons := nil. "a cache" arguments := arguments veryDeepCopyWith: deepCopier. argumentsProvider := argumentsProvider veryDeepCopyWith: deepCopier. "argumentsSelector := argumentsSelector. a Symbol" style := style. "a Symbol"!

1 0

The Trunk: ToolBuilder-Morphic-mt.173.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.173.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.173 Author: mt Time: 31 July 2016, 11:11:41.15449 am UUID: 859eb0f9-c596-2f48-9ae3-a3f8056450c5 Ancestors: ToolBuilder-Morphic-mt.172 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against ToolBuilder-Morphic-mt.172 =============== Item was changed: Model subclass: #ListChooser + instanceVariableNames: 'selectedIndex items searchText addAllowed result title listMorph dialogMorph' - instanceVariableNames: 'window fullList selectedItems searchText searchMorph title listMorph index realIndex buttonBar builder addAllowed result' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Morphic'! !ListChooser commentStamp: 'MAD 3/14/2010 16:20' prior: 0! I am a simple dialog to allow the user to pick from a list of strings or symbols. I support keyboard and mouse navigation, and interactive filtering of the displayed items. You can specify whether you want the index, or the value of the selected item. If you're interested in the value, you can also allow users to Add a new value not in the list. cmd-s or <enter> or double-click answers the currently selected item's value/index; cmd-l or <escape> or closing the window answers nil/zero. Now using ToolBuilder, so needs Morphic-MAD.381. Released under the MIT Licence.! Item was added: + ----- Method: ListChooser class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + { #addColor. 'Colors'. 'Color for a normal button.' }. + { #disabledColor. 'Colors'. 'Color for a disabled button.' }. + }! Item was changed: + ----- Method: ListChooser>>accept (in category 'actions') ----- - ----- Method: ListChooser>>accept (in category 'event handling') ----- accept "if the user submits with no valid entry, make them start over" - self canAccept ifFalse: [ - searchMorph selectAll. - ^ self ]. + | choice | + self canAccept ifFalse: [ + self canAdd ifTrue: [^ self add]. + ^ self changed: #textSelection]. + + choice := self selectedItem. + + self canAdd ifTrue: [ + "Ask the user whether to add the new item or choose the list selection." + (UserDialogBoxMorph confirm: 'You can either choose an existing item or add a new one.\What do you want?' translated withCRs title: 'Choose or Add' translated trueChoice: choice asString falseChoice: self searchText asString at: ActiveHand position) + ifTrue: [self result: choice] ifFalse: [self result: self searchText asString] + ] ifFalse: [self result: choice]. + + + self changed: #close.! - "find the selected item in the original list, and return it" - result := selectedItems at: index. - - builder ifNotNil: [ :bldr | - builder := nil. - bldr close: window ]! Item was changed: + ----- Method: ListChooser>>acceptColor (in category 'colors') ----- - ----- Method: ListChooser>>acceptColor (in category 'drawing') ----- acceptColor + + self canAdd ifTrue: [^ self addColor]. + ^ self canAccept + ifTrue: [ self userInterfaceTheme okColor ifNil: [(Color r: 0.49 g: 0.749 b: 0.49)] ] + ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]! - ifTrue: [ ColorTheme current okColor ] - ifFalse: [ Color lightGray "ColorTheme current disabledColor <- you don't have this!!" ]! Item was added: + ----- Method: ListChooser>>acceptLabel (in category 'colors') ----- + acceptLabel + + ^ self canAdd + ifFalse: ['Choose' translated] + ifTrue: [self canAccept + ifTrue: ['Choose or Add' translated] + ifFalse: ['Add' translated]]! Item was changed: + ----- Method: ListChooser>>acceptText: (in category 'actions') ----- - ----- Method: ListChooser>>acceptText: (in category 'event handling') ----- acceptText: someText "the text morph wants to tell us about its contents but I don't care, I'm only interested in the list" self accept! Item was changed: + ----- Method: ListChooser>>add (in category 'actions') ----- - ----- Method: ListChooser>>add (in category 'event handling') ----- add "if the user submits with no valid entry, make them start over" + self canAdd ifFalse: [^ self changed: #textSelection]. + self result: self searchText asString. + self changed: #close.! - self canAdd ifFalse: [ - searchMorph selectAll. - ^ self ]. - - "find the string to return" - result := searchMorph getText. - - builder ifNotNil: [ :bldr | - builder := nil. - bldr close: window ]! Item was added: + ----- Method: ListChooser>>addAllowed (in category 'accessing') ----- + addAllowed + + ^ addAllowed! Item was added: + ----- Method: ListChooser>>addAllowed: (in category 'accessing') ----- + addAllowed: anObject + + addAllowed := anObject! Item was added: + ----- Method: ListChooser>>addColor (in category 'colors') ----- + addColor + + ^ self canAdd + ifTrue: [ self userInterfaceTheme addColor ifNil: [Color blue muchLighter] ] + ifFalse: [ self userInterfaceTheme disabledColor ifNil: [Color lightGray] ]! Item was added: + ----- Method: ListChooser>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + changed: #okColor; + changed: #cancelColor; + changed: #addColor.! Item was removed: - ----- Method: ListChooser>>buildButtonBarWith: (in category 'building') ----- - buildButtonBarWith: builder - | panel button | - panel := builder pluggablePanelSpec new - model: self; - layout: #proportional; - children: OrderedCollection new. - button := builder pluggableButtonSpec new. - button - model: self; - label: 'Accept (s)'; - action: #accept; - enabled: #canAccept; - state: #canAccept; - color: #acceptColor; - frame: (0.0 @ 0.0 corner: 0.34@1). - panel children add: button. - - button := builder pluggableButtonSpec new. - button - model: self; - label: 'Add (a)'; - action: #add; - enabled: #canAdd; - frame: (0.36 @ 0.0 corner: 0.63@1). - panel children add: button. - - button := builder pluggableButtonSpec new. - button - model: self; - label: 'Cancel (l)'; - action: #cancel; - color: #cancelColor; - frame: (0.65 @ 0.0 corner: 1@1). - panel children add: button. - - ^ panel! Item was removed: - ----- Method: ListChooser>>buildListMorphWith: (in category 'building') ----- - buildListMorphWith: builder - | listSpec | - listSpec := builder pluggableListSpec new. - listSpec - model: self; - list: #list; - getIndex: #selectedIndex; - setIndex: #selectedIndex:; - doubleClick: #accept; - "handleBasicKeys: false;" - keystrokePreview: #keyStrokeFromList:; - "doubleClickSelector: #accept;" - autoDeselect: false. - ^ listSpec! Item was removed: - ----- Method: ListChooser>>buildSearchMorphWith: (in category 'building') ----- - buildSearchMorphWith: builder - | fieldSpec | - fieldSpec := builder pluggableInputFieldSpec new. - fieldSpec - model: self; - getText: #searchText; - setText: #acceptText:; - menu: nil. - "hideScrollBarsIndefinitely;" - "acceptOnCR: true;" - "setBalloonText: 'Type a string to filter down the listed items'." - "onKeyStrokeSend: #keyStroke: to: self." - ^ fieldSpec! Item was removed: - ----- Method: ListChooser>>buildWindowWith: (in category 'building') ----- - buildWindowWith: builder - | windowSpec | - windowSpec := builder pluggableWindowSpec new. - windowSpec model: self. - windowSpec label: #title. - windowSpec children: OrderedCollection new. - ^windowSpec! Item was removed: - ----- Method: ListChooser>>buildWindowWith:specs: (in category 'building') ----- - buildWindowWith: builder specs: specs - | windowSpec | - windowSpec := self buildWindowWith: builder. - specs do: [ :assoc | - | rect action widgetSpec | - rect := assoc key. - action := assoc value. - widgetSpec := action value. - widgetSpec ifNotNil:[ - widgetSpec frame: rect. - windowSpec children add: widgetSpec ] ]. - ^ windowSpec! Item was changed: ----- Method: ListChooser>>buildWith: (in category 'building') ----- + buildWith: builder + + | dialogSpec searchBarHeight listSpec fieldSpec | - buildWith: aBuilder - | windowSpec searchBarHeight buttonBarHeight | - builder := aBuilder. searchBarHeight := Preferences standardDefaultTextFont height * 2. - buttonBarHeight := Preferences standardButtonFont height * 4. + dialogSpec := builder pluggableDialogSpec new + model: self; + title: #title; + closeAction: #closed; + extent: self initialExtent; + children: OrderedCollection new; + buttons: OrderedCollection new; + yourself. - windowSpec := self buildWindowWith: builder specs: { - (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@searchBarHeight)) -> [self buildSearchMorphWith: builder]. - (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@searchBarHeight corner: 0@buttonBarHeight negated)) -> [self buildListMorphWith: builder]. - (LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@buttonBarHeight negated corner: 0@0)) -> [self buildButtonBarWith: builder]. - }. - windowSpec closeAction: #closed. - windowSpec extent: self initialExtent. - window := builder build: windowSpec. + listSpec := builder pluggableListSpec new. + listSpec + model: self; + list: #items; + getIndex: #selectedIndex; + setIndex: #selectedIndex:; + doubleClick: #accept; + "keystrokePreview: #keyStrokeFromList:;" + autoDeselect: false; + name: #list; + frame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@searchBarHeight corner: 0@0)). + dialogSpec children add: listSpec. + fieldSpec := builder pluggableInputFieldSpec new. + fieldSpec + model: self; + getText: #searchText; + editText: #searchText:; + setText: #acceptText:; + selection: #textSelection; + menu: nil; + indicateUnacceptedChanges: false; + askBeforeDiscardingEdits: false; + help: 'Type a string to filter down the listed items'; + frame: (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@searchBarHeight)). + dialogSpec children add: fieldSpec. + + "Buttons" + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: #acceptLabel; + action: #accept; + enabled: #canAcceptOrAdd; + color: #acceptColor). + + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: 'Cancel'; + action: #cancel; + color: #cancelColor). + + dialogMorph := builder build: dialogSpec. + dialogMorph addKeyboardCaptureFilter: self. + listMorph := builder widgetAt: #list. + listMorph allowEmptyFilterResult: true. + + ^ dialogMorph! - searchMorph := window submorphs detect: - [ :each | each isKindOf: PluggableTextMorph ]. - searchMorph - hideScrollBarsIndefinitely; - acceptOnCR: true; - setBalloonText: 'Type a string to filter down the listed items'; - onKeyStrokeSend: #keyStroke: to: self; - hasUnacceptedEdits: true "force acceptOnCR to work even with no text entered". - listMorph := window submorphs detect: - [ :each | each isKindOf: PluggableListMorph ]. - ^ window! Item was added: + ----- Method: ListChooser>>canAcceptOrAdd (in category 'testing') ----- + canAcceptOrAdd + ^ self canAccept or: [self canAdd]! Item was changed: ----- Method: ListChooser>>canAdd (in category 'testing') ----- canAdd + ^ self addAllowed + and: [self searchText asString withBlanksTrimmed notEmpty] + and: [self selectedItem asString ~= self searchText asString]! - ^ addAllowed and: [ self canAccept not ]! Item was changed: + ----- Method: ListChooser>>cancel (in category 'actions') ----- - ----- Method: ListChooser>>cancel (in category 'event handling') ----- cancel + + self result: nil. + self changed: #close.! - "Cancel the dialog and move on" - index := 0. - builder ifNotNil: [ builder close: window ]! Item was changed: + ----- Method: ListChooser>>cancelColor (in category 'colors') ----- - ----- Method: ListChooser>>cancelColor (in category 'drawing') ----- cancelColor + + ^ self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]! - ^ ColorTheme current cancelColor! Item was changed: ----- Method: ListChooser>>chooseIndexFrom:title: (in category 'initialize-release') ----- chooseIndexFrom: labelList title: aString | choice | choice := self chooseItemFrom: labelList title: aString addAllowed: false. + ^ self items indexOf: choice ifAbsent: 0! - ^ fullList indexOf: choice ifAbsent: 0! Item was changed: ----- Method: ListChooser>>chooseIndexFrom:title:addAllowed: (in category 'initialize-release') ----- chooseIndexFrom: labelList title: aString addAllowed: aBoolean | choice | choice := self chooseItemFrom: labelList title: aString addAllowed: false. + self addAllowed: aBoolean. + ^ self items indexOf: choice ifAbsent: 0! - addAllowed := aBoolean. - ^ fullList indexOf: choice ifAbsent: 0! Item was changed: ----- Method: ListChooser>>chooseItemFrom:title:addAllowed: (in category 'initialize-release') ----- chooseItemFrom: labelList title: aString addAllowed: aBoolean + + self items: labelList asOrderedCollection. - fullList := labelList asOrderedCollection. "coerce everything into an OC" - builder := ToolBuilder default. - self list: fullList. self title: aString. + self addAllowed: aBoolean. + + ToolBuilder open: self. + ^ self result! - addAllowed := aBoolean. - window := ToolBuilder default open: self. - window center: Sensor cursorPoint. - window setConstrainedPosition: (Sensor cursorPoint - (window fullBounds extent // 2)) hangOut: false. - - self changed: #inputRequested with: #searchText. - window lookFocused. "Sigh..." - - builder runModal: window. - ^ result! Item was changed: + ----- Method: ListChooser>>closed (in category 'actions') ----- - ----- Method: ListChooser>>closed (in category 'event handling') ----- closed + + self selectedIndex: 0.! - "Cancel the dialog and move on" - builder ifNotNil: [ index := 0 ]! Item was added: + ----- Method: ListChooser>>filterEvent:for: (in category 'event handling') ----- + filterEvent: aKeyboardEvent for: aMorph + + | char | + aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent]. + aKeyboardEvent anyModifierKeyPressed ifTrue: [^ aKeyboardEvent]. + + char := aKeyboardEvent keyCharacter. + + char = Character backspace + ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButLast]). ^ aKeyboardEvent ignore]. + char = Character delete + ifTrue: [self searchText: (self searchText asString ifNotEmpty: [:s | s allButFirst]). ^ aKeyboardEvent ignore]. + (char = Character cr or: [char = Character enter]) + ifTrue: [self accept. aKeyboardEvent ignore]. + char = Character escape + ifTrue: [self cancel. aKeyboardEvent ignore]. + (char asInteger between: 32 and: 126) + ifTrue: [self searchText: self searchText asString, char asString. aKeyboardEvent ignore]. + + ^ aKeyboardEvent! Item was removed: - ----- Method: ListChooser>>handlesKeyboard: (in category 'event handling') ----- - handlesKeyboard: evt - ^ true! Item was changed: ----- Method: ListChooser>>initialExtent (in category 'building') ----- initialExtent + + | listFont | - | listFont titleFont buttonFont listWidth titleWidth buttonWidth | listFont := Preferences standardListFont. + ^ (20 * (listFont widthOf: $m))@(15 * listFont height)! - titleFont := Preferences windowTitleFont. - buttonFont := Preferences standardButtonFont. - listWidth := 20 * (listFont widthOf: $m). - titleWidth := titleFont widthOfString: self title, '__________'. "add some space for titlebar icons" - buttonWidth := buttonFont widthOfString: '_Accept_(s)___Add (a)___Cancel_(l)_'. - ^ (listWidth max: (titleWidth max: buttonWidth))@(30 * (listFont height))! Item was added: + ----- Method: ListChooser>>items (in category 'accessing') ----- + items + + ^ items! Item was added: + ----- Method: ListChooser>>items: (in category 'accessing') ----- + items: anObject + + items := anObject! Item was removed: - ----- Method: ListChooser>>keyStroke: (in category 'event handling') ----- - keyStroke: event - | newText key | - "handle updates to the search box interactively" - key := event keyString. - (key = '<up>') ifTrue: [ - self move: -1. - ^ self ]. - (key = '<down>') ifTrue: [ - self move: 1. - ^ self ]. - - (key = '<Cmd-s>') ifTrue: [ self accept. ^ self ]. - (key = '<cr>') ifTrue: [ self accept. ^ self ]. - - (key = '<escape>') ifTrue: [ self cancel. ^ self ]. - (key = '<Cmd-l>') ifTrue: [ self cancel. ^ self ]. - - (key = '<Cmd-a>') ifTrue: [ self add. ^ self ]. - - "pull out what's been typed, and update the list as required" - newText := searchMorph textMorph asText asString. - (newText = searchText) ifFalse: [ - searchText := newText. - self updateFilter ]. - ! Item was removed: - ----- Method: ListChooser>>keyStrokeFromList: (in category 'event handling') ----- - keyStrokeFromList: event - "we don't want the list to be picking up events, excepting scroll events" - - "Don't sent ctrl-up/ctrl-down events to the searchMorph: they're scrolling events." - (#(30 31) contains: [:each | each = event keyValue]) not - ifTrue: - ["window world primaryHand keyboardFocus: searchMorph." - searchMorph keyStroke: event. - "let the list know we've dealt with it" - ^true]. - ^false. - ! Item was removed: - ----- Method: ListChooser>>list (in category 'accessing') ----- - list - ^ selectedItems! Item was removed: - ----- Method: ListChooser>>list: (in category 'accessing') ----- - list: items - fullList := items. - selectedItems := items. - self changed: #itemList.! Item was removed: - ----- Method: ListChooser>>list:title: (in category 'accessing') ----- - list: aList title: aString - self list: aList. - self title: aString! Item was removed: - ----- Method: ListChooser>>move: (in category 'event handling') ----- - move: offset - | newindex | - "The up arrow key moves the cursor, and it seems impossible to restore. - So, for consistency, on either arrow, select everything, so a new letter-press starts over. yuk." - searchMorph selectAll. - - newindex := self selectedIndex + offset. - newindex > selectedItems size ifTrue: [ ^ nil ]. - newindex < 1 ifTrue: [ ^ nil ]. - self selectedIndex: newindex. - ! Item was removed: - ----- Method: ListChooser>>moveWindowNear: (in category 'drawing') ----- - moveWindowNear: aPoint - | trialRect delta | - trialRect := Rectangle center: aPoint extent: window fullBounds extent. - delta := trialRect amountToTranslateWithin: World bounds. - window position: trialRect origin + delta.! Item was removed: - ----- Method: ListChooser>>realIndex (in category 'accessing') ----- - realIndex - ^ realIndex ifNil: [ 0 ]! Item was added: + ----- Method: ListChooser>>result (in category 'accessing') ----- + result + + ^ result! Item was added: + ----- Method: ListChooser>>result: (in category 'accessing') ----- + result: anObject + + result := anObject! Item was changed: ----- Method: ListChooser>>searchText: (in category 'accessing') ----- searchText: aString + searchText := aString. + listMorph filterList: aString asString. + + self changed: #searchText. + self changed: #canAcceptOrAdd. + self changed: #acceptLabel. + self changed: #buttons.! - searchText := aString! Item was changed: ----- Method: ListChooser>>selectedIndex (in category 'accessing') ----- selectedIndex + ^ selectedIndex ifNil: [ 1 ]! - ^ index ifNil: [ index := 1 ]! Item was changed: ----- Method: ListChooser>>selectedIndex: (in category 'accessing') ----- selectedIndex: anInt + selectedIndex := anInt. + self changed: #selectedIndex.! - index := (anInt min: selectedItems size). - self changed: #selectedIndex. - self changed: #canAccept.! Item was added: + ----- Method: ListChooser>>selectedItem (in category 'accessing') ----- + selectedItem + + ^ self items at: self selectedIndex ifAbsent: []! Item was added: + ----- Method: ListChooser>>textSelection (in category 'accessing') ----- + textSelection + ^ self searchText size +1 to: self searchText size ! Item was removed: - ----- Method: ListChooser>>updateFilter (in category 'event handling') ----- - updateFilter - - selectedItems := - searchText isEmptyOrNil - ifTrue: [ fullList ] - ifFalse: [ | pattern patternMatches prefixMatches | - pattern := (searchText includes: $*) - ifTrue: [ searchText ] - ifFalse: [ '*', searchText, '*' ]. - patternMatches := fullList select: [:s | pattern match: s ]. - prefixMatches := OrderedCollection new: patternMatches size. - patternMatches removeAllSuchThat: [ :each | - (each findString: searchText startingAt: 1 caseSensitive: false) = 1 - and: [ - prefixMatches add: each. - true ] ]. - prefixMatches addAllLast: patternMatches; yourself]. - self changed: #list. - self selectedIndex: 1. - self changed: #selectedIndex.! Item was added: + ----- Method: ListMultipleChooser class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + }! Item was added: + ----- Method: ListMultipleChooser>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + changed: #okColor; + changed: #cancelColor.! Item was changed: ----- Method: ListMultipleChooser>>buildWith: (in category 'toolbuilder') ----- buildWith: builder + | dialogSpec choicesSpec | + dialogSpec := builder pluggableDialogSpec new - | windowSpec choicesSpec acceptSpec cancelSpec buttonHeight | - windowSpec := builder pluggableWindowSpec new model: self; + extent: self initialExtent; + title: #title; + children: OrderedCollection new; + buttons: OrderedCollection new. + - extent: 250@400; - label: #title; - children: OrderedCollection new. - - buttonHeight := Preferences standardButtonFont height * 4. - choicesSpec := builder pluggableMultiSelectionListSpec new model: self; list: #labels; setIndex: #selectedIndex:; getIndex: #selectedIndex; setSelectionList: #selectionAt:put:; getSelectionList: #selectionAt:; + frame: (0@0 corner: 1@1). + dialogSpec children add: choicesSpec. - frame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@0 corner: 0@ buttonHeight negated)). - windowSpec children add: choicesSpec. + "Buttons" + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: 'accept'; + color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49]); + action: #accept). + + dialogSpec buttons add: ( + builder pluggableButtonSpec new + model: self; + label: 'cancel'; + color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588]); + action: #cancel). + + ^ builder build: dialogSpec! - acceptSpec := builder pluggableButtonSpec new - model: self; - label: 'accept'; - color: ColorTheme current okColor; - action: #accept; - frame: (LayoutFrame fractions: (0@1 corner: 0.5@1) offsets: (0@ buttonHeight negated corner: 0@0)). - windowSpec children add: acceptSpec. - - cancelSpec := builder pluggableButtonSpec new - model: self; - label: 'cancel'; - color: ColorTheme current cancelColor; - action: #cancel; - frame: (LayoutFrame fractions: (0.5@1 corner: 1@1) offsets: (0@ buttonHeight negated corner: 0@0)). - windowSpec children add: cancelSpec. - - ^ builder build: windowSpec! Item was changed: ----- Method: ListMultipleChooser>>choose (in category 'actions') ----- choose - | builder window | - builder := ToolBuilder default. - window := builder open: self.. - window center: Sensor cursorPoint. "Avoid morphic dependency here..." + " self changed: #inputRequested with: #selectedIndex. + " + ToolBuilder open: self. - self changed: #inputRequested with: #selectedIndex. - window lookFocused. "Sigh..." - - builder runModal: window. - ^ self selectedValues! Item was added: + ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') ----- + initialExtent + + | listFont | + listFont := Preferences standardListFont. + ^ (20 * (listFont widthOf: $m))@(15 * listFont height)! Item was added: + ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- + buildPluggableDialog: aSpec + + | widget | + + widget := self dialogClass new. + self register: widget id: aSpec name. + + widget model: aSpec model. + + "Set child dependent layout properties. The pane morph holds the special contents." + widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). + self setLayoutHintsFor: widget paneMorph spec: aSpec. + widget paneMorph layoutInset: (aSpec padding ifNil: [ProportionalSplitterMorph gripThickness]). + widget paneMorph cellInset: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]). + widget paneMorph wantsPaneSplitters ifTrue: [widget paneMorph addCornerGrips"addEdgeGrips"]. + + "Now create the children." + panes := OrderedCollection new. + aSpec children isSymbol + ifTrue: [ + widget getChildrenSelector: aSpec children. + widget update: aSpec children] + ifFalse: [ + self buildAll: aSpec children in: widget paneMorph]. + + "Now create the buttons." + aSpec buttons isSymbol + ifTrue: [ + widget getButtonsSelector: aSpec buttons. + widget update: aSpec buttons] + ifFalse: [ + self buildAll: aSpec buttons in: widget buttonRowMorph. + widget updateButtonProperties]. + + aSpec title ifNotNil: [:label | + label isSymbol + ifTrue:[widget getTitleSelector: label; update: label] + ifFalse:[widget title: label]]. + aSpec message ifNotNil: [:label | + label isSymbol + ifTrue:[widget getMessageSelector: label; update: label] + ifFalse:[widget message: label]]. + + widget closeDialogSelector: aSpec closeAction. + self buildHelpFor: widget spec: aSpec. + + "Everything is shrink-wrapped around the pane morph." + widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]). + + ^ widget! Item was added: + ----- Method: MorphicToolBuilder>>dialogClass (in category 'widget classes') ----- + dialogClass + ^ PluggableDialogWindow! Item was changed: ----- Method: MorphicToolBuilder>>open: (in category 'opening') ----- open: anObject "Build and open the object. Answer the widget opened." | morph | anObject isMorph ifTrue:[morph := anObject] ifFalse:[morph := self build: anObject]. (morph isKindOf: MenuMorph) ifTrue:[morph popUpInWorld: World]. + (morph isKindOf: DialogWindow) + ifTrue: [^ morph moveToHand; getUserResponse]. (morph isKindOf: SystemWindow) ifFalse:[morph openInWorld] ifTrue:[ morph := morph openInWorldExtent: morph extent. (self class openToolsAttachedToMouseCursor and: [self currentEvent isMouse and: [self currentEvent isMouseUp]]) ifTrue: [ morph setProperty: #initialDrop toValue: true. morph hasDropShadow: false. self currentHand attachMorph: morph]]. ^morph! Item was changed: ----- Method: MorphicToolBuilder>>windowClassFor: (in category 'widget classes') ----- windowClassFor: aSpec - aSpec isDialog ifTrue: [^ PluggableDialogWindow]. ^aSpec multiWindowStyle caseOf: { [nil] -> [PluggableSystemWindow]. [#labelButton] -> [PluggableSystemWindowWithLabelButton] } otherwise: [PluggableSystemWindowWithLabelButton]! Item was changed: ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') ----- chooseFrom: aList lines: linesArray title: aString "Choose an item from the given list. Answer the index of the selected item." + + aList size <= 7 ifTrue: [ + | dialog | + dialog := DialogWindow new + title: 'Please Choose'; + message: aString; + yourself. + aList doWithIndex: [:ea :index | + dialog createButton: ea value: index]. + dialog selectedButtonIndex: 1. + ^ dialog getUserResponseAtHand ifNil: [0]]. + + ^ ListChooser chooseFrom: aList title: aString! - ^ aList size > 30 - ifTrue: - [ "Don't put more than 30 items in a menu. Use ListChooser insted" - ListChooser - chooseFrom: aList - title: aString ] - ifFalse: - [ MenuMorph - chooseFrom: aList - lines: linesArray - title: aString ]! Item was changed: ----- Method: MorphicUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') ----- chooseFrom: labelList values: valueList lines: linesArray title: aString "Choose an item from the given list. Answer the selected item." + | index | + index := self chooseFrom: labelList lines: linesArray title: aString. + ^ index = 0 + ifTrue: [ nil ] + ifFalse: [ valueList at: index ]! - ^ labelList size > 30 - ifTrue: - [ "No point in displaying more than 30 items in a menu. Use ListChooser insted" - index := ListChooser - chooseFrom: labelList - title: aString. - index = 0 ifFalse: [ valueList at: index ] ] - ifFalse: - [ MenuMorph - chooseFrom: labelList - values: valueList - lines: linesArray - title: aString ]! Item was added: + ----- Method: MorphicUIManager>>chooseFromOrAddTo:lines:title: (in category 'ui requests') ----- + chooseFromOrAddTo: aList lines: linesArray title: aString + + ^ ListChooser + chooseItemFrom: aList + title: aString + addAllowed: true! Item was changed: + DialogWindow subclass: #PluggableDialogWindow + instanceVariableNames: 'model getTitleSelector getMessageSelector getChildrenSelector getButtonsSelector closeDialogSelector' - PluggableSystemWindow subclass: #PluggableDialogWindow - instanceVariableNames: 'statusValue' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Morphic'! Item was added: + ----- Method: PluggableDialogWindow>>closeDialogSelector (in category 'accessing') ----- + closeDialogSelector + + ^ closeDialogSelector! Item was added: + ----- Method: PluggableDialogWindow>>closeDialogSelector: (in category 'accessing') ----- + closeDialogSelector: anObject + + closeDialogSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>delete (in category 'submorphs-add/remove') ----- + delete + + self model okToClose ifFalse: [^ self]. + + self closeDialogSelector ifNotNil: [:sel | self model perform: sel]. + + self model + windowIsClosing; + release. + self model: nil. + + super delete.! Item was added: + ----- Method: PluggableDialogWindow>>getButtonsSelector (in category 'accessing') ----- + getButtonsSelector + + ^ getButtonsSelector! Item was added: + ----- Method: PluggableDialogWindow>>getButtonsSelector: (in category 'accessing') ----- + getButtonsSelector: anObject + + getButtonsSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>getChildrenSelector (in category 'accessing') ----- + getChildrenSelector + + ^ getChildrenSelector! Item was added: + ----- Method: PluggableDialogWindow>>getChildrenSelector: (in category 'accessing') ----- + getChildrenSelector: anObject + + getChildrenSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>getMessageSelector (in category 'accessing') ----- + getMessageSelector + + ^ getMessageSelector! Item was added: + ----- Method: PluggableDialogWindow>>getMessageSelector: (in category 'accessing') ----- + getMessageSelector: anObject + + getMessageSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>getTitleSelector (in category 'accessing') ----- + getTitleSelector + + ^ getTitleSelector! Item was added: + ----- Method: PluggableDialogWindow>>getTitleSelector: (in category 'accessing') ----- + getTitleSelector: anObject + + getTitleSelector := anObject! Item was added: + ----- Method: PluggableDialogWindow>>model (in category 'accessing') ----- + model + ^ model! Item was added: + ----- Method: PluggableDialogWindow>>model: (in category 'accessing') ----- + model: anObject + + model ifNotNil: [model removeDependent: self]. + anObject ifNotNil: [anObject addDependent: self]. + model := anObject.! Item was removed: - ----- Method: PluggableDialogWindow>>statusValue (in category 'as yet unclassified') ----- - statusValue - ^statusValue! Item was removed: - ----- Method: PluggableDialogWindow>>statusValue: (in category 'as yet unclassified') ----- - statusValue: val - statusValue := val! Item was added: + ----- Method: PluggableDialogWindow>>update: (in category 'updating') ----- + update: what + + what ifNil:[^self]. + + what == self getTitleSelector ifTrue:[self title: (model perform: self getTitleSelector)]. + what == self getMessageSelector ifTrue:[self message: (model perform: self getMessageSelector)]. + + what == self getChildrenSelector ifTrue:[ + self paneMorph removeAllMorphs. + (self model perform: self getChildrenSelector) + do: [:m| m hResizing: #spaceFill; vResizing: #spaceFill]; + in: [:children | self paneMorph addAllMorphs: children]]. + + what == self getButtonsSelector ifTrue:[ + self buttonRow + removeAllMorphs; + addAllMorphs: (self model perform: self getButtonsSelector). + self updateButtonProperties]. + + what == #close ifTrue: [^ self delete]. + + super update: what.! Item was added: + ----- Method: PluggableDialogWindow>>updateButtonProperties (in category 'updating') ----- + updateButtonProperties + + self buttons do: [:ea | + ea setProperty: #normalColor toValue: ea offColor. + ea setProperty: #normalLabel toValue: ea label. + ea hResizing: #rigid; vResizing: #rigid]. + + self updateButtonExtent.!

1 0

The Trunk: ToolBuilder-Kernel-mt.100.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.100.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-mt.100 Author: mt Time: 31 July 2016, 11:11:03.29749 am UUID: 8ae8d06d-141f-d846-9c73-f7fa561bb78a Ancestors: ToolBuilder-Kernel-mt.99 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against ToolBuilder-Kernel-mt.99 =============== Item was added: + PluggableCompositeSpec subclass: #PluggableDialogSpec + instanceVariableNames: 'title message extent buttons closeAction' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolBuilder-Kernel'! Item was added: + ----- Method: PluggableDialogSpec>>buildWith: (in category 'building') ----- + buildWith: builder + ^builder buildPluggableDialog: self.! Item was added: + ----- Method: PluggableDialogSpec>>buttons (in category 'accessing') ----- + buttons + + ^ buttons! Item was added: + ----- Method: PluggableDialogSpec>>buttons: (in category 'accessing') ----- + buttons: anObject + + buttons := anObject! Item was added: + ----- Method: PluggableDialogSpec>>closeAction (in category 'accessing') ----- + closeAction + + ^ closeAction! Item was added: + ----- Method: PluggableDialogSpec>>closeAction: (in category 'accessing') ----- + closeAction: anObject + + closeAction := anObject! Item was added: + ----- Method: PluggableDialogSpec>>extent (in category 'accessing') ----- + extent + + ^ extent! Item was added: + ----- Method: PluggableDialogSpec>>extent: (in category 'accessing') ----- + extent: anObject + + extent := anObject! Item was added: + ----- Method: PluggableDialogSpec>>horizontalResizing (in category 'as yet unclassified') ----- + horizontalResizing + ^ #rigid! Item was added: + ----- Method: PluggableDialogSpec>>label (in category 'window compatibility') ----- + label + ^ self title! Item was added: + ----- Method: PluggableDialogSpec>>label: (in category 'window compatibility') ----- + label: stringOrSymbol + self title: stringOrSymbol.! Item was added: + ----- Method: PluggableDialogSpec>>message (in category 'accessing') ----- + message + + ^ message! Item was added: + ----- Method: PluggableDialogSpec>>message: (in category 'accessing') ----- + message: anObject + + message := anObject! Item was added: + ----- Method: PluggableDialogSpec>>title (in category 'accessing') ----- + title + + ^ title! Item was added: + ----- Method: PluggableDialogSpec>>title: (in category 'accessing') ----- + title: anObject + + title := anObject! Item was added: + ----- Method: PluggableDialogSpec>>verticalResizing (in category 'as yet unclassified') ----- + verticalResizing + ^ #rigid! Item was changed: PluggableCompositeSpec subclass: #PluggableWindowSpec + instanceVariableNames: 'label extent closeAction multiWindowStyle' - instanceVariableNames: 'label extent closeAction isDialog multiWindowStyle' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableWindowSpec commentStamp: '<historical>' prior: 0! A common window. Expects to see change/update notifications when the label should change. Instance variables: label <String|Symbol> The selector under which to retrieve the label or the label directly extent <Point> The (initial) extent of the window. closeAction <Symbol> The action to perform when the window is closed.! Item was removed: - ----- Method: PluggableWindowSpec>>isDialog (in category 'accessing') ----- - isDialog - - ^isDialog ifNil: [false] - ! Item was removed: - ----- Method: PluggableWindowSpec>>isDialog: (in category 'accessing') ----- - isDialog: val - - isDialog := val - - ! Item was added: + ----- Method: ToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- + buildPluggableDialog: spec + + | windowSpec | + windowSpec := self pluggableWindowSpec new. + windowSpec children: (spec children ifNil: [OrderedCollection new]). + + "TODO: Convert the dialog's message into some element in the children." + + spec buttons ifNotNil: [:buttons | windowSpec children addAll: buttons]. + windowSpec + model: spec model; + extent: spec extent; + label: spec title. + ^ self buildPluggableWindow: windowSpec! Item was added: + ----- Method: ToolBuilder>>pluggableDialogSpec (in category 'defaults') ----- + pluggableDialogSpec + ^PluggableDialogSpec!

1 0

The Trunk: Compiler-mt.324.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-mt.324.mcz ==================== Summary ==================== Name: Compiler-mt.324 Author: mt Time: 31 July 2016, 11:10:04.90449 am UUID: f8b4e0ae-171c-8541-ae32-656183633ad6 Ancestors: Compiler-eem.323 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against Compiler-eem.323 =============== Item was changed: ----- Method: UndefinedVariable>>openMenuIn: (in category 'as yet unclassified') ----- openMenuIn: aBlock - | labels caption index | - labels := #('yes' 'no'). - caption := name, ' appears to be - undefined at this point. - Proceed anyway?'. + ^ self resume: (UIManager default + confirm: name asText allBold, ' appears to be undefined at this point.\Proceed anyway?' withCRs + title: 'Undefined Variable').! - index := aBlock value: labels value: #() value: caption. - ^ self resume: index = 1! Item was changed: ----- Method: UnknownSelector>>openMenuIn: (in category 'as yet unclassified') ----- openMenuIn: aBlock | alternatives labels lines caption choice | alternatives := Symbol possibleSelectorsFor: name. labels := Array streamContents: + [:s | s nextPut: name; nextPutAll: alternatives]. - [:s | s nextPut: name; nextPutAll: alternatives; nextPut: 'cancel']. lines := {1. alternatives size + 1}. caption := 'Unknown selector, please\confirm, correct, or cancel' withCRs. choice := aBlock value: labels value: lines value: caption. + + choice = 0 ifTrue: [^ self resume: nil]. + choice = 1 ifTrue: [^ self resume: name asSymbol]. - choice = 0 ifTrue: [self resume: nil]. - choice = 1 ifTrue: [self resume: name asSymbol]. - choice = labels size ifTrue: [self resume: nil]. self resume: (alternatives at: choice - 1)! Item was changed: ----- Method: UnusedVariable>>openMenuIn: (in category 'as yet unclassified') ----- openMenuIn: aBlock + + self resume: (UIManager default + confirm: name asText allBold, ' appears to be unused in this method.\Remove it from the code?' withCRs + title: 'Unused Variable').! - | index | - index := aBlock value: #('yes' 'no') - value: #() - value: name, ' appears to be\unused in this method.\OK to remove it?' withCRs. - self resume: index = 1!

1 0

The Trunk: Morphic-mt.1211.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1211.mcz ==================== Summary ==================== Name: Morphic-mt.1211 Author: mt Time: 31 July 2016, 11:09:16.28949 am UUID: ea98f52e-1be2-e946-947b-465339d1c150 Ancestors: Morphic-mt.1210 *** Widget Refactorings and UI Themes (Part 5 of 11) *** Some fixes and refactorings for dialogs including added support for UI theming. =============== Diff against Morphic-mt.1210 =============== Item was added: + Morph subclass: #DialogWindow + instanceVariableNames: 'titleMorph messageMorph paneMorph buttonRow result selectedButton cancelButton timeout preferredPosition keyMap exclusive' + classVariableNames: 'GradientDialog RoundedDialogCorners UseWiggleAnimation' + poolDictionaries: '' + category: 'Morphic-Windows'! + + !DialogWindow commentStamp: '<historical>' prior: 0! + A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was added: + ----- Method: DialogWindow class>>gradientDialog (in category 'preferences') ----- + gradientDialog + + <preference: 'gradientDialog' + category: 'dialogs' + description: 'If true, dialogs will have a gradient look.' + type: #Boolean> + ^ GradientDialog ifNil: [true] + ! Item was added: + ----- Method: DialogWindow class>>gradientDialog: (in category 'preferences') ----- + gradientDialog: aBoolean + + aBoolean = GradientDialog ifTrue: [^ self]. + GradientDialog := aBoolean. + self refreshAllDialogs.! Item was added: + ----- Method: DialogWindow class>>refreshAllDialogs (in category 'preferences') ----- + refreshAllDialogs + + self allSubInstances do: [:instance | instance setDefaultParameters; setTitleParameters].! Item was added: + ----- Method: DialogWindow class>>roundedDialogCorners (in category 'preferences') ----- + roundedDialogCorners + <preference: 'Rounded Dialog Corners' + categoryList: #(windows dialogs) + description: 'Governs whether dialog windows should have rounded corners' + type: #Boolean> + ^ RoundedDialogCorners ifNil: [ true ]! Item was added: + ----- Method: DialogWindow class>>roundedDialogCorners: (in category 'preferences') ----- + roundedDialogCorners: aBoolean + + RoundedDialogCorners = aBoolean ifTrue: [^ self]. + RoundedDialogCorners := aBoolean. + self refreshAllDialogs.! Item was added: + ----- Method: DialogWindow class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the dialogs''s border.' }. + { #borderWidth. 'Borders'. 'Width of the dialogs''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the dialog.' }. + { #font. 'Fonts'. 'Font for dialog messages.' }. + { #textColor. 'Colors'. 'Color for dialog messages.' }. + + { #titleBorderColor. 'Colors'. 'Color of the dialogs title border.' }. + { #titleBorderWidth. 'Geometry'. 'Width of the dialog title border.' }. + { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }. + { #titleColor. 'Colors'. 'Background color of the dialogs'' title.' }. + { #titleFont. 'Fonts'. 'Font for dialog title.' }. + { #titleTextColor. 'Colors'. 'Color for the dialog title label.' }. + + { #okColor. 'Colors'. 'Color for the OK button.' }. + { #cancelColor. 'Colors'. 'Color for the Cancel button.' }. + { #buttonColor. 'Colors'. 'Color for a normal button.' }. + { #selectionModifier. 'Colors'. 'How to convert the color of a selected button?' }. + }! Item was added: + ----- Method: DialogWindow class>>useWiggleAnimation (in category 'preferences') ----- + useWiggleAnimation + + <preference: 'Use Wiggle Animation in Modal Dialogs' + categoryList: #(Morphic windows dialogs) + description: 'In order to indicate that a modal dialog is waiting for a user''s input, wiggle instead of flash.' + type: #Boolean> + ^ UseWiggleAnimation ifNil: [true]! Item was added: + ----- Method: DialogWindow class>>useWiggleAnimation: (in category 'preferences') ----- + useWiggleAnimation: aBoolean + + UseWiggleAnimation := aBoolean.! Item was added: + ----- Method: DialogWindow>>addPaneMorph: (in category 'constructing') ----- + addPaneMorph: aMorph + + self paneMorph addMorphBack: aMorph.! Item was added: + ----- Method: DialogWindow>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + setDefaultParameters; + setTitleParameters; + setMessageParameters. + + "Update all buttons." + selectedButton in: [:sb | + self buttons do: [:ea | + ea setProperty: #normalColor toValue: self defaultButtonColor. + self deselectButton: ea]. + sb ifNotNil: [self selectButton: sb]].! Item was added: + ----- Method: DialogWindow>>buttonRowMorph (in category 'accessing - ui') ----- + buttonRowMorph + ^ buttonRow! Item was added: + ----- Method: DialogWindow>>buttons (in category 'accessing - ui') ----- + buttons + + ^buttonRow submorphs! Item was added: + ----- Method: DialogWindow>>cancelButton (in category 'accessing - ui') ----- + cancelButton + ^ cancelButton! Item was added: + ----- Method: DialogWindow>>cancelDialog (in category 'running') ----- + cancelDialog + + self cancelButton + ifNil: [self closeDialog: nil] + ifNotNil: [:btn | btn performAction]. ! Item was added: + ----- Method: DialogWindow>>closeDialog (in category 'running') ----- + closeDialog + + self selectedButton + ifNil: [self closeDialog: nil] + ifNotNil: [:btn | btn performAction]. ! Item was added: + ----- Method: DialogWindow>>closeDialog: (in category 'running') ----- + closeDialog: returnValue + result := returnValue. + self delete.! Item was added: + ----- Method: DialogWindow>>createAcceptButton (in category 'constructing') ----- + createAcceptButton + + ^ self + createButton: 'Accept' translated + value: true + color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49])! Item was added: + ----- Method: DialogWindow>>createBody (in category 'initialization') ----- + createBody + + | body | + body := Morph new + changeTableLayout; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + listDirection: #topToBottom; + cellPositioning: #leftCenter; + layoutInset: (10@5 corner: 10@10); + cellInset: 5; + color: Color transparent; + yourself. + body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow}. + self addMorphBack: body.! Item was added: + ----- Method: DialogWindow>>createButton: (in category 'constructing') ----- + createButton: buttonLabel + + ^ self + createButton: buttonLabel + value: self buttonRow submorphs size + 1 + color: self defaultButtonColor! Item was added: + ----- Method: DialogWindow>>createButton:value: (in category 'constructing') ----- + createButton: buttonLabel value: buttonValue + + ^ self + createButton: buttonLabel + value: buttonValue + color: self defaultButtonColor! Item was added: + ----- Method: DialogWindow>>createButton:value:color: (in category 'constructing') ----- + createButton: buttonLabel value: buttonValue color: buttonColor + + | button | + button := PluggableButtonMorphPlus new + label: buttonLabel ; + action: [ self closeDialog: buttonValue ] ; + setProperty: #normalColor toValue: buttonColor ; + setProperty: #normalLabel toValue: buttonLabel ; + hResizing: #rigid; + vResizing: #rigid; + yourself. + + self deselectButton: button. + buttonRow addMorphBack: button. + self updateButtonExtent. + + ^ button! Item was added: + ----- Method: DialogWindow>>createButtonRow (in category 'initialization') ----- + createButtonRow + + ^ buttonRow := Morph new + color: Color transparent; + changeTableLayout; + vResizing: #shrinkWrap; + hResizing: #spaceFill; + listDirection: #leftToRight; + listCentering: #center; + cellInset: 5; + yourself! Item was added: + ----- Method: DialogWindow>>createCancelButton (in category 'constructing') ----- + createCancelButton + + ^ cancelButton := self + createButton: 'Cancel' translated + value: false + color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588])! Item was added: + ----- Method: DialogWindow>>createCancelButton:value: (in category 'constructing') ----- + createCancelButton: label value: result + + ^ cancelButton := self + createButton: label + value: result! Item was added: + ----- Method: DialogWindow>>createMessage: (in category 'initialization') ----- + createMessage: aString + + messageMorph := aString asText asMorph lock. + self setMessageParameters. + ^ messageMorph! Item was added: + ----- Method: DialogWindow>>createPane (in category 'initialization') ----- + createPane + + ^ paneMorph := BorderedMorph new + changeProportionalLayout; + hResizing: #rigid; + vResizing: #rigid; + layoutInset: 0; + color: Color transparent; + borderWidth: 0; + yourself.! Item was added: + ----- Method: DialogWindow>>createTitle: (in category 'initialization') ----- + createTitle: aString + "Mimick behavior of MenuMorph title creation." + + | box closeButton menuButton | + box := Morph new + name: #title; + changeTableLayout; + listDirection: #leftToRight; + listCentering: #justified; + yourself. + + titleMorph := aString asText asMorph lock. + + closeButton := SystemWindowButton new + color: Color transparent; + target: self; + extent: 12@12; + actionSelector: #cancelDialog; + balloonText: 'Cancel this dialog' translated; + borderWidth: 0; + labelGraphic: SystemWindow closeBoxImage; + extent: SystemWindow closeBoxImage extent; + yourself. + + menuButton := SystemWindowButton new + color: Color transparent; + target: self; + actionSelector: #offerDialogMenu; + balloonText: 'Dialog menu' translated; + borderWidth: 0; + labelGraphic: SystemWindow menuBoxImage; + extent: SystemWindow menuBoxImage extent; + yourself. + + box addAllMorphs: {closeButton. titleMorph. menuButton}. + + self addMorphBack: box. + self setTitleParameters. + ! Item was added: + ----- Method: DialogWindow>>defaultButtonColor (in category 'accessing') ----- + defaultButtonColor + + ^ self userInterfaceTheme buttonColor ifNil: [(Color r: 0.658 g: 0.678 b: 0.78) twiceLighter]! Item was added: + ----- Method: DialogWindow>>deselectButton: (in category 'selection') ----- + deselectButton: aButton + + aButton ifNil: [^ self]. + aButton offColor: (aButton valueOfProperty: #normalColor). + aButton == selectedButton ifTrue: [selectedButton := nil].! Item was added: + ----- Method: DialogWindow>>drawOverlayOn: (in category 'drawing') ----- + drawOverlayOn: aCanvas + + | title inset | + super drawOverlayOn: aCanvas. + + title := self submorphs first. + + self wantsRoundedCorners ifTrue: [ + inset := (self class roundedDialogCorners and: [self class gradientDialog]) + "This check compensates a bug in balloon." + ifTrue: [0@0 corner: 0@ -1] ifFalse: [self borderWidth @ 0]. + + "Overdraw lower part of title bar to hide bottom corners." + aCanvas + fillRectangle:( (title bottomLeft - (0 @ self submorphs first cornerRadius) corner: title bottomRight) insetBy: inset) + color: self color]. + + "Draw a line between the title and the contents." + self borderWidth > 0 ifTrue: [ + "Redraw the border all around. Needed because rounded borders do not align very well." + self wantsRoundedCorners + ifTrue: [ aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self borderStyle width color: self borderStyle color] + ifFalse: [aCanvas frameRectangle: self bounds width: self borderStyle width color: self borderStyle color]].! Item was added: + ----- Method: DialogWindow>>ensureSelectedButton (in category 'selection') ----- + ensureSelectedButton + + self selectedButton ifNil: [self selectButton: self buttons first].! Item was added: + ----- Method: DialogWindow>>exclusive (in category 'accessing') ----- + exclusive + + ^ exclusive! Item was added: + ----- Method: DialogWindow>>exclusive: (in category 'accessing') ----- + exclusive: aBoolean + + exclusive := aBoolean. + + exclusive + ifTrue: [self activeHand newMouseFocus: self] + ifFalse: [self activeHand releaseMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>exploreInvocation (in category 'running') ----- + exploreInvocation + + | result context | + self exclusive: false. "We want to explore." + + result := OrderedCollection new. + context := thisContext. + + [context method selector = #getUserResponse] + whileFalse: [context := context sender]. + + [context sender] whileNotNil: [ + result add: context method. + context := context sender]. + result add: context method. + + result explore.! Item was added: + ----- Method: DialogWindow>>flash (in category 'running') ----- + flash + "Flash me" + Beeper beepPrimitive. + + self class useWiggleAnimation ifTrue: [ + #(-2 4 -6 8 -4) do: [:i | + self left: self left + i. + self refreshWorld. + ] separatedBy: [(Delay forMilliseconds: 50) wait] + ] ifFalse: [ + 1 to: 2 do:[:i| + self color: Color black. + self world doOneCycleNow. + (Delay forMilliseconds: 50) wait. + self color: Color white. + self world doOneCycleNow. + (Delay forMilliseconds: 50) wait] ]! Item was added: + ----- Method: DialogWindow>>getUserResponse (in category 'running') ----- + getUserResponse + + | hand world | + (ProvideAnswerNotification signal: self title asString) ifNotNil: [:answer| ^ answer]. + + self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." + + hand := self currentHand. + world := self currentWorld. + + self fullBounds. + self center: preferredPosition. + self bounds: (self bounds translatedToBeWithin: world bounds). + self openInWorld: world. + + hand keyboardFocus in: [:priorKeyboardFocus | + hand mouseFocus in: [:priorMouseFocus | + self exclusive ifTrue: [hand newMouseFocus: self]. + hand newKeyboardFocus: self. + + [self isInWorld] whileTrue:[world doOneSubCycle]. + + hand newKeyboardFocus: priorKeyboardFocus. + self exclusive ifTrue: [ + hand newMouseFocus: priorMouseFocus]]]. + + ^ result! Item was added: + ----- Method: DialogWindow>>getUserResponseAfter: (in category 'running') ----- + getUserResponseAfter: seconds + + timeout := seconds + 1. + + self ensureSelectedButton. + self step. + self updateButtonExtent. + + ^ self getUserResponse! Item was added: + ----- Method: DialogWindow>>getUserResponseAtHand (in category 'running') ----- + getUserResponseAtHand + + ^ self getUserResponseAtHand: ActiveHand! Item was added: + ----- Method: DialogWindow>>getUserResponseAtHand: (in category 'running') ----- + getUserResponseAtHand: aHand + + self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." + + self moveSelectedButtonToHand: aHand. + ^ self getUserResponse! Item was added: + ----- Method: DialogWindow>>handleMouseUp: (in category 'events') ----- + handleMouseUp: event + + super handleMouseUp: event. + self exclusive ifTrue: [event hand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>handlesKeyboard: (in category 'events') ----- + handlesKeyboard: evt + + ^true! Item was added: + ----- Method: DialogWindow>>handlesMouseDown: (in category 'events') ----- + handlesMouseDown: evt + + ^ true! Item was added: + ----- Method: DialogWindow>>initialExtent (in category 'initialization') ----- + initialExtent + + ^ 200@150! Item was added: + ----- Method: DialogWindow>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self + changeTableLayout; + listDirection: #topToBottom; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + setProperty: #indicateKeyboardFocus toValue: #never. + + self createTitle: 'Dialog'. + self createBody. + + self setDefaultParameters. + + keyMap := Dictionary new. + exclusive := true. + preferredPosition := ActiveWorld center.! Item was added: + ----- Method: DialogWindow>>justDroppedInto:event: (in category 'dropping/grabbing') ----- + justDroppedInto: aMorph event: event + + "Restore drop shadow if necessary." + self hasDropShadow: Preferences menuAppearance3d. + + self exclusive ifTrue: [ + "aggressively preserve focus" + event hand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>keyStroke: (in category 'events') ----- + keyStroke: evt + | char | + self stopAutoTrigger. + char := evt keyCharacter. + + char = Character escape ifTrue: [ ^ self cancelDialog ]. + (char = Character cr or: [char = Character enter]) ifTrue: [ ^ self closeDialog ]. + + ((char = Character arrowLeft or: [char = Character arrowUp]) + or: [ evt shiftPressed and: [ char = Character tab ] ]) + ifTrue: [ ^ self selectPreviousButton ]. + ((char = Character arrowRight or: [char = Character arrowDown]) + or: [ char = Character tab ]) + ifTrue: [ ^ self selectNextButton ]. + + keyMap + at: char asLowercase + ifPresent: [ : foundButton | foundButton performAction ] + ifAbsent: [ "do nothing" ].! Item was added: + ----- Method: DialogWindow>>message (in category 'accessing') ----- + message + ^messageMorph contents! Item was added: + ----- Method: DialogWindow>>message: (in category 'accessing') ----- + message: aStringOrText + + messageMorph contents: aStringOrText. + self setMessageParameters.! Item was added: + ----- Method: DialogWindow>>messageMorph (in category 'accessing - ui') ----- + messageMorph + ^ messageMorph! Item was added: + ----- Method: DialogWindow>>mouseDown: (in category 'events') ----- + mouseDown: event + + self stopAutoTrigger. + + "Always bring me to the front since I am modal" + self comeToFront. + + (self containsPoint: event position) + ifFalse:[^ self flash]. + + event hand + waitForClicksOrDrag: self + event: event + selectors: { nil. nil. nil. #startDrag: } + threshold: HandMorph dragThreshold.! Item was added: + ----- Method: DialogWindow>>mouseUp: (in category 'events') ----- + mouseUp: event + self stopAutoTrigger. + ! Item was added: + ----- Method: DialogWindow>>moveSelectedButtonToHand: (in category 'position') ----- + moveSelectedButtonToHand: aHand + "Just let the user confirm the selected button without having to reposition the mouse." + + self ensureSelectedButton. + self moveTo: self fullBounds center + (aHand position - self selectedButton center).! Item was added: + ----- Method: DialogWindow>>moveTo: (in category 'position') ----- + moveTo: position + + preferredPosition := position.! Item was added: + ----- Method: DialogWindow>>moveToHand (in category 'position') ----- + moveToHand + + self moveToHand: self activeHand.! Item was added: + ----- Method: DialogWindow>>moveToHand: (in category 'position') ----- + moveToHand: aHand + + self moveTo: aHand position.! Item was added: + ----- Method: DialogWindow>>offerDialogMenu (in category 'running') ----- + offerDialogMenu + + | menu | + menu := MenuMorph new defaultTarget: self. + menu + add: (exclusive == true ifTrue: ['<yes>'] ifFalse: ['<no>']), 'be modally exclusive' translated + action: #toggleExclusive; + addLine; + add: 'explore dialog invocation' translated + action: #exploreInvocation. + + menu popUpEvent: self currentEvent in: self world. + + [menu isInWorld] whileTrue: [self world doOneSubCycle]. + self exclusive ifTrue: [self activeHand newMouseFocus: self].! Item was added: + ----- Method: DialogWindow>>paneMorph (in category 'accessing - ui') ----- + paneMorph + ^ paneMorph! Item was added: + ----- Method: DialogWindow>>processFocusEvent:using: (in category 'events') ----- + processFocusEvent: evt using: dispatcher + + ^ dispatcher dispatchFocusEventFully: evt with: self! Item was added: + ----- Method: DialogWindow>>registerKeyboardShortcutFor: (in category 'constructing') ----- + registerKeyboardShortcutFor: button + "Take the first alpha-numeric character that is not already used as a shortcut, and use it as a shortcut." + + (button valueOfProperty: #normalLabel) asString in: [:normalLabel | normalLabel do: [:char | + char isAlphaNumeric ifTrue: [ keyMap + at: char asLowercase + ifPresent: [] + ifAbsent: [ + button label: ('{1} ({2})' format: {normalLabel. char}). + ^ keyMap at: char asLowercase put: button ] ] ] ]! Item was added: + ----- Method: DialogWindow>>registerKeyboardShortcuts (in category 'constructing') ----- + registerKeyboardShortcuts + + self buttons do: [:ea | self registerKeyboardShortcutFor: ea].! Item was added: + ----- Method: DialogWindow>>selectButton: (in category 'selection') ----- + selectButton: aButton + + | buttonColor | + buttonColor := ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c muchLighter] ]) value: (aButton valueOfProperty: #normalColor)). + self deselectButton: selectedButton. + aButton offColor: buttonColor. + selectedButton := aButton.! Item was added: + ----- Method: DialogWindow>>selectNextButton (in category 'selection') ----- + selectNextButton + + self selectedButton ifNil: [^ self]. + self selectedButtonIndex: self selectedButtonIndex \\ self buttons size + 1.! Item was added: + ----- Method: DialogWindow>>selectPreviousButton (in category 'selection') ----- + selectPreviousButton + + self selectedButton ifNil: [^ self]. + self selectedButtonIndex: self selectedButtonIndex - 2 \\ self buttons size + 1.! Item was added: + ----- Method: DialogWindow>>selectedButton (in category 'accessing') ----- + selectedButton + ^ selectedButton! Item was added: + ----- Method: DialogWindow>>selectedButton: (in category 'accessing') ----- + selectedButton: aButton + + aButton + ifNil: [self deselectButton: self selectedButton] + ifNotNil: [self selectButton: aButton].! Item was added: + ----- Method: DialogWindow>>selectedButtonIndex (in category 'accessing') ----- + selectedButtonIndex + + ^ self selectedButton + ifNil: [0] + ifNotNil: [:btn | self buttons indexOf: btn]! Item was added: + ----- Method: DialogWindow>>selectedButtonIndex: (in category 'accessing') ----- + selectedButtonIndex: anInteger + + anInteger = 0 ifTrue: [^ self selectedButton: nil]. + self selectedButton: (self buttons at: anInteger).! Item was added: + ----- Method: DialogWindow>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color white]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]); + layoutInset: ((self class roundedDialogCorners and: [self class gradientDialog]) + "This check compensates a bug in balloon." + ifTrue: [0] ifFalse: [self borderWidth negated asPoint]). + + Preferences menuAppearance3d ifTrue: [self addDropShadow].! Item was added: + ----- Method: DialogWindow>>setMessageParameters (in category 'initialization') ----- + setMessageParameters + + messageMorph ifNotNil: [ + | fontToUse colorToUse | + fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme textColor ifNil: [Color black]. + + messageMorph contents + addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse). + messageMorph releaseParagraph; changed].! Item was added: + ----- Method: DialogWindow>>setTitleParameters (in category 'initialization') ----- + setTitleParameters + + (self submorphNamed: #title) ifNotNil: [:title | + title + fillStyle: (self class gradientDialog + ifFalse: [SolidFillStyle color: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])] + ifTrue: [self titleGradientFor: title from: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]); + borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]); + borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]); + cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]); + vResizing: #shrinkWrap; + hResizing: #spaceFill; + wrapCentering: #center; + cellPositioning: #center; + cellInset: 0; + layoutInset: (5@3 corner: 5@ (2+(self wantsRoundedCorners ifFalse: [0] ifTrue: [self cornerRadius])))]. + + titleMorph ifNotNil: [ + | fontToUse colorToUse | + fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black]. + + titleMorph contents + addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse). + titleMorph releaseParagraph; changed].! Item was added: + ----- Method: DialogWindow>>startDrag: (in category 'dropping/grabbing') ----- + startDrag: event + + self hasDropShadow: false. + event hand grabMorph: self.! Item was added: + ----- Method: DialogWindow>>step (in category 'stepping and presenter') ----- + step + timeout ifNil: [^self]. + timeout = 0 + ifTrue: [ + self stopStepping. + selectedButton performAction] + ifFalse: [ + selectedButton label: ('{1} ({2})' format: { + selectedButton valueOfProperty: #normalLabel. + timeout}). + timeout := timeout - 1]! Item was added: + ----- Method: DialogWindow>>stepTime (in category 'stepping and presenter') ----- + stepTime + ^1000! Item was added: + ----- Method: DialogWindow>>stopAutoTrigger (in category 'stepping and presenter') ----- + stopAutoTrigger + timeout ifNil: [^self]. + timeout := nil. + self stopStepping. + selectedButton label: (selectedButton valueOfProperty: #normalLabel). ! Item was added: + ----- Method: DialogWindow>>title (in category 'accessing') ----- + title + ^titleMorph contents! Item was added: + ----- Method: DialogWindow>>title: (in category 'accessing') ----- + title: aString + + titleMorph contents: aString asText. + self setTitleParameters.! Item was added: + ----- Method: DialogWindow>>titleGradientFor:from: (in category 'initialization') ----- + titleGradientFor: morph from: aColor + + | cc gradient | + cc := aColor. + gradient := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.15 ->(cc mixed: 0.5 with: Color white). + 0.7 -> cc. + }. + gradient origin: morph topLeft. + gradient direction: 0 @ (TextStyle defaultFont height + 10). + ^ gradient! Item was added: + ----- Method: DialogWindow>>toggleExclusive (in category 'running') ----- + toggleExclusive + + self exclusive: self exclusive not.! Item was added: + ----- Method: DialogWindow>>update: (in category 'updating') ----- + update: aspect + + aspect == #buttons + ifTrue: [self updateButtonExtent]. + + ^ super update: aspect! Item was added: + ----- Method: DialogWindow>>updateButtonExtent (in category 'updating') ----- + updateButtonExtent + + self updateButtonExtent: 20@10.! Item was added: + ----- Method: DialogWindow>>updateButtonExtent: (in category 'updating') ----- + updateButtonExtent: margin + + "Update all button extents." + (buttonRow submorphs collect: [:ea | ea minimumExtent]) max + margin in: [:preferredExtent | + buttonRow submorphsDo: [:ea | ea extent: preferredExtent]]. + + "See if horizontal button layout would be more appropriate." + self flag: #magicNumber. "mt: Remove number with computation, maybe choose button font and 20 characters" + (buttonRow submorphs collect: [:ea | ea fullBounds width]) sum > 400 + ifTrue: [buttonRow + hResizing: #shrinkWrap; + listDirection: #topToBottom; + layoutInset: (buttonRow owner fullBounds width - (buttonRow owner layoutInset left*2) - buttonRow submorphs first fullBounds width // 2@0)] + ifFalse: [buttonRow + hResizing: #spaceFill; + listDirection: #leftToRight; + layoutInset: 0].! Item was added: + ----- Method: DialogWindow>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + + ^ self class roundedDialogCorners or: [super wantsRoundedCorners]! Item was added: + ----- Method: DialogWindow>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- + wantsToBeDroppedInto: aMorph + "Return true if it's okay to drop the receiver into aMorph" + ^aMorph isWorldMorph "only into worlds"! Item was changed: + DialogWindow subclass: #FillInTheBlankMorph - RectangleMorph subclass: #FillInTheBlankMorph instanceVariableNames: 'response done textPane responseUponCancel' + classVariableNames: '' - classVariableNames: 'RoundedDialogCorners' poolDictionaries: '' category: 'Morphic-Windows'! Item was changed: ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR:answerExtent: (in category 'instance creation') ----- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean answerExtent: answerExtent "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel." "FillInTheBlankMorph request: 'Type something, then type CR.' initialAnswer: 'yo ho ho!!' centerAt: Display center" | aFillInTheBlankMorph | aFillInTheBlankMorph := self new setQuery: queryString initialAnswer: defaultAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean. + + aFillInTheBlankMorph createAcceptButton + action: [aFillInTheBlankMorph textPane accept]. + aFillInTheBlankMorph createCancelButton + action: [aFillInTheBlankMorph closeDialog: returnOnCancel]. + + aFillInTheBlankMorph moveTo: aPoint. - aFillInTheBlankMorph responseUponCancel: returnOnCancel. - aWorld addMorph: aFillInTheBlankMorph centeredNear: aPoint. ^ aFillInTheBlankMorph getUserResponse ! Item was changed: ----- Method: FillInTheBlankMorph class>>requestPassword:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR: (in category 'instance creation') ----- requestPassword: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel." "FillInTheBlankMorph request: 'Type something, then type CR.' initialAnswer: 'yo ho ho!!' centerAt: Display center" | aFillInTheBlankMorph | aFillInTheBlankMorph := self new setPasswordQuery: queryString initialAnswer: defaultAnswer answerHeight: 50 acceptOnCR: acceptBoolean. + + aFillInTheBlankMorph createAcceptButton + action: [aFillInTheBlankMorph textPane accept]. + aFillInTheBlankMorph createCancelButton + action: [aFillInTheBlankMorph closeDialog: returnOnCancel]. + + aFillInTheBlankMorph moveTo: aPoint. + ^ aFillInTheBlankMorph getUserResponse! - aFillInTheBlankMorph responseUponCancel: returnOnCancel. - aWorld addMorph: aFillInTheBlankMorph centeredNear: aPoint. - ^ aFillInTheBlankMorph getUserResponse - ! Item was removed: - ----- Method: FillInTheBlankMorph class>>roundedDialogCorners (in category 'preferences') ----- - roundedDialogCorners - <preference: 'Rounded Dialog Corners' - category: 'windows' - description: 'Governs whether dialog windows should have rounded corners' - type: #Boolean> - ^ RoundedDialogCorners ifNil: [ true ]! Item was removed: - ----- Method: FillInTheBlankMorph class>>roundedDialogCorners: (in category 'preferences') ----- - roundedDialogCorners: aBoolean - - RoundedDialogCorners := aBoolean. - self allInstances do: [:instance | - aBoolean - ifTrue: [instance useRoundedCorners] - ifFalse: [instance useSquareCorners]].! Item was removed: - ----- Method: FillInTheBlankMorph>>accept (in category 'menu') ----- - accept - "Sent by the accept button." - - textPane accept. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>cancel (in category 'menu') ----- - cancel - "Sent by the cancel button." - - response := responseUponCancel. - done := true. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - varDict at: 'responseUponCancel' ifAbsent: [responseUponCancel := '']. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: FillInTheBlankMorph>>createAcceptButton (in category 'initialization') ----- - createAcceptButton - "create the [accept] button" - | result frame | - result := SimpleButtonMorph new target: self; - color: ColorTheme current okColor. - result - borderColor: (Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [result color twiceDarker]). - result label: 'Accept(s)' translated; - actionSelector: #accept. - result setNameTo: 'accept'. - frame := LayoutFrame new. - frame rightFraction: 0.5; - rightOffset: -10; - bottomFraction: 1.0; - bottomOffset: -2. - result layoutFrame: frame. - self addMorph: result. - self - updateColor: result - color: result color - intensity: 2. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>createCancelButton (in category 'initialization') ----- - createCancelButton - "create the [cancel] button" - | result frame | - result := SimpleButtonMorph new target: self; - color: ColorTheme current cancelColor. - result - borderColor: (Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [result color twiceDarker]). - result label: 'Cancel(l)' translated; - actionSelector: #cancel. - result setNameTo: 'cancel'. - frame := LayoutFrame new. - frame leftFraction: 0.5; - leftOffset: 10; - bottomFraction: 1.0; - bottomOffset: -2. - result layoutFrame: frame. - self addMorph: result. - self - updateColor: result - color: result color - intensity: 2. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>createQueryTextMorph: (in category 'initialization') ----- - createQueryTextMorph: queryString - "create the queryTextMorph" - | result frame | - result := TextMorph new contents: queryString. - result setNameTo: 'query' translated. - result lock. - frame := LayoutFrame new. - frame topFraction: 0.0; - topOffset: 2. - frame leftFraction: 0.5; - leftOffset: (result width // 2) negated. - result layoutFrame: frame. - self addMorph: result. - ^ result! Item was added: + ----- Method: FillInTheBlankMorph>>createTextPaneAcceptOnCR: (in category 'initialization') ----- + createTextPaneAcceptOnCR: acceptBoolean + + textPane := PluggableTextMorph + on: self + text: #response + accept: #response: + readSelection: #selectionInterval + menu: #codePaneMenu:shifted:. + textPane + showScrollBarsOnlyWhenNeeded; + wantsFrameAdornments: false; + hasUnacceptedEdits: true; + acceptOnCR: acceptBoolean; + setNameTo: 'textPane'; + layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@1)); + hResizing: #spaceFill; + vResizing: #spaceFill. + + ^ textPane! Item was removed: - ----- Method: FillInTheBlankMorph>>createTextPaneExtent:acceptBoolean:topOffset:buttonAreaHeight: (in category 'initialization') ----- - createTextPaneExtent: answerExtent acceptBoolean: acceptBoolean topOffset: topOffset buttonAreaHeight: buttonAreaHeight - "create the textPane" - | result frame | - result := PluggableTextMorph - on: self - text: #response - accept: #response: - readSelection: #selectionInterval - menu: #codePaneMenu:shifted:. - result - extent: answerExtent; - showScrollBarsOnlyWhenNeeded; - hResizing: #spaceFill; - vResizing: #spaceFill; - borderWidth: 1; - hasUnacceptedEdits: true; - acceptOnCR: acceptBoolean; - setNameTo: 'textPane'. - frame := LayoutFrame new - leftFraction: 0.0; - rightFraction: 1.0; - topFraction: 0.0; - topOffset: topOffset; - bottomFraction: 1.0; - bottomOffset: buttonAreaHeight negated; - yourself. - result layoutFrame: frame. - self addMorph: result. - ^ result! Item was removed: - ----- Method: FillInTheBlankMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: FillInTheBlankMorph>>delete (in category 'initialization') ----- - delete - - self breakDependents. - super delete.! Item was removed: - ----- Method: FillInTheBlankMorph>>extent: (in category 'geometry') ----- - extent: aPoint - "change the receiver's extent" - - super extent: aPoint . - self setDefaultParameters. - self updateColor! Item was added: + ----- Method: FillInTheBlankMorph>>filterEvent:for: (in category 'events') ----- + filterEvent: event for: morph + + (event isKeystroke and: [event keyCharacter = Character escape]) + ifTrue: [event ignore. self cancelDialog]. + + ^ event! Item was removed: - ----- Method: FillInTheBlankMorph>>getUserResponse (in category 'invoking') ----- - getUserResponse - "Wait for the user to accept or cancel, and answer the result string. Answers the empty string if the user cancels." - "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." - - | w | - w := self world. - w ifNil: [^ response]. - - (ProvideAnswerNotification signal: - (self submorphOfClass: TextMorph) userString) ifNotNil: - [:answer | - self delete. - w doOneCycle. - ^ response := (answer == #default) ifTrue: [response] ifFalse: [answer]]. - - done := false. - w activeHand newKeyboardFocus: textPane. - [done] whileFalse: [w doOneCycle]. - self delete. - w doOneCycle. - ^ response - ! Item was removed: - ----- Method: FillInTheBlankMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^true! Item was changed: ----- Method: FillInTheBlankMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self addKeyboardCaptureFilter: self.! - self setDefaultParameters. - self extent: 400 @ 150. - responseUponCancel := ''. - self class roundedDialogCorners ifTrue: [self useRoundedCorners]. - ! Item was removed: - ----- Method: FillInTheBlankMorph>>morphicLayerNumber (in category 'invoking') ----- - morphicLayerNumber - - ^10.6! Item was removed: - ----- Method: FillInTheBlankMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - (self containsPoint: evt position) ifFalse:[^ Beeper beep]. "sent in response to outside modal click" - evt hand grabMorph: self. "allow repositioning"! Item was changed: ----- Method: FillInTheBlankMorph>>response (in category 'accessing') ----- response + ^ result - ^ response ! Item was changed: ----- Method: FillInTheBlankMorph>>response: (in category 'accessing') ----- response: aText "Sent when text pane accepts." + result := aText asString. + self delete. - response := aText asString. - done := true. - ^ true ! Item was removed: - ----- Method: FillInTheBlankMorph>>responseUponCancel: (in category 'initialization') ----- - responseUponCancel: anObject - responseUponCancel := anObject - ! Item was changed: ----- Method: FillInTheBlankMorph>>selectionInterval (in category 'accessing') ----- selectionInterval + ^ 1 to: result size - ^ 1 to: response size ! Item was changed: ----- Method: FillInTheBlankMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters - "change the receiver's appareance parameters" + super setDefaultParameters. + textPane ifNotNil: [:tp | tp borderColor: self borderColor].! - | colorFromMenu worldColor menuColor | - - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. - - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - - self color: menuColor. - self borderWidth: MenuMorph menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]. - self borderColor: menuBorderColor. - ]. - - - self layoutInset: 3. - ! Item was changed: ----- Method: FillInTheBlankMorph>>setPasswordQuery:initialAnswer:answerHeight:acceptOnCR: (in category 'initialization') ----- setPasswordQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean + - | pane | self setQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean. + textPane font: (StrikeFont passwordFontSize: 12).! - pane := self submorphNamed: 'textPane'. - pane font: (StrikeFont passwordFontSize: 12).! Item was changed: ----- Method: FillInTheBlankMorph>>setQuery:initialAnswer:answerExtent:acceptOnCR: (in category 'initialization') ----- setQuery: queryString initialAnswer: initialAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean + + | text | + + result := initialAnswer. - | query topOffset accept cancel buttonAreaHeight | - response := initialAnswer. done := false. + + self paneMorph removeAllMorphs. + + self title: 'Input Requested'. + self message: queryString. - self removeAllMorphs. - self layoutPolicy: ProportionalLayout new. - query := self createQueryTextMorph: queryString. - topOffset := query height + 4. - accept := self createAcceptButton. - cancel := self createCancelButton. - buttonAreaHeight := (accept height max: cancel height) - + 7. - textPane := self - createTextPaneExtent: answerExtent - acceptBoolean: acceptBoolean - topOffset: topOffset - buttonAreaHeight: buttonAreaHeight. + text := self createTextPaneAcceptOnCR: acceptBoolean. + self paneMorph addMorphBack: text. + + self paneMorph extent: ((initialAnswer asText asMorph extent + (20@10) max: answerExtent) min: 500@500). + self setDefaultParameters.! - self extent: (((answerExtent max: query extent) - max: (initialAnswer asText asMorph extent)) min: 500@500) + (20@30) + (0 @ (topOffset + buttonAreaHeight))! Item was added: + ----- Method: FillInTheBlankMorph>>textPane (in category 'accessing') ----- + textPane + ^ textPane! Item was removed: - ----- Method: FillInTheBlankMorph>>undoGrabCommand (in category 'grabbing/dropping') ----- - undoGrabCommand - ^nil! Item was removed: - ----- Method: FillInTheBlankMorph>>updateColor (in category 'initialization') ----- - updateColor - "update the recevier's fillStyle" - | textPaneBorderColor | - self - updateColor: self - color: self color - intensity: 1. - textPane isNil - ifTrue: [^ self]. - textPaneBorderColor := self borderColor == #raised - ifTrue: [#inset] - ifFalse: [self borderColor]. - textPane borderColor: textPaneBorderColor! Item was removed: - ----- Method: FillInTheBlankMorph>>updateColor:color:intensity: (in category 'initialization') ----- - updateColor: aMorph color: aColor intensity: anInteger - "update the apareance of aMorph" - | fill | - MenuMorph gradientMenu - ifFalse: [^ self]. - - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 -> aColor}. - fill radial: false; - origin: aMorph topLeft; - direction: 0 @ aMorph height. - aMorph fillStyle: fill! Item was changed: Morph subclass: #NewBalloonMorph instanceVariableNames: 'balloonOwner textMorph maximumWidth orientation hasTail' + classVariableNames: 'UseNewBalloonMorph' - classVariableNames: 'DefaultBalloonTextColor UseNewBalloonMorph' poolDictionaries: '' category: 'Morphic-Widgets'! !NewBalloonMorph commentStamp: 'mt 3/31/2015 10:15' prior: 0! A balloon is a bubble with an optional tail. It contains rich text, which describes something about its balloon-owner.! Item was removed: - ----- Method: NewBalloonMorph class>>defaultBalloonTextColor (in category 'preferences') ----- - defaultBalloonTextColor - - <preference: 'Default balloon text color' - categoryList: #(Morphic colors) - description: 'Specifies the default text color if no color information is provided via text attributes such as for plain strings. Otherwise the color information from the text attributes is used.' - type: #Color> - ^ DefaultBalloonTextColor ifNil: [Color black]! Item was removed: - ----- Method: NewBalloonMorph class>>defaultBalloonTextColor: (in category 'preferences') ----- - defaultBalloonTextColor: color - - DefaultBalloonTextColor := color.! Item was changed: ----- Method: NewBalloonMorph class>>string:for:corner: (in category 'instance creation') ----- string: message for: morph corner: symbol ^ self new - color: morph balloonColor; balloonOwner: morph; setText: message; orientation: symbol; yourself! Item was added: + ----- Method: NewBalloonMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the balloon''s border.' }. + { #borderWidth. 'Borders'. 'Width of the balloon''s border.' }. + { #color. 'Colors', 'Color for the balloon background.' }. + { #font. 'Fonts'. 'Font for balloon text if not overridden by text attributes.' }. + { #textColor. 'Colors'. 'Color for the balloon text if not overridden by text attributes.' }. + }! Item was added: + ----- Method: NewBalloonMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was removed: - ----- Method: NewBalloonMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - - ^ self defaultColor muchDarker"Color black"! Item was removed: - ----- Method: NewBalloonMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - - ^ MenuMorph menuBorderWidth! Item was removed: - ----- Method: NewBalloonMorph>>defaultColor (in category 'initialization') ----- - defaultColor - - ^ BalloonMorph balloonColor! Item was changed: ----- Method: NewBalloonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + self fillStyle isColor + ifFalse: [self fillStyle isGradientFill + ifTrue: [self fillStyle direction: 0 @ self height]]. "Bubble." self wantsRoundedCorners ifTrue: [aCanvas frameAndFillRoundRect: self bubbleBounds radius: self cornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color] ifFalse: [aCanvas fillRectangle: self bubbleBounds fillStyle: self fillStyle borderStyle: self borderStyle]. "Tail." self hasTail ifTrue: [ self verticesForTail in: [:points | | pixelOffset | pixelOffset := points first y < points second y ifFalse: [points first x < points second x ifTrue: [self borderStyle width negated @ self borderStyle width] "bottomLeft" ifFalse: [self borderStyle width @ self borderStyle width]] "bottomRight" ifTrue: [points first x < points second x ifTrue: [self borderStyle width negated @ self borderStyle width negated] "topLeft" ifFalse: [self borderStyle width @ self borderStyle width negated]]. "topRight" aCanvas drawPolygon: points fillStyle: self fillStyle. aCanvas line: points first to: points second + pixelOffset width: self borderStyle width color: self borderStyle color. aCanvas line: points first to: points third + pixelOffset width: self borderStyle width color: self borderStyle color]]! Item was changed: ----- Method: NewBalloonMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self setDefaultParameters. + - self - borderWidth: self defaultBorderWidth; - borderColor: self defaultBorderColor; - color: self defaultColor; - hasDropShadow: (Preferences menuAppearance3d and: [self defaultColor isTranslucent not]); - shadowOffset: 1@1; - shadowColor: (self color muchDarker muchDarker alpha: 0.333); - orientation: #bottomLeft. - - MenuMorph roundedMenuCorners - ifTrue: [self cornerStyle: #rounded]. - textMorph := TextMorph new wrapFlag: false; lock; yourself. self addMorph: textMorph.! Item was added: + ----- Method: NewBalloonMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + self + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color r: 0.46 g: 0.46 b: 0.353]); + color: (self userInterfaceTheme color ifNil: [Color r: 0.92 g: 0.92 b: 0.706]); + hasDropShadow: (Preferences menuAppearance3d and: [self color isTranslucent not]); + shadowOffset: 1@1; + shadowColor: (self color muchDarker muchDarker alpha: 0.333); + orientation: #bottomLeft. + + MenuMorph roundedMenuCorners + ifTrue: [self cornerStyle: #rounded]. + + "Gradients?" + MenuMorph gradientMenu ifTrue: [ + | cc fill | + cc := self color. + fill := GradientFillStyle ramp: { + 0.0 -> Color white. + 0.15 -> (cc mixed: 0.5 with: Color white). + 0.5 -> cc. + 0.8 -> cc twiceDarker}. + fill + origin: self topLeft; + direction: 0@self height. + self fillStyle: fill].! Item was changed: ----- Method: NewBalloonMorph>>setText: (in category 'initialization') ----- setText: stringOrText | text | text := stringOrText asText. text unembellished ifTrue: [ + text addAttribute: (TextColor color: (self userInterfaceTheme textColor ifNil: [Color black]))]. - text addAttribute: (TextColor color: self class defaultBalloonTextColor)]. + text addAttribute: (TextFontReference toFont: (self userInterfaceTheme font ifNil: [TextStyle defaultFont])). - text addAttribute: (TextFontReference toFont: (self balloonOwner ifNil: [BalloonMorph]) balloonFont). self textMorph wrapFlag: false. self textMorph newContents: text. self textMorph fullBounds. (self maximumWidth > 0 and: [self textMorph width > self maximumWidth]) ifTrue: [ self textMorph wrapFlag: true; width: self maximumWidth]. self updateLayout.! Item was changed: + Morph subclass: #SystemProgressBarMorph + instanceVariableNames: 'barSize barColor' - RectangleMorph subclass: #SystemProgressBarMorph - instanceVariableNames: 'barSize' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressBarMorph commentStamp: 'laza 4/9/2004 11:47' prior: 0! Instances of this morph get used by SystemProgressMoprh to quickly display a progress bar.! Item was added: + ----- Method: SystemProgressBarMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the progress bar''s border.' }. + { #borderWidth. 'Borders'. 'Width of the progress bar''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the progress bar.' }. + { #barColor. 'Colors'. 'Color of the progress bar''s bar.' }. + }! Item was added: + ----- Method: SystemProgressBarMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was changed: ----- Method: SystemProgressBarMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | area | super drawOn: aCanvas. barSize > 0 ifTrue: [ area := self innerBounds. + area := area origin extent: (barSize min: area extent x)@area extent y. + aCanvas fillRectangle: area color: barColor - area := area origin extent: barSize-2@area extent y. - aCanvas fillRectangle: area color: LazyListMorph listSelectionColor ]. ! Item was changed: ----- Method: SystemProgressBarMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self setDefaultParameters. - self - borderWidth: 0; - color: MenuMorph menuColor muchLighter. - barSize := 0. ! Item was added: + ----- Method: SystemProgressBarMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + "change the receiver's appareance parameters" + + self + color: (self userInterfaceTheme color ifNil: [Color r: 0.977 g: 0.977 b: 0.977]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color transparent]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]). + + barColor := self userInterfaceTheme barColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9].! Item was changed: + Morph subclass: #SystemProgressMorph + instanceVariableNames: 'activeSlots bars labels font lock requestedPosition textColor' - RectangleMorph subclass: #SystemProgressMorph - instanceVariableNames: 'activeSlots bars labels font lock requestedPosition' classVariableNames: 'BarHeight BarWidth Inset UniqueInstance' poolDictionaries: '' category: 'Morphic-Widgets'! !SystemProgressMorph commentStamp: '<historical>' prior: 0! An single instance of this morph class is used to display progress while the system is busy, eg. while it receives code updates or does a fileIn. To give the user progress information you don't deal directly with SystemProgressMorph. You keep on using the well established way of progress notification, that has been a long time in the system, is widely used and does not depend on the existence of SystemProgressMorph. For more information on this look at the example in this class or look at the comment of the method displayProgressAt:from:to:during: in class String. SystemProgressMorph is not meant to be used as a component inside other morphs. You can switch back to the old style of progress display by disabling the morphicProgressStyle setting in the morphic section of the preferences.! Item was added: + ----- Method: SystemProgressMorph class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + self reset.! Item was added: + ----- Method: SystemProgressMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the progress'' border.' }. + { #borderWidth. 'Borders'. 'Width of the progress'' border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the progress.' }. + + { #font. 'Fonts'. 'Font for bar labels.' }. + { #textColor. 'Colors'. 'Color for bar labels.' }. + }! Item was added: + ----- Method: SystemProgressMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self setDefaultParameters.! Item was changed: ----- Method: SystemProgressMorph>>font: (in category 'accessing') ----- font: anObject + font := anObject. + self labels select: [:ea | ea notNil] thenDo: [:ea | ea font: font].! - font := anObject! Item was changed: ----- Method: SystemProgressMorph>>initialize (in category 'initialization') ----- initialize super initialize. activeSlots := 0. bars := Array new: 10. labels := Array new: 10. - font := Preferences standardMenuFont. lock := Semaphore forMutualExclusion. self setDefaultParameters; setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #leftCenter; cellInset: 5; listCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: Inset; minWidth: 150! Item was changed: ----- Method: SystemProgressMorph>>nextSlotFor: (in category 'private') ----- nextSlotFor: shortDescription lock critical: [ | label bar slots | slots := self labels size. self activeSlots = slots ifTrue: [^0]. self activeSlots: self activeSlots + 1. 1 to: slots do: [:index | label := (self labels at: index). label ifNil: [ bar := self bars at: index put: (SystemProgressBarMorph new extent: BarWidth@BarHeight). + label := self labels at: index put: ((StringMorph contents: shortDescription font: self font) color: self textColor). - label := self labels at: index put: (StringMorph contents: shortDescription font: self font). self addMorphBack: label; addMorphBack: bar. ^index]. label owner ifNil: [ bar := self bars at: index. label := self labels at: index. self addMorphBack: (label contents: shortDescription); addMorphBack: (bar barSize: 0). ^index]]] ! Item was changed: ----- Method: SystemProgressMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters "change the receiver's appareance parameters" + self + color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]). - | colorFromMenu worldColor menuColor | + Preferences menuAppearance3d ifTrue: [self addDropShadow]. - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. + self + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]). - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - self color: menuColor. - - MenuMorph roundedMenuCorners - ifTrue: [self useRoundedCorners]. - self borderWidth: MenuMorph menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]. - self borderColor: menuBorderColor. - ]. - self updateColor: self color: self color intensity: 1.! Item was added: + ----- Method: SystemProgressMorph>>textColor (in category 'accessing') ----- + textColor + + ^ textColor ifNil: [Color black]! Item was added: + ----- Method: SystemProgressMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + + textColor := aColor. + self labels select: [:ea | ea notNil] thenDo: [:ea | ea color: textColor].! Item was changed: ----- Method: SystemProgressMorph>>updateColor:color:intensity: (in category 'initialization') ----- updateColor: aMorph color: aColor intensity: anInteger "update the apareance of aMorph" + | fill cc | - | fill | MenuMorph gradientMenu ifFalse: [^ self]. + + cc := aColor adjustSaturation: -0.08 brightness: 0.4. + fill := GradientFillStyle ramp: { + 0.0 -> cc. + 0.25 -> (aColor mixed: 0.5 with: cc). + 1.0 -> aColor}. + - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 ->aColor}. fill radial: false; origin: aMorph topLeft; direction: 0 @ aMorph height. aMorph fillStyle: fill! Item was added: + ----- Method: SystemProgressMorph>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + + ^ MenuMorph roundedMenuCorners or: [super wantsRoundedCorners]! Item was changed: + DialogWindow subclass: #UserDialogBoxMorph + instanceVariableNames: '' - AlignmentMorph subclass: #UserDialogBoxMorph - instanceVariableNames: 'titleMorph labelMorph buttonRow value selectedButton cancelButton timeout savedLabel keyMap' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !UserDialogBoxMorph commentStamp: 'ar 12/11/2009 22:33' prior: 0! A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm: (in category 'utilities') ----- confirm: aString "UserDialogBoxMorph confirm: 'Do you like chocolate?'" + ^self confirm: aString title: 'Please Confirm'! - ^self confirm: aString title: 'Please confirm:'! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:orCancel:at: (in category 'utilities') ----- confirm: aString orCancel: cancelBlock at: aPointOrNil ^self confirm: aString orCancel: cancelBlock + title: 'Please Confirm' - title: 'Please confirm:' at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:orCancel:title:at: (in category 'utilities') ----- confirm: aString orCancel: cancelBlock title: titleString at: aPointOrNil + (self new - ^(self new title: titleString; + message: aString; + createButton: 'Yes' translated value: true; + createButton: 'No' translated value: false; + createButton: 'Cancel' translated value: nil; + selectedButtonIndex: 1; "YES" + yourself) in: [:dialog | + ^ (aPointOrNil + ifNil: [dialog getUserResponseAtHand] + ifNotNil: [ + dialog moveTo: aPointOrNil. + dialog getUserResponse]) + ifNil: [ cancelBlock value ]]! - label: aString; - addSelectedButton: 'Yes' translated value: true; - addButton: 'No' translated value: false; - addCancelButton: 'Cancel' translated value: nil; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil) - ifNil: [ cancelBlock value ]! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:at: (in category 'utilities') ----- confirm: aString title: titleString at: aPointOrNil "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?'" ^self new title: titleString; + message: aString; + createButton: 'Yes' translated value: true; + createCancelButton: 'No' translated value: false; + selectedButtonIndex: 1; "YES" + getUserResponseAtHand! - label: aString; - addSelectedButton: 'Yes' translated value: true; - addCancelButton: 'No' translated value: false; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:at: (in category 'utilities') ----- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice at: aPointOrNil "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...'" ^self new title: titleString; + message: aString; + createButton: trueChoice translated value: true; + createCancelButton: falseChoice translated value: false; + selectedButtonIndex: 1; + moveTo: (aPointOrNil ifNil: [ActiveWorld center]); + getUserResponse! - label: aString; - addSelectedButton: trueChoice translated value: true; - addCancelButton: falseChoice translated value: false; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:default:triggerAfter:at: (in category 'utilities') ----- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice default: default triggerAfter: seconds at: aPointOrNil "UserDialogBoxMorph confirm: 'I like hot java' title: 'What do you say?' trueChoice: 'You bet!!' falseChoice: 'Nope' default: false triggerAfter: 12 at: 121@212" ^self new title: titleString; + message: aString; + createButton: trueChoice translated value: true; + createCancelButton: falseChoice translated value: false; + selectedButtonIndex: (default ifTrue: [1] ifFalse: [2]); + moveTo: (aPointOrNil ifNil: [ActiveWorld center]); + getUserResponseAfter: seconds! - label: aString; - addButton: trueChoice translated value: true selected: default performActionOnEscape: false; - addButton: falseChoice translated value: false selected: default not performActionOnEscape: true; - triggerAfter: seconds; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was changed: ----- Method: UserDialogBoxMorph class>>inform: (in category 'utilities') ----- inform: aString "UserDialogBoxMorph inform: 'Squeak is great!!'" + ^self inform: aString title: 'Note' translated! - ^self inform: aString title: 'Note:'! Item was changed: ----- Method: UserDialogBoxMorph class>>inform:title:at: (in category 'utilities') ----- inform: aString title: titleString at: aPointOrNil "UserDialogBoxMorph inform: 'Squeak is great!!' title: 'Will you look at this:'" ^self new title: titleString; + message: aString; + createButton: 'OK' translated value: nil; + getUserResponseAtHand! - label: aString; - addSelectedCancelButton: 'OK' translated value: nil; - runModalIn: ActiveWorld forHand: ActiveHand at: aPointOrNil! Item was removed: - ----- Method: UserDialogBoxMorph>>addButton:value: (in category 'constructing') ----- - addButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: false - performActionOnEscape: false! Item was removed: - ----- Method: UserDialogBoxMorph>>addButton:value:selected:performActionOnEscape: (in category 'constructing') ----- - addButton: buttonLabel value: buttonValue selected: isSelected performActionOnEscape: performActionOnEscape - "Adds a button with the given label and value. - The value is returned if the user presses the button." - | button | - button := PluggableButtonMorphPlus new - label: buttonLabel ; - action: [ self closeDialog: buttonValue ] ; - onColor: self buttonColor twiceLighter - offColor: self buttonColor twiceLighter. - button hResizing: #spaceFill; vResizing: #spaceFill. - isSelected ifTrue: [ self selectButton: button ]. - performActionOnEscape ifTrue: [ self performActionOnEscapeOf: button ]. - self registerKeyFor: button. - buttonRow addMorphBack: button! Item was removed: - ----- Method: UserDialogBoxMorph>>addCancelButton:value: (in category 'constructing') ----- - addCancelButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: false - performActionOnEscape: true! Item was removed: - ----- Method: UserDialogBoxMorph>>addSelectedButton:value: (in category 'constructing') ----- - addSelectedButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: true - performActionOnEscape: false! Item was removed: - ----- Method: UserDialogBoxMorph>>addSelectedCancelButton:value: (in category 'constructing') ----- - addSelectedCancelButton: buttonLabel value: buttonValue - - self - addButton: buttonLabel - value: buttonValue - selected: true - performActionOnEscape: true! Item was removed: - ----- Method: UserDialogBoxMorph>>buttonColor (in category 'initialization') ----- - buttonColor - ^Color r: 0.658 g: 0.678 b: 0.78! Item was removed: - ----- Method: UserDialogBoxMorph>>buttons (in category 'events') ----- - buttons - - ^buttonRow submorphs select: [ :each | - each isKindOf: PluggableButtonMorphPlus ].! Item was removed: - ----- Method: UserDialogBoxMorph>>checkAgainstKeymap: (in category 'events') ----- - checkAgainstKeymap: aCharacter - keyMap - at: aCharacter asLowercase - ifPresent: [ : foundButton | foundButton performAction ] - ifAbsent: [ "do nothing" ]! Item was removed: - ----- Method: UserDialogBoxMorph>>closeDialog: (in category 'running') ----- - closeDialog: returnValue - value := returnValue. - self delete.! Item was removed: - ----- Method: UserDialogBoxMorph>>deselectSelectedButton (in category 'events') ----- - deselectSelectedButton - - selectedButton ifNil: [ ^self ]. - selectedButton - onColor: self buttonColor twiceLighter - offColor: self buttonColor twiceLighter. - selectedButton := nil! Item was removed: - ----- Method: UserDialogBoxMorph>>drawSubmorphsOn: (in category 'drawing') ----- - drawSubmorphsOn: aCanvas - - super drawSubmorphsOn: aCanvas. - - self wantsRoundedCorners ifTrue: [ - "Overdraw lower part of title bar to hide bottom corners." - aCanvas - fillRectangle: (self submorphs first "titleRow" bottomLeft - (-1 @ self submorphs first cornerRadius) - corner: self submorphs first "titleRow" bottomRight - (1@0)) - color: self color].! Item was removed: - ----- Method: UserDialogBoxMorph>>flash (in category 'events') ----- - flash - "Flash me" - 1 to: 2 do:[:i| - self color: Color black. - self world doOneCycleNow. - (Delay forMilliseconds: 50) wait. - self color: Color white. - self world doOneCycleNow. - (Delay forMilliseconds: 50) wait. - ].! Item was removed: - ----- Method: UserDialogBoxMorph>>handlesKeyboard: (in category 'events') ----- - handlesKeyboard: evt - - ^true! Item was removed: - ----- Method: UserDialogBoxMorph>>initialize (in category 'initialization') ----- - initialize - - | titleRow cc | - super initialize. - self color: Color white. - self listDirection: #topToBottom; wrapCentering: #center; - hResizing: #shrinkWrap; vResizing: #shrinkWrap. - self layoutInset: -1 @ -1; cellInset: 5@5. - self borderStyle: BorderStyle thinGray. - self setProperty: #indicateKeyboardFocus: toValue: #never. - - FillInTheBlankMorph roundedDialogCorners - ifTrue: [self useRoundedCorners]. - - self hasDropShadow: Preferences menuAppearance3d. - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12)]. - - cc := Color gray: 0.8. - titleRow := AlignmentMorph newRow. - titleRow hResizing: #spaceFill; vResizing: #shrinkWrap. - - self cornerStyle == #rounded - ifTrue: [titleRow useRoundedCorners]. - - titleRow borderStyle: BorderStyle thinGray. - titleRow layoutInset: (5@5 corner: (2@ (5 + (titleRow cornerStyle == #rounded ifTrue: [titleRow cornerRadius] ifFalse: [0])))). - titleRow color: cc. - titleRow fillStyle: self titleGradient. - - titleMorph := StringMorph new. - titleMorph emphasis: 1. - titleRow addMorph: titleMorph. - labelMorph := TextMorph new. - labelMorph margins: (Preferences standardButtonFont widthOf: $x) * 2 @ 0. - labelMorph lock. - buttonRow := AlignmentMorph newRow - vResizing: #rigid; - height: (Preferences standardButtonFont height + 20); - hResizing: #spaceFill; - layoutInset: - (((Preferences standardButtonFont widthOf: $x) * 2 @ 0) - corner: ((Preferences standardButtonFont widthOf: $x) * 2 @ 10)); - cellInset: (Preferences standardButtonFont widthOf: $x) * 2. - buttonRow color: Color transparent. - self - addMorphBack: titleRow ; - addMorphBack: labelMorph ; - addMorphBack: buttonRow. - keyMap := Dictionary new! Item was removed: - ----- Method: UserDialogBoxMorph>>justDroppedInto:event: (in category 'events') ----- - justDroppedInto: aMorph event: event - - "Restore drop shadow if necessary." - self hasDropShadow: Preferences menuAppearance3d. - - "aggressively preserve focus" - event hand newMouseFocus: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>keyStroke: (in category 'events') ----- - keyStroke: evt - | evtCharacter | - self stopAutoTrigger. - evtCharacter := evt keyCharacter. - evtCharacter = Character escape ifTrue: [ - ^cancelButton ifNotNil: [ cancelButton performAction ] ]. - evtCharacter = Character cr ifTrue: [ - ^selectedButton ifNotNil: [ selectedButton performAction ] ]. - (evtCharacter = Character arrowLeft or: [ - evt shiftPressed and: [ evtCharacter = Character tab ] ]) ifTrue: [ - ^self selectPreviousButton ]. - (evtCharacter = Character arrowRight or: [ - evtCharacter = Character tab ]) ifTrue: [ - ^self selectNextButton ]. - self checkAgainstKeymap: evtCharacter! Item was changed: + ----- Method: UserDialogBoxMorph>>label (in category 'accessing') ----- - ----- Method: UserDialogBoxMorph>>label (in category 'constructing') ----- label + ^ self message! - "The dialog's label (String)" - ^labelMorph contents - ! Item was changed: + ----- Method: UserDialogBoxMorph>>label: (in category 'accessing') ----- - ----- Method: UserDialogBoxMorph>>label: (in category 'constructing') ----- label: aString + self message: aString.! - "The dialog's label (String)" - labelMorph contents: aString. - ! Item was removed: - ----- Method: UserDialogBoxMorph>>mouseDown: (in category 'events') ----- - mouseDown: event - self stopAutoTrigger. - "Always bring me to the front since I am modal" - self comeToFront. - (self containsPoint: event position) ifFalse:[ - Beeper beepPrimitive. - ^self flash]. - - self hasDropShadow: false. - event hand grabMorph: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>mouseUp: (in category 'events') ----- - mouseUp: event - self stopAutoTrigger. - "aggressively preserve focus" - event hand newMouseFocus: self.! Item was removed: - ----- Method: UserDialogBoxMorph>>performActionOnEscapeOf: (in category 'constructing') ----- - performActionOnEscapeOf: aButton - - cancelButton := aButton! Item was removed: - ----- Method: UserDialogBoxMorph>>processFocusEvent:using: (in category 'events') ----- - processFocusEvent: evt using: dispatcher - - ^ dispatcher dispatchFocusEventFully: evt with: self! Item was removed: - ----- Method: UserDialogBoxMorph>>registerKeyFor: (in category 'constructing') ----- - registerKeyFor: button - button label do: - [ : eachChar | eachChar isAlphaNumeric ifTrue: - [ keyMap - at: eachChar asLowercase - ifPresent: [ : found | "It's already taken, don't use it." ] - ifAbsent: - [ ^ keyMap - at: eachChar asLowercase - put: button ] ] ]! Item was removed: - ----- Method: UserDialogBoxMorph>>runModalIn:forHand:at: (in category 'running') ----- - runModalIn: aWorld forHand: aHand at: aPointOrNil - "Ensure that we have a reasonable minimum size" - | oldFocus pos offset | - (ProvideAnswerNotification signal: self label asString) ifNotNil:[:answer| ^answer]. - self openInWorld: aWorld. - pos := aPointOrNil ifNil: [ - "If called after a longer UI operation, be sure to use the current mouse cursor. Hand position is not up-to-date. Do one world cycle does not help if there are currently no mouse events. So, we *have to be* this extreme." - Sensor cursorPoint]. - offset := aPointOrNil - ifNil: [selectedButton fullBounds origin - (selectedButton fullBounds extent // 2 * (-1@1))] - ifNotNil: [self fullBounds extent // 2]. - self setConstrainedPosition: pos - offset hangOut: false. - oldFocus := aHand keyboardFocus. - aHand newMouseFocus: self. - aHand newKeyboardFocus: self. - savedLabel := selectedButton label. - [self isInWorld] whileTrue:[aWorld doOneSubCycle]. - oldFocus ifNotNil:[aHand newKeyboardFocus: oldFocus]. - ^value! Item was removed: - ----- Method: UserDialogBoxMorph>>selectButton: (in category 'events') ----- - selectButton: aButton - - self deselectSelectedButton. - aButton - onColor: Color orange muchLighter - offColor: Color orange muchLighter. - selectedButton := aButton! Item was removed: - ----- Method: UserDialogBoxMorph>>selectNextButton (in category 'events') ----- - selectNextButton - - | buttons | - buttons := self buttons. - self selectButton: (buttons atWrap: (buttons indexOf: selectedButton) + 1)! Item was removed: - ----- Method: UserDialogBoxMorph>>selectPreviousButton (in category 'events') ----- - selectPreviousButton - - | buttons | - buttons := self buttons. - self selectButton: (buttons atWrap: (buttons indexOf: selectedButton) - 1)! Item was removed: - ----- Method: UserDialogBoxMorph>>step (in category 'stepping and presenter') ----- - step - timeout ifNil: [^self]. - timeout = 0 - ifTrue: [ - self stopStepping. - selectedButton performAction] - ifFalse: [ - selectedButton label: savedLabel, '(', timeout printString, ')'. - timeout := timeout - 1]! Item was removed: - ----- Method: UserDialogBoxMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^1000! Item was removed: - ----- Method: UserDialogBoxMorph>>stopAutoTrigger (in category 'stepping and presenter') ----- - stopAutoTrigger - timeout ifNil: [^self]. - timeout := nil. - self stopStepping. - selectedButton label: savedLabel ! Item was removed: - ----- Method: UserDialogBoxMorph>>title (in category 'constructing') ----- - title - ^titleMorph contents! Item was removed: - ----- Method: UserDialogBoxMorph>>title: (in category 'constructing') ----- - title: aString - titleMorph contents: aString! Item was removed: - ----- Method: UserDialogBoxMorph>>titleGradient (in category 'initialization') ----- - titleGradient - - | cc gradient | - SystemWindow gradientWindow - ifFalse: [^ SolidFillStyle color: self buttonColor]. - - cc := self buttonColor. - gradient := GradientFillStyle ramp: { - 0.0 -> Color white. - 0.33 ->(cc mixed: 0.5 with: Color white). - 1.0 -> cc. - }. - gradient origin: 0@0. - gradient direction: 0 @ (TextStyle defaultFont height + 10). - ^gradient! Item was removed: - ----- Method: UserDialogBoxMorph>>triggerAfter: (in category 'constructing') ----- - triggerAfter: seconds - timeout := seconds! Item was removed: - ----- Method: UserDialogBoxMorph>>wantsToBeDroppedInto: (in category 'events') ----- - wantsToBeDroppedInto: aMorph - "Return true if it's okay to drop the receiver into aMorph" - ^aMorph isWorldMorph "only into worlds"! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'SystemProgressMorph reset.'! - (PackageInfo named: 'Morphic') postscript: 'MenuIcons initializeIcons. - TheWorldMainDockingBar updateInstances.'!

1 0

The Trunk: 51Deprecated-mt.37.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of 51Deprecated to project The Trunk: http://source.squeak.org/trunk/51Deprecated-mt.37.mcz ==================== Summary ==================== Name: 51Deprecated-mt.37 Author: mt Time: 31 July 2016, 11:02:27.47649 am UUID: 7a39db3d-68a6-8545-a4b4-ec7c35d1edf9 Ancestors: 51Deprecated-mt.36 *** Widget Refactorings and UI Themes (Part 4 of 11) *** Some fixes and refactorings in menus and docking bars. Prepare both for UI themeing. =============== Diff against 51Deprecated-mt.36 =============== Item was added: + ----- Method: MenuMorph class>>menuBorderColor (in category '*51Deprecated') ----- + menuBorderColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #borderColor for: self) ifNil: [(Color r: 0.2 g: 0.3 b: 0.9)]! Item was added: + ----- Method: MenuMorph class>>menuBorderWidth (in category '*51Deprecated') ----- + menuBorderWidth + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #borderWidth for: self) ifNil: [2]! Item was added: + ----- Method: MenuMorph class>>menuColor (in category '*51Deprecated') ----- + menuColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #color for: self) ifNil: [(Color r: 0.9 g: 0.9 b: 0.9)]! Item was added: + ----- Method: MenuMorph class>>menuLineColor (in category '*51Deprecated') ----- + menuLineColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #lineColor for: self) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was added: + ----- Method: MenuMorph class>>menuSelectionColor (in category '*51Deprecated') ----- + menuSelectionColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #selectionColor for: MenuItemMorph) ifNil: [(Color r: 0.4 g: 0.5 b: 0.7)]! Item was added: + ----- Method: MenuMorph class>>menuTitleBorderColor (in category '*51Deprecated') ----- + menuTitleBorderColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #titleBorderColor for: self) ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was added: + ----- Method: MenuMorph class>>menuTitleBorderWidth (in category '*51Deprecated') ----- + menuTitleBorderWidth + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #titleBorderWidth for: self) ifNil: [0]! Item was added: + ----- Method: MenuMorph class>>menuTitleColor (in category '*51Deprecated') ----- + menuTitleColor + + self deprecated: 'mt: Use UI themes.'. + ^ (UserInterfaceTheme current get: #titleColor for: self) ifNil: [ Color transparent]!

1 0

The Trunk: Morphic-mt.1210.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1210.mcz ==================== Summary ==================== Name: Morphic-mt.1210 Author: mt Time: 31 July 2016, 11:01:49.38749 am UUID: 885974ef-35e1-cd4f-8c9e-858dcd73e15b Ancestors: Morphic-mt.1209 *** Widget Refactorings and UI Themes (Part 4 of 11) *** Some fixes and refactorings in menus and docking bars. Prepare both for UI themeing. =============== Diff against Morphic-mt.1209 =============== Item was changed: ----- Method: DockingBarItemMorph>>adjacentTo (in category 'selecting') ----- adjacentTo + | roundedCornersOffset verticalOffset | - | roundedCornersOffset | roundedCornersOffset := MenuMorph roundedMenuCorners ifTrue: [Morph preferredCornerRadius negated] ifFalse: [0]. + verticalOffset := 2. owner isFloating + ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ 4)}]. owner isAdheringToTop + ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ 4)}]. owner isAdheringToLeft + ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ 4)}]. owner isAdheringToBottom + ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset)}]. - ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ 4)}]. owner isAdheringToRight + ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset negated)}]. - ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ -4)}]. ^ {self bounds bottomLeft + (roundedCornersOffset @ 5)}! Item was added: + ----- Method: DockingBarItemMorph>>drawIconOn: (in category 'drawing') ----- + drawIconOn: aCanvas + + | pos | + self hasIcon ifTrue: [ + | iconForm | + iconForm := self iconForm. + + pos := (contents + ifEmpty: [self left + (self width - iconForm width // 2)] + ifNotEmpty: [self left]) + @ (self top + (self height - iconForm height // 2)). + + aCanvas + translucentImage: iconForm + at: pos].! Item was added: + ----- Method: DockingBarItemMorph>>drawLabelOn: (in category 'drawing') ----- + drawLabelOn: aCanvas + + | stringBounds | + self contents ifEmpty: [^ self]. + + stringBounds := bounds. + + self hasIcon ifTrue: [ + stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ]. + + "Vertical centering." + stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. + "Horizontal centering." + stringBounds := stringBounds left: stringBounds left + (stringBounds width - (self fontToUse widthOfString: contents) // 2) abs. + + aCanvas + drawString: contents + in: stringBounds + font: self fontToUse + color: self colorToUse.! Item was removed: - ----- Method: DockingBarItemMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | stringColor stringBounds | - (isSelected and: [ isEnabled ]) - ifTrue: [ - aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle. - stringColor := color negated ] - ifFalse: [ stringColor := color ]. - stringBounds := bounds. - stringBounds := stringBounds left: stringBounds left + self stringMargin. - self hasIcon ifTrue: [ - | iconForm | - iconForm := self iconForm. - aCanvas - translucentImage: iconForm - at: stringBounds left @ (self top + (self height - iconForm height // 2)). - stringBounds := stringBounds left: stringBounds left + iconForm width + 2 ]. - stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. - aCanvas - drawString: contents - in: stringBounds - font: self fontToUse - color: stringColor! Item was added: + ----- Method: DockingBarItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') ----- + drawSubMenuMarkerOn: aCanvas + "Ignore."! Item was removed: - ----- Method: DockingBarItemMorph>>minWidth (in category 'layout') ----- - minWidth - - | iconWidth | - iconWidth := self hasIcon - ifTrue: [ self icon width + 2 ] - ifFalse: [ 0 ]. - ^ (self fontToUse widthOfString: contents) + iconWidth + (2 * self stringMargin)! Item was removed: - ----- Method: DockingBarItemMorph>>stringMargin (in category 'layout') ----- - stringMargin - - ^Preferences tinyDisplay - ifTrue: [ 1 ] - ifFalse: [ 6 ]! Item was removed: - ----- Method: DockingBarItemMorph>>subMenuMarker (in category 'private') ----- - subMenuMarker - - self shouldNotImplement! Item was changed: + Morph subclass: #DockingBarMorph - AlignmentMorph subclass: #DockingBarMorph instanceVariableNames: 'originalColor gradientRamp fillsOwner avoidVisibleBordersAtEdge autoGradient selectedItem activeSubMenu oldKeyboardFocus oldMouseFocus' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus-DockingBar'! Item was added: + ----- Method: DockingBarMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the menu''s border.' }. + { #borderWidth. 'Geometry'. 'Width of the menu''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the menu.' }. + + { #lineColor. 'Colors'. 'Color of the separators between menu items.' }. + { #lineStyle. 'Colors'. 'Use border-style to change appearance.' }. + { #lineWidth. 'Geometry'. 'How big the separators should be.' }. + }! Item was changed: ----- Method: DockingBarMorph>>addLine (in category 'construction') ----- addLine "Append a divider line to this menu. Suppress duplicate lines." + | colorToUse | submorphs isEmpty ifTrue: [^ self]. + self lastSubmorph knownName = #line ifTrue: [^ self]. + + colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9]. + self addMorphBack: (Morph new + color: colorToUse; + extent: (self userInterfaceTheme lineWidth ifNil: [2]) asPoint; + borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]); + borderColor: colorToUse; + borderWidth: 1; + name: #line; "see above" + yourself).! - (self lastSubmorph isKindOf: MenuLineMorph) - ifFalse: [self addMorphBack: MenuLineMorph new]. - ! Item was added: + ----- Method: DockingBarMorph>>applyUserInterfaceTheme (in category 'update') ----- + applyUserInterfaceTheme + + | colorToUse | + gradientRamp := nil. + + super applyUserInterfaceTheme. + + self setDefaultParameters. + + "Update properties of separating lines." + colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9]. + self submorphs + select: [:ea | ea knownName = #line] + thenDo: [:line | + line + color: colorToUse; + extent: (self userInterfaceTheme lineWidth ifNil: [2]) asPoint; + borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]); + borderColor: colorToUse].! Item was changed: ----- Method: DockingBarMorph>>color: (in category 'accessing') ----- color: aColor "Set the receiver's color." + super color: aColor. originalColor := aColor asColor. + gradientRamp := nil. "" self updateColor! Item was changed: ----- Method: DockingBarMorph>>gradientRamp (in category 'private - layout') ----- gradientRamp + | cc | + cc := originalColor adjustSaturation: -0.08 brightness: 0.4. + ^ gradientRamp ifNil:[gradientRamp := { + 0.0 -> cc. + 0.25 -> (originalColor mixed: 0.5 with: cc). + 0.9 -> originalColor. + 1.0 -> originalColor darker.}]! - ^ gradientRamp ifNil:[{0.0 -> originalColor muchLighter. 1.0 -> originalColor twiceDarker}]! Item was changed: ----- Method: DockingBarMorph>>initialize (in category 'initialize-release') ----- initialize "initialize the receiver" super initialize. + self changeTableLayout. + selectedItem := nil. activeSubMenu := nil. fillsOwner := true. avoidVisibleBordersAtEdge := true. autoGradient := MenuMorph gradientMenu. self setDefaultParameters ; beFloating ; beSticky ; layoutInset: 0 ; dropEnabled: true! Item was changed: ----- Method: DockingBarMorph>>setDefaultParameters (in category 'initialize-release') ----- setDefaultParameters "private - set the default parameter using Preferences as the inspiration source" + - | colorFromMenu worldColor menuColor menuBorderColor | - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. - "" - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [MenuMorph menuColor]. - "" - menuBorderColor := Preferences menuAppearance3d - ifTrue: [#raised] - ifFalse: [colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [MenuMorph menuBorderColor]]. - "" self + color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]). + + self extent: (Preferences standardMenuFont height asPoint).! - setColor: menuColor - borderWidth: MenuMorph menuBorderWidth - borderColor: menuBorderColor! Item was changed: ----- Method: DockingBarMorph>>updateColor (in category 'private - layout') ----- updateColor "private - update the receiver's color" | fill | + MenuMorph gradientMenu ifFalse: [ - self autoGradient ifFalse: [ self color ~= originalColor ifTrue: [self color: originalColor]. ^ self]. "" fill := GradientFillStyle ramp: self gradientRamp. "" fill origin: self topLeft. self isVertical ifTrue: [fill direction: self width @ 0] ifFalse: [fill direction: 0 @ self height]. "" self fillStyle: fill! Item was changed: ----- Method: DockingBarMorph>>updateLayoutProperties (in category 'private - layout') ----- updateLayoutProperties "private - update the layout properties based on adhering, fillsOwner and avoidVisibleBordersAtEdge preferencs" "" (self isHorizontal or: [self isFloating]) ifTrue: [self listDirection: #leftToRight] ifFalse: [self listDirection: #topToBottom]. "" self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. self fillsOwner ifTrue: ["" self isHorizontal ifTrue: [self hResizing: #spaceFill]. self isVertical ifTrue: [self vResizing: #spaceFill]]. + "" + self isHorizontal ifTrue: [ + self submorphsDo: [:m | m hResizing: #shrinkWrap; vResizing: #spaceFill]]. + self isVertical ifTrue: [ + self submorphsDo: [:m | m vResizing: #shrinkWrap; hResizing: #spaceFill]]. + ! - ! Item was changed: ----- Method: MenuIcons class>>squeakLogoIcon (in category 'accessing - icons') ----- squeakLogoIcon ^ Icons at: #squeakLogoIcon ifAbsentPut: [(Form extent: 24@16 depth: 32 + fromArray: #( 0 0 67108865 2063597569 1778384897 889192449 0 0 0 0 0 0 0 0 0 0 0 0 1610612737 1811939329 1610612737 0 0 0 0 0 905969665 889192449 0 1442840577 788529153 0 0 0 0 0 0 0 0 0 0 1711276033 469762049 0 1728053249 0 0 0 0 0 1006632961 704643073 0 0 1895825409 234881025 0 0 0 0 0 0 0 0 1207959553 838860801 0 0 1728053249 0 0 0 0 0 738197505 989855745 0 0 167772161 1862270977 0 0 0 0 0 0 0 83886081 1879048193 0 0 0 1744830465 0 0 0 0 0 469762049 1258291201 0 0 0 1543503873 520093697 0 0 0 0 0 0 1543503873 335544321 0 0 0 1761607681 0 0 0 0 0 16777217 1644167169 0 0 0 33554433 67108865 0 0 0 0 0 0 33554433 0 0 0 0 1795162113 0 0 0 0 0 0 1711276033 0 0 0 0 0 117440513 0 0 0 0 0 0 0 0 0 100663297 1677721601 0 0 0 0 0 0 1744830465 0 0 0 0 3019898881 4009754625 1056964609 0 0 1090519041 3204448257 1325400065 0 0 0 889192449 889192449 0 0 0 0 0 0 1392508929 352321537 0 0 637534209 4278190081 4278190081 2650800129 0 0 3372220417 4278190081 3758096385 0 0 0 1560281089 117440513 0 0 0 0 0 0 0 0 0 0 134217729 4060086273 4278190081 1929379841 0 0 3187671041 4278190081 3590324225 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 704643073 1577058305 83886081 0 0 771751937 2667577345 956301313 0 0 0 0 0 0 0 0 0 0 369098753 973078529 1577058305 1728053249 1711276033 1325400065 805306369 218103809 0 855638017 922746881 16777217 0 268435457 788529153 1308622849 1593835521 1056964609 436207617 16777217 0 0 1442840577 1761607681 1409286145 788529153 301989889 872415233 1124073473 1627389953 1929379841 973078529 2030043137 4278190081 4278190081 2164260865 1040187393 1946157057 1577058305 939524097 452984833 687865857 1325400065 1778384897 1795162113 1392508929 0 0 855638017 1795162113 1677721601 855638017 620756993 436207617 486539265 285212673 2030043137 4278190081 4278190081 2164260865 486539265 1023410177 922746881 1157627905 1392508929 1845493761 1744830465 486539265 0 0 201326593 2013265921 1006632961 0 553648129 1694498817 1778384897 1694498817 1728053249 738197505 0 855638017 922746881 16777217 738197505 1728053249 1744830465 1778384897 1476395009 251658241 117440513 1476395009 1879048193 150994945 0 16777217 0 486539265 1426063361 16777217 0 0 0 0 0 0 0 0 0 0 0 0 234881025 1728053249 486539265 0 167772161 50331649) - fromArray: #( 16777215 16777215 67108864 2063597568 1778384896 889192448 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1610612736 1811939328 1610612736 16777215 16777215 16777215 16777215 16777215 905969664 889192448 16777215 1442840576 788529152 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1711276032 469762048 16777215 1728053248 16777215 16777215 16777215 16777215 16777215 1006632960 704643072 16777215 16777215 1895825408 234881024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1207959552 838860800 16777215 16777215 1728053248 16777215 16777215 16777215 16777215 16777215 738197504 989855744 16777215 16777215 167772160 1862270976 16777215 16777215 16777215 16777215 16777215 16777215 16777215 83886080 1879048192 16777215 16777215 16777215 1744830464 16777215 16777215 16777215 16777215 16777215 469762048 1258291200 16777215 16777215 16777215 1543503872 520093696 16777215 16777215 16777215 16777215 16777215 16777215 1543503872 335544320 16777215 16777215 16777215 1761607680 16777215 16777215 16777215 16777215 16777215 16777216 1644167168 16777215 16777215 16777215 33554432 67108864 16777215 16777215 16777215 16777215 16777215 16777215 33554432 16777215 16777215 16777215 16777215 1795162112 16777215 16777215 16777215 16777215 16777215 16777215 1711276032 16777215 16777215 16777215 16777215 16777215 117440512 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100663296 1677721600 16777215 16777215 16777215 16777215 16777215 16777215 1744830464 16777215 16777215 16777215 16777215 3019898880 4009754624 1056964608 16777215 16777215 1090519040 3204448256 1325400064 16777215 16777215 16777215 889192448 889192448 16777215 16777215 16777215 16777215 16777215 16777215 1392508928 352321536 16777215 16777215 637534208 4278190080 4278190080 2650800128 16777215 16777215 3372220416 4278190080 3758096384 16777215 16777215 16777215 1560281088 117440512 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 134217728 4060086272 4278190080 1929379840 16777215 16777215 3187671040 4278190080 3590324224 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 704643072 1577058304 83886080 16777215 16777215 771751936 2667577344 956301312 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 369098752 973078528 1577058304 1728053248 1711276032 1325400064 805306368 218103808 16777215 858262026 925501705 16777216 16777215 268435456 788529152 1308622848 1593835520 1056964608 436207616 16777216 16777215 16777215 1442840576 1761607680 1409286144 788529152 301989888 872415232 1124073472 1627389952 1929379840 973078528 2032667403 4280814347 4280814347 2166885388 1040187392 1946157056 1577058304 939524096 452984832 687865856 1325400064 1778384896 1795162112 1392508928 16777215 16777215 855638016 1795162112 1677721600 855638016 620756992 436207616 486539264 285212672 2032667403 4280814347 4280814347 2166885388 486539264 1023410176 922746880 1157627904 1392508928 1845493760 1744830464 486539264 16777215 16777215 201326592 2013265920 1006632960 16777215 553648128 1694498816 1778384896 1694498816 1728053248 738197504 16777215 858262026 925501705 16777216 738197504 1728053248 1744830464 1778384896 1476395008 251658240 117440512 1476395008 1879048192 150994944 16777215 16777216 16777215 486539264 1426063360 16777216 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 234881024 1728053248 486539264 16777215 167772160 50331648) offset: 0@0)]! Item was added: + ----- Method: MenuIcons class>>squeakLogoIconColorized: (in category 'accessing - icons') ----- + squeakLogoIconColorized: aColor + + ^ self squeakLogoIcon + collectColors: [:c | aColor alpha: c alpha]! Item was removed: - ----- Method: MenuIcons class>>squeakLogoInvertedIcon (in category 'accessing - icons') ----- - squeakLogoInvertedIcon - ^ Icons - at: #squeakLogoInvertedIcon ifAbsentPut: [(Form - extent: 24@16 - depth: 32 - fromArray: #( 16777215 16777215 83886079 2080374783 1795162111 905969663 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1627389951 1828716543 1627389951 16777215 16777215 16777215 16777215 16777215 922746879 905969663 16777215 1459617791 805306367 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1728053247 486539263 16777215 1744830463 16777215 16777215 16777215 16777215 16777215 1023410175 721420287 16777215 16777215 1912602623 251658239 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1224736767 855638015 16777215 16777215 1744830463 16777215 16777215 16777215 16777215 16777215 754974719 1006632959 16777215 16777215 184549375 1879048191 16777215 16777215 16777215 16777215 16777215 16777215 16777215 100663295 1895825407 16777215 16777215 16777215 1761607679 16777215 16777215 16777215 16777215 16777215 486539263 1275068415 16777215 16777215 16777215 1560281087 536870911 16777215 16777215 16777215 16777215 16777215 16777215 1560281087 352321535 16777215 16777215 16777215 1778384895 16777215 16777215 16777215 16777215 16777215 33554431 1660944383 16777215 16777215 16777215 50331647 83886079 16777215 16777215 16777215 16777215 16777215 16777215 50331647 16777215 16777215 16777215 16777215 1811939327 16777215 16777215 16777215 16777215 16777215 16777215 1728053247 16777215 16777215 16777215 16777215 16777215 134217727 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 117440511 1694498815 16777215 16777215 16777215 16777215 16777215 16777215 1761607679 16777215 16777215 16777215 16777215 3036676095 4026531839 1073741823 16777215 16777215 1107296255 3221225471 1342177279 16777215 16777215 16777215 905969663 905969663 16777215 16777215 16777215 16777215 16777215 16777215 1409286143 369098751 16777215 16777215 654311423 4294967295 4294967295 2667577343 16777215 16777215 3388997631 4294967295 3774873599 16777215 16777215 16777215 1577058303 134217727 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 150994943 4076863487 4294967295 1946157055 16777215 16777215 3204448255 4294967295 3607101439 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 721420287 1593835519 100663295 16777215 16777215 788529151 2684354559 973078527 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 385875967 989855743 1593835519 1744830463 1728053247 1342177279 822083583 234881023 16777215 869791221 936769270 33554431 16777215 285212671 805306367 1325400063 1610612735 1073741823 452984831 33554431 16777215 16777215 1459617791 1778384895 1426063359 805306367 318767103 889192447 1140850687 1644167167 1946157055 989855743 2044196084 4292343028 4292343028 2178413555 1056964607 1962934271 1593835519 956301311 469762047 704643071 1342177279 1795162111 1811939327 1409286143 16777215 16777215 872415231 1811939327 1694498815 872415231 637534207 452984831 503316479 301989887 2044196084 4292343028 4292343028 2178413555 503316479 1040187391 939524095 1174405119 1409286143 1862270975 1761607679 503316479 16777215 16777215 218103807 2030043135 1023410175 16777215 570425343 1711276031 1795162111 1711276031 1744830463 754974719 16777215 869791221 936769270 33554431 754974719 1744830463 1761607679 1795162111 1493172223 268435455 134217727 1493172223 1895825407 167772159 16777215 33554431 16777215 503316479 1442840575 33554431 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 251658239 1744830463 503316479 16777215 184549375 67108863) - offset: 0@0)]! Item was added: + ----- Method: MenuItemMorph class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + SubMenuMarker := (UserInterfaceTheme current get: #subMenuMarker for: self) + ifNil: [self defaultSubMenuMarker].! Item was added: + ----- Method: MenuItemMorph class>>defaultSubMenuMarker (in category 'defaults') ----- + defaultSubMenuMarker + + | f | + f := Form + extent: 5@9 + fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648) + offset: 0@0. + ^ ColorForm mappingWhiteToTransparentFrom: f! Item was changed: ----- Method: MenuItemMorph class>>initialize (in category 'class initialization') ----- initialize "MenuItemMorph initialize" + SubMenuMarker := self defaultSubMenuMarker. - | f | - f := Form - extent: 5@9 - fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648) - offset: 0@0. - SubMenuMarker := ColorForm mappingWhiteToTransparentFrom: f. ! Item was added: + ----- Method: MenuItemMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #font. 'Fonts'. 'Font for menu items.' }. + { #textColor. 'Colors'. 'Color for the menu item''s labels.' }. + { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }. + { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }. + { #subMenuMarker. 'Forms'. 'The form to be used to indicate a submenu.' }. + }! Item was added: + ----- Method: MenuItemMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self + color: (self userInterfaceTheme textColor ifNil: [Color black]); + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]). + ! Item was added: + ----- Method: MenuItemMorph>>colorToUse (in category 'accessing') ----- + colorToUse + + ^ isSelected & isEnabled + ifTrue: [ self userInterfaceTheme selectionTextColor ifNil: [Color white] ] + ifFalse: [ color ]! Item was added: + ----- Method: MenuItemMorph>>drawBackgroundOn: (in category 'drawing') ----- + drawBackgroundOn: aCanvas + + isSelected & isEnabled + ifTrue: [aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle].! Item was added: + ----- Method: MenuItemMorph>>drawIconOn: (in category 'drawing') ----- + drawIconOn: aCanvas + + self hasIcon ifTrue: [ + | iconForm | + iconForm := self iconForm. + aCanvas + translucentImage: iconForm + at: self bounds left @ (self top + (self height - iconForm height // 2)).].! Item was added: + ----- Method: MenuItemMorph>>drawLabelOn: (in category 'drawing') ----- + drawLabelOn: aCanvas + + | stringBounds | + stringBounds := bounds. + + self hasIcon ifTrue: [ + stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ]. + self hasMarker ifTrue: [ + stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8 ]. + + stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. + + aCanvas + drawString: contents + in: stringBounds + font: self fontToUse + color: self colorToUse.! Item was changed: ----- Method: MenuItemMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + + self + drawBackgroundOn: aCanvas; + drawIconOn: aCanvas; + drawLabelOn: aCanvas; + drawSubMenuMarkerOn: aCanvas.! - | stringColor stringBounds | - isSelected & isEnabled - ifTrue: [ - aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle. - stringColor := color negated ] - ifFalse: [ stringColor := color ]. - stringBounds := bounds. - self hasIcon ifTrue: [ - | iconForm | - iconForm := self iconForm. - aCanvas - translucentImage: iconForm - at: stringBounds left @ (self top + (self height - iconForm height // 2)). - stringBounds := stringBounds left: stringBounds left + iconForm width + 2 ]. - self hasMarker ifTrue: [ - stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8 ]. - stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2. - aCanvas - drawString: contents - in: stringBounds - font: self fontToUse - color: stringColor. - self hasSubMenu - ifTrue: [| subMenuMarker subMenuMarkerPosition | - subMenuMarker := self subMenuMarker. - subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2). - aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition ]! Item was added: + ----- Method: MenuItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') ----- + drawSubMenuMarkerOn: aCanvas + + self hasSubMenu ifTrue: [ + | subMenuMarker subMenuMarkerPosition | + subMenuMarker := self subMenuMarker. + subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2). + aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition ]! Item was changed: ----- Method: MenuItemMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" contents := ''. hasFocus := false. isEnabled := true. subMenu := nil. isSelected := false. target := nil. selector := nil. arguments := nil. + font := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. + self + color: (self userInterfaceTheme textColor ifNil: [Color black]); + hResizing: #spaceFill; + vResizing: #shrinkWrap! - font := Preferences standardMenuFont. - self hResizing: #spaceFill; - vResizing: #shrinkWrap! Item was changed: ----- Method: MenuItemMorph>>minWidth (in category 'layout') ----- minWidth | subMenuWidth iconWidth markerWidth | subMenuWidth := self hasSubMenu ifTrue: [ 10 ] ifFalse: [ 0 ]. iconWidth := self hasIcon ifTrue: [ self icon width + 2 ] ifFalse: [ 0 ]. markerWidth := self hasMarker ifTrue: [ self submorphBounds width + 8 ] ifFalse: [ 0 ]. ^(self fontToUse widthOfString: contents) + + subMenuWidth + iconWidth + markerWidth + self stringMargin! - + subMenuWidth + iconWidth + markerWidth! Item was changed: ----- Method: MenuItemMorph>>selectionFillStyle (in category 'private') ----- selectionFillStyle + " Answer the fill style to use with the receiver is the selected element " - " Answer the fill style to use with the receiver is the selected - element " + | fill baseColor | + baseColor := self userInterfaceTheme selectionColor ifNil: [Color r: 0.4 g: 0.5 b: 0.7]. - | fill baseColor preferenced | - Display depth <= 2 ifTrue: [ - ^Color gray ]. - preferenced := MenuMorph menuSelectionColor. - preferenced notNil ifTrue: [ ^preferenced ]. - baseColor := owner color negated. MenuMorph gradientMenu ifFalse: [ ^baseColor ]. + fill := GradientFillStyle ramp: { 0.0 -> baseColor twiceLighter. 1 -> baseColor twiceDarker }. fill origin: self topLeft. + fill direction: 0 @ self height. ^ fill! Item was added: + ----- Method: MenuItemMorph>>stringMargin (in category 'layout') ----- + stringMargin + + ^Preferences tinyDisplay + ifTrue: [ 1 ] + ifFalse: [ 6 ]! Item was changed: + Morph subclass: #MenuMorph - AlignmentMorph subclass: #MenuMorph instanceVariableNames: 'defaultTarget selectedItem stayUp popUpOwner activeSubMenu' classVariableNames: 'CloseBoxImage CloseBoxImageFlat CloseBoxImageGradient GradientMenu MenuBorderColor MenuBorderWidth MenuColor MenuLineColor MenuSelectionColor MenuTitleBorderColor MenuTitleBorderWidth MenuTitleColor PushPinImage RoundedMenuCorners' poolDictionaries: '' category: 'Morphic-Menus'! !MenuMorph commentStamp: '<historical>' prior: 0! Instance variables: defaultTarget <Object> The default target for creating menu items selectedItem <MenuItemMorph> The currently selected item in the receiver stayUp <Boolean> True if the receiver should stay up after clicks popUpOwner <MenuItemMorph> The menu item that automatically invoked the receiver, if any. activeSubMenu <MenuMorph> The currently active submenu.! Item was removed: - ----- Method: MenuMorph class>>menuBorderColor (in category 'preferences') ----- - menuBorderColor - - <preference: 'menuBorderColor' - category: #menus - description: 'Menus border color' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuBorderColor ifNil: [(Color r: 0.2 g: 0.3 b: 0.9)]! Item was removed: - ----- Method: MenuMorph class>>menuBorderColor: (in category 'preferences') ----- - menuBorderColor: aColor - MenuBorderColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuBorderWidth (in category 'preferences') ----- - menuBorderWidth - <preference: 'menuBorderWidth' - category: #menus - description: 'Menus border width' - type: #Number> - ^MenuBorderWidth ifNil: [2]! Item was removed: - ----- Method: MenuMorph class>>menuBorderWidth: (in category 'preferences') ----- - menuBorderWidth: anInteger - MenuBorderWidth := anInteger! Item was removed: - ----- Method: MenuMorph class>>menuColor (in category 'preferences') ----- - menuColor - <preference: 'menuColor' - category: #menus - description: 'Menus color' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuColor ifNil: [(Color r: 0.9 g: 0.9 b: 0.9)]! Item was removed: - ----- Method: MenuMorph class>>menuColor: (in category 'preferences') ----- - menuColor: aColor - MenuColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuLineColor (in category 'preferences') ----- - menuLineColor - <preference: 'menuLineColor' - category: #menus - description: 'Menus color of separating lines' - type: #Color> - ^MenuLineColor ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was removed: - ----- Method: MenuMorph class>>menuLineColor: (in category 'preferences') ----- - menuLineColor: aColor - MenuLineColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuSelectionColor (in category 'preferences') ----- - menuSelectionColor - <preference: 'menuSelectionColor' - category: #menus - description: 'Color of selected item in menu' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuSelectionColor ifNil: [(Color r: 0.4 g: 0.5 b: 0.7)]! Item was removed: - ----- Method: MenuMorph class>>menuSelectionColor: (in category 'preferences') ----- - menuSelectionColor: aColor - MenuSelectionColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderColor (in category 'preferences') ----- - menuTitleBorderColor - <preference: 'menuTitleBorderColor' - category: #menus - description: 'Border color of frame around menu title' - type: #Color> - Display depth <= 2 ifTrue: [^ Color black]. - ^MenuTitleBorderColor ifNil: [(Color r: 0.6 g: 0.7 b: 1)]! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderColor: (in category 'preferences') ----- - menuTitleBorderColor: aColor - MenuTitleBorderColor := aColor! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderWidth (in category 'preferences') ----- - menuTitleBorderWidth - <preference: 'menuTitleBorderWidth' - category: #menus - description: 'Width of frame around menus title' - type: #Number> - ^MenuTitleBorderWidth ifNil: [0]! Item was removed: - ----- Method: MenuMorph class>>menuTitleBorderWidth: (in category 'preferences') ----- - menuTitleBorderWidth: anInteger - MenuTitleBorderWidth := anInteger! Item was removed: - ----- Method: MenuMorph class>>menuTitleColor (in category 'preferences') ----- - menuTitleColor - <preference: 'menuTitleColor' - category: #menus - description: 'Color of background of menus title' - type: #Color> - Display depth = 1 ifTrue: [^ Color white]. - Display depth = 2 ifTrue: [^ Color gray]. - ^MenuTitleColor ifNil: [ Color transparent]! Item was removed: - ----- Method: MenuMorph class>>menuTitleColor: (in category 'preferences') ----- - menuTitleColor: aColor - MenuTitleColor := aColor! Item was added: + ----- Method: MenuMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #borderColor. 'Colors'. 'Color of the menu''s border.' }. + { #borderWidth. 'Borders'. 'Width of the menu''s border.' }. + { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. + { #color. 'Colors'. 'Background color of the menu.' }. + + { #titleBorderColor. 'Colors'. 'Color of the menu title border.' }. + { #titleBorderWidth. 'Geometry'. 'Width of the menu title border.' }. + { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }. + { #titleColor. 'Colors'. 'Background color of the menu'' title.' }. + { #titleFont. 'Fonts'. 'Font for menu title.' }. + { #titleTextColor. 'Colors'. 'Color for the menu title label.' }. + + { #lineColor. 'Colors'. 'Color of the separators between menu items.' }. + { #lineStyle. 'Colors'. 'Use border-style to change appearance.' }. + { #lineWidth. 'Geometry'. 'How big the separators should be.' }. + }! Item was changed: ----- Method: MenuMorph>>addLine (in category 'construction') ----- addLine "Append a divider line to this menu. Suppress duplicate lines." + + | colorToUse | + self hasItems ifFalse: [^ self]. + self lastSubmorph knownName = #line ifTrue: [^ self]. + + colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9]. + self addMorphBack: (Morph new + color: colorToUse; + hResizing: #spaceFill; + height: (self userInterfaceTheme lineWidth ifNil: [2]); + borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]); + borderColor: colorToUse; + borderWidth: 1; + name: #line; "see above" + yourself).! - self hasItems - ifFalse: [^ self]. - (self lastSubmorph isKindOf: MenuLineMorph) - ifFalse: [self addMorphBack: MenuLineMorph new] ! Item was changed: ----- Method: MenuMorph>>addStayUpIcons (in category 'construction') ----- addStayUpIcons + | title closeBox pinBox | - | title closeBox pinBox titleBarArea titleString | title := submorphs detect: [:ea | ea hasProperty: #titleString] + ifNone: [ + "Called too soon. Will add stay-up icons when title is added." + self setProperty: #needsTitlebarWidgets toValue: true. - ifNone: [self setProperty: #needsTitlebarWidgets toValue: true. ^ self]. closeBox := SystemWindowButton new target: self; actionSelector: #delete; labelGraphic: self class closeBoxImage; color: Color transparent; extent: self class closeBoxImage extent; borderWidth: 0. pinBox := SystemWindowButton new target: self; actionSelector: #stayUp:; arguments: {true}; labelGraphic: self class pushPinImage; color: Color transparent; extent: self class pushPinImage extent; borderWidth: 0. + Preferences noviceMode ifTrue: [ + closeBox setBalloonText: 'close this menu'. + pinBox setBalloonText: 'keep this menu up']. + + title + addMorphFront: closeBox; + addMorphBack: pinBox. + - Preferences noviceMode - ifTrue: [closeBox setBalloonText: 'close this menu'. - pinBox setBalloonText: 'keep this menu up']. - titleBarArea := AlignmentMorph newRow vResizing: #shrinkWrap; - layoutInset: 3; - color: MenuMorph menuTitleColor; - addMorphBack: closeBox; - addMorphBack: title; - addMorphBack: pinBox. - - title color: Color transparent. - - titleString := title - findDeepSubmorphThat: [:each | each respondsTo: #font: ] - ifAbsent: [StringMorph contents: String empty]. - titleString font: Preferences windowTitleFont. - self wantsRoundedCorners - ifTrue: [titleBarArea useRoundedCorners]. - - self addMorphFront: titleBarArea. - titleBarArea setProperty: #titleString toValue: (title valueOfProperty: #titleString). - title removeProperty: #titleString. self setProperty: #hasTitlebarWidgets toValue: true. self removeProperty: #needsTitlebarWidgets. self removeStayUpItems! Item was changed: ----- Method: MenuMorph>>addTitle:icon:updatingSelector:updateTarget: (in category 'construction') ----- addTitle: aString icon: aForm updatingSelector: aSelector updateTarget: aTarget + "Add a title line at the top of this menu Make aString its initial contents. If aSelector is not nil, then periodically obtain fresh values for its contents by sending aSelector to aTarget." + + | container fontToUse colorToUse labelArea | + + container := AlignmentMorph newRow. + self setTitleParametersFor: container. + + aForm ifNotNil: [:form | container addMorphBack: form asMorph]. - "Add a title line at the top of this menu Make aString its initial - contents. - If aSelector is not nil, then periodically obtain fresh values for - its - contents by sending aSelector to aTarget.." - | title titleContainer | - title := AlignmentMorph newColumn. - self setTitleParametersFor: title. - "" - aForm isNil - ifTrue: [titleContainer := title] - ifFalse: [| pair | - pair := AlignmentMorph newRow. + fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]. + colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black]. + + "Build the label." - pair color: Color transparent. - pair hResizing: #shrinkWrap. - pair layoutInset: 0. - pair addMorphBack: (Morph new extent: 5@5; color: Color transparent). "padding" - pair addMorphBack: aForm asMorph. - pair addMorphBack: (Morph new extent: 5@5; color: Color transparent). "padding" - titleContainer := AlignmentMorph newColumn. - titleContainer color: Color transparent. - titleContainer vResizing: #shrinkWrap. - titleContainer wrapCentering: #center. - titleContainer cellPositioning: #topCenter. - titleContainer layoutInset: 0. - pair addMorphBack: titleContainer. - "" - title addMorphBack: pair]. - "" aSelector + ifNil: [ + labelArea := AlignmentMorph newColumn + color: Color transparent; + vResizing: #shrinkWrap; + wrapCentering: #center; + cellPositioning: #topCenter. + aString asString linesDo: [:line | labelArea + addMorphBack: ((StringMorph contents: line + font: fontToUse) + color: colorToUse; - ifNil: ["" - aString asString - linesDo: [:line | titleContainer - addMorphBack: ((StringMorph - contents: line - font: Preferences standardMenuFont) - color: (Color black); yourself)]] + ifNotNil: [ + labelArea := UpdatingStringMorph on: aTarget selector: aSelector. + labelArea font: fontToUse. + labelArea color: colorToUse. + labelArea useStringFormat. + labelArea lock]. + + container addMorphBack: labelArea. - ifNotNil: [| usm | - usm := UpdatingStringMorph on: aTarget selector: aSelector. - usm font: Preferences standardMenuFont. - usm useStringFormat. - usm lock. - titleContainer addMorphBack: usm]. "" + container setProperty: #titleString toValue: aString. + self addMorphFront: container. - title setProperty: #titleString toValue: aString. - self addMorphFront: title. "" - title useSquareCorners. (self hasProperty: #needsTitlebarWidgets) ifTrue: [self addStayUpIcons]! Item was added: + ----- Method: MenuMorph>>applyUserInterfaceTheme (in category 'update') ----- + applyUserInterfaceTheme + + | colorToUse | + super applyUserInterfaceTheme. + + self setDefaultParameters. + + "Update properties of separating lines." + colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9]. + self submorphs + select: [:ea | ea knownName = #line] + thenDo: [:line | + line + color: colorToUse; + height: (self userInterfaceTheme lineWidth ifNil: [2]); + borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]); + borderColor: colorToUse].! Item was changed: ----- Method: MenuMorph>>initialize (in category 'initialization') ----- initialize super initialize. bounds := 0 @ 0 corner: 40 @ 10. self setDefaultParameters. + self changeTableLayout. self listDirection: #topToBottom. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. defaultTarget := nil. selectedItem := nil. stayUp := false. popUpOwner := nil.! Item was changed: ----- Method: MenuMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters "change the receiver's appareance parameters" + self + color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]); + borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); + borderWidth: (self userInterfaceTheme borderWidth ifNil: [1]). - | colorFromMenu worldColor menuColor | - - colorFromMenu := Preferences menuColorFromWorld - and: [Display depth > 4 - and: [(worldColor := self currentWorld color) isColor]]. + Preferences menuAppearance3d ifTrue: [self addDropShadow]. + - menuColor := colorFromMenu - ifTrue: [worldColor luminance > 0.7 - ifTrue: [worldColor mixed: 0.85 with: Color black] - ifFalse: [worldColor mixed: 0.4 with: Color white]] - ifFalse: [self class menuColor]. - - self color: menuColor. - self borderWidth: self class menuBorderWidth. - - Preferences menuAppearance3d ifTrue: [ - self borderStyle: BorderStyle thinGray. - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.666); - shadowOffset: 1 @ 1] - ifTrue: [ - self - shadowColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.0 alpha: 0.01); - shadowOffset: (10@8 corner: 10@12) ] - ] - ifFalse: [ - | menuBorderColor | - menuBorderColor := colorFromMenu - ifTrue: [worldColor muchDarker] - ifFalse: [self class menuBorderColor]. - self borderColor: menuBorderColor. - ]. - - self layoutInset: 3. ! Item was added: + ----- Method: MenuMorph>>setTitleParameters (in category 'initialization') ----- + setTitleParameters + + self setTitleParametersFor: (self allMorphs + detect: [:each | each hasProperty: #titleString] + ifNone: [^ self]).! Item was changed: ----- Method: MenuMorph>>setTitleParametersFor: (in category 'initialization') ----- setTitleParametersFor: aMenuTitle - | menuTitleColor menuTitleBorderColor | - self wantsRoundedCorners - ifTrue: [aMenuTitle useRoundedCorners]. - menuTitleColor := Preferences menuColorFromWorld - ifTrue: [self color darker] - ifFalse: [MenuMorph menuTitleColor]. - - menuTitleBorderColor := Preferences menuAppearance3d - ifTrue: [#inset] - ifFalse: [Preferences menuColorFromWorld - ifTrue: [self color darker muchDarker] - ifFalse: [MenuMorph menuTitleBorderColor]]. - aMenuTitle + color: (self userInterfaceTheme titleColor ifNil: [Color transparent]); + borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle default]); + borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]); + borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]); + cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]); - setColor: menuTitleColor - borderWidth: MenuMorph menuTitleBorderWidth - borderColor: menuTitleBorderColor; vResizing: #shrinkWrap; wrapCentering: #center; + cellPositioning: #center; + cellInset: 5; + layoutInset: (5@0 corner: 5@0).! - cellPositioning: #topCenter; - layoutInset: 0. - ! Item was changed: ----- Method: MenuMorph>>updateColor (in category 'control') ----- updateColor + | fill title cc | - | fill title | self class gradientMenu ifFalse: [^ self]. (self fillStyle == self color) not ifTrue: [^ self]. "Don't apply the gradient more than once" "" + title := self allMorphs + detect: [:each | each hasProperty: #titleString] + ifNone: []. + + cc := self color adjustSaturation: -0.08 brightness: 0.4. + fill := GradientFillStyle ramp: { + 0.0 -> (title ifNil: [cc] ifNotNil: [cc muchLighter]). + 0.25 -> (self color mixed: 0.5 with: cc). + 1.0 -> self color}. - fill := GradientFillStyle ramp: {0.0 -> Color white. 1 -> self color}. "" fill radial: false; origin: self topLeft; direction: 0 @ self height. "" - self fillStyle: fill. " update the title color" + + title ifNotNil: [fill direction: 0@ title height]. + self fillStyle: fill. + title ifNil: [^ self]. - title := self allMorphs - detect: [:each | each hasProperty: #titleString] - ifNone: [^ self]. "" + fill := GradientFillStyle ramp: { + 0.0 -> title color twiceLighter. + 1 -> title color twiceDarker}. - fill := GradientFillStyle ramp: {0.0 -> title color twiceLighter. 1 -> title color twiceDarker}. "" fill origin: title topLeft; direction: title width @ 0. "" title fillStyle: fill! Item was added: + ----- Method: TheWorldMainDockingBar class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + self updateInstances.! Item was added: + ----- Method: TheWorldMainDockingBar class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ { + { #textColor. 'Colors'. 'The color for the clock and other labels.' }. + { #font. 'Fonts'. 'The font for the clock and other labels.' }. + { #logoColor. 'Colors'. 'The color of the Squeak logo.' }. + { #selectionLogoColor. 'Colors'. 'The color of the Squeak logo when it is selected.' }. + }! Item was added: + ----- Method: TheWorldMainDockingBar>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + "Do it on the class-side."! Item was changed: ----- Method: TheWorldMainDockingBar>>clockOn: (in category 'right side') ----- clockOn: aDockingBar aDockingBar addMorphBack: (ClockMorph new + font: self fontToUse; + color: self colorToUse; show24hr: self class twentyFourHourClock; showSeconds: self class showSecondsInClock; yourself); addDefaultSpace! Item was added: + ----- Method: TheWorldMainDockingBar>>colorToUse (in category 'private') ----- + colorToUse + + ^ self userInterfaceTheme textColor ifNil: [Color black]! Item was changed: ----- Method: TheWorldMainDockingBar>>createDockingBar (in category 'construction') ----- createDockingBar "Create a docking bar from the receiver's representation" | dockingBar | dockingBar := DockingBarMorph new adhereToTop; color: MenuMorph menuColor; - gradientRamp: self gradientRamp; autoGradient: MenuMorph gradientMenu; borderWidth: 0. self fillDockingBar: dockingBar. self labelIfNeeded: dockingBar. ^ dockingBar! Item was added: + ----- Method: TheWorldMainDockingBar>>fontToUse (in category 'private') ----- + fontToUse + + ^ self userInterfaceTheme font ifNil: [TextStyle defaultFont]! Item was changed: ----- Method: TheWorldMainDockingBar>>squeakMenuOn: (in category 'construction') ----- squeakMenuOn: aDockingBar "Private - fill the given docking bar" aDockingBar addItem: [ :item | item contents: ''; + icon: (MenuIcons squeakLogoIconColorized: + (self userInterfaceTheme logoColor ifNil: [Color black])); + selectedIcon: (MenuIcons squeakLogoIconColorized: + (self userInterfaceTheme selectionLogoColor ifNil: [Color white])); - icon: MenuIcons squeakLogoIcon; - selectedIcon: MenuIcons squeakLogoInvertedIcon; addSubMenu: [ :menu | self aboutMenuItemOn: menu; updateMenuItemOn: menu. menu addLine. self saveMenuItemOn: menu; saveAsMenuItemOn: menu; saveAsNewVersionMenuItemOn: menu. menu addLine. self saveAndQuitMenuItemOn: menu; quitMenuItemOn: menu ] ]! Item was added: + (PackageInfo named: 'Morphic') postscript: 'MenuIcons initializeIcons. + TheWorldMainDockingBar updateInstances.'!

1 0

The Trunk: 51Deprecated-mt.36.mcz
by commits＠source.squeak.org 31 Jul '16

31 Jul '16

Marcel Taeumel uploaded a new version of 51Deprecated to project The Trunk: http://source.squeak.org/trunk/51Deprecated-mt.36.mcz ==================== Summary ==================== Name: 51Deprecated-mt.36 Author: mt Time: 31 July 2016, 10:56:06.86249 am UUID: 5dae79d1-829b-6046-82de-e00a2acb0379 Ancestors: 51Deprecated-mt.35 *** Widget Refactorings and UI Themes (Part 3 of 11) *** Prepare Shout syntax highlighting for UI themes. (Temporarily no syntax highlighting. Sorry. Be patient.) =============== Diff against 51Deprecated-mt.35 =============== Item was added: + ----- Method: SHTextStylerST80 class>>attributesByPixelHeight: (in category '*51Deprecated') ----- + attributesByPixelHeight: aNumber + + self deprecated: 'Use UI themes.'. + ^self textAttributesByPixelHeight + at: aNumber + ifAbsent: [Dictionary new]! Item was added: + ----- Method: SHTextStylerST80 class>>attributesFor:pixelHeight: (in category '*51Deprecated') ----- + attributesFor: aSymbol pixelHeight: aNumber + + self deprecated: 'Use UI themes.'. + ^(self textAttributesByPixelHeight + at: aNumber + ifAbsent:[Dictionary new]) + at: aSymbol ifAbsent:[nil]!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages July 2016