Platform-Services.st 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644
  1. Smalltalk createPackage: 'Platform-Services'!
  2. Object subclass: #ConsoleErrorHandler
  3. slots: {}
  4. package: 'Platform-Services'!
  5. !ConsoleErrorHandler commentStamp!
  6. I am manage Smalltalk errors, displaying the stack in the console.!
  7. !ConsoleErrorHandler methodsFor: 'error handling'!
  8. handleError: anError
  9. anError context ifNotNil: [ self logErrorContext: anError context ].
  10. self logError: anError
  11. ! !
  12. !ConsoleErrorHandler methodsFor: 'private'!
  13. log: aString
  14. console log: aString
  15. !
  16. logContext: aContext
  17. aContext home ifNotNil: [
  18. self logContext: aContext home ].
  19. self log: aContext asString
  20. !
  21. logError: anError
  22. self log: anError messageText
  23. !
  24. logErrorContext: aContext
  25. aContext ifNotNil: [
  26. aContext home ifNotNil: [
  27. self logContext: aContext home ]]
  28. ! !
  29. ConsoleErrorHandler class slots: {#current}!
  30. !ConsoleErrorHandler class methodsFor: 'initialization'!
  31. initialize
  32. ErrorHandler registerIfNone: self new
  33. ! !
  34. Object subclass: #ConsoleTranscript
  35. slots: {#textarea}
  36. package: 'Platform-Services'!
  37. !ConsoleTranscript commentStamp!
  38. I am a specific transcript emitting to the JavaScript console.
  39. If no other transcript is registered, I am the default.!
  40. !ConsoleTranscript methodsFor: 'actions'!
  41. open
  42. ! !
  43. !ConsoleTranscript methodsFor: 'printing'!
  44. clear
  45. "no op"
  46. !
  47. cr
  48. "no op"
  49. !
  50. show: anObject
  51. "Smalltalk objects should have no trouble displaying themselves on the Transcript; Javascript objects don't know how, so must be wrapped in a JSObectProxy."
  52. <inlineJS: 'console.log(String($recv(anObject)._asString()))'>
  53. ! !
  54. !ConsoleTranscript class methodsFor: 'initialization'!
  55. initialize
  56. Transcript registerIfNone: self new
  57. ! !
  58. Object subclass: #Environment
  59. slots: {}
  60. package: 'Platform-Services'!
  61. !Environment commentStamp!
  62. I provide an unified entry point to manipulate Amber packages, classes and methods.
  63. Typical use cases include IDEs, remote access and restricting browsing.!
  64. !Environment methodsFor: 'accessing'!
  65. allSelectors
  66. ^ Smalltalk core allSelectors
  67. !
  68. availableClassNames
  69. ^ Smalltalk classes
  70. collect: [ :each | each name ]
  71. !
  72. availablePackageNames
  73. ^ Smalltalk packages
  74. collect: [ :each | each name ]
  75. !
  76. availableProtocolsFor: aClass
  77. | protocols |
  78. protocols := aClass protocols.
  79. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ].
  80. ^ protocols asSet asArray sort
  81. !
  82. classBuilder
  83. ^ ClassBuilder new
  84. !
  85. classNamed: aString
  86. ^ (Smalltalk globals at: aString asSymbol)
  87. ifNil: [ self error: 'Invalid class name' ]
  88. !
  89. classes
  90. ^ Smalltalk classes
  91. !
  92. doItReceiver
  93. ^ DoIt new
  94. !
  95. packages
  96. ^ Smalltalk packages
  97. !
  98. systemAnnouncer
  99. ^ (Smalltalk globals at: #SystemAnnouncer) current
  100. ! !
  101. !Environment methodsFor: 'actions'!
  102. commitPackage: aPackage onSuccess: aBlock onError: anotherBlock
  103. aPackage transport
  104. commitOnSuccess: aBlock
  105. onError: anotherBlock
  106. !
  107. copyClass: aClass to: aClassName
  108. (Smalltalk globals at: aClassName)
  109. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  110. ClassBuilder new copyClass: aClass named: aClassName
  111. !
  112. inspect: anObject
  113. Inspector inspect: anObject
  114. !
  115. moveClass: aClass toPackage: aPackageName
  116. | package |
  117. package := Package named: aPackageName.
  118. package ifNil: [ self error: 'Invalid package name' ].
  119. package == aClass package ifTrue: [ ^ self ].
  120. aClass package: package.
  121. aClass recompile
  122. !
  123. moveMethod: aMethod toClass: aClassName
  124. | destinationClass |
  125. destinationClass := self classNamed: aClassName.
  126. destinationClass == aMethod origin ifTrue: [ ^ self ].
  127. aMethod origin isMetaclass ifTrue: [
  128. destinationClass := destinationClass theMetaClass ].
  129. destinationClass
  130. compile: aMethod source
  131. protocol: aMethod protocol.
  132. aMethod origin
  133. removeCompiledMethod: aMethod
  134. !
  135. moveMethod: aMethod toProtocol: aProtocol
  136. aMethod protocol: aProtocol.
  137. aMethod origin
  138. compile: aMethod source
  139. protocol: aMethod protocol
  140. !
  141. removeClass: aClass
  142. Smalltalk removeClass: aClass
  143. !
  144. removeMethod: aMethod
  145. aMethod origin removeCompiledMethod: aMethod
  146. !
  147. removeProtocol: aString from: aClass
  148. (aClass methodsInProtocol: aString)
  149. do: [ :each | aClass removeCompiledMethod: each ]
  150. !
  151. renameClass: aClass to: aClassName
  152. (Smalltalk globals at: aClassName)
  153. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  154. ClassBuilder new renameClass: aClass to: aClassName
  155. !
  156. renamePackage: aPackageName to: aNewPackageName
  157. Smalltalk renamePackage: aPackageName to: aNewPackageName
  158. !
  159. renameProtocol: aString to: anotherString in: aClass
  160. (aClass methodsInProtocol: aString)
  161. do: [ :each | each protocol: anotherString ]
  162. !
  163. setClassCommentOf: aClass to: aString
  164. aClass comment: aString
  165. ! !
  166. !Environment methodsFor: 'compiling'!
  167. addInstVarNamed: aString to: aClass
  168. | newInstVars |
  169. newInstVars := aClass instanceVariableNames copyWith: aString.
  170. aClass isMetaclass
  171. ifTrue: [ self classBuilder
  172. class: aClass slots: newInstVars ]
  173. ifFalse: [ self classBuilder
  174. addSubclassOf: aClass superclass
  175. named: aClass name
  176. instanceVariableNames: newInstVars
  177. package: aClass package name ]
  178. !
  179. compileClassComment: aString for: aClass
  180. aClass comment: aString
  181. !
  182. compileClassDefinition: aString
  183. [ self evaluate: aString for: DoIt new ]
  184. on: Error
  185. do: [ :error | Terminal alert: error messageText ]
  186. !
  187. compileMethod: sourceCode for: class protocol: protocol
  188. ^ class
  189. compile: sourceCode
  190. protocol: protocol
  191. ! !
  192. !Environment methodsFor: 'error handling'!
  193. evaluate: aBlock on: anErrorClass do: exceptionBlock
  194. "Evaluate a block and catch exceptions happening on the environment stack"
  195. ^ aBlock on: (self classNamed: anErrorClass name) do: exceptionBlock
  196. ! !
  197. !Environment methodsFor: 'evaluating'!
  198. evaluate: aString for: anObject
  199. ^ Evaluator evaluate: aString for: anObject
  200. ! !
  201. !Environment methodsFor: 'services'!
  202. registerErrorHandler: anErrorHandler
  203. ErrorHandler register: anErrorHandler
  204. !
  205. registerFinder: aFinder
  206. Finder register: aFinder
  207. !
  208. registerInspector: anInspector
  209. Inspector register: anInspector
  210. !
  211. registerProgressHandler: aProgressHandler
  212. ProgressHandler register: aProgressHandler
  213. !
  214. registerTranscript: aTranscript
  215. Transcript register: aTranscript
  216. ! !
  217. Object subclass: #NullProgressHandler
  218. slots: {}
  219. package: 'Platform-Services'!
  220. !NullProgressHandler commentStamp!
  221. I am the default progress handler. I do not display any progress, and simply iterate over the collection.!
  222. !NullProgressHandler methodsFor: 'progress handling'!
  223. do: aBlock on: aCollection displaying: aString
  224. aCollection do: aBlock
  225. ! !
  226. NullProgressHandler class slots: {#current}!
  227. !NullProgressHandler class methodsFor: 'initialization'!
  228. initialize
  229. ProgressHandler registerIfNone: self new
  230. ! !
  231. Object subclass: #Service
  232. slots: {}
  233. package: 'Platform-Services'!
  234. !Service commentStamp!
  235. I implement the basic behavior for class registration to a service.
  236. See the `Transcript` class for a concrete service.
  237. ## API
  238. Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.!
  239. Service class slots: {#current}!
  240. !Service class methodsFor: 'accessing'!
  241. current
  242. ^ current
  243. ! !
  244. !Service class methodsFor: 'instance creation'!
  245. new
  246. self shouldNotImplement
  247. ! !
  248. !Service class methodsFor: 'registration'!
  249. register: anObject
  250. current := anObject
  251. !
  252. registerIfNone: anObject
  253. self current ifNil: [ self register: anObject ]
  254. ! !
  255. Service subclass: #ErrorHandler
  256. slots: {}
  257. package: 'Platform-Services'!
  258. !ErrorHandler commentStamp!
  259. I am the service used to handle Smalltalk errors.
  260. See `boot.js` `handleError()` function.
  261. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.!
  262. !ErrorHandler class methodsFor: 'error handling'!
  263. handleError: anError
  264. | smalltalkError |
  265. smalltalkError := Smalltalk asSmalltalkException: anError.
  266. smalltalkError context ifNil: [ smalltalkError context: thisContext ].
  267. self handleUnhandledError: smalltalkError
  268. !
  269. handleUnhandledError: anError
  270. anError wasHandled ifFalse: [
  271. self current handleError: anError.
  272. anError beHandled ]
  273. ! !
  274. Service subclass: #Finder
  275. slots: {}
  276. package: 'Platform-Services'!
  277. !Finder commentStamp!
  278. I am the service responsible for finding classes/methods.
  279. __There is no default finder.__
  280. ## API
  281. Use `#browse` on an object to find it.!
  282. !Finder class methodsFor: 'finding'!
  283. findClass: aClass
  284. ^ self current findClass: aClass
  285. !
  286. findMethod: aCompiledMethod
  287. ^ self current findMethod: aCompiledMethod
  288. !
  289. findString: aString
  290. ^ self current findString: aString
  291. ! !
  292. Service subclass: #Inspector
  293. slots: {}
  294. package: 'Platform-Services'!
  295. !Inspector commentStamp!
  296. I am the service responsible for inspecting objects.
  297. The default inspector object is the transcript.!
  298. !Inspector class methodsFor: 'inspecting'!
  299. inspect: anObject
  300. ^ self current inspect: anObject
  301. ! !
  302. Service subclass: #Platform
  303. slots: {}
  304. package: 'Platform-Services'!
  305. !Platform commentStamp!
  306. I am bridge to JS environment.
  307. ## API
  308. Platform globals. "JS global object"
  309. Platform newXHR "new XMLHttpRequest() or its shim"!
  310. !Platform class methodsFor: 'accessing'!
  311. fetch: aStringOrObject
  312. ^ self current fetch: aStringOrObject
  313. !
  314. fetchUrl: aString options: anObject
  315. ^ self current fetchUrl: aString options: anObject
  316. !
  317. globals
  318. ^ self current globals
  319. !
  320. newXhr
  321. ^ self current newXhr
  322. ! !
  323. !Platform class methodsFor: 'testing'!
  324. includesGlobal: aString
  325. ^ self globals
  326. at: aString
  327. ifPresent: [ true ]
  328. ifAbsent: [ false ]
  329. ! !
  330. Service subclass: #ProgressHandler
  331. slots: {}
  332. package: 'Platform-Services'!
  333. !ProgressHandler commentStamp!
  334. I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`.
  335. Registered instances must implement `#do:on:displaying:`.
  336. The default behavior is to simply iterate over the collection, using `NullProgressHandler`.!
  337. !ProgressHandler class methodsFor: 'progress handling'!
  338. do: aBlock on: aCollection displaying: aString
  339. self current do: aBlock on: aCollection displaying: aString
  340. ! !
  341. Service subclass: #Terminal
  342. slots: {}
  343. package: 'Platform-Services'!
  344. !Terminal commentStamp!
  345. I am UI interface service.
  346. ## API
  347. Terminal alert: 'Hey, there is a problem'.
  348. Terminal confirm: 'Affirmative?'.
  349. Terminal prompt: 'Your name:'.!
  350. !Terminal class methodsFor: 'dialogs'!
  351. alert: aString
  352. ^ self current alert: aString
  353. !
  354. confirm: aString
  355. ^ self current confirm: aString
  356. !
  357. prompt: aString
  358. ^ self current prompt: aString
  359. !
  360. prompt: aString default: defaultString
  361. ^ self current prompt: aString default: defaultString
  362. ! !
  363. Service subclass: #Transcript
  364. slots: {}
  365. package: 'Platform-Services'!
  366. !Transcript commentStamp!
  367. I am a facade for Transcript actions.
  368. I delegate actions to the currently registered transcript.
  369. ## API
  370. Transcript
  371. show: 'hello world';
  372. cr;
  373. show: anObject.!
  374. !Transcript class methodsFor: 'instance creation'!
  375. open
  376. self current open
  377. ! !
  378. !Transcript class methodsFor: 'printing'!
  379. clear
  380. self current clear
  381. !
  382. cr
  383. self current show: String cr
  384. !
  385. inspect: anObject
  386. self show: anObject
  387. !
  388. show: anObject
  389. self current show: anObject
  390. ! !
  391. !AssociativeCollection methodsFor: '*Platform-Services'!
  392. inspectOn: anInspector
  393. | variables |
  394. variables := Array streamContents: [ :stream |
  395. stream
  396. nextPut: '#self' -> self;
  397. nextPut: '#keys' -> self keys;
  398. nextPutAll: self associations ].
  399. anInspector
  400. setLabel: self shortenedPrintString;
  401. setVariables: variables
  402. ! !
  403. !Collection methodsFor: '*Platform-Services'!
  404. inspectOn: anInspector
  405. | variables |
  406. variables := Array streamContents: [ :stream |
  407. | i |
  408. stream nextPut: '#self' -> self.
  409. i := 1.
  410. self do: [ :each |
  411. stream nextPut: i -> each.
  412. i := i + 1 ] ].
  413. anInspector
  414. setLabel: self shortenedPrintString;
  415. setVariables: variables
  416. ! !
  417. !Date methodsFor: '*Platform-Services'!
  418. inspectOn: anInspector
  419. | variables |
  420. variables := Array streamContents: [ :stream |
  421. stream
  422. nextPut: '#self' -> self;
  423. nextPut: '#year' -> self year;
  424. nextPut: '#month' -> self month;
  425. nextPut: '#day' -> self day;
  426. nextPut: '#hours' -> self hours;
  427. nextPut: '#minutes' -> self minutes;
  428. nextPut: '#seconds' -> self seconds;
  429. nextPut: '#milliseconds' -> self milliseconds ].
  430. anInspector
  431. setLabel: self printString;
  432. setVariables: variables
  433. ! !
  434. !JSObjectProxy methodsFor: '*Platform-Services'!
  435. inspectOn: anInspector
  436. | variables |
  437. variables := Array streamContents: [ :stream |
  438. stream
  439. nextPut: '#self' -> self jsObject;
  440. nextPutAll: (JSObjectProxy associationsOfProxy: self) ].
  441. anInspector setLabel: self printString.
  442. anInspector setVariables: variables
  443. ! !
  444. !Object methodsFor: '*Platform-Services'!
  445. inspectOn: anInspector
  446. | variables |
  447. variables := Array streamContents: [ :stream |
  448. stream nextPut: '#self' -> self.
  449. self class allInstanceVariableNames do: [ :each |
  450. stream nextPut: each -> (self instVarNamed: each) ] ].
  451. anInspector
  452. setLabel: self printString;
  453. setVariables: variables
  454. ! !
  455. !SequenceableCollection methodsFor: '*Platform-Services'!
  456. do: aBlock displayingProgress: aString
  457. ProgressHandler
  458. do: aBlock
  459. on: self
  460. displaying: aString
  461. !
  462. inspectOn: anInspector
  463. | variables |
  464. variables := Array streamContents: [ :stream |
  465. stream nextPut: '#self' -> self.
  466. self withIndexDo: [ :each :i |
  467. stream nextPut: i -> each ] ].
  468. anInspector
  469. setLabel: self shortenedPrintString;
  470. setVariables: variables
  471. ! !
  472. !TMethodContext methodsFor: '*Platform-Services'!
  473. inspectOn: anInspector
  474. | variables |
  475. variables := Array streamContents: [ :stream |
  476. stream
  477. nextPut: '#self' -> self;
  478. nextPut: '#home' -> self home;
  479. nextPut: '#receiver' -> self receiver;
  480. nextPut: '#selector' -> self selector;
  481. nextPut: '#locals' -> self locals.
  482. self class instanceVariableNames do: [ :each |
  483. stream nextPut: each -> (self instVarNamed: each) ] ].
  484. anInspector
  485. setLabel: self printString;
  486. setVariables: variables
  487. ! !