Skip to content

Commit

Permalink
60402
Browse files Browse the repository at this point in the history
19728 Integrate Sublimish theme
	https://pharo.fogbugz.com/f/cases/19728

18460 FileLists "more..." menu item in preview panes context menu does not work
	https://pharo.fogbugz.com/f/cases/18460

http://files.pharo.org/image/60/60402.zip
  • Loading branch information
Jenkins Build Server authored and ci committed Feb 20, 2017
1 parent fa70f97 commit 986ba23
Show file tree
Hide file tree
Showing 146 changed files with 783 additions and 31 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -274,6 +274,7 @@ baseline: spec
spec package: 'SmartSuggestions-Tests'.
spec package: 'Spec-Help'.
spec package: 'Spec-Tests'.
spec package: 'SublimishTheme'.
spec package: 'System-CachingTests'.
spec package: 'System-History-Tests'.
spec package: 'System-Localization-Tests'.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -461,6 +461,9 @@ spec group: 'Kernel-Tests-Group' with: #(
'Text-Tests' "required by Multilingual-Tests"
).

spec group: 'Themes-Group' with: #(
'SublimishTheme'
).

spec group: 'GT&QA-Group' with: #(
'GeneralRules' "depends on QA, needs cleanup"
Expand Down Expand Up @@ -516,4 +519,5 @@ spec group: #default with: #(
'Optional-Group'
'Versionner-Group'
'General-Tests-Group'
'Themes-Group'
).
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
script60401
script60402

^ 'AST-Core-TheIntegrator.492.mcz
AST-Tests-Core-TheIntegrator.134.mcz
Expand All @@ -17,7 +17,7 @@ Balloon-TheIntegrator.139.mcz
Balloon-Tests-TheIntegrator.2.mcz
BaselineOfBasicTools-TheIntegrator.6.mcz
BaselineOfDisplay-TheIntegrator.4.mcz
BaselineOfIDE-TheIntegrator.19.mcz
BaselineOfIDE-TheIntegrator.22.mcz
BaselineOfMetacello-EstebanLorenzano.89.mcz
BaselineOfMorphic-TheIntegrator.19.mcz
BaselineOfMorphicCore-TheIntegrator.7.mcz
Expand Down Expand Up @@ -334,6 +334,7 @@ Spec-PolyWidgets-TheIntegrator.93.mcz
Spec-Tests-TheIntegrator.104.mcz
Spec-Tools-TheIntegrator.382.mcz
StartupPreferences-TheIntegrator.153.mcz
SublimishTheme-TheIntegrator.9.mcz
System-Announcements-TheIntegrator.138.mcz
System-BasicCommandLineHandler-TheIntegrator.18.mcz
System-Caching-TheIntegrator.29.mcz
Expand Down Expand Up @@ -385,7 +386,7 @@ Tool-DependencyAnalyser-Test-Data-ChristopheDemarey.2.mcz
Tool-DependencyAnalyser-UI-ChristopheDemarey.54.mcz
Tool-Diff-TheIntegrator.47.mcz
Tool-ExternalBrowser-TheIntegrator.57.mcz
Tool-FileList-TheIntegrator.92.mcz
Tool-FileList-TheIntegrator.94.mcz
Tool-FileList-Tests-EstebanLorenzano.3.mcz
Tool-Finder-TheIntegrator.78.mcz
Tool-ImageCleaner-TheIntegrator.19.mcz
Expand Down

This file was deleted.

Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
update60402
"self new update60402"
self withUpdateLog: '19728 Integrate Sublimish theme
https://pharo.fogbugz.com/f/cases/19728
18460 FileLists "more..." menu item in preview panes context menu does not work
https://pharo.fogbugz.com/f/cases/18460'.
self loadTogether: self script60402 merge: false.
self flushCaches.
Original file line number Diff line number Diff line change
@@ -1,12 +1,6 @@
commentForCurrentUpdate
^ '19488 STONWriterTests>>#testDictionaryWithComplexKeys is order dependent
https://pharo.fogbugz.com/f/cases/19488
^ '19728 Integrate Sublimish theme
https://pharo.fogbugz.com/f/cases/19728
18584 DNU on showing menu in PointerExplorer
https://pharo.fogbugz.com/f/cases/18584
18459 FileList calls unimplemented method allRegisteredServices
https://pharo.fogbugz.com/f/cases/18459
18724 DNU EyeTreeInspector workspace pane context menu
https://pharo.fogbugz.com/f/cases/18724'
18460 FileLists "more..." menu item in preview panes context menu does not work
https://pharo.fogbugz.com/f/cases/18460'
1 change: 1 addition & 0 deletions SublimishTheme.package/SublimishTheme.class/README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
A dark theme for Pharo. If you like Sublime then you'll like Sublimish theme.Original source: https://github.com/sebastianconcept/SublimishTheme
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
baseColor

^ Color fromHexString: '3e3d32'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
basePassiveBackgroundColor
^ Color darkGray
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
baseSelectionColor
^ Color fromHexString: '49483E'
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
darkBaseColor
^ self baseColor darker darker
"^ Color veryDarkGray"
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
lightBaseColor
^ self baseColor lighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
lightSelectionColor
^ Color fromHexString: '49483E'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
themeName
^ 'Sublimish'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
veryLightSelectionColor
^ self lightSelectionColor muchLighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
importIcons: icons fromFolder: aString inClass: aClass category: aCategory
icons
do: [:each |
| method form |
form := PNGReadWriter formFromFileNamed: aString, '/', each , '.png'.
method := each , Character cr asString ,
(aClass methodStart: each),
form storeString,
aClass methodEnd.
aClass class compile: method classified: aCategory ].
aClass initialize
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
newDefaultSettings
self setPreferredPreferences.

^super newDefaultSettings
menuColor: self baseColor;
menuTitleColor: self baseColor;
windowColor: self baseColor;
selectionColor: self lightSelectionColor;
menuSelectionColor: self baseSelectionColor;
progressBarColor: self baseColor;
standardColorsOnly: true;
autoSelectionColor: false;
preferRoundCorner: false;
fadedBackgroundWindows: false;
secondarySelectionColor: self veryLightSelectionColor;
flatMenu: true
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
setPreferredPreferences
"NECPreferences
expandPrefixes: true;
popupShowWithShortcut: Character tab asShortcut."
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
isAbstract
"Answer whether the receiver is considered to be abstract."

^false
5 changes: 5 additions & 0 deletions SublimishTheme.package/SublimishTheme.class/definition.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
Pharo3DarkTheme subclass: #SublimishTheme
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'SublimishTheme'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
backgroundColor
^ Color fromHexString: '262720'
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
balloonBackgroundColor

^Color veryDarkGray lighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
borderColor
^ Color darkGray darker darker
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
buttonColor
^ self backgroundColor lighter lighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
caretColor
^ self backgroundColor muchLighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
disabledColor
^ Color veryLightGray muchLighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
enabledColor
^ self textColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
lightBackgroundColor
^ Color r: 0.218 g: 0.217 b: 0.217
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
listTextColor
"Answer the list text color to use."

^ self textColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
menuBorderColor
^ self borderColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
menuBorderWidth
^ self borderWidth
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
scrollbarColor
^ self buttonColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
secondarySelectionColor
^ self selectionColor darker
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
selectionColor
^ Color fromHexString: '49483E'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
selectionTextColor
^ Color r: 16rE0 g: 16rE2 b: 16rE4 range: 255
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
spotlightWindowColor
^ self windowColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
textColor

^ Color fromHexString: 'FCF3D7'
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
textColorForNonStandardBackground
^ Color black
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
unfocusedSelectionColor
^ self secondarySelectionColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
subgroupColorFrom: paneColor
"Answer the colour for a subgroup given the pane colour."

^ self glamorousLightColorFor: paneColor" self class baseColor"
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
taskbarButtonLabelColorForCollapsed: aButton
"Answer the colour for the label of the given taskbar button, given that the corresponding window is collapsed."

^ self textColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
taskbarButtonLabelColorForExpanded: aButton
"Answer the colour for the label of the given taskbar button, given that the corresponding window is expanded."

^ self textColor
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
taskbarButtonLabelColorFor: aButton
"Answer the colour for the label of the given taskbar button."

^aButton model
ifNil: [super taskbarButtonLabelColorFor: aButton]
ifNotNil: [:win |
win isActive
ifTrue: [Color black]
ifFalse: [Color gray darker]]
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
buttonCornerStyleIn: aThemedMorph
"If asked, we only allow square corners"

^ #square
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
buttonNormalBorderStyleFor: aButton
"Return the normal button borderStyle for the given button."

(aButton valueOfProperty: #noBorder ifAbsent: [ false ])
ifTrue: [
^ SimpleBorder new
width: 0;
baseColor: Color transparent ].

^ SimpleBorder new
width: 1;
baseColor: self buttonColor lighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
scrollbarNormalFillStyleFor: aScrollbar
"Return the normal scrollbar fillStyle for the given scrollbar."

^ SolidFillStyle color: self backgroundColor lighter.
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
scrollbarNormalThumbBorderStyleFor: aScrollbar
"Return the normal thumb borderStyle for the given scrollbar."

^ BorderStyle simple
width: 0;
baseColor: Color transparent
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
scrollbarPagingAreaCornerStyleIn: aThemedMorph
^#square
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
scrollbarPressedThumbFillStyleFor: aScrollbar
"Return the normal scrollbar button fillStyle for the given scrollbar."

^ SolidFillStyle color: self backgroundColor lighter lighter
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
configureWindowBorderFor: aWindow
" super configureWindowBorderFor: aWindow.
aWindow roundedCorners: #()"
| aStyle |

aStyle :=
SimpleBorder new
color: self borderColor;
width: 1.

aWindow borderStyle: aStyle.
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
configureWindowDropShadowFor: aWindow

aWindow hasDropShadow: false
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
dropListNormalBorderStyleFor: aDropList
"Return the normal borderStyle for the given drop list"

^ self buttonNormalBorderStyleFor: aDropList
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
dropListNormalListBorderStyleFor: aDropList
"Return the normal borderStyle for the list of the given given drop list"

^BorderStyle inset
width: 1;
baseColor: self buttonColor lighter.
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
groupPanelBorderStyleFor: aGroupPanel
"Answer the normal border style for a group panel."

^ SimpleBorder new
width: 1;
baseColor: ((self glamorousBaseColorFor: aGroupPanel))
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
plainGroupPanelBorderStyleFor: aGroupPanel
"Answer the normal border style for a plain group panel."

^SimpleBorder new
width: 1;
baseColor: Color transparent
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
tabLabelNormalBorderStyleFor: aTabLabel
" ^SimpleBorder new
width: 0;
baseColor: (self buttonBaseColorFor: aTabLabel) darker
" ^ self buttonNormalBorderStyleFor: aTabLabel
Loading

0 comments on commit 986ba23

Please sign in to comment.