Platform-Services.st 14 KB

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