Squeak-dev March 2019

squeak-dev@lists.squeakfoundation.org

26 participants
85 discussions

The Inbox: HelpSystem-Core-kks.109.mcz
by commits＠source.squeak.org 08 Mar '19

08 Mar '19

A new version of HelpSystem-Core was added to project The Inbox: http://source.squeak.org/inbox/HelpSystem-Core-kks.109.mcz ==================== Summary ==================== Name: HelpSystem-Core-kks.109 Author: kks Time: 8 March 2019, 2:52:33.288436 pm UUID: a50742bc-0442-4e86-8c1f-7b54fb50754e Ancestors: HelpSystem-Core-pre.108 Added # prefix to method names in help topics so that we can browse them directly with a single keystroke =============== Diff against HelpSystem-Core-pre.108 =============== Item was changed: ----- Method: ClassAPIHelpBuilder>>buildMethodTopicsOn:for: (in category 'private building') ----- buildMethodTopicsOn: topic for: aClass topic contents: (String streamContents: [ :stream | aClass selectors sort do: [ :selector | stream nextPutAll: aClass name; + nextPutAll: '>>#'; - nextPutAll: '>>'; nextPutAll: selector asString; cr; nextPutAll: ( (aClass commentsAt: selector) at: 1 ifAbsent: [ 'Method has no comment.' ]); cr; cr ] ])! Item was changed: ----- Method: MethodListHelpTopic>>contents (in category 'accessing') ----- contents ^ (String streamContents: [ :stream | self theClass selectors sort do: [ :selector | stream nextPutAll: self theClass name; + nextPutAll: '>>#'; - nextPutAll: '>>'; nextPutAll: selector asString; cr; nextPutAll: ( (self theClass commentsAt: selector) at: 1 ifAbsent: [ '-' ]); cr; cr ] ])!

3 2

The Trunk: KernelTests-eem.355.mcz
by commits＠source.squeak.org 07 Mar '19

07 Mar '19

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.355.mcz ==================== Summary ==================== Name: KernelTests-eem.355 Author: eem Time: 6 March 2019, 3:16:05.445238 pm UUID: 6dcbdd43-dbe7-4ddf-8142-ec9c7fb4296c Ancestors: KernelTests-tonyg.354 Avoid using a deprecated message (includesSubString:) in a test. =============== Diff against KernelTests-tonyg.354 =============== Item was changed: ----- Method: AllocationTest>>testOutOfMemorySignal (in category 'tests') ----- testOutOfMemorySignal "Ensure that OutOfMemory is signaled eventually" | sz | self setFreeSpaceLimitOf: 1024 * 1024 * 1024 * (Smalltalk wordSize = 8 ifTrue: [4] ifFalse: [1.5]) around: [sz := 512*1024*1024. "work around the 1GB alloc bug" self should: [(1 to: 2000) collect: [:i| Array new: sz]] raise: OutOfMemory]. "Call me when this test fails, I want your machine." "Current (2017) Spur VMs fail new: & basicNew: with #'bad argument' if given other than a non-negative SmallInteger." sz := 1024*1024*1024*1024. self should: [Array new: sz] raise: OutOfMemory, Error withExceptionDo: [:ex| ex class == Error ifTrue: + [self assert: [ex messageText includesSubstring: 'basicNew: with invalid argument']]]! - [self assert: [ex messageText includesSubString: 'basicNew: with invalid argument']]]!

1 0

Final Reminder: Only 5 spots left for Camp Smalltalk! Raspberry PI kits to all who attend!
by Mariano Martinez Peck 05 Mar '19

05 Mar '19

Hello All, There are 5 slots left for Camp Smalltalk Charlotte 2019 taking place at the end of this month. Now is the time to sign up if you are thinking of attending (see bottom for registration link). Camp Smalltalk is about community engagement and collaboration. There are a number of fantastic talks already lined up such as: Developing Smalltalk solutions running directly on ios / android mobile platforms (along with tooling) Live demo of @1MB remote-debuggable smalltalk images controlling peripherals attached to a Raspberry PI (ARM) In-depth look at large scale use of CMake/CTest/CDash for use with Smalltalk systems Smalltalk dialect portability solutions for the Smalltalk community (for use with GIT) We also have a fantastic Saturday evening social dinner planned on the boardwalk near the hotel. *As a special gift to attendees*, Instantiations will be providing everyone with their own Raspberry PI Zero Wifi devices with 8GB mini-sd card and power supply. Raspbian Linux with VA Smalltalk for ARM will be pre-installed. And if that isn't enough, each attendee will be receiving an open-source license for VA Smalltalk. This event is happening *March 29th – March 31st 2019* in Charlotte, North Carolina. Event details and registration info are available at the following link: Camp Smalltalk Charlotte 2019 <https://www.eventbrite.com/e/camp-smalltalk-charlotte-2019-tickets-52380940…> Hope to see you there! [image: IMG_0912.jpg] -- Mariano https://twitter.com/MartinezPeck http://marianopeck.wordpress.com

1 0

Could someone please delete my FFI packages out of Trunk?
by Chris Cunningham 05 Mar '19

05 Mar '19

I was trying to move from Inbox to FFI, but missed that the target was Trunk on the website. And I'm unable to delete/move to treated. Thanks, cbc

2 1

final methods
by K K Subbu 05 Mar '19

05 Mar '19

All, How does one enforce finality of methods in Squeak? I noticed that methods like Object>>basicSize have instructions in comments not to override these, but what if these methods do get overridden/extended during compilation (perhaps by accident or oversight). Can we use a dummy primitive in these methods to mark them as final? Regards .. Subbu

5 4

The Trunk: FFI-Win32-cbc.13.mcz
by commits＠source.squeak.org 05 Mar '19

05 Mar '19

Chris Cunningham uploaded a new version of FFI-Win32 to project The Trunk: http://source.squeak.org/trunk/FFI-Win32-cbc.13.mcz ==================== Summary ==================== Name: FFI-Win32-cbc.13 Author: cbc Time: 25 October 2017, 8:25:54.022628 am UUID: 66fa70bb-22f1-5748-b805-2a201a834489 Ancestors: FFI-Win32-cbc.12 Add descriptive errors for return codes from Wind32Shell. =============== Diff against FFI-Win32-cbc.12 =============== Item was added: + ----- Method: Win32Shell>>error: (in category 'operations') ----- + error: code + Win32ShellErrors signal: code! Item was changed: ----- Method: Win32Shell>>shellExecute: (in category 'operations') ----- shellExecute: aFileString "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: nil lpDirectory: nil nShowCmd: 0. + (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! - result <= 32 ifTrue: [self error: 'system error, code:', result printString]! Item was changed: ----- Method: Win32Shell>>shellExplore: (in category 'operations') ----- shellExplore: aPathString "Explores the folder specified by aPathString" | result | result := self shellExecute: nil lpOperation: 'explore' lpFile: aPathString lpParameters: nil lpDirectory: nil nShowCmd: 1. + (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! - result <= 32 ifTrue: [self error: 'system error, code:', result printString]! Item was changed: ----- Method: Win32Shell>>shellFind: (in category 'operations') ----- shellFind: aPathString "Initiates a search starting from the specified directory." | result | result := self shellExecute: nil lpOperation: 'find' lpFile: nil lpParameters: nil lpDirectory: aPathString nShowCmd: 1. + (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! - result <= 32 ifTrue: [self error: 'system error, code:', result printString]! Item was changed: ----- Method: Win32Shell>>shellOpen: (in category 'operations') ----- shellOpen: aFileString "Opens the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: nil lpDirectory: nil nShowCmd: 1. + (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! - result <= 32 ifTrue: [self error: 'system error, code:', result printString]! Item was added: + SharedPool subclass: #Win32ShellErrors + instanceVariableNames: 'errorNumber description' + classVariableNames: 'ERROR_BAD_FORMAT ERROR_FILE_NOT_FOUND ERROR_PATH_NOT_FOUND OUT_OF_MEMORY_OR_RESOURCES SE_ERR_ACCESSDENIED SE_ERR_ACCOSINCOMPLETE SE_ERR_DDEBUSY SE_ERR_DDEFAIL SE_ERR_DDETIMEOUT SE_ERR_DDLNOTFOUND SE_ERR_FNF SE_ERR_NOASSOC SE_ERR_OOM SE_ERR_PNF SE_ERR_SHARE' + poolDictionaries: '' + category: 'FFI-Win32-Examples'! + Win32ShellErrors class + instanceVariableNames: 'errors'! + Win32ShellErrors class + instanceVariableNames: 'errors'! Item was added: + ----- Method: Win32ShellErrors class>>initialize (in category 'as yet unclassified') ----- + initialize + self initializeWindowConstants! Item was added: + ----- Method: Win32ShellErrors class>>initializeWindowConstants (in category 'as yet unclassified') ----- + initializeWindowConstants + OUT_OF_MEMORY_OR_RESOURCES := self new errorNumber: 0; description: 'The operating system is out of memory or resources'. + SE_ERR_FNF := self new errorNumber: 2; description: 'The specified file was not found'. + SE_ERR_PNF := self new errorNumber: 3; description: 'The specified path was not found'. + SE_ERR_ACCESSDENIED := self new errorNumber: 5; description: 'The operating system denied access to the specified file'. + SE_ERR_OOM := self new errorNumber: 8; description: 'There was not enough memory to complete the operation'. + ERROR_BAD_FORMAT := self new errorNumber: 11; description: 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image)'. + SE_ERR_SHARE := self new errorNumber: 26; description: 'A sharing violation occurred'. + SE_ERR_ACCOSINCOMPLETE := self new errorNumber: 27; description: 'The filename association is incomplete or invalid'. + SE_ERR_DDETIMEOUT := self new errorNumber: 28; description: 'The DDE transaction could not be completed because the request timed out'. + SE_ERR_DDEFAIL := self new errorNumber: 29; description: 'The DDE transaction failed'. + SE_ERR_DDEBUSY := self new errorNumber: 30; description: 'The DDE transaction could not be completed because other DDE transactions were being processed'. + SE_ERR_NOASSOC := self new errorNumber: 31; description: 'There is no application associated with the given filename extension'. + SE_ERR_DDLNOTFOUND := self new errorNumber: 32; description: 'The specified dynamic-link library was not found'. + errors := Dictionary new: (self allInstances size). + self allInstances do: [:err| + errors at: err errorNumber put: err + ].! Item was added: + ----- Method: Win32ShellErrors class>>signal: (in category 'as yet unclassified') ----- + signal: code + | err | + err := errors at: code ifAbsent: [Error signal: 'system error, code:', code]. + Error signal: err errorString! Item was added: + ----- Method: Win32ShellErrors>>description (in category 'accessing') ----- + description + + ^ description + ! Item was added: + ----- Method: Win32ShellErrors>>description: (in category 'accessing') ----- + description: anObject + + description := anObject. + ! Item was added: + ----- Method: Win32ShellErrors>>errorNumber (in category 'accessing') ----- + errorNumber + + ^ errorNumber + ! Item was added: + ----- Method: Win32ShellErrors>>errorNumber: (in category 'accessing') ----- + errorNumber: anObject + + errorNumber := anObject. + ! Item was added: + ----- Method: Win32ShellErrors>>errorString (in category 'accessing') ----- + errorString + ^'system error, code: ', errorNumber, ' "', description, '"'!

1 0

The Trunk: FFI-Win32-cbc.12.mcz
by commits＠source.squeak.org 05 Mar '19

05 Mar '19

Chris Cunningham uploaded a new version of FFI-Win32 to project The Trunk: http://source.squeak.org/trunk/FFI-Win32-cbc.12.mcz ==================== Summary ==================== Name: FFI-Win32-cbc.12 Author: cbc Time: 28 March 2017, 5:09:55.317402 pm UUID: 8f7957c1-d4e4-c942-a7c1-0763a354d89d Ancestors: FFI-Win32-tbn.11 Added ability to silently run a program in the background (no window) ==================== Snapshot ==================== SystemOrganization addCategory: #'FFI-Win32-Examples'! ExternalStructure subclass: #Win32Handle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! Win32Handle subclass: #Win32HDC instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32HDC>>apiDeleteDC: (in category 'api calls') ----- apiDeleteDC: aHDC <apicall: bool 'DeleteDC' (Win32HDC) module:'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HDC>>apiDrawFocusRect:with: (in category 'api calls') ----- apiDrawFocusRect: aHDC with: lpRect "Draws a rectangle in the style used to indicate that the rectangle has the focus." <apicall: bool 'DrawFocusRect' (Win32HDC Win32Rectangle*) module: 'user32.dll'> ^ self externalCallFailed! ----- Method: Win32HDC>>apiDrawFrameControl:with:with:with: (in category 'api calls') ----- apiDrawFrameControl: aHDC with: lpRect with: type with: state "Draws a frame control of the specified type and style" <apicall: bool 'DrawFrameControl' (Win32HDC Win32Rectangle* ulong ulong) module: 'user32.dll'> ^ self externalCallFailed! ----- Method: Win32HDC>>apiEllipse:with:with:with:with: (in category 'api calls') ----- apiEllipse: aHDC with: left with: top with: right with: bottom <apicall: bool 'Ellipse' (Win32HDC long long long long) module: 'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HDC>>apiExtFloodFill:with:with:with:with: (in category 'api calls') ----- apiExtFloodFill: aHDC with: x with: y with: colorref with: fillType "fills an area of the display surface with the current brush" <apicall: bool 'ExtFloodFill' (Win32HDC long long ulong ulong) module: 'gdi32.dll'> ^ self externalCallFailed! ----- Method: Win32HDC>>apiFillRect:with:with: (in category 'api calls') ----- apiFillRect: aHDC with: lpRect with: brush "Fills a rectangle by using the specified brush. This function includes the left and top borders, but excludes the right and bottom borders of the rectangle. " <apicall: char 'FillRect' (Win32HDC Win32Rectangle* Win32HBrush) module: 'user32.dll'> ^ self externalCallFailed! ----- Method: Win32HDC>>apiFrameRect:with:with: (in category 'api calls') ----- apiFrameRect: aHDC with: lpRect with: brush "Draws a border around the specified rectangle by using the specified brush. The width and height of the border are always one logical unit." <apicall: char 'FrameRect' (Win32HDC Win32Rectangle* Win32HBrush) module: 'user32.dll'> ^ self externalCallFailed! ----- Method: Win32HDC>>apiLineTo:with:with: (in category 'api calls') ----- apiLineTo: aHDC with: x with: y <apicall: bool 'LineTo' (Win32HDC long long) module:'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HDC>>apiMoveToEx:with:with:with: (in category 'api calls') ----- apiMoveToEx: aHDC with: x with: y with: pt <apicall: bool 'MoveToEx' (Win32HDC long long Win32Point*) module: 'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HDC>>apiRectangle:with:with:with:with: (in category 'api calls') ----- apiRectangle: aHDC with: left with: top with: right with: bottom <apicall: bool 'Rectangle' (Win32HDC long long long long) module: 'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HDC>>apiRoundRect:with:with:with:with:with:with: (in category 'api calls') ----- apiRoundRect: aHDC with: left with: top with: right with: bottom with: width with: height "Draws a rectangle with rounded corners. The rectangle is outlined by using the current pen and filled by using the current brush" <apicall: bool 'RoundRect' (Win32HDC long long long long long long) module: 'gdi32.dll'> ^ self externalCallFailed! ----- Method: Win32HDC>>apiSelectObject:with: (in category 'api calls') ----- apiSelectObject: aHDC with: aHGDIOBJ <apicall: Win32HGDIObj 'SelectObject' (Win32HDC Win32HGDIObj) module: 'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HDC>>delete (in category 'initialize-release') ----- delete handle == nil ifFalse:[self apiDeleteDC: self]. handle := nil.! ----- Method: Win32HDC>>drawFocusRectangle: (in category 'drawing') ----- drawFocusRectangle: aRect "draws a rectangle in the style used to indicate that the rectangle has the focus" self apiDrawFocusRect: self with: (Win32Rectangle fromRectangle: aRect) ! ----- Method: Win32HDC>>drawFrameControl:type:style: (in category 'drawing') ----- drawFrameControl: aRect type: aType style: aStyle "Draws a frame control of the specified type and style (integer values)" self apiDrawFrameControl: self with: (Win32Rectangle fromRectangle: aRect) with: aType with: aStyle! ----- Method: Win32HDC>>ellipse: (in category 'drawing') ----- ellipse: aRect ^self apiEllipse: self with: aRect left with: aRect top with: aRect right with: aRect bottom! ----- Method: Win32HDC>>fillRectangle:color: (in category 'drawing') ----- fillRectangle: aRect color: aColor "fills an area of the display with the given color" | brush | brush := Win32HBrush createSolidBrush: aColor asColorref. self apiFillRect: self with: (Win32Rectangle fromRectangle: aRect) with: brush. brush delete! ----- Method: Win32HDC>>floodFillAt:boundaryColor:fillColor: (in category 'drawing') ----- floodFillAt: aPoint boundaryColor: aColor fillColor: anotherColor "fills an area of the display with the given color" | newBrush oldBrush | newBrush := Win32HBrush createSolidBrush: anotherColor asColorref. oldBrush := self selectObject: newBrush. (self apiExtFloodFill: self with: aPoint x with: aPoint y with: aColor asColorref with: 0) inspect. self selectObject: oldBrush. newBrush delete! ----- Method: Win32HDC>>frameRectangle:brush: (in category 'drawing') ----- frameRectangle: aRect brush: aBrush "Draws a border around the specified rectangle by using the specified brush. The width and height of the border are always one logical unit." self apiFrameRect: self with: (Win32Rectangle fromRectangle: aRect) with: aBrush. ! ----- Method: Win32HDC>>lineTo: (in category 'drawing') ----- lineTo: aPoint ^self apiLineTo: self with: aPoint x with: aPoint y! ----- Method: Win32HDC>>moveTo: (in category 'drawing') ----- moveTo: aPoint ^self apiMoveToEx: self with: aPoint x with: aPoint y with: nil! ----- Method: Win32HDC>>rectangle: (in category 'drawing') ----- rectangle: aRect ^self apiRectangle: self with: aRect left with: aRect top with: aRect right with: aRect bottom! ----- Method: Win32HDC>>roundRectangle:width:height: (in category 'drawing') ----- roundRectangle: aRect width: width height: height ^ self apiRoundRect: self with: aRect left with: aRect top with: aRect right with: aRect bottom with: width with: height! ----- Method: Win32HDC>>selectObject: (in category 'drawing') ----- selectObject: aHGDIOBJ ^self apiSelectObject: self with: aHGDIOBJ! Win32Handle subclass: #Win32HGDIObj instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! Win32HGDIObj subclass: #Win32HBrush instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32HBrush class>>apiCreateHatchBrush:with: (in category 'api calls') ----- apiCreateHatchBrush: aStyle with: colorref "Creates a logical brush that has the specified hatch pattern and color" <apicall: Win32HBrush 'CreateHatchBrush' (long ulong) module: 'gdi32.dll'> ^ self externalCallFailed! ----- Method: Win32HBrush class>>backwardDiagonalWithColor: (in category 'hatch brushes') ----- backwardDiagonalWithColor: aColor "45-degree downward left-to-right hatch brush" ^ self createHatchBrush: 3 color: aColor! ----- Method: Win32HBrush class>>createHatchBrush:color: (in category 'instance creation') ----- createHatchBrush: aStyle color: aColor "Creates an instance of the receiver that has the specified hatch pattern and color" ^ self apiCreateHatchBrush: aStyle with: aColor asColorref! ----- Method: Win32HBrush class>>createSolidBrush: (in category 'instance creation') ----- createSolidBrush: aCOLORREF <apicall: Win32HBrush 'CreateSolidBrush' (ulong) module: 'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HBrush class>>crossWithColor: (in category 'hatch brushes') ----- crossWithColor: aColor "Horizontal and vertical crosshatch brush" ^ self createHatchBrush: 4 color: aColor! ----- Method: Win32HBrush class>>diagonalCrossWithColor: (in category 'hatch brushes') ----- diagonalCrossWithColor: aColor "45-degree crosshatch brush" ^ self createHatchBrush: 5 color: aColor! ----- Method: Win32HBrush class>>forwardDiagonalWithColor: (in category 'hatch brushes') ----- forwardDiagonalWithColor: aColor "45-degree upward left-to-right hatch brush" ^ self createHatchBrush: 2 color: aColor! ----- Method: Win32HBrush class>>horizontalWithColor: (in category 'hatch brushes') ----- horizontalWithColor: aColor "Horizontal hatch brush" ^ self createHatchBrush: 0 color: aColor! ----- Method: Win32HBrush class>>verticalWithColor: (in category 'hatch brushes') ----- verticalWithColor: aColor "Horizontal hatch brush" ^ self createHatchBrush: 1 color: aColor ! ----- Method: Win32HGDIObj>>apiDeleteObject: (in category 'api calls') ----- apiDeleteObject: aHGDIOBJ <apicall: bool 'DeleteObject' (Win32HGDIObj) module: 'gdi32.dll'> ^self externalCallFailed! ----- Method: Win32HGDIObj>>delete (in category 'initialize-release') ----- delete self apiDeleteObject: self! ----- Method: Win32Handle class>>fields (in category 'accessing') ----- fields "Win32Handle defineFields" "The following really means typedef void* Win32Handle; " ^#(nil 'ulong') "an opaque 32bit handle"! ExternalStructure subclass: #Win32Point instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32Point class>>apiGetCursorPos: (in category 'api calls') ----- apiGetCursorPos: pt <apicall: bool 'GetCursorPos' (Win32Point*) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Point class>>fields (in category 'accessing') ----- fields "POINT defineFields" ^#( (x 'long') (y 'long') )! ----- Method: Win32Point class>>getCursorPos (in category 'instance creation') ----- getCursorPos | pt | pt := self new. self apiGetCursorPos: pt. ^pt! ----- Method: Win32Point>>asPoint (in category 'converting') ----- asPoint ^self x @ self y! ----- Method: Win32Point>>x (in category 'accessing') ----- x "This method was automatically generated" ^handle signedLongAt: 1! ----- Method: Win32Point>>x: (in category 'accessing') ----- x: anObject "This method was automatically generated" handle signedLongAt: 1 put: anObject! ----- Method: Win32Point>>y (in category 'accessing') ----- y "This method was automatically generated" ^handle signedLongAt: 5! ----- Method: Win32Point>>y: (in category 'accessing') ----- y: anObject "This method was automatically generated" handle signedLongAt: 5 put: anObject! ExternalStructure subclass: #Win32Rectangle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32Rectangle class>>fields (in category 'accessing') ----- fields "Win32Rectangle defineFields" ^ #(#(#left 'long') #(#top 'long') #(#right 'long') #(#bottom 'long') )! ----- Method: Win32Rectangle class>>fromRectangle: (in category 'instance creation') ----- fromRectangle: rc "returns an instance of the receiver from the given smalltalk rectangle" ^ self new left: rc left top: rc top right: rc right bottom: rc bottom ! ----- Method: Win32Rectangle>>bottom (in category 'accessing') ----- bottom "This method was automatically generated" ^handle signedLongAt: 13! ----- Method: Win32Rectangle>>bottom: (in category 'accessing') ----- bottom: anObject "This method was automatically generated" handle signedLongAt: 13 put: anObject! ----- Method: Win32Rectangle>>left (in category 'accessing') ----- left "This method was automatically generated" ^handle signedLongAt: 1! ----- Method: Win32Rectangle>>left: (in category 'accessing') ----- left: anObject "This method was automatically generated" handle signedLongAt: 1 put: anObject! ----- Method: Win32Rectangle>>left:top:right:bottom: (in category 'accessing') ----- left: left top: top right: right bottom: bottom "sets the coordinates of the receiver" self left: left. self top: top. self right: right. self bottom: bottom ! ----- Method: Win32Rectangle>>right (in category 'accessing') ----- right "This method was automatically generated" ^handle signedLongAt: 9! ----- Method: Win32Rectangle>>right: (in category 'accessing') ----- right: anObject "This method was automatically generated" handle signedLongAt: 9 put: anObject! ----- Method: Win32Rectangle>>top (in category 'accessing') ----- top "This method was automatically generated" ^handle signedLongAt: 5! ----- Method: Win32Rectangle>>top: (in category 'accessing') ----- top: anObject "This method was automatically generated" handle signedLongAt: 5 put: anObject! Object subclass: #Win32Error instanceVariableNames: 'errorCode' classVariableNames: 'ErrorCodes' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32Error class>>initialize (in category 'as yet unclassified') ----- initialize "Win32Error initialize" ErrorCodes := Dictionary new. ErrorCodes at: 203 put: #('ERROR_ENVVAR_NOT_FOUND' 'There was no environment variable with that name'); yourself! ----- Method: Win32Error class>>lastError (in category 'as yet unclassified') ----- lastError ^(self new) initializeWithLastError! ----- Method: Win32Error class>>win32GetLastError (in category 'as yet unclassified') ----- win32GetLastError "DWORD WINAPI GetLastError(void);" <apicall: ulong 'GetLastError' () module:'kernel32.dll'> ^nil! ----- Method: Win32Error>>errorCode (in category 'as yet unclassified') ----- errorCode ^errorCode! ----- Method: Win32Error>>errorMessage (in category 'as yet unclassified') ----- errorMessage ^(ErrorCodes at: errorCode) at: 2 ifAbsent: ['Unknown Error: ' , errorCode]! ----- Method: Win32Error>>errorName (in category 'as yet unclassified') ----- errorName ^(ErrorCodes at: errorCode) at: 1 ifAbsent: ['ERROR_UNKNOWN_' , errorCode ]! ----- Method: Win32Error>>initializeWithLastError (in category 'as yet unclassified') ----- initializeWithLastError errorCode := self class win32GetLastError.! Object subclass: #Win32Utils instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! !Win32Utils commentStamp: 'tbn 8/22/2005 23:50' prior: 0! This is an utility class with helpfull methods for Win32 users. Note that it uses FFI and is platform dependent.! ----- Method: Win32Utils class>>apiFreeEnvironmentStrings: (in category 'api calls') ----- apiFreeEnvironmentStrings: extData "Win32Utils apiFreeEnvironmentStrings" <apicall: long 'FreeEnvironmentStrings' (void*) module: 'kernel32.dll'> ^self externalCallFailed! ----- Method: Win32Utils class>>apiGetEnvironmentStrings (in category 'api calls') ----- apiGetEnvironmentStrings "Win32Utils apiGetEnvironmentStrings" <apicall: byte* 'GetEnvironmentStrings' () module: 'kernel32.dll'> ^self externalCallFailed! ----- Method: Win32Utils class>>apiGetEnvironmentVariable:buffer:size: (in category 'api calls') ----- apiGetEnvironmentVariable: name buffer: buffer size: bufferSize "DWORD WINAPI GetEnvironmentVariable( __in_opt LPCTSTR lpName, __out_opt LPTSTR lpBuffer, __in DWORD nSize );" "http://msdn.microsoft.com/en-us/library/ms683188(VS.85).aspx" <apicall: ulong 'GetEnvironmentVariableA' ( char* byte* ulong) module: 'kernel32.dll'> ^self externalCallFailed! ----- Method: Win32Utils class>>apiSetCursorPosX:y: (in category 'api calls') ----- apiSetCursorPosX: x y: y "this is apparently how to control the mouse cursor pragmatically on windows: http://lists.squeakfoundation.org/pipermail/squeak-dev/2011-February/157676… " <apicall: bool 'SetCursorPos' (long long) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Utils class>>getCommonEnvironmentVariables (in category 'examples') ----- getCommonEnvironmentVariables "Returns a dictionary with common environment variables for Win32 systems" |map| map := Dictionary new. #('ALLUSERSPROFILE' 'APPDATA' 'COMPUTERNAME' 'COMSPEC' 'HOMEDRIVE' 'HOMEPATH' 'LOGONSERVER' 'SYSTEMDRIVE' 'OS' 'PATH' 'SYSTEMROOT' 'TEMP' 'TMP' 'USERDOMAIN' 'USERNAME' 'USERPROFILE' 'WINDIR') do: [:each | map at: each put: (self getEnvironmentVariable: each)]. ^map ! ----- Method: Win32Utils class>>getEnvironmentVariable: (in category 'accessing') ----- getEnvironmentVariable: aString "Win32Utils getEnvironmentVariable: 'windir'" ^ self getEnvironmentVariable: aString ifAbsent: [nil]! ----- Method: Win32Utils class>>getEnvironmentVariable:buffer:ifAbsent: (in category 'accessing') ----- getEnvironmentVariable: name buffer: buffer ifAbsent: block "Win32Utils getEnvironmentVariable: 'APPDATA' " "Win32Utils getEnvironmentVariable: 'APPDATAx' " "http://msdn.microsoft.com/en-us/library/ms683188(VS.85).aspx " | retval err | retval := self apiGetEnvironmentVariable: name buffer: buffer size: buffer byteSize. retval = 0 ifTrue: [ err := Win32Error lastError. ^(err errorName = 'ERROR_ENVVAR_NOT_FOUND') ifTrue: [block value] ifFalse: [ self error: 'Problem with retrieving env var ' , name , '. Code is ' , err errorName. nil ] ]. ^(retval < buffer byteSize) ifTrue: [( buffer copyFrom: 1 to: retval ) asString] ifFalse: [ self getEnvironmentVariable: name buffer: (ByteArray new: retval) ifAbsent: block ]. ! ----- Method: Win32Utils class>>getEnvironmentVariable:ifAbsent: (in category 'accessing') ----- getEnvironmentVariable: name ifAbsent: block "Win32Utils getEnvironmentVariable: 'APPDATA' ifAbsent: [nil]" "Win32Utils getEnvironmentVariable: 'APPDATAx' ifAbsent: [5]" ^self getEnvironmentVariable: name buffer: (ByteArray new: 256) ifAbsent: block! ----- Method: Win32Utils class>>getEnvironmentVariables (in category 'accessing') ----- getEnvironmentVariables "Win32Utils getEnvironmentVariables" | externalData strs | externalData := self apiGetEnvironmentStrings. strs := externalData fromCStrings. self apiFreeEnvironmentStrings: externalData. ^strs ! SharedPool subclass: #Win32Constants instanceVariableNames: '' classVariableNames: 'COLOR_ACTIVEBORDER COLOR_ACTIVECAPTION COLOR_APPWORKSPACE COLOR_BACKGROUND COLOR_BTNFACE COLOR_BTNHIGHLIGHT COLOR_BTNSHADOW COLOR_BTNTEXT COLOR_CAPTIONTEXT COLOR_GRAYTEXT COLOR_HIGHLIGHT COLOR_HIGHLIGHTTEXT COLOR_INACTIVEBORDER COLOR_INACTIVECAPTION COLOR_INACTIVECAPTIONTEXT COLOR_MENU COLOR_MENUTEXT COLOR_SCROLLBAR COLOR_WINDOW COLOR_WINDOWFRAME COLOR_WINDOWTEXT CS_BYTEALIGNCLIENT CS_BYTEALIGNWINDOW CS_CLASSDC CS_DBLCLKS CS_HREDRAW CS_NOCLOSE CS_OWNDC CS_PARENTDC CS_SAVEBITS CS_VREDRAW CW_USEDEFAULT GWL_STYLE HWND_BROADCAST WM_DESTROY WM_MOVE WS_BORDER WS_CAPTION WS_CHILD WS_CHILDWINDOW WS_CLIPCHILDREN WS_CLIPSIBLINGS WS_DISABLED WS_DLGFRAME WS_EX_ACCEPTFILES WS_EX_APPWINDOW WS_EX_CLIENTEDGE WS_EX_CONTEXTHELP WS_EX_CONTROLPARENT WS_EX_DLGMODALFRAME WS_EX_LEFT WS_EX_LEFTSCROLLBAR WS_EX_LTRREADING WS_EX_MDICHILD WS_EX_NOACTIVATE WS_EX_NOPARENTNOTIFY WS_EX_OVERLAPPEDWINDOW WS_EX_PALETTEWINDOW WS_EX_RIGHT WS_EX_RIGHTSCROLLBAR WS_EX_RTLREADING WS_EX_STATICEDGE WS_EX _TOOLWINDOW WS_EX_TOPMOST WS_EX_TRANSPARENT WS_EX_WINDOWEDGE WS_GROUP WS_HSCROLL WS_ICONIC WS_MAXIMIZE WS_MAXIMIZEBOX WS_MINIMIZE WS_MINIMIZEBOX WS_OVERLAPPED WS_OVERLAPPEDWINDOW WS_POPUP WS_POPUPWINDOW WS_SIZEBOX WS_SYSMENU WS_TABSTOP WS_THICKFRAME WS_TILED WS_TILEDWINDOW WS_VISIBLE WS_VSCROLL' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32Constants class>>initialize (in category 'pool initialization') ----- initialize "Win32Constants initialize" self initializeWindowConstants.! ----- Method: Win32Constants class>>initializeWindowConstants (in category 'pool initialization') ----- initializeWindowConstants GWL_STYLE := -16. WS_EX_ACCEPTFILES := 16r10. WS_EX_APPWINDOW := 16r40000. WS_EX_CLIENTEDGE := 16r200. WS_EX_CONTEXTHELP := 16r400. WS_EX_CONTROLPARENT := 16r10000. WS_EX_DLGMODALFRAME := 16r1. WS_EX_LEFT := 16r0. WS_EX_LEFTSCROLLBAR := 16r4000. WS_EX_LTRREADING := 16r0. WS_EX_MDICHILD := 16r40. WS_EX_NOACTIVATE := 16r8000000. WS_EX_NOPARENTNOTIFY := 16r4. WS_EX_OVERLAPPEDWINDOW := 16r300. WS_EX_PALETTEWINDOW := 16r188. WS_EX_RIGHT := 16r1000. WS_EX_RIGHTSCROLLBAR := 16r0. WS_EX_RTLREADING := 16r2000. WS_EX_STATICEDGE := 16r20000. WS_EX_TOOLWINDOW := 16r80. WS_EX_TOPMOST := 16r8. WS_EX_TRANSPARENT := 16r20. WS_EX_WINDOWEDGE := 16r100. WS_BORDER := 16r800000. WS_CAPTION := 16rC00000. WS_CHILD := 16r40000000. WS_CHILDWINDOW := 16r40000000. WS_CLIPCHILDREN := 16r2000000. WS_CLIPSIBLINGS := 16r4000000. WS_DISABLED := 16r8000000. WS_DLGFRAME := 16r400000. WS_GROUP := 16r20000. WS_HSCROLL := 16r100000. WS_ICONIC := 16r20000000. WS_MAXIMIZE := 16r1000000. WS_MAXIMIZEBOX := 16r10000. WS_MINIMIZE := 16r20000000. WS_MINIMIZEBOX := 16r20000. WS_OVERLAPPED := 16r0. WS_OVERLAPPEDWINDOW := 16rCF0000. WS_POPUP := 16r80000000. WS_POPUPWINDOW := 16r80880000. WS_SIZEBOX := 16r40000. WS_SYSMENU := 16r80000. WS_TABSTOP := 16r10000. WS_THICKFRAME := 16r40000. WS_TILED := 16r0. WS_TILEDWINDOW := 16rCF0000. WS_VISIBLE := 16r10000000. WS_VSCROLL := 16r200000. CS_BYTEALIGNCLIENT := 16r1000. CS_BYTEALIGNWINDOW := 16r2000. CS_CLASSDC := 16r40. CS_DBLCLKS := 16r8. CS_HREDRAW := 16r2. CS_NOCLOSE := 16r200. CS_OWNDC := 16r20. CS_PARENTDC := 16r80. CS_SAVEBITS := 16r800. CS_VREDRAW := 16r1. COLOR_ACTIVEBORDER := 10. COLOR_ACTIVECAPTION := 2. COLOR_APPWORKSPACE := 12. COLOR_BACKGROUND := 1. COLOR_BTNFACE := 15. COLOR_BTNHIGHLIGHT := 20. COLOR_BTNSHADOW := 16. COLOR_BTNTEXT := 18. COLOR_CAPTIONTEXT := 9. COLOR_GRAYTEXT := 17. COLOR_HIGHLIGHT := 13. COLOR_HIGHLIGHTTEXT := 14. COLOR_INACTIVEBORDER := 11. COLOR_INACTIVECAPTION := 3. COLOR_INACTIVECAPTIONTEXT := 19. COLOR_MENU := 4. COLOR_MENUTEXT := 7. COLOR_SCROLLBAR := 0. COLOR_WINDOW := 5. COLOR_WINDOWFRAME := 6. COLOR_WINDOWTEXT := 8. CW_USEDEFAULT := 16r80000000. HWND_BROADCAST := 16rFFFF. WM_DESTROY := 16r2. WM_MOVE := 16r3! Win32Handle subclass: #Win32Window instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'Win32Constants' category: 'FFI-Win32-Examples'! !Win32Window commentStamp: '<historical>' prior: 0! Here's a simple Win32 example: | hwnd dc dst | hwnd _ Win32Window getFocus. "fetch the window currently having the focus" dc _ hwnd getDC. "grab the dc or the window" dst _ 100. dc moveTo: 0@0. "draw a rect" dc lineTo: dst@0. dc lineTo: dst@dst. dc lineTo: 0@dst. dc lineTo: 0@0. "and a cross" dc lineTo: dst@dst. dc moveTo: dst@0. dc lineTo: 0@dst. hwnd releaseDC: dc.! ----- Method: Win32Window class>>coloredEllipses (in category 'examples') ----- coloredEllipses "Win32Window coloredEllipses" "Draw a bunch of ellipses" | rnd pt1 pt2 w h colors newBrush oldBrush | colors := Color colorNames collect:[:cName| (Color perform: cName)]. "convert to COLORREF" colors := colors collect:[:c| (c red * 255) asInteger + ((c green * 255) asInteger << 8) + ((c blue * 255) asInteger << 16)]. rnd := Random new. w := Display width. h := Display height. self getFocus getHDCDuring:[:hDC| [Sensor anyButtonPressed] whileFalse:[ newBrush := Win32HBrush createSolidBrush: colors atRandom. oldBrush := hDC selectObject: newBrush. pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. hDC ellipse: (Rectangle encompassing: (Array with: pt1 with: pt2)). hDC selectObject: oldBrush. newBrush delete. ]. ]. Display forceToScreen.! ----- Method: Win32Window class>>coloredRectangles (in category 'examples') ----- coloredRectangles "Win32Window coloredRectangles" "Draw a bunch of ellipses" | rnd pt1 pt2 w h colors newBrush oldBrush n nPixels time r | colors := Color colorNames collect:[:cName| (Color perform: cName)]. "convert to COLORREF" colors := colors collect:[:c| (c red * 255) asInteger + ((c green * 255) asInteger << 8) + ((c blue * 255) asInteger << 16)]. rnd := Random new. w := Display width. h := Display height. self getFocus getHDCDuring:[:hDC| n := 0. nPixels := 0. time := Time millisecondClockValue. [Sensor anyButtonPressed] whileFalse:[ newBrush := Win32HBrush createSolidBrush: colors atRandom. oldBrush := hDC selectObject: newBrush. pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. hDC rectangle: (r := Rectangle encompassing: (Array with: pt1 with: pt2)). hDC selectObject: oldBrush. newBrush delete. n := n + 1. nPixels := nPixels + ((r right - r left) * (r bottom - r top)). (n \\ 100) = 0 ifTrue:[ 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) asStringWithCommas displayAt: 0@0]. ]. ]. Display forceToScreen.! ----- Method: Win32Window class>>getDesktopWindow (in category 'accessing') ----- getDesktopWindow "Return the HWND describing the desktop" <apicall: Win32Window 'GetDesktopWindow' (void) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window class>>getFocus (in category 'accessing') ----- getFocus "Return the HWND currently having the input focus" <apicall: Win32Window 'GetFocus' (void) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window class>>getMainWindowText: (in category 'examples') ----- getMainWindowText: aString "Returns the window text of the main window" self new getWindowText: Win32Window getFocus ! ----- Method: Win32Window class>>getWindowLong:index: (in category 'private') ----- getWindowLong: hwnd index: index "Retrieves information about the specified window." <apicall: Win32Window 'GetWindowLongA' (long long) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window class>>getWindowStyle (in category 'private') ----- getWindowStyle "Returns the window style for the focus window" ^self getWindowLong: self getFocus index: GWL_STYLE ! ----- Method: Win32Window class>>setMainWindowText: (in category 'examples') ----- setMainWindowText: aString "Sets the window text of the main window" self new apiSetWindowText: Win32Window getFocus text: aString! ----- Method: Win32Window class>>setNonResizable (in category 'private') ----- setNonResizable " self setNonResizable " | newStyle | newStyle := self getWindowStyle bitClear: ((WS_SIZEBOX bitOr: WS_MINIMIZE) bitOr: WS_MAXIMIZE). self setWindowLong: self getFocus index: GWL_STYLE value: newStyle. ! ----- Method: Win32Window class>>setWindowLong:index:value: (in category 'private') ----- setWindowLong: hwnd index: index value: value "Sets information about the specified window." <apicall: Win32Window 'SetWindowLongA' (long long long) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window class>>win32Draw (in category 'examples') ----- win32Draw "Win32Window win32Draw" "Draw a bunch of lines using the Windows API" | hWnd hDC pt | hWnd := Win32Window getFocus. hDC := hWnd getDC. hDC moveTo: (hWnd screenToClient: Win32Point getCursorPos). [Sensor anyButtonPressed] whileFalse:[ pt := Win32Point getCursorPos. hWnd screenToClient: pt. hDC lineTo: pt. ]. hWnd releaseDC: hDC. Display forceToScreen.! ----- Method: Win32Window>>apiGetDC: (in category 'api calls') ----- apiGetDC: aHWND <apicall: Win32HDC 'GetDC' (Win32Window) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window>>apiGetParent: (in category 'api calls') ----- apiGetParent: aWindow <apicall: Win32Window 'GetParent' (Win32Window) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window>>apiGetWindowText:buffer:maxCount: (in category 'api calls') ----- apiGetWindowText: handleWindow buffer: aBuffer maxCount: aNumber <apicall: ulong 'GetWindowTextA' (Win32Window char* long) module: 'user32.dll'> self externalCallFailed! ----- Method: Win32Window>>apiMessageBox:text:title:flags: (in category 'api calls') ----- apiMessageBox: aHWND text: aString title: aTitle flags: flags <apicall: long 'MessageBoxA' (Win32Window char* char* ulong) module:'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window>>apiReleaseDC:with: (in category 'api calls') ----- apiReleaseDC: aHWND with: aHDC <apicall: long 'ReleaseDC' (Win32Window Win32HDC) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window>>apiScreenToClient:with: (in category 'api calls') ----- apiScreenToClient: aHWND with: aPOINT <apicall: bool 'ScreenToClient' (Win32Window Win32Point*) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window>>apiSetWindowPosition:insertAfter:x:y:cx:cy:flags: (in category 'api calls') ----- apiSetWindowPosition: handleWindow insertAfter: handleAfterWindow x: x y: y cx: cx cy: cy flags: flags <apicall: bool 'SetWindowPos' (Win32Window Win32Window ulong ulong ulong ulong ulong) module: 'user32.dll'> ^self primitiveFailed ! ----- Method: Win32Window>>apiSetWindowText:text: (in category 'api calls') ----- apiSetWindowText: handleWindow text: aString <apicall: long 'SetWindowTextA' (Win32Window char*) module: 'user32.dll'> ^self externalCallFailed! ----- Method: Win32Window>>getDC (in category 'accessing') ----- getDC "Return the DC associated with the window" ^self apiGetDC: self! ----- Method: Win32Window>>getHDCDuring: (in category 'accessing') ----- getHDCDuring: aBlock "Provide a Win32 HDC during the execution of aBlock" | hDC | hDC := self getDC. [aBlock value: hDC] ensure:[self releaseDC: hDC].! ----- Method: Win32Window>>getParent (in category 'accessing') ----- getParent | wnd | wnd := self apiGetParent: self. ^wnd handle = 0 ifTrue:[nil] ifFalse:[wnd]! ----- Method: Win32Window>>getWindowText: (in category 'api calls') ----- getWindowText: handleWindow "self new getWindowText: Win32Window getFocus" |buffer maxSize | maxSize := 255. buffer := ByteArray new: maxSize. self apiGetWindowText: handleWindow buffer: buffer maxCount: maxSize. ^buffer asString ! ----- Method: Win32Window>>messageBox: (in category 'accessing') ----- messageBox: aString "Win32Window getFocus messageBox:'Hello World'" ^self messageBox: aString title: 'Squeak'! ----- Method: Win32Window>>messageBox:title: (in category 'accessing') ----- messageBox: aString title: aTitle "Win32Window getFocus messageBox:'Hello World' title:'News from Squeak:'" ^self messageBox: aString title: aTitle flags: 0! ----- Method: Win32Window>>messageBox:title:flags: (in category 'accessing') ----- messageBox: aString title: aTitle flags: flags "Win32Window getFocus messageBox:'Are you ready???' title:'News from Squeak:' flags: 3" ^self apiMessageBox: self text: aString title: aTitle flags: flags! ----- Method: Win32Window>>releaseDC: (in category 'accessing') ----- releaseDC: aHDC "Release the given DC" self apiReleaseDC: self with: aHDC! ----- Method: Win32Window>>screenToClient: (in category 'accessing') ----- screenToClient: aPoint self apiScreenToClient: self with: aPoint. ^aPoint! ExternalObject subclass: #Win32File instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! ----- Method: Win32File class>>setReadOnly: (in category 'operations') ----- setReadOnly: fileString "Convenient shorthand." ^ (self new) setReadOnly: fileString! ----- Method: Win32File class>>setReadWrite: (in category 'operations') ----- setReadWrite: fileString "Convenient shorthand" ^ (self new) setReadWrite: fileString! ----- Method: Win32File>>getFileAttributes: (in category 'api calls') ----- getFileAttributes: fileString <apicall: ulong 'GetFileAttributesA' (char*) module: 'Kernel32.dll'> ^ self externalCallFailed! ----- Method: Win32File>>setFileAttributes:lpAttrs: (in category 'api calls') ----- setFileAttributes: fileString lpAttrs: aLong <apicall: ulong 'SetFileAttributesA' (char* ulong) module: 'Kernel32.dll'> ^ self externalCallFailed! ----- Method: Win32File>>setReadOnly: (in category 'operations') ----- setReadOnly: fileString "Set FILE_READ_ONLY (bit 1)" | attrs | attrs := (self getFileAttributes: fileString). attrs < 0 ifTrue: [ self error: 'Cannot get file attributes. System error.' ]. (self setFileAttributes: fileString lpAttrs: (attrs bitOr: 1)) = 0 ifTrue: [ self error: 'Cannot set file attributes. System error.' ].! ----- Method: Win32File>>setReadWrite: (in category 'operations') ----- setReadWrite: fileString "Clear FILE_READ_ONLY (bit 1)" | attrs | attrs := (self getFileAttributes: fileString). attrs < 0 ifTrue: [ self error: 'Cannot get file attributes. System error.' ]. (self setFileAttributes: fileString lpAttrs: (attrs bitClear: 1)) = 0 ifTrue: [ self error: 'Cannot set file attributes. System error.' ].! ExternalObject subclass: #Win32Shell instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Win32-Examples'! !Win32Shell commentStamp: '<historical>' prior: 0! This class wrappes the Windows 32 shell. Try Win32Shell new shellOpen: 'c:\image.bmp' to open a document Win32Shell new shellOpen: 'c:\myprogram.exe' to start an executable Win32Shell new shellExplore: 'c:\' to explore a directory Win32Shell new shellFind: 'c:\' to initiate a search Note that this class is platform specific. ! ----- Method: Win32Shell>>shellExecute: (in category 'operations') ----- shellExecute: aFileString "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: nil lpDirectory: nil nShowCmd: 0. result <= 32 ifTrue: [self error: 'system error, code:', result printString]! ----- Method: Win32Shell>>shellExecute:lpOperation:lpFile:lpParameters:lpDirectory:nShowCmd: (in category 'api calls') ----- shellExecute: hwnd lpOperation: opString lpFile: fileString lpParameters: parmString lpDirectory: dirString nShowCmd: anInteger "Opens or prints the specified file, which can be an executable or document file. HINSTANCE ShellExecute( HWND hwnd, // handle to parent window LPCTSTR lpOperation, // pointer to string that specifies operation to perform LPCTSTR lpFile, // pointer to filename or folder name string LPCTSTR lpParameters, // pointer to string that specifies executable-file parameters LPCTSTR lpDirectory, // pointer to string that specifies default directory INT nShowCmd // whether file is shown when opened );" <apicall: long 'ShellExecuteA' (long char* char* char* char* ulong) module:'shell32.dll'>! ----- Method: Win32Shell>>shellExplore: (in category 'operations') ----- shellExplore: aPathString "Explores the folder specified by aPathString" | result | result := self shellExecute: nil lpOperation: 'explore' lpFile: aPathString lpParameters: nil lpDirectory: nil nShowCmd: 1. result <= 32 ifTrue: [self error: 'system error, code:', result printString]! ----- Method: Win32Shell>>shellFind: (in category 'operations') ----- shellFind: aPathString "Initiates a search starting from the specified directory." | result | result := self shellExecute: nil lpOperation: 'find' lpFile: nil lpParameters: nil lpDirectory: aPathString nShowCmd: 1. result <= 32 ifTrue: [self error: 'system error, code:', result printString]! ----- Method: Win32Shell>>shellOpen: (in category 'operations') ----- shellOpen: aFileString "Opens the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: nil lpDirectory: nil nShowCmd: 1. result <= 32 ifTrue: [self error: 'system error, code:', result printString]!

1 0

Two old(?) Morphic submissions in Inbox
by Tim Johnson 03 Mar '19

03 Mar '19

Hi, I don't know the timeframe for Inbox-to-Trunk consideration, so please excuse me if a 4-month reminder is gauche. I still believe these Morphic changes from November would be good to include. They're fairly simple user experience enhancements. Please let me know if they need further work or attention, in which case I may need some instruction on proper Inbox submission. I didn't intend to include or change any preamble/postscript. Here's what they do: Morphic-tcj.1467 avoids a DNU if someone clicks the 'printer setup' shifted-menu item. #printerSetup was implemented in MVC but not Morphic. (Not sure whether the 'printer setup' menu item is even useful.) Morphic-tcj.1466 saves a user from making a mess in the event of shift-clicking a menu item label in TheWorldMainDockingBar. (I suggest you try it, to witness the current behavior, which is deficient in two ways from my perspective.) Thanks, Tim J

2 2

The Trunk: Morphic-kfr.1482.mcz
by commits＠source.squeak.org 03 Mar '19

03 Mar '19

Karl Ramberg uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-kfr.1482.mcz ==================== Summary ==================== Name: Morphic-kfr.1482 Author: kfr Time: 3 March 2019, 12:06:05.575161 pm UUID: 9ff8560d-375c-a947-91b6-3ab0f856f9fc Ancestors: Morphic-ul.1481 Two small fixes from tcj Prevent DockingBar menu item labels from being edited, by default. This hides three possible defects in current item label editing behavior: the editor appears with its position slightly off, it only allows one keypress before automatically accepting the input, and if a menubar icon is shift-clicked then it is erased and replaced by text input by the user. Note that the menubar can be easily restored to its default contents by clicking Extras->Rebuild Menus, or evaluating: TheWorldMainDockingBar updateInstances Copy a method from MVC's ParagraphEditor to Morphic's TextEditor. #printerSetup is sent by StringHolder's shifted yellow button menu and so can be sent to both ParagraphEditor (in MVC) and TextEditor (in Morphic). =============== Diff against Morphic-ul.1481 =============== Item was changed: ----- Method: DockingBarItemMorph>>wantsKeyboardFocusOnShiftClick (in category 'events') ----- wantsKeyboardFocusOnShiftClick "set this preference to false to prevent user editing of docking bar menu items" + ^Preferences valueOfPreference: #allowMenubarItemEditing ifAbsent: [false]! - ^Preferences valueOfPreference: #allowMenubarItemEditing ifAbsent: [true]! Item was added: + ----- Method: TextEditor>>printerSetup (in category 'menu messages') ----- + printerSetup + "copied from ParagraphEditor" + TextPrinter defaultTextPrinter inspect + !

1 0

The Inbox: Morphic-tcj.1482.mcz
by commits＠source.squeak.org 03 Mar '19

03 Mar '19

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-tcj.1482.mcz ==================== Summary ==================== Name: Morphic-tcj.1482 Author: tcj Time: 2 March 2019, 3:35:41.130915 pm UUID: 78f4a7bc-b74c-408c-bbd9-4729d1d8404e Ancestors: Morphic-ul.1481 Add a menu item to copy a SketchMorph's form as code, thus allowing it to be easily reproduced elsewhere. =============== Diff against Morphic-ul.1481 =============== Item was changed: ----- Method: Morph>>addPaintingItemsTo:hand: (in category 'menus') ----- addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing; add: 'set rotation center' translated action: #setRotationCenter; add: 'reset forward-direction' translated action: #resetForwardDirection; add: 'set rotation style' translated action: #setRotationStyle; add: 'erase pixels of color' translated action: #erasePixelsUsing:; add: 'recolor pixels of color' translated action: #recolorPixelsUsing:; + add: 'copy as code' translated action: #copyAsCode; add: 'reduce color palette' translated action: #reduceColorPalette:; add: 'detect edges' translated action: #edgeDetect; add: 'sharpen' translated action: #sharpen; add: 'blur' translated action: #blur; add: 'emboss' translated action: #emboss; add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetPoint) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! Item was added: + ----- Method: SketchMorph>>copyAsCode (in category 'menu') ----- + copyAsCode + | s | + "Copy a textual representation of my form to the clipboard, which can be used to easily recreate it. + Choosing to reduce colors can create a much smaller string." + s := String new writeStream. + ( ( self confirm: 'reduce colors?' ) + ifTrue: [ self form colorReduced ] + ifFalse: [ self form ] ) storeOn: s. + Clipboard clipboardText: s close contents. + !

3 2

← Newer
1
2
3
4
5
6
7
8
9
Older →