Packages May 2018

packages@lists.squeakfoundation.org

1 participants
110 discussions

The Trunk: EToys-mt.328.mcz
by commits＠source.squeak.org 12 May '18

12 May '18

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.328.mcz ==================== Summary ==================== Name: EToys-mt.328 Author: mt Time: 12 May 2018, 10:57:29.401582 am UUID: 5269f6c3-6d89-294a-a49c-dbd1381b3eb4 Ancestors: EToys-mt.327 Duplicate a check from PolygonMorph in SectorMorph. Would be nice if we could see if a super call had an early exit. :-) There are several examples in the image such as Morph >> #extent: and the #closeTo: check. =============== Diff against EToys-mt.327 =============== Item was changed: ----- Method: SectorMorph>>computeBounds (in category 'updating') ----- computeBounds super computeBounds. + vertices ifNil: [^ self]. self setRotationCenterFrom: vertices first!

1 0

The Trunk: Morphic-mt.1428.mcz
by commits＠source.squeak.org 11 May '18

11 May '18

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1428.mcz ==================== Summary ==================== Name: Morphic-mt.1428 Author: mt Time: 11 May 2018, 10:02:42.214977 am UUID: 843c8d82-5e60-8746-b610-418f2d5619fd Ancestors: Morphic-mt.1427 Reset mouse cursor for pop-up menus. =============== Diff against Morphic-mt.1427 =============== Item was changed: ----- Method: MenuMorph>>popUpAt:forHand:in:allowKeyboard: (in category 'control') ----- popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: aBoolean "Present this menu at the given point under control of the given hand." | evt | aWorld submorphs select: [:each | (each isKindOf: MenuMorph) and: [each stayUp not]] thenCollect: [:menu | menu delete]. self items isEmpty ifTrue: [^ self]. MenuIcons decorateMenu: self. (self submorphs select: [:m | m isKindOf: UpdatingMenuItemMorph]) do: [:m | m updateContents]. "precompute width" self positionAt: aPoint relativeTo: (selectedItem ifNil: [self items first]) inWorld: aWorld. aWorld addMorphFront: self. "Acquire focus for valid pop up behavior" + hand + newMouseFocus: self; + showTemporaryCursor: nil. - hand newMouseFocus: self. aBoolean ifTrue: [ originalFocusHolder := hand keyboardFocus. hand newKeyboardFocus: self. self showKeyboardHelp]. evt := hand lastEvent. (evt isKeyboard or: [evt isMouse and: [evt anyButtonPressed not]]) ifTrue: ["Select first item if button not down" self moveSelectionDown: 1 event: evt "Select first item if button not down"]. self updateColor. self changed!

1 0

The Trunk: EToys-mt.327.mcz
by commits＠source.squeak.org 11 May '18

11 May '18

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.327.mcz ==================== Summary ==================== Name: EToys-mt.327 Author: mt Time: 11 May 2018, 9:59:07.436977 am UUID: fd205533-1369-ee42-9cbb-85a0980378ff Ancestors: EToys-mt.326 Consistency. =============== Diff against EToys-mt.326 =============== Item was changed: ----- Method: BroomMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- justDroppedInto: aMorph event: anEvent super justDroppedInto: aMorph event: anEvent. aMorph isPlayfieldLike ifFalse: [ ^self delete ]. self centered: anEvent hand lastEvent yellowButtonPressed. self transient ifFalse: [ ^self ]. self reset. self hotspot: (start := anEvent position). + anEvent hand newMouseFocus: self. + anEvent hand newKeyboardFocus: self. - anEvent hand mouseFocus: self. - anEvent hand keyboardFocus: self. "Cursor blank show."! Item was changed: ----- Method: BroomMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt self reset. self resetFilter. self hotspot: (start := evt position). + evt hand newMouseFocus: self. + evt hand newKeyboardFocus: self. - evt hand mouseFocus: self. - evt hand keyboardFocus: self. "Cursor blank show."!

1 0

The Trunk: Tools-tpr.814.mcz
by commits＠source.squeak.org 11 May '18

11 May '18

tim Rowledge uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-tpr.814.mcz ==================== Summary ==================== Name: Tools-tpr.814 Author: tpr Time: 10 May 2018, 3:46:56.604043 pm UUID: 51286010-27d3-4475-88e1-381c5e1c8319 Ancestors: Tools-tpr.813 Remove spurious 'browse class' menu entry and keypress response, replace with correct opening of a full browser based on the selected item in the Inspector. =============== Diff against Tools-tpr.813 =============== Item was added: + ----- Method: Inspector>>browseClass (in category 'menu commands') ----- + browseClass + "Open a full browser on the class of the selected item" + + ToolSet browseClass: self selectedClass! Item was changed: ----- Method: Inspector>>inspectorKey:from: (in category 'menu commands') ----- inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" aChar == $i ifTrue: [^ self selection inspect]. aChar == $I ifTrue: [^ self selection explore]. + aChar == $b ifTrue: [^ self browseClass]. - aChar == $b ifTrue: [^ self browseMethodFull]. aChar == $h ifTrue: [^ self classHierarchy]. aChar == $c ifTrue: [^ self copyName]. aChar == $p ifTrue: [^ self browseFullProtocol]. aChar == $N ifTrue: [^ self browseClassRefs]. aChar == $t ifTrue: [^ self tearOffTile]. aChar == $v ifTrue: [^ self viewerForValue]. ^ self arrowKey: aChar from: view! Item was changed: ----- Method: Inspector>>mainFieldListMenu: (in category 'menu commands') ----- mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> "gets overriden by subclasses, _whithout_ the <fieldListMenu>" aMenu addStayUpItemSpecial. aMenu addList: #( ('inspect (i)' inspectSelection) ('explore (I)' exploreSelection)). self addCollectionItemsTo: aMenu. aMenu addList: #( - ('method refs to this inst var' referencesToSelection) ('methods storing into this inst var' defsOfSelection) ('objects pointing to this value' objectReferencesToSelection) ('chase pointers' chasePointers) ('explore pointers' explorePointers) - + ('browse full (b)' browseClass) + ('browse hierarchy (h)' classHierarchy) - ('browse full (b)' browseMethodFull) - ('browse class' browseClass) - ('browse hierarchy (h)' classHierarchy) ('browse protocol (p)' browseFullProtocol) - ('references... (r)' browseVariableReferences) + ('assignments... (a)' browseVariableAssignments) - ('assignments... (a)' browseVariableAssignments) ('class refs (N)' browseClassRefs) - ('copy name (c)' copyName) ('basic inspect' inspectBasic)). Smalltalk isMorphic ifTrue: [aMenu addList: #( - ('tile for this value (t)' tearOffTile) ('viewer for this value (v)' viewerForValue))]. ^ aMenu " - ('alias for this value' aliasForValue) ('watcher for this slot' watcherForSlot)" !

1 0

The Trunk: Tools-tpr.813.mcz
by commits＠source.squeak.org 10 May '18

10 May '18

tim Rowledge uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-tpr.813.mcz ==================== Summary ==================== Name: Tools-tpr.813 Author: tpr Time: 10 May 2018, 2:54:14.550558 pm UUID: 01e3ab07-6692-4a92-a287-da9d4452de56 Ancestors: Tools-cmm.812 Remove the non-working (and too much work to be worth it) #browseClass send. Opening a full class browser is as useful and actually works. Rename #classHierarchy to #browseClassHiearchy because it actually makes sense to name similar methods similarly rather than with wildy unconnected names that just makes life more annoying that is strictly required. Deprecate the old version. (See 60Deprecated-tpr.19) =============== Diff against Tools-cmm.812 =============== Item was added: + ----- Method: ObjectExplorer>>browseClassHierarchy (in category 'menus - actions') ----- + browseClassHierarchy + "Create and schedule a class list browser on the receiver's hierarchy." + + self systemNavigation + spawnHierarchyForClass: self selectedClass + selector: nil + ! Item was removed: - ----- Method: ObjectExplorer>>classHierarchy (in category 'menus - actions') ----- - classHierarchy - "Create and schedule a class list browser on the receiver's hierarchy." - - self systemNavigation - spawnHierarchyForClass: self selectedClass - selector: nil - ! Item was changed: ----- Method: ObjectExplorer>>explorerKey:from:event: (in category 'menus') ----- explorerKey: aChar from: view event: event event anyModifierKeyPressed ifFalse: [^ false]. self object ifNotNil: [ aChar == $i ifTrue: [self inspectSelection. ^ true]. aChar == $I ifTrue: [self exploreSelection. ^ true]. aChar == $b ifTrue: [self browseFull. ^ true]. + aChar == $h ifTrue: [self browseClassHierarchy. ^ true]. - aChar == $h ifTrue: [self classHierarchy. ^ true]. aChar == $c ifTrue: [self copyName. ^ true]. aChar == $p ifTrue: [self browseFullProtocol. ^ true]. aChar == $N ifTrue: [self browseClassRefs. ^ true]. aChar == $v ifTrue: [self viewerForValue. ^ true]]. ^ false! Item was changed: ----- Method: ObjectExplorer>>mainTreeListMenu: (in category 'menus') ----- mainTreeListMenu: aMenu <treeListMenu> aMenu addStayUpItemSpecial. aMenu addList: #( ('inspect (i)' inspectSelection) ('explore (I)' exploreSelection) - ('method refs to this inst var' referencesToSelection) ('methods storing into this inst var' defsOfSelection) ('objects pointing to this value' objectReferencesToSelection) ('chase pointers' chasePointersForSelection) + ('explore pointers' explorePointersForSelection) - ('explore pointers' explorePointersForSelection) - ('browse full (b)' browseFull) + ('browse hierarchy (h)' browseClassHierarchy) - ('browse class' browseClass) - ('browse hierarchy (h)' classHierarchy) ('browse protocol (p)' browseFullProtocol) - ('references... (r)' browseVariableReferences) + ('assignments... (a)' browseVariableAssignments) - ('assignments... (a)' browseVariableAssignments) ('class refs (N)' browseClassRefs) - ('copy name (c)' copyName) ('copy value' copyValue) ('basic inspect' inspectBasic)). Smalltalk isMorphic ifTrue: [ aMenu addList: #( - ('viewer for this value (v)' viewerForValue))]. aMenu addList: #( - ('monitor changes' monitorSelection)). monitorList isEmptyOrNil ifFalse: [ aMenu addList: #( ('stop monitoring all' stopMonitoring))]. ^ aMenu!

1 0

The Trunk: 60Deprecated-tpr.19.mcz
by commits＠source.squeak.org 10 May '18

10 May '18

tim Rowledge uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-tpr.19.mcz ==================== Summary ==================== Name: 60Deprecated-tpr.19 Author: tpr Time: 10 May 2018, 2:52:18.56558 pm UUID: d97f4ebe-21aa-43d6-92f8-8e13d7564217 Ancestors: 60Deprecated-mt.18 deprecate an annoyingly (mis)named method. See also Tools-tpr.813 for the replacement =============== Diff against 60Deprecated-mt.18 =============== Item was added: + ----- Method: ObjectExplorer>>classHierarchy (in category '*60Deprecated-Tools') ----- + classHierarchy + "Create and schedule a class list browser on the receiver's hierarchy." + + self deprecated: 'Use #browseClassHierarchy instead'. + self browseClassHierarchy + !

1 0

The Trunk: System-mt.1025.mcz
by commits＠source.squeak.org 09 May '18

09 May '18

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1025.mcz ==================== Summary ==================== Name: System-mt.1025 Author: mt Time: 9 May 2018, 9:23:01.362554 am UUID: 061ddb0a-c159-884b-8964-3f3c2f74e7c7 Ancestors: System-mt.1024 Fixes typo. =============== Diff against System-mt.1024 =============== Item was changed: Object subclass: #UserInterfaceTheme instanceVariableNames: 'properties name next ignoreApply lastScaleFactor' classVariableNames: 'All Current Default' poolDictionaries: '' category: 'System-Support'! + !UserInterfaceTheme commentStamp: 'mt 5/9/2018 09:22' prior: 0! - !UserInterfaceTheme commentStamp: 'rhi 5/5/2018 09:18' prior: 0! A UserInterfaceTheme is a dictionary of preferred visual properties; colors, borderStyles, borderWidths, fonts, forms, etc. used to color and style the IDE. Accessing the Theme + To access the proper UserInterfaceTheme instance for an object, send it #userInterfaceTheme. The default implementation on Object returns an instance of UserInterfaceThemeRequest that provides a lightweight, clean proxy of the actual theme in use by the IDE at the current time. To do anything more sophisticated than basic querying and setting of properties, you must ask the proxy for the actual theme by sending #theme. - To access the proper UserInterfaceTheme instance for an object, send it #userInterfaceTheme. The default implementation on Object returns an instance of UserInterfaceThemeRequest that provides a lightweight, clean proxy of the actual theme in use by the IDE at the current time. To do anything more sophisticated than basic queryinh and setting of properties, you must ask the proxy for the actual theme by sending #theme. Customizing the Theme We can ask the #userInterfaceTheme for the value of any visual property by name: mySystemWindow userInterfaceTheme closeBoxImage Initially that would answer nil, which causes the legacy code to use whatever default it used so far. To override various visual properties of any kind of object, the #set:for:to: message can be used, for example: myUserInterfaceTheme set: #closeBoxImage for: SystemWindow to: MenuIcons smallCancelIcon Now the closeBoxImage message will answer the MenuIcons icon instead of nil. Alternatively, values may be derived based on other values in the theme, as in: myUserInterfaceTheme set: #color for: FillInTheBlankMorph to: { MenuMorph->#color. #twiceDarker } This makes FillInTheBlankMorph use the same color as a MenuMorph but #twiceDarker, providing a clean way to build coherent sets of colors within a theme. SystemWindow's code can be changed to use the expression above to access elements of the theme. Upgrading Legacy Code Following the introduction of this class, various client code all around the system must be modified to access it. This variety of legacy code uses a variety of methods to specify their visual properties: 1) a hard-coded values. 2) a values derived from some other value. 3) providing local storage for a settable value which can be nil. 4) providing local storage for a settable value which is expected to always have a particular valid value (never nil). The requirement, for each case, is to let the value be overridden. The solution for each of the above should be handled respectively to the above list, as follows: 1) Check the #userInterfaceTheme, if that property returns nil, use the legacy hard-coded value. (see example: SystemWindow>>#createCloseBox). 2) Nothing to do -- simply perform the same derivation on the result of (1). 3) Check the local storage, if present, use it. If nil, then check the #userInterfaceTheme, if it has this property present, use it, else return nil. 4) Check the #userInterfaceTheme, if the property is not nil, use it, otherwise use the local value. Tool Support If a new access to #userInterfaceTheme is added to the code, be sure to add the property and its description to the #themeSettings for that class. See implementors of #themeSettings for examples.!

1 0

The Trunk: System-mt.1024.mcz
by commits＠source.squeak.org 09 May '18

09 May '18

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1024.mcz ==================== Summary ==================== Name: System-mt.1024 Author: mt Time: 9 May 2018, 8:36:00.223271 am UUID: 74d2ef0a-9d9a-2847-a108-68482bd91da4 Ancestors: System-mt.1023 Updates code comments and some code formatting. =============== Diff against System-mt.1023 =============== Item was changed: UserInterfaceTheme subclass: #CommunityTheme instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! + !CommunityTheme commentStamp: 'rhi 5/5/2018 09:27' prior: 0! + A dark theme designed by members of the Squeak community.! - !CommunityTheme commentStamp: 'mt 7/26/2016 16:22' prior: 0! - A dark theme designed by members the Squeak community such as Karl Ramberg, Chris Muller, and Marcel Taeumel.! Item was changed: Object subclass: #UserInterfaceTheme instanceVariableNames: 'properties name next ignoreApply lastScaleFactor' classVariableNames: 'All Current Default' poolDictionaries: '' category: 'System-Support'! + !UserInterfaceTheme commentStamp: 'rhi 5/5/2018 09:18' prior: 0! + A UserInterfaceTheme is a dictionary of preferred visual properties; colors, borderStyles, borderWidths, fonts, forms, etc. used to color and style the IDE. - !UserInterfaceTheme commentStamp: 'tpr 9/25/2017 11:59' prior: 0! - A UserInterfaceTheme is a dictionary of preferred visual-properties; colors, borderStyles, borderWidths, fonts, forms, etc. used to color and style the IDE. + Accessing the Theme + To access the proper UserInterfaceTheme instance for an object, send it #userInterfaceTheme. The default implementation on Object returns an instance of UserInterfaceThemeRequest that provides a lightweight, clean proxy of the actual theme in use by the IDE at the current time. To do anything more sophisticated than basic queryinh and setting of properties, you must ask the proxy for the actual theme by sending #theme. - Accessing The Theme - To access the proper UserInterfaceTheme instance for an object, send it #userInterfaceTheme. The default implementation on Object provides the an instance of UserInterfaceThemeRequest that provides a lightweight, clean proxy of the actual theme in-use by the IDE at the current time. To do anything more sophisticated than basic query and setting of properties you must ask the proxy for the actual theme by sending #theme. + Customizing the Theme + We can ask the #userInterfaceTheme for the value of any visual property by name: - Customizing The Theme - We can ask the userInterfaceTheme for the value of any visual-property, by name: mySystemWindow userInterfaceTheme closeBoxImage + Initially that would answer nil, which causes the legacy code to use whatever default it used so far. To override various visual properties of any kind of object, the #set:for:to: message can be used, for example: - Initially that would answer nil, which causes the legacy code to use whatever default it's always used. To override various visual-properties of any kind of object, the #set: for: to: message can be used. For example, myUserInterfaceTheme set: #closeBoxImage for: SystemWindow to: MenuIcons smallCancelIcon Now the closeBoxImage message will answer the MenuIcons icon instead of nil. Alternatively, values may be derived based on other values in the theme, as in: myUserInterfaceTheme set: #color for: FillInTheBlankMorph + to: { MenuMorph->#color. #twiceDarker } - to: { MenuMorph->#color. #twiceDarker } + This makes FillInTheBlankMorph use the same color as a MenuMorph but #twiceDarker, providing a clean way to build coherent sets of colors within a theme. SystemWindow's code can be changed to use the expression above to access elements of the theme. - This would make FillInTheBlankMorph use the same color as a MenuMorph but twiceDarker, providing a clean way to build coherent seets of colors within a theme. SystemWindow's code can be changed to use the expression above to access elements of the theme. Upgrading Legacy Code + Following the introduction of this class, various client code all around the system must be modified to access it. This variety of legacy code uses a variety of methods to specify their visual properties: - Following the introduction of this class, various client code all around the system must be modified to access it. This variety of legacy code uses a variety of methods to specify their visual properties: 1) a hard-coded values. 2) a values derived from some other value. 3) providing local storage for a settable value which can be nil. 4) providing local storage for a settable value which is expected to always have a particular valid value (never nil). + The requirement, for each case, is to let the value be overridden. - The requirement, for each case, is to let the value be overridden. The solution for each of the above should be handled respectively to the above list, as follows: + 1) Check the #userInterfaceTheme, if that property returns nil, use the legacy hard-coded value. (see example: SystemWindow>>#createCloseBox). - 1) Check the userInterfaceTheme, if that property returns nil, use the legacy hard-coded value. (see example: SystemWindow>>#createCloseBox). 2) Nothing to do -- simply perform the same derivation on the result of (1). + 3) Check the local storage, if present, use it. If nil, then check the #userInterfaceTheme, if it has this property present, use it, else return nil. + 4) Check the #userInterfaceTheme, if the property is not nil, use it, otherwise use the local value. - 3) Check the local storage, if present, use it. If nil, then check the userInterfaceTheme, if it has this property present, use it, else return nil. - 4) Check the userInterfaceTheme, if the property is not nil, use it, otherwise use the local value. Tool Support + If a new access to #userInterfaceTheme is added to the code, be sure to add the property and its description to the #themeSettings for that class. See implementors of #themeSettings for examples.! - If a new access to #userInterfaceTheme is added to the code, be sure to add the property and its description to the #themeSettings for that class. See implementors of #themeSettings for examples.! Item was changed: ----- Method: UserInterfaceTheme class>>allThemeProperties (in category 'tools') ----- allThemeProperties + "Answer an Array of 3-element Arrays. Each inner Array holds the information needed to present a theme editor tool; the property name, category, and description." + + "self allThemeProperties" + + ^ Array streamContents: [:stream | + self allThemePropertiesDo: [:cls :prop | + stream nextPut: {cls}, prop]]! - "Answer an Array of 3-element Array's. Each inner Array are the information needed to present a Theme editor tool; the property name, category, and description. - - self allThemeProperties" - - ^ Array streamContents: - [ : stream | self allThemePropertiesDo: [ : cls : prop | stream nextPut: {cls}, prop ]]! Item was changed: ----- Method: UserInterfaceTheme class>>allThemes (in category 'accessing') ----- allThemes + ^ All ifNil: [All := IdentitySet new]! Item was changed: ----- Method: UserInterfaceTheme class>>cleanUp: (in category 'initialize-release') ----- cleanUp: aggressive aggressive ifTrue: [ All := nil. + SqueakTheme + create; + createDuller. + SolarizedTheme + createDark; + createLight. - SqueakTheme create; createDuller. - SolarizedTheme createDark; createLight. MonokaiTheme createDark. CommunityTheme createDark. TrimTheme create].! Item was changed: ----- Method: UserInterfaceTheme class>>clientClassesToReapply (in category 'private') ----- clientClassesToReapply "All client classes plus their unique subclasses." + ^ IdentitySet new in: [:result | + self clientClasses do: [:cc | + cc withAllSubclassesDo: [:sc | + result add: sc]]. + result]! - ^ IdentitySet new in: [:result | self clientClasses do: [:cc | cc withAllSubclassesDo: [:sc | - result add: sc]]. result] - ! Item was changed: ----- Method: UserInterfaceTheme class>>current: (in category 'accessing') ----- current: aUserInterfaceTheme "Replace the current system theme with aUserInterfaceTheme." + + Current := aUserInterfaceTheme. + "Notify?"! - Current := aUserInterfaceTheme - "Notify?"! Item was changed: ----- Method: UserInterfaceTheme class>>default (in category 'accessing') ----- default + ^ Default ifNil: [Default := self new + name: 'Autogenerated Default'; + yourself]! - ^ Default ifNil: [Default := self new name: 'Autogenerated Default'; yourself]! Item was changed: ----- Method: UserInterfaceTheme class>>default: (in category 'accessing') ----- default: aUserInterfaceTheme + Default := aUserInterfaceTheme.! Item was changed: ----- Method: UserInterfaceTheme class>>named: (in category 'initialize-release') ----- named: aString + ^ self allThemes detect: [:ea | ea name = aString] + ifNone: [self new + name: aString; + register]! - ifNone: [self new name: aString; register]! Item was changed: ----- Method: UserInterfaceTheme class>>propertiesForCategory: (in category 'tools') ----- propertiesForCategory: categoryName + + ^ self allThemeProperties select: [:each | each third = categoryName]! - ^ self allThemeProperties select: [ : each | each third = categoryName ]! Item was changed: ----- Method: UserInterfaceTheme class>>propertiesForClass: (in category 'tools') ----- propertiesForClass: aClass + + ^ self allThemeProperties select: [:each | each first == aClass]! - ^ self allThemeProperties select: [ : each | each first = aClass ]! Item was changed: Object subclass: #UserInterfaceThemeRequest instanceVariableNames: 'target theme' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! + !UserInterfaceThemeRequest commentStamp: 'rhi 5/5/2018 09:30' prior: 0! + To be able to use a UserInterfaceTheme as a container of fairly arbitrary properties whilst making it seem like we are sending regular messages as a way of accessing those properties, we can handle #doesNotUnderstand: and check the name of the message not understood against our property list. This is clever, devious, interesting, and may confuse users until they get to see an explanation like this. - !UserInterfaceThemeRequest commentStamp: 'mt 9/23/2017 10:37' prior: 0! - In order to be able to use a UserInterfaceTheme as a container of fairly arbitrary properties whilst making it seem like we are sending regular messages as a way of accessing those properties we can handle the dNU: and check the not understood message name against our property list. This is clever, devious, interesting and may confuse users until they get to see an explanation like this. Answer nil or a value for the property specified by aMessage's #selector. Searching for the property proceeds by + a) searching my dictionary for a key made up of an Association with a key of the class of the 'client' and a value of the message name. For example SimpleButtonMorph->#borderColor + b) searching again for a key made from the superclass(es) of the client - e.g. RectangleMorph->borderColor and then if required BorderedMorph->#borderColor etc. - a) searching my dictionary for a key made up of an Association with a key of the class of the 'client' and a value of the message name. For example SimpleButtonMorph->borderColor - b) searching again for a key made from the superclass(es) of the client - e.g. RectangleMorph->borderColor and then if required BorderedMorph->borderColor etc. c) if there is a linked theme, search it in the same manner. + As an extreme example, consider a basic theme with a linked theme specific to buttons: - As an extreme example, consider a basic theme with a linked theme specifically for buttons. mySimpleButtonMorph borderColor + ... would search the basic theme for SimpleButtonMorph->#borderColor, the superclass equivalents as in b) above, then search the linked theme for SimpleButtonMorph->#borderColor and (hopefully) find something meaningful.! - ... would search the basic theme for SimpleButtonMorph->borderColor, the superclass equivalents as in b) above, then search the linked theme for SimpleButtonMorph->borderColor and, we hope, find something meaningful.! Item was changed: ----- Method: UserInterfaceThemeRequest>>doesNotUnderstand: (in category 'lookup') ----- doesNotUnderstand: aMessage + "Look up the visual attribute specified by aMessage's #selector in the current theme for the current target object." - "Look up the visual-attribute specified by aMessage's #selector in the current theme for the current target object." aMessage numArgs = 0 ifTrue: [ ^ (self theme get: self target class -> aMessage selector) ifNil: [(self theme respondsTo: aMessage selector) ifTrue: [self theme perform: aMessage selector] + ifFalse: [nil "unset property"]]]. - ifFalse: [nil "means unset property"]]]. ^ self theme perform: aMessage selector withArguments: aMessage arguments.!

1 0

The Trunk: Tools-cmm.812.mcz
by commits＠source.squeak.org 09 May '18

09 May '18

Chris Muller uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-cmm.812.mcz ==================== Summary ==================== Name: Tools-cmm.812 Author: cmm Time: 8 May 2018, 10:59:15.586524 pm UUID: d05b5ccd-cc99-4f00-85b1-264218092ef2 Ancestors: Tools-dtl.811 - Integrate newly-defined classes into the hierarchy list of a HierarchyBrowser without muting the other classes. If it's outside the hierarchy, spawn it in a new window. - Bug reports can contain sensitive and/or private information (variable values), so use care when sending them electronically. 'copy bug report to clipboard' replaced 'mail out bug report' on the debugger menu. =============== Diff against Tools-dtl.811 =============== Item was changed: ----- Method: Browser>>defineClass:notifying: (in category 'class functions') ----- defineClass: defString notifying: aController "The receiver's textual content is a request to define a new class. The source code is defString. If any errors occur in compilation, notify aController." | oldClass class newClassName defTokens keywdIx envt | oldClass := self selectedClassOrMetaClass. defTokens := defString findTokens: Character separators. ((defTokens first = 'Trait' and: [defTokens second = 'named:']) or: [defTokens second = 'classTrait']) ifTrue: [^self defineTrait: defString notifying: aController]. keywdIx := defTokens findFirst: [:x | x beginsWith: 'category']. envt := self selectedEnvironment. keywdIx := defTokens findFirst: [:x | '*subclass*' match: x]. newClassName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'. ((oldClass isNil or: [oldClass theNonMetaClass name asString ~= newClassName]) and: [envt includesKey: newClassName asSymbol]) ifTrue: ["Attempting to define new class over existing one when not looking at the original one in this browser..." (self confirm: ((newClassName , ' is an existing class in this system. Redefining it might cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size)) ifFalse: [^ false]]. "ar 8/29/1999: Use oldClass superclass for defining oldClass since oldClass superclass knows the definerClass of oldClass." oldClass ifNotNil:[oldClass := oldClass superclass]. class := envt beCurrentDuring: [oldClass subclassDefinerClass evaluate: defString in: envt notifying: aController logged: false]. (class isKindOf: Behavior) + ifTrue: [self changed: #systemCategoryList; changed: #classList. + self clearUserEditFlag; spawnOrNavigateTo: class. - ifTrue: [self changed: #systemCategoryList. - self changed: #classList. - self clearUserEditFlag. - self setClass: class selector: nil. - "self clearUserEditFlag; editClass." ^ true] ifFalse: [^ false]! Item was added: + ----- Method: Browser>>spawnOrNavigateTo: (in category 'private') ----- + spawnOrNavigateTo: aClass + self setClass: aClass selector: nil! Item was changed: ----- Method: Debugger>>mainContextStackMenu: (in category 'context stack menu') ----- mainContextStackMenu: aMenu "Set up the menu appropriately for the context-stack-list, unshifted" <contextStackMenuShifted: false> ^ aMenu addList: #( ('fullStack (f)' fullStack) ('restart (r)' restart) ('proceed (p)' proceed) ('step (t)' doStep) ('step through (T)' stepIntoBlock) ('send (e)' send) ('where (w)' where) ('peel to first like this' peelToFirst) - ('return entered value' returnValue) - ('toggle break on entry' toggleBreakOnEntry) ('senders of (n)' browseSendersOfMessages) ('implementors of (m)' browseMessages) ('inheritance (i)' methodHierarchy) - ('versions (v)' browseVersions) - ('references (r)' browseVariableReferences) ('assignments (a)' browseVariableAssignments) - ('class refs (N)' browseClassRefs) ('browse full (b)' browseMethodFull) ('file out ' fileOutMessage) - + ('copy bug report to clipboard' copyBugReportToClipboard)); - ('mail out bug report' mailOutBugReport) - ('bug report to clipboard' copyBugReportToClipboard)); yourself ! Item was changed: ----- Method: HierarchyBrowser>>setClass: (in category 'initialization') ----- + setClass: aClass + self initHierarchyForClass: (centralClass ifNil: [ aClass ]). + super setClass: aClass! - setClass: aClass - - self initHierarchyForClass: aClass. - super setClass: aClass.! Item was added: + ----- Method: HierarchyBrowser>>spawnOrNavigateTo: (in category 'private') ----- + spawnOrNavigateTo: aClass + (aClass inheritsFrom: centralClass) + ifTrue: [ super spawnOrNavigateTo: aClass ] + ifFalse: [ self systemNavigation browseHierarchy: aClass ]! Item was changed: ----- Method: HierarchyBrowser>>updateAfterClassChange (in category 'initialization') ----- updateAfterClassChange "It is possible that some the classes comprising the hierarchy have changed, so reinitialize the entire browser." + | priorSelection | + priorSelection := self selectedClassName. + (centralClass notNil and: [centralClass isObsolete not]) + ifTrue: [self initHierarchyForClass: centralClass]. + + (self classListIndexOf: priorSelection) > 0 + ifTrue: [self selectClassNamed: priorSelection].! - ifTrue: [self initHierarchyForClass: centralClass]!

1 0

The Trunk: EToys-mt.326.mcz
by commits＠source.squeak.org 06 May '18

06 May '18

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.326.mcz ==================== Summary ==================== Name: EToys-mt.326 Author: mt Time: 6 May 2018, 3:18:35.522836 pm UUID: 95d9813d-1659-9b4f-9cc6-d290709bf39a Ancestors: EToys-tpr.325 Supplement to refactoring in Morphic-mt.1427. =============== Diff against EToys-tpr.325 =============== Item was changed: ----- Method: AnonymousSoundMorph>>sound:interimName: (in category 'initialization') ----- sound: aSampledSound interimName: anInterimName "Establish the sound object and an interim name." | aStringMorph | self removeAllMorphs. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. + self borderWidth: 2. - borderWidth := 2. self listDirection: #topToBottom. sound := aSampledSound. interimName := anInterimName. aStringMorph := StringMorph contents: interimName font: ScriptingSystem fontForEToyButtons. self addMorphBack: aStringMorph. self addButtonRow. self balloonTextSelector: #soundMorphHelpString. self setNameTo: interimName! Item was changed: ----- Method: CalendarMorph>>newButtonWithContents: (in category 'building') ----- newButtonWithContents: aByteString ^SimpleButtonMorph new label: aByteString; color: (self color mixed: 0.5 with: Color gray); + borderStyle: (BorderStyle raised width: 2)! - borderColor: #raised; - borderWidth: 2! Item was changed: ----- Method: CalendarMorph>>newDateButtonWithContents: (in category 'building') ----- newDateButtonWithContents: aByteString ^SimpleButtonMorph new label: aByteString; cornerStyle: #square; color: self color muchLighter; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; width: 30! Item was changed: ----- Method: ChessMorph>>addButtonRow (in category 'initialize') ----- addButtonRow | r m | r := AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: Color transparent. + r cellInset: 2. r addMorphBack: (self buttonName: ' New ' translated action: #newGame). r addMorphBack: (self buttonName: ' Help ' translated action: #findBestMove). r addMorphBack: (self buttonName: ' Play ' translated action: #thinkAndMove). r addMorphBack: (self buttonName: ' Auto ' translated action: #autoPlay). r addMorphBack: (self buttonName: ' Undo ' translated action: #undoMove). r addMorphBack: (self buttonName: ' Redo ' translated action: #redoMove). r addMorphBack: (self buttonName: ' Quit ' translated action: #delete). r disableTableLayout: true. r align: r bounds topLeft with: self layoutBounds topLeft. self addMorphFront: r. m := UpdatingStringMorph on: self selector: #statusString. m useStringFormat. m disableTableLayout: true. m align: m bounds topLeft with: r fullBounds bottomLeft. self addMorphFront: m.! Item was changed: ----- Method: ChessMorph>>buttonName:action: (in category 'initialize') ----- buttonName: aString action: aSymbol ^ SimpleButtonMorph new target: self; label: aString; actionSelector: aSymbol; color: (Color gray: 0.8); "old color" fillStyle: self buttonFillStyle; + borderWidth: 1; + borderRaised. - borderWidth: 0; - borderColor: #raised. ! Item was changed: ----- Method: ChessMorph>>defaultBorderColor (in category 'initialization') ----- defaultBorderColor + ^ Color transparent! - "answer the default border color/fill style for the receiver" - ^ #raised! Item was added: + ----- Method: ChessMorph>>defaultBorderStyle (in category 'initialization') ----- + defaultBorderStyle + ^ BorderStyle raised! Item was changed: ----- Method: ChessMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" animateMove := false. autoPlay := false. + self cornerStyle: #square. - self cornerStyle: #rounded. self layoutPolicy: TableLayout new. self listDirection: #leftToRight; wrapDirection: #bottomToTop. self addSquares. self addButtonRow. self newGame! Item was changed: ----- Method: CommandTilesMorph>>initialize (in category 'initialization') ----- initialize super initialize. self wrapCentering: #center; cellPositioning: #leftCenter. self hResizing: #shrinkWrap. + self borderWidth: 0. - borderWidth := 0. self layoutInset: 0. self extent: 5@5. "will grow to fit" ! Item was changed: ----- Method: EToyProjectHistoryMorph>>defaultBorderColor (in category 'initialization') ----- defaultBorderColor + ^ Color transparent! - "answer the default border color/fill style for the receiver" - ^ #raised! Item was added: + ----- Method: EToyProjectHistoryMorph>>defaultBorderStyle (in category 'initialization') ----- + defaultBorderStyle + ^ BorderStyle raised! Item was changed: ----- Method: EToyProjectHistoryMorph>>rebuild (in category 'as yet unclassified') ----- rebuild | history r1 | history := ProjectHistory currentHistory mostRecentCopy. changeCounter := ProjectHistory changeCounter. self removeAllMorphs. self rubberBandCells: false. "enable growing" r1 := self addARow: { self inAColumn: { StringMorph new contents: 'Jump...' translated; lock. }. }. r1 on: #mouseUp send: #jumpToProject to: self. history do: [ :each | ( self addARow: { (self inAColumn: { StretchyImageMorph new form: each second; minWidth: 35; minHeight: 35; lock }) vResizing: #spaceFill. self inAColumn: { StringMorph new contents: each first; lock. "StringMorph new contents: each fourth first; lock." }. (self inAColumn: { StringMorph new color: Color red; contents: 'X'; on: #mouseDown send: #confirmedDelete:evt:from: to: self withValue: each fourth first }) hResizing: #rigid. } ) color: Color paleYellow; + borderStyle: (BorderStyle raised width: 1); - borderWidth: 1; - borderColor: #raised; vResizing: #spaceFill; on: #mouseUp send: #mouseUp:in: to: self; on: #mouseDown send: #mouseDown:in: to: self; on: #mouseMove send: #mouseMove:in: to: self; on: #mouseLeave send: #mouseLeave:in: to: self; setProperty: #projectParametersTuple toValue: each; setBalloonText: (each third isEmptyOrNil ifTrue: ['not saved'] ifFalse: [each third]) ]. "--- newTuple := { aProject name. aProject thumbnail. aProject url. WeakArray with: aProject. }. ---"! Item was changed: ----- Method: FishEyeMorph>>extent: (in category 'geometry') ----- extent: aPoint "Round to a number divisible by grid. Note that the superclass has its own implementation." | g gridSize | gridSize := self gridSizeFor: aPoint. "self halt." + g := (aPoint - (2 * self borderWidth)) // gridSize. - g := (aPoint - (2 * borderWidth)) // gridSize. srcExtent := g * gridSize. gridNum := g. ^super extent: self defaultExtent! Item was changed: ----- Method: FreeCell>>buildButton:target:label:selector: (in category 'private') ----- buildButton: aButton target: aTarget label: aLabel selector: aSelector "wrap a button or switch in an alignmentMorph to provide some space around the button" | a | aButton target: aTarget; label: aLabel; actionSelector: aSelector; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: Color gray. a := AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: Color transparent; layoutInset: 1. a addMorph: aButton. ^ a ! Item was changed: ----- Method: FreeCell>>makeControlBar (in category 'initialization') ----- makeControlBar ^AlignmentMorph newRow color: self colorNearBottom; + borderStyle: (BorderStyle inset width: 2); - borderColor: #inset; - borderWidth: 2; layoutInset: 0; hResizing: #spaceFill; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter; yourself.! Item was changed: ----- Method: FreeCellStatistics>>buildButton:target:label:selector: (in category 'user interface') ----- buildButton: aButton target: aTarget label: aLabel selector: aSelector "wrap a button or switch in an alignmentMorph to provide some space around the button" | a | aButton target: aTarget; label: aLabel; actionSelector: aSelector; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: Color gray. a := AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap; color: Color transparent; layoutInset: 1. a addMorph: aButton. ^ a ! Item was changed: ----- Method: FreeCellStatistics>>makeControls (in category 'user interface') ----- makeControls | row | row := AlignmentMorph newRow. row wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #spaceFill; vResizing: #shrinkWrap; color: self color; + borderStyle: (BorderStyle inset width: 2); - borderWidth: 2; - borderColor: #inset; addMorphBack: self makeOkButton; addMorphBack: self makeResetButton. ^row.! Item was changed: ----- Method: FreeCellStatistics>>makeStatistics (in category 'user interface') ----- makeStatistics | row | row := AlignmentMorph newRow. row wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #spaceFill; vResizing: #spaceFill; color: self color; + borderStyle: (BorderStyle inset width: 2); - borderWidth: 2; - borderColor: #inset; addMorphBack: (AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter; color: self color; addMorph: (statsMorph := TextMorph new contents: self statsText)). ^row.! Item was changed: ----- Method: HTTPProxyEditor>>updateWidgets (in category 'initialization') ----- updateWidgets "update the receiver's widgets" acceptWidget isNil ifFalse: ["" acceptWidget color: Color lightGreen; + borderStyle: (BorderStyle raised width: 2)]. - borderWidth: 2; - borderColor: #raised]. cancelWidget isNil ifFalse: ["" cancelWidget color: Color lightRed; + borderStyle: (BorderStyle raised width: 2)]. - borderWidth: 2; - borderColor: #raised]. "" serverNameLabelWidget isNil ifFalse: ["" serverNameLabelWidget color: self paneColor lighter; + borderStyle: (BorderStyle raised width: serverNameLabelWidget borderWidth)]. - borderColor: #raised]. portLabelWidget isNil ifFalse: ["" portLabelWidget color: self paneColor lighter; + borderStyle: (BorderStyle raised width: portLabelWidget borderWidth)]! - borderColor: #raised]! Item was changed: ----- Method: IconicButtonWithLabel>>labelGraphic:color:andLabel: (in category 'as yet unclassified') ----- labelGraphic: aForm color: nonTranslucent andLabel: aStringMorph | graphicalMorph labeledItem actualForm | labeledItem := AlignmentMorph newColumn. labeledItem hResizing: #shrinkWrap. labeledItem vResizing: #shrinkWrap. labeledItem color: nonTranslucent. labeledItem borderWidth: 0. labeledItem layoutInset: 4@0; cellPositioning: #center. self removeAllMorphs. actualForm := (Form extent: aForm extent depth: 32) fillColor: nonTranslucent. aForm displayOn: actualForm at: 0@0 rule: 34. graphicalMorph := SketchMorph withForm: actualForm. labeledItem addMorph: graphicalMorph. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. aStringMorph ifNotNil: [ labeledItem addMorphBack: aStringMorph ]. self addMorph: labeledItem. + self extent: submorphs first fullBounds extent + (self borderWidth + 6). - self extent: submorphs first fullBounds extent + (borderWidth + 6). labeledItem lock. ! Item was changed: ----- Method: IconicButtonWithLabel>>labelString: (in category 'as yet unclassified') ----- labelString: aString labelMorph ifNotNil: [ labelMorph contents: aString. + self extent: self firstSubmorph fullBounds extent + (self borderWidth + 6). - self extent: submorphs first fullBounds extent + (borderWidth + 6). ]. ! Item was changed: ----- Method: MidiInputMorph>>addChannelControlsFor: (in category 'as yet unclassified') ----- addChannelControlsFor: channelIndex | r divider col | r := self makeRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. r addMorphBack: (self channelNumAndMuteButtonFor: channelIndex). r addMorphBack: (Morph new extent: 10@5; color: color). "spacer" r addMorphBack: (self panAndVolControlsFor: channelIndex). divider := AlignmentMorph new extent: 10@1; - borderWidth: 1; layoutInset: 0; + borderStyle: (BorderStyle raised width: 1); - borderColor: #raised; color: color; hResizing: #spaceFill; vResizing: #rigid. col := self lastSubmorph. col addMorphBack: divider. col addMorphBack: r. ! Item was changed: ----- Method: MidiInputMorph>>makeControls (in category 'as yet unclassified') ----- makeControls | bb r reverbSwitch onOffSwitch | bb := SimpleButtonMorph new target: self; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: color. r := AlignmentMorph newRow. r color: bb color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r addMorphBack: ( bb label: '<>'; actWhen: #buttonDown; actionSelector: #invokeMenu). onOffSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); borderWidth: 2; label: 'On'; actionSelector: #toggleOnOff; target: self; setSwitchState: false. r addMorphBack: onOffSwitch. reverbSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); borderWidth: 2; label: 'Reverb Disable'; actionSelector: #disableReverb:; target: self; setSwitchState: SoundPlayer isReverbOn not. r addMorphBack: reverbSwitch. ^ r ! Item was changed: ----- Method: Mines>>buildButton:target:label:selector: (in category 'initialize') ----- buildButton: aButton target: aTarget label: aLabel selector: aSelector "wrap a button or switch in an alignmentMorph to allow a row of buttons to fill space" | a | aButton target: aTarget; label: aLabel; actionSelector: aSelector; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: color. a := AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap; color: color. a addMorph: aButton. ^ a ! Item was changed: ----- Method: Mines>>defaultBorderColor (in category 'initialization') ----- defaultBorderColor + ^ Color transparent! - "answer the default border color/fill style for the receiver" - ^ #raised! Item was added: + ----- Method: Mines>>defaultBorderStyle (in category 'initialization') ----- + defaultBorderStyle + ^ BorderStyle raised! Item was changed: ----- Method: Mines>>makeControls (in category 'initialize') ----- makeControls | row | row := AlignmentMorph newRow color: color; borderWidth: 2; layoutInset: 3. + row borderStyle: BorderStyle inset. - row borderColor: #inset. row hResizing: #spaceFill; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter; extent: 5 @ 5. row addMorph: (self buildButton: SimpleSwitchMorph new target: self label: ' Help ' translated selector: #help:). row addMorph: (self buildButton: SimpleButtonMorph new target: self label: ' Quit ' translated selector: #delete). "row addMorph: (self buildButton: SimpleButtonMorph new target: self label: ' Hint ' translated selector: #hint)." row addMorph: (self buildButton: SimpleButtonMorph new target: self label: ' New game ' translated selector: #newGame). minesDisplay := LedMorph new digits: 2; extent: 2 * 10 @ 15. row addMorph: (self wrapPanel: minesDisplay label: 'Mines:' translated). timeDisplay := LedTimerMorph new digits: 3; extent: 3 * 10 @ 15. row addMorph: (self wrapPanel: timeDisplay label: 'Time:' translated). ^ row! Item was changed: ----- Method: MinesBoard>>defaultBorderColor (in category 'initialization') ----- defaultBorderColor + ^ Color transparent! - "answer the default border color/fill style for the receiver" - ^ #inset! Item was added: + ----- Method: MinesBoard>>defaultBorderStyle (in category 'initialization') ----- + defaultBorderStyle + ^ BorderStyle inset! Item was changed: ----- Method: MinesTile>>drawOn: (in category 'drawing') ----- drawOn: aCanvas "Draw a rectangle with a solid, inset, or raised border. Note: the raised border color *and* the inset border color are generated from the receiver's own color, instead of having the inset border color generated from the owner's color, as in BorderedMorph." | font rct | + super drawOn: aCanvas. + + self borderStyle style == #inset ifTrue: [ - - borderWidth = 0 ifTrue: [ "no border" - aCanvas fillRectangle: bounds color: color. - ^ self.]. - - borderColor == #raised ifTrue: [ - ^ aCanvas frameAndFillRectangle: bounds - fillColor: color - borderWidth: borderWidth - topLeftColor: color lighter lighter - bottomRightColor: color darker darker darker]. - - borderColor == #inset ifTrue: [ - aCanvas frameAndFillRectangle: bounds - fillColor: color - borderWidth: 1 " borderWidth" - topLeftColor: (color darker darker darker) - bottomRightColor: color lighter. self isMine ifTrue: [ font := StrikeFont familyName: 'Atlanta' size: 22 emphasized: 1. + rct := self bounds insetBy: ((self bounds width) - (font widthOfString: '*'))/2@0. - rct := bounds insetBy: ((bounds width) - (font widthOfString: '*'))/2@0. rct := rct top: rct top + 1. aCanvas drawString: '*' in: (rct translateBy: 1@1) font: font color: Color black. ^ aCanvas drawString: '*' in: rct font: font color: Color red .]. self nearMines > 0 ifTrue: [ font := StrikeFont familyName: 'ComicBold' size: 22 emphasized: 1. + rct := self bounds insetBy: ((self bounds width) - (font widthOfString: nearMines asString))/2@0. - rct := bounds insetBy: ((bounds width) - (font widthOfString: nearMines asString))/2@0. rct := rct top: rct top + 1. aCanvas drawString: nearMines asString in: (rct translateBy: 1@1) font: font color: Color black. + ^ aCanvas drawString: nearMines asString in: rct font: font color: ((palette at: nearMines) ) .]].! - ^ aCanvas drawString: nearMines asString in: rct font: font color: ((palette at: nearMines) ) .]. - ^self. ]. - - "solid color border" - aCanvas frameAndFillRectangle: bounds - fillColor: color - borderWidth: borderWidth - borderColor: borderColor.! Item was changed: ----- Method: MinesTile>>switchState: (in category 'accessing') ----- switchState: aBoolean switchState := aBoolean. disabled ifFalse: [switchState ifTrue:[ "flag ifTrue: [self setFlag]." "if this is a flagged tile, unflag it." + self borderStyle: (BorderStyle inset width: 1). - self borderColor: #inset. self color: onColor] ifFalse:[ + self borderStyle: (BorderStyle raised width: 3). - self borderColor: #raised. self color: offColor]]! Item was changed: ----- Method: NewVariableDialogMorph>>buildDecimalPlacesButton (in category 'build') ----- buildDecimalPlacesButton | button | button := SimpleButtonMorph new labelString: self decimalPlaces asString font: Preferences standardEToysButtonFont; color: (Color r: 0.806 g: 1.0 b: 0.645); target: self; actionSelector: #chooseDecimalPlaces; extent: 200 @ (TextStyle defaultFont height + 10); cornerStyle: #square; + borderStyle: BorderStyle raised; - borderColor: #raised; yourself. self addArrowsOn: button. ^ button ! Item was changed: ----- Method: NewVariableDialogMorph>>buildVarTypeButton (in category 'build') ----- buildVarTypeButton | button | button := SimpleButtonMorph new labelString: self varType translated font: Preferences standardEToysButtonFont; color: (Color r: 0.806 g: 1.0 b: 0.645); target: self; actionSelector: #chooseType; extent: 200 @ (TextStyle defaultFont height + 10); cornerStyle: #square; + borderStyle: BorderStyle raised; - borderColor: #raised; yourself. self addArrowsOn: button. ^ button ! Item was changed: ----- Method: PDAClockMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + aCanvas frameAndFillRectangle: self bounds fillColor: backgroundColor + borderWidth: self borderWidth borderColor: self borderColor. - aCanvas frameAndFillRectangle: bounds fillColor: backgroundColor - borderWidth: 1 borderColor: borderColor. super drawOn: aCanvas. ! Item was changed: ----- Method: PlayingCardDeck>>initialize (in category 'initialization') ----- initialize super initialize. self cellPositioning: #topLeft. self reverseTableCells: true. self layout: #grid. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. + self borderWidth: 0. - borderWidth := 0. self layoutInset: 0. stackingPolicy := #stagger. stackingOrder := #ascending. emptyDropPolicy := #any. self newSeed. ^self! Item was changed: ----- Method: RecordingControls>>initialize (in category 'initialization') ----- initialize "Initialize the receiver." | r full | super initialize. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. + self borderWidth: 2. - borderWidth := 2. self listDirection: #topToBottom. recorder := SoundRecorder new. recordingSaved := false. full := self addButtonRows. self changeCodec: OggSpeexCodec name: 'Speex'. "self addRecordLevelSliderIn: full." "Doesn't work in most or maybe even all platforms..." r := AlignmentMorph newRow vResizing: #shrinkWrap. r addMorphBack: (self makeRecordMeterIn: full). self addMorphBack: r. self extent: 10@10. "make minimum size" self setButtonEnablement ! Item was changed: ----- Method: RulerMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | s | super drawOn: aCanvas. s := self width printString, 'x', self height printString. + aCanvas drawString: s in: (self bounds insetBy: self borderWidth + 5) font: nil color: Color red. - aCanvas drawString: s in: (bounds insetBy: borderWidth + 5) font: nil color: Color red. ! Item was changed: ----- Method: SameGame>>buildButton:target:label:selector: (in category 'initialization') ----- buildButton: aButton target: aTarget label: aLabel selector: aSelector "wrap a button or switch in an alignmentMorph to allow a row of buttons to fill space" | a | aButton target: aTarget; label: aLabel; actionSelector: aSelector; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: color. a := AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap; color: color. a addMorph: aButton. ^ a ! Item was changed: ----- Method: SameGameTile>>setSwitchState: (in category 'accessing') ----- setSwitchState: aBoolean switchState := aBoolean. disabled ifFalse: [switchState ifTrue: + [self borderInset. - [self borderColor: #inset. self color: onColor] ifFalse: + [self borderRaised. - [self borderColor: #raised. self color: offColor]]! Item was changed: ----- Method: ScriptEditorMorph>>extent: (in category 'other') ----- extent: x | newExtent tw menu | newExtent := x max: self minWidth @ self minHeight. (tw := self findA: TwoWayScrollPane) ifNil: ["This was the old behavior" ^ super extent: newExtent]. (self hasProperty: #autoFitContents) ifTrue: [ menu := MenuMorph new defaultTarget: self. menu addUpdating: #autoFitString target: self action: #autoFitOnOff. menu addTitle: 'To resize the script, uncheck the box below' translated. menu popUpEvent: nil in: self world . ^ self]. "Allow the user to resize to any size" tw extent: ((newExtent x max: self firstSubmorph width) + @ (newExtent y - self firstSubmorph height)) - (self borderWidth * 2) + (-4 @ -4). "inset?" - @ (newExtent y - self firstSubmorph height)) - (borderWidth * 2) + (-4 @ -4). "inset?" ^ super extent: newExtent! Item was changed: ----- Method: ScriptableButton>>label: (in category 'accessing') ----- label: aString "Set the receiver's label as indicated" | aLabel | (aLabel := self findA: StringMorph) ifNotNil: [aLabel contents: aString] ifNil: [aLabel := StringMorph contents: aString font: Preferences standardEToysButtonFont. self addMorph: aLabel]. + self extent: aLabel extent + (self borderWidth + 6). - self extent: aLabel extent + (borderWidth + 6). aLabel position: self center - (aLabel extent // 2). aLabel lock! Item was changed: ----- Method: StackMorph>>formatList: (in category 'menu') ----- formatList: pl | rr ff | "Turn this plugglable list into a good looking morph." pl color: Color transparent; borderWidth: 0. pl font: ((TextStyle named: #Palatino) fontOfSize: 14). pl toggleCornerRounding; width: 252; retractableOrNot; hResizing: #spaceFill. rr := (RectangleMorph new) toggleCornerRounding; extent: pl extent + (30@30). rr color: self currentPage color; fillStyle: (ff := self currentPage fillStyle copy). ff isGradientFill ifTrue: [ rr fillStyle direction: (ff direction * self currentPage extent / rr extent) rounded. rr fillStyle origin: rr bounds origin]. rr addMorph: pl. rr layoutPolicy: TableLayout new. rr layoutInset: 10@15; cellInset: 10@15; wrapDirection: #leftToRight. + rr listCentering: #center; borderStyle: (BorderStyle raised width: 5). - rr listCentering: #center; borderWidth: 5; borderColor: #raised. "Up and down buttons on left with arrows in a holder." "lb := (RectangleMorph new) color: transparent; borderWidth: 0." ^ rr! Item was changed: ----- Method: StandardViewer>>addHeaderMorphWithBarHeight:includeDismissButton: (in category 'initialization') ----- addHeaderMorphWithBarHeight: anInteger includeDismissButton: aBoolean "Add the header morph to the receiver, using anInteger as a guide for its height, and if aBoolean is true, include a dismiss buton for it" | header aButton aTextMorph nail wrpr costs headWrapper | header := AlignmentMorph newRow color: Color transparent; wrapCentering: #center; cellPositioning: #leftCenter. aBoolean ifTrue: [aButton := self tanOButton. header addMorph: aButton. aButton actionSelector: #dismiss; setBalloonText: 'remove this entire Viewer from the screen don''t worry -- nothing will be lost!!.' translated. header addTransparentSpacerOfSize: 3]. costs := scriptedPlayer costumes. costs ifNotNil: [(costs size > 1 or: [costs size = 1 and: [costs first ~~ scriptedPlayer costume]]) ifTrue: [header addUpDownArrowsFor: self. "addArrowsOn: adds the box with two arrow at the front." (wrpr := header submorphs first) submorphs second setBalloonText: 'switch to previous costume' translated. wrpr submorphs first setBalloonText: 'switch to next costume' translated]. header addTransparentSpacerOfSize: 3]. self viewsMorph ifTrue: [scriptedPlayer costume assureExternalName]. aTextMorph := UpdatingStringMorph new useStringFormat; target: scriptedPlayer; getSelector: #nameForViewer; setNameTo: 'name'; font: ScriptingSystem fontForNameEditingInScriptor. self viewsMorph ifTrue: [aTextMorph putSelector: #setName:. aTextMorph setProperty: #okToTextEdit toValue: true]. aTextMorph step. header addMorphBack: aTextMorph. aTextMorph setBalloonText: 'Click here to edit the player''s name.' translated. header addMorphBack: ((self transparentSpacerOfSize: 0) hResizing: #spaceFill; color: Color red). aButton := ThreePhaseButtonMorph labelSymbol: #AddInstanceVariable target: scriptedPlayer actionSelector: #addInstanceVariable arguments: #(). aButton setBalloonText: 'click here to add a variable to this object.' translated. header addMorphBack: aButton. header addTransparentSpacerOfSize: 3. nail := (self hasProperty: #noInteriorThumbnail) ifFalse: [ThumbnailMorph new objectToView: scriptedPlayer viewSelector: #costume] ifTrue: [ImageMorph new image: (ScriptingSystem formAtKey: #MenuIcon)]. nail on: #mouseDown send: #offerViewerMenuForEvt:morph: to: scriptedPlayer. header addMorphBack: nail. nail setBalloonText: 'click here to get a menu that will allow you to locate this object, tear off a tile, etc..' translated. (self hasProperty: #noInteriorThumbnail) ifFalse: + [nail borderStyle: (BorderStyle raised width: 3)]. - [nail borderWidth: 3; borderColor: #raised]. header addTransparentSpacerOfSize: 3. aButton := ThreePhaseButtonMorph labelSymbol: #AddCategoryViewer. aButton actWhen: #buttonUp; target: self; actionSelector: #addCategoryViewer; setBalloonText: 'click here to add another category pane' translated. header addMorphBack: aButton. header beSticky. anInteger > 0 ifTrue: [headWrapper := AlignmentMorph newColumn color: self color. headWrapper addTransparentSpacerOfSize: (0 @ anInteger). headWrapper addMorphBack: header. self addMorph: headWrapper] ifFalse: [self addMorph: header]! Item was changed: ----- Method: SyntaxMorph>>borderColor: (in category 'accessing') ----- borderColor: colorOrSymbolOrNil + self borderColor = colorOrSymbolOrNil ifFalse: [ + super borderColor: colorOrSymbolOrNil. - borderColor = colorOrSymbolOrNil ifFalse: [ - borderColor := colorOrSymbolOrNil. self bounds area < 40000 ifTrue: [self invalidRect: self bounds] ifFalse: [(self bounds areasOutside: (self bounds insetBy: self borderWidth)) do: [:r | self invalidRect: r]]]. ! Item was changed: ----- Method: SyntaxMorph>>select (in category 'selection') ----- select self deselect. "Outer block is not colored and has no popup" (owner isSyntaxMorph and: [owner nodeClassIs: MethodNode]) ifTrue: [self setDeselectedColor "normal"] ifFalse: [self color: Color lightBrown]. + self borderStyle: (BorderStyle raised width: self borderWidth). - self borderColor: #raised. self offerPopUp.! Item was changed: ----- Method: SyntaxMorph>>trackDropZones (in category 'insertion drop zones') ----- trackDropZones | hand i localPt insertion insHt ii prevBot nxtHt d c1 c2 ht2 spacer1 spacer2 wid ht1 dc each | hand := self primaryHand. ("hand lastEvent redButtonPressed &" hand hasSubmorphs and: [(self hasOwner: hand) not]) ifFalse: [^ self]. insertion := hand firstSubmorph renderedMorph. insertion isSyntaxMorph ifFalse: [^ self]. insertion isNoun ifFalse: [(insertion nodeClassIs: CommentNode) ifFalse: [^ self]]. localPt := self globalPointToLocal: hand position. insHt := insertion height. "**just use standard line height here" self removeDropZones. "Maybe first check if in right place, then just tweak heights." i := (ii := self indexOfMorphAbove: localPt) min: submorphs size-1. prevBot := i <= 0 ifTrue: [(self innerBounds) top] ifFalse: [(self submorphs at: i) bottom]. nxtHt := (submorphs isEmpty ifTrue: [insertion] ifFalse: [self submorphs at: i+1]) height. d := ii > i ifTrue: [nxtHt "for consistent behavior at bottom"] ifFalse: [0 max: (localPt y - prevBot min: nxtHt)]. "Top and bottom spacer heights cause continuous motion..." c1 := Color transparent. c2 := Color transparent. ht2 := d*insHt//nxtHt. ht1 := insHt - ht2. + wid := self width - (2*self borderWidth) - (2*self layoutInset). - wid := self width - (2*borderWidth) - (2*self layoutInset). wid isPoint ifTrue: [wid := wid x]. (spacer1 := BorderedMorph newBounds: (0@0 extent: wid@ht1) color: (ht1 > (insHt//2) ifTrue: [c1] ifFalse: [c2])) borderWidth: 1; borderColor: spacer1 color. self privateAddMorph: spacer1 atIndex: (i+1 max: 1). (spacer2 := BorderedMorph newBounds: (0@0 extent: wid@ht2) color: (ht2 > (insHt//2+1) ifTrue: [c1] ifFalse: [c2])) borderWidth: 1; borderColor: spacer2 color. spacer1 setProperty: #dropZone toValue: true. spacer2 setProperty: #dropZone toValue: true. self privateAddMorph: spacer2 atIndex: (i+3 min: submorphs size+1). self fullBounds. "Force layout prior to testing for cursor containment" "Maintain the drop target highlight -- highlight spacer if hand is in it." {spacer1. spacer2} do: [:spacer | (spacer containsPoint: localPt) ifTrue: [spacer color: self dropColor. "Ignore border color. Maybe do it later. self borderColor = self dropColor ifTrue: [self borderColor: self stdBorderColor]"]]. "If no submorph (incl spacers) highlighted, then re-highlight the block." "Ignore border color. Maybe do it later. ((self wantsDroppedMorph: insertion event: hand lastEvent) and: [(self submorphs anySatisfy: [:m | m containsPoint: localPt]) not]) ifTrue: [self borderColor: self dropColor]. " "Dragging a tile within a Block, if beside a tile, color it a dropzone" "Transcript show: localPt y printString; space; show: submorphs first top printString; space; show: submorphs last top printString; cr." dc := self dropColor. 1 to: ((ii+4 min: submorphs size) max: 1) do: [:ind | each := submorphs at: ind. each isSyntaxMorph ifTrue: [ localPt y >= each top ifTrue: ["in this one or beyond" (localPt y < each bottom) ifTrue: [(each submorphs anySatisfy: [:m | m containsPoint: localPt]) ifTrue: [each setDeselectedColor] ifFalse: [each color: dc]] ifFalse: [each color = dc ifTrue: [each setDeselectedColor]]] ifFalse: [each color = dc ifTrue: [each setDeselectedColor]]]]. ! Item was changed: ----- Method: SyntaxMorph>>unhighlight (in category 'highlighting') ----- unhighlight + self setDeselectedColor.! - self setDeselectedColor. - - - false ifTrue: [ - self currentSelectionDo: [:innerMorph :mouseDownLoc :outerMorph | - self color: ( false - "(self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]])" - ifTrue: [self valueOfProperty: #deselectedBorderColor ifAbsent: [#raised]] - ifFalse: [self color: Color transparent] - ) - ]]. - ! Item was changed: ----- Method: SyntaxMorph>>unhighlightBorder (in category 'highlighting') ----- unhighlightBorder self currentSelectionDo: [:innerMorph :mouseDownLoc :outerMorph | self borderColor: ( (self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]]) + ifFalse: [self borderColor: self stdBorderColor] + ifTrue: [ + (self hasProperty: #deselectedBorderColor) + ifTrue: [self borderColor: (self valueOfProperty: #deselectedBorderColor)] + ifFalse: [self borderStyle: (BorderStyle raised width: self borderWidth)]] )].! - ifTrue: [self valueOfProperty: #deselectedBorderColor ifAbsent: [#raised]] - ifFalse: [self stdBorderColor] - ) - ] - ! Item was changed: ----- Method: Tetris>>buildButtonTarget:label:selector:help: (in category 'initialization') ----- buildButtonTarget: aTarget label: aLabel selector: aSelector help: aString ^self rowForButtons addMorph: ( SimpleButtonMorph new target: aTarget; label: aLabel; actionSelector: aSelector; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: color ) ! Item was changed: ----- Method: TileMorph>>typeColor: (in category 'misc') ----- typeColor: aColor "Set the receiver's typeColor" + self borderColor: ScriptingSystem standardTileBorderColor. + - borderColor := ScriptingSystem standardTileBorderColor. typeColor := aColor. color := ScriptingSystem uniformTileInteriorColor ! Item was changed: ----- Method: WatchMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas "Draw the watch on the given canvas" | pHour pMin pSec time centerColor | time := Time now. pHour := self radius: 0.6 hourAngle: time hours + (time minutes/60.0). pMin := self radius: 0.72 hourAngle: (time minutes / 5.0). pSec := self radius: 0.8 hourAngle: (time seconds / 5.0). centerColor := cColor ifNil: [Color transparent] ifNotNil: [time hours < 12 ifTrue: [cColor muchLighter] ifFalse: [cColor]]. antialias ifTrue: [aCanvas asBalloonCanvas aaLevel: 4; + drawOval: (self bounds insetBy: self borderWidth // 2 + 1) color: self fillStyle + borderWidth: self borderWidth borderColor: self borderColor; + drawOval: (self bounds insetBy: self extent*0.35) color: centerColor - drawOval: (bounds insetBy: borderWidth // 2 + 1) color: self fillStyle - borderWidth: borderWidth borderColor: borderColor; - drawOval: (bounds insetBy: self extent*0.35) color: centerColor borderWidth: 0 borderColor: Color black; drawPolygon: {self center. pHour} color: Color transparent borderWidth: 3 borderColor: handsColor; drawPolygon: {self center. pMin} color: Color transparent borderWidth: 2 borderColor: handsColor; drawPolygon: {self center. pSec} color: Color transparent borderWidth: 1 borderColor: handsColor] ifFalse: [super drawOn: aCanvas. aCanvas + fillOval: (self bounds insetBy: self extent*0.35) color: centerColor; - fillOval: (bounds insetBy: self extent*0.35) color: centerColor; line: self center to: pHour width: 3 color: handsColor; line: self center to: pMin width: 2 color: handsColor; line: self center to: pSec width: 1 color: handsColor] !

1 0

← Newer
1
...
5
6
7
8
9
10
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2018