Packages February 2017

packages@lists.squeakfoundation.org

1 participants
69 discussions

The Trunk: SqueakSSL-Core-eem.32.mcz
by commits＠source.squeak.org 25 Feb '17

25 Feb '17

Eliot Miranda uploaded a new version of SqueakSSL-Core to project The Trunk: http://source.squeak.org/trunk/SqueakSSL-Core-eem.32.mcz ==================== Summary ==================== Name: SqueakSSL-Core-eem.32 Author: eem Time: 25 February 2017, 10:46:29.171578 am UUID: d57e1fe9-c199-47bf-81c7-abe7964f34f9 Ancestors: SqueakSSL-Core-ul.31 Fix slip in upToAll:limit: that causes errors in the SocketStreamTests>>testUpToAllCrlf* tests. See Network-eem.186. =============== Diff against SqueakSSL-Core-ul.31 =============== Item was changed: ----- Method: SecureSocketStream>>upToAll:limit: (in category 'private-compat') ----- upToAll: aStringOrByteArray limit: nBytes "Pre Squeak 4.2 compatibility" | index sz result searchedSoFar target | "Deal with ascii vs. binary" + target := self isBinary + ifTrue:[aStringOrByteArray asByteArray] + ifFalse:[aStringOrByteArray asString]. - self isBinary - ifTrue:[target := aStringOrByteArray asByteArray] - ifFalse:[target := aStringOrByteArray asString]. sz := target size. "Look in the current inBuffer first" index := inBuffer indexOfSubCollection: target + startingAt: (lastRead - sz + 2 max: 1). - startingAt: lastRead - sz + 2. (index > 0 and: [(index + sz) <= inNextToWrite]) ifTrue: ["found it" result := self nextInBuffer: index - lastRead - 1. self skip: sz. ^ result ]. [searchedSoFar := self inBufferSize. "Receive more data" self receiveData. recentlyRead > 0] whileTrue:[ "Data begins at lastRead + 1, we add searchedSoFar as offset and backs up sz - 1 so that we can catch any borderline hits." index := inBuffer indexOfSubCollection: target startingAt: (lastRead + searchedSoFar - sz + 2 max: 1). (index > 0 and: [(index + sz) <= inNextToWrite]) ifTrue: ["found it" result := self nextInBuffer: index - lastRead - 1. self skip: sz. ^ result ]. "Check if we've exceeded the max. amount" (nBytes notNil and:[inNextToWrite - lastRead > nBytes]) ifTrue:[^self nextAllInBuffer]. ]. "not found and (non-signaling) connection was closed" ^self nextAllInBuffer!

1 0

The Trunk: Network-eem.186.mcz
by commits＠source.squeak.org 25 Feb '17

25 Feb '17

Eliot Miranda uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-eem.186.mcz ==================== Summary ==================== Name: Network-eem.186 Author: eem Time: 25 February 2017, 10:45:26.371668 am UUID: cfa17471-ba85-4440-8aea-d24c0a5c3697 Ancestors: Network-tfel.185 Fix slip in upToAll:limit: that causes errors in the SocketStreamTests>>testUpToAllCrlf* tests. =============== Diff against Network-tfel.185 =============== Item was changed: ----- Method: SocketStream>>upToAll:limit: (in category 'stream in') ----- upToAll: aStringOrByteArray limit: nBytes "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aStringOrByteArray. If aCollection is not in the stream, or not found within nBytes answer the available contents of the stream" | index sz result searchedSoFar target | "Deal with ascii vs. binary" + target := self isBinary + ifTrue:[aStringOrByteArray asByteArray] + ifFalse:[aStringOrByteArray asString]. - self isBinary - ifTrue:[target := aStringOrByteArray asByteArray] - ifFalse:[target := aStringOrByteArray asString]. sz := target size. "Look in the current inBuffer first" index := inBuffer indexOfSubCollection: target + startingAt: (lastRead - sz + 2 max: 1). - startingAt: lastRead - sz + 2. (index > 0 and: [(index + sz) <= inNextToWrite]) ifTrue: ["found it" result := self nextInBuffer: index - lastRead - 1. self skip: sz. ^ result ]. [searchedSoFar := self inBufferSize. "Receive more data" self receiveData. recentlyRead > 0] whileTrue:[ "Data begins at lastRead + 1, we add searchedSoFar as offset and backs up sz - 1 so that we can catch any borderline hits." index := inBuffer indexOfSubCollection: target startingAt: (lastRead + searchedSoFar - sz + 2 max: 1). (index > 0 and: [(index + sz) <= inNextToWrite]) ifTrue: ["found it" result := self nextInBuffer: index - lastRead - 1. self skip: sz. ^ result ]. "Check if we've exceeded the max. amount" (nBytes notNil and:[inNextToWrite - lastRead > nBytes]) ifTrue:[^self nextAllInBuffer]. ]. "not found and (non-signaling) connection was closed" ^self nextAllInBuffer!

1 0

The Trunk: Collections-eem.734.mcz
by commits＠source.squeak.org 25 Feb '17

25 Feb '17

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.734.mcz ==================== Summary ==================== Name: Collections-eem.734 Author: eem Time: 24 February 2017, 3:51:29.783168 pm UUID: a81dce52-1da2-4c87-b8a7-fd6bf485396b Ancestors: Collections-topa.733 Eliminate the ugly hack to speed up stream wide character writes. The trade-offs with Spur have changed and the cure is now arguably worse than the disease. The VM no longer supports the primitive (since it cannot be sufficiently polymorphic). hence the hack is paid for on every write but pays off only on wide chaacter writes to byte strings. Now that Spur's become is much faster than V3 let's accept that the writing of a wide character to a byte string stream won't be as fast, since all other stream writes will be. Slightly faster (and correctly commented) version of isSeparator. =============== Diff against Collections-topa.733 =============== Item was changed: ----- Method: Character>>isSeparator (in category 'testing') ----- isSeparator "Answer whether the receiver is one of the separator characters--space, cr, tab, line feed, or form feed." | integerValue | + (integerValue := self asInteger) > 32 ifTrue: [^false]. + ^#(false false false false false false false false false + true "9 = tab" + true "10 = line feed" + false + true "12 = form feed" + true "13 = cr" + false false false false false false false false false false false false false false false false false false + true) at: integerValue + 1! - (integerValue := self asInteger) > 32 ifTrue: [ ^false ]. - integerValue - caseOf: { - [ 32 "space" ] -> [ ^true ]. - [ 9 "cr" ] -> [ ^true ]. - [ 13 "tab"] -> [ ^true ]. - [ 10 "line feed" ] -> [ ^true ] } - otherwise: [ ^integerValue = 12 "form feed" ]! Item was changed: ----- Method: WriteStream>>nextPut: (in category 'accessing') ----- nextPut: anObject "Primitive. Insert the argument at the next position in the Stream represented by the receiver. Fail if the collection of this stream is not an Array or a String. Fail if the stream is positioned at its end, or if the position is out of bounds in the collection. Fail if the argument is not of the right type for the collection. Optional. See Object documentation whatIsAPrimitive." <primitive: 66> - ((collection class == ByteString) and: [ - anObject isCharacter and:[anObject isOctetCharacter not]]) ifTrue: [ - collection := (WideString from: collection). - ^self nextPut: anObject. - ]. position >= writeLimit ifTrue: [^ self pastEndPut: anObject] ifFalse: [position := position + 1. ^collection at: position put: anObject]!

1 0

The Trunk: NetworkTests-tonyg.44.mcz
by commits＠source.squeak.org 23 Feb '17

23 Feb '17

Levente Uzonyi uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-tonyg.44.mcz ==================== Summary ==================== Name: NetworkTests-tonyg.44 Author: tonyg Time: 19 February 2017, 11:58:49.983661 am UUID: 1828cc1e-30e3-42f8-9161-e41bb29579a6 Ancestors: NetworkTests-mt.43 Add tests for SocketStream>>upToAll: with varying delimiter lengths, in binary mode in particular. As of Network-tfel.185, ascii mode works fine because ('abc' indexOfSubCollection: 'b' startingAt: -999) is acceptable, but binary mode doesn't work because out-of-range start positions are rejected there. =============== Diff against NetworkTests-mt.43 =============== Item was added: + ----- Method: SocketStreamTest>>testUpToAllCrlfAscii (in category 'stream protocol') ----- + testUpToAllCrlfAscii + "Tests correct behavior of #upToAll with a two-byte delimiter in ascii mode" + self testUpToAllDelimiter: String crlf + input: 'A header', String crlf, 'and a body' + expected: {'A header'. 'and a body'} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllCrlfBinary (in category 'stream protocol') ----- + testUpToAllCrlfBinary + "Tests correct behavior of #upToAll with a two-byte delimiter in binary mode" + self testUpToAllDelimiter: String crlf + input: 'A header', String crlf, 'and a body' + expected: {'A header'. 'and a body'} + binary: true. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllCrlfCrlfAscii (in category 'stream protocol') ----- + testUpToAllCrlfCrlfAscii + "Tests correct behavior of #upToAll with a four-byte delimiter in ascii mode" + self testUpToAllDelimiter: String crlfcrlf + input: 'A header', String crlfcrlf, 'and a body' + expected: {'A header'. 'and a body'} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllCrlfCrlfBinary (in category 'stream protocol') ----- + testUpToAllCrlfCrlfBinary + "Tests correct behavior of #upToAll with a four-byte delimiter in binary mode" + self testUpToAllDelimiter: String crlfcrlf + input: 'A header', String crlfcrlf, 'and a body' + expected: {'A header'. 'and a body'} + binary: true. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllDelimiter:input:expected:binary: (in category 'stream protocol') ----- + testUpToAllDelimiter: delimiter input: input expected: aCollection binary: useBinary + "General test of #upToAll." + clientStream nextPutAll: input; close. + serverStream shouldSignal: false. + useBinary ifTrue: [serverStream binary] ifFalse: [serverStream ascii]. + aCollection do: [:expected | | actual | + actual := (serverStream upToAll: delimiter) asString. + self assert: actual = expected]. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllEmptyPatternAscii (in category 'stream protocol') ----- + testUpToAllEmptyPatternAscii + "Tests correct behavior of #upToAll with an empty delimiter string, in ascii mode" + self testUpToAllDelimiter: '' + input: 'xaxbxc' + expected: {'xaxbxc'} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllEmptyPatternBinary (in category 'stream protocol') ----- + testUpToAllEmptyPatternBinary + "Tests correct behavior of #upToAll with an empty delimiter string, in binary mode" + self testUpToAllDelimiter: '' + input: 'xaxbxc' + expected: {'xaxbxc'} + binary: true. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllLongPatternAscii (in category 'stream protocol') ----- + testUpToAllLongPatternAscii + "Tests correct behavior of #upToAll with a long delimiter string, in ascii mode" + self testUpToAllDelimiter: 'xxxxx' + input: 'xxxxxaxxxxbxxxxxc' + expected: {''. 'axxxxb'. 'c'} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllLongPatternBinary (in category 'stream protocol') ----- + testUpToAllLongPatternBinary + "Tests correct behavior of #upToAll with a long delimiter string, in binary mode" + self testUpToAllDelimiter: 'xxxxx' + input: 'xxxxxaxxxxbxxxxxc' + expected: {''. 'axxxxb'. 'c'} + binary: true. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllMediumPatternAscii (in category 'stream protocol') ----- + testUpToAllMediumPatternAscii + "Tests correct behavior of #upToAll with a two-character delimiter string, in ascii mode" + self testUpToAllDelimiter: 'xx' + input: 'xxaxbxxc' + expected: {''. 'axb'. 'c'} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllMediumPatternBinary (in category 'stream protocol') ----- + testUpToAllMediumPatternBinary + "Tests correct behavior of #upToAll with a two-character delimiter string, in binary mode" + self testUpToAllDelimiter: 'xx' + input: 'xxaxbxxc' + expected: {''. 'axb'. 'c'} + binary: true. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllShortPatternAscii (in category 'stream protocol') ----- + testUpToAllShortPatternAscii + "Tests correct behavior of #upToAll with a short delimiter string, in ascii mode" + self testUpToAllDelimiter: 'x' + input: 'xaxbxc' + expected: {''. 'a'. 'b'. 'c'} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllShortPatternAscii2 (in category 'stream protocol') ----- + testUpToAllShortPatternAscii2 + "Tests correct behavior of #upToAll with a short delimiter string, in ascii mode" + self testUpToAllDelimiter: 'x' + input: 'axbxcx' + expected: {'a'. 'b'. 'c'. ''} + binary: false. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllShortPatternBinary (in category 'stream protocol') ----- + testUpToAllShortPatternBinary + "Tests correct behavior of #upToAll with a short delimiter string, in binary mode" + self testUpToAllDelimiter: 'x' + input: 'xaxbxc' + expected: {''. 'a'. 'b'. 'c'} + binary: true. + ! Item was added: + ----- Method: SocketStreamTest>>testUpToAllShortPatternBinary2 (in category 'stream protocol') ----- + testUpToAllShortPatternBinary2 + "Tests correct behavior of #upToAll with a short delimiter string, in binary mode" + self testUpToAllDelimiter: 'x' + input: 'axbxcx' + expected: {'a'. 'b'. 'c'. ''} + binary: true. + !

1 0

The Trunk: KernelTests-tonyg.318.mcz
by commits＠source.squeak.org 18 Feb '17

18 Feb '17

Tobias Pape uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-tonyg.318.mcz ==================== Summary ==================== Name: KernelTests-tonyg.318 Author: tonyg Time: 17 February 2017, 2:10:54.13995 pm UUID: 550fed38-fe11-4cea-bccb-2e3c13b421d0 Ancestors: KernelTests-nice.317 Add tests for Promise>>wait (including proposed change from Kernel-tonyg.1059) =============== Diff against KernelTests-nice.317 =============== Item was added: + ----- Method: PromiseTest>>testWaitForRejection (in category 'testing - monad') ----- + testWaitForRejection + | p | + p := Promise new. + [ (Delay forMilliseconds: 1) wait. p rejectWith: Error new ] fork. + self should: [ p wait ] raise: BrokenPromise.! Item was added: + ----- Method: PromiseTest>>testWaitForResolution (in category 'testing - monad') ----- + testWaitForResolution + | p | + p := Promise new. + [ (Delay forMilliseconds: 1) wait. p resolveWith: #ok ] fork. + self assert: [ p wait = #ok ]! Item was added: + ----- Method: PromiseTest>>testWaitRejectionYieldsCorrectBrokenPromise (in category 'testing - monad') ----- + testWaitRejectionYieldsCorrectBrokenPromise + | p | + p := Promise new. + [ (Delay forMilliseconds: 1) wait. p rejectWith: Error new ] fork. + [ p wait ] on: BrokenPromise do: [ :bp | ^ self assert: [ bp promise == p ] ]. + self fail: 'Should not reach this point'!

1 0

The Trunk: Kernel-tonyg.1059.mcz
by commits＠source.squeak.org 18 Feb '17

18 Feb '17

Tobias Pape uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-tonyg.1059.mcz ==================== Summary ==================== Name: Kernel-tonyg.1059 Author: tonyg Time: 17 February 2017, 2:10:00.316749 pm UUID: 75619647-2c74-47e9-bbd4-adb402acfd2d Ancestors: Kernel-ul.1058 Change Promise>>wait to signal BrokenPromise if the promise is rejected. =============== Diff against Kernel-ul.1058 =============== Item was added: + Error subclass: #BrokenPromise + instanceVariableNames: 'promise' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Exceptions'! + + !BrokenPromise commentStamp: 'tonyg 2/17/2017 13:53' prior: 0! + I am signalled when, during a Promise>>wait, the promise is rejected. + promise: the promise itself. + ! Item was added: + ----- Method: BrokenPromise>>defaultAction (in category 'as yet unclassified') ----- + defaultAction + self messageText: 'Promise was rejected'. + ^super defaultAction! Item was added: + ----- Method: BrokenPromise>>isResumable (in category 'as yet unclassified') ----- + isResumable + ^ true! Item was added: + ----- Method: BrokenPromise>>promise (in category 'as yet unclassified') ----- + promise + ^ promise! Item was added: + ----- Method: BrokenPromise>>promise: (in category 'as yet unclassified') ----- + promise: aPromise + promise := aPromise! Item was changed: ----- Method: Promise>>wait (in category 'waiting') ----- wait + "Wait unconditionally for this promise to become fulfilled or rejected." - "Wait unconditionally for this promise to resolve." | sema | sema := Semaphore new. self whenResolved:[sema signal]. + self whenRejected:[sema signal]. sema wait. + ^ self isResolved + ifTrue: [ value ] + ifFalse: [ BrokenPromise new promise: self; signal ]! - ^value!

1 0

The Trunk: KernelTests-tonyg.318.mcz
by commits＠source.squeak.org 18 Feb '17

18 Feb '17

1 0

The Trunk: Kernel-tonyg.1059.mcz
by commits＠source.squeak.org 18 Feb '17

18 Feb '17

1 0

The Trunk: ST80-eem.222.mcz
by commits＠source.squeak.org 14 Feb '17

14 Feb '17

Eliot Miranda uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-eem.222.mcz ==================== Summary ==================== Name: ST80-eem.222 Author: eem Time: 14 February 2017, 12:00:58.102425 pm UUID: 648b088e-73f0-4f1d-810a-d5059cf8eb1c Ancestors: ST80-nice.221 Preserve text emphasis when doing inOutdent: (tab/shift-tab). Comment out the unused guard against too much outdenting, insrtead of doing the search and then ignoring the result. =============== Diff against ST80-nice.221 =============== Item was changed: ----- Method: ParagraphEditor>>inOutdent:delta: (in category 'editing keys') ----- inOutdent: characterStream delta: delta "Add/remove a tab at the front of every line occupied by the selection. Flushes typeahead. Derived from work by Larry Tesler back in December 1985. Now triggered by Cmd-L and Cmd-R. 2/29/96 sw" + | realStart realStop lines startLine stopLine start stop adjustStart "indentation" numLines oldText newText newSize | - | realStart realStop lines startLine stopLine start stop adjustStart indentation numLines oldString newString newSize | sensor keyboard. "Flush typeahead" "Operate on entire lines, but remember the real selection for re-highlighting later" realStart := self startIndex. realStop := self stopIndex - 1. "Special case a caret on a line of its own, including weird case at end of paragraph" (realStart > realStop and: [realStart < 2 or: [(paragraph string at: realStart - 1) == Character cr or: [(paragraph string at: realStart - 1) == Character lf]]]) ifTrue: [delta < 0 ifTrue: [view flash] ifFalse: [self replaceSelectionWith: Character tab asSymbol asText. self selectAt: realStart + 1]. ^true]. lines := paragraph lines. startLine := paragraph lineIndexOfCharacterIndex: realStart. "start on a real line, not a wrapped line" [startLine = 1 or: [CharacterSet crlf includes: (paragraph string at: (lines at: startLine-1) last)]] whileFalse: [startLine := startLine - 1]. stopLine := paragraph lineIndexOfCharacterIndex: (realStart max: realStop). start := (lines at: startLine) first. stop := (lines at: stopLine) last. "Pin the start of highlighting unless the selection starts a line" adjustStart := realStart > start. "Find the indentation of the least-indented non-blank line; never outdent more" + "indentation := (startLine to: stopLine) inject: 1000 into: - indentation := (startLine to: stopLine) inject: 1000 into: [:m :l | m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])]. + indentation + delta <= 0 ifTrue: [^false]." - indentation + delta <= 0 ifTrue: ["^false"]. numLines := stopLine + 1 - startLine. + oldText := paragraph text copyFrom: start to: stop. + newText := oldText species new: oldText size + ((numLines * delta) max: 0). + - oldString := paragraph string copyFrom: start to: stop. - newString := oldString species new: oldString size + ((numLines * delta) max: 0). - "Do the actual work" newSize := 0. delta > 0 ifTrue: [| tabs | + tabs := oldText species new: delta withAll: Character tab. + oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | + startL < endWithoutDelimiters ifTrue: [newText replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. + newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldText startingAt: startL]] - tabs := oldString species new: delta withAll: Character tab. - oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL | - startL < endWithoutDelimiters ifTrue: [newString replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. - newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldString startingAt: startL]] ifFalse: [| tab | tab := Character tab. + oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | - oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL | | i | i := 0. + [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldText at: i + startL) == tab]]] whileTrue: [i := i + 1]. + newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldText startingAt: i + startL]]. + newSize < newText size ifTrue: [newText := newText copyFrom: 1 to: newSize]. - [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldString at: i + startL) == tab]]] whileTrue: [i := i + 1]. - newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldString startingAt: i + startL]]. - newSize < newString size ifTrue: [newString := newString copyFrom: 1 to: newSize]. "Adjust the range that will be highlighted later" adjustStart ifTrue: [realStart := (realStart + delta) max: start]. + realStop := realStop + newSize - oldText size. - realStop := realStop + newSize - oldString size. "Replace selection" self selectInvisiblyFrom: start to: stop. + self replaceSelectionWith: newText. - self replaceSelectionWith: newString asText. self selectFrom: realStart to: realStop. "highlight only the original range" ^ true!

1 0

The Trunk: Morphic-eem.1322.mcz
by commits＠source.squeak.org 14 Feb '17

14 Feb '17

Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1322.mcz ==================== Summary ==================== Name: Morphic-eem.1322 Author: eem Time: 14 February 2017, 11:57:56.157607 am UUID: 0e0bfc65-dd95-4b5f-a552-7bd3cb6b096a Ancestors: Morphic-topa.1321 Preserve text emphasis when doing inOutdent: (tab/shift-tab). Comment out the unused guard against too much outdenting, insrtead of doing the search and then ignoring the result. =============== Diff against Morphic-topa.1321 =============== Item was changed: ----- Method: TextEditor>>inOutdent:delta: (in category 'editing keys') ----- inOutdent: aKeyboardEvent delta: delta "Add/remove a tab at the front of every line occupied by the selection. Flushes typeahead. Derived from work by Larry Tesler back in December 1985. Now triggered by Cmd-L and Cmd-R. 2/29/96 sw" + | realStart realStop lines startLine stopLine start stop adjustStart "indentation" numLines oldText newText newSize | - | realStart realStop lines startLine stopLine start stop adjustStart indentation numLines oldString newString newSize | "Operate on entire lines, but remember the real selection for re-highlighting later" realStart := self startIndex. realStop := self stopIndex - 1. "Special case a caret on a line of its own, including weird case at end of paragraph" (realStart > realStop and: [realStart < 2 or: [(paragraph string at: realStart - 1) == Character cr or: [(paragraph string at: realStart - 1) == Character lf]]]) ifTrue: [delta < 0 ifTrue: [morph flash] ifFalse: [self replaceSelectionWith: Character tab asText. self selectAt: realStart + 1]. ^true]. lines := paragraph lines. startLine := paragraph lineIndexOfCharacterIndex: realStart. "start on a real line, not a wrapped line" [startLine = 1 or: [CharacterSet crlf includes: (paragraph string at: (lines at: startLine-1) last)]] whileFalse: [startLine := startLine - 1]. stopLine := paragraph lineIndexOfCharacterIndex: (realStart max: realStop). start := (lines at: startLine) first. stop := (lines at: stopLine) last. + - "Pin the start of highlighting unless the selection starts a line" adjustStart := realStart > start. "Find the indentation of the least-indented non-blank line; never outdent more" + "indentation := (startLine to: stopLine) inject: 1000 into: - indentation := (startLine to: stopLine) inject: 1000 into: [:m :l | m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])]. + indentation + delta <= 0 ifTrue: [^false]." - indentation + delta <= 0 ifTrue: ["^false"]. numLines := stopLine + 1 - startLine. + oldText := paragraph text copyFrom: start to: stop. + newText := oldText species new: oldText size + ((numLines * delta) max: 0). - oldString := paragraph string copyFrom: start to: stop. - newString := oldString species new: oldString size + ((numLines * delta) max: 0). "Do the actual work" newSize := 0. delta > 0 ifTrue: [| tabs | + tabs := oldText species new: delta withAll: Character tab. + oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | + startL < endWithoutDelimiters ifTrue: [newText replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. + newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldText startingAt: startL]] - tabs := oldString species new: delta withAll: Character tab. - oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL | - startL < endWithoutDelimiters ifTrue: [newString replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1]. - newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldString startingAt: startL]] ifFalse: [| tab | tab := Character tab. + oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL | - oldString lineIndicesDo: [:startL :endWithoutDelimiters :endL | | i | i := 0. + [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldText at: i + startL) == tab]]] whileTrue: [i := i + 1]. + newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldText startingAt: i + startL]]. + newSize < newText size ifTrue: [newText := newText copyFrom: 1 to: newSize]. - [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldString at: i + startL) == tab]]] whileTrue: [i := i + 1]. - newString replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldString startingAt: i + startL]]. - newSize < newString size ifTrue: [newString := newString copyFrom: 1 to: newSize]. "Adjust the range that will be highlighted later" adjustStart ifTrue: [realStart := (realStart + delta) max: start]. + realStop := realStop + newSize - oldText size. - realStop := realStop + newSize - oldString size. "Replace selection" self selectInvisiblyFrom: start to: stop. + self replaceSelectionWith: newText. - self replaceSelectionWith: newString asText. self selectFrom: realStart to: realStop. "highlight only the original range" ^ true!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2017