2
0

Platform-Services.st 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722
  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. <console.log(String($recv(anObject)._asString()))>
  53. ! !
  54. !ConsoleTranscript class methodsFor: 'initialization'!
  55. initialize
  56. Transcript registerIfNone: self new
  57. ! !
  58. Object subclass: #InterfacingObject
  59. instanceVariableNames: ''
  60. package: 'Platform-Services'!
  61. !InterfacingObject commentStamp!
  62. 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`.
  63. ## API
  64. self alert: 'Hey, there is a problem'.
  65. self confirm: 'Affirmative?'.
  66. self prompt: 'Your name:'.
  67. self ajax: #{
  68. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  69. }.!
  70. !InterfacingObject methodsFor: 'actions'!
  71. ajax: anObject
  72. self deprecatedAPI.
  73. ^ PlatformInterface ajax: anObject
  74. !
  75. alert: aString
  76. ^ Terminal alert: aString
  77. !
  78. confirm: aString
  79. ^ Terminal confirm: aString
  80. !
  81. prompt: aString
  82. ^ Terminal prompt: aString
  83. !
  84. prompt: aString default: defaultString
  85. ^ Terminal prompt: aString default: defaultString
  86. ! !
  87. InterfacingObject subclass: #Environment
  88. instanceVariableNames: ''
  89. package: 'Platform-Services'!
  90. !Environment commentStamp!
  91. I provide an unified entry point to manipulate Amber packages, classes and methods.
  92. Typical use cases include IDEs, remote access and restricting browsing.!
  93. !Environment methodsFor: 'accessing'!
  94. allSelectors
  95. ^ Smalltalk core allSelectors
  96. !
  97. availableClassNames
  98. ^ Smalltalk classes
  99. collect: [ :each | each name ]
  100. !
  101. availablePackageNames
  102. ^ Smalltalk packages
  103. collect: [ :each | each name ]
  104. !
  105. availableProtocolsFor: aClass
  106. | protocols |
  107. protocols := aClass protocols.
  108. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ].
  109. ^ protocols asSet asArray sort
  110. !
  111. classBuilder
  112. ^ ClassBuilder new
  113. !
  114. classNamed: aString
  115. ^ (Smalltalk globals at: aString asSymbol)
  116. ifNil: [ self error: 'Invalid class name' ]
  117. !
  118. classes
  119. ^ Smalltalk classes
  120. !
  121. doItReceiver
  122. ^ DoIt new
  123. !
  124. packages
  125. ^ Smalltalk packages
  126. !
  127. systemAnnouncer
  128. ^ (Smalltalk globals at: #SystemAnnouncer) current
  129. ! !
  130. !Environment methodsFor: 'actions'!
  131. commitPackage: aPackage onSuccess: aBlock onError: anotherBlock
  132. aPackage transport
  133. commitOnSuccess: aBlock
  134. onError: anotherBlock
  135. !
  136. copyClass: aClass to: aClassName
  137. (Smalltalk globals at: aClassName)
  138. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  139. ClassBuilder new copyClass: aClass named: aClassName
  140. !
  141. inspect: anObject
  142. Inspector inspect: anObject
  143. !
  144. moveClass: aClass toPackage: aPackageName
  145. | package |
  146. package := Package named: aPackageName.
  147. package ifNil: [ self error: 'Invalid package name' ].
  148. package == aClass package ifTrue: [ ^ self ].
  149. aClass package: package
  150. !
  151. moveMethod: aMethod toClass: aClassName
  152. | destinationClass |
  153. destinationClass := self classNamed: aClassName.
  154. destinationClass == aMethod methodClass ifTrue: [ ^ self ].
  155. aMethod methodClass isMetaclass ifTrue: [
  156. destinationClass := destinationClass class ].
  157. destinationClass
  158. compile: aMethod source
  159. protocol: aMethod protocol.
  160. aMethod methodClass
  161. removeCompiledMethod: aMethod
  162. !
  163. moveMethod: aMethod toProtocol: aProtocol
  164. aMethod protocol: aProtocol
  165. !
  166. removeClass: aClass
  167. Smalltalk removeClass: aClass
  168. !
  169. removeMethod: aMethod
  170. aMethod methodClass removeCompiledMethod: aMethod
  171. !
  172. removeProtocol: aString from: aClass
  173. (aClass methodsInProtocol: aString)
  174. do: [ :each | aClass removeCompiledMethod: each ]
  175. !
  176. renameClass: aClass to: aClassName
  177. (Smalltalk globals at: aClassName)
  178. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  179. ClassBuilder new renameClass: aClass to: aClassName
  180. !
  181. renamePackage: aPackageName to: aNewPackageName
  182. (Smalltalk globals at: aNewPackageName)
  183. ifNotNil: [ self error: 'A package named ', aNewPackageName, ' already exists' ].
  184. Smalltalk renamePackage: aPackageName to: aNewPackageName
  185. !
  186. renameProtocol: aString to: anotherString in: aClass
  187. (aClass methodsInProtocol: aString)
  188. do: [ :each | each protocol: anotherString ]
  189. !
  190. setClassCommentOf: aClass to: aString
  191. aClass comment: aString
  192. ! !
  193. !Environment methodsFor: 'compiling'!
  194. addInstVarNamed: aString to: aClass
  195. self classBuilder
  196. addSubclassOf: aClass superclass
  197. named: aClass name
  198. instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  199. package: aClass package name
  200. !
  201. compileClassComment: aString for: aClass
  202. aClass comment: aString
  203. !
  204. compileClassDefinition: aString
  205. [ self evaluate: aString for: DoIt new ]
  206. on: Error
  207. do: [ :error | self alert: error messageText ]
  208. !
  209. compileMethod: sourceCode for: class protocol: protocol
  210. ^ class
  211. compile: sourceCode
  212. protocol: protocol
  213. ! !
  214. !Environment methodsFor: 'error handling'!
  215. evaluate: aBlock on: anErrorClass do: exceptionBlock
  216. "Evaluate a block and catch exceptions happening on the environment stack"
  217. aBlock tryCatch: [ :exception |
  218. (exception isKindOf: (self classNamed: anErrorClass name))
  219. ifTrue: [ exceptionBlock value: exception ]
  220. ifFalse: [ exception resignal ] ]
  221. ! !
  222. !Environment methodsFor: 'evaluating'!
  223. evaluate: aString for: anObject
  224. ^ Evaluator evaluate: aString for: anObject
  225. ! !
  226. !Environment methodsFor: 'services'!
  227. registerErrorHandler: anErrorHandler
  228. ErrorHandler register: anErrorHandler
  229. !
  230. registerFinder: aFinder
  231. Finder register: aFinder
  232. !
  233. registerInspector: anInspector
  234. Inspector register: anInspector
  235. !
  236. registerProgressHandler: aProgressHandler
  237. ProgressHandler register: aProgressHandler
  238. !
  239. registerTranscript: aTranscript
  240. Transcript register: aTranscript
  241. ! !
  242. Object subclass: #NullProgressHandler
  243. instanceVariableNames: ''
  244. package: 'Platform-Services'!
  245. !NullProgressHandler commentStamp!
  246. I am the default progress handler. I do not display any progress, and simply iterate over the collection.!
  247. !NullProgressHandler methodsFor: 'progress handling'!
  248. do: aBlock on: aCollection displaying: aString
  249. aCollection do: aBlock
  250. ! !
  251. NullProgressHandler class instanceVariableNames: 'current'!
  252. !NullProgressHandler class methodsFor: 'initialization'!
  253. initialize
  254. ProgressHandler registerIfNone: self new
  255. ! !
  256. Object subclass: #PlatformInterface
  257. instanceVariableNames: ''
  258. package: 'Platform-Services'!
  259. !PlatformInterface commentStamp!
  260. Deprecated. Use `Platform` or `Terminal`.!
  261. !PlatformInterface class methodsFor: 'accessing'!
  262. globals
  263. self deprecatedAPI: 'Use Platform globals'.
  264. ^ Platform globals
  265. ! !
  266. !PlatformInterface class methodsFor: 'actions'!
  267. ajax: anObject
  268. self deprecatedAPI: 'Use Platform newXhr or dedicated library.'.
  269. ^ JQuery
  270. ifNotNil: [ JQuery current ajax: anObject ]
  271. ifNil: [ self error: 'JQuery wrapper not loaded, cannot do AJAX.' ]
  272. !
  273. alert: aString
  274. self deprecatedAPI: 'Use Terminal alert:'.
  275. ^ Terminal alert: aString
  276. !
  277. confirm: aString
  278. self deprecatedAPI: 'Use Terminal confirm:'.
  279. ^ Terminal confirm: aString
  280. !
  281. existsGlobal: aString
  282. self deprecatedAPI: 'Use Smalltalk existsJsGlobal:'.
  283. ^ PlatformInterface globals
  284. at: aString
  285. ifPresent: [ true ]
  286. ifAbsent: [ false ]
  287. !
  288. newXhr
  289. self deprecatedAPI: 'Use Platform newXhr'.
  290. ^ Platform newXhr
  291. !
  292. prompt: aString
  293. self deprecatedAPI: 'Use Terminal prompt:'.
  294. ^ Terminal prompt: aString
  295. !
  296. prompt: aString default: defaultString
  297. self deprecatedAPI: 'Use Terminal prompt:default:'.
  298. ^ Terminal prompt: aString default: defaultString
  299. ! !
  300. Object subclass: #Service
  301. instanceVariableNames: ''
  302. package: 'Platform-Services'!
  303. !Service commentStamp!
  304. I implement the basic behavior for class registration to a service.
  305. See the `Transcript` class for a concrete service.
  306. ## API
  307. Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.!
  308. Service class instanceVariableNames: 'current'!
  309. !Service class methodsFor: 'accessing'!
  310. current
  311. ^ current
  312. ! !
  313. !Service class methodsFor: 'instance creation'!
  314. new
  315. self shouldNotImplement
  316. ! !
  317. !Service class methodsFor: 'registration'!
  318. register: anObject
  319. current := anObject
  320. !
  321. registerIfNone: anObject
  322. self current ifNil: [ self register: anObject ]
  323. ! !
  324. Service subclass: #ErrorHandler
  325. instanceVariableNames: ''
  326. package: 'Platform-Services'!
  327. !ErrorHandler commentStamp!
  328. I am the service used to handle Smalltalk errors.
  329. See `boot.js` `handleError()` function.
  330. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.!
  331. !ErrorHandler class methodsFor: 'error handling'!
  332. handleError: anError
  333. self handleUnhandledError: anError
  334. !
  335. handleUnhandledError: anError
  336. anError wasHandled ifTrue: [ ^ self ].
  337. ^ self current handleError: anError
  338. ! !
  339. Service subclass: #Finder
  340. instanceVariableNames: ''
  341. package: 'Platform-Services'!
  342. !Finder commentStamp!
  343. I am the service responsible for finding classes/methods.
  344. __There is no default finder.__
  345. ## API
  346. Use `#browse` on an object to find it.!
  347. !Finder class methodsFor: 'finding'!
  348. findClass: aClass
  349. ^ self current findClass: aClass
  350. !
  351. findMethod: aCompiledMethod
  352. ^ self current findMethod: aCompiledMethod
  353. !
  354. findString: aString
  355. ^ self current findString: aString
  356. ! !
  357. Service subclass: #Inspector
  358. instanceVariableNames: ''
  359. package: 'Platform-Services'!
  360. !Inspector commentStamp!
  361. I am the service responsible for inspecting objects.
  362. The default inspector object is the transcript.!
  363. !Inspector class methodsFor: 'inspecting'!
  364. inspect: anObject
  365. ^ self current inspect: anObject
  366. ! !
  367. Service subclass: #Platform
  368. instanceVariableNames: ''
  369. package: 'Platform-Services'!
  370. !Platform commentStamp!
  371. I am bridge to JS environment.
  372. ## API
  373. Platform globals. "JS global object"
  374. Platform newXHR "new XMLHttpRequest() or its shim"!
  375. !Platform class methodsFor: 'accessing'!
  376. globals
  377. ^ self current globals
  378. !
  379. newXhr
  380. ^ self current newXhr
  381. ! !
  382. Service subclass: #ProgressHandler
  383. instanceVariableNames: ''
  384. package: 'Platform-Services'!
  385. !ProgressHandler commentStamp!
  386. I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`.
  387. Registered instances must implement `#do:on:displaying:`.
  388. The default behavior is to simply iterate over the collection, using `NullProgressHandler`.!
  389. !ProgressHandler class methodsFor: 'progress handling'!
  390. do: aBlock on: aCollection displaying: aString
  391. self current do: aBlock on: aCollection displaying: aString
  392. ! !
  393. Service subclass: #Terminal
  394. instanceVariableNames: ''
  395. package: 'Platform-Services'!
  396. !Terminal commentStamp!
  397. I am UI interface service.
  398. ## API
  399. Terminal alert: 'Hey, there is a problem'.
  400. Terminal confirm: 'Affirmative?'.
  401. Terminal prompt: 'Your name:'.!
  402. !Terminal class methodsFor: 'dialogs'!
  403. alert: aString
  404. ^ self current alert: aString
  405. !
  406. confirm: aString
  407. ^ self current confirm: aString
  408. !
  409. prompt: aString
  410. ^ self current prompt: aString
  411. !
  412. prompt: aString default: defaultString
  413. ^ self current prompt: aString default: defaultString
  414. ! !
  415. Service subclass: #Transcript
  416. instanceVariableNames: ''
  417. package: 'Platform-Services'!
  418. !Transcript commentStamp!
  419. I am a facade for Transcript actions.
  420. I delegate actions to the currently registered transcript.
  421. ## API
  422. Transcript
  423. show: 'hello world';
  424. cr;
  425. show: anObject.!
  426. !Transcript class methodsFor: 'instance creation'!
  427. open
  428. self current open
  429. ! !
  430. !Transcript class methodsFor: 'printing'!
  431. clear
  432. self current clear
  433. !
  434. cr
  435. self current show: String cr
  436. !
  437. inspect: anObject
  438. self show: anObject
  439. !
  440. show: anObject
  441. self current show: anObject
  442. ! !
  443. !AssociativeCollection methodsFor: '*Platform-Services'!
  444. inspectOn: anInspector
  445. | variables |
  446. variables := Dictionary new.
  447. variables at: '#self' put: self.
  448. variables at: '#keys' put: self keys.
  449. self keysAndValuesDo: [ :key :value |
  450. variables at: key put: value ].
  451. anInspector
  452. setLabel: self printString;
  453. setVariables: variables
  454. ! !
  455. !Collection methodsFor: '*Platform-Services'!
  456. inspectOn: anInspector
  457. | variables |
  458. variables := Dictionary new.
  459. variables at: '#self' put: self.
  460. self withIndexDo: [ :each :i |
  461. variables at: i put: each ].
  462. anInspector
  463. setLabel: self printString;
  464. setVariables: variables
  465. ! !
  466. !Date methodsFor: '*Platform-Services'!
  467. inspectOn: anInspector
  468. | variables |
  469. variables := Dictionary new.
  470. variables at: '#self' put: self.
  471. variables at: '#year' put: self year.
  472. variables at: '#month' put: self month.
  473. variables at: '#day' put: self day.
  474. variables at: '#hours' put: self hours.
  475. variables at: '#minutes' put: self minutes.
  476. variables at: '#seconds' put: self seconds.
  477. variables at: '#milliseconds' put: self milliseconds.
  478. anInspector
  479. setLabel: self printString;
  480. setVariables: variables
  481. ! !
  482. !JSObjectProxy methodsFor: '*Platform-Services'!
  483. inspectOn: anInspector
  484. | variables |
  485. variables := Dictionary new.
  486. variables at: '#self' put: self jsObject.
  487. anInspector setLabel: self printString.
  488. JSObjectProxy addObjectVariablesTo: variables ofProxy: self.
  489. anInspector setVariables: variables
  490. ! !
  491. !MethodContext methodsFor: '*Platform-Services'!
  492. inspectOn: anInspector
  493. | variables |
  494. variables := Dictionary new.
  495. variables at: '#self' put: self.
  496. variables at: '#home' put: self home.
  497. variables at: '#receiver' put: self receiver.
  498. variables at: '#selector' put: self selector.
  499. variables at: '#locals' put: self locals.
  500. self class instanceVariableNames do: [ :each |
  501. variables at: each put: (self instVarAt: each) ].
  502. anInspector
  503. setLabel: self printString;
  504. setVariables: variables
  505. ! !
  506. !Object methodsFor: '*Platform-Services'!
  507. inspectOn: anInspector
  508. | variables |
  509. variables := Dictionary new.
  510. variables at: '#self' put: self.
  511. self class allInstanceVariableNames do: [ :each |
  512. variables at: each put: (self instVarAt: each) ].
  513. anInspector
  514. setLabel: self printString;
  515. setVariables: variables
  516. ! !
  517. !SequenceableCollection methodsFor: '*Platform-Services'!
  518. do: aBlock displayingProgress: aString
  519. ProgressHandler
  520. do: aBlock
  521. on: self
  522. displaying: aString
  523. ! !
  524. !Set methodsFor: '*Platform-Services'!
  525. inspectOn: anInspector
  526. | variables i |
  527. variables := Dictionary new.
  528. variables at: '#self' put: self.
  529. i := 1.
  530. self do: [ :each |
  531. variables at: i put: each.
  532. i := i + 1 ].
  533. anInspector
  534. setLabel: self printString;
  535. setVariables: variables
  536. ! !
  537. !String methodsFor: '*Platform-Services'!
  538. inspectOn: anInspector
  539. | label |
  540. super inspectOn: anInspector.
  541. self printString size > 30
  542. ifTrue: [ label := (self printString copyFrom: 1 to: 30), '...''' ]
  543. ifFalse: [ label := self printString ].
  544. anInspector setLabel: label
  545. ! !