Platform-Services.st 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637
  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. self classBuilder
  169. addSubclassOf: aClass superclass
  170. named: aClass name
  171. instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  172. package: aClass package name
  173. !
  174. compileClassComment: aString for: aClass
  175. aClass comment: aString
  176. !
  177. compileClassDefinition: aString
  178. [ self evaluate: aString for: DoIt new ]
  179. on: Error
  180. do: [ :error | Terminal alert: error messageText ]
  181. !
  182. compileMethod: sourceCode for: class protocol: protocol
  183. ^ class
  184. compile: sourceCode
  185. protocol: protocol
  186. ! !
  187. !Environment methodsFor: 'error handling'!
  188. evaluate: aBlock on: anErrorClass do: exceptionBlock
  189. "Evaluate a block and catch exceptions happening on the environment stack"
  190. aBlock tryCatch: [ :exception |
  191. (exception isKindOf: (self classNamed: anErrorClass name))
  192. ifTrue: [ exceptionBlock value: exception ]
  193. ifFalse: [ exception resignal ] ]
  194. ! !
  195. !Environment methodsFor: 'evaluating'!
  196. evaluate: aString for: anObject
  197. ^ Evaluator evaluate: aString for: anObject
  198. ! !
  199. !Environment methodsFor: 'services'!
  200. registerErrorHandler: anErrorHandler
  201. ErrorHandler register: anErrorHandler
  202. !
  203. registerFinder: aFinder
  204. Finder register: aFinder
  205. !
  206. registerInspector: anInspector
  207. Inspector register: anInspector
  208. !
  209. registerProgressHandler: aProgressHandler
  210. ProgressHandler register: aProgressHandler
  211. !
  212. registerTranscript: aTranscript
  213. Transcript register: aTranscript
  214. ! !
  215. Object subclass: #NullProgressHandler
  216. instanceVariableNames: ''
  217. package: 'Platform-Services'!
  218. !NullProgressHandler commentStamp!
  219. I am the default progress handler. I do not display any progress, and simply iterate over the collection.!
  220. !NullProgressHandler methodsFor: 'progress handling'!
  221. do: aBlock on: aCollection displaying: aString
  222. aCollection do: aBlock
  223. ! !
  224. NullProgressHandler class instanceVariableNames: 'current'!
  225. !NullProgressHandler class methodsFor: 'initialization'!
  226. initialize
  227. ProgressHandler registerIfNone: self new
  228. ! !
  229. Object subclass: #Service
  230. instanceVariableNames: ''
  231. package: 'Platform-Services'!
  232. !Service commentStamp!
  233. I implement the basic behavior for class registration to a service.
  234. See the `Transcript` class for a concrete service.
  235. ## API
  236. Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.!
  237. Service class instanceVariableNames: 'current'!
  238. !Service class methodsFor: 'accessing'!
  239. current
  240. ^ current
  241. ! !
  242. !Service class methodsFor: 'instance creation'!
  243. new
  244. self shouldNotImplement
  245. ! !
  246. !Service class methodsFor: 'registration'!
  247. register: anObject
  248. current := anObject
  249. !
  250. registerIfNone: anObject
  251. self current ifNil: [ self register: anObject ]
  252. ! !
  253. Service subclass: #ErrorHandler
  254. instanceVariableNames: ''
  255. package: 'Platform-Services'!
  256. !ErrorHandler commentStamp!
  257. I am the service used to handle Smalltalk errors.
  258. See `boot.js` `handleError()` function.
  259. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.!
  260. !ErrorHandler class methodsFor: 'error handling'!
  261. handleError: anError
  262. ([ anError isSmalltalkError ] tryCatch: [ false ])
  263. ifTrue: [ self handleUnhandledError: anError ]
  264. ifFalse: [
  265. | smalltalkError |
  266. smalltalkError := JavaScriptException on: anError.
  267. smalltalkError wrap.
  268. self handleUnhandledError: smalltalkError ]
  269. !
  270. handleUnhandledError: anError
  271. anError wasHandled ifFalse: [
  272. self current handleError: anError.
  273. anError beHandled ]
  274. ! !
  275. Service subclass: #Finder
  276. instanceVariableNames: ''
  277. package: 'Platform-Services'!
  278. !Finder commentStamp!
  279. I am the service responsible for finding classes/methods.
  280. __There is no default finder.__
  281. ## API
  282. Use `#browse` on an object to find it.!
  283. !Finder class methodsFor: 'finding'!
  284. findClass: aClass
  285. ^ self current findClass: aClass
  286. !
  287. findMethod: aCompiledMethod
  288. ^ self current findMethod: aCompiledMethod
  289. !
  290. findString: aString
  291. ^ self current findString: aString
  292. ! !
  293. Service subclass: #Inspector
  294. instanceVariableNames: ''
  295. package: 'Platform-Services'!
  296. !Inspector commentStamp!
  297. I am the service responsible for inspecting objects.
  298. The default inspector object is the transcript.!
  299. !Inspector class methodsFor: 'inspecting'!
  300. inspect: anObject
  301. ^ self current inspect: anObject
  302. ! !
  303. Service subclass: #Platform
  304. instanceVariableNames: ''
  305. package: 'Platform-Services'!
  306. !Platform commentStamp!
  307. I am bridge to JS environment.
  308. ## API
  309. Platform globals. "JS global object"
  310. Platform newXHR "new XMLHttpRequest() or its shim"!
  311. !Platform class methodsFor: 'accessing'!
  312. globals
  313. ^ self current globals
  314. !
  315. newXhr
  316. ^ self current newXhr
  317. ! !
  318. Service subclass: #ProgressHandler
  319. instanceVariableNames: ''
  320. package: 'Platform-Services'!
  321. !ProgressHandler commentStamp!
  322. I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`.
  323. Registered instances must implement `#do:on:displaying:`.
  324. The default behavior is to simply iterate over the collection, using `NullProgressHandler`.!
  325. !ProgressHandler class methodsFor: 'progress handling'!
  326. do: aBlock on: aCollection displaying: aString
  327. self current do: aBlock on: aCollection displaying: aString
  328. ! !
  329. Service subclass: #Terminal
  330. instanceVariableNames: ''
  331. package: 'Platform-Services'!
  332. !Terminal commentStamp!
  333. I am UI interface service.
  334. ## API
  335. Terminal alert: 'Hey, there is a problem'.
  336. Terminal confirm: 'Affirmative?'.
  337. Terminal prompt: 'Your name:'.!
  338. !Terminal class methodsFor: 'dialogs'!
  339. alert: aString
  340. ^ self current alert: aString
  341. !
  342. confirm: aString
  343. ^ self current confirm: aString
  344. !
  345. prompt: aString
  346. ^ self current prompt: aString
  347. !
  348. prompt: aString default: defaultString
  349. ^ self current prompt: aString default: defaultString
  350. ! !
  351. Service subclass: #Transcript
  352. instanceVariableNames: ''
  353. package: 'Platform-Services'!
  354. !Transcript commentStamp!
  355. I am a facade for Transcript actions.
  356. I delegate actions to the currently registered transcript.
  357. ## API
  358. Transcript
  359. show: 'hello world';
  360. cr;
  361. show: anObject.!
  362. !Transcript class methodsFor: 'instance creation'!
  363. open
  364. self current open
  365. ! !
  366. !Transcript class methodsFor: 'printing'!
  367. clear
  368. self current clear
  369. !
  370. cr
  371. self current show: String cr
  372. !
  373. inspect: anObject
  374. self show: anObject
  375. !
  376. show: anObject
  377. self current show: anObject
  378. ! !
  379. !AssociativeCollection methodsFor: '*Platform-Services'!
  380. inspectOn: anInspector
  381. | variables |
  382. variables := Dictionary new.
  383. variables at: '#self' put: self.
  384. variables at: '#keys' put: self keys.
  385. self keysAndValuesDo: [ :key :value |
  386. variables at: key put: value ].
  387. anInspector
  388. setLabel: self printString;
  389. setVariables: variables
  390. ! !
  391. !Collection methodsFor: '*Platform-Services'!
  392. inspectOn: anInspector
  393. | variables |
  394. variables := Dictionary new.
  395. variables at: '#self' put: self.
  396. self withIndexDo: [ :each :i |
  397. variables at: i put: each ].
  398. anInspector
  399. setLabel: self printString;
  400. setVariables: variables
  401. ! !
  402. !Date methodsFor: '*Platform-Services'!
  403. inspectOn: anInspector
  404. | variables |
  405. variables := Dictionary new.
  406. variables at: '#self' put: self.
  407. variables at: '#year' put: self year.
  408. variables at: '#month' put: self month.
  409. variables at: '#day' put: self day.
  410. variables at: '#hours' put: self hours.
  411. variables at: '#minutes' put: self minutes.
  412. variables at: '#seconds' put: self seconds.
  413. variables at: '#milliseconds' put: self milliseconds.
  414. anInspector
  415. setLabel: self printString;
  416. setVariables: variables
  417. ! !
  418. !JSObjectProxy methodsFor: '*Platform-Services'!
  419. inspectOn: anInspector
  420. | variables |
  421. variables := Dictionary new.
  422. variables at: '#self' put: self jsObject.
  423. anInspector setLabel: self printString.
  424. JSObjectProxy addObjectVariablesTo: variables ofProxy: self.
  425. anInspector setVariables: variables
  426. ! !
  427. !MethodContext methodsFor: '*Platform-Services'!
  428. inspectOn: anInspector
  429. | variables |
  430. variables := Dictionary new.
  431. variables at: '#self' put: self.
  432. variables at: '#home' put: self home.
  433. variables at: '#receiver' put: self receiver.
  434. variables at: '#selector' put: self selector.
  435. variables at: '#locals' put: self locals.
  436. self class instanceVariableNames do: [ :each |
  437. variables at: each put: (self instVarAt: each) ].
  438. anInspector
  439. setLabel: self printString;
  440. setVariables: variables
  441. ! !
  442. !Object methodsFor: '*Platform-Services'!
  443. inspectOn: anInspector
  444. | variables |
  445. variables := Dictionary new.
  446. variables at: '#self' put: self.
  447. self class allInstanceVariableNames do: [ :each |
  448. variables at: each put: (self instVarAt: each) ].
  449. anInspector
  450. setLabel: self printString;
  451. setVariables: variables
  452. ! !
  453. !SequenceableCollection methodsFor: '*Platform-Services'!
  454. do: aBlock displayingProgress: aString
  455. ProgressHandler
  456. do: aBlock
  457. on: self
  458. displaying: aString
  459. ! !
  460. !Set methodsFor: '*Platform-Services'!
  461. inspectOn: anInspector
  462. | variables i |
  463. variables := Dictionary new.
  464. variables at: '#self' put: self.
  465. i := 1.
  466. self do: [ :each |
  467. variables at: i put: each.
  468. i := i + 1 ].
  469. anInspector
  470. setLabel: self printString;
  471. setVariables: variables
  472. ! !
  473. !String methodsFor: '*Platform-Services'!
  474. inspectOn: anInspector
  475. | label |
  476. super inspectOn: anInspector.
  477. self printString size > 30
  478. ifTrue: [ label := (self printString copyFrom: 1 to: 30), '...''' ]
  479. ifFalse: [ label := self printString ].
  480. anInspector setLabel: label
  481. ! !