================================================================== pub/Smalltalk/st80_vw/RemoteObjects/remoteobjects.st ================================================================== ApplicationModel subclass: #ORBConsole instanceVariableNames: 'silentMode portNumber serverMessage serverLog serverRemoteObjects clientSessions clientRemoteObjects ' classVariableNames: '' poolDictionaries: '' category: 'RemoteObjects'! !ORBConsole methodsFor: 'initialization'! initialize self updateListOfServerObjects. ORB isDown ifFalse: [self serverMessage value: 'ORB Server is still running.']! ! !ORBConsole methodsFor: 'aspects'! clientRemoteObjects ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^clientRemoteObjects isNil ifTrue: [clientRemoteObjects := SelectionInList new] ifFalse: [clientRemoteObjects]! clientSessions ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^clientSessions isNil ifTrue: [clientSessions := SelectionInList new] ifFalse: [clientSessions]! portNumber ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^portNumber isNil ifTrue: [portNumber := 6666 asValue] ifFalse: [portNumber]! serverLog ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^serverLog isNil ifTrue: [serverLog := SelectionInList new] ifFalse: [serverLog]! serverMessage ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^serverMessage isNil ifTrue: [serverMessage := String new asValue] ifFalse: [serverMessage]! serverRemoteObjects ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^serverRemoteObjects isNil ifTrue: [serverRemoteObjects := SelectionInList new] ifFalse: [serverRemoteObjects]! silentMode ''connect this to ORB" silentMode isNil ifTrue: [silentMode := PluggableAdaptor on: ORB. silentMode getBlock: [:m | m isInSilentErrorMode] putBlock: [:m :v | v ifTrue: [m beInSilentErrorMode] ifFalse: [m beNotInSilentErrorMode]] updateBlock: [:m :a :p | ]]. ^silentMode! ! !ORBConsole methodsFor: 'server part'! logMessage: aString | list | list := self serverLog list. list addFirst: aString. list size > 16 ifTrue: [list removeLast]! portNumberCanBeChanged ^ORB isDown! serverDown ORB close. self serverMessage value: 'ORB Server is down (closed).'! serverRemoteObjectAdd | nameAndConfirm name confirm value stringExpression | nameAndConfirm := ORB requestSymbolAndConfirm: 'Enter name of new object'. name := nameAndConfirm at: 1. confirm := nameAndConfirm at: 2. name isNil ifTrue: [^nil]. (name includes: $ ) ifTrue: [^ORB warn: 'Name cannot contain spaces.']. name isEmpty ifTrue: [^nil]. ((name at: 1) between: $A and: $Z) ifFalse: [^ORB warn: 'Name must begin with capital leter A..Z']. (name reject: [:c | (c between: $0 and: $9) or: [(c between: $A and: $Z) or: [c between: $a and: $z]]]) isEmpty ifFalse: [^ORB warn: 'Use only A..Z, a..z and 0..9 characters, please.']. (ORB remoteObjects includesKey: name) ifTrue: [^ORB warn: 'This name is already used, sorry.']. confirm ifTrue: [value := Object fromUser. (value isKindOf: Inspector) ifTrue: [value := value object]] ifFalse: [Object errorSignal handle: [:ex | ^ORB warn: 'Evaluation error in expression ''' , stringExpression , ''''] do: [value := Compiler evaluate: (stringExpression := ORB request: 'Enter Smalltalk expression...')]]. ORB remoteObjects at: name put: value. self updateListOfServerObjects! serverRemoteObjectBrowse | object | self serverRemoteObjects selection isNil ifTrue: [^ORB warn: 'No object selected.']. object := ORB remoteObjects at: self serverRemoteObjects selection. object = ORBRemoteInterface ifTrue: [^ORB inspect]. (object respondsTo: #openInterface) ifTrue: [object openInterface] ifFalse: [object inspect]! serverRemoteObjectChange | confirm value stringExpression | self serverRemoteObjects selection isNil ifTrue: [^ORB warn: 'No object selected.']. self serverRemoteObjects selection = #ORB ifTrue: [^ORB warn: 'Do not change object ORB, please.']. confirm := ORB confirm: 'New value for object ' , self serverRemoteObjects selection , ' will be set up from window.'. confirm ifTrue: [value := Object fromUser. (value isKindOf: Inspector) ifTrue: [value := value object]] ifFalse: [Object errorSignal handle: [:ex | ^ORB warn: 'Evaluation error in expression ''' , stringExpression , ''''] do: [value := Compiler evaluate: (stringExpression := ORB request: 'Enter Smalltalk expression...')]]. ORB remoteObjects at: self serverRemoteObjects selection put: value! serverRemoteObjectRemove self serverRemoteObjects selection isNil ifTrue: [^ORB warn: 'No object selected.']. self serverRemoteObjects selection = #ORB ifTrue: [^ORB warn: 'Do not remove object ORB, please.']. (ORB confirm: 'Are you sure to remove object ' , self serverRemoteObjects selection , '?') ifFalse: [^nil]. ORB remoteObjects removeKey: self serverRemoteObjects selection. self updateListOfServerObjects! serverRemoteObjectRename | name value | self serverRemoteObjects selection isNil ifTrue: [^ORB warn: 'No object selected.']. self serverRemoteObjects selection = #ORB ifTrue: [^ORB warn: 'Do not rename object ORB, please.']. name := ORB requestSymbol: 'Enter new name for object ' , self serverRemoteObjects selection , '...'. name isNil ifTrue: [^nil]. (name includes: $ ) ifTrue: [^ORB warn: 'Name cannot contain spaces.']. name isEmpty ifTrue: [^nil]. ((name at: 1) between: $A and: $Z) ifFalse: [^ORB warn: 'Name must begin with capital leter A..Z']. (name reject: [:c | (c between: $0 and: $9) or: [(c between: $A and: $Z) or: [c between: $a and: $z]]]) isEmpty ifFalse: [^ORB warn: 'Use only A..Z, a..z and 0..9 characters, please.']. (ORB remoteObjects includesKey: name) ifTrue: [^ORB warn: 'This name is already used, sorry.']. value := ORB remoteObjects at: self serverRemoteObjects selection. ORB remoteObjects removeKey: self serverRemoteObjects selection. ORB remoteObjects at: name put: value. self updateListOfServerObjects! serverRemoteObjectReset ORB initializeRemoteObjects. self updateListOfServerObjects! serverStart ORB isDown ifFalse: [^ORB warn: 'ORB Server should be running.']. ORB waitForConnectionsAtPort: self portNumber value. self serverMessage value: (ORB isDown ifTrue: ['ORB Server cannot be started at this port.'] ifFalse: ['ORB Server is running'])! updateListOfServerObjects self serverRemoteObjects list: ORB remoteObjectsNames asSortedCollection! ! !ORBConsole methodsFor: 'client part'! clientObjectInspect | name obj | (name := self clientRemoteObjects selection) isNil ifTrue: [^ORB warn: 'No object selected...']. obj := RemoteObject named: name session: self clientSessions selection. obj yourself inspect! clientObjectOpen | name obj value | (name := self clientRemoteObjects selection) isNil ifTrue: [^ORB warn: 'No object selected...']. obj := RemoteObject named: name session: self clientSessions selection. value := obj yourself. (value respondsTo: #openInterface) ifFalse: [^ORB warn: 'This object does not understand the message #openInterface.'] ifTrue: [value openInterface]! clientObjectWorkspace | name obj workspace | (name := self clientRemoteObjects selection) isNil ifTrue: [^ORB warn: 'No object selected...']. obj := RemoteObject named: name session: self clientSessions selection. workspace := ORBWorkspace new. workspace openInterface. workspace object: obj! clientSessionAdd | sessionData host newSession | sessionData := ORB requestNewSession. host := sessionData at: 1. portNumber := sessionData at: 2. newSession := ORB newSessionWith: host port: portNumber. newSession isNil ifTrue: [ORB isInSilentErrorMode ifTrue: [ORB warn: 'No session created.']. ^nil]. self clientSessions list add: newSession! clientSessionClose self clientSessions selection isNil ifTrue: [^ORB warn: 'No session selected...']. self clientSessions selection close. self clientSessions listHolder changed: #value. self clientRemoteObjects list: List new! clientSessionsChanged | session orb list | (session := self clientSessions selection) isNil ifTrue: [^self clientRemoteObjects list: List new]. session isDown ifTrue: [^self clientRemoteObjects list: List new]. orb := RemoteObject named: #ORB session: session. list := orb remoteObjectsNames. list isNil ifTrue: [list := List new]. self clientRemoteObjects list: list! clientSessionUpdate self clientSessions list removeAll: (self clientSessions list select: [:c | c isDown]). self clientSessionsChanged! serverLogSelected | message | (message := self serverLog selection copy) isNil ifTrue: [^nil]. message at: (message indexOf: $>) + 1 put: Character cr. ORB warnLarge: message! ! !ORBConsole methodsFor: 'private - gui'! openInterface: aSelector ''open only once" builder == nil ifTrue: [^super openInterface: aSelector] ifFalse: [ORBDialog new openInterface]! requestForWindowClose self class console: nil. self clientSessions list do: [:c | [c close] fork]. ^super requestForWindowClose! ! ''-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ORBConsole class instanceVariableNames: 'console '! !ORBConsole class methodsFor: 'instance creation'! new console isNil ifFalse: [^ORBDialog new]. console := super new. console initialize. ^console! ! !ORBConsole class methodsFor: 'interface specs'! windowSpec ''UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'ORB Console' #min: #(#Point 290 458 ) #max: #(#Point 290 458 ) #bounds: #(#Rectangle 255 71 545 529 ) #flags: 8 ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#Point 1 1 ) #label: #logoImage #hasCharacterOrientedLabel: false ) #(#LabelSpec #layout: #(#Point 40 4 ) #colors: #(#LookPreferences #setForegroundColor: #(#ColorValue 3899 0 3899 ) ) #label: 'ORB Console' #style: #large ) #(#GroupBoxSpec #layout: #(#Rectangle 4 36 284 276 ) #label: 'server' ) #(#InputFieldSpec #layout: #(#Rectangle 52 48 120 72 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #white ) ) #model: #portNumber #callbacksSpec: #(#UIEventCallbackSubSpec #requestFocusInSelector: #portNumberCanBeChanged #requestValueChangeSelector: #portNumberCanBeChanged ) #tabable: false #type: #number #formatString: '0' ) #(#LabelSpec #layout: #(#Point 12 56 ) #label: 'port #' ) #(#ActionButtonSpec #layout: #(#Rectangle 160 48 216 72 ) #model: #serverStart #tabable: false #label: 'start' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 220 48 276 72 ) #model: #serverDown #tabable: false #label: 'down' #defaultable: true ) #(#InputFieldSpec #layout: #(#Rectangle 12 76 276 100 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue 7044 7044 7044 ) ) #model: #serverMessage #tabable: false #isReadOnly: true ) #(#CheckBoxSpec #layout: #(#Point 184 24 ) #model: #silentMode #tabable: false #label: 'silent error mode' ) #(#GroupBoxSpec #layout: #(#Rectangle 4 280 284 452 ) #label: 'client' ) #(#SequenceViewSpec #layout: #(#Rectangle 12 100 276 172 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #white ) ) #model: #serverLog #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #serverLogSelected ) #tabable: false #useModifierKeys: true #selectionType: #highlight ) #(#LabelSpec #layout: #(#Point 164 300 ) #label: 'remote objects' ) #(#LabelSpec #layout: #(#Point 12 300 ) #label: 'sessions' ) #(#SequenceViewSpec #layout: #(#Rectangle 12 196 160 268 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #white ) ) #model: #serverRemoteObjects #menu: #serverObjectsMenu #useModifierKeys: true #selectionType: #highlight ) #(#LabelSpec #layout: #(#Point 12 176 ) #label: 'remote objects' ) #(#ActionButtonSpec #layout: #(#Rectangle 220 196 276 220 ) #model: #serverRemoteObjectChange #tabable: false #label: 'change' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 220 244 276 268 ) #model: #serverRemoteObjectReset #tabable: false #label: 'reset all' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 164 220 220 244 ) #model: #serverRemoteObjectRename #tabable: false #label: 'rename' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 164 196 220 220 ) #model: #serverRemoteObjectAdd #tabable: false #label: 'add' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 220 220 276 244 ) #model: #serverRemoteObjectBrowse #tabable: false #label: 'browse' #defaultable: true ) #(#SequenceViewSpec #layout: #(#Rectangle 12 320 160 392 ) #flags: 15 #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #white ) ) #model: #clientSessions #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #clientSessionsChanged ) #menu: #clientSessionsMenu #useModifierKeys: true #selectionType: #highlight ) #(#SequenceViewSpec #layout: #(#Rectangle 164 320 276 392 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #white ) ) #model: #clientRemoteObjects #menu: #clientObjectsMenu #useModifierKeys: true #selectionType: #highlight ) #(#ActionButtonSpec #layout: #(#Rectangle 12 396 68 420 ) #model: #clientSessionAdd #tabable: false #label: 'add' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 164 244 220 268 ) #model: #serverRemoteObjectRemove #tabable: false #label: 'remove' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 68 396 160 420 ) #model: #clientSessionClose #tabable: false #label: 'close session' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 164 396 220 420 ) #model: #clientObjectInspect #tabable: false #label: 'inspect' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 164 420 276 444 ) #model: #clientObjectWorkspace #tabable: false #label: 'open workspace' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 220 396 276 420 ) #model: #clientObjectOpen #tabable: false #label: 'open' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 12 420 160 444 ) #model: #clientSessionUpdate #tabable: false #label: 'refresh sessions' #defaultable: true ) ) ) )! ! !ORBConsole class methodsFor: 'resources'! clientObjectsMenu ''UIMenuEditor new openOnClass: self andSelector: #clientObjectsMenu" ^#(#Menu #( #(#MenuItem #rawLabel: 'inspect' #value: #clientObjectInspect ) #(#MenuItem #rawLabel: 'open interface' #value: #clientOpenInterface ) #(#MenuItem #rawLabel: 'open workspace' #value: #clientObjectWorkspace ) ) #(2 1 ) nil ) decodeAsLiteralArray! clientSessionsMenu ''UIMenuEditor new openOnClass: self andSelector: #clientSessionsMenu" ^#(#Menu #( #(#MenuItem #rawLabel: 'add' #value: #clientSessionAdd ) #(#MenuItem #rawLabel: 'close session' #value: #clientSessionClose ) #(#MenuItem #rawLabel: 'refresh sessions' #value: #clientSessionUpdate ) ) #(2 1 ) nil ) decodeAsLiteralArray! logoImage ''UIMaskEditor new openOnClass: self andSelector: #logoImage" ^CachedImage on: (Image extent: 32@32 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 15 255 255 240 15 255 255 240 15 255 255 240 15 255 255 240 0 0 0 240 0 0 0 240 0 0 0 240 3 128 0 240 3 128 0 240 3 159 224 240 3 159 224 240 3 128 96 240 3 128 96 240 3 128 96 240 3 128 96 240 3 128 96 240 3 128 96 240 3 128 0 240 3 128 0 240 3 255 248 240 3 255 248 240 3 255 248 240 0 0 0 240 0 0 0 240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])! serverObjectsMenu ''UIMenuEditor new openOnClass: self andSelector: #serverObjectsMenu" ^#(#Menu #( #(#MenuItem #rawLabel: 'add' #value: #serverRemoteObjectAdd ) #(#MenuItem #rawLabel: 'rename' #value: #serverRemoteObjectRename ) #(#MenuItem #rawLabel: 'remove' #value: #serverRemoteObjectRemove ) #(#MenuItem #rawLabel: 'change' #value: #serverRemoteObjectChange ) #(#MenuItem #rawLabel: 'browse' #value: #serverRemoteObjectBrowse ) #(#MenuItem #rawLabel: 'reset all' #value: #serverRemoteObjectReset ) ) #(5 1 ) nil ) decodeAsLiteralArray! ! !ORBConsole class methodsFor: 'initialize'! console: anObjectOrNil console := anObjectOrNil! initialize self open! ! !ORBConsole class methodsFor: 'ORB dependency'! logMessage: aString id: anId chunks: anInteger messageArray: anArray ''print log" | str | console isNil ifTrue: [^nil]. str := WriteStream on: String new. str nextPutAll: anId; nextPut: $[. anInteger printOn: str. str nextPut: $]; nextPut: $ ; nextPutAll: aString; nextPutAll: '> '. str nextPutAll: (ORB stringFromMessageArray: anArray). str close. console logMessage: str contents! logMessage: aString id: anId chunks: anInteger value: anObject ''print log" | str | console isNil ifTrue: [^nil]. str := WriteStream on: String new. str nextPutAll: anId; nextPut: $[. anInteger printOn: str. str nextPut: $]; nextPut: $ ; nextPutAll: aString; nextPutAll: '> '. anObject printOn: str. str close. console logMessage: str contents! logMessage: aString id: anId restProcesses: anInteger ''print log" | str | console isNil ifTrue: [^nil]. str := WriteStream on: String new. str nextPutAll: anId. str nextPut: $ ; nextPutAll: aString; nextPutAll: '> '. anInteger = 0 ifTrue: [str nextPutAll: 'server ready'] ifFalse: [anInteger printOn: str. str nextPutAll: ' processes waiting']. str close. console logMessage: str contents! ! ApplicationModel subclass: #ORBDialog instanceVariableNames: 'message result stringField symbolField numberField ' classVariableNames: '' poolDictionaries: '' category: 'RemoteObjects'! !ORBDialog methodsFor: 'aspects'! message ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^message isNil ifTrue: [message := String new asValue] ifFalse: [message]! numberField ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^numberField isNil ifTrue: [numberField := 0 asValue] ifFalse: [numberField]! result ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^result isNil ifTrue: [result := false asValue] ifFalse: [result]! stringField ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^stringField isNil ifTrue: [stringField := String new asValue] ifFalse: [stringField]! symbolField ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^symbolField isNil ifTrue: [symbolField := nil asValue] ifFalse: [symbolField]! ! !ORBDialog methodsFor: 'dialog methods'! closeNo result := false. self closeWindow! closeWindow self closeRequest! closeYes result := true. self closeWindow! result: anObject ''set the value of instance variable" result := anObject! ! ''-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ORBDialog class instanceVariableNames: ''! ================================================================== pub/Smalltalk/st80_vw/RemoteObjects/remoteobjects_example.st ================================================================== ApplicationModel subclass: #TranscriptWriter instanceVariableNames: 'messageField session ' classVariableNames: '' poolDictionaries: '' category: 'RemoteObjects_example'! !TranscriptWriter methodsFor: 'aspects'! messageField ''This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method.'' ^messageField isNil ifTrue: [messageField := String new asValue] ifFalse: [messageField]! ! !TranscriptWriter methodsFor: 'private - gui'! requestForWindowClose self closeSession. ^true! ! !TranscriptWriter methodsFor: 'actions'! closeSession session isNil ifFalse: [session close]. self builder window label: 'Transcript Writer'! connect | host number | self closeSession. host := Dialog request: 'host address...' initialAnswer: '???'. host isEmpty ifTrue: [^nil]. number := (Dialog request: 'port number...' initialAnswer: '6666') asNumber. number = 0 ifTrue: [^nil]. session := ORB newSessionWith: host port: number. self builder window label: 'Transcript Writer@' , host , ':' , number printString! send | object | session isNil ifTrue: [^Dialog warn: 'No session yet...']. object := RemoteObject named: #Transcript session: session. object cr; show: self messageField value. self messageField value: ''! ! ================================================================== pub/Smalltalk/st80_vw/RemoteObjects/image_ascursor.st ================================================================== '' NAME Image_asCursor AUTHOR Bernard Horan CONTRIBUTOR Bernard Horan FUNCTION Convert a Depth1Image into a Cursor ST-VERSIONS VisualWorks 2.0 PREREQUISITES CONFLICTS DISTRIBUTION world VERSION 1.0 DATE 3rd March 95 SUMMARY Used for AnimatedCursors''! ================================================================== pub/Smalltalk/st80_vw/RemoteObjects/object_fromuser.st ================================================================== 'From VisualWorks(R), Release 2.5.1 of September 26, 1995 on December 27, 1997 at 10:33:20 am'! !Object methodsFor: 'from user'! fromUser ^self fromUserLabeled: self printString , '?'! fromUserLabeled: aString | point screenWindows window result desiredClass | self isBehavior ifTrue: [desiredClass := self] ifFalse: [desiredClass := self class]. [true] whileTrue: [point := Cursor crossHair showWhile: [| text | text := aString asText allBold asComposedText. Screen default dragShape: text offset: text bounds center + (0 @ 16) gridPhase: 1 @ 1 gridSpacing: 1 @ 1 boundedBy: nil whileButton: 0 isDown: false]. screenWindows := Screen default stackedWindows reverse. window := screenWindows detect: [:each | (each displayBox containsPoint: point) & (each class ~~ Window)] ifNone: [nil]. window isNil ifFalse: [((result := window model origin) isKindOf: desiredClass) ifTrue: [^result] ifFalse: [^nil]]]! !