Squeak-dev August 2011

squeak-dev@lists.squeakfoundation.org

55 participants
171 discussions

Squeaksource not synchronized
by Torsten Bergmann 17 Aug '11

17 Aug '11

Trouble with SqS again: JQWidgetBox-Dynatree-Core-tbn.1.mcz JQWidgetBox-Dynatree-Core-tbn.2.mcz JQWidgetBox-Dynatree-Core-tbn.3.mcz JQWidgetBox-Dynatree-Dev-tbn.1.mcz JQWidgetBox-Dynatree-Dev-tbn.2.mcz JQWidgetBox-Dynatree-Dev-tbn.3.mcz I saved them yesterday to SqS - then later Squeaksource went down and was restarted. I was not able to find them today using the web ui. So I tried to upload them using the squeaksource web ui - but failed since it complained that "they are not in mcz format" (???) So I used the "Copy" functionality from MetacelloBrowser to copy them from the local cache to squeaksource. This worked and now they are in the repo http://www.squeaksource.com/JQueryWidgetBox when I look at the repo using the Monticello browser from the image. But still they are not visible in the squeaksource web ui of the project: http://www.squeaksource.com/JQueryWidgetBox.html The other two from today JQWidgetBox-Dynatree-Core-tbn.4.mcz JQWidgetBox-Dynatree-Dev-tbn.4.mcz are visible in both (Monticello and Squeaksource web ui) - correct. Looks like the contents on disk is not in sync with the data the squeaksource image holds. Any idea? Bye T. -- NEU: FreePhone - 0ct/min Handyspartarif mit Geld-zurück-Garantie! Jetzt informieren: http://www.gmx.net/de/go/freephone

1 0

The Trunk: Morphic-cmm.568.mcz
by commits＠source.squeak.org 17 Aug '11

17 Aug '11

Chris Muller uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-cmm.568.mcz ==================== Summary ==================== Name: Morphic-cmm.568 Author: cmm Time: 16 August 2011, 7:41:16.85 pm UUID: 0e5f72e8-32fa-4608-bb91-f08260ecbab5 Ancestors: Morphic-nice.567 - Fixed Auto Enclose preference. - Restored ability to use Control in lieu of Alt+Shift for enclosing with (, {, or double-quote. =============== Diff against Morphic-nice.567 =============== Item was changed: ----- Method: TextEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeShiftCmdKeyShortcuts "Initialize the shift-command-key (or control-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the capitalized versions of the letters. TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values." "TextEditor initialize" | cmdMap cmds | "shift-command and control shortcuts" cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: ( 1 + 1) put: #cursorHome:. "home key" cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key" cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key" cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key" cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key" cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return" cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key" cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key" cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key" cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key" cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key" cmdMap at: (32 + 1) put: #selectWord:. "space bar key" cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus" cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus" cmdMap at: (127 + 1) put: #forwardDelete:. "del key" "On some keyboards, these characters require a shift" + '([<{|"''9' do: [:char | cmdMap at: char asciiValue + 1 put: #enclose:]. - '([<{|"''' do: [:char | cmdMap at: char asciiValue + 1 put: #enclose:]. "NB: sw 12/9/2001 commented out the idiosyncratic line just below, which was grabbing shift-esc in the text editor and hence which argued with the wish to have shift-esc be a universal gesture for escaping the local context and calling up the desktop menu." "cmdMap at: (27 + 1) put: #shiftEnclose:." "ctrl-[" "'""''(' do: [ :char | cmdMap at: (char asciiValue + 1) put: #enclose:]." cmds := #( $c compareToClipboard: $d duplicate: $h cursorTopHome: $j doAgainMany: $k changeStyle: $l outdent: $m selectCurrentTypeIn: $r indent: $s search: $u changeLfToCr: $x makeLowercase: $y makeUppercase: $z makeCapitalized: ). 1 to: cmds size by: 2 do: [ :i | cmdMap at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys" cmdMap at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys" cmdMap at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys" ]. shiftCmdActions := cmdMap! Item was changed: ----- Method: TextEditor>>dispatchOnKeyboardEvent: (in category 'typing support') ----- dispatchOnKeyboardEvent: aKeyboardEvent "Carry out the action associated with this character, if any. Type-ahead is passed so some routines can flush or use it." | honorCommandKeys openers closers result | (aKeyboardEvent keyCharacter == Character cr and: [ morph acceptOnCR ]) ifTrue: [ self closeTypeIn. ^ true ]. self clearParens. aKeyboardEvent keyValue = 13 ifTrue: [ aKeyboardEvent controlKeyPressed ifTrue: [ ^ self normalCharacter: aKeyboardEvent ]. aKeyboardEvent shiftPressed ifTrue: [ ^ self lf: aKeyboardEvent ]. aKeyboardEvent commandKeyPressed ifTrue: [ ^ self crlf: aKeyboardEvent ]. ^ self crWithIndent: aKeyboardEvent ]. ((honorCommandKeys := Preferences cmdKeysInText) and: [ aKeyboardEvent keyCharacter = Character enter ]) ifTrue: [ ^ self dispatchOnEnterWith: aKeyboardEvent ]. "Special keys overwrite crtl+key combinations - at least on Windows. To resolve this conflict, assume that keys other than cursor keys aren't used together with Crtl." ((self class specialShiftCmdKeys includes: aKeyboardEvent keyValue) and: [ aKeyboardEvent keyValue < 27 ]) ifTrue: [ ^ aKeyboardEvent controlKeyPressed ifTrue: [ self perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ] ifFalse: [ self perform: (self class cmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ] ]. "backspace, and escape keys (ascii 8 and 27) are command keys" ((honorCommandKeys and: [ aKeyboardEvent commandKeyPressed ]) or: [ self class specialShiftCmdKeys includes: aKeyboardEvent keyValue ]) ifTrue: [ ^ aKeyboardEvent shiftPressed ifTrue: [ self perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ] ifFalse: [ self perform: (self class cmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ] ]. "the control key can be used to invoke shift-cmd shortcuts" (honorCommandKeys and: [ aKeyboardEvent controlKeyPressed ]) + ifTrue: [^ self perform: (self class shiftCmdActions at: (aKeyboardEvent keyValue + 1)) with: aKeyboardEvent ]. - ifTrue: [ ^ self perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1) with: aKeyboardEvent ]. openers := '([{'. closers := ')]}'. result := self normalCharacter: aKeyboardEvent. (closers includes: aKeyboardEvent keyCharacter) ifTrue: [ self blinkPrevParen: aKeyboardEvent ]. (self class autoEnclose and: [ openers includes: aKeyboardEvent keyCharacter ]) ifTrue: [ + markBlock := pointBlock. self addString: (closers at: (openers indexOf: aKeyboardEvent keyCharacter)) asString. + markBlock := pointBlock. self moveCursor: [ :position | position - 1 ] forward: false select: false "no special behavior" ]. ^ result! Item was changed: ----- Method: TextEditor>>enclose: (in category 'editing keys') ----- enclose: aKeyboardEvent "Insert or remove bracket characters around the current selection." | left right startIndex stopIndex oldSelection which t | self closeTypeIn. startIndex := self startIndex. stopIndex := self stopIndex. oldSelection := self selection. + which := '([<{|"''9' indexOf: aKeyboardEvent keyCharacter ifAbsent: [ ^true ]. + "Allow Control key in lieu of Alt+Shift for (, {, and double-quote." + left := ((Preferences cmdKeysInText and: [ aKeyboardEvent controlKeyPressed ]) + ifTrue: [ '({<{|""(' ] + ifFalse: ['([<{|"''(']) at: which. + right := ((Preferences cmdKeysInText and: [ aKeyboardEvent controlKeyPressed ]) + ifTrue: [ ')}>}|"")' ] + ifFalse: [')]>}|"'')']) at: which. - which := '([<{|"''' indexOf: aKeyboardEvent keyCharacter ifAbsent: [ ^true ]. - left := '([<{|"''' at: which. - right := ')]>}|"''' at: which. t := self text. ((startIndex > 1 and: [stopIndex <= t size]) and: [ (t at: startIndex-1) = left and: [(t at: stopIndex) = right]]) ifTrue: [ "already enclosed; strip off brackets" self selectFrom: startIndex-1 to: stopIndex. self replaceSelectionWith: oldSelection] ifFalse: [ "not enclosed; enclose by matching brackets" self replaceSelectionWith: (Text string: (String with: left), oldSelection string, (String with: right) attributes: emphasisHere). self selectFrom: startIndex+1 to: stopIndex]. ^true!

1 0

Daily Commit Log
by commits＠source.squeak.org 17 Aug '11

17 Aug '11

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2011-August/004921.html Name: Kernel-cmm.607 Ancestors: Kernel-nice.605 - Size and speed optimization for DateAndTime, Date, and other Timespans. By sending them the new #makeUTC message, Dates can now share a canonicalized #zero 'offset' Duration. Hashing Dates created in offset zero is many times faster than those with other offsets. - Since there are typically many Dates in the system, their 1-day 'duration' is also shared. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004922.html Name: Kernel-cmm.608 Ancestors: Kernel-cmm.607 Allow creation of ContextParts with #basicNew: as long as a valid frame-size is specified. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004923.html Name: Kernel-cmm.612 Ancestors: Kernel-cmm.608, Kernel-ul.611 Merged cmm.607 and cmm.608. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004924.html Name: Monticello-cmm.478 Ancestors: Monticello-ul.477 - For #copyAllFrom:, only copy those that don't exist in the receiver. - Added MCRepository>>#copyImageVersions. For each package contained in the receiver, copy the version of that package which is currently loaded in this image. If no version of a package is loaded in the image, nothing is copied for that package. - Added String>>#withLoadedPackageVersions so that load scripts specifying Monticello package names can be easily upgraded. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004925.html Name: Monticello-cmm.479 Ancestors: Monticello-cmm.478 Don't need to use #indexSatisfying:startingAt:. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004926.html Name: Monticello-cmm.480 Ancestors: Monticello-cmm.479 Added 'copy image versions here' to repository context menu. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004927.html Name: Monticello-cmm.481 Ancestors: Monticello-cmm.480 Better copyAllFrom:. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004928.html Name: MonticelloConfigurations-cmm.97 Ancestors: MonticelloConfigurations-bf.96 - When storing a Configuration, instead of complaining to the user about what versions are missing in the target repository, just copy the missing versions in automatically. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004929.html Name: SMLoader-cmm.76 Ancestors: SMLoader-nice.75 Upgrade load-scripts with one-click. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004930.html Name: Tools-cmm.369 Ancestors: Tools-btc.368 Fix duplicate halo for MessageTrace. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004931.html Name: Tools-cmm.375 Ancestors: Tools-nice.374, Tools-cmm.369 Merged cmm.369. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004932.html Name: KernelTests-cmm.198 Ancestors: KernelTests-nice.197 - Test for #makeUTC. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2011-August/004933.html Name: Collections-ul.454 Ancestors: Collections-ul.453 - improved performance of String >> #unescapedPercents - improved performance of RWBinaryOrTextStream >> #upTo: - categorized most uncategorized methods of RWBinaryOrTextStream =============================================

1 0

squeaksource is down
by Torsten Bergmann 16 Aug '11

16 Aug '11

... again -- Empfehlen Sie GMX DSL Ihren Freunden und Bekannten und wir belohnen Sie mit bis zu 50,- Euro! https://freundschaftswerbung.gmx.de

1 0

TextMorph takes to much space in layout
by r2ruyu-nana＠yahoo.de 16 Aug '11

16 Aug '11

Hello squeaker! A TextMorph takes to much space in a table layout: parent := Morph new color: Color yellow. parent changeTableLayout; vResizing: #shrinkWrap; hResizing: #spaceFill; extent: 400@300. w := TextMorph new contentsWrapped: 'Some very very very very long string...'. w "width: 300;" backgroundColor: Color veryLightGray; hResizing: #spaceFill. parent addMorphBack: (Morph new color: Color red); addMorphBack: w; addMorphBack: (Morph new color: Color blue). parent openInWorld. "w layoutChanged." But doing 'w layoutChanged' afterwards everything is fine again. It has something to do with the default extent of the TextMorph. If you're uncommenting the width-line there will be less space below the TextMorph. Also, everything if fine without the hReszing:#spaceFill of the TextMorph... How to get it right from the beginning on? Without doing explicitly 'w layoutChanged'. Best regards, r2ruyu

2 4

Re: [squeak-dev] The Inbox: Kernel-ul.613.mcz
by Levente Uzonyi 16 Aug '11

16 Aug '11

On Tue, 16 Aug 2011, commits(a)source.squeak.org wrote: > A new version of Kernel was added to project The Inbox: > http://source.squeak.org/inbox/Kernel-ul.613.mcz > > ==================== Summary ==================== > > Name: Kernel-ul.613 > Author: ul > Time: 16 August 2011, 11:33:03.744 am > UUID: cd3bc5e7-fabf-b74a-9f8c-18eee845bc9b > Ancestors: Kernel-cmm.612 > > Extracted and enhanced the ProcessSpecific from Pharo. > > =============== Diff against Kernel-cmm.612 =============== > > Item was changed: > SystemOrganization addCategory: #'Kernel-Chronology'! > SystemOrganization addCategory: #'Kernel-Classes'! > SystemOrganization addCategory: #'Kernel-Methods'! > + SystemOrganization addCategory: #'Kernel-Models'! > SystemOrganization addCategory: #'Kernel-Numbers'! > SystemOrganization addCategory: #'Kernel-Objects'! > SystemOrganization addCategory: #'Kernel-Processes'! > + SystemOrganization addCategory: #'Kernel-Processes-Variables'! > - SystemOrganization addCategory: #'Kernel-Models'! > > Item was removed: > - ----- Method: ContextPart>>object:basicAt: (in category 'mirror primitives') ----- > - object: anObject basicAt: index > - "Answer the value of an indexable element in the argument anObject without sending > - it a message. Fail if the argument index is not an Integer or is out of bounds, or if > - anObject is not indexable. This mimics the action of the VM when it indexes an object. > - Used to simulate the execution machinery by, for example, the debugger. > - Primitive. See Object documentation whatIsAPrimitive." > - > - <primitive: 60> > - index isInteger ifTrue: [self errorSubscriptBounds: index]. > - index isNumber > - ifTrue: [^self object: anObject basicAt: index asInteger] > - ifFalse: [self errorNonIntegerIndex]! > > Item was added: > + ----- Method: ContextPart>>object:basicAt: (in category 'mirror primitives') ----- > + object: anObject basicAt: index > + "Answer the value of an indexable element in the argument anObject without sending > + it a message. Fail if the argument index is not an Integer or is out of bounds, or if > + anObject is not indexable. This mimics the action of the VM when it indexes an object. > + Used to simulate the execution machinery by, for example, the debugger. > + Primitive. See Object documentation whatIsAPrimitive." > + > + <primitive: 60> > + index isInteger ifTrue: [self errorSubscriptBounds: index]. > + index isNumber > + ifTrue: [^self object: anObject basicAt: index asInteger] > + ifFalse: [self errorNonIntegerIndex]! I wonder why is this shown as removed and added here, MC didn't show this method as changed. Levente snip

2 1

The Trunk: Collections-ul.454.mcz
by commits＠source.squeak.org 16 Aug '11

16 Aug '11

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.454.mcz ==================== Summary ==================== Name: Collections-ul.454 Author: ul Time: 9 August 2011, 1:58:09.614 pm UUID: 84c5cf1a-89c4-f643-a3ba-525df170e492 Ancestors: Collections-ul.453 - improved performance of String >> #unescapedPercents - improved performance of RWBinaryOrTextStream >> #upTo: - categorized most uncategorized methods of RWBinaryOrTextStream =============== Diff against Collections-ul.453 =============== Item was changed: + ----- Method: RWBinaryOrTextStream>>asBinaryOrTextStream (in category 'converting') ----- - ----- Method: RWBinaryOrTextStream>>asBinaryOrTextStream (in category 'as yet unclassified') ----- asBinaryOrTextStream ^ self! Item was changed: + ----- Method: RWBinaryOrTextStream>>ascii (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>ascii (in category 'as yet unclassified') ----- ascii isBinary := false! Item was changed: + ----- Method: RWBinaryOrTextStream>>binary (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>binary (in category 'as yet unclassified') ----- binary isBinary := true! Item was changed: + ----- Method: RWBinaryOrTextStream>>contents (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>contents (in category 'as yet unclassified') ----- contents "Answer with a copy of my collection from 1 to readLimit." | newArray | isBinary ifFalse: [^ super contents]. "String" readLimit := readLimit max: position. newArray := ByteArray new: readLimit. ^ newArray replaceFrom: 1 to: readLimit with: collection startingAt: 1.! Item was changed: + ----- Method: RWBinaryOrTextStream>>contentsOfEntireFile (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>contentsOfEntireFile (in category 'as yet unclassified') ----- contentsOfEntireFile "For compatibility with file streams." ^ self contents! Item was changed: + ----- Method: RWBinaryOrTextStream>>isBinary (in category 'testing') ----- - ----- Method: RWBinaryOrTextStream>>isBinary (in category 'as yet unclassified') ----- isBinary ^ isBinary! Item was changed: + ----- Method: RWBinaryOrTextStream>>next (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>next (in category 'as yet unclassified') ----- next | byte | ^ isBinary ifTrue: [byte := super next. byte ifNil: [nil] ifNotNil: [byte asciiValue]] ifFalse: [super next]. ! Item was changed: + ----- Method: RWBinaryOrTextStream>>next: (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>next: (in category 'as yet unclassified') ----- next: anInteger "Answer the next anInteger elements of my collection. Must override to get class right." | newArray | newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: anInteger. ^ self nextInto: newArray! Item was changed: + ----- Method: RWBinaryOrTextStream>>next:into:startingAt: (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>next:into:startingAt: (in category 'as yet unclassified') ----- next: n into: aCollection startingAt: startIndex "Read n objects into the given collection. Return aCollection or a partial copy if less than n elements have been read." "Overriden for efficiency" | max | max := (readLimit - position) min: n. aCollection replaceFrom: startIndex to: startIndex+max-1 with: collection startingAt: position+1. position := position + max. max = n ifTrue:[^aCollection] ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1]! Item was changed: + ----- Method: RWBinaryOrTextStream>>nextPut: (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>nextPut: (in category 'as yet unclassified') ----- nextPut: charOrByte ^super nextPut: charOrByte asCharacter! Item was changed: + ----- Method: RWBinaryOrTextStream>>readInto:startingAt:count: (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>readInto:startingAt:count: (in category 'as yet unclassified') ----- readInto: aCollection startingAt: startIndex count: n "Read n objects into the given collection. Return number of elements that have been read." "Overriden for efficiency" | max | max := (readLimit - position) min: n. aCollection replaceFrom: startIndex to: startIndex+max-1 with: collection startingAt: position+1. position := position + max. ^max! Item was changed: + ----- Method: RWBinaryOrTextStream>>reset (in category 'positioning') ----- - ----- Method: RWBinaryOrTextStream>>reset (in category 'as yet unclassified') ----- reset "Set the receiver's position to the beginning of the sequence of objects." super reset. isBinary ifNil: [isBinary := false]. collection class == ByteArray ifTrue: ["Store as String and convert as needed." collection := collection asString. isBinary := true]. ! Item was changed: + ----- Method: RWBinaryOrTextStream>>text (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>text (in category 'as yet unclassified') ----- text isBinary := false! Item was changed: ----- Method: RWBinaryOrTextStream>>upTo: (in category 'accessing') ----- + upTo: anObject + "fast version using indexOf:" + + | start end | + start := position+1. + isBinary + ifTrue: [ anObject isInteger ifFalse: [ ^self upToEnd ] ] + ifFalse: [ anObject isCharacter ifFalse: [ ^self upToEnd ] ]. + end := collection indexOf: anObject asCharacter startingAt: start ifAbsent: [ 0 ]. + "not present--return rest of the collection" + (end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ]. + "skip to the end and return the data passed over" + position := end. + ^((isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: end - start) + replaceFrom: 1 + to: end - start + with: collection + startingAt: start! - upTo: anObject - "Answer a subcollection from the current access position to the - occurrence (if any, but not inclusive) of anObject in the receiver. If - anObject is not in the collection, answer the entire rest of the receiver." - | newStream element species | - species := isBinary ifTrue:[ByteArray] ifFalse:[String]. - newStream := WriteStream on: (species new: 100). - [self atEnd or: [(element := self next) = anObject]] - whileFalse: [newStream nextPut: element]. - ^newStream contents! Item was changed: + ----- Method: RWBinaryOrTextStream>>upToEnd (in category 'accessing') ----- - ----- Method: RWBinaryOrTextStream>>upToEnd (in category 'as yet unclassified') ----- upToEnd "Must override to get class right." | newArray | newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position. ^ self nextInto: newArray! Item was changed: ----- Method: String>>unescapePercents (in category 'converting') ----- unescapePercents + "decode %xx form. This is the opposite of #encodeForHTTP. Assume UTF-8 encoding by default." + + | unescaped | + unescaped := self unescapePercentsRaw. + ^[ unescaped utf8ToSqueak ] + on: Error + do: [ unescaped ]! - "decode %xx form. This is the opposite of #encodeForHTTP" - ^ self unescapePercentsWithTextEncoding: 'utf-8'.! Item was added: + ----- Method: String>>unescapePercentsRaw (in category 'converting') ----- + unescapePercentsRaw + "decode string including %XX form" + + | unescaped char asciiVal specialChars oldPos pos | + unescaped := ReadWriteStream on: String new. + specialChars := '+%' asCharacterSet. + oldPos := 1. + [pos := self indexOfAnyOf: specialChars startingAt: oldPos. + pos > 0] + whileTrue: [unescaped + nextPutAll: (self copyFrom: oldPos to: pos - 1). + char := self at: pos. + (char = $% + and: [pos + 2 <= self size]) + ifTrue: [asciiVal := (self at: pos + 1) asUppercase digitValue * 16 + (self at: pos + 2) asUppercase digitValue. + asciiVal > 255 + ifTrue: [^ self]. + unescaped + nextPut: (Character value: asciiVal). + pos := pos + 3. + pos <= self size + ifFalse: [char := nil]. + oldPos := pos] + ifFalse: [char = $+ + ifTrue: [unescaped nextPut: Character space] + ifFalse: [unescaped nextPut: char]. + oldPos := pos + 1]]. + oldPos <= self size + ifTrue: [unescaped + nextPutAll: (self copyFrom: oldPos to: self size)]. + ^unescaped contents! Item was added: + ----- Method: String>>unescapePercentsWithTextConverter: (in category 'converting') ----- + unescapePercentsWithTextConverter: aTextConverter + "decode string including %XX form" + + | unescaped | + unescaped := self unescapePercentsRaw. + ^[ unescaped convertFromWithConverter: aTextConverter ] + on: Error + do: ["the contents may be squeak-encoded" + unescaped ]! Item was changed: ----- Method: String>>unescapePercentsWithTextEncoding: (in category 'converting') ----- unescapePercentsWithTextEncoding: encodingName "decode string including %XX form" + + | converter | - | unescaped char asciiVal specialChars oldPos pos converter | - unescaped := ReadWriteStream on: String new. - specialChars := '+%' asCharacterSet. - oldPos := 1. - [pos := self indexOfAnyOf: specialChars startingAt: oldPos. - pos > 0] - whileTrue: [unescaped - nextPutAll: (self copyFrom: oldPos to: pos - 1). - char := self at: pos. - (char = $% - and: [pos + 2 <= self size]) - ifTrue: [asciiVal := (self at: pos + 1) asUppercase digitValue * 16 + (self at: pos + 2) asUppercase digitValue. - asciiVal > 255 - ifTrue: [^ self]. - unescaped - nextPut: (Character value: asciiVal). - pos := pos + 3. - pos <= self size - ifFalse: [char := nil]. - oldPos := pos] - ifFalse: [char = $+ - ifTrue: [unescaped nextPut: Character space] - ifFalse: [unescaped nextPut: char]. - oldPos := pos + 1]]. - oldPos <= self size - ifTrue: [unescaped - nextPutAll: (self copyFrom: oldPos to: self size)]. converter := (TextConverter newForEncoding: encodingName) + ifNil: [ TextConverter newForEncoding: nil ]. + ^self unescapePercentsWithTextConverter: converter! - ifNil: [TextConverter newForEncoding: nil]. - ^ [unescaped contents convertFromWithConverter: converter] - on: Error - do: ["the contents may be squeak-encoded" - unescaped contents]!

1 0

The Inbox: Kernel-ul.613.mcz
by commits＠source.squeak.org 16 Aug '11

16 Aug '11

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ul.613.mcz ==================== Summary ==================== Name: Kernel-ul.613 Author: ul Time: 16 August 2011, 11:33:03.744 am UUID: cd3bc5e7-fabf-b74a-9f8c-18eee845bc9b Ancestors: Kernel-cmm.612 Extracted and enhanced the ProcessSpecific from Pharo. =============== Diff against Kernel-cmm.612 =============== Item was changed: SystemOrganization addCategory: #'Kernel-Chronology'! SystemOrganization addCategory: #'Kernel-Classes'! SystemOrganization addCategory: #'Kernel-Methods'! + SystemOrganization addCategory: #'Kernel-Models'! SystemOrganization addCategory: #'Kernel-Numbers'! SystemOrganization addCategory: #'Kernel-Objects'! SystemOrganization addCategory: #'Kernel-Processes'! + SystemOrganization addCategory: #'Kernel-Processes-Variables'! - SystemOrganization addCategory: #'Kernel-Models'! Item was removed: - ----- Method: ContextPart>>object:basicAt: (in category 'mirror primitives') ----- - object: anObject basicAt: index - "Answer the value of an indexable element in the argument anObject without sending - it a message. Fail if the argument index is not an Integer or is out of bounds, or if - anObject is not indexable. This mimics the action of the VM when it indexes an object. - Used to simulate the execution machinery by, for example, the debugger. - Primitive. See Object documentation whatIsAPrimitive." - - <primitive: 60> - index isInteger ifTrue: [self errorSubscriptBounds: index]. - index isNumber - ifTrue: [^self object: anObject basicAt: index asInteger] - ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: ContextPart>>object:basicAt: (in category 'mirror primitives') ----- + object: anObject basicAt: index + "Answer the value of an indexable element in the argument anObject without sending + it a message. Fail if the argument index is not an Integer or is out of bounds, or if + anObject is not indexable. This mimics the action of the VM when it indexes an object. + Used to simulate the execution machinery by, for example, the debugger. + Primitive. See Object documentation whatIsAPrimitive." + + <primitive: 60> + index isInteger ifTrue: [self errorSubscriptBounds: index]. + index isNumber + ifTrue: [^self object: anObject basicAt: index asInteger] + ifFalse: [self errorNonIntegerIndex]! Item was added: + ----- Method: ContextPart>>object:instVarAt: (in category 'mirror primitives') ----- + object: anObject instVarAt: anIndex + "Primitive. Answer a fixed variable in an object. The numbering of the + variables corresponds to the named instance variables. Fail if the index + is not an Integer or is not the index of a fixed variable. Essential for the + debugger. See Object documentation whatIsAPrimitive." + + <primitive: 73> + "Access beyond fixed variables." + ^self object: anObject basicAt: anIndex - (self objectClass: anObject) instSize! Item was removed: - ----- Method: ContextPart>>object:instVarAt: (in category 'mirror primitives') ----- - object: anObject instVarAt: anIndex - "Primitive. Answer a fixed variable in an object. The numbering of the - variables corresponds to the named instance variables. Fail if the index - is not an Integer or is not the index of a fixed variable. Essential for the - debugger. See Object documentation whatIsAPrimitive." - - <primitive: 73> - "Access beyond fixed variables." - ^self object: anObject basicAt: anIndex - (self objectClass: anObject) instSize! Item was added: + ProcessSpecificVariable subclass: #DynamicVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Processes-Variables'! + + !DynamicVariable commentStamp: 'mvl 3/13/2007 13:55' prior: 0! + My subclasses are dynamic variables: each subclass represents a variable + whose value persists inside the block passed to #value:during:. There is + no way to change the value inside such a block, but it is possible to + temporarirly rebind it in a nested manner.! Item was added: + ----- Method: DynamicVariable class>>value:during: (in category 'accessing') ----- + value: anObject during: aBlock + + | p oldValue | + p := Processor activeProcess. + oldValue := p environmentAt: self ifAbsent: [self default]. + ^[ + p environmentAt: self put: anObject. + aBlock value ] + ensure: [ p environmentAt: self put: oldValue ].! Item was added: + ----- Method: Process>>environmentAt: (in category 'process specific') ----- + environmentAt: key + ^ self environmentAt: key ifAbsent: [self environmentKeyNotFound]! Item was added: + ----- Method: Process>>environmentAt:ifAbsent: (in category 'process specific') ----- + environmentAt: key ifAbsent: aBlock + + ^(env ifNil: [ ^aBlock value ]) at: key ifAbsent: aBlock.! Item was added: + ----- Method: Process>>environmentAt:put: (in category 'process specific') ----- + environmentAt: key put: value + + ^(env ifNil: [ env := Dictionary new ]) at: key put: value.! Item was added: + ----- Method: Process>>environmentKeyNotFound (in category 'process specific') ----- + environmentKeyNotFound + self error: 'Environment key not found'! Item was added: + ----- Method: Process>>environmentRemoveKey: (in category 'process specific') ----- + environmentRemoveKey: key + ^ self environmentRemoveKey: key ifAbsent: [self environmentKeyNotFound]! Item was added: + ----- Method: Process>>environmentRemoveKey:ifAbsent: (in category 'process specific') ----- + environmentRemoveKey: key ifAbsent: errorBlock + + ^(env ifNil: [ ^errorBlock value ]) removeKey: key ifAbsent: errorBlock! Item was added: + ProcessSpecificVariable subclass: #ProcessLocalVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Processes-Variables'! + + !ProcessLocalVariable commentStamp: 'mvl 3/13/2007 12:28' prior: 0! + My subclasses have values specific to the active process. They can be read with #value and set with #value:! Item was added: + ----- Method: ProcessLocalVariable class>>value: (in category 'accessing') ----- + value: anObject + Processor activeProcess environmentAt: self put: anObject! Item was added: + Object subclass: #ProcessSpecificVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Processes-Variables'! + ProcessSpecificVariable class + instanceVariableNames: 'hash'! + + !ProcessSpecificVariable commentStamp: 'mvl 3/13/2007 13:53' prior: 0! + My subclasses (not instances of them) keep state specific to the current process. + + There are two kinds of process-specific variables: process-local (state available + for read and write in all methods inside the process), and dynamic variables + (implementing dynamic scope).! + ProcessSpecificVariable class + instanceVariableNames: 'hash'! Item was added: + ----- Method: ProcessSpecificVariable class>>default (in category 'accessing') ----- + default + "Answer the default value for the variable. The default for the default value is nil." + ^nil! Item was added: + ----- Method: ProcessSpecificVariable class>>hash (in category 'accessing') ----- + hash + + ^hash ifNil: [ hash := super hash ]! Item was added: + ----- Method: ProcessSpecificVariable class>>value (in category 'accessing') ----- + value + "Answer the current value for this variable in the current context." + ^Processor activeProcess environmentAt: self ifAbsent: [self default].!

1 0

The Inbox: KernelTests-ul.199.mcz
by commits＠source.squeak.org 16 Aug '11

16 Aug '11

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-ul.199.mcz ==================== Summary ==================== Name: KernelTests-ul.199 Author: ul Time: 16 August 2011, 11:45:58.335 am UUID: 636e5fb8-70ac-3043-b7d5-2a9fd5a2bf73 Ancestors: KernelTests-cmm.198 Tests for ProcessSpecific from Pharo. =============== Diff against KernelTests-cmm.198 =============== Item was added: + TestCase subclass: #ProcessSpecificTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Processes'! + + !ProcessSpecificTest commentStamp: 'mvl 3/13/2007 13:52' prior: 0! + A ProcessSpecificTest is a test case for process local and dynamic variables. + ! Item was added: + ----- Method: ProcessSpecificTest>>checkDynamic: (in category 'testing') ----- + checkDynamic: value + self assert: TestDynamicVariable value = value! Item was added: + ----- Method: ProcessSpecificTest>>checkLocal: (in category 'testing') ----- + checkLocal: value + self assert: TestLocalVariable value = value! Item was added: + ----- Method: ProcessSpecificTest>>testDynamicVariable (in category 'testing') ----- + testDynamicVariable + + | s1 s2 p1stopped p2stopped | + s1 := Semaphore new. + s2 := Semaphore new. + p1stopped := p2stopped := false. + [ + TestDynamicVariable value: 1 during:[ + self checkDynamic: 1. + (Delay forMilliseconds: 30) wait. + self checkDynamic: 1. + TestDynamicVariable value: 3 during:[ + (Delay forMilliseconds: 30) wait. + self checkDynamic: 3 + ]. + self checkDynamic: 1. + ]. + self checkDynamic: nil. + p1stopped := true. + s1 signal. + ] fork. + + [ + TestDynamicVariable value: 2 during:[ + self checkDynamic: 2. + (Delay forMilliseconds: 30) wait. + self checkDynamic: 2. + ]. + self checkDynamic: nil. + p2stopped := true. + s2 signal. + ] fork. + + "Set a maximum wait timeout so that the test case will complete + even if the processes fail to signal us." + s1 waitTimeoutSeconds: 2. + s2 waitTimeoutSeconds: 2. + self assert: p1stopped. + self assert: p2stopped.! Item was added: + ----- Method: ProcessSpecificTest>>testLocalVariable (in category 'testing') ----- + testLocalVariable + + | s1 s2 p1stopped p2stopped | + s1 := Semaphore new. + s2 := Semaphore new. + p1stopped := p2stopped := false. + [ + self checkLocal: 0. + TestLocalVariable value: 1. + self checkLocal: 1. + (Delay forMilliseconds: 30) wait. + self checkLocal: 1. + TestLocalVariable value: 2. + self checkLocal: 2. + p1stopped := true. + s1 signal. + ] fork. + + [ + (Delay forMilliseconds: 30) wait. + self checkLocal: 0. + TestLocalVariable value: 3. + self checkLocal: 3. + (Delay forMilliseconds: 30) wait. + self checkLocal: 3. + TestLocalVariable value: 4. + self checkLocal: 4. + p2stopped := true. + s2 signal. + ] fork. + + "Set a maximum wait timeout so that the test case will complete + even if the processes fail to signal us." + s1 waitTimeoutMSecs: 5000. + s2 waitTimeoutMSecs: 5000. + self assert: p1stopped. + self assert: p2stopped. + ! Item was changed: ClassTestCase subclass: #ProcessTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'KernelTests-Processes'! + + !ProcessTest commentStamp: 'ul 8/16/2011 11:35' prior: 0! + I hold test cases for generic Process-related behaviour.! Item was added: + ----- Method: ProcessTest>>tearDown (in category 'running') ----- + tearDown + Processor activeProcess environmentRemoveKey: #processTests ifAbsent: []! Item was added: + ----- Method: ProcessTest>>testEnvironmentAt (in category 'testing') ----- + testEnvironmentAt + Processor activeProcess environmentAt: #processTests put: 42. + self assert: (Processor activeProcess environmentAt: #processTests) = 42. + self should: [Processor activeProcess environmentAt: #foobar] raise: Error! Item was added: + ----- Method: ProcessTest>>testEnvironmentAtPut (in category 'testing') ----- + testEnvironmentAtPut + self assert: (Processor activeProcess environmentAt: #processTests put: 42) = 42.! Item was added: + ----- Method: ProcessTest>>testEnvironmentRemoveKey (in category 'testing') ----- + testEnvironmentRemoveKey + Processor activeProcess environmentAt: #processTests put: 42. + Processor activeProcess environmentRemoveKey: #processTests. + self assert: (Processor activeProcess environmentAt: #processTests ifAbsent: []) isNil. + self should: [Processor activeProcess environmentAt: #processTests] raise: Error! Item was added: + DynamicVariable subclass: #TestDynamicVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Processes'! + + !TestDynamicVariable commentStamp: 'mvl 3/13/2007 13:51' prior: 0! + TestDynamicVariable is a test class using in ProcessSpecificTest. + + ! Item was added: + ProcessLocalVariable subclass: #TestLocalVariable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Processes'! + + !TestLocalVariable commentStamp: 'mvl 3/13/2007 13:52' prior: 0! + TestLocalVariable is a test class using in ProcessSpecificTest.! Item was added: + ----- Method: TestLocalVariable class>>default (in category 'as yet unclassified') ----- + default + "My default value for a new process is 0." + + ^0!

1 0

The Trunk: KernelTests-cmm.198.mcz
by commits＠source.squeak.org 16 Aug '11

16 Aug '11

Chris Muller uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-cmm.198.mcz ==================== Summary ==================== Name: KernelTests-cmm.198 Author: cmm Time: 15 August 2011, 9:30:58.161 pm UUID: 64f23ad0-eb40-407d-90e6-6e45a2b5611e Ancestors: KernelTests-nice.197 - Test for #makeUTC. =============== Diff against KernelTests-nice.197 =============== Item was removed: - ----- Method: DateTest>>testFromDifferentTimeZones (in category 'testing') ----- - testFromDifferentTimeZones - "Equal dates should compare equal regardless of which TimeZone they are created in." - | priorTz march31stLocal march31stOcean | - self deny: DateAndTime localTimeZone offset hours = -9. - priorTz := DateAndTime localTimeZone. - march31stLocal := Date today. - DateAndTime - localTimeZone: (TimeZone - offset: -9 hours - name: 'No Countries' - abbreviation: 'Ocean'). - march31stOcean := Date today. - DateAndTime localTimeZone: priorTz. - self assert: march31stLocal = march31stOcean. - DateAndTime localTimeZone offset hours > -9 - ifTrue: [self deny: march31stOcean > march31stLocal] - ifFalse: [self deny: march31stOcean > march31stLocal] ! Item was added: + ----- Method: DateTest>>testMakeUTC (in category 'testing') ----- + testMakeUTC + "Equal dates should compare equal regardless of which TimeZone + they are created in." + | priorTz march31stLocal march31stOcean | + "This test won't work in GMT-9, but nobody lives there." + self deny: DateAndTime localTimeZone offset hours = -9. + priorTz := DateAndTime localTimeZone. + march31stLocal := Date today. + DateAndTime + localTimeZone: (TimeZone + offset: -9 hours + name: 'No Countries' + abbreviation: 'Ocean'). + march31stOcean := Date today. + DateAndTime localTimeZone: priorTz. + self assert: march31stLocal makeUTC = march31stOcean makeUTC ; + deny: march31stOcean makeUTC > march31stLocal makeUTC ; + deny: march31stOcean makeUTC < march31stLocal makeUTC!

1 0

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

Jump to page: