Packages August 2016

packages@lists.squeakfoundation.org

1 participants
528 discussions

The Trunk: Morphic-mt.1219.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1219.mcz ==================== Summary ==================== Name: Morphic-mt.1219 Author: mt Time: 1 August 2016, 5:14:54.536106 pm UUID: d7730709-869a-b847-adaa-ee09107f7cdd Ancestors: Morphic-mt.1218 Fixes a bug in the pluggable button label drawing code. Theme the three-phase button, too. =============== Diff against Morphic-mt.1218 =============== Item was changed: ----- Method: ImageMorph>>extent: (in category 'geometry') ----- extent: aPoint + + super extent: self preferredExtent.! - "Do nothing; my extent is determined by my image Form." - ! Item was changed: ----- Method: ImageMorph>>image: (in category 'accessing') ----- image: anImage self changed. image := anImage depth = 1 ifTrue: [ColorForm mappingWhiteToTransparentFrom: anImage] ifFalse: [anImage]. + super extent: self preferredExtent! - super extent: image extent! Item was added: + ----- Method: ImageMorph>>preferredExtent (in category 'accessing') ----- + preferredExtent + ^ image ifNil: [0@0] ifNotNil: [image extent]! Item was changed: ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') ----- drawLabelOn: aCanvas | fontToUse labelToUse colorToUse labelWidth layoutBounds drawBlock | self label ifNil: [^ self]. layoutBounds := self layoutBounds. labelToUse := self label asString. fontToUse := self font. colorToUse := self textColorToUse. "Support very narrow buttons. Shrink text to monogram then." + ((layoutBounds width < self labelShrinkThreshold + and: [self hResizing ~~ #shrinkWrap]) + and: [labelToUse size > 3]) ifTrue: [ + labelToUse := labelToUse first asString. "Show first character only." + fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode]. - (layoutBounds width < self labelShrinkThreshold and: [labelToUse size > 3]) ifTrue: [ - labelToUse := labelToUse first asString. "Show first character only." - fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode]. labelWidth := fontToUse widthOfString: labelToUse. drawBlock := [:c | c drawString: labelToUse at: (layoutBounds center x - (labelWidth // 2) max: (layoutBounds left)) @ (layoutBounds center y - (fontToUse height // 2)) font: fontToUse color: colorToUse]. self clipSubmorphs ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock] ifFalse: [drawBlock value: aCanvas]! Item was changed: ImageMorph subclass: #ThreePhaseButtonMorph + instanceVariableNames: 'offImage pressedImage state target actionSelector arguments actWhen label font textColor' - instanceVariableNames: 'offImage pressedImage state target actionSelector arguments actWhen' classVariableNames: 'AuthorModeOwner' poolDictionaries: '' category: 'Morphic-Widgets'! !ThreePhaseButtonMorph commentStamp: '<historical>' prior: 0! A button morph with separate images for on, off, and pressed with the mouse. When the event actWhen occurs, send actionSelector with 'arguments' to target. For other events, default to my eventHandler. The current event is not supplied in the arguments to the actionSelector. image (a.k.a. onImage) may not be nil. offImage and pressedImage may be nil. nil there means be transparent and show the underlying object. Tools for debugging: Display the images momentarily under program control (for positioning) (self is an instance). self state: #on. self state: #off. self state: #pressed. self state: #off. Display a rectangle where the button is. Display fillWithColor: bounds + (self world viewBox origin). self invalidRect: bounds.! Item was changed: ----- Method: ThreePhaseButtonMorph class>>checkBox (in category 'instance creation') ----- checkBox "Answer a button pre-initialized with checkbox images." | f | ^self new onImage: (f := ScriptingSystem formAtKey: 'CheckBoxOn'); pressedImage: (ScriptingSystem formAtKey: 'CheckBoxPressed'); offImage: (ScriptingSystem formAtKey: 'CheckBoxOff'); extent: f extent + (2@0); + setDefaultParameters; yourself ! Item was changed: ----- Method: ThreePhaseButtonMorph class>>radioButton (in category 'instance creation') ----- radioButton "Answer a button pre-initialized with radiobutton images." | f | ^self new onImage: (f := ScriptingSystem formAtKey: 'RadioButtonOn'); pressedImage: (ScriptingSystem formAtKey: 'RadioButtonPressed'); offImage: (ScriptingSystem formAtKey: 'RadioButtonOff'); extent: f extent + (2@0); + setDefaultParameters; yourself ! Item was added: + ----- Method: ThreePhaseButtonMorph class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ super themeProperties, { + { #color. 'Colors'. 'Color of the button.' }. + { #font. 'Fonts'. 'Font for button title.' }. + { #textColor. 'Colors'. 'Color for the button title label.' }. + }! Item was added: + ----- Method: ThreePhaseButtonMorph>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + self setDefaultParameters.! Item was added: + ----- Method: ThreePhaseButtonMorph>>color: (in category 'accessing') ----- + color: c + + self onImage ifNotNil: [:form | + self onImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])]. + self offImage ifNotNil: [:form | + self offImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])]. + self pressedImage ifNotNil: [:form | + self pressedImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])]. + + ^ super color: c! Item was added: + ----- Method: ThreePhaseButtonMorph>>currentImage (in category 'accessing') ----- + currentImage + + state == #off ifTrue: [^ offImage]. + state == #pressed ifTrue: [^ pressedImage]. + state == #on ifTrue: [^ image]. + ^ image! Item was changed: ----- Method: ThreePhaseButtonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + | imageToUse | + + imageToUse := self currentImage. + + imageToUse ifNotNil: [aCanvas translucentImage: imageToUse at: bounds origin]. + + self label ifNotNil: [:lbl | + aCanvas + drawString: lbl + at: bounds origin + (imageToUse ifNil: [0@0] ifNotNil: [:form | (form width @ 0) + (3@0)]) + font: self font + color: self textColor].! - state == #off ifTrue: [ - offImage ifNotNil: [aCanvas translucentImage: offImage at: bounds origin]]. - state == #pressed ifTrue: [ - pressedImage ifNotNil: [aCanvas translucentImage: pressedImage at: bounds origin]]. - state == #on ifTrue: [ - image ifNotNil: [aCanvas translucentImage: image at: bounds origin]].! Item was added: + ----- Method: ThreePhaseButtonMorph>>font (in category 'accessing') ----- + font + ^ font ifNil: [TextStyle defaultFont]! Item was added: + ----- Method: ThreePhaseButtonMorph>>font: (in category 'accessing') ----- + font: aFont + font := aFont. + super extent: self preferredExtent.! Item was added: + ----- Method: ThreePhaseButtonMorph>>label (in category 'accessing') ----- + label + ^ label! Item was added: + ----- Method: ThreePhaseButtonMorph>>label: (in category 'accessing') ----- + label: aString + label := aString. + super extent: self preferredExtent.! Item was added: + ----- Method: ThreePhaseButtonMorph>>preferredExtent (in category 'accessing') ----- + preferredExtent + + | iw ih lw lh | + iw := self currentImage width. + ih := self currentImage height. + lw := self font widthOfString: (self label ifNil: ['']). + lh := self font height. + ^ (iw + 3 + lw) @ (ih max: lh)! Item was added: + ----- Method: ThreePhaseButtonMorph>>setDefaultParameters (in category 'initialization') ----- + setDefaultParameters + + self + color: (self userInterfaceTheme color ifNil: [Color black]); + font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); + textColor: (self userInterfaceTheme textColor ifNil: [Color black]).! Item was added: + ----- Method: ThreePhaseButtonMorph>>textColor (in category 'accessing') ----- + textColor + ^ textColor ifNil: [Color black]! Item was added: + ----- Method: ThreePhaseButtonMorph>>textColor: (in category 'accessing') ----- + textColor: aColor + textColor := aColor.!

1 0

The Trunk: System-mt.857.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.857.mcz ==================== Summary ==================== Name: System-mt.857 Author: mt Time: 1 August 2016, 5:13:08.765106 pm UUID: 0297521f-ec7e-7e4e-88c1-725a49f25bd2 Ancestors: System-mt.856 Theme the three-phase button, too. =============== Diff against System-mt.856 =============== Item was changed: ----- Method: SqueakTheme class>>addButtons: (in category 'instance creation') ----- addButtons: theme theme set: #borderColor for: #PluggableButtonMorph to: Color gray; set: #borderWidth for: #PluggableButtonMorph to: 1; set: #borderStyle for: #PluggableButtonMorph to: BorderStyle default; set: #color for: #PluggableButtonMorph to: [Color gray: 0.91]; set: #font for: #PluggableButtonMorph to: [Preferences standardButtonFont]; set: #textColor for: #PluggableButtonMorph to: Color black; set: #selectionModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: -0.2] ]; set: #hoverModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: -0.1] ]; set: #feedbackModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: -0.3] ]. "And the plus-version." theme set: #disabledColor for: #PluggableButtonMorphPlus to: Color transparent; set: #disabledTextColor for: #PluggableButtonMorphPlus to: (Color gray: 0.6). + + "And the three-phase button." + theme + derive: #color for: #ThreePhaseButtonMorph from: #PluggableButtonMorph at: #textColor; + derive: #font for: #ThreePhaseButtonMorph from: #PluggableButtonMorph; + derive: #textColor for: #ThreePhaseButtonMorph from: #PluggableButtonMorph.! - !

1 0

The Trunk: System-mt.856.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.856.mcz ==================== Summary ==================== Name: System-mt.856 Author: mt Time: 1 August 2016, 3:17:05.483063 pm UUID: e9f7d2ad-81a0-1d4f-b553-31510a255316 Ancestors: System-mt.855 Revise the system version descriptions. Be not so talky in release versions. =============== Diff against System-mt.855 =============== Item was changed: ----- Method: SystemVersion>>description (in category 'printing') ----- description + self isAlpha ifTrue: [^ 'ALPHA. New features which are not stable yet may come in\with each update. Also, existing features might not work reliably\due to updates and related changes.' translated withCRs]. - self isAlpha ifTrue: [^ 'This is an ALPHA version. It means that new features might be\introduced with each update or that very basic functions might\be quite buggy at the moment.\\Please refrain from using this version for important projects.' translated withCRs]. + self isFeatureFreeze ifTrue: [^ 'FEATURE FREEZE. A new release is being prepared.\There will be only bugfixes, but no new features.' translated withCRs]. - self isFeatureFreeze ifTrue: [^ 'This is a FEATURE FREEZE version. We are in the middle of preparing\a new release. It means that there will be no new features but only bugfixes.\\Please do not contribute new features at the moment. ;-)' translated withCRs]. + self isCodeFreeze ifTrue: [^ 'RELEASE CANDIDATE. The new release is almost ready.\There will be only bugfixes, if any.' translated withCRs]. - self isCodeFreeze ifTrue: [^ 'This is a RELEASE CANDIDATE version. It means that we are almost\done preparing the new release.\\Please do ONLY contribute URGENT fixes. Thank you. :-)' translated withCRs]. + self isRelease ifTrue: [^ ''].! - self isRelease ifTrue: [^ self inform: 'This is a release version. It means that there will be only\bugfixes but no new features.\\Have fun. :-)' translated withCRs].!

1 0

The Trunk: ReleaseBuilder-mt.140.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-mt.140.mcz ==================== Summary ==================== Name: ReleaseBuilder-mt.140 Author: mt Time: 1 August 2016, 3:13:12.180063 pm UUID: 908dfe7e-fd75-5f44-a62e-3a141a625134 Ancestors: ReleaseBuilder-mt.139 Feature-freeze the Trunk. =============== Diff against ReleaseBuilder-mt.139 =============== Item was changed: ----- Method: ReleaseBuilder class>>initialize (in category 'class initialization') ----- initialize Smalltalk addToStartUpList: self. + SystemVersion newVersion: 'Squeak5.1beta'.! - SystemVersion newVersion: 'Squeak5.1alpha'.!

1 0

The Trunk: Monticello-mt.641.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-mt.641.mcz ==================== Summary ==================== Name: Monticello-mt.641 Author: mt Time: 1 August 2016, 3:12:22.642063 pm UUID: 6e5db234-d1b0-1544-b633-dfd20aead82a Ancestors: Monticello-mt.640 If we are in feature-freeze or code-freeze, inform the developer when committing to the trunk repository. =============== Diff against Monticello-mt.640 =============== Item was changed: ----- Method: MCWorkingCopyBrowser>>saveVersion (in category 'actions') ----- saveVersion | repo | self canSave ifFalse: [^self]. self checkForNewerVersions ifFalse: [^self]. repo := self repository. + (repo == MCRepository trunk and: [SystemVersion current isFeatureFreeze]) + ifTrue: [self inform: 'FEATURE FREEZE. A new release is being prepared.\Please do only do bugfixes, but no new features.' translated withCRs]. + (repo == MCRepository trunk and: [SystemVersion current isCodeFreeze]) + ifTrue: [self inform: 'CODE FREEZE. The new release is almost ready.\Please do only do URGENT fixes, if any.' translated withCRs]. + (self withRepository: repo do: [workingCopy newVersion]) ifNotNil: [:v | (MCVersionInspector new version: v) show. Cursor wait showWhile: [repo storeVersion: v]. MCCacheRepository default cacheAllFileNamesDuring: [repo cacheAllFileNamesDuring: [v allAvailableDependenciesDo: [:dep | (repo includesVersionNamed: dep info name) ifFalse: [repo storeVersion: dep]]]]]!

1 0

The Trunk: ToolBuilder-Morphic-mt.176.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.176.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.176 Author: mt Time: 1 August 2016, 2:44:38.851063 pm UUID: 90acc5bd-1f6a-4f48-b1ac-d36a798437d4 Ancestors: ToolBuilder-Morphic-mt.175 For lists smaller than or equal to 7, use button-only dialog but still support keyboard filtering. Note that people tend to choose between #(yes no) and hence we do need such a button-only version of a list chooser. Still, better than using menus in terms of input modality and visual consistency. =============== Diff against ToolBuilder-Morphic-mt.175 =============== Item was changed: ----- Method: MorphicUIManager>>chooseFrom:lines:title: (in category 'ui requests') ----- chooseFrom: aList lines: linesArray title: aString "Choose an item from the given list. Answer the index of the selected item." aList size <= 7 ifTrue: [ | dialog | dialog := DialogWindow new title: 'Please Choose'; message: aString; + filterEnabled: true; yourself. aList doWithIndex: [:ea :index | dialog createButton: ea value: index]. dialog selectedButtonIndex: 1. ^ dialog getUserResponseAtHand ifNil: [0]]. ^ ListChooser chooseFrom: aList title: aString!

1 0

The Trunk: Morphic-mt.1218.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1218.mcz ==================== Summary ==================== Name: Morphic-mt.1218 Author: mt Time: 1 August 2016, 2:42:37.666063 pm UUID: c5757b59-e3d1-5841-a689-f52f1a38c28e Ancestors: Morphic-mt.1217 Add the possibility to filter button-only dialogs via keyboard expressions as known from menus. =============== Diff against Morphic-mt.1217 =============== Item was changed: Morph subclass: #DialogWindow + instanceVariableNames: 'titleMorph messageMorph paneMorph buttonRow result selectedButton cancelButton timeout preferredPosition keyMap exclusive filter filterEnabled filterMorph' - instanceVariableNames: 'titleMorph messageMorph paneMorph buttonRow result selectedButton cancelButton timeout preferredPosition keyMap exclusive' classVariableNames: 'GradientDialog RoundedDialogCorners UseWiggleAnimation' poolDictionaries: '' category: 'Morphic-Windows'! !DialogWindow commentStamp: '<historical>' prior: 0! A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.! Item was changed: ----- Method: DialogWindow>>createBody (in category 'initialization') ----- createBody | body | body := Morph new changeTableLayout; hResizing: #shrinkWrap; vResizing: #shrinkWrap; listDirection: #topToBottom; cellPositioning: #leftCenter; layoutInset: (10@5 corner: 10@10); cellInset: 5; color: Color transparent; yourself. + body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow. self createFilter}. - body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow}. self addMorphBack: body.! Item was added: + ----- Method: DialogWindow>>createFilter (in category 'initialization') ----- + createFilter + + filterMorph := '' asText asMorph lock. + filterMorph + visible: false; + disableTableLayout: true. + ^ filterMorph! Item was changed: ----- Method: DialogWindow>>drawOverlayOn: (in category 'drawing') ----- drawOverlayOn: aCanvas | title inset | super drawOverlayOn: aCanvas. title := self submorphs first. self wantsRoundedCorners ifTrue: [ inset := (self class roundedDialogCorners and: [self class gradientDialog]) "This check compensates a bug in balloon." ifTrue: [0@0 corner: 0@ -1] ifFalse: [self borderWidth @ 0]. "Overdraw lower part of title bar to hide bottom corners." aCanvas fillRectangle:( (title bottomLeft - (0 @ self submorphs first cornerRadius) corner: title bottomRight) insetBy: inset) color: self color]. "Draw a line between the title and the contents." self borderWidth > 0 ifTrue: [ "Redraw the border all around. Needed because rounded borders do not align very well." self wantsRoundedCorners ifTrue: [ aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self borderStyle width color: self borderStyle color] ifFalse: [aCanvas frameRectangle: self bounds width: self borderStyle width color: self borderStyle color]].! Item was changed: ----- Method: DialogWindow>>ensureSelectedButton (in category 'selection') ----- ensureSelectedButton + self buttons ifEmpty: [^ self]. + self selectedButton ifNil: [self selectButton: self buttons first]. + self selectedButton enabled ifFalse: [self selectNextButton].! - self selectedButton ifNil: [self selectButton: self buttons first].! Item was added: + ----- Method: DialogWindow>>filter (in category 'accessing') ----- + filter + ^ filter ifNil: ['']! Item was added: + ----- Method: DialogWindow>>filter: (in category 'accessing') ----- + filter: aString + filter := aString. + self updateFilter.! Item was added: + ----- Method: DialogWindow>>filterEnabled (in category 'accessing') ----- + filterEnabled + ^ filterEnabled ifNil: [false]! Item was added: + ----- Method: DialogWindow>>filterEnabled: (in category 'accessing') ----- + filterEnabled: aBoolean + + filterEnabled := aBoolean. + self updateFilter.! Item was changed: ----- Method: DialogWindow>>keyStroke: (in category 'events') ----- keyStroke: evt | char | self stopAutoTrigger. char := evt keyCharacter. char = Character escape ifTrue: [ ^ self cancelDialog ]. (char = Character cr or: [char = Character enter]) ifTrue: [ ^ self closeDialog ]. ((char = Character arrowLeft or: [char = Character arrowUp]) or: [ evt shiftPressed and: [ char = Character tab ] ]) ifTrue: [ ^ self selectPreviousButton ]. ((char = Character arrowRight or: [char = Character arrowDown]) or: [ char = Character tab ]) ifTrue: [ ^ self selectNextButton ]. + + self filterEnabled ifTrue: [ + char = Character backspace ifTrue: [self filter: (self filter ifEmpty: [''] ifNotEmpty: [:f | f allButLast])]. + (char isAlphaNumeric or: [char = Character space]) + ifTrue: [self filter: self filter, char asString]]. + - keyMap at: char asLowercase ifPresent: [ : foundButton | foundButton performAction ] ifAbsent: [ "do nothing" ].! Item was changed: ----- Method: DialogWindow>>selectNextButton (in category 'selection') ----- selectNextButton self selectedButton ifNil: [^ self]. + (self buttons anySatisfy: [:ea | ea enabled]) ifFalse: [^ self]. + + self selectedButtonIndex: self selectedButtonIndex \\ self buttons size + 1. + self selectedButton enabled ifFalse: [self selectNextButton].! - self selectedButtonIndex: self selectedButtonIndex \\ self buttons size + 1.! Item was changed: ----- Method: DialogWindow>>selectPreviousButton (in category 'selection') ----- selectPreviousButton self selectedButton ifNil: [^ self]. + (self buttons anySatisfy: [:ea | ea enabled]) ifFalse: [^ self]. + + self selectedButtonIndex: self selectedButtonIndex - 2 \\ self buttons size + 1. + self selectedButton enabled ifFalse: [self selectPreviousButton].! - self selectedButtonIndex: self selectedButtonIndex - 2 \\ self buttons size + 1.! Item was changed: ----- Method: DialogWindow>>setMessageParameters (in category 'initialization') ----- setMessageParameters messageMorph ifNotNil: [ | fontToUse colorToUse | fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. colorToUse := self userInterfaceTheme textColor ifNil: [Color black]. messageMorph contents addAttribute: (TextFontReference toFont: fontToUse); addAttribute: (TextColor color: colorToUse). + messageMorph textColor: colorToUse. messageMorph releaseParagraph; changed].! Item was added: + ----- Method: DialogWindow>>updateFilter (in category 'updating') ----- + updateFilter + + self buttons do: [:ea | + ea enabled: (self filter isEmpty or: [ea label asString includesSubstring: self filter caseSensitive: false])]. + + filterMorph + visible: self filter notEmpty; + disableTableLayout: self filter isEmpty; + contents: '<', self filter, '>'; + textColor: self messageMorph textColor. + + self ensureSelectedButton.!

1 0

The Trunk: Network-ul.180.mcz
by commits＠source.squeak.org 01 Aug '16

01 Aug '16

Levente Uzonyi uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ul.180.mcz ==================== Summary ==================== Name: Network-ul.180 Author: ul Time: 25 July 2016, 8:40:01.001452 pm UUID: 2f23a55c-fec5-41ac-95bd-6a8c2458be95 Ancestors: Network-nice.179 Socket changes: - fixed the comment of #isOtherEndConnected and #isThisEndConnected - do not slice the data (TCP) in the image in #sendData:. Let the VM, the kernel, the hardware deal with that. - use #isOtherEndConnected when receiving data, and #isThisEndConnected when sending data instead of #isConnected - move away from #milliseconds:since:, since we have a clock that won't roll over =============== Diff against Network-nice.179 =============== Item was changed: ----- Method: Socket>>closeAndDestroy: (in category 'connection open/close') ----- closeAndDestroy: timeoutSeconds "First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)." + socketHandle ifNil: [ ^self ]. + self isThisEndConnected ifTrue: [ + self close. "Close this end." ]. + (self waitForDisconnectionFor: timeoutSeconds) ifFalse: [ + "The other end has not closed the connect yet, so we will just abort it." + self primSocketAbortConnection: socketHandle ]. + self destroy! - socketHandle ifNotNil: [ - self isConnected ifTrue: [ - self close. "close this end" - (self waitForDisconnectionFor: timeoutSeconds) ifFalse: [ - "The other end didn't close so we just abort the connection" - self primSocketAbortConnection: socketHandle]]. - self destroy]. - ! Item was changed: ----- Method: Socket>>discardReceivedData (in category 'receiving') ----- discardReceivedData "Discard any data received up until now, and return the number of bytes discarded." | buf totalBytesDiscarded | buf := String new: 10000. totalBytesDiscarded := 0. + [self isOtherEndConnected and: [self dataAvailable]] whileTrue: [ - [self isConnected and: [self dataAvailable]] whileTrue: [ totalBytesDiscarded := totalBytesDiscarded + (self receiveDataInto: buf)]. ^ totalBytesDiscarded ! Item was changed: ----- Method: Socket>>isOtherEndConnected (in category 'queries') ----- isOtherEndConnected + "Return true if this socket is connected, or this end has closed the connection but not the other end, so we can still receive data." - "Return true if this socket is connected, or this end has closed the connection but not the other end, so we can still send data." | state | socketHandle ifNil: [ ^false ]. (state := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [ ^true ]. ^state == ThisEndClosed ! Item was changed: ----- Method: Socket>>isThisEndConnected (in category 'queries') ----- isThisEndConnected + "Return true if this socket is connected, other the other end has closed the connection but not this end, so we can still send data." - "Return true if this socket is connected, other the other end has closed the connection but not this end, so we can still receive data." | state | socketHandle ifNil: [ ^false ]. (state := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [ ^true ]. ^state == OtherEndClosed ! Item was changed: ----- Method: Socket>>sendData: (in category 'sending') ----- sendData: aStringOrByteArray "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent." "An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts." | bytesSent bytesToSend count | bytesToSend := aStringOrByteArray size. bytesSent := 0. [bytesSent < bytesToSend] whileTrue: [ (self waitForSendDoneFor: 60) ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent']. count := self primSocket: socketHandle sendData: aStringOrByteArray startIndex: bytesSent + 1 + count: bytesToSend - bytesSent. - count: (bytesToSend - bytesSent min: DefaultSendBufferSize). bytesSent := bytesSent + count]. ^ bytesSent ! Item was changed: ----- Method: Socket>>waitForConnectionFor:ifTimedOut:ifRefused: (in category 'waiting') ----- waitForConnectionFor: timeout ifTimedOut: timeoutBlock ifRefused: refusedBlock "Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not." + | deadline timeLeft status | + deadline := Time millisecondClockValue + (timeout * 1000) truncated. + (status := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [^true]. + [ (status == WaitingForConnection) and: [ (timeLeft := deadline - Time millisecondClockValue) > 0 ] ] - | startTime msecsDelta msecsEllapsed status | - startTime := Time millisecondClockValue. - msecsDelta := (timeout * 1000) truncated. - status := self primSocketConnectionStatus: socketHandle. - status = Connected ifTrue: [^true]. - [(status = WaitingForConnection) and: [(msecsEllapsed := Time millisecondsSince: startTime) < msecsDelta]] whileTrue: [ + semaphore waitTimeoutMSecs: timeLeft. + status := self primSocketConnectionStatus: socketHandle ]. + status == Connected ifTrue: [ ^true ]. + status == WaitingForConnection + ifTrue: [ timeoutBlock value ] + ifFalse: [ refusedBlock value ]. + ^false! - semaphore waitTimeoutMSecs: msecsDelta - msecsEllapsed. - status := self primSocketConnectionStatus: socketHandle]. - status = Connected - ifFalse: [ - status = WaitingForConnection - ifTrue: [timeoutBlock value] - ifFalse: [refusedBlock value]. - ^false]. - ^ true! Item was changed: ----- Method: Socket>>waitForConnectionUntil: (in category 'waiting') ----- waitForConnectionUntil: deadline "Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not." + | status timeLeft | - | status waitTime | [ (status := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [ ^true ]. status == WaitingForConnection ifFalse: [ ^false ]. + (timeLeft := deadline - Time millisecondClockValue) <= 0 ifTrue: [ ^false ]. + semaphore waitTimeoutMSecs: timeLeft ] repeat! - (waitTime := deadline - Time millisecondClockValue) > 0 ifFalse: [ ^false ]. - semaphore waitTimeoutMSecs: waitTime ] repeat! Item was changed: ----- Method: Socket>>waitForDataFor:ifClosed:ifTimedOut: (in category 'waiting') ----- waitForDataFor: timeout ifClosed: closedBlock ifTimedOut: timedOutBlock "Wait for the given nr of seconds for data to arrive." + | deadline timeLeft | - | startTime msecsDelta | socketHandle ifNil: [ ^closedBlock value ]. + deadline := Time millisecondClockValue + (timeout * 1000) truncated. - startTime := Time millisecondClockValue. - msecsDelta := (timeout * 1000) truncated. [ (self primSocketReceiveDataAvailable: socketHandle) ifTrue: [ ^self ]. + self isOtherEndConnected ifFalse: [ ^closedBlock value ]. + (timeLeft := deadline - Time millisecondClockValue) <= 0 ifTrue: [ ^timedOutBlock value ]. - self isConnected ifFalse: [ ^closedBlock value ]. - (Time millisecondsSince: startTime) < msecsDelta ifFalse: [ ^timedOutBlock value ]. "Providing a maximum for the time for waiting is a workaround for a VM bug which causes sockets waiting for data forever in some rare cases, because the semaphore doesn't get signaled. Remove the ""min: self class maximumReadSemaphoreWaitTimeout"" part when the bug is fixed." readSemaphore waitTimeoutMSecs: + (timeLeft min: self class maximumReadSemaphoreWaitTimeout) ] repeat! - (msecsDelta - (Time millisecondsSince: startTime) min: self class maximumReadSemaphoreWaitTimeout) ] repeat! Item was changed: ----- Method: Socket>>waitForDataIfClosed: (in category 'waiting') ----- waitForDataIfClosed: closedBlock "Wait indefinitely for data to arrive. This method will block until data is available or the socket is closed." socketHandle ifNil: [ ^closedBlock value ]. [ (self primSocketReceiveDataAvailable: socketHandle) ifTrue: [ ^self ]. + self isOtherEndConnected ifFalse: [ ^closedBlock value ]. - self isConnected ifFalse: [ ^closedBlock value ]. "ul 8/13/2014 21:16 Providing a maximum for the time for waiting is a workaround for a VM bug which causes sockets waiting for data forever in some rare cases, because the semaphore doesn't get signaled. Replace the ""waitTimeoutMSecs: self class maximumReadSemaphoreWaitTimeout"" part with ""wait"" when the bug is fixed." readSemaphore waitTimeoutMSecs: self class maximumReadSemaphoreWaitTimeout ] repeat! Item was changed: ----- Method: Socket>>waitForDisconnectionFor: (in category 'waiting') ----- waitForDisconnectionFor: timeout "Wait for the given nr of seconds for the connection to be broken. Return true if it is broken by the deadline, false if not. The client should know the connection is really going to be closed (e.g., because he has called 'close' to send a close request to the other end) before calling this method." + | deadline | + deadline := Time millisecondClockValue + (timeout * 1000) truncated. + [ self isOtherEndConnected and: [ deadline - Time millisecondClockValue > 0 ] ] + whileTrue: [ + self discardReceivedData. + "Providing a maximum for the time for waiting is a workaround for a VM bug which causes sockets waiting for data forever in some rare cases, because the semaphore doesn't get signaled. Remove the ""min: self class maximumReadSemaphoreWaitTimeout"" part when the bug is fixed." + readSemaphore waitTimeoutMSecs: + (deadline - Time millisecondClockValue min: self class maximumReadSemaphoreWaitTimeout) ]. + ^self isOtherEndConnected! - | startTime msecsDelta status | - startTime := Time millisecondClockValue. - msecsDelta := (timeout * 1000) truncated. - status := self primSocketConnectionStatus: socketHandle. - [((status == Connected) or: [(status == ThisEndClosed)]) and: - [(Time millisecondsSince: startTime) < msecsDelta]] whileTrue: [ - self discardReceivedData. - "Providing a maximum for the time for waiting is a workaround for a VM bug which causes sockets waiting for data forever in some rare cases, because the semaphore doesn't get signaled. Remove the ""min: self class maximumReadSemaphoreWaitTimeout"" part when the bug is fixed." - readSemaphore waitTimeoutMSecs: - (msecsDelta - (Time millisecondsSince: startTime) min: self class maximumReadSemaphoreWaitTimeout). - status := self primSocketConnectionStatus: socketHandle]. - ^ status ~= Connected! Item was changed: ----- Method: Socket>>waitForSendDoneFor: (in category 'waiting') ----- waitForSendDoneFor: timeout "Wait up until the given deadline for the current send operation to complete. Return true if it completes by the deadline, false if not." + | deadline timeleft | + deadline := Time millisecondClockValue + (timeout * 1000) truncated. - | startTime msecsDelta msecsEllapsed | - startTime := Time millisecondClockValue. - msecsDelta := (timeout * 1000) truncated. [ (self primSocketSendDone: socketHandle) ifTrue: [ ^true ]. + self isThisEndConnected ifFalse: [ ^false ]. + (timeleft := deadline - Time millisecondClockValue) <= 0 ifTrue: [ ^false ]. + writeSemaphore waitTimeoutMSecs: timeleft ] repeat! - self isConnected ifFalse: [ ^false ]. - (msecsEllapsed := Time millisecondsSince: startTime) < msecsDelta ifFalse: [ ^false ]. - writeSemaphore waitTimeoutMSecs: msecsDelta - msecsEllapsed ] repeat!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages August 2016