Squeak-dev July 2016

squeak-dev@lists.squeakfoundation.org

38 participants
224 discussions

The Trunk: Morphic-mt.1217.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.1217.mcz ==================== Summary ==================== Name: Morphic-mt.1217 Author: mt Time: 31 July 2016, 1:05:33.780679 pm UUID: 40eb6f6d-92d3-574f-8dd7-e13db762ba75 Ancestors: Morphic-mt.1216 Makes icon labels in scroll bar buttons visible again for Solarized and Monokai themes. Those have no distinct border color for scroll bar buttons, which is normally used for determining the color of the iconic labels. =============== Diff against Morphic-mt.1216 =============== Item was changed: ----- Method: ScrollBar>>imageColor (in category 'accessing') ----- imageColor + ^ slider ifNil: [Color black] ifNotNil: [:s | + (s color = s borderColor or: [s borderColor isTransparent]) + ifTrue: [s color adjustBrightness: (s color brightness < 0.5 ifTrue: [0.2] ifFalse: [-0.2])] + ifFalse: [s borderColor]]! - ^ slider ifNil: [Color black] ifNotNil: [:s | s borderColor]!

1 0

The Trunk: Morphic-mt.1216.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.1216.mcz ==================== Summary ==================== Name: Morphic-mt.1216 Author: mt Time: 31 July 2016, 11:47:41.295418 am UUID: 2829bb9f-b521-ec45-9252-77d6143b9dd5 Ancestors: Morphic-mt.1215 Small fix for the button border that was not updated correctly once a disabled button got enabled again. =============== Diff against Morphic-mt.1215 =============== Item was changed: ----- 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 borderStyle color: borderColor. - self borderColor: borderColor. self class gradientButton ifFalse: [ isPressing ifTrue: [ self color: feedbackColor. + self borderStyle color: feedbackColor muchDarker]. - self borderColor: feedbackColor muchDarker]. isHovering ifTrue: [ self color: hoverColor. + self borderStyle color: borderColor]. - 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.!

1 0

The Trunk: Morphic-mt.1215.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.1215.mcz ==================== Summary ==================== Name: Morphic-mt.1215 Author: mt Time: 31 July 2016, 11:34:33.618418 am UUID: 73cf8a9d-c030-5f48-a2de-6bf45a687362 Ancestors: Morphic-mt.1214 *** Widget Refactorings and UI Themes (Part 10 of 11) *** Drop shadow theme support and keyboard focus color theme support. =============== Diff against Morphic-mt.1214 =============== Item was added: + ----- Method: Morph class>>themeProperties (in category 'preferences') ----- + themeProperties + + | catName | + catName := 'Other'. + + ^{ + { #hardShadowColor. catName. 'The color of shadows. An alpha about 0.5 is recommended.' }. + { #hardShadowOffset. catName. 'The offset of the shadows behind the morph.' } . + { #softShadowColor. catName. 'The color of soft shadows. An alpha less than 0.05 is recommended.' }. + { #softShadowOffset. catName. 'The offset of soft shadows behind the morph.' } . + { #keyboardFocusColor. catName. 'The color of the keyboard focus indication.' }. + { #keyboardFocusWidth. catName. 'The width of the keyboard focus indication.' }. + }! Item was changed: ----- Method: Morph class>>useSoftDropShadow: (in category 'preferences') ----- useSoftDropShadow: aBoolean UseSoftDropShadow = aBoolean ifTrue: [^ self]. UseSoftDropShadow := aBoolean. SystemWindow refreshAllWindows. + DialogWindow refreshAllDialogs. SystemProgressMorph reset. TheWorldMainDockingBar updateInstances.! Item was changed: ----- Method: Morph>>addDropShadow (in category 'drop shadows') ----- addDropShadow + self + hasDropShadow: true; + shadowOffset: (self useSoftDropShadow + ifTrue: [self userInterfaceTheme softShadowOffset ifNil: [10@8 corner: 10@12]] + ifFalse: [self userInterfaceTheme hardShadowOffset ifNil: [1@1]]); + shadowColor: (self useSoftDropShadow + ifTrue: [self userInterfaceTheme softShadowColor ifNil: [Color black alpha: 0.01]] + ifFalse: [self userInterfaceTheme hardShadowColor ifNil: [Color black alpha: 0.5]]).! - self hasDropShadow: true. - - self useSoftDropShadow - ifFalse: [ - self - shadowOffset: 3@3; - shadowColor: (Color black alpha: 0.5)] - ifTrue: [ - self - shadowOffset: (10@8 corner: 10@12); - shadowColor: (Color black alpha: 0.01)].! Item was added: + ----- Method: Morph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + "Re-initialize the shadow. Ensure shadow cache invalidation." + self hasDropShadow ifTrue: [ + self addDropShadow. + self removeProperty: #dropShadow. + self changed].! Item was changed: ----- Method: Morph>>drawKeyboardFocusIndicationOn: (in category 'drawing') ----- drawKeyboardFocusIndicationOn: aCanvas self wantsRoundedCorners + ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self keyboardFocusWidth color: self keyboardFocusColor] + ifFalse: [aCanvas frameRectangle: self bounds width: self keyboardFocusWidth color: self keyboardFocusColor].! - ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius width: 3 "self borderStyle width" color: self keyboardFocusColor] - ifFalse: [aCanvas frameRectangle: self bounds width: 3 "self borderStyle width" color: self keyboardFocusColor].! Item was changed: ----- Method: Morph>>keyboardFocusColor (in category 'drawing') ----- keyboardFocusColor + ^ self userInterfaceTheme keyboardFocusColor ifNil: [TranslucentColor r: 0.3 g: 0.5 b: 0.5 alpha: 0.5]! - ^ Preferences keyboardFocusColor muchDarker alpha: 0.5! Item was added: + ----- Method: Morph>>keyboardFocusWidth (in category 'drawing') ----- + keyboardFocusWidth + + ^ self userInterfaceTheme keyboardFocusWidth ifNil: [3]! Item was changed: ----- Method: Morph>>shadowOffset: (in category 'drop shadows') ----- shadowOffset: aPoint "Set the current shadow offset" self shadowOffset = aPoint ifTrue: [^ self]. self changed. (aPoint isNil or: [ aPoint isZero ]) ifTrue:[self removeProperty: #shadowOffset] ifFalse:[self setProperty: #shadowOffset toValue: aPoint]. + self removeProperty: #dropShadow. self layoutChanged. self changed.!

1 0

The Trunk: Morphic-mt.1214.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.1214.mcz ==================== Summary ==================== Name: Morphic-mt.1214 Author: mt Time: 31 July 2016, 11:29:46.133418 am UUID: 0a02a7cb-3826-8d4f-9069-2b6b84a827ae Ancestors: Morphic-mt.1213 *** Widget Refactorings and UI Themes (Part 8 of 11) *** Adds minimal tool support for UI themes to world main docking bar's EXTRAS menu. =============== Diff against Morphic-mt.1213 =============== Item was changed: ----- Method: MenuMorph class>>gradientMenu: (in category 'preferences') ----- gradientMenu: aBoolean + GradientMenu = aBoolean ifTrue: [^ self]. GradientMenu := aBoolean. + + self flag: #refactor. "mt: Heavy use of the gradient-menu property..." - SystemProgressMorph reset. + SystemProgressMorph reset. + PluggableTextMorph flushAdornmentCache. + + MenuMorph allSubInstancesDo: [:ea | ea setDefaultParameters; setTitleParameters; updateColor]. + DockingBarMorph allSubInstancesDo: [:ea | ea setDefaultParameters; updateColor]. + + TheWorldMainDockingBar updateInstances. + PluggableListMorph allSubInstancesDo: [:ea | ea setListParameters]. + SimpleHierarchicalListMorph allSubInstancesDo: [:ea | ea setDefaultParameters]. + ! - "Update docking bars and their sub-menus." - ActiveWorld mainDockingBars do: [:bar | - bar - autoGradient: aBoolean; - updateColor]. - TheWorldMainDockingBar updateInstances.! Item was added: + ----- Method: TheWorldMainDockingBar>>editCurrentTheme (in category 'submenu - extras') ----- + editCurrentTheme + + UserInterfaceTheme current explore.! Item was changed: ----- Method: TheWorldMainDockingBar>>extrasMenuOn: (in category 'submenu - extras') ----- extrasMenuOn: aDockingBar aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. menu addLine. menu addItem:[:item| item + contents: 'Themes & Colors' translated; + subMenuUpdater: self + selector: #themesAndWindowColorsOn: ]. - contents: 'Window Colors' translated; - help: 'Changes the window color scheme' translated; - addSubMenu:[:submenu| self windowColorsOn: submenu]]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine information' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Standard Graphics Library' translated; help: 'Lets you view and change the system''s standard library of graphics' translated; target: ScriptingSystem; selector: #inspectFormDictionary]. menu addItem:[:item| item contents: 'Annotation Setup' translated; help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated; target: Preferences; selector: #editAnnotations]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! Item was added: + ----- Method: TheWorldMainDockingBar>>themesAndWindowColorsOn: (in category 'submenu - extras') ----- + themesAndWindowColorsOn: menu + + | themes | + themes := UserInterfaceTheme allThemes asArray sortBy: [:t1 :t2 | + t1 name <= t2 name]. + + menu addItem:[:item| + item + contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated; + target: self; + selector: #toggleColorfulWindows]. + menu addItem:[:item| + item + contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated; + target: self; + selector: #toggleGradients]. + menu addItem:[:item | + item + contents: ((Preferences valueOfFlag: #menuAppearance3d) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Shadows' translated; + target: self; + selector: #toggleShadows]. + menu addItem:[:item | + item + contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Widget Look' translated; + target: self; + selector: #toggleRoundedLook]. + + + menu addLine. + + themes ifEmpty: [ + menu addItem: [ :item | + item + contents: '(No UI themes found.)' translated; + isEnabled: false ] ]. + themes do: [ :each | + menu addItem: [ :item | + item + contents: (UserInterfaceTheme current == each ifTrue: ['<yes>'] ifFalse: ['<no>']), each name; + target: each; + selector: #apply ] ]. + menu + addLine; + add: 'Edit Current UI Theme...' target: self selector: #editCurrentTheme.! Item was added: + ----- Method: TheWorldMainDockingBar>>toggleColorfulWindows (in category 'submenu - extras') ----- + toggleColorfulWindows + + Model useColorfulWindows: Model useColorfulWindows not.! Item was added: + ----- Method: TheWorldMainDockingBar>>toggleGradients (in category 'submenu - extras') ----- + toggleGradients + + | switch | + switch := SystemWindow gradientWindow not. + + SystemWindow gradientWindow: switch. + DialogWindow gradientDialog: switch. + MenuMorph gradientMenu: switch. + ScrollBar gradientScrollBar: switch. + PluggableButtonMorph gradientButton: switch.! Item was added: + ----- Method: TheWorldMainDockingBar>>toggleRoundedLook (in category 'submenu - extras') ----- + toggleRoundedLook + + | switch | + switch := SystemWindow roundedWindowCorners not. + + SystemWindow roundedWindowCorners: switch. + DialogWindow roundedDialogCorners: switch. + PluggableButtonMorph roundedButtonCorners: switch. + MenuMorph roundedMenuCorners: switch. + ScrollBar roundedScrollBarLook: switch.! Item was added: + ----- Method: TheWorldMainDockingBar>>toggleShadows (in category 'submenu - extras') ----- + toggleShadows + + Preferences toggle: #menuAppearance3d.! Item was removed: - ----- Method: TheWorldMainDockingBar>>windowColorsOn: (in category 'construction') ----- - windowColorsOn: menu - - menu addItem:[:item| - item - contents: 'Gray Windows' translated; - help: 'Use uniform window colors' translated; - target: Preferences; - selector: #installUniformWindowColors]. - - menu addItem:[:item| - item - contents: 'Colorful Windows' translated; - help: 'Use normal window colors' translated; - target: Preferences; - selector: #installNormalWindowColors]. - - menu addLine. - - menu addItem:[:item| - item - contents: 'Bright-colored Windows' translated; - help: 'Use bright window colors' translated; - target: Preferences; - selector: #installBrightWindowColors]. - - menu addItem:[:item| - item - contents: 'Pastel-colored Windows' translated; - help: 'Use pastel window colors' translated; - target: Preferences; - selector: #installPastelWindowColors]. - ! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! - (PackageInfo named: 'Morphic') postscript: 'ScrollBar initializeImagesCache. - LazyListMorph allSubInstancesDo: [:ea | ea resetFilterOffsets]. - PluggableTextMorph flushAdornmentCache.'!

1 0

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

31 Jul '16

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.854.mcz ==================== Summary ==================== Name: System-mt.854 Author: mt Time: 31 July 2016, 11:27:38.353418 am UUID: b8b7f590-e108-a54f-8217-2ba1b4fd793d Ancestors: System-mt.853 *** Widget Refactorings and UI Themes (Part 7 of 11) *** Look-up and store default fonts in the current theme. =============== Diff against System-mt.853 =============== Item was changed: ----- Method: Preferences class>>setBalloonHelpFontTo: (in category 'prefs - fonts') ----- setBalloonHelpFontTo: aFont + UserInterfaceTheme current + set: #balloonHelpFont + to: aFont; + apply.! - Smalltalk at: #BalloonMorph ifPresent: - [:thatClass | thatClass setBalloonFontTo: aFont]! Item was changed: ----- Method: Preferences class>>setButtonFontTo: (in category 'prefs - fonts') ----- setButtonFontTo: aFont + + UserInterfaceTheme current + set: #standardButtonFont + to: aFont; + apply.! - Parameters at: #standardButtonFont put: aFont! Item was changed: ----- Method: Preferences class>>setCodeFontTo: (in category 'prefs - fonts') ----- setCodeFontTo: aFont "Establish the code font." + UserInterfaceTheme current + set: #standardCodeFont + to: aFont; + apply.! - Parameters at: #standardCodeFont put: aFont! Item was changed: ----- Method: Preferences class>>setEToysFontTo: (in category 'prefs - fonts') ----- setEToysFontTo: aFont "change the font used in eToys environment" + + UserInterfaceTheme current + set: #eToysFont + to: aFont; + apply.! - Parameters at: #eToysFont put: aFont! Item was changed: ----- Method: Preferences class>>setEToysTitleFontTo: (in category 'prefs - fonts') ----- setEToysTitleFontTo: aFont "change the font used in eToys environment" + + UserInterfaceTheme current + set: #eToysTitleFont + to: aFont; + apply.! - Parameters at: #eToysTitleFont put: aFont! Item was changed: ----- Method: Preferences class>>setFlapsFontTo: (in category 'prefs - fonts') ----- setFlapsFontTo: aFont + UserInterfaceTheme current + set: #standardFlapFont + to: aFont; + apply. + + "FlapTab allSubInstancesDo: + [:aFlapTab | aFlapTab reformatTextualTab]"! - Parameters at: #standardFlapFont put: aFont. - FlapTab allSubInstancesDo: - [:aFlapTab | aFlapTab reformatTextualTab]! Item was changed: ----- Method: Preferences class>>setHaloLabelFontTo: (in category 'prefs - fonts') ----- setHaloLabelFontTo: aFont "change the font used in eToys environment" + + UserInterfaceTheme current + set: #haloLabelFont + to: aFont; + apply.! - Parameters at: #haloLabelFont put: aFont! Item was changed: ----- Method: Preferences class>>setListFontTo: (in category 'prefs - fonts') ----- setListFontTo: aFont "Set the list font as indicated" + UserInterfaceTheme current + set: #standardListFont + to: aFont; + apply. + + "Smalltalk at: #ListParagraph ifPresent: [:lp | lp initialize]. + Smalltalk at: #Flaps ifPresent: [:flaps | flaps replaceToolsFlap]"! - Parameters at: #standardListFont put: aFont. - Smalltalk at: #ListParagraph ifPresent: [:lp | lp initialize]. - Smalltalk at: #Flaps ifPresent: [:flaps | flaps replaceToolsFlap]! Item was changed: ----- Method: Preferences class>>setMenuFontTo: (in category 'prefs - fonts') ----- setMenuFontTo: aFont + + UserInterfaceTheme current + set: #standardMenuFont + to: aFont; + apply. + + "Smalltalk at: #PopUpMenu ifPresent:[:aClass| aClass setMenuFontTo: aFont]. + TheWorldMainDockingBar updateInstances."! - "rbb 2/18/2005 12:54 - How should this be changed to work - with the UIManager, if at all?" - Parameters at: #standardMenuFont put: aFont. - Smalltalk at: #PopUpMenu ifPresent:[:aClass| aClass setMenuFontTo: aFont]. - TheWorldMainDockingBar updateInstances.! Item was changed: ----- Method: Preferences class>>setPaintBoxButtonFontTo: (in category 'prefs - fonts') ----- setPaintBoxButtonFontTo: aFont "change the font used in the buttons in PaintBox." + + UserInterfaceTheme current + set: #paintBoxButtonFont + to: aFont; + apply.! - Parameters at: #paintBoxButtonFont put: aFont! Item was changed: ----- Method: Preferences class>>setWindowTitleFontTo: (in category 'prefs - fonts') ----- setWindowTitleFontTo: aFont "Set the window-title font to be as indicated" + UserInterfaceTheme current + set: #windowTitleFont + to: aFont; + apply. + + "(Smalltalk hasClassNamed: #StandardSystemView) - Parameters at: #windowTitleFont put: aFont. - (Smalltalk hasClassNamed: #StandardSystemView) ifTrue: [(Smalltalk at: #StandardSystemView) setLabelStyle]. (Smalltalk hasClassNamed: #Flaps) + ifTrue: [(Smalltalk at: #Flaps) replaceToolsFlap]" - ifTrue: [(Smalltalk at: #Flaps) replaceToolsFlap] ! Item was changed: ----- Method: Preferences class>>standardBalloonHelpFont (in category 'prefs - fonts') ----- standardBalloonHelpFont + + ^ (UserInterfaceTheme current get: #balloonHelpFont) + ifNil: [TextStyle defaultFont]! - ^BalloonMorph balloonFont! Item was changed: ----- Method: Preferences class>>standardButtonFont (in category 'prefs - fonts') ----- standardButtonFont + + ^ (UserInterfaceTheme current get: #standardButtonFont) + ifNil: [TextStyle defaultFont]! - "Answer an attractive font to use for buttons" - "Answer the font to be used for textual flap tab labels" - ^ Parameters - at: #standardButtonFont - ifAbsentPut: [StrikeFont familyName: #ComicBold size: 16]! Item was changed: ----- Method: Preferences class>>standardCodeFont (in category 'prefs - fonts') ----- standardCodeFont + + ^ (UserInterfaceTheme current get: #standardCodeFont) + ifNil: [TextStyle defaultFont]! - "Answer the font to be used in code" - ^ Parameters at: #standardCodeFont ifAbsentPut: [TextStyle defaultFont]! Item was changed: ----- Method: Preferences class>>standardDefaultTextFont (in category 'prefs - fonts') ----- standardDefaultTextFont + + ^ (UserInterfaceTheme current get: #standardDefaultTextFont) + ifNil: [TextStyle defaultFont]! - ^TextStyle defaultFont! Item was changed: ----- Method: Preferences class>>standardEToysFont (in category 'prefs - fonts') ----- standardEToysFont + + ^ (UserInterfaceTheme current get: #eToysFont) + ifNil: [self standardButtonFont]! - "Answer the font to be used in the eToys environment" - ^ Parameters at: #eToysFont ifAbsentPut: [self standardButtonFont]! Item was changed: ----- Method: Preferences class>>standardEToysTitleFont (in category 'prefs - fonts') ----- standardEToysTitleFont + + ^ (UserInterfaceTheme current get: #eToysTitleFont) + ifNil: [self standardEToysFont]! - "Answer the font to be used in the eToys environment" - ^ Parameters at: #eToysTitleFont ifAbsentPut: [self standardEToysFont]! Item was changed: ----- Method: Preferences class>>standardFlapFont (in category 'prefs - fonts') ----- standardFlapFont + + ^ (UserInterfaceTheme current get: #standardFlapFont) + ifNil: [self standardButtonFont]! - "Answer the font to be used for textual flap tab labels" - ^ Parameters at: #standardFlapFont ifAbsentPut: [self standardButtonFont]! Item was changed: ----- Method: Preferences class>>standardHaloLabelFont (in category 'prefs - fonts') ----- standardHaloLabelFont + + ^ (UserInterfaceTheme current get: #haloLabelFont) + ifNil: [TextStyle defaultFont]! - "Answer the font to be used in the eToys environment" - ^ Parameters at: #haloLabelFont ifAbsentPut: [TextStyle defaultFont]! Item was changed: ----- Method: Preferences class>>standardListFont (in category 'prefs - fonts') ----- standardListFont + + ^ (UserInterfaceTheme current get: #standardListFont) + ifNil: [TextStyle defaultFont]! - "Answer the font to be used in lists" - ^ Parameters at: #standardListFont ifAbsentPut: [TextStyle defaultFont]! Item was changed: ----- Method: Preferences class>>standardMenuFont (in category 'prefs - fonts') ----- standardMenuFont + + ^ (UserInterfaceTheme current get: #standardMenuFont) + ifNil: [TextStyle defaultFont]! - "Answer the font to be used in menus" - ^ Parameters at: #standardMenuFont ifAbsentPut: [TextStyle defaultFont]! Item was changed: ----- Method: Preferences class>>standardPaintBoxButtonFont (in category 'prefs - fonts') ----- standardPaintBoxButtonFont + + ^ (UserInterfaceTheme current get: #paintBoxButtonFont) + ifNil: [self standardButtonFont]! - "Answer the font to be used in the eToys environment" - ^ Parameters at: #paintBoxButtonFont ifAbsentPut: [self standardButtonFont]! Item was changed: ----- Method: Preferences class>>standardSystemFont (in category 'prefs - fonts') ----- standardSystemFont "Answer the standard system font " + ^ (UserInterfaceTheme current get: #standardSystemFont) + ifNil: [TextStyle defaultFont]! - ^(TextConstants at: #DefaultTextStyle) defaultFont! Item was changed: ----- Method: Preferences class>>windowTitleFont (in category 'prefs - fonts') ----- windowTitleFont "Answer the standard font to use for window titles" + + ^ (UserInterfaceTheme current get: #windowTitleFont) + ifNil: [TextStyle defaultFont]! - ^ Parameters at: #windowTitleFont ifAbsentPut: [StrikeFont familyName: #NewYork size: 15]!

1 0

The Trunk: 51Deprecated-mt.38.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.38.mcz ==================== Summary ==================== Name: 51Deprecated-mt.38 Author: mt Time: 31 July 2016, 11:24:23.37849 am UUID: 165d2c29-2c81-c841-a85c-a60b5a222130 Ancestors: 51Deprecated-mt.37 *** 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 51Deprecated-mt.37 =============== Item was added: + ----- Method: NewParagraph>>insertionPointColor (in category '*51Deprecated') ----- + insertionPointColor + self focused ifFalse: [^ Color transparent]. + ^ Display depth <= 2 + ifTrue: [Color black] + ifFalse: [Preferences insertionPointColor]! Item was added: + ----- Method: ScrollBar class>>createArrowOfDirection:in: (in category '*51Deprecated') ----- + 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 added: + ----- Method: ScrollBar class>>createBoxIn: (in category '*51Deprecated') ----- + 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 added: + ----- Method: ScrollBar class>>updateScrollBarButtonAspect:color: (in category '*51Deprecated') ----- + 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 added: + ----- Method: ScrollBar class>>updateScrollBarButtonsAspect:color: (in category '*51Deprecated') ----- + updateScrollBarButtonsAspect: aCollection color: aColor + "update aCollection of morphs with aColor" + + + aCollection + do: [:each | self updateScrollBarButtonAspect: each color: aColor]! Item was added: + ----- Method: ScrollBar class>>verticesForComplexArrow: (in category '*51Deprecated') ----- + 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 added: + ----- Method: ScrollBar class>>verticesForSimpleArrow: (in category '*51Deprecated') ----- + 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 added: + ----- Method: ScrollBar>>scrollDown (in category '*51Deprecated') ----- + 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 added: + ----- Method: ScrollBar>>scrollUp (in category '*51Deprecated') ----- + scrollUp + self flag: #obsolete. + upButton eventHandler: nil. + upButton on: #mouseDown send: #scrollUpInit to: self. + upButton on: #mouseUp send: #finishedScrolling to: self. + ^self scrollUpInit!

1 0

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

31 Jul '16

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.711.mcz ==================== Summary ==================== Name: Tools-mt.711 Author: mt Time: 31 July 2016, 11:23:32.11449 am UUID: 51307e24-030b-e046-a6f0-332c36d3a3ef Ancestors: Tools-mt.710 *** 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 Tools-mt.710 =============== Item was changed: ----- Method: PointerExplorerWrapper>>preferredColor (in category 'accessing') ----- preferredColor ^self isWeakOnly ifTrue: [ Color gray ] + ifFalse: [ super preferredColor ]! - ifFalse: [ Color black ]!

1 0

The Trunk: ToolBuilder-Morphic-mt.175.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.175.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.175 Author: mt Time: 31 July 2016, 11:22:46.85449 am UUID: 2aeb6aa3-4498-394f-90dc-d8192d0e8ef9 Ancestors: ToolBuilder-Morphic-mt.174 *** 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 ToolBuilder-Morphic-mt.174 =============== Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableList: (in category 'widgets required') ----- buildPluggableList: aSpec | widget listClass getIndex setIndex | aSpec getSelected ifNil:[ listClass := self listClass. getIndex := aSpec getIndex. setIndex := aSpec setIndex. ] ifNotNil:[ listClass := self listByItemClass. getIndex := aSpec getSelected. setIndex := aSpec setSelected. ]. widget := listClass on: aSpec model list: aSpec list selected: getIndex changeSelected: setIndex menu: aSpec menu keystroke: aSpec keyPress. self register: widget id: aSpec name. "Override default scroll bar policies if needed. Widget will use preference values otherwise." aSpec hScrollBarPolicy ifNotNil: [:policy | policy caseOf: { [#always] -> [widget alwaysShowHScrollBar]. [#never] -> [widget hideHScrollBarIndefinitely]. [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ]. aSpec vScrollBarPolicy ifNotNil: [:policy | policy caseOf: { [#always] -> [widget alwaysShowVScrollBar]. [#never] -> [widget hideVScrollBarIndefinitely]. [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ]. widget getListElementSelector: aSpec listItem. widget getListSizeSelector: aSpec listSize. widget getIconSelector: aSpec icon. widget getHelpSelector: aSpec helpItem. widget doubleClickSelector: aSpec doubleClick. widget dragItemSelector: aSpec dragItem. widget dropItemSelector: aSpec dropItem. widget wantsDropSelector: aSpec dropAccept. widget dragStartedSelector: aSpec dragStarted. widget autoDeselect: aSpec autoDeselect. widget keystrokePreviewSelector: aSpec keystrokePreview. + aSpec color ifNotNil: [:c | widget color: c]. - widget - borderWidth: 1; - borderColor: Color lightGray; - color: (aSpec color - ifNil: [Color white] - ifNotNil: [aSpec color]). - self buildHelpFor: widget spec: aSpec. self setFrame: aSpec frame in: widget. self setLayoutHintsFor: widget spec: aSpec. parent ifNotNil:[self add: widget to: parent]. panes ifNotNil:[ aSpec list ifNotNil:[panes add: aSpec list]. ]. ^widget! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableScrollPane: (in category 'widgets optional') ----- buildPluggableScrollPane: spec | widget panel | widget := self scrollPaneClass new. widget model: spec model. self register: widget id: spec name. spec children ifNotNil: [:obj | "Create panel morph to scroll it." panel := self pluggablePanelSpec new model: spec model; children: obj; layout: spec layout; horizontalResizing: (spec layout == #proportional ifTrue: [#rigid] ifFalse: [#shrinkWrap]); verticalResizing: (spec layout == #proportional ifTrue: [#rigid] ifFalse: [#shrinkWrap]); buildWith: self. widget morph: panel. ] ifNil: [spec morph ifNotNil: [:m | widget morph: m] ifNil: [widget morphClass: spec morphClass]]. self setFrame: spec frame in: widget. self setLayoutHintsFor: widget spec: spec. parent ifNotNil: [self add: widget to: parent]. + spec borderWidth ifNotNil: [:w | widget borderWidth: w]. - widget borderWidth: spec borderWidth. "Override default scroll bar policies if needed. Widget will use preference values otherwise." spec hScrollBarPolicy ifNotNil: [:policy | policy caseOf: { [#always] -> [widget alwaysShowHScrollBar]. [#never] -> [widget hideHScrollBarIndefinitely]. [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]}]. spec vScrollBarPolicy ifNotNil: [:policy | policy caseOf: { [#always] -> [widget alwaysShowVScrollBar]. [#never] -> [widget hideVScrollBarIndefinitely]. [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]}]. ^ widget! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableText: (in category 'widgets required') ----- buildPluggableText: aSpec | widget | widget := self textPaneClass new. aSpec stylerClass ifNotNil: [:c | widget styler: (c new view: widget)]. widget on: aSpec model text: aSpec getText accept: aSpec setText readSelection: aSpec selection menu: aSpec menu. aSpec font ifNotNil: [:f | widget font: f]. widget readOnly: aSpec readOnly. widget editTextSelector: aSpec editText. widget wantsFrameAdornments: aSpec indicateUnacceptedChanges. widget askBeforeDiscardingEdits: aSpec askBeforeDiscardingEdits. widget setProperty: #alwaysAccept toValue: aSpec askBeforeDiscardingEdits not. aSpec softLineWrap ifNotNil: [:b | widget wrapFlag: b]. widget isAutoFit ifTrue: [widget hideHScrollBarIndefinitely] ifFalse: [widget showHScrollBarOnlyWhenNeeded]. self register: widget id: aSpec name. widget getColorSelector: aSpec color. self buildHelpFor: widget spec: aSpec. self setFrame: aSpec frame in: widget. self setLayoutHintsFor: widget spec: aSpec. parent ifNotNil:[self add: widget to: parent]. - widget borderColor: Color lightGray. - widget color: Color white. ^widget! Item was changed: ----- Method: PluggableTextMorphPlus>>drawBalloonTextOn: (in category 'drawing') ----- drawBalloonTextOn: aCanvas "Show balloon text in the text morph if it has no contents." textMorph contents ifNotEmpty: [ ^ self ]. ([ self balloonText ] on: Error do: [ : err | 'error in balloonText' ]) ifNotNil: [ : text | aCanvas drawString: text in: (self innerBounds insetBy: (5 @ 2 corner: 0 @ 0)) + font: (self userInterfaceTheme balloonTextFont ifNil: [TextStyle defaultFont]) + color: (self userInterfaceTheme balloonTextColor ifNil: [Color gray: 0.7]) ]! - font: textMorph textStyle defaultFont "I want italic here" - color: (Color gray: 0.7) ]!

1 0

The Trunk: ToolBuilder-Kernel-mt.101.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.101.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-mt.101 Author: mt Time: 31 July 2016, 11:22:04.71649 am UUID: b332ef4d-c896-ad4c-acfc-1f1e3a6cb96d Ancestors: ToolBuilder-Kernel-mt.100 *** 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 ToolBuilder-Kernel-mt.100 =============== Item was changed: ----- Method: PluggableScrollPaneSpec>>borderWidth (in category 'accessing') ----- borderWidth + ^ borderWidth! - ^ borderWidth ifNil: [1]!

1 0

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

Jump to page: