Smalltalk createPackage: 'Platform-Services'! Object subclass: #ConsoleErrorHandler instanceVariableNames: '' package: 'Platform-Services'! !ConsoleErrorHandler commentStamp! I am manage Smalltalk errors, displaying the stack in the console.! !ConsoleErrorHandler methodsFor: 'error handling'! handleError: anError anError context ifNotNil: [ self logErrorContext: anError context ]. self logError: anError ! ! !ConsoleErrorHandler methodsFor: 'private'! log: aString console log: aString ! logContext: aContext aContext home ifNotNil: [ self logContext: aContext home ]. self log: aContext asString ! logError: anError self log: anError messageText ! logErrorContext: aContext aContext ifNotNil: [ aContext home ifNotNil: [ self logContext: aContext home ]] ! ! ConsoleErrorHandler class instanceVariableNames: 'current'! !ConsoleErrorHandler class methodsFor: 'initialization'! initialize ErrorHandler registerIfNone: self new ! ! Object subclass: #ConsoleTranscript instanceVariableNames: 'textarea' package: 'Platform-Services'! !ConsoleTranscript commentStamp! I am a specific transcript emitting to the JavaScript console. If no other transcript is registered, I am the default.! !ConsoleTranscript methodsFor: 'actions'! open ! ! !ConsoleTranscript methodsFor: 'printing'! clear "no op" ! cr "no op" ! show: anObject "Smalltalk objects should have no trouble displaying themselves on the Transcript; Javascript objects don't know how, so must be wrapped in a JSObectProxy." ! ! !ConsoleTranscript class methodsFor: 'initialization'! initialize Transcript registerIfNone: self new ! ! Object subclass: #InterfacingObject instanceVariableNames: '' package: 'Platform-Services'! !InterfacingObject commentStamp! I am superclass of all object that interface with user or environment. `Widget` and a few other classes are subclasses of me. I delegate all of the above APIs to `PlatformInterface`. ## API self alert: 'Hey, there is a problem'. self confirm: 'Affirmative?'. self prompt: 'Your name:'. self ajax: #{ 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script' }.! !InterfacingObject methodsFor: 'actions'! ajax: anObject ^ PlatformInterface ajax: anObject ! alert: aString ^ PlatformInterface alert: aString ! confirm: aString ^ PlatformInterface confirm: aString ! prompt: aString ^ PlatformInterface prompt: aString ! prompt: aString default: defaultString ^ PlatformInterface prompt: aString default: defaultString ! ! InterfacingObject subclass: #Environment instanceVariableNames: '' package: 'Platform-Services'! !Environment commentStamp! I provide an unified entry point to manipulate Amber packages, classes and methods. Typical use cases include IDEs, remote access and restricting browsing.! !Environment methodsFor: 'accessing'! allSelectors ^ Smalltalk core allSelectors ! availableClassNames ^ Smalltalk classes collect: [ :each | each name ] ! availablePackageNames ^ Smalltalk packages collect: [ :each | each name ] ! availableProtocolsFor: aClass | protocols | protocols := aClass protocols. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ]. ^ protocols asSet asArray sort ! classBuilder ^ ClassBuilder new ! classNamed: aString ^ (Smalltalk globals at: aString asSymbol) ifNil: [ self error: 'Invalid class name' ] ! classes ^ Smalltalk classes ! doItReceiver ^ DoIt new ! packages ^ Smalltalk packages ! systemAnnouncer ^ (Smalltalk globals at: #SystemAnnouncer) current ! ! !Environment methodsFor: 'actions'! commitPackage: aPackage onSuccess: aBlock onError: anotherBlock aPackage transport commitOnSuccess: aBlock onError: anotherBlock ! copyClass: aClass to: aClassName (Smalltalk globals at: aClassName) ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ]. ClassBuilder new copyClass: aClass named: aClassName ! inspect: anObject Inspector inspect: anObject ! moveClass: aClass toPackage: aPackageName | package | package := Package named: aPackageName. package ifNil: [ self error: 'Invalid package name' ]. package == aClass package ifTrue: [ ^ self ]. aClass package: package ! moveMethod: aMethod toClass: aClassName | destinationClass | destinationClass := self classNamed: aClassName. destinationClass == aMethod methodClass ifTrue: [ ^ self ]. aMethod methodClass isMetaclass ifTrue: [ destinationClass := destinationClass class ]. destinationClass compile: aMethod source protocol: aMethod protocol. aMethod methodClass removeCompiledMethod: aMethod ! moveMethod: aMethod toProtocol: aProtocol aMethod protocol: aProtocol ! removeClass: aClass Smalltalk removeClass: aClass ! removeMethod: aMethod aMethod methodClass removeCompiledMethod: aMethod ! removeProtocol: aString from: aClass (aClass methodsInProtocol: aString) do: [ :each | aClass removeCompiledMethod: each ] ! renameClass: aClass to: aClassName (Smalltalk globals at: aClassName) ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ]. ClassBuilder new renameClass: aClass to: aClassName ! renameProtocol: aString to: anotherString in: aClass (aClass methodsInProtocol: aString) do: [ :each | each protocol: anotherString ] ! setClassCommentOf: aClass to: aString aClass comment: aString ! ! !Environment methodsFor: 'compiling'! addInstVarNamed: aString to: aClass self classBuilder addSubclassOf: aClass superclass named: aClass name instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself) package: aClass package name ! compileClassComment: aString for: aClass aClass comment: aString ! compileClassDefinition: aString [ self evaluate: aString for: DoIt new ] on: Error do: [ :error | self alert: error messageText ] ! compileMethod: sourceCode for: class protocol: protocol ^ class compile: sourceCode protocol: protocol ! ! !Environment methodsFor: 'error handling'! evaluate: aBlock on: anErrorClass do: exceptionBlock "Evaluate a block and catch exceptions happening on the environment stack" aBlock tryCatch: [ :exception | (exception isKindOf: (self classNamed: anErrorClass name)) ifTrue: [ exceptionBlock value: exception ] ifFalse: [ exception resignal ] ] ! ! !Environment methodsFor: 'evaluating'! evaluate: aString for: anObject ^ Evaluator evaluate: aString for: anObject ! ! !Environment methodsFor: 'services'! registerErrorHandler: anErrorHandler ErrorHandler register: anErrorHandler ! registerFinder: aFinder Finder register: aFinder ! registerInspector: anInspector Inspector register: anInspector ! registerProgressHandler: aProgressHandler ProgressHandler register: aProgressHandler ! registerTranscript: aTranscript Transcript register: aTranscript ! ! Object subclass: #NullProgressHandler instanceVariableNames: '' package: 'Platform-Services'! !NullProgressHandler commentStamp! I am the default progress handler. I do not display any progress, and simply iterate over the collection.! !NullProgressHandler methodsFor: 'progress handling'! do: aBlock on: aCollection displaying: aString aCollection do: aBlock ! ! NullProgressHandler class instanceVariableNames: 'current'! !NullProgressHandler class methodsFor: 'initialization'! initialize ProgressHandler registerIfNone: self new ! ! Object subclass: #PlatformInterface instanceVariableNames: '' package: 'Platform-Services'! !PlatformInterface commentStamp! I am single entry point to UI and environment interface. My `initialize` tries several options (for now, browser environment only) to set myself up. ## API PlatformInterface alert: 'Hey, there is a problem'. PlatformInterface confirm: 'Affirmative?'. PlatformInterface prompt: 'Your name:'. PlatformInterface ajax: #{ 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script' }.! PlatformInterface class instanceVariableNames: 'worker'! !PlatformInterface class methodsFor: 'accessing'! globals ! setWorker: anObject worker := anObject ! ! !PlatformInterface class methodsFor: 'actions'! ajax: anObject ^ worker ifNotNil: [ worker ajax: anObject ] ifNil: [ self error: 'ajax: not available' ] ! alert: aString ^ worker ifNotNil: [ worker alert: aString ] ifNil: [ self error: 'alert: not available' ] ! confirm: aString ^ worker ifNotNil: [ worker confirm: aString ] ifNil: [ self error: 'confirm: not available' ] ! existsGlobal: aString ^ PlatformInterface globals at: aString ifPresent: [ true ] ifAbsent: [ false ] ! prompt: aString ^ worker ifNotNil: [ worker prompt: aString ] ifNil: [ self error: 'prompt: not available' ] ! prompt: aString default: defaultString ^ worker ifNotNil: [ worker prompt: aString default: defaultString ] ifNil: [ self error: 'prompt: not available' ] ! ! !PlatformInterface class methodsFor: 'initialization'! initialize | candidate | super initialize. BrowserInterface ifNotNil: [ candidate := BrowserInterface new. candidate isAvailable ifTrue: [ self setWorker: candidate. ^ self ] ] ! ! Object subclass: #Service instanceVariableNames: '' package: 'Platform-Services'! !Service commentStamp! I implement the basic behavior for class registration to a service. See the `Transcript` class for a concrete service. ## API Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.! Service class instanceVariableNames: 'current'! !Service class methodsFor: 'accessing'! current ^ current ! ! !Service class methodsFor: 'instance creation'! new self shouldNotImplement ! ! !Service class methodsFor: 'registration'! register: anObject current := anObject ! registerIfNone: anObject self current ifNil: [ self register: anObject ] ! ! Service subclass: #ErrorHandler instanceVariableNames: '' package: 'Platform-Services'! !ErrorHandler commentStamp! I am the service used to handle Smalltalk errors. See `boot.js` `handleError()` function. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.! !ErrorHandler class methodsFor: 'error handling'! handleError: anError self handleUnhandledError: anError ! handleUnhandledError: anError anError wasHandled ifTrue: [ ^ self ]. ^ self current handleError: anError ! ! Service subclass: #Finder instanceVariableNames: '' package: 'Platform-Services'! !Finder commentStamp! I am the service responsible for finding classes/methods. __There is no default finder.__ ## API Use `#browse` on an object to find it.! !Finder class methodsFor: 'finding'! findClass: aClass ^ self current findClass: aClass ! findMethod: aCompiledMethod ^ self current findMethod: aCompiledMethod ! findString: aString ^ self current findString: aString ! ! Service subclass: #Inspector instanceVariableNames: '' package: 'Platform-Services'! !Inspector commentStamp! I am the service responsible for inspecting objects. The default inspector object is the transcript.! !Inspector class methodsFor: 'inspecting'! inspect: anObject ^ self current inspect: anObject ! ! Service subclass: #ProgressHandler instanceVariableNames: '' package: 'Platform-Services'! !ProgressHandler commentStamp! I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`. Registered instances must implement `#do:on:displaying:`. The default behavior is to simply iterate over the collection, using `NullProgressHandler`.! !ProgressHandler class methodsFor: 'progress handling'! do: aBlock on: aCollection displaying: aString self current do: aBlock on: aCollection displaying: aString ! ! Service subclass: #Transcript instanceVariableNames: '' package: 'Platform-Services'! !Transcript commentStamp! I am a facade for Transcript actions. I delegate actions to the currently registered transcript. ## API Transcript show: 'hello world'; cr; show: anObject.! !Transcript class methodsFor: 'instance creation'! open self current open ! ! !Transcript class methodsFor: 'printing'! clear self current clear ! cr self current show: String cr ! inspect: anObject self show: anObject ! show: anObject self current show: anObject ! ! !SequenceableCollection methodsFor: '*Platform-Services'! do: aBlock displayingProgress: aString ProgressHandler do: aBlock on: self displaying: aString ! !