Kernel-Infrastructure.st 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170
  1. Smalltalk createPackage: 'Kernel-Infrastructure'!
  2. Object subclass: #ConsoleErrorHandler
  3. instanceVariableNames: ''
  4. package: 'Kernel-Infrastructure'!
  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: #InterfacingObject
  35. instanceVariableNames: ''
  36. package: 'Kernel-Infrastructure'!
  37. !InterfacingObject commentStamp!
  38. 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`.
  39. ## API
  40. self alert: 'Hey, there is a problem'.
  41. self confirm: 'Affirmative?'.
  42. self prompt: 'Your name:'.
  43. self ajax: #{
  44. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  45. }.!
  46. !InterfacingObject methodsFor: 'actions'!
  47. ajax: anObject
  48. ^ PlatformInterface ajax: anObject
  49. !
  50. alert: aString
  51. ^ PlatformInterface alert: aString
  52. !
  53. confirm: aString
  54. ^ PlatformInterface confirm: aString
  55. !
  56. prompt: aString
  57. ^ PlatformInterface prompt: aString
  58. ! !
  59. InterfacingObject subclass: #Environment
  60. instanceVariableNames: ''
  61. package: 'Kernel-Infrastructure'!
  62. !Environment commentStamp!
  63. I provide an unified entry point to manipulate Amber packages, classes and methods.
  64. Typical use cases include IDEs, remote access and restricting browsing.!
  65. !Environment methodsFor: 'accessing'!
  66. allSelectors
  67. ^ Smalltalk vm allSelectors
  68. !
  69. availableClassNames
  70. ^ Smalltalk classes
  71. collect: [ :each | each name ]
  72. !
  73. availablePackageNames
  74. ^ Smalltalk packages
  75. collect: [ :each | each name ]
  76. !
  77. availableProtocolsFor: aClass
  78. | protocols |
  79. protocols := aClass protocols.
  80. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ].
  81. ^ protocols asSet asArray sort
  82. !
  83. classBuilder
  84. ^ ClassBuilder new
  85. !
  86. classNamed: aString
  87. ^ (Smalltalk globals at: aString asSymbol)
  88. ifNil: [ self error: 'Invalid class name' ]
  89. !
  90. classes
  91. ^ Smalltalk classes
  92. !
  93. doItReceiver
  94. ^ DoIt new
  95. !
  96. packages
  97. ^ Smalltalk packages
  98. !
  99. systemAnnouncer
  100. ^ (Smalltalk globals at: #SystemAnnouncer) current
  101. ! !
  102. !Environment methodsFor: 'actions'!
  103. commitPackage: aPackage
  104. aPackage commit
  105. !
  106. copyClass: aClass to: aClassName
  107. (Smalltalk globals at: aClassName)
  108. ifNotNil: [ self error: 'A class named ', aClassName, ' already exists' ].
  109. ClassBuilder new copyClass: aClass named: aClassName
  110. !
  111. eval: aString on: aReceiver
  112. | compiler |
  113. compiler := Compiler new.
  114. [ compiler parseExpression: aString ] on: Error do: [ :ex |
  115. ^ self alert: ex messageText ].
  116. ^ compiler evaluateExpression: aString on: aReceiver
  117. !
  118. inspect: anObject
  119. Inspector inspect: anObject
  120. !
  121. moveClass: aClass toPackage: aPackageName
  122. | package |
  123. package := Package named: aPackageName.
  124. package ifNil: [ self error: 'Invalid package name' ].
  125. package == aClass package ifTrue: [ ^ self ].
  126. aClass package: package
  127. !
  128. moveMethod: aMethod toClass: aClassName
  129. | destinationClass |
  130. destinationClass := self classNamed: aClassName.
  131. destinationClass == aMethod methodClass ifTrue: [ ^ self ].
  132. destinationClass
  133. compile: aMethod source
  134. protocol: aMethod protocol.
  135. aMethod methodClass
  136. removeCompiledMethod: aMethod
  137. !
  138. moveMethod: aMethod toProtocol: aProtocol
  139. aMethod protocol: aProtocol
  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. renameProtocol: aString to: anotherString in: aClass
  157. (aClass methodsInProtocol: aString)
  158. do: [ :each | each protocol: anotherString ]
  159. !
  160. setClassCommentOf: aClass to: aString
  161. aClass comment: aString
  162. ! !
  163. !Environment methodsFor: 'compiling'!
  164. addInstVarNamed: aString to: aClass
  165. self classBuilder
  166. addSubclassOf: aClass superclass
  167. named: aClass name
  168. instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  169. package: aClass package name
  170. !
  171. compileClassComment: aString for: aClass
  172. aClass comment: aString
  173. !
  174. compileClassDefinition: aString
  175. [ self eval: aString on: DoIt new ]
  176. on: Error
  177. do: [ :error | self alert: error messageText ]
  178. !
  179. compileMethod: sourceCode for: class protocol: protocol
  180. ^ class
  181. compile: sourceCode
  182. protocol: protocol
  183. ! !
  184. !Environment methodsFor: 'error handling'!
  185. evaluate: aBlock on: anErrorClass do: exceptionBlock
  186. "Evaluate a block and catch exceptions happening on the environment stack"
  187. self try: aBlock catch: [ :exception |
  188. (exception isKindOf: (self classNamed: anErrorClass name))
  189. ifTrue: [ exceptionBlock value: exception ]
  190. ifFalse: [ exception signal ] ]
  191. ! !
  192. !Environment methodsFor: 'services'!
  193. registerErrorHandler: anErrorHandler
  194. ErrorHandler register: anErrorHandler
  195. !
  196. registerInspector: anInspector
  197. Inspector register: anInspector
  198. !
  199. registerProgressHandler: aProgressHandler
  200. ProgressHandler register: aProgressHandler
  201. !
  202. registerTranscript: aTranscript
  203. Transcript register: aTranscript
  204. ! !
  205. ProtoObject subclass: #JSObjectProxy
  206. instanceVariableNames: 'jsObject'
  207. package: 'Kernel-Infrastructure'!
  208. !JSObjectProxy commentStamp!
  209. I handle sending messages to JavaScript objects, making JavaScript object accessing from Amber fully transparent.
  210. My instances make intensive use of `#doesNotUnderstand:`.
  211. My instances are automatically created by Amber whenever a message is sent to a JavaScript object.
  212. ## Usage examples
  213. JSObjectProxy objects are instanciated by Amber when a Smalltalk message is sent to a JavaScript object.
  214. window alert: 'hello world'.
  215. window inspect.
  216. (window jQuery: 'body') append: 'hello world'
  217. Amber messages sends are converted to JavaScript function calls or object property access _(in this order)_. If n one of them match, a `MessageNotUnderstood` error will be thrown.
  218. ## Message conversion rules
  219. - `someUser name` becomes `someUser.name`
  220. - `someUser name: 'John'` becomes `someUser name = "John"`
  221. - `console log: 'hello world'` becomes `console.log('hello world')`
  222. - `(window jQuery: 'foo') css: 'background' color: 'red'` becomes `window.jQuery('foo').css('background', 'red')`
  223. __Note:__ For keyword-based messages, only the first keyword is kept: `window foo: 1 bar: 2` is equivalent to `window foo: 1 baz: 2`.!
  224. !JSObjectProxy methodsFor: 'accessing'!
  225. at: aString
  226. <return self['@jsObject'][aString]>
  227. !
  228. at: aString ifAbsent: aBlock
  229. "return the aString property or evaluate aBlock if the property is not defined on the object"
  230. <
  231. var obj = self['@jsObject'];
  232. return aString in obj ? obj[aString] : aBlock._value();
  233. >
  234. !
  235. at: aString ifPresent: aBlock
  236. "return the evaluation of aBlock with the value if the property is defined or return nil"
  237. <
  238. var obj = self['@jsObject'];
  239. return aString in obj ? aBlock._value_(obj[aString]) : nil;
  240. >
  241. !
  242. at: aString ifPresent: aBlock ifAbsent: anotherBlock
  243. "return the evaluation of aBlock with the value if the property is defined
  244. or return value of anotherBlock"
  245. <
  246. var obj = self['@jsObject'];
  247. return aString in obj ? aBlock._value_(obj[aString]) : anotherBlock._value();
  248. >
  249. !
  250. at: aString put: anObject
  251. <return self['@jsObject'][aString] = anObject>
  252. !
  253. jsObject
  254. ^ jsObject
  255. !
  256. jsObject: aJSObject
  257. jsObject := aJSObject
  258. !
  259. lookupProperty: aString
  260. "Looks up a property in JS object.
  261. Answer the property if it is present, or nil if it is not present."
  262. <return aString in self._jsObject() ? aString : nil>
  263. ! !
  264. !JSObjectProxy methodsFor: 'comparing'!
  265. = anObject
  266. anObject class == self class ifFalse: [ ^ false ].
  267. ^ self compareJSObjectWith: anObject jsObject
  268. ! !
  269. !JSObjectProxy methodsFor: 'enumerating'!
  270. asJSON
  271. "Answers the receiver in a stringyfy-friendly fashion"
  272. ^ jsObject
  273. !
  274. keysAndValuesDo: aBlock
  275. <
  276. var o = self['@jsObject'];
  277. for(var i in o) {
  278. aBlock._value_value_(i, o[i]);
  279. }
  280. >
  281. ! !
  282. !JSObjectProxy methodsFor: 'printing'!
  283. printOn: aStream
  284. aStream nextPutAll: self printString
  285. !
  286. printString
  287. <
  288. var js = self['@jsObject'];
  289. return js.toString
  290. ? js.toString()
  291. : Object.prototype.toString.call(js)
  292. >
  293. ! !
  294. !JSObjectProxy methodsFor: 'private'!
  295. compareJSObjectWith: aJSObject
  296. <return self["@jsObject"] === aJSObject>
  297. ! !
  298. !JSObjectProxy methodsFor: 'proxy'!
  299. addObjectVariablesTo: aDictionary
  300. <
  301. for(var i in self['@jsObject']) {
  302. aDictionary._at_put_(i, self['@jsObject'][i]);
  303. }
  304. >
  305. !
  306. doesNotUnderstand: aMessage
  307. ^ (self lookupProperty: aMessage selector asJavaScriptSelector)
  308. ifNil: [ super doesNotUnderstand: aMessage ]
  309. ifNotNil: [ :jsSelector |
  310. self
  311. forwardMessage: jsSelector
  312. withArguments: aMessage arguments ]
  313. !
  314. forwardMessage: aString withArguments: anArray
  315. <
  316. return smalltalk.send(self._jsObject(), aString, anArray);
  317. >
  318. !
  319. inspectOn: anInspector
  320. | variables |
  321. variables := Dictionary new.
  322. variables at: '#self' put: self jsObject.
  323. anInspector setLabel: self printString.
  324. self addObjectVariablesTo: variables.
  325. anInspector setVariables: variables
  326. ! !
  327. !JSObjectProxy class methodsFor: 'instance creation'!
  328. on: aJSObject
  329. ^ self new
  330. jsObject: aJSObject;
  331. yourself
  332. ! !
  333. Object subclass: #NullProgressHandler
  334. instanceVariableNames: ''
  335. package: 'Kernel-Infrastructure'!
  336. !NullProgressHandler commentStamp!
  337. I am the default progress handler. I do not display any progress, and simply iterate over the collection.!
  338. !NullProgressHandler methodsFor: 'progress handling'!
  339. do: aBlock on: aCollection displaying: aString
  340. aCollection do: aBlock
  341. ! !
  342. NullProgressHandler class instanceVariableNames: 'current'!
  343. !NullProgressHandler class methodsFor: 'initialization'!
  344. initialize
  345. ProgressHandler registerIfNone: self new
  346. ! !
  347. Object subclass: #Organizer
  348. instanceVariableNames: ''
  349. package: 'Kernel-Infrastructure'!
  350. !Organizer commentStamp!
  351. I represent categorization information.
  352. ## API
  353. Use `#addElement:` and `#removeElement:` to manipulate instances.!
  354. !Organizer methodsFor: 'accessing'!
  355. addElement: anObject
  356. <self.elements.addElement(anObject)>
  357. !
  358. elements
  359. ^ (self basicAt: 'elements') copy
  360. !
  361. removeElement: anObject
  362. <self.elements.removeElement(anObject)>
  363. ! !
  364. Organizer subclass: #ClassOrganizer
  365. instanceVariableNames: ''
  366. package: 'Kernel-Infrastructure'!
  367. !ClassOrganizer commentStamp!
  368. I am an organizer specific to classes. I hold method categorization information for classes.!
  369. !ClassOrganizer methodsFor: 'accessing'!
  370. addElement: aString
  371. super addElement: aString.
  372. SystemAnnouncer current announce: (ProtocolAdded new
  373. protocol: aString;
  374. theClass: self theClass;
  375. yourself)
  376. !
  377. removeElement: aString
  378. super removeElement: aString.
  379. SystemAnnouncer current announce: (ProtocolRemoved new
  380. protocol: aString;
  381. theClass: self theClass;
  382. yourself)
  383. !
  384. theClass
  385. < return self.theClass >
  386. ! !
  387. Organizer subclass: #PackageOrganizer
  388. instanceVariableNames: ''
  389. package: 'Kernel-Infrastructure'!
  390. !PackageOrganizer commentStamp!
  391. I am an organizer specific to packages. I hold classes categorization information.!
  392. Object subclass: #Package
  393. instanceVariableNames: 'transport'
  394. package: 'Kernel-Infrastructure'!
  395. !Package commentStamp!
  396. I am similar to a "class category" typically found in other Smalltalks like Pharo or Squeak. Amber does not have class categories anymore, it had in the beginning but now each class in the system knows which package it belongs to.
  397. Each package has a name and can be queried for its classes, but it will then resort to a reverse scan of all classes to find them.
  398. ## API
  399. Packages are manipulated through "Smalltalk current", like for example finding one based on a name or with `Package class >> #name` directly:
  400. Smalltalk current packageAt: 'Kernel'
  401. Package named: 'Kernel'
  402. A package differs slightly from a Monticello package which can span multiple class categories using a naming convention based on hyphenation. But just as in Monticello a package supports "class extensions" so a package can define behaviors in foreign classes using a naming convention for method categories where the category starts with an asterisk and then the name of the owning package follows.
  403. You can fetch a package from the server:
  404. Package load: 'Additional-Examples'!
  405. !Package methodsFor: 'accessing'!
  406. basicTransport
  407. "Answer the transport literal JavaScript object as setup in the JavaScript file, if any"
  408. <return self.transport>
  409. !
  410. definition
  411. ^ String streamContents: [ :stream |
  412. stream
  413. nextPutAll: self class name;
  414. nextPutAll: String lf, String tab;
  415. nextPutAll: ' named: ';
  416. nextPutAll: '''', self name, '''';
  417. nextPutAll: String lf, String tab;
  418. nextPutAll: ' transport: (';
  419. nextPutAll: self transport definition, ')' ]
  420. !
  421. name
  422. <return self.pkgName>
  423. !
  424. name: aString
  425. <self.pkgName = aString>
  426. !
  427. organization
  428. ^ self basicAt: 'organization'
  429. !
  430. transport
  431. ^ transport ifNil: [
  432. transport := (PackageTransport fromJson: self basicTransport)
  433. package: self;
  434. yourself ]
  435. !
  436. transport: aPackageTransport
  437. transport := aPackageTransport.
  438. aPackageTransport package: self
  439. ! !
  440. !Package methodsFor: 'classes'!
  441. classes
  442. ^ self organization elements
  443. !
  444. setupClasses
  445. self classes
  446. do: [ :each | ClassBuilder new setupClass: each ];
  447. do: [ :each | each initialize ]
  448. !
  449. sortedClasses
  450. "Answer all classes in the receiver, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)."
  451. ^ self class sortedClasses: self classes
  452. ! !
  453. !Package methodsFor: 'dependencies'!
  454. loadDependencies
  455. "Returns list of packages that need to be loaded
  456. before loading this package."
  457. | classes packages |
  458. classes := self loadDependencyClasses.
  459. ^ (classes collect: [ :each | each package ]) asSet
  460. remove: self ifAbsent: [];
  461. yourself
  462. !
  463. loadDependencyClasses
  464. "Returns classes needed at the time of loading a package.
  465. These are all that are used to subclass
  466. and to define an extension method"
  467. | starCategoryName |
  468. starCategoryName := '*', self name.
  469. ^ (self classes collect: [ :each | each superclass ]) asSet
  470. remove: nil ifAbsent: [];
  471. addAll: (Smalltalk classes select: [ :each | each protocols, each class protocols includes: starCategoryName ]);
  472. yourself
  473. ! !
  474. !Package methodsFor: 'printing'!
  475. printOn: aStream
  476. super printOn: aStream.
  477. aStream
  478. nextPutAll: ' (';
  479. nextPutAll: self name;
  480. nextPutAll: ')'
  481. ! !
  482. !Package methodsFor: 'testing'!
  483. isPackage
  484. ^ true
  485. ! !
  486. Package class instanceVariableNames: 'defaultCommitPathJs defaultCommitPathSt'!
  487. !Package class methodsFor: 'accessing'!
  488. named: aPackageName
  489. ^ Smalltalk
  490. packageAt: aPackageName
  491. ifAbsent: [
  492. Smalltalk createPackage: aPackageName ]
  493. !
  494. named: aPackageName ifAbsent: aBlock
  495. ^ Smalltalk packageAt: aPackageName ifAbsent: aBlock
  496. !
  497. named: aPackageName transport: aTransport
  498. | package |
  499. package := self named: aPackageName.
  500. package transport: aTransport.
  501. ^ package
  502. ! !
  503. !Package class methodsFor: 'sorting'!
  504. sortedClasses: classes
  505. "Answer classes, sorted by superclass/subclasses and by class name for common subclasses (Issue #143)"
  506. | children others nodes expandedClasses |
  507. children := #().
  508. others := #().
  509. classes do: [ :each |
  510. (classes includes: each superclass)
  511. ifFalse: [ children add: each ]
  512. ifTrue: [ others add: each ]].
  513. nodes := children collect: [ :each |
  514. ClassSorterNode on: each classes: others level: 0 ].
  515. nodes := nodes sorted: [ :a :b | a theClass name <= b theClass name ].
  516. expandedClasses := Array new.
  517. nodes do: [ :aNode |
  518. aNode traverseClassesWith: expandedClasses ].
  519. ^ expandedClasses
  520. ! !
  521. Object subclass: #PlatformInterface
  522. instanceVariableNames: ''
  523. package: 'Kernel-Infrastructure'!
  524. !PlatformInterface commentStamp!
  525. I am single entry point to UI and environment interface.
  526. My `initialize` tries several options (for now, browser environment only) to set myself up.
  527. ## API
  528. PlatformInterface alert: 'Hey, there is a problem'.
  529. PlatformInterface confirm: 'Affirmative?'.
  530. PlatformInterface prompt: 'Your name:'.
  531. PlatformInterface ajax: #{
  532. 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script'
  533. }.!
  534. PlatformInterface class instanceVariableNames: 'worker'!
  535. !PlatformInterface class methodsFor: 'accessing'!
  536. globals
  537. <return (new Function('return this'))();>
  538. !
  539. setWorker: anObject
  540. worker := anObject
  541. ! !
  542. !PlatformInterface class methodsFor: 'actions'!
  543. ajax: anObject
  544. ^ worker
  545. ifNotNil: [ worker ajax: anObject ]
  546. ifNil: [ self error: 'ajax: not available' ]
  547. !
  548. alert: aString
  549. ^ worker
  550. ifNotNil: [ worker alert: aString ]
  551. ifNil: [ self error: 'alert: not available' ]
  552. !
  553. confirm: aString
  554. ^ worker
  555. ifNotNil: [ worker confirm: aString ]
  556. ifNil: [ self error: 'confirm: not available' ]
  557. !
  558. existsGlobal: aString
  559. ^ PlatformInterface globals
  560. at: aString
  561. ifPresent: [ true ]
  562. ifAbsent: [ false ]
  563. !
  564. prompt: aString
  565. ^ worker
  566. ifNotNil: [ worker prompt: aString ]
  567. ifNil: [ self error: 'prompt: not available' ]
  568. ! !
  569. !PlatformInterface class methodsFor: 'initialization'!
  570. initialize
  571. | candidate |
  572. super initialize.
  573. BrowserInterface ifNotNil: [
  574. candidate := BrowserInterface new.
  575. candidate isAvailable ifTrue: [ self setWorker: candidate. ^ self ]
  576. ]
  577. ! !
  578. Object subclass: #Service
  579. instanceVariableNames: ''
  580. package: 'Kernel-Infrastructure'!
  581. !Service commentStamp!
  582. I implement the basic behavior for class registration to a service.
  583. See the `Transcript` class for a concrete service.
  584. ## API
  585. Use class-side methods `#register:` and `#registerIfNone:` to register classes to a specific service.!
  586. Service class instanceVariableNames: 'current'!
  587. !Service class methodsFor: 'accessing'!
  588. current
  589. ^ current
  590. ! !
  591. !Service class methodsFor: 'instance creation'!
  592. new
  593. self shouldNotImplement
  594. ! !
  595. !Service class methodsFor: 'registration'!
  596. register: anObject
  597. current := anObject
  598. !
  599. registerIfNone: anObject
  600. self current ifNil: [ self register: anObject ]
  601. ! !
  602. Service subclass: #ErrorHandler
  603. instanceVariableNames: ''
  604. package: 'Kernel-Infrastructure'!
  605. !ErrorHandler commentStamp!
  606. I am the service used to handle Smalltalk errors.
  607. See `boot.js` `handleError()` function.
  608. Registered service instances must implement `#handleError:` to perform an action on the thrown exception.!
  609. !ErrorHandler class methodsFor: 'error handling'!
  610. handleError: anError
  611. self current handleError: anError
  612. ! !
  613. Service subclass: #Inspector
  614. instanceVariableNames: ''
  615. package: 'Kernel-Infrastructure'!
  616. !Inspector commentStamp!
  617. I am the service responsible for inspecting objects.
  618. The default inspector object is the transcript.!
  619. !Inspector class methodsFor: 'inspecting'!
  620. inspect: anObject
  621. ^ self current inspect: anObject
  622. ! !
  623. Service subclass: #ProgressHandler
  624. instanceVariableNames: ''
  625. package: 'Kernel-Infrastructure'!
  626. !ProgressHandler commentStamp!
  627. I am used to manage progress in collection iterations, see `SequenceableCollection >> #do:displayingProgress:`.
  628. Registered instances must implement `#do:on:displaying:`.
  629. The default behavior is to simply iterate over the collection, using `NullProgressHandler`.!
  630. !ProgressHandler class methodsFor: 'progress handling'!
  631. do: aBlock on: aCollection displaying: aString
  632. self current do: aBlock on: aCollection displaying: aString
  633. ! !
  634. Service subclass: #Transcript
  635. instanceVariableNames: ''
  636. package: 'Kernel-Infrastructure'!
  637. !Transcript commentStamp!
  638. I am a facade for Transcript actions.
  639. I delegate actions to the currently registered transcript.
  640. ## API
  641. Transcript
  642. show: 'hello world';
  643. cr;
  644. show: anObject.!
  645. !Transcript class methodsFor: 'instance creation'!
  646. open
  647. self current open
  648. ! !
  649. !Transcript class methodsFor: 'printing'!
  650. clear
  651. self current clear
  652. !
  653. cr
  654. self current show: String cr
  655. !
  656. inspect: anObject
  657. self show: anObject
  658. !
  659. show: anObject
  660. self current show: anObject
  661. ! !
  662. Object subclass: #SmalltalkImage
  663. instanceVariableNames: ''
  664. package: 'Kernel-Infrastructure'!
  665. !SmalltalkImage commentStamp!
  666. I represent the Smalltalk system, wrapping
  667. operations of variable `smalltalk` declared in `js/boot.js`.
  668. ## API
  669. I have only one instance, accessed with global variable `Smalltalk`.
  670. The `smalltalk` object holds all class and packages defined in the system.
  671. ## Classes
  672. Classes can be accessed using the following methods:
  673. - `#classes` answers the full list of Smalltalk classes in the system
  674. - `#at:` answers a specific class or `nil`
  675. ## Packages
  676. Packages can be accessed using the following methods:
  677. - `#packages` answers the full list of packages
  678. - `#packageAt:` answers a specific package or `nil`
  679. ## Parsing
  680. The `#parse:` method is used to parse Amber source code.
  681. It requires the `Compiler` package and the `js/parser.js` parser file in order to work.!
  682. !SmalltalkImage methodsFor: 'accessing'!
  683. at: aString
  684. <return smalltalk[aString]>
  685. !
  686. at: aKey ifAbsent: aBlock
  687. ^ (self includesKey: aKey)
  688. ifTrue: [ self at: aKey ]
  689. ifFalse: [ aBlock value ]
  690. !
  691. at: aString put: anObject
  692. <return smalltalk[aString]=anObject>
  693. !
  694. current
  695. "Backward compatibility for Smalltalk current ..."
  696. self deprecatedAPI.
  697. ^ self
  698. !
  699. globals
  700. "Future compatibility to be able to use Smalltalk globals at: ..."
  701. ^ self
  702. !
  703. includesKey: aKey
  704. <return smalltalk.hasOwnProperty(aKey)>
  705. !
  706. parse: aString
  707. | result |
  708. self
  709. try: [ result := self basicParse: aString ]
  710. catch: [ :ex | (self parseError: ex parsing: aString) signal ].
  711. ^ result
  712. source: aString;
  713. yourself
  714. !
  715. pseudoVariableNames
  716. ^ #('self' 'super' 'nil' 'true' 'false' 'thisContext')
  717. !
  718. readJSObject: anObject
  719. <return smalltalk.readJSObject(anObject)>
  720. !
  721. reservedWords
  722. "JavaScript reserved words"
  723. <return smalltalk.reservedWords>
  724. !
  725. version
  726. "Answer the version string of Amber"
  727. ^ '0.13.0-pre'
  728. !
  729. vm
  730. "Future compatibility to be able to use Smalltalk vm ..."
  731. <return smalltalk>
  732. ! !
  733. !SmalltalkImage methodsFor: 'accessing amd'!
  734. amdRequire
  735. ^ self at: 'amdRequire'
  736. !
  737. defaultAmdNamespace
  738. ^ self at: 'defaultAmdNamespace'
  739. !
  740. defaultAmdNamespace: aString
  741. self at: 'defaultAmdNamespace' put: aString
  742. ! !
  743. !SmalltalkImage methodsFor: 'classes'!
  744. classes
  745. <return smalltalk.classes()>
  746. !
  747. removeClass: aClass
  748. aClass isMetaclass ifTrue: [ self error: aClass asString, ' is a Metaclass and cannot be removed!!' ].
  749. self deleteClass: aClass.
  750. SystemAnnouncer current
  751. announce: (ClassRemoved new
  752. theClass: aClass;
  753. yourself)
  754. ! !
  755. !SmalltalkImage methodsFor: 'error handling'!
  756. asSmalltalkException: anObject
  757. "A JavaScript exception may be thrown.
  758. We then need to convert it back to a Smalltalk object"
  759. ^ ((self isSmalltalkObject: anObject) and: [ anObject isKindOf: Error ])
  760. ifTrue: [ anObject ]
  761. ifFalse: [ JavaScriptException on: anObject ]
  762. !
  763. parseError: anException parsing: aString
  764. ^ ParseError new messageText: 'Parse error on line ', (anException basicAt: 'line') ,' column ' , (anException basicAt: 'column') ,' : Unexpected character ', (anException basicAt: 'found')
  765. ! !
  766. !SmalltalkImage methodsFor: 'globals'!
  767. addGlobalJsVariable: aString
  768. self globalJsVariables add: aString
  769. !
  770. deleteGlobalJsVariable: aString
  771. self globalJsVariables remove: aString ifAbsent:[]
  772. !
  773. globalJsVariables
  774. "Array of global JavaScript variables"
  775. <return smalltalk.globalJsVariables>
  776. ! !
  777. !SmalltalkImage methodsFor: 'packages'!
  778. createPackage: packageName
  779. | package announcement |
  780. package := self basicCreatePackage: packageName.
  781. announcement := PackageAdded new
  782. package: package;
  783. yourself.
  784. SystemAnnouncer current announce: announcement.
  785. ^ package
  786. !
  787. packageAt: packageName
  788. <return smalltalk.packages[packageName]>
  789. !
  790. packageAt: packageName ifAbsent: aBlock
  791. ^ (self packageAt: packageName) ifNil: aBlock
  792. !
  793. packages
  794. "Return all Package instances in the system."
  795. <
  796. return Object.keys(smalltalk.packages).map(function(k) {
  797. return smalltalk.packages[k];
  798. })
  799. >
  800. !
  801. removePackage: packageName
  802. "Removes a package and all its classes."
  803. | pkg |
  804. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  805. pkg classes do: [ :each |
  806. self removeClass: each ].
  807. self deletePackage: packageName
  808. !
  809. renamePackage: packageName to: newName
  810. "Rename a package."
  811. | pkg |
  812. pkg := self packageAt: packageName ifAbsent: [ self error: 'Missing package: ', packageName ].
  813. (self packageAt: newName) ifNotNil: [ self error: 'Already exists a package called: ', newName ].
  814. (self at: 'packages') at: newName put: pkg.
  815. pkg name: newName.
  816. self deletePackage: packageName.
  817. ! !
  818. !SmalltalkImage methodsFor: 'private'!
  819. basicCreatePackage: packageName
  820. "Create and bind a new bare package with given name and return it."
  821. <return smalltalk.addPackage(packageName)>
  822. !
  823. basicParse: aString
  824. <return smalltalk.parser.parse(aString)>
  825. !
  826. createPackage: packageName properties: aDict
  827. "Needed to import .st files: they begin with this call."
  828. self deprecatedAPI.
  829. aDict isEmpty ifFalse: [ self error: 'createPackage:properties: called with nonempty properties' ].
  830. ^ self createPackage: packageName
  831. !
  832. deleteClass: aClass
  833. "Deletes a class by deleting its binding only. Use #removeClass instead"
  834. <smalltalk.removeClass(aClass)>
  835. !
  836. deletePackage: packageName
  837. "Deletes a package by deleting its binding, but does not check if it contains classes etc.
  838. To remove a package, use #removePackage instead."
  839. <delete smalltalk.packages[packageName]>
  840. ! !
  841. !SmalltalkImage methodsFor: 'testing'!
  842. isSmalltalkObject: anObject
  843. "Consider anObject a Smalltalk object if it has a 'klass' property.
  844. Note that this may be unaccurate"
  845. <return typeof anObject.klass !!== 'undefined'>
  846. ! !
  847. SmalltalkImage class instanceVariableNames: 'current'!
  848. !SmalltalkImage class methodsFor: 'initialization'!
  849. initialize
  850. smalltalk at: 'Smalltalk' put: self current
  851. ! !
  852. !SmalltalkImage class methodsFor: 'instance creation'!
  853. current
  854. ^ current ifNil: [ current := super new ] ifNotNil: [ self deprecatedAPI. current ]
  855. !
  856. new
  857. self shouldNotImplement
  858. ! !
  859. !SequenceableCollection methodsFor: '*Kernel-Infrastructure'!
  860. do: aBlock displayingProgress: aString
  861. ProgressHandler
  862. do: aBlock
  863. on: self
  864. displaying: aString
  865. ! !
  866. !String methodsFor: '*Kernel-Infrastructure'!
  867. asJavaScriptSelector
  868. "Return first keyword of the selector, without trailing colon."
  869. ^ self replace: '^([a-zA-Z0-9]*).*$' with: '$1'
  870. ! !