1
0

Kernel-Infrastructure.st 29 KB

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