Squeak-dev May 2015

squeak-dev@lists.squeakfoundation.org

50 participants
615 discussions

The Trunk: Collections-tfel.624.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Tim Felgentreff uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-tfel.624.mcz ==================== Summary ==================== Name: Collections-tfel.624 Author: tfel Time: 1 May 2015, 3:39:37.7 pm UUID: 5cb7424e-b88f-3b4e-beb3-c97639f2d91f Ancestors: Collections-tfel.623 remove overrides for beginsWith: in ByteStrings and ByteSymbols, because these actually perform worse now than the generic implementation in String =============== Diff against Collections-tfel.623 =============== Item was removed: - ----- Method: ByteString>>beginsWith: (in category 'testing') ----- - beginsWith: sequence - "Answer whether the receiver begins with the given sequence. The comparison is case-sensitive. Overridden for better performance." - - | sequenceSize | - sequence class isBytes ifFalse: [ ^super beginsWith: sequence ]. - ((sequenceSize := sequence size) = 0 or: [ self size < sequenceSize ]) ifTrue: [ ^false ]. - "The following method uses a suboptimal algorithm (brute force pattern matching with O(n^2) worst case runtime), but the primitive in C is so fast (assuming large alphabets), that it's still worth using it instead of linear time pure smalltalk implementation. There are some obvious cases when the brute force algorithm is suboptimal, e.g. when the first elements don't match, so let's compare them here before using the primitive." - (self basicAt: 1) = (sequence basicAt: 1) ifFalse: [ ^false ]. - ^(self findSubstring: sequence in: self startingAt: 1 matchTable: CaseSensitiveOrder) = 1! Item was removed: - ----- Method: ByteSymbol>>beginsWith: (in category 'testing') ----- - beginsWith: sequence - "Answer whether the receiver begins with the given sequence. The comparison is case-sensitive. Overridden for better performance." - - | sequenceSize | - sequence class isBytes ifFalse: [ ^super beginsWith: sequence ]. - ((sequenceSize := sequence size) = 0 or: [ self size < sequenceSize ]) ifTrue: [ ^false ]. - "The following method uses a suboptimal algorithm (brute force pattern matching with O(n^2) worst case runtime), but the primitive in C is so fast (assuming large alphabets), that it's still worth using it instead of linear time pure smalltalk implementation. There are some obvious cases when the brute force algorithm is suboptimal, e.g. when the first elements don't match, so let's compare them here before using the primitive." - (self basicAt: 1) = (sequence basicAt: 1) ifFalse: [ ^false ]. - ^(self findSubstring: sequence in: self startingAt: 1 matchTable: CaseSensitiveOrder) = 1!

1 0

The Trunk: Kernel-nice.923.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.923.mcz ==================== Summary ==================== Name: Kernel-nice.923 Author: nice Time: 1 May 2015, 3:32:43.592 pm UUID: 875249b7-3037-4f50-9ab1-c1b2ec94b0e1 Ancestors: Kernel-nice.922 Use an intermediate abstract Float representation (sign, exponent, significand) in order to convert single precision bits to double precision bits rather than attempting the conversion by direct bit manipulations. This lead to simpler code, because it is like a semantic bit manipulation rather than a raw bit manipulation. And this also lead to faster code on 32 bits interpreter/COG/Spur VM thanks to avoidance of LargeInteger (was Kernel-nice.893 / 24 December 2014) =============== Diff against Kernel-nice.922 =============== Item was changed: ----- Method: Float class>>fromIEEE32Bit: (in category 'instance creation') ----- fromIEEE32Bit: word "Convert the given 32 bit word (which is supposed to be a positive 32bit value) from a 32bit IEEE floating point representation into an actual Squeak float object (being 64bit wide). Should only be used for conversion in FloatArrays or likewise objects." + | sign mantissa exponent | - | sign mantissa exponent newFloat delta | word negative ifTrue: [^ self error:'Cannot deal with negative numbers']. word = 0 ifTrue: [^ Float zero]. + word = 16r80000000 ifTrue: [^Float negativeZero]. - sign := word bitAnd: 16r80000000. - word = sign ifTrue: [^self negativeZero]. + sign := word bitShift: -31. exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127. mantissa := word bitAnd: 16r7FFFFF. exponent = 128 ifTrue:["Either NAN or INF" mantissa = 0 ifFalse:[^ Float nan]. sign = 0 ifTrue:[^ Float infinity] ifFalse:[^ Float negativeInfinity]]. + exponent = -127 + ifTrue: + ["gradual underflow (denormalized number) + There is no implied one, but the exponent is -126" + exponent := -126] + ifFalse: + [mantissa := mantissa + 16r800000 "impliedOne"]. - exponent = -127 ifTrue: [ - "gradual underflow (denormalized number) - Remove first bit of mantissa and adjust exponent" - delta := mantissa highBit. - mantissa := (mantissa bitAnd: (1 bitShift: delta - 1) - 1) bitShift: 24 - delta. - exponent := exponent + delta - 23]. "Create new float" + ^(sign = 0 + ifTrue: [mantissa] + ifFalse: [mantissa negated]) + asFloat timesTwoPower: exponent - 23! - newFloat := self new: 2. - newFloat basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)). - newFloat basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29). - ^newFloat!

1 0

The Trunk: Kernel-nice.922.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.922.mcz ==================== Summary ==================== Name: Kernel-nice.922 Author: nice Time: 1 May 2015, 3:24:52.309 pm UUID: 609507cb-36a8-44cd-a2ab-368a7a8b6a02 Ancestors: Kernel-nice.921 Remove an un-necessary inst. var. shadowing (inbox Kernel-nice.745 7 March 2013) =============== Diff against Kernel-nice.921 =============== Item was changed: ----- Method: ContextPart>>asMessage (in category 'converting') ----- asMessage + | selector args | - | sender selector args | - sender := self sender. selector := sender method selector. args := Array new: selector numArgs. 1 to: selector numArgs do: [ :i | args at: i put: (sender tempAt: i)]. ^ Message selector: selector arguments: args.!

1 0

The Trunk: KernelTests-nice.293.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.293.mcz ==================== Summary ==================== Name: KernelTests-nice.293 Author: nice Time: 1 May 2015, 3:16:46.949 pm UUID: fb60846c-b40a-4f89-9ec5-1260cfbf0319 Ancestors: KernelTests-mt.292 Tests asserting floorLog: exactness for Number performing exact arithmetic. This was inbox KernelTests-nice.239 / 11 December 2012 =============== Diff against KernelTests-mt.292 =============== Item was added: + ----- Method: FractionTest>>testFloorLogExactness (in category 'tests - mathematical functions') ----- + testFloorLogExactness + + 1 + (Float fminDenormalized floorLog: 10) to: -1 do: [:n | + self assert: ((10 raisedTo: n) floorLog: 10) = n]. + + "Float version is not exact for at least 2 reasons: + 1/(10 raisedTo: n) asFloat is not exact + (aFloat log: radix) is not exact + + (1 + (Float fminDenormalized floorLog: 10) to: -1) count: [:n | + ((10 raisedTo: n) asFloat floorLog: 10) ~= n]." + ! Item was added: + ----- Method: IntegerTest>>testFloorLogExactness (in category 'tests - mathematical functions') ----- + testFloorLogExactness + + 1 to: (Float fmax floorLog: 10) do: [:n | + self assert: ((10 raisedTo: n) floorLog: 10) = n]. + + "Float version is not exact for at least 2 reasons: + (10 raisedTo: n) asFloat is not exact for n > 22 + (aFloat log: radix) is not exact + + (1 to: (Float fmax floorLog: 10)) count: [:n | + ((10 raisedTo: n) asFloat floorLog: 10) ~= n]."! Item was added: + ----- Method: ScaledDecimalTest>>testFloorLogExactness (in category 'tests - mathematical functions') ----- + testFloorLogExactness + 1 + (Float fminDenormalized floorLog: 10) to: (Float fmax floorLog: 10) do: [:n | + self assert: ((10 raisedTo: n) asScaledDecimal floorLog: 10) = n description: 'floorLog should be exact for ScaledDecimals'.]!

1 0

The Trunk: Kernel-nice.921.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.921.mcz ==================== Summary ==================== Name: Kernel-nice.921 Author: nice Time: 1 May 2015, 3:09:15.528 pm UUID: 1ce76bf5-1e32-4d12-b7b1-9f23a75d37b2 Ancestors: Kernel-topa.920 Provide an exact version for #floorLog: for those Number using exact arithmetic (as proposed in inbox Kernel-nice.721 / 11 December 2012). Previous version was not exact, otherwise this count would have been zero: (-300 to: -1) count: [:n | n ~= ((10 raisedTo: n) floorLog: 10)]. Note that this won't make #log: exact, and could lead to disagreement between the two functions. However, old behavior compatible with log: is still possible by passing the radix argument asFloat, so this is not a real problem. =============== Diff against Kernel-topa.920 =============== Item was added: + ----- Method: Fraction>>floorLog: (in category 'mathematical functions') ----- + floorLog: radix + "Unlike super, this version is exact when radix is integer" + + | d n | + radix isInteger ifFalse: [^super floorLog: 10]. + n := numerator floorLog: radix. + d := denominator floorLog: radix. + ^(numerator * (radix raisedTo: d)) + < (denominator * (radix raisedTo: n)) + ifTrue: [n - d - 1] + ifFalse: [n - d]! Item was added: + ----- Method: Integer>>floorLog: (in category 'mathematical functions') ----- + floorLog: radix + "Unlike super, this version is exact when radix is integer" + + radix isInteger ifFalse: [^super floorLog: 10]. + self <= 0 ifTrue: [^DomainError signal: 'floorLog: is only defined for x > 0.0']. + ^(self numberOfDigitsInBase: radix) - 1! Item was added: + ----- Method: ScaledDecimal>>floorLog: (in category 'mathematical functions') ----- + floorLog: radix + "Unlike super, this version is exact when radix is integer" + + ^self asFraction floorLog: radix!

1 0

Re: [squeak-dev] The Trunk: Morphic-mt.895.mcz
by Nicolas Cellier 01 May '15

01 May '15

2015-04-17 15:58 GMT+02:00 <commits(a)source.squeak.org>: > Marcel Taeumel uploaded a new version of Morphic to project The Trunk: > http://source.squeak.org/trunk/Morphic-mt.895.mcz > > ==================== Summary ==================== > > Name: Morphic-mt.895 > Author: mt > Time: 17 April 2015, 3:58:36.602 pm > UUID: 955fb45c-fbb5-d545-8e18-2f22524bcd24 > Ancestors: Morphic-mt.894 > > Added the missing hooks so that text models can not only handle printing > but also debugging, exploring, inspecting, and even evaluation. > > This avoids having to subclass PluggableTextMorph, TextMorph, and > TextEditor for achieving the same variation point. > > =============== Diff against Morphic-mt.894 =============== > > Item was changed: > ----- Method: TextEditor>>debugIt (in category 'do-its') ----- > debugIt > > + | receiver context | > - | method receiver context | > - (model respondsTo: #doItReceiver) > - ifTrue: > - [receiver := model doItReceiver. > - context := model doItContext] > - ifFalse: > - [receiver := context := nil]. > self lineSelectAndEmptyCheck: [^self]. > + > + (model respondsTo: #debugIt:) > + ifTrue: [^ model perform: #debugIt: with: self selection]. > + > + receiver := (model respondsTo: #doItReceiver) > + ifTrue: [model doItReceiver] > + ifFalse: [nil]. > + > + context := (model respondsTo: #doItContext) > + ifTrue: [model doItContext] > + ifFalse: [nil]. > + > + (self compileSelectionFor: receiver in: context) ifNotNil: > [:method | > + self debug: method receiver: receiver in: context].! > - method := self compileSelectionFor: receiver in: context. > - method notNil ifTrue: > - [self debug: method receiver: receiver in: context].! > > Item was changed: > ----- Method: TextEditor>>evaluateSelectionAndDo: (in category 'do-its') > ----- > evaluateSelectionAndDo: aBlock > "Treat the current selection as an expression; evaluate it and > invoke aBlock with the result." > | result rcvr ctxt | > self lineSelectAndEmptyCheck: [^ nil]. > > + (model respondsTo: #evaluate:) ifTrue: [ > + ^ aBlock value: (model perform: #evaluate: with: self > selection)]. > + > In one image with Tweak loaded (http://squeaksource.com/TweakCore) this change had the effect loosing the ability to do it/print it/inspect it For example, typing one of most basic Smalltalk expression 3+4 -> a Text for '3+4' This is because the Scripting package installs Object>>evaluate: aBlock ^aBlock value What are these hooks usefull for? They do not seem in usage currently in the image. Nicolas > (model respondsTo: #doItReceiver) > ifTrue: [ rcvr := model doItReceiver. > ctxt := model doItContext] > ifFalse: [rcvr := ctxt := nil]. > result := [ > rcvr class evaluatorClass new > evaluate: self selectionAsStream > in: ctxt > to: rcvr > notifying: self > ifFail: [morph flash. ^ nil] > logged: true. > ] > on: OutOfScopeNotification > do: [ :ex | ex resume: true]. > > (model respondsTo: #evaluated:result:) ifTrue: [ > model perform: #evaluated:result: with: self selection > with: result]. > > ^aBlock value: result! > > Item was changed: > ----- Method: TextEditor>>exploreIt (in category 'do-its') ----- > exploreIt > + > + self evaluateSelectionAndDo: [:result | > + (model respondsTo: #exploreIt:result:) > + ifTrue: [model > + perform: #exploreIt:result: > + with: self selection > + with: result] > + ifFalse: [result explore]].! > - self evaluateSelectionAndDo: [:result | result explore]! > > Item was changed: > ----- Method: TextEditor>>inspectIt (in category 'do-its') ----- > inspectIt > + > + self evaluateSelectionAndDo: [:result | > + (model respondsTo: #inspectIt:result:) > + ifTrue: [model > + perform: #inspectIt:result: > + with: self selection > + with: result] > + ifFalse: [result inspect]].! > - self evaluateSelectionAndDo: [:result | result inspect]! > > >

2 2

The Trunk: 46Deprecated-mt.1.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of 46Deprecated to project The Trunk: http://source.squeak.org/trunk/46Deprecated-mt.1.mcz ==================== Summary ==================== Name: 46Deprecated-mt.1 Author: mt Time: 1 May 2015, 2:33:12.046 pm UUID: a2c7055c-a7ec-4442-b80a-8e076a79e39c Ancestors: Some deprecations for 4.6 added. ==================== Snapshot ==================== ----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category '*46Deprecated') ----- exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." | is str ans revertSeg roots holder | self flag: #toRemove. self halt. "unused" "world == World ifTrue: [^ false]." "self inform: 'Can''t send the current world out'." world ifNil: [^ false]. world presenter ifNil: [^ false]. ScrapBook default emptyScrapBook. world currentHand pasteBuffer: nil. "don't write the paste buffer." world currentHand mouseOverHandler initialize. "forget about any references here" "Display checkCurrentHandForObjectToPaste." Command initialize. world clearCommandHistory. world fullReleaseCachedState; releaseViewers. world cleanseStepList. world localFlapTabs size = world flapTabs size ifFalse: [ self error: 'Still holding onto Global flaps']. world releaseSqueakPages. holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" "Just export me, not my previous version" revertSeg := self parameterAt: #revertToMe. self projectParameters removeKey: #revertToMe ifAbsent: []. roots := OrderedCollection new. roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]). roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" catList do: [:sysCat | (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb | roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]]. is := ImageSegment new copySmartRootsExport: roots asArray. "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)" is state = #tooBig ifTrue: [^ false]. str := ''. "considered legal to save a project that has never been entered" (is outPointers includes: world) ifTrue: [ str := str, '\Project''s own world is not in the segment.' withCRs]. str isEmpty ifFalse: [ ans := (UIManager default chooseFrom: #('Do not write file' 'Write file anyway' 'Debug') title: str). ans = 1 ifTrue: [ revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg]. ^ false]. ans = 3 ifTrue: [self halt: 'Segment not written']]. is writeForExportWithSources: aFileName inDirectory: aDirectory. revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg]. holder. world flapTabs do: [:ft | (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. is arrayOfRoots do: [:obj | obj isScriptEditorMorph ifTrue: [obj unhibernate]]. ^ true ! ----- Method: Browser>>classComment:notifying: (in category '*46Deprecated') ----- classComment: aText notifying: aPluggableTextMorph "The user has just entered aText. It may be all red (a side-effect of replacing the default comment), so remove the color if it is." | theClass cleanedText redRange | theClass := self selectedClassOrMetaClass. theClass ifNotNil: [cleanedText := aText asText. redRange := cleanedText rangeOf: TextColor red startingAt: 1. redRange size = cleanedText size ifTrue: [cleanedText removeAttribute: TextColor red from: 1 to: redRange last ]. theClass comment: aText stamp: Utilities changeStamp]. self changed: #classCommentText. ^ true! ----- Method: Browser>>defineMessage:notifying: (in category '*46Deprecated') ----- defineMessage: aString notifying: aController self deprecated: 'Use Browser >> #defineMessageFrom:notifying:. This returns a Symbol or nil, not a Boolean.'. ^ (self defineMessageFrom: aString notifying: aController) notNil.! ----- Method: Browser>>messageListSingleton (in category '*46Deprecated') ----- messageListSingleton | name | name := self selectedMessageName. ^ name ifNil: [Array new] ifNotNil: [Array with: name]! ----- Method: Browser>>optionalAnnotationHeight (in category '*46Deprecated') ----- optionalAnnotationHeight ^ 10! ----- Method: Browser>>optionalButtonHeight (in category '*46Deprecated') ----- optionalButtonHeight ^ 10! ----- Method: Browser>>potentialClassNames (in category '*46Deprecated') ----- potentialClassNames "Answer the names of all the classes that could be viewed in this browser. This hook is provided so that HierarchyBrowsers can indicate their restricted subset. For generic Browsers, the entire list of classes known to Smalltalk is provided, though of course that really only is accurate in the case of full system browsers." ^ Smalltalk classNames! ----- Method: CodeHolder>>abbreviatedWordingFor: (in category '*46Deprecated') ----- abbreviatedWordingFor: aButtonSelector "Answer the abbreviated form of wording, from a static table. Answer nil if there is no entry -- in which case the long form will be used on the corresponding browser button." #( (browseMethodFull 'browse') (browseSendersOfMessages 'senders') (browseMessages 'impl') (browseVersions 'vers') (methodHierarchy 'inher') (classHierarchy 'hier') (browseVariableReferences 'refs') (offerMenu 'menu')) do: [:pair | pair first == aButtonSelector ifTrue: [^ pair second]]. ^ nil! ----- Method: CodeHolder>>showingDiffsString (in category '*46Deprecated') ----- showingDiffsString "Answer a string representing whether I'm showing diffs. Not sent any more but retained so that prexisting buttons that sent this will not raise errors." ^ (self showingRegularDiffs ifTrue: ['<yes>'] ifFalse: ['<no>']), 'showDiffs'! ----- Method: CodeHolder>>toggleDiff (in category '*46Deprecated') ----- toggleDiff "Retained for backward compatibility with existing buttons in existing images" self toggleDiffing! ----- Method: HierarchyBrowser>>potentialClassNames (in category '*46Deprecated') ----- potentialClassNames "Answer the names of all the classes that could be viewed in this browser" ^ self classList collect: [:aName | aName copyWithout: $ ]! ----- Method: ScrollPane>>alwaysShowHScrollBar: (in category '*46Deprecated') ----- alwaysShowHScrollBar: bool self flag: #deprecated. self setProperty: #hScrollBarAlways toValue: bool. bool ifTrue: [self hScrollBarPolicy: #always] ifFalse: [self hScrollBarPolicy: #whenNeeded]. self hHideOrShowScrollBar. ! ----- Method: ScrollPane>>alwaysShowScrollBars: (in category '*46Deprecated') ----- alwaysShowScrollBars: bool "Get rid of scroll bar for short panes that don't want it shown." self flag: #deprecated. self alwaysShowHScrollBar: bool; alwaysShowVScrollBar: bool. ! ----- Method: ScrollPane>>alwaysShowVScrollBar: (in category '*46Deprecated') ----- alwaysShowVScrollBar: bool self flag: #deprecated. self setProperty: #vScrollBarAlways toValue: bool. bool ifTrue: [self vScrollBarPolicy: #always] ifFalse: [self vScrollBarPolicy: #whenNeeded]. self vHideOrShowScrollBar. ! ----- Method: ScrollPane>>hInitScrollBarTEMPORARY (in category '*46Deprecated') ----- hInitScrollBarTEMPORARY "This is called lazily before the hScrollBar is accessed in a couple of places. It is provided to transition old ScrollPanes lying around that do not have an hScrollBar. Once it has been in the image for awhile, and all ScrollPanes have an hScrollBar, this method and it's references can be removed. " "Temporary method for filein of changeset" hScrollBar ifNil: [hScrollBar := ScrollBar new model: self slotName: 'hScrollBar'. hScrollBar borderWidth: 1; borderColor: Color black. self resizeScrollBars; setScrollDeltas; hideOrShowScrollBars]. ! ----- Method: ScrollPane>>hideHScrollBarIndefinitely: (in category '*46Deprecated') ----- hideHScrollBarIndefinitely: bool "Get rid of scroll bar for short panes that don't want it shown." self flag: #deprecated. self setProperty: #noHScrollBarPlease toValue: bool. bool ifTrue: [self hScrollBarPolicy: #never] ifFalse: [self hScrollBarPolicy: #whenNeeded]. self hHideOrShowScrollBar. ! ----- Method: ScrollPane>>hideScrollBarsIndefinitely: (in category '*46Deprecated') ----- hideScrollBarsIndefinitely: bool "Get rid of scroll bar for short panes that don't want it shown." self flag: #deprecated. self hideVScrollBarIndefinitely: bool. self hideHScrollBarIndefinitely: bool. ! ----- Method: ScrollPane>>hideVScrollBarIndefinitely: (in category '*46Deprecated') ----- hideVScrollBarIndefinitely: bool "Get rid of scroll bar for short panes that don't want it shown." self flag: #deprecated. self setProperty: #noVScrollBarPlease toValue: bool. bool ifTrue: [self vScrollBarPolicy: #never] ifFalse: [self vScrollBarPolicy: #whenNeeded]. self vHideOrShowScrollBar. ! ----- Method: ScrollPane>>isAScrollbarShowing (in category '*46Deprecated') ----- isAScrollbarShowing "Return true if a either retractable scroll bar is currently showing" self flag: #deprectaed. "mt: Use #isAnyScrollbarShowing" retractableScrollBar ifFalse:[^true]. ^self hIsScrollbarShowing or: [self vIsScrollbarShowing] ! ----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded: (in category '*46Deprecated') ----- showHScrollBarOnlyWhenNeeded: bool "Get rid of scroll bar for short panes that don't want it shown." self flag: #deprecated. self setProperty: #noHScrollBarPlease toValue: bool not. self setProperty: #hScrollBarAlways toValue: bool not. bool ifTrue: [self hScrollBarPolicy: #whenNeeded] ifFalse: [self hScrollBarPolicy: #never]. self hHideOrShowScrollBar. ! ----- Method: ScrollPane>>showScrollBarsOnlyWhenNeeded: (in category '*46Deprecated') ----- showScrollBarsOnlyWhenNeeded: bool self flag: #deprecated. self showHScrollBarOnlyWhenNeeded: bool. self showVScrollBarOnlyWhenNeeded: bool. ! ----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded: (in category '*46Deprecated') ----- showVScrollBarOnlyWhenNeeded: bool "Get rid of scroll bar for short panes that don't want it shown." self flag: #deprecated. self setProperty: #noVScrollBarPlease toValue: bool not. self setProperty: #vScrollBarAlways toValue: bool not. bool ifTrue: [self vScrollBarPolicy: #whenNeeded] ifFalse: [self vScrollBarPolicy: #never]. self vHideOrShowScrollBar. !

1 0

The Trunk: Tools-mt.613.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.613.mcz ==================== Summary ==================== Name: Tools-mt.613 Author: mt Time: 1 May 2015, 2:32:16.632 pm UUID: e0697d0b-8eb9-5647-81bd-922a24eb997f Ancestors: Tools-mt.612 Deprecations updated. =============== Diff against Tools-mt.612 =============== Item was changed: ----- Method: Browser>>arrowKey:from: (in category 'multi-window support') ----- arrowKey: aChar from: view "Intercept Apple-Digit to select panes" | index | (aChar isDigit + and: [self multiWindowState notNil]) ifTrue: - and: [multiWindowState notNil]) ifTrue: [index := aChar asciiValue - $0 asciiValue. index = 0 ifTrue: [index := 10]. + ^index <= self multiWindowState models size + ifTrue: [self multiWindowState selectWindowIndex: index] - ^index <= multiWindowState models size - ifTrue: [multiWindowState selectWindowIndex: index] ifFalse: [self changed: #flash]]. ^super arrowKey: aChar from: view ! Item was removed: - ----- Method: Browser>>classComment:notifying: (in category 'class comment pane') ----- - classComment: aText notifying: aPluggableTextMorph - "The user has just entered aText. - It may be all red (a side-effect of replacing the default comment), so remove the color if it is." - - | theClass cleanedText redRange | - theClass := self selectedClassOrMetaClass. - theClass - ifNotNil: [cleanedText := aText asText. - redRange := cleanedText rangeOf: TextColor red startingAt: 1. - redRange size = cleanedText size - ifTrue: [cleanedText - removeAttribute: TextColor red - from: 1 - to: redRange last ]. - theClass comment: aText stamp: Utilities changeStamp]. - self changed: #classCommentText. - ^ true! Item was changed: ----- Method: Browser>>classHierarchy (in category 'multi-window support') ----- classHierarchy | behavior newBrowser | (behavior := self selectedClassOrMetaClass) isNil ifTrue: [^self]. (self isPackage "PackageBrowser pains can't support a hierarchy browser; not sure why." + or: [self multiWindowState isNil]) ifTrue: - or: [multiWindowState isNil]) ifTrue: [^super classHierarchy]. (newBrowser := HierarchyBrowser new initHierarchyForClass: behavior) selectMessageCategoryNamed: self selectedMessageCategoryName; selectMessageNamed: self selectedMessageName; editSelection: editSelection. + self multiWindowState addWindow: newBrowser - multiWindowState addWindow: newBrowser ! Item was removed: - ----- Method: Browser>>defineMessage:notifying: (in category 'message functions') ----- - defineMessage: aString notifying: aController - self deprecated: 'Use Browser >> #defineMessageFrom:notifying:. This returns a Symbol or nil, not a Boolean.'. - ^ (self defineMessageFrom: aString notifying: aController) notNil.! Item was changed: ----- Method: Browser>>findClass (in category 'system category functions') ----- findClass "Search for a class by name." | foundClass | + (self multiWindowState notNil - (multiWindowState notNil or: [self okToChange]) ifFalse: [^self classNotFound]. foundClass := UIManager default chooseClassOrTrait. foundClass ifNil: [^self classNotFound]. (self selectedClass notNil + and: [self multiWindowState notNil - and: [multiWindowState notNil "Can only support multi-window if original window has all the right panes." + and: [self multiWindowState prototype isHierarchy not]]) ifTrue: - and: [multiWindowState prototype isHierarchy not]]) ifTrue: [(self classList includes: foundClass name) + ifTrue: [self multiWindowState copyWindow] + ifFalse: [self multiWindowState addNewWindow]]. - ifTrue: [multiWindowState copyWindow] - ifFalse: [multiWindowState addNewWindow]]. self selectCategoryForClass: foundClass. self selectClass: foundClass! Item was changed: ----- Method: Browser>>labelString (in category 'initialize-release') ----- labelString | label | label := self selectedClassName ifNil: [ self defaultBrowserTitle ] ifNotNil: [ self defaultBrowserTitle, ': ', self selectedClassName asString ]. + (self multiWindowState notNil + and: [self multiWindowState models size > 1]) ifTrue: + [label := (self multiWindowState models indexOf: self) printString, '. ', label]. - (multiWindowState notNil - and: [multiWindowState models size > 1]) ifTrue: - [label := (multiWindowState models indexOf: self) printString, '. ', label]. ^label! Item was removed: - ----- Method: Browser>>messageListSingleton (in category 'message list') ----- - messageListSingleton - - | name | - name := self selectedMessageName. - ^ name ifNil: [Array new] - ifNotNil: [Array with: name]! Item was changed: ----- Method: Browser>>okToClose (in category 'multi-window support') ----- okToClose ^super okToClose + and: [self multiWindowState isNil or: [self multiWindowState okToClose]]! - and: [multiWindowState isNil or: [multiWindowState okToClose]]! Item was removed: - ----- Method: Browser>>optionalAnnotationHeight (in category 'initialize-release') ----- - optionalAnnotationHeight - - ^ 10! Item was removed: - ----- Method: Browser>>optionalButtonHeight (in category 'initialize-release') ----- - optionalButtonHeight - - ^ 10! Item was removed: - ----- Method: Browser>>potentialClassNames (in category 'system category functions') ----- - potentialClassNames - "Answer the names of all the classes that could be viewed in this browser. This hook is provided so that HierarchyBrowsers can indicate their restricted subset. For generic Browsers, the entire list of classes known to Smalltalk is provided, though of course that really only is accurate in the case of full system browsers." - - ^ Smalltalk classNames! Item was removed: - ----- Method: CodeHolder>>abbreviatedWordingFor: (in category 'commands') ----- - abbreviatedWordingFor: aButtonSelector - "Answer the abbreviated form of wording, from a static table. Answer nil if there is no entry -- in which case the long form will be used on the corresponding browser button." - - #( - (browseMethodFull 'browse') - (browseSendersOfMessages 'senders') - (browseMessages 'impl') - (browseVersions 'vers') - (methodHierarchy 'inher') - (classHierarchy 'hier') - (browseVariableReferences 'refs') - (offerMenu 'menu')) do: - - [:pair | pair first == aButtonSelector ifTrue: [^ pair second]]. - ^ nil! Item was changed: ----- Method: CodeHolder>>buildCodeProvenanceButtonWith: (in category 'toolbuilder') ----- buildCodeProvenanceButtonWith: builder | buttonSpec | buttonSpec := builder pluggableActionButtonSpec new. + buttonSpec + model: self; + label: #codePaneProvenanceString; + changeLabelWhen: #contents; + style: #menuButton; + action: #offerWhatToShowMenu; + help: 'Governs what view is shown in the code pane. Click here to change the view'; + margin: (5@0 corner: 0@0). - buttonSpec model: self. - buttonSpec label: #codePaneProvenanceString. - buttonSpec changeLabelWhen: #contents. - buttonSpec style: #menuButton. - buttonSpec action: #offerWhatToShowMenu. - buttonSpec help: 'Governs what view is shown in the code pane. Click here to change the view'. ^buttonSpec! Item was changed: ----- Method: CodeHolder>>restoreTextualCodingPane (in category 'diffs') ----- restoreTextualCodingPane "If the receiver is showing tiles, restore the textual coding pane" + contentsSymbol == #tiles ifTrue: - self showingTiles ifTrue: [contentsSymbol := #source. self installTextualCodingPane]! Item was removed: - ----- Method: CodeHolder>>showingDiffsString (in category 'diffs') ----- - showingDiffsString - "Answer a string representing whether I'm showing diffs. Not sent any more but retained so that prexisting buttons that sent this will not raise errors." - - ^ (self showingRegularDiffs - ifTrue: - ['<yes>'] - ifFalse: - ['<no>']), 'showDiffs'! Item was removed: - ----- Method: CodeHolder>>showingTiles (in category 'diffs') ----- - showingTiles - "Answer whether the receiver is currently showing tiles" - - ^ contentsSymbol == #tiles - ! Item was removed: - ----- Method: CodeHolder>>toggleDiff (in category 'diffs') ----- - toggleDiff - "Retained for backward compatibility with existing buttons in existing images" - - self toggleDiffing! Item was removed: - ----- Method: HierarchyBrowser>>potentialClassNames (in category 'initialization') ----- - potentialClassNames - "Answer the names of all the classes that could be viewed in this browser" - ^ self classList collect: - [:aName | aName copyWithout: $ ]! Item was changed: ----- Method: PackagePaneBrowser>>labelString (in category 'initialize-release') ----- labelString ^self package ifNil: [super labelString] ifNotNil: [:pkg| | label | label := self defaultBrowserTitle, ': ', pkg, (self selectedClass ifNil: [''] ifNotNil: [' ', self selectedClass printString]). + (self multiWindowState notNil + and: [self multiWindowState models size > 1]) ifTrue: + [label := (self multiWindowState models indexOf: self) printString, '. ', label]. - (multiWindowState notNil - and: [multiWindowState models size > 1]) ifTrue: - [label := (multiWindowState models indexOf: self) printString, '. ', label]. label]!

1 0

The Trunk: Morphic-mt.954.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.954.mcz ==================== Summary ==================== Name: Morphic-mt.954 Author: mt Time: 1 May 2015, 2:30:32.642 pm UUID: 45cdee2d-1fbe-fd42-8990-b204902bdd56 Ancestors: Morphic-mt.953 Deprecations updated and some dependencies to MorphicExtras removed. =============== Diff against Morphic-mt.953 =============== Item was removed: - ----- Method: Morph>>nextOwnerPage (in category 'geometry') ----- - nextOwnerPage - "Tell my container to advance to the next page" - | targ | - targ := self ownerThatIsA: BookMorph. - targ ifNotNil: [targ nextPage]! Item was removed: - ----- Method: Morph>>previousOwnerPage (in category 'geometry') ----- - previousOwnerPage - "Tell my container to advance to the previous page" - | targ | - targ := self ownerThatIsA: BookMorph. - targ ifNotNil: [targ previousPage]! Item was removed: - ----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') ----- - exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory - "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? - Player classes are included automatically." - - | is str ans revertSeg roots holder | - self flag: #toRemove. - self halt. "unused" - "world == World ifTrue: [^ false]." - "self inform: 'Can''t send the current world out'." - world ifNil: [^ false]. world presenter ifNil: [^ false]. - - ScrapBook default emptyScrapBook. - world currentHand pasteBuffer: nil. "don't write the paste buffer." - world currentHand mouseOverHandler initialize. "forget about any references here" - "Display checkCurrentHandForObjectToPaste." - Command initialize. - world clearCommandHistory. - world fullReleaseCachedState; releaseViewers. - world cleanseStepList. - world localFlapTabs size = world flapTabs size ifFalse: [ - self error: 'Still holding onto Global flaps']. - world releaseSqueakPages. - holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" - - "Just export me, not my previous version" - revertSeg := self parameterAt: #revertToMe. - self projectParameters removeKey: #revertToMe ifAbsent: []. - - roots := OrderedCollection new. - roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. - roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]). - - roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" - - catList do: [:sysCat | - (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb | - roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]]. - - is := ImageSegment new copySmartRootsExport: roots asArray. - "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)" - - is state = #tooBig ifTrue: [^ false]. - - str := ''. - "considered legal to save a project that has never been entered" - (is outPointers includes: world) ifTrue: [ - str := str, '\Project''s own world is not in the segment.' withCRs]. - str isEmpty ifFalse: [ - ans := (UIManager default - chooseFrom: #('Do not write file' 'Write file anyway' 'Debug') - title: str). - ans = 1 ifTrue: [ - revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg]. - ^ false]. - ans = 3 ifTrue: [self halt: 'Segment not written']]. - - is writeForExportWithSources: aFileName inDirectory: aDirectory. - revertSeg ifNotNil: [self projectParameterAt: #revertToMe put: revertSeg]. - holder. - world flapTabs do: [:ft | - (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. - is arrayOfRoots do: [:obj | - obj isScriptEditorMorph ifTrue: [obj unhibernate]]. - ^ true - ! Item was removed: - ----- Method: ScrollPane>>alwaysShowHScrollBar: (in category 'DEPRECATED') ----- - alwaysShowHScrollBar: bool - self flag: #deprecated. - self setProperty: #hScrollBarAlways toValue: bool. - - bool - ifTrue: [self hScrollBarPolicy: #always] - ifFalse: [self hScrollBarPolicy: #whenNeeded]. - - self hHideOrShowScrollBar. - ! Item was removed: - ----- Method: ScrollPane>>alwaysShowScrollBars: (in category 'DEPRECATED') ----- - alwaysShowScrollBars: bool - "Get rid of scroll bar for short panes that don't want it shown." - - self flag: #deprecated. - - self - alwaysShowHScrollBar: bool; - alwaysShowVScrollBar: bool. - ! Item was removed: - ----- Method: ScrollPane>>alwaysShowVScrollBar: (in category 'DEPRECATED') ----- - alwaysShowVScrollBar: bool - - self flag: #deprecated. - - self setProperty: #vScrollBarAlways toValue: bool. - - bool - ifTrue: [self vScrollBarPolicy: #always] - ifFalse: [self vScrollBarPolicy: #whenNeeded]. - - self vHideOrShowScrollBar. - ! Item was removed: - ----- Method: ScrollPane>>hInitScrollBarTEMPORARY (in category 'DEPRECATED') ----- - hInitScrollBarTEMPORARY - "This is called lazily before the hScrollBar is accessed in a couple of places. It is provided to transition old ScrollPanes lying around that do not have an hScrollBar. Once it has been in the image for awhile, and all ScrollPanes have an hScrollBar, this method and it's references can be removed. " - - "Temporary method for filein of changeset" - hScrollBar ifNil: - [hScrollBar := ScrollBar new model: self slotName: 'hScrollBar'. - hScrollBar borderWidth: 1; borderColor: Color black. - self - resizeScrollBars; - setScrollDeltas; - hideOrShowScrollBars]. - ! Item was removed: - ----- Method: ScrollPane>>hideHScrollBarIndefinitely: (in category 'DEPRECATED') ----- - hideHScrollBarIndefinitely: bool - "Get rid of scroll bar for short panes that don't want it shown." - - self flag: #deprecated. - - self setProperty: #noHScrollBarPlease toValue: bool. - - bool - ifTrue: [self hScrollBarPolicy: #never] - ifFalse: [self hScrollBarPolicy: #whenNeeded]. - - self hHideOrShowScrollBar. - ! Item was removed: - ----- Method: ScrollPane>>hideScrollBarsIndefinitely: (in category 'DEPRECATED') ----- - hideScrollBarsIndefinitely: bool - "Get rid of scroll bar for short panes that don't want it shown." - - self flag: #deprecated. - - self hideVScrollBarIndefinitely: bool. - self hideHScrollBarIndefinitely: bool. - ! Item was removed: - ----- Method: ScrollPane>>hideVScrollBarIndefinitely: (in category 'DEPRECATED') ----- - hideVScrollBarIndefinitely: bool - "Get rid of scroll bar for short panes that don't want it shown." - - self flag: #deprecated. - - self setProperty: #noVScrollBarPlease toValue: bool. - - bool - ifTrue: [self vScrollBarPolicy: #never] - ifFalse: [self vScrollBarPolicy: #whenNeeded]. - - self vHideOrShowScrollBar. - ! Item was removed: - ----- Method: ScrollPane>>isAScrollbarShowing (in category 'DEPRECATED') ----- - isAScrollbarShowing - "Return true if a either retractable scroll bar is currently showing" - - self flag: #deprectaed. "mt: Use #isAnyScrollbarShowing" - retractableScrollBar ifFalse:[^true]. - ^self hIsScrollbarShowing or: [self vIsScrollbarShowing] - ! Item was removed: - ----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded: (in category 'DEPRECATED') ----- - showHScrollBarOnlyWhenNeeded: bool - "Get rid of scroll bar for short panes that don't want it shown." - - self flag: #deprecated. - - self setProperty: #noHScrollBarPlease toValue: bool not. - self setProperty: #hScrollBarAlways toValue: bool not. - - bool - ifTrue: [self hScrollBarPolicy: #whenNeeded] - ifFalse: [self hScrollBarPolicy: #never]. - - self hHideOrShowScrollBar. - ! Item was removed: - ----- Method: ScrollPane>>showScrollBarsOnlyWhenNeeded: (in category 'DEPRECATED') ----- - showScrollBarsOnlyWhenNeeded: bool - - self flag: #deprecated. - - self showHScrollBarOnlyWhenNeeded: bool. - self showVScrollBarOnlyWhenNeeded: bool. - ! Item was removed: - ----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded: (in category 'DEPRECATED') ----- - showVScrollBarOnlyWhenNeeded: bool - "Get rid of scroll bar for short panes that don't want it shown." - - self flag: #deprecated. - - self setProperty: #noVScrollBarPlease toValue: bool not. - self setProperty: #vScrollBarAlways toValue: bool not. - - bool - ifTrue: [self vScrollBarPolicy: #whenNeeded] - ifFalse: [self vScrollBarPolicy: #never]. - - self vHideOrShowScrollBar. - !

1 0

The Trunk: MorphicExtras-mt.162.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.162.mcz ==================== Summary ==================== Name: MorphicExtras-mt.162 Author: mt Time: 1 May 2015, 2:28:34.974 pm UUID: 784bd1ad-62dc-1b4d-89d6-5fa506031d2c Ancestors: MorphicExtras-mt.161 Added from Morph package. =============== Diff against MorphicExtras-mt.161 =============== Item was added: + ----- Method: Morph>>nextOwnerPage (in category '*MorphicExtras') ----- + nextOwnerPage + "Tell my container to advance to the next page" + | targ | + targ := self ownerThatIsA: BookMorph. + targ ifNotNil: [targ nextPage]! Item was added: + ----- Method: Morph>>previousOwnerPage (in category '*MorphicExtras') ----- + previousOwnerPage + "Tell my container to advance to the previous page" + | targ | + targ := self ownerThatIsA: BookMorph. + targ ifNotNil: [targ previousPage]!

1 0

Jump to page: