Platform-Services.st 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652
  1. Smalltalk createPackage: 'Platform-Services'!
  2. Object subclass: #ConsoleErrorHandler
  3. instanceVariableNames: ''
  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 instanceVariableNames: 'current'!
  30. !ConsoleErrorHandler class methodsFor: 'initialization'!
  31. initialize
  32. ErrorHandler registerIfNone: self new
  33. ! !
  34. Object subclass: #ConsoleTranscript
  35. instanceVariableNames: '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. instanceVariableNames: ''
  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 methodClass ifTrue: [ ^ self ].
  127. aMethod methodClass isMetaclass ifTrue: [
  128. destinationClass := destinationClass theMetaClass ].
  129. destinationClass
  130. compile: aMethod source
  131. protocol: aMethod protocol.
  132. aMethod methodClass
  133. removeCompiledMethod: aMethod
  134. !
  135. moveMethod: aMethod toProtocol: aProtocol
  136. aMethod protocol: aProtocol.
  137. aMethod methodClass
  138. compile: aMethod source
  139. protocol: aMethod protocol
  140. !
  141. removeClass: aClass
  142. Smalltalk removeClass: aClass
  143. !
  144. removeMethod: aMethod
  145. aMethod methodClass 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 instanceVariables: 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 tryCatch: [ :exception |
  196. (exception isKindOf: (self classNamed: anErrorClass name))
  197. ifTrue: [ exceptionBlock value: exception ]
  198. ifFalse: [ exception resignal ] ]
  199. ! !
  200. !Environment methodsFor: 'evaluating'!
  201. evaluate: aString for: anObject
  202. ^ Evaluator evaluate: aString for: anObject
  203. ! !
  204. !Environment methodsFor: 'services'!
  205. registerErrorHandler: anErrorHandler
  206. ErrorHandler register: anErrorHandler
  207. !
  208. registerFinder: aFinder
  209. Finder register: aFinder
  210. !
  211. registerInspector: anInspector
  212. Inspector register: anInspector
  213. !
  214. registerProgressHandler: aProgressHandler
  215. ProgressHandler register: aProgressHandler
  216. !
  217. registerTranscript: aTranscript
  218. Transcript register: aTranscript
  219. ! !
  220. Object subclass: #NullProgressHandler
  221. instanceVariableNames: ''
  222. package: 'Platform-Services'!
  223. !NullProgressHandler commentStamp!
  224. I am the default progress handler. I do not display any progress, and simply iterate over the collection.!
  225. !NullProgressHandler methodsFor: 'progress handling'!
  226. do: aBlock on: aCollection displaying: aString
  227. aCollection do: aBlock
  228. ! !
  229. NullProgressHandler class instanceVariableNames: 'current'!
  230. !NullProgressHandler class methodsFor: 'initialization'!
  231. initialize
  232. ProgressHandler registerIfNone: self new
  233. ! !
  234. Object subclass: #Service
  235. instanceVariableNames: ''
  236. package: 'Platform-Services'!
  237. !Service commentStamp!
  238. I implement the basic behavior for class registration to a service.
  239. See the `Transcript` class for a concrete service.
  240. ## API
  241. Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.!
  242. Service class instanceVariableNames: 'current'!
  243. !Service class methodsFor: 'accessing'!
  244. current
  245. ^ current
  246. ! !
  247. !Service class methodsFor: 'instance creation'!
  248. new
  249. self shouldNotImplement
  250. ! !
  251. !Service class methodsFor: 'registration'!
  252. register: anObject
  253. current := anObject
  254. !
  255. registerIfNone: anObject
  256. self current ifNil: [ self register: anObject ]
  257. ! !
  258. Service subclass: #ErrorHandler
  259. instanceVariableNames: ''
  260. package: 'Platform-Services'!
  261. !ErrorHandler commentStamp!
  262. I am the service used to handle Smalltalk errors.
  263. See `boot.js` `handleError()` function.
  264. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.!
  265. !ErrorHandler class methodsFor: 'error handling'!
  266. handleError: anError
  267. ([ anError isSmalltalkError ] tryCatch: [ false ])
  268. ifTrue: [ self handleUnhandledError: anError ]
  269. ifFalse: [
  270. | smalltalkError |
  271. smalltalkError := JavaScriptException on: anError.
  272. smalltalkError wrap.
  273. self handleUnhandledError: smalltalkError ]
  274. !
  275. handleUnhandledError: anError
  276. anError wasHandled ifFalse: [
  277. self current handleError: anError.
  278. anError beHandled ]
  279. ! !
  280. Service subclass: #Finder
  281. instanceVariableNames: ''
  282. package: 'Platform-Services'!
  283. !Finder commentStamp!
  284. I am the service responsible for finding classes/methods.
  285. __There is no default finder.__
  286. ## API
  287. Use `#browse` on an object to find it.!
  288. !Finder class methodsFor: 'finding'!
  289. findClass: aClass
  290. ^ self current findClass: aClass
  291. !
  292. findMethod: aCompiledMethod
  293. ^ self current findMethod: aCompiledMethod
  294. !
  295. findString: aString
  296. ^ self current findString: aString
  297. ! !
  298. Service subclass: #Inspector
  299. instanceVariableNames: ''
  300. package: 'Platform-Services'!
  301. !Inspector commentStamp!
  302. I am the service responsible for inspecting objects.
  303. The default inspector object is the transcript.!
  304. !Inspector class methodsFor: 'inspecting'!
  305. inspect: anObject
  306. ^ self current inspect: anObject
  307. ! !
  308. Service subclass: #Platform
  309. instanceVariableNames: ''
  310. package: 'Platform-Services'!
  311. !Platform commentStamp!
  312. I am bridge to JS environment.
  313. ## API
  314. Platform globals. "JS global object"
  315. Platform newXHR "new XMLHttpRequest() or its shim"!
  316. !Platform class methodsFor: 'accessing'!
  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. instanceVariableNames: ''
  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. instanceVariableNames: ''
  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. instanceVariableNames: ''
  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 := Dictionary new.
  395. variables at: '#self' put: self.
  396. variables at: '#keys' put: self keys.
  397. self keysAndValuesDo: [ :key :value |
  398. variables at: key put: value ].
  399. anInspector
  400. setLabel: self printString;
  401. setVariables: variables
  402. ! !
  403. !Collection methodsFor: '*Platform-Services'!
  404. inspectOn: anInspector
  405. | variables |
  406. variables := Dictionary new.
  407. variables at: '#self' put: self.
  408. self withIndexDo: [ :each :i |
  409. variables at: i put: each ].
  410. anInspector
  411. setLabel: self printString;
  412. setVariables: variables
  413. ! !
  414. !Date methodsFor: '*Platform-Services'!
  415. inspectOn: anInspector
  416. | variables |
  417. variables := Dictionary new.
  418. variables at: '#self' put: self.
  419. variables at: '#year' put: self year.
  420. variables at: '#month' put: self month.
  421. variables at: '#day' put: self day.
  422. variables at: '#hours' put: self hours.
  423. variables at: '#minutes' put: self minutes.
  424. variables at: '#seconds' put: self seconds.
  425. variables at: '#milliseconds' put: self milliseconds.
  426. anInspector
  427. setLabel: self printString;
  428. setVariables: variables
  429. ! !
  430. !JSObjectProxy methodsFor: '*Platform-Services'!
  431. inspectOn: anInspector
  432. | variables |
  433. variables := Dictionary new.
  434. variables at: '#self' put: self jsObject.
  435. anInspector setLabel: self printString.
  436. JSObjectProxy addObjectVariablesTo: variables ofProxy: self.
  437. anInspector setVariables: variables
  438. ! !
  439. !MethodContext methodsFor: '*Platform-Services'!
  440. inspectOn: anInspector
  441. | variables |
  442. variables := Dictionary new.
  443. variables at: '#self' put: self.
  444. variables at: '#home' put: self home.
  445. variables at: '#receiver' put: self receiver.
  446. variables at: '#selector' put: self selector.
  447. variables at: '#locals' put: self locals.
  448. self class instanceVariableNames do: [ :each |
  449. variables at: each put: (self instVarAt: each) ].
  450. anInspector
  451. setLabel: self printString;
  452. setVariables: variables
  453. ! !
  454. !Object methodsFor: '*Platform-Services'!
  455. inspectOn: anInspector
  456. | variables |
  457. variables := Dictionary new.
  458. variables at: '#self' put: self.
  459. self class allInstanceVariableNames do: [ :each |
  460. variables at: each put: (self instVarAt: each) ].
  461. anInspector
  462. setLabel: self printString;
  463. setVariables: variables
  464. ! !
  465. !SequenceableCollection methodsFor: '*Platform-Services'!
  466. do: aBlock displayingProgress: aString
  467. ProgressHandler
  468. do: aBlock
  469. on: self
  470. displaying: aString
  471. ! !
  472. !Set methodsFor: '*Platform-Services'!
  473. inspectOn: anInspector
  474. | variables i |
  475. variables := Dictionary new.
  476. variables at: '#self' put: self.
  477. i := 1.
  478. self do: [ :each |
  479. variables at: i put: each.
  480. i := i + 1 ].
  481. anInspector
  482. setLabel: self printString;
  483. setVariables: variables
  484. ! !
  485. !String methodsFor: '*Platform-Services'!
  486. inspectOn: anInspector
  487. | label |
  488. super inspectOn: anInspector.
  489. self printString size > 30
  490. ifTrue: [ label := (self printString copyFrom: 1 to: 30), '...''' ]
  491. ifFalse: [ label := self printString ].
  492. anInspector setLabel: label
  493. ! !