From VisualWorks®, Pre-Release 7.4.1 (mar06.3) of 20. März 2006 on 30. März 2006 at 3:29:07 (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>InputState</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none x y bitState shiftState ctrlState lockState metaState metaKeyState otherMetaKey1State lastClick eventDispatcher lastDownPoint lastUpPoint lastUpButton lastWindow contextMenuDelay delayedEvent <imports></imports> <category>OS-Window System</category> <attributes> <package>CE</package> </attributes> </class> <comment> UI.InputState
Class InputState flattens the mouse motion and mouse button state into booleans for polling InputSensors. Keyboard shift, control and meta are also flattened. Instance Variables: x <Integer> mouse coordinate y <Integer> mouse coordinate bitState <Integer> vector of all the mouse buttons shiftState <Integer> state of the left shift key ctrlState <Integer> state of the control key lockState <Integer> state of the caps-lock key metaState <Integer> vector of all the modifier key states metaKeyState <Integer> state of the meta key otherMetaKey1State <Integer> state of the 2nd meta key activitySemaphore <Semaphore> used to halt polling when no input is available lastEventTime <Integer> millisecond time of the last input event eventDispatcher <Object | nil> an object which dispatches general events--those events not bound to a particular window. The object, if not nil, must respond to #dispatchEvent:. lastDownPoint <Point> The mouse position the last time a mouse button was pressed lastUpPoint <point> The mouse position the last time a mouse button was released lastUpButton <Integer> The last button released Class Variables: CtrlMask <Integer> bits of metaState vector specifying control key state DefaultState <InputState> usual input state for windows DoubleClickTimeout <Integer> milliseconds between two clicks of a double click FunctionKeyNames <Array> maps function key codes to Symbols FunctionKeyValues <Array> InputProcess <Process> dispatches input events InputSemaphore <Semaphore> signalled on input events InterruptKey <Integer> input encoding of the interrupt key LockMask <Integer> bits of metaState vector specifying lock key state MetaFunctionKeyMap <Integer> maps function key codes to Booleans as to whether a key is a modifier key MetaMask <Integer> bits of metaState vector specifying meta key state OtherMeta1Mask <Integer> bits of metaState vector specifying other meta (1) key state PollingTimeout <Integer> number of milliseconds to wait for input before sleeping ShiftMask <Integer> bits of metaState vector specifying shift key state GrabProtect <Semaphore> guarantees mutual exclusive access to GrabQueue. GrabQueue <OrderedCollection> a queue of windows that are grabbing mouse input. The last item in the collection is the current grab object.
</comment> <class> <name>WinCESystemSupport</name> <environment>OS</environment> <super>OS.OSSystemSupport</super> <private>false</private> none <imports> OS.WinCESystemSupportDictionary.* </imports> <category>OS-Support</category> <attributes> <includeFiles><item>sipapi.h</item></includeFiles> <includeDirectories><item></item></includeDirectories> <libraryFiles><item>coredll.dll</item> <item>aygshell.dll</item></libraryFiles> <libraryDirectories><item>\Windows</item></libraryDirectories> <beVirtual>false</beVirtual> <optimizationLevel>full</optimizationLevel> <package>CE Base</package> </attributes> </class> <comment> OS.WinCESystemSupport
This class provides access to Windows CE-specific functionality.
</comment> <class> <name>CEFilename</name> <environment>OS</environment> <super>OS.NTFSFilename</super> <private>false</private> none <imports></imports> <category>OS-PC</category> <attributes> <package>CE Base</package> </attributes> </class> <comment> OS.CEFilename
Refines class PCFilename to add CE file system specific behavior. On CE no current working directory and hence no relative filenames exist. CEFilename keeps the working directory in a shared variable and so allows relative filenames.
</comment> <name>RightMouseButtonEmulationActive</name> <environment>UI.InputState</environment> <private>false</private> <constant>false</constant> <category>button emulation</category> <initializer>false</initializer> <attributes> <package>CE</package> </attributes> <name>RightMouseButtonEmulation</name> <environment>UI.InputState</environment> <private>false</private> <constant>false</constant> <category>button emulation</category> <initializer>true</initializer> <attributes> <package>CE</package> </attributes> <name>CurrentDirectoryString</name> <environment>OS.CEFilename</environment> <private>false</private> <constant>false</constant> <category>current settings</category> <initializer>'\'</initializer> <attributes> <package>CE Base</package> </attributes> <methods> UI.InputState <category>private dispatching</category>
send: window eventButtonPress: event | focusWindow thisClick | self changeWindowOrigin: window andSwapButtonsNow: event. lastDownPoint := x @ y. self setStateFromVector: (event at: 8). (focusWindow := self focusWindowOr: window) ifNil: [^self]. event at: 2 put: focusWindow key. thisClick := event at: 9. ((event at: 7) = 1 and: [self startContextWaitProcessWith: event for: focusWindow]) ifTrue: [^self]. ((lastUpButton anyMask: self mouseButtons) and: [lastClick + self class doubleClickTimeout > thisClick and: [(lastDownPoint - lastUpPoint) abs <= (2 @ 2)]]) ifTrue: [focusWindow sensor eventDoubleClick: event] ifFalse: [focusWindow sensor eventButtonPress: event]. lastClick := thisClick
send: window eventButtonRelease: event | focusWindow | contextMenuDelay ifNotNil: [self stopContextMenuDelay]. self changeWindowOrigin: window andSwapButtonsNow: event. lastUpPoint := x @ y. self setStateFromVector: (event at: 8). lastUpButton := 1 bitShift: (event at: 7) - 1. (focusWindow := self focusWindowOr: window) ifNil: [^self]. event at: 2 put: focusWindow key. focusWindow sensor eventButtonRelease: event
send: window eventMouseMoved: event | focusWindow | contextMenuDelay ifNotNil: [(x@y dist: lastDownPoint) > 3 ifTrue:[self stopContextMenuDelay]]. self changeWindowOrigin: window andSwapButtons: event. window ifNil: [^self processUnboundEvent: event]. focusWindow := self focusWindowOr: window. focusWindow ifNil: [^self sendMouseTransition: focusWindow]. event at: 2 put: focusWindow key. focusWindow sensor eventMouseMoved: event. focusWindow ~= lastWindow ifTrue: [self sendMouseTransition: focusWindow]
startContextWaitProcessWith: event for: focusWindow "This forks a process doing a lot of things: 1. wait for 650 ms 2. continue only if this delay wasn't canceled 3. draw a small red circle arround the mouse position to warn the user that a menu is about to come up 4. wait another 650 ms 5. restore the area where the circle was drawn 6. continue only if the second delay wasn't canceled 7. send the event as a release button event, otherwise we cannot open a menu 8. convert the event into a middle mouse button pressed event, and send it. 9. nill out the delayedEvent if the fake event was sent since we don't wat to send it after we open the menu The delays are stored in instVar contextMenuDelay, which is accesses by 'process:' to clear and cancel the delay if another event is to be processed while the delay is running." self class rbEmulationEnabledActive ifFalse: [^false]. delayedEvent := event. contextMenuDelay := Delay forMilliseconds: 650. [ [| copiedEvent | copiedEvent := event copy. contextMenuDelay wait. contextMenuDelay ifNotNil: [| gc pixmap focusPoint | [| pixExtent square | gc := focusWindow graphicsContext. pixExtent := 19 @ 18. pixmap := Pixmap extent: pixExtent. square := 0 @ 0 extent: 14 @ 14. gc paint: ColorValue red. gc lineWidth: 2. focusPoint := lastDownPoint - focusWindow globalOrigin - (7 @ 7). pixmap graphicsContext copyRectangularArea: (0 @ 0 extent: pixExtent) from: gc sourceOffsetX: focusPoint x - 2 y: focusPoint y - 1 destinationOffsetX: 0 y: 0. gc displayArcBoundedBy: square startAngle: 0 sweepAngle: 360 at: focusPoint. gc flush. (contextMenuDelay := Delay forMilliseconds: 650) wait] ensure: [gc notNil & pixmap notNil ifTrue: [gc displayPixmap: pixmap at: focusPoint - (2 @ 1). gc flush]]. contextMenuDelay ifNotNil: [copiedEvent at: 7 put: 2. "make it middle mouse button and ctrl down, then send it off to the window sensor, it should pop up a menu" copiedEvent at: 8 put: ((copiedEvent at: 8) bitOr: CtrlMask). focusWindow sensor eventButtonPress: copiedEvent. delayedEvent := nil]]] on: Error do: [:s | ]] forkAt: 51. ^true
stopContextMenuDelay | window thisClick | contextMenuDelay disable. contextMenuDelay := nil. delayedEvent ifNil: [^self]. window := Window findRegistrant: (delayedEvent at: 2). (window := self focusWindowOr: window) ifNil: [^self]. thisClick := delayedEvent at: 9. ((lastUpButton anyMask: self mouseButtons) and: [lastClick + self class doubleClickTimeout > thisClick and: [(lastDownPoint - lastUpPoint) abs <= (2 @ 2)]]) ifTrue: [window sensor eventDoubleClick: delayedEvent] ifFalse: [window sensor eventButtonPress: delayedEvent]. lastClick := thisClick
</methods> <methods> UI.InputState class <category>accessing</category>
rbEmulationEnabled ^RightMouseButtonEmulation
rbEmulationEnabled: aBoolean RightMouseButtonEmulation := aBoolean
rbEmulationEnabledActive ^RightMouseButtonEmulationActive
rbEmulationEnabledActive: aBoolean RightMouseButtonEmulationActive := aBoolean
</methods> <methods> UI.InputState class <category>system startup</category>
postStartup "Clean up after a snapshot" self rbEmulationEnabledActive: (self rbEmulationEnabled and: ['* ce *' match: OSHandle currentPlatformID]).
</methods> <methods> OS.WinCESystemSupport <category>types</category>
BOOL <C: typedef long BOOL>
CLSID <C: typedef void * CLSID>
DWORD <C: typedef unsigned long DWORD>
HANDLE <C: typedef void * HANDLE>
HWND <C: typedef void * HWND>
IMENUMINFO <C: typedef struct tagIMENUMINFO IMENUMINFO>
IMENUMPROC <C: typedef int (* IMENUMPROC)(IMENUMINFO * )>
IMWINDOWPOS <C: typedef struct tagIMWINDOWPOS IMWINDOWPOS>
LPBYTE <C: typedef unsigned char * LPBYTE>
LPCWSTR <C: typedef wchar_t * LPCWSTR>
LPSTR <C: typedef char * LPSTR>
LPVOID <C: typedef void * LPVOID>
LPWSTR <C: typedef wchar_t * LPWSTR>
PIMENUMINFO <C: typedef struct tagIMENUMINFO * PIMENUMINFO>
RECT <C: typedef struct _RECT RECT>
SIPINFO <C: typedef struct tagSIPINFO SIPINFO>
wchar_t <C: typedef short wchar_t>
WORD <C: typedef unsigned short WORD>
</methods> <methods> OS.WinCESystemSupport <category>structs</category>
PROCESS_INFORMATION "Describes a created process and its main thread." <C: struct PROCESS_INFORMATION { HANDLE hProcess; HANDLE hThread; DWORD dwProcessId; DWORD dwThreadId; }>
tagIMENUMINFO <C: struct tagIMENUMINFO { unsigned short szName[260]; CLSID clsid; }>
tagIMWINDOWPOS <C: struct tagIMWINDOWPOS { int x, y, cx, cy; }>
tagSIPINFO <C: struct tagSIPINFO { unsigned long cbSize, fdwFlags; RECT rcVisibleDesktop, rcSipRect; unsigned long dwImDataSize; void * pvImData; }>
_RECT <C: struct _RECT { long left, top, right, bottom; }>
</methods> <methods> OS.WinCESystemSupport <category>procedures</category>
regCreateKey: hKey named: lpSubKey result: phkResult disposition: lpdwDisposition "Shortcut for RegCreateKey" ^self RegCreateKey: hKey named: lpSubKey gcCopyToHeapUnicode reserved: 0 class: nil options: 0 sam: self writeAccessMask security: nil result: phkResult disposition: lpdwDisposition.
</methods> <methods> OS.WinCESystemSupport <category>utilities</category>
hideSIP | pSipInfo result | self halt. pSipInfo := self SIPINFO calloc. pSipInfo memberAt: #cbSize put: pSipInfo type referentType dataSize. result := self SipGetInfo: pSipInfo. result ifFalse:[result := self GetLastError. self halt.]. pSipInfo memberAt: #fdwFlags put: ((pSipInfo memberAt: #fdwFlags) bitAnd: self SIPF_ON value bitInvert). result := self SipSetInfo: pSipInfo. result ifFalse:[result := self GetLastError. self halt.].
setCurrentDirectory: pathName "Set the current working directory." CEFilename setCurrentDirectory: pathName
showSIP | pSipInfo result | pSipInfo := self SIPINFO calloc. pSipInfo memberAt: #cbSize put: pSipInfo type referentType dataSize. result := self SipGetInfo: pSipInfo. result ifFalse:[result := self GetLastError. self halt.]. pSipInfo memberAt: #fdwFlags put: ((pSipInfo memberAt: #fdwFlags) bitOr: SIPF_ON value). result := self SipSetInfo: pSipInfo. result ifFalse:[result := self GetLastError. self halt.].
showSIPFor: aWindow ^self SHFullScreen: aWindow windowHandle with: SHFS_SHOWSIPBUTTON value
</methods> <methods> OS.WinCESystemSupport <category>private- accessing</category>
createPath: path in: key "Iterate through a path and create each branch under a key." | errorCode newKey initialKey disposition | initialKey := key. disposition := CIntegerType long newInFixedSpace. newKey := CVoidType void pointerType newInFixedSpace. path do: [ :subKey | errorCode := self regCreateKey: initialKey asInteger named: subKey result: newKey disposition: disposition. errorCode = self ERROR_SUCCESS ifFalse: [^nil]. initialKey := newKey contents]. ^newKey
</methods> <methods> OS.WinCESystemSupport <category>constants</category>
ERROR_SUCCESS ^0
HKEY_CLASSES_ROOT ^16r80000000
REG_SZ ^1
SIP_DOWN ^1
SIP_FORCEDOWN ^2
SIP_INPUTDIALOG ^4
SIP_UNCHANGED ^3
SIP_UP ^0
writeAccessMask "defined by WinNT API" ^131078
</methods> <methods> OS.WinCESystemSupport <category>accessing</category>
registerVisualworksExtension "self new registerVisualworksExtension" self setVariableWithRoot: self HKEY_CLASSES_ROOT path: (Array with: '.im') key: 'Default' value: 'visual_im'. self setVariableWithRoot: self HKEY_CLASSES_ROOT path: (Array with: 'visual_im' with: 'shell' with:'open' with:'command') key: 'Default' value: ('"',CEnvironment commandLine first,'" "%1"').
removeVariableWithRoot: rootValue path: path name: parameterName ifAbsent: errorBlock "Remove the value of the named parameter, which must be a string. If not present in registry, return value of errorBlock." | key errorCode voidPointerType stream | key := (voidPointerType := CVoidType void pointerType) newInFixedSpace. key contents: (voidPointerType cast: rootValue). stream := WriteStream on: (String new: 64). path do: [:each | stream nextPutAll: each] separatedBy: [stream nextPut: $\]. errorCode := self RegOpenKeyEx: key contents subKey: stream contents options: 0 access: self KEY_SET_VALUE result: key. errorCode = self ERROR_SUCCESS ifFalse: [^errorBlock value]. errorCode := self RegDeleteValueW: key contents name: parameterName. self RegCloseKey: key contents. errorCode = self ERROR_SUCCESS ifFalse: [^errorBlock value]
setVariableWithRoot: rootValue path: path key: subkey value: value "Set the value in the registry of subkey, which value must be a string. Answer whether the operation was successful." | key newKey errorCode voidPointerType| key := (voidPointerType := CVoidType void pointerType) newInFixedSpace. key contents: (voidPointerType cast: rootValue). newKey := self createPath: path in: key contents. newKey == nil ifTrue: [^false]. errorCode := self RegSetValueEx: newKey contents asInteger name: subkey gcCopyToHeapUnicode reserved: 0 type: self REG_SZ data: value gcCopyToHeapUnicode size: (value size + 1) * 2. ^errorCode = self ERROR_SUCCESS
windowDecorationRectangle ^0@0 corner: 0@0
</methods> <methods> OS.WinCESystemSupport <category>defines</category>
IM_NARROWIMAGE <C: #define IM_NARROWIMAGE 2 >
IM_POSITION <C: #define IM_POSITION 0 >
IM_WIDEIMAGE <C: #define IM_WIDEIMAGE 1 >
MAX_PATH <C: #define MAX_PATH 260 >
SHFS_SHOWSIPBUTTON <C: #define SHFS_SHOWSIPBUTTON 0x0004 >
SIPF_DOCKED <C: #define SIPF_DOCKED 0x00000002 >
SIPF_LOCKED <C: #define SIPF_LOCKED 0x00000004 >
SIPF_OFF <C: #define SIPF_OFF 0x00000000 >
SIPF_ON <C: #define SIPF_ON 0x00000001 >
SIP_STATUS_AVAILABLE <C: #define SIP_STATUS_AVAILABLE 1 >
SIP_STATUS_UNAVAILABLE <C: #define SIP_STATUS_UNAVAILABLE 0 >
SPI_GETCURRENTIM <C: #define SPI_GETCURRENTIM 227 >
SPI_GETSIPINFO <C: #define SPI_GETSIPINFO 225 >
SPI_SETCOMPLETIONINFO <C: #define SPI_SETCOMPLETIONINFO 223 >
SPI_SETCURRENTIM <C: #define SPI_SETCURRENTIM 226 >
SPI_SETSIPINFO <C: #define SPI_SETSIPINFO 224 >
</methods> <methods> OS.WinCESystemSupport class <category>utilities</category>
CreateProcess: aProgramNameString arguments: anArgumentString "Create a new process with a specific argument list. Answer aCCompositePointer to a PROCESS_INFORMATION struct. The example is intended to run on PocketPC 2003." "self CreateProcess: 'iexplore.exe' arguments: ' \Windows\agdefault.htm'" ^self CreateProcess: aProgramNameString arguments: anArgumentString creationFlags: 0.
CreateProcess: aProgramNameString arguments: anArgumentString creationFlags: creationFlags "Create a new detached process with a specific argument list and creationFlags. Answer aCCompositePointer to a PROCESS_INFORMATION struct." | interface processInfo | interface := self new. processInfo := interface PROCESS_INFORMATION gcMalloc. interface CreateProcess: (aProgramNameString ifNil: [nil] ifNotNil: [aProgramNameString gcCopyToHeapUnicode]) commandLine: anArgumentString gcCopyToHeapUnicode pSecurity: nil tSecurity: nil inheritHandles: 0 creationFlags: creationFlags environment: nil currentDirectoryName: nil startupInfo: nil processInfo: processInfo. ^processInfo
libraryFilesSearchSignals ^ExternalLibraryHolder libraryNotFoundSignal
</methods> <methods> OS.CEFilename <category>private</category>
named: n (n isEmpty not and: [n first == self separator or: [n includes: $:]]) ifTrue: [^super named: n] ifFalse: [| path | path := self class getDefaultDirectory asString. path last == self separator ifTrue: [^super named: path , n] ifFalse: [^super named: path , (String with: self separator) , n]]
</methods> <methods> OS.CEFilename class <category>parsing</category>
bytesFor: char "Answer number of unicode character to encode this character." ^1
isBadCharacter: char "Answer if this character is illegal for a platform pathname string." "Assume nobody likes unprintable characters." | cv | cv := char asInteger. cv < 32 "space" ifTrue: [^true]. cv = 8r177 "del" ifTrue: [^true]. ^(self badCharacterList includes: char)
</methods> <methods> OS.CEFilename class <category>private</category>
currentDirectoryString "Return the platform-specific token that represents the current directory" ^CurrentDirectoryString copy
hookupTo: pn "The receiver has become the default class for Filename. Get prepared." (ObjectMemory dependents includes: self) ifFalse: [ObjectMemory addDependent: self]. String.PrimitiveArgumentClass := TwoByteString. self setCwd
setCwd "set current working directory at startup time. The current working directory is the one where the image was loaded from. If no image was specified in the commandLine, use the executable" "self setCwd" | commandLine fileName | commandLine := CEnvironment commandLine. fileName := commandLine detect: [:s | '*.im' match: s] ifNone: [commandLine first]. self setCurrentDirectory: fileName asFilename head
update: anAspect anAspect == #returnFromSnapshot ifTrue: [self setCwd]
</methods> <methods> OS.CEFilename class <category>utilities</category>
encodeFilename: aString ^aString asTwoByteString
volumes ^Array with: '\'
</methods> <methods> OS.CEFilename class <category>accessing</category>
getDefaultDirectory ^CurrentDirectoryString
setCurrentDirectory: aFileName CurrentDirectoryString := aFileName asString
</methods> <methods> UI.InputManager class <category>initialization</category>
platformHookup "This is sent when VisualWorks starts up. A manager that is appropriate for the platform must be chosen at this time to handle setlocale requests. However, the NilInputManager may still be installed as the default if the current locale so specifies." | platform | Default := nil. platform := self platformName. "Use WindowsInputManager only when not running on CE (avoiding unicode bugs in WindowsInputManager)." (platform = 'MS-Windows' and: [('* ce *' match: OSHandle currentPlatformID) not]) ifTrue: [| wim | wim := #{WindowsInputManager} value. wim initializeEncoder. ^Default := PlatformManager := wim new]. "Use X11InputManager only when running X11R5 or better." (platform = 'X11' and: [(ObjectMemory objectRegisteredWithEngineFor: 'XlibSpecificationRelease') >= 5]) ifTrue: [^PlatformManager := #{X11InputManager} value new]. PlatformManager := NullInputManager new
</methods> <methods> OS.Filename class <category>class initialization</category>
hookupFor: ps withID: id "hook-up default subclasses." | dpc | dpc := id = 'unix' ifTrue: [('*MacOSX*' match: ps ignoreCase: false) ifTrue: [MacOSXFilename] ifFalse: [UnixFilename]] ifFalse: [id = 'mac' ifTrue: [MacFilename] ifFalse: [(#('dos' 'os2' 'win32') includes: id) ifTrue: [('* ce *' match: ps) ifTrue: [CEFilename] ifFalse: [PCFilename]] ifFalse: [self]]]. self defaultClass: dpc. dpc hookupTo: ps.
</methods> <methods> OS.OSSystemSupport class <category>instance creation</category>
concreteClassFrom: platformArray "Answer the specific subclass that interfaces to the OS described by the supplied platformArray." | platformSymbol version | platformSymbol := platformArray at: 1. #unix == platformSymbol ifTrue: [('*macOSX*' match: (platformArray at: 2)) ifFalse: [^#{UnixSystemSupport} value] ifTrue: [^#{MacOSXSystemSupport} value]]. #os2 == platformSymbol ifTrue: [^#{OS2SystemSupport} value]. #win32 == platformSymbol ifTrue: [| stream os | stream := (platformArray at: 2) readStream. stream skipThrough: Character space. version := stream upTo: Character space. os := stream upTo: Character space. "Should be end of string." ^os = 'win32s' ifTrue: [('V3.*' match: version) ifTrue: [#{Win32sSystemSupport} value] ifFalse: [#{Win95SystemSupport} value]] ifFalse: [os = '95' ifTrue: [#{Win95SystemSupport} value] ifFalse: [os = 'ce' ifTrue: [#{WinCESystemSupport} value] ifFalse:[#{WinNTSystemSupport} value]]]]. #mac == platformSymbol ifTrue: [| stream | stream := (platformArray at: 2) readStream. stream skipThrough: Character space; skipThrough: Character space; skipThrough: Character space. ^stream peek == $P ifTrue: [#{PowerMacSystemSupport} value] ifFalse: [#{MacSystemSupport} value]]. ^#unknown.
</methods> <methods> Core.ByteEncodedString class <category>class initialization</category>
initialize "ByteEncodedString initialize" StringClasses := Dictionary new. StringClasses at: 'Mac' put: #{MacString}. StringClasses at: 'ISO8859L1' put: #{ISO8859L1String}. StringClasses at: 'IBMCP850' put: #{OS2String}. UnsupportedCharacterError notifierString: (#errCharacterNotSupported << #dialogs >> 'This character is not supported by this class of string'); nameClass: self message: #unsupportedCharacterSignal
</methods> <methods> Core.ByteEncodedString class <category>system startup</category>
install | className stringClass nm | className := self platformStringPreference first. className changeClassTo: ByteString. stringClass := (StringClasses at: className) value. self defaultPlatformClass: stringClass. PrimitiveArgumentClass := ObjectMemory vmIsUnicode ifTrue: [TwoByteString] ifFalse: [ByteArray]. PrimitiveArgumentClass bePreferredClassWithEncoding: stringClass encoder decodingMap copy
</methods> <methods> OS.PCFilename class <category>class initialization</category>
initialize "Initialize the dictionary of file system classes for the known File Systems. Edit this when a new known file system is added. NT has quite a lot of names for file systems and more may be found." "PCFilename initialize" (FsDict := Dictionary new) at: 'CDFS' put: HPFSFilename; at: 'DOS' put: FATFilename; at: 'FAT' put: FATFilename; at: 'FAT32' put: FATFilename; at: 'HPFS' put: HPFSFilename; at: 'LAN' put: FATFilename; at: 'NETWARE' put: FATFilename; at: 'NetWare' put: FATFilename; at: 'NFS' put: HPFSFilename; at: '*NT5CSC' put: NTFSFilename; at: 'NTFS' put: NTFSFilename; at: 'NWCOMPA' put: FATFilename; at: 'NWCOMPAT' put: FATFilename; at: 'NWFS' put: FATFilename; at: 'Samba' put: FATFilename; at: 'VINES' put: FATFilename; at: 'CEFS' put: CEFilename. ^self
</methods> <methods> Core.TwoByteString class <category>system startup</category>
bePreferredClassWithEncoding: anEncoding "Register the receiver with the VM as the preferred String class. anEncoding is a TwoByteString of size 256, that specifies, for any given byte value, what Character that byte should represent" <primitive: 341> ^self primitiveFailed
</methods> <methods> OS.IOAccessor class <category>utilities</category>
convertSimpleStringForPlatform: aString "Convert aString, which has a single- or double-byte encoding, to conform to the platform's default encoding." ObjectMemory vmIsUnicode ifTrue: [aString isByteIndexed ifFalse:[^aString]]. ^aString asByteArrayEncoding: #default
</methods> <methods> Graphics.Window class <category>class initialization</category>
initializeLabelEncodings "Each element of the collection is an Array of four elements - pattern to compare against OSHandle currentPlatformID - pattern to compare against Locale current name - pattern to compare against Locale current defaultEncoding - if all three patterns match, the encoding to use for window labels" LabelEncoding := OrderedCollection new. LabelEncoding add: #('* hp *' 'C' '*' #HP_Roman8). LabelEncoding add: #('* ucs2 *' '*' '*' #UCS_2).
</methods> <methods> Graphics.Window <category>accessing</category>
label: aString iconLabel: anIconString "Convert string into platform encoding and set the label for this window, if supported by the window manager." | encoding | encoding := self class defaultWindowLabelEncoding. encoding = #UCS_2 ifTrue: [^self primLabel: (aString asString) iconLabel: (anIconString asString)]. ^self primLabel: (aString asString asByteArrayEncoding: encoding) iconLabel: (anIconString asString asByteArrayEncoding: encoding)
</methods> <methods> Kernel.ObjectMemory class <category>testing</category>
vmIsUnicode ^[self objectRegisteredWithEngineFor: 'vmIsUnicode'] on: Error do: [: error | false]
</methods> <methods> UI.ScheduledWindow class <category>defaults</category>
windowTopLeftHeadroom "Answer a point specifying how much headroom to use for title decoration in automatic window placement. The default is 10-pixel left border and 30-pixel title bar height" ^Screen default rendererName == #'MS-Windows' ifTrue: [[OSSystemSupport concreteClass new windowDecorationRectangle origin] on: Error do: [:ex | ex return: 10 @ 30]] ifFalse: [10 @ 30]
</methods> <methods> UI.ScheduledWindow <category>scheduling</category>
openIn: aRectangle "Open and schedule the receiver in aRectangle." | newBounds | self setDisplayBox: (newBounds := Screen default makeRectangleVisible: aRectangle). self privateOpenForced: true. self extentEvent: self extent. Cursor normal show. ^newBounds
</methods> <methods> UI.WindowManager <category>event processing</category>
processNextEvent | event | event := eventQueue next. activeController := event activeWindowController. "need this for debugging" self safelyDispatchForWindowManager: event. self repairDamages. event isExposeEvent ifTrue: [event window setupKeyboard]. Processor yield. ^event
</methods> <methods> UI.TransientWindow <category>private</category>
setupKeyboard ^self
</methods> <methods> UI.ExposeEvent <category>testing</category>
isExposeEvent ^true
</methods> <methods> UI.Event <category>testing</category>
isExposeEvent ^false
</methods> <methods> OS.SocketAccessor <category>accessing</category>
getPendingError "Return the value of my pending error option. This can be checked before performing operations on me to verify that some previous operation hasn't resulted in a SOL_SOCKET-level error which could cause subsequent operations to signal an exception. On most CE devices this getSockOpt call is not supported, so we provide the current errorCode instead." | ba | ('*win* ce *' match: OSHandle currentPlatformID) ifTrue: [^self getPendingErrorOnCE]. ba := self getOptionsLevel: self class SOL_SOCKET name: self class SO_ERROR. ba changeClassTo: UninterpretedBytes. ^ba unsignedLongAt: 1
getPendingErrorOnCE "Return the value of my pending error option. This can be checked before performing operations on me to verify that some previous operation hasn't resulted in a SOL_SOCKET-level error which could cause subsequent operations to signal an exception. On most CE devices this getSockOpt call is not supported, so we provide the current errorCode instead." | ba oldError | oldError := self errorCode. oldError isNil ifTrue:[oldError := 0]. [ba := self getOptionsLevel: self class SOL_SOCKET name: self class SO_ERROR] on: OsIllegalOperation do: [:exception | ^oldError]. ba changeClassTo: UninterpretedBytes. ^ba unsignedLongAt: 1
</methods> <methods> Graphics.ScreenGraphicsContext <category>primitives-curves</category>
roundedPrimDisplayArcBBoxOrigin: originPoint extent: extentPoint startAngle: startAngle sweepAngle: sweepAngle "Display an elliptical arc defined by the bounding rectangle of the ellipse and by the starting angle and angle of sweep for the arc. The bounding rectangle is specified by the coordinates of its top left corner and by its width and height. The angles are specified in degrees, with positive angles indicating clockwise displacements, negative angles counterclockwise. The startAngle specifies that starting angular position for the arc, measured from three o'clock. The sweep angle specifies the angular path of the arc relative to the starting angle. The angles are specified in the (possibly skewed) coordinate system of the ellipse. For example, the angle between three o'clock and a line from the center of the ellipse to the top right corner of the bounding rectangle is always 45 degrees, even if the bounding rectangle is not square. The points have already been rounded and the angles already converted to Floats. Use the current line width, cap style, and paint." <primitive: 990> " We have already rounded all the points, so the primitive must be unable to handle some other aspect of the drawing operation. Fall back to general-case code. " self displayGeneralArcBBoxOrigin: originPoint extent: extentPoint startAngle: startAngle sweepAngle: sweepAngle
roundedPrimDisplayWedgeBBoxOrigin: originPoint extent: extentPoint startAngle: startAngle sweepAngle: sweepAngle "Display an elliptical wedge bounded by a zero-width arc and the zero-width line segments from the center of the ellipse to the ends of the arc. The bounding arc is defined by the bounding rectangle of the ellipse and by the starting angle and angle of sweep for the arc. The bounding rectangle is specified by the coordinates of its top left corner and by its width and height. The angles are specified in degrees, with positive angles indicating clockwise displacements, negative angles counterclockwise. The startAngle specifies that starting angular position for the arc, measured from three o'clock. The sweep angle specifies the angular path of the arc relative to the starting angle. The angles are specified in the (possibly skewed) coordinate system of the ellipse. For example, the angle between three o'clock and a line from the center of the ellipse to the top right corner of the bounding rectangle is always 45 degrees, even if the bounding rectangle is not square. Use the current paint. The coordinates have already been rounded and the angles converted to floats." <primitive: 991> (EllipticalArc boundingBox: (originPoint extent: extentPoint) startAngle: startAngle sweepAngle: sweepAngle) asPolyline asFiller displayOn: self
</methods> <methods> Graphics.Window class <category>private</category>
encodeWindowTypeSpecification: aWindowType "Answer the encoded version of this window type specification." ('* PocketPC*' match: OSHandle currentPlatformID) ifTrue: [^(#(#popUp #dialog #normalX #modelessDialog #imageModalDialog #reserved #postedMenu #normal) indexOf: aWindowType ifAbsent: [3]) - 1]. ^(#(#popUp #dialog #normal #modelessDialog #imageModalDialog #reserved #postedMenu) indexOf: aWindowType ifAbsent: [3]) - 1
</methods> <methods> Graphics.Window <category>private</category>
setupKeyboard ('* PocketPC*' match: OSHandle currentPlatformID) ifTrue: [WinCESystemSupport new showSIPFor: self ]. ^self
</methods> <methods> Kernel.ObjectMemory class <category>system startup</category>
bringAllWindowsToFront InputState postStartup. ('* ce *' match: OSHandle currentPlatformID) ifTrue: [Window allGeneralInstances do: [:x | x isOpen ifTrue: [x raise]]]
</methods> <methods> Core.SystemEventInterest class <category>dependencies-pragma</category>
redButtonEmulation <triggerAtSystemEvent: #earlySystemInstallation> InputState postStartup
</methods> <methods> Tools.VisualWorksSettings class <category>settings-look and feel</category>
lookAndFeel60rightButtonEmulation <setting: #(lookAndFeel rightButtonEmulation)> ^(BooleanSetting on: InputState aspect: #rbEmulationEnabled) default: #false; label: #RightButtonEmulation << #labels >> 'Right Mouse button emulation for Windows CE'; helpText: #RightButtonEmulationHelpText << #dialogs >> 'This setting controls the right mouse button emulation designed for the Windows CE platform. If enabled, a normal mouse button selection, where the mouse isn''t moved in any direction, will first draw a small red circle arround the mouse point, and if enough time has elapsed, the middle mouse menu is poped up. The red circle is removed, if the mouse is moved or the button is released in time. Because Windows CE devices normally have no mouse, but only a stylus, this setting should be switched on if application are to be deployed on Windows CE.'
</methods> <methods> Tools.VisualWorksSettings class <category>pages</category>
lookAndFeelPage <settingsPage: #(lookAndFeel) position: -30> ^ModularSettingsPage new label: #LookAndFeel << #labels >> 'Look and Feel'; icon: (ListIconLibrary visualFor: #window); addAllSettings: (self settingsWithPrefix: #(lookAndFeel) except: #(windowPlacement mouseButtonOrder rightButtonEmulation)); useRadioButtonsForEnumerations; addSetting: (self settingWithId: #(lookAndFeel windowPlacement)); addSetting: (self settingWithId: #(lookAndFeel mouseButtonOrder)); addSetting: (self settingWithId: #(lookAndFeel rightButtonEmulation))
</methods> <methods> OS.WinCESystemSupport <category>procedures</category>
CreateProcess: imageName commandLine: commandLine pSecurity: lpsaProcess tSecurity: lpsaThread inheritHandles: inheritHandles creationFlags: creationFlags environment: environment currentDirectoryName: currentDirectoryName startupInfo: startupInfo processInfo: processInfo "Create a new process running in a separate address space. n.b., we use CreateProcessW (the UNICODE/wide version) rather than CreateProcessA (the ANSI version) since CE implements only the unicode versions. This differs from the other Windows versions. Unused structs are replaced by 'void *' types. Description: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcekernl/html/_wcesdk_win32_createprocess.asp" <C: BOOL CreateProcessW( LPCWSTR imageName, LPCWSTR commandLine, void * lpsaProcess, void * lpsaThread, BOOL inheritHandles, DWORD creationFlags, LPVOID environment, LPWSTR currentDirectoryName, void * startupInfo, struct PROCESS_INFORMATION *processInfo)>
GetLastError <C:DWORD GetLastError(void)>
RegCreateKey: hKey named: lpSubKey reserved: reserved class: lpClass options: dwOptions sam: samDesired security: lpSecurityAttributes result: phkResult disposition: lpdwDisposition <C: long RegCreateKeyExW(unsigned long hKey, wchar_t * lpSubKey, unsigned long reserved, wchar_t *lpClass, unsigned long dwOptions, unsigned long samDesired, void * lpSecurityAttributes, void ** phkResult, unsigned long * lpdwDisposition)> ^self externalAccessFailedWith: _errorCode
RegDeleteValueW: hKey name: lpszValueName <C: long RegDeleteValueW(void * hKey, WORD *lpszValueName)> ^self externalAccessFailedWith: _errorCode
RegSetValueEx: hKey name: lpszValueName reserved: dwReserved type: dwType data: lpbData size: cbData <C: long RegSetValueExW( unsigned long hKey, wchar_t *lpszValueName, unsigned long dwReserved, unsigned long dwType, unsigned char *lpbData, unsigned long cbData)> ^self externalAccessFailedWith: _errorCode
SHFullScreen: hwndRequester with: dwState <C:__bool int SHFullScreen(HWND hwndRequester, DWORD dwState)>
SHSipPreferenceForWindow: windowHandle state: sipState <C: __bool int SHSipPreference(HWND windowHandle,int sipState)>
SipEnumIM: arg <C: int SipEnumIM(IMENUMPROC)> ^self externalAccessFailedWith: _errorCode
SipGetCurrentIM: arg <C: int SipGetCurrentIM(CLSID * )> ^self externalAccessFailedWith: _errorCode
SipRegisterNotification: arg <C: int SipRegisterNotification(void * )> ^self externalAccessFailedWith: _errorCode
SipSetCurrentIM: arg <C: int SipSetCurrentIM(CLSID * )> ^self externalAccessFailedWith: _errorCode
SipSetDefaultRect: arg <C: int SipSetDefaultRect(RECT * )> ^self externalAccessFailedWith: _errorCode
SipSetInfo: arg <C: __bool int SipSetInfo(SIPINFO * )> ^self externalAccessFailedWith: _errorCode
SipShowIM: arg <C: int SipShowIM(unsigned long)> ^self externalAccessFailedWith: _errorCode
SipStatus: argArray <C: unsigned long SipStatus(...)> ^self externalAccessFailedWith: _errorCode
</methods> <methods> OS.WinCESystemSupport <category>utilities</category>
SHSipPreference: windowHandle with: st <C:__bool int SHSipPreference (HWND windowHandle, int st)>
</methods> <methods> OS.WinCESystemSupport <category>accessing</category>
SipGetInfo: arg <C: _bool int SipGetInfo(SIPINFO * )> ^self externalAccessFailedWith: _errorCode
</methods> <initialize> Core.ByteEncodedString </initialize> <initialize> OS.PCFilename </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>Window</name> <environment>Graphics</environment> <super>Graphics.DisplaySurface</super> <private>false</private> none inputOrigin creationOrigin sensor iconic windowType effectiveWindowType statusLineHeight allowsStatusLine mapped eventHandlers windowManager <imports></imports> <category>OS-Window System</category> <attributes> <package>OS-Window System</package> </attributes> </class> <class> <name>TransientWindow</name> <environment>UI</environment> <super>Graphics.Window</super> <private>false</private> none component paintPreferences isEventDriven controller <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</package> </attributes> </class> <class> <name>NTFSFilename</name> <environment>OS</environment> <super>OS.PCFilename</super> <private>false</private> none <imports></imports> <category>OS-PC</category> <attributes> <package>OS-PC</package> </attributes> </class> <class> <name>ScreenGraphicsContext</name> <environment>Graphics</environment> <super>Graphics.GraphicsContext</super> <private>false</private> none <imports></imports> <category>Graphics-Support</category> <attributes> <package>Graphics-Support</package> </attributes> </class> <class> <name>OSSystemSupport</name> <environment>OS</environment> <super>External.ExternalInterface</super> <private>false</private> none <imports> OS.OSSystemSupportDictionary.* </imports> <category>OS-Support</category> <attributes> <includeFiles></includeFiles> <includeDirectories></includeDirectories> <libraryFiles></libraryFiles> <libraryDirectories></libraryDirectories> <beVirtual>false</beVirtual> <optimizationLevel>full</optimizationLevel> <package>OS-Support</package> </attributes> </class> <class> <name>SocketAccessor</name> <environment>OS</environment> <super>OS.BlockableIOAccessor</super> <private>false</private> none concreteClass <imports></imports> <category>OS-Sockets</category> <attributes> <package>OS-Sockets</package> </attributes> </class> <class> <name>ScheduledWindow</name> <environment>UI</environment> <super>Graphics.Window</super> <private>false</private> none label icon minimumSize maximumSize component lookPreferences paintPreferences edgeDecorationPolicy widgetPolicy controller model damageRepairPolicy masterWindow <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</package> </attributes> </class> <class> <name>Event</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none time initiator window <imports></imports> <category>Interface-Events</category> <attributes> <package>Interface-Events</package> </attributes> </class> <class> <name>ExposeEvent</name> <environment>UI</environment> <super>UI.ResizeEvent</super> <private>false</private> none buttonNumber <imports></imports> <category>Interface-Events</category> <attributes> <package>Interface-Events</package> </attributes> </class> <class> <name>WindowManager</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none windows activeController interruptLock outstandingMetaOrDamage openInProgress eventQueue baseProcess dontFilterEvents <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</package> </attributes> </class>