Platform-ImportExport.st 29 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193
  1. Smalltalk createPackage: 'Platform-ImportExport'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Platform-ImportExport'!
  5. !AbstractExporter commentStamp!
  6. I am an abstract exporter for Amber source code.
  7. ## API
  8. Use `#exportPackage:on:` to export a given package on a Stream.!
  9. !AbstractExporter methodsFor: 'accessing'!
  10. extensionMethodsOfPackage: aPackage
  11. | result |
  12. result := OrderedCollection new.
  13. (self extensionProtocolsOfPackage: aPackage) do: [ :each |
  14. result addAll: each ownMethods ].
  15. ^ result
  16. !
  17. extensionProtocolsOfPackage: aPackage
  18. | extensionName result |
  19. extensionName := '*', aPackage name.
  20. result := OrderedCollection new.
  21. "The classes must be loaded since it is extensions only.
  22. Therefore topological sorting (dependency resolution) does not matter here.
  23. Not sorting topologically improves the speed by a number of magnitude.
  24. Not to shuffle diffs, classes are sorted by their name."
  25. (Smalltalk classes asArray sorted: [ :a :b | a name < b name ]) do: [ :each |
  26. ({each. each theMetaClass} copyWithout: nil) do: [ :behavior |
  27. (behavior protocols includes: extensionName) ifTrue: [
  28. result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
  29. ^ result
  30. ! !
  31. !AbstractExporter methodsFor: 'output'!
  32. exportPackage: aPackage on: aStream
  33. self subclassResponsibility
  34. ! !
  35. AbstractExporter subclass: #ChunkExporter
  36. instanceVariableNames: ''
  37. package: 'Platform-ImportExport'!
  38. !ChunkExporter commentStamp!
  39. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  40. I do not output any compiled code.!
  41. !ChunkExporter methodsFor: 'accessing'!
  42. extensionCategoriesOfPackage: aPackage
  43. "Issue #143: sort protocol alphabetically"
  44. | name map result |
  45. name := aPackage name.
  46. result := OrderedCollection new.
  47. (Package sortedClasses: Smalltalk classes) do: [ :each |
  48. {each. each theMetaClass} do: [ :aClass |
  49. map := Dictionary new.
  50. aClass protocolsDo: [ :category :methods |
  51. category = ('*', name) ifTrue: [ map at: category put: methods ] ].
  52. result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |
  53. MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].
  54. ^ result
  55. !
  56. ownCategoriesOfClass: aClass
  57. "Answer the protocols of aClass that are not package extensions"
  58. "Issue #143: sort protocol alphabetically"
  59. | map |
  60. map := Dictionary new.
  61. aClass protocolsDo: [ :each :methods |
  62. (each match: '^\*') ifFalse: [ map at: each put: methods ] ].
  63. ^ (map keys sorted: [ :a :b | a <= b ]) collect: [ :each |
  64. MethodCategory name: each theClass: aClass methods: (map at: each) ]
  65. !
  66. ownCategoriesOfMetaClass: aClass
  67. "Issue #143: sort protocol alphabetically"
  68. ^ self ownCategoriesOfClass: aClass theMetaClass
  69. !
  70. ownMethodProtocolsOfClass: aClass
  71. "Answer a collection of ExportMethodProtocol object of aClass that are not package extensions"
  72. ^ aClass ownProtocols collect: [ :each |
  73. ExportMethodProtocol name: each theClass: aClass ]
  74. ! !
  75. !ChunkExporter methodsFor: 'convenience'!
  76. chunkEscape: aString
  77. "Replace all occurrences of !! with !!!! and trim at both ends."
  78. ^ (aString replace: '!!' with: '!!!!') trimBoth
  79. ! !
  80. !ChunkExporter methodsFor: 'output'!
  81. exportBehavior: aBehavior on: aStream
  82. aBehavior exportBehaviorDefinitionTo: aStream using: self.
  83. self
  84. exportProtocols: (self ownMethodProtocolsOfClass: aBehavior)
  85. on: aStream
  86. !
  87. exportCategoryEpilogueOf: aCategory on: aStream
  88. aStream write: ' !!'; lf; lf
  89. !
  90. exportCategoryPrologueOf: aCategory on: aStream
  91. aStream
  92. write: '!!';
  93. print: aCategory theClass;
  94. write: ' methodsFor: ';
  95. print: aCategory;
  96. write: '!!'
  97. !
  98. exportDefinitionOf: aClass on: aStream
  99. "Chunk format."
  100. aStream
  101. print: aClass superclass;
  102. write: ' subclass: ';
  103. printSymbol: aClass name;
  104. lf.
  105. "aClass traitComposition
  106. ifNotEmpty: [ aStream tab; write: {'uses: '. aClass traitCompositionDefinition}; lf ]."
  107. aStream
  108. tab;
  109. write: 'instanceVariableNames: ';
  110. print: (' ' join: aClass instanceVariableNames);
  111. lf;
  112. tab;
  113. write: 'package: ';
  114. print: aClass category;
  115. write: '!!';
  116. lf.
  117. aClass comment ifNotEmpty: [ aStream
  118. write: '!!'; print: aClass; write: ' commentStamp!!'; lf;
  119. write: { self chunkEscape: aClass comment. '!!' }; lf ].
  120. aStream lf
  121. !
  122. exportMetaDefinitionOf: aClass on: aStream
  123. | classIvars classTraitComposition |
  124. classIvars := aClass class instanceVariableNames.
  125. classTraitComposition := aClass class traitComposition.
  126. (classIvars notEmpty "or: [classTraitComposition notEmpty]") ifTrue: [
  127. aStream
  128. print: aClass theMetaClass.
  129. aStream space. "classTraitComposition
  130. ifEmpty: [ aStream space ]
  131. ifNotEmpty: [ aStream lf; tab; write: {'uses: '. aClass class traitCompositionDefinition}; lf; tab ]."
  132. aStream
  133. write: 'instanceVariableNames: ';
  134. print: (' ' join: classIvars);
  135. write: '!!'; lf; lf ]
  136. !
  137. exportMethod: aMethod on: aStream
  138. aStream
  139. lf; lf; write: (self chunkEscape: aMethod source); lf;
  140. write: '!!'
  141. !
  142. exportPackage: aPackage on: aStream
  143. self
  144. exportPackageDefinitionOf: aPackage on: aStream;
  145. exportPackageImportsOf: aPackage on: aStream.
  146. aPackage sortedClasses do: [ :each |
  147. self exportBehavior: each on: aStream.
  148. each theMetaClass ifNotNil: [ :meta | self exportBehavior: meta on: aStream ] ].
  149. self exportPackageTraitCompositionsOf: aPackage on: aStream.
  150. self
  151. exportProtocols: (self extensionProtocolsOfPackage: aPackage)
  152. on: aStream
  153. !
  154. exportPackageDefinitionOf: aPackage on: aStream
  155. aStream
  156. write: 'Smalltalk createPackage: ';
  157. print: aPackage name;
  158. write: '!!';
  159. lf
  160. !
  161. exportPackageImportsOf: aPackage on: aStream
  162. aPackage imports ifNotEmpty: [ :imports | aStream
  163. write: '(Smalltalk packageAt: ';
  164. print: aPackage name;
  165. write: ' ifAbsent: [ self error: ';
  166. print: 'Package not created: ', aPackage name;
  167. write: { ' ]) imports: '. self chunkEscape: aPackage importsDefinition. '!!' };
  168. lf ]
  169. !
  170. exportPackageTraitCompositionsOf: aPackage on: aStream
  171. aPackage traitCompositions ifNotEmpty: [ :traitCompositions |
  172. traitCompositions keysAndValuesDo: [ :key :value | self exportTraitComposition: value of: key on: aStream ].
  173. aStream write: '!! !!'; lf; lf ]
  174. !
  175. exportProtocol: aProtocol on: aStream
  176. aProtocol ownMethods ifNotEmpty: [ :methods |
  177. self exportProtocolPrologueOf: aProtocol on: aStream.
  178. methods do: [ :method |
  179. self exportMethod: method on: aStream ].
  180. self exportProtocolEpilogueOf: aProtocol on: aStream ]
  181. !
  182. exportProtocolEpilogueOf: aProtocol on: aStream
  183. aStream write: ' !!'; lf; lf
  184. !
  185. exportProtocolPrologueOf: aProtocol on: aStream
  186. aStream
  187. write: '!!';
  188. print: aProtocol theClass;
  189. write: ' methodsFor: ';
  190. print: aProtocol name;
  191. write: '!!'
  192. !
  193. exportProtocols: aCollection on: aStream
  194. aCollection do: [ :each |
  195. self exportProtocol: each on: aStream ]
  196. !
  197. exportTraitComposition: aTraitComposition of: aBehavior on: aStream
  198. aStream
  199. print: aBehavior;
  200. write: ' setTraitComposition: ';
  201. write: aBehavior traitCompositionDefinition;
  202. write: ' asTraitComposition!!';
  203. lf
  204. !
  205. exportTraitDefinitionOf: aClass on: aStream
  206. "Chunk format."
  207. aStream
  208. write: 'Trait named: '; printSymbol: aClass name; lf.
  209. "aClass traitComposition
  210. ifNotEmpty: [ aStream tab; write: {'uses: '. aClass traitCompositionDefinition}; lf ]."
  211. aStream
  212. tab; write: 'package: '; print: aClass category; write: '!!'; lf.
  213. aClass comment ifNotEmpty: [
  214. aStream
  215. write: '!!'; print: aClass; write: ' commentStamp!!'; lf;
  216. write: { self chunkEscape: aClass comment. '!!' }; lf ].
  217. aStream lf
  218. ! !
  219. AbstractExporter subclass: #Exporter
  220. instanceVariableNames: ''
  221. package: 'Platform-ImportExport'!
  222. !Exporter commentStamp!
  223. I am responsible for outputting Amber code into a JavaScript string.
  224. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  225. ## Use case
  226. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  227. !Exporter methodsFor: 'accessing'!
  228. ownMethodsOfClass: aClass
  229. "Issue #143: sort methods alphabetically"
  230. ^ ((aClass methodDictionary values) sorted: [ :a :b | a selector <= b selector ])
  231. reject: [ :each | (each protocol match: '^\*') ]
  232. !
  233. ownMethodsOfMetaClass: aClass
  234. "Issue #143: sort methods alphabetically"
  235. ^ self ownMethodsOfClass: aClass theMetaClass
  236. ! !
  237. !Exporter methodsFor: 'output'!
  238. exportBehavior: aBehavior on: aStream
  239. aBehavior exportBehaviorDefinitionTo: aStream using: self.
  240. aBehavior ownMethods do: [ :method |
  241. self exportMethod: method on: aStream ]
  242. !
  243. exportDefinitionOf: aClass on: aStream
  244. aStream
  245. lf;
  246. write: {
  247. '$core.addClass('.
  248. aClass name asJavaScriptSource. ', '.
  249. aClass superclass ifNil: [ 'null' ] ifNotNil: [ :superclass | superclass asJavaScriptSource ]. ', '.
  250. aClass instanceVariableNames asJavaScriptSource. ', '.
  251. aClass category asJavaScriptSource.
  252. ');' }.
  253. aClass comment ifNotEmpty: [
  254. aStream
  255. lf;
  256. write: '//>>excludeStart("ide", pragmas.excludeIdeData);'; lf;
  257. write: { aClass asJavaScriptSource. '.comment='. aClass comment crlfSanitized asJavaScriptSource. ';' }; lf;
  258. write: '//>>excludeEnd("ide");' ].
  259. aStream lf
  260. !
  261. exportMetaDefinitionOf: aClass on: aStream
  262. aStream lf.
  263. aClass theMetaClass instanceVariableNames ifNotEmpty: [ :classIvars | aStream
  264. write: { aClass theMetaClass asJavaScriptSource. '.iVarNames = '. classIvars asJavaScriptSource. ';' };
  265. lf ]
  266. !
  267. exportMethod: aMethod on: aStream
  268. aStream
  269. write: '$core.addMethod('; lf;
  270. write: '$core.method({'; lf;
  271. write: { 'selector: '. aMethod selector asJavaScriptSource. ',' }; lf;
  272. write: { 'protocol: '. aMethod protocol asJavaScriptSource. ',' }; lf;
  273. write: { 'fn: '. aMethod fn compiledSource. ',' }; lf;
  274. write: '//>>excludeStart("ide", pragmas.excludeIdeData);'; lf;
  275. write: { 'args: '. aMethod arguments asJavaScriptSource. ',' }; lf;
  276. write: { 'source: '. aMethod source asJavaScriptSource. ',' }; lf;
  277. write: { 'referencedClasses: '. aMethod referencedClasses asJavaScriptSource. ',' }; lf;
  278. write: '//>>excludeEnd("ide");'; lf;
  279. write: { 'messageSends: '. aMethod messageSends asJavaScriptSource }; lf;
  280. write: '}),'; lf;
  281. write: { aMethod methodClass asJavaScriptSource. ');' }; lf; lf
  282. !
  283. exportPackage: aPackage on: aStream
  284. self
  285. exportPackagePrologueOf: aPackage on: aStream;
  286. exportPackageDefinitionOf: aPackage on: aStream;
  287. exportPackageContextOf: aPackage on: aStream;
  288. exportPackageImportsOf: aPackage on: aStream;
  289. exportPackageTransportOf: aPackage on: aStream.
  290. aPackage sortedClasses do: [ :each |
  291. self exportBehavior: each on: aStream.
  292. each theMetaClass ifNotNil: [ :meta | self exportBehavior: meta on: aStream ] ].
  293. self exportPackageTraitCompositionsOf: aPackage on: aStream.
  294. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  295. self exportMethod: each on: aStream ].
  296. self exportPackageEpilogueOf: aPackage on: aStream
  297. !
  298. exportPackageBodyBlockPrologueOf: aPackage on: aStream
  299. aStream
  300. write: 'if(!!("nilAsValue" in $boot))$boot.nilAsValue=$boot.nilAsReceiver;'; lf;
  301. write: 'var $core=$boot.api,nil=$boot.nilAsValue,$nil=$boot.nilAsReceiver,$recv=$boot.asReceiver,$globals=$boot.globals;'; lf
  302. !
  303. exportPackageContextOf: aPackage on: aStream
  304. aStream
  305. write: {
  306. '($core.packageDescriptors||$core.packages)['.
  307. aPackage name asJavaScriptSource.
  308. '].innerEval = '.
  309. 'function (expr) { return eval(expr); }'.
  310. ';' };
  311. lf
  312. !
  313. exportPackageDefinitionOf: aPackage on: aStream
  314. aStream
  315. write: { '$core.addPackage('. aPackage name asJavaScriptSource. ');' };
  316. lf
  317. !
  318. exportPackageEpilogueOf: aPackage on: aStream
  319. self subclassResponsibility
  320. !
  321. exportPackageImportsOf: aPackage on: aStream
  322. aPackage importsAsJson ifNotEmpty: [ :imports |
  323. aStream
  324. write: {
  325. '($core.packageDescriptors||$core.packages)['.
  326. aPackage name asJavaScriptSource.
  327. '].imports = '.
  328. imports asJavaScriptSource.
  329. ';' };
  330. lf ]
  331. !
  332. exportPackagePrologueOf: aPackage on: aStream
  333. self subclassResponsibility
  334. !
  335. exportPackageTraitCompositionsOf: aPackage on: aStream
  336. aPackage traitCompositions ifNotEmpty: [ :traitCompositions |
  337. traitCompositions keysAndValuesDo: [ :key :value | self exportTraitComposition: value of: key on: aStream ].
  338. aStream lf ]
  339. !
  340. exportPackageTransportOf: aPackage on: aStream
  341. aStream
  342. write: {
  343. '($core.packageDescriptors||$core.packages)['.
  344. aPackage name asJavaScriptSource.
  345. '].transport = '.
  346. aPackage transport asJSONString.
  347. ';' };
  348. lf
  349. !
  350. exportTraitComposition: aTraitComposition of: aBehavior on: aStream
  351. aStream write: {
  352. '$core.setTraitComposition('.
  353. aTraitComposition asJavaScriptSource.
  354. ', '.
  355. aBehavior asJavaScriptSource.
  356. ');' };
  357. lf
  358. !
  359. exportTraitDefinitionOf: aClass on: aStream
  360. aStream
  361. lf;
  362. write: {
  363. '$core.addTrait('.
  364. aClass name asJavaScriptSource. ', '.
  365. aClass category asJavaScriptSource.
  366. ');' }.
  367. aClass comment ifNotEmpty: [
  368. aStream
  369. lf;
  370. write: '//>>excludeStart("ide", pragmas.excludeIdeData);'; lf;
  371. write: { aClass asJavaScriptSource. '.comment='. aClass comment crlfSanitized asJavaScriptSource. ';' }; lf;
  372. write: '//>>excludeEnd("ide");' ].
  373. aStream lf
  374. ! !
  375. Exporter subclass: #AmdExporter
  376. instanceVariableNames: 'namespace'
  377. package: 'Platform-ImportExport'!
  378. !AmdExporter commentStamp!
  379. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  380. !AmdExporter methodsFor: 'output'!
  381. exportPackageEpilogueOf: aPackage on: aStream
  382. aStream
  383. write: '});';
  384. lf
  385. !
  386. exportPackagePrologueOf: aPackage on: aStream
  387. | importsForOutput loadDependencies pragmaStart pragmaEnd |
  388. pragmaStart := ''.
  389. pragmaEnd := ''.
  390. importsForOutput := self importsForOutput: aPackage.
  391. loadDependencies := self amdNamesOfPackages: aPackage loadDependencies.
  392. importsForOutput value ifNotEmpty: [
  393. pragmaStart := String lf, '//>>excludeStart("imports", pragmas.excludeImports);', String lf.
  394. pragmaEnd := String lf, '//>>excludeEnd("imports");', String lf ].
  395. aStream
  396. write: {
  397. 'define('.
  398. ((#('amber/boot' ':1:'), importsForOutput value, #(':2:'), loadDependencies asArray sorted) asJavaScriptSource
  399. replace: ',\s*["'']:1:["'']' with: pragmaStart)
  400. replace: ',\s*["'']:2:["'']' with: pragmaEnd.
  401. ', function('.
  402. ((((#('$boot' ':1:'), importsForOutput key, #(':2:')) join: ',')
  403. replace: ',\s*:1:' with: pragmaStart)
  404. replace: ',\s*:2:' with: pragmaEnd).
  405. '){"use strict";' };
  406. lf.
  407. self exportPackageBodyBlockPrologueOf: aPackage on: aStream
  408. ! !
  409. !AmdExporter methodsFor: 'private'!
  410. amdNamesOfPackages: anArray
  411. ^ (anArray
  412. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  413. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  414. !
  415. amdNamespaceOfPackage: aPackage
  416. ^ (aPackage transport type = 'amd')
  417. ifTrue: [ aPackage transport namespace ]
  418. ifFalse: [ nil ]
  419. !
  420. importsForOutput: aPackage
  421. "Returns an association where key is list of import variables
  422. and value is list of external dependencies, with ones imported as variables
  423. put at the beginning with same order as is in key.
  424. For example imports:{'jQuery'->'jquery'. 'bootstrap'} would yield
  425. #('jQuery') -> #('jquery' 'bootstrap')"
  426. | namedImports anonImports importVarNames |
  427. namedImports := #().
  428. anonImports := #().
  429. importVarNames := #().
  430. aPackage imports do: [ :each | each isString
  431. ifTrue: [ anonImports add: each ]
  432. ifFalse: [ namedImports add: each value.
  433. importVarNames add: each key ]].
  434. ^ importVarNames -> (namedImports, anonImports)
  435. ! !
  436. Object subclass: #ChunkParser
  437. instanceVariableNames: 'stream last'
  438. package: 'Platform-ImportExport'!
  439. !ChunkParser commentStamp!
  440. I am responsible for parsing aStream contents in the chunk format.
  441. ## API
  442. ChunkParser new
  443. stream: aStream;
  444. nextChunk!
  445. !ChunkParser methodsFor: 'accessing'!
  446. last
  447. ^ last
  448. !
  449. stream: aStream
  450. stream := aStream
  451. ! !
  452. !ChunkParser methodsFor: 'reading'!
  453. nextChunk
  454. "The chunk format (Smalltalk Interchange Format or Fileout format)
  455. is a trivial format but can be a bit tricky to understand:
  456. - Uses the exclamation mark as delimiter of chunks.
  457. - Inside a chunk a normal exclamation mark must be doubled.
  458. - A non empty chunk must be a valid Smalltalk expression.
  459. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  460. - The object created by the expression then takes over reading chunks.
  461. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  462. | char result chunk |
  463. result := '' writeStream.
  464. [ char := stream next.
  465. char notNil ] whileTrue: [
  466. char = '!!' ifTrue: [
  467. stream peek = '!!'
  468. ifTrue: [ stream next "skipping the escape double" ]
  469. ifFalse: [ ^ last := result contents trimBoth "chunk end marker found" ]].
  470. result nextPut: char ].
  471. ^ last := nil "a chunk needs to end with !!"
  472. ! !
  473. !ChunkParser class methodsFor: 'instance creation'!
  474. on: aStream
  475. ^ self new stream: aStream
  476. ! !
  477. Object subclass: #ClassCommentReader
  478. instanceVariableNames: 'class'
  479. package: 'Platform-ImportExport'!
  480. !ClassCommentReader commentStamp!
  481. I provide a mechanism for retrieving class comments stored on a file.
  482. See also `ClassCategoryReader`.!
  483. !ClassCommentReader methodsFor: 'accessing'!
  484. class: aClass
  485. class := aClass
  486. ! !
  487. !ClassCommentReader methodsFor: 'fileIn'!
  488. scanFrom: aChunkParser
  489. | chunk |
  490. chunk := aChunkParser nextChunk.
  491. chunk ifNotEmpty: [
  492. self setComment: chunk ].
  493. ! !
  494. !ClassCommentReader methodsFor: 'initialization'!
  495. initialize
  496. super initialize.
  497. ! !
  498. !ClassCommentReader methodsFor: 'private'!
  499. setComment: aString
  500. class comment: aString
  501. ! !
  502. Object subclass: #ClassProtocolReader
  503. instanceVariableNames: 'class category'
  504. package: 'Platform-ImportExport'!
  505. !ClassProtocolReader commentStamp!
  506. I provide a mechanism for retrieving class descriptions stored on a file in the Smalltalk chunk format.!
  507. !ClassProtocolReader methodsFor: 'accessing'!
  508. class: aClass category: aString
  509. class := aClass.
  510. category := aString
  511. ! !
  512. !ClassProtocolReader methodsFor: 'fileIn'!
  513. scanFrom: aChunkParser
  514. | chunk |
  515. [ chunk := aChunkParser nextChunk.
  516. chunk isEmpty ] whileFalse: [
  517. self compileMethod: chunk ]
  518. ! !
  519. !ClassProtocolReader methodsFor: 'initialization'!
  520. initialize
  521. super initialize.
  522. ! !
  523. !ClassProtocolReader methodsFor: 'private'!
  524. compileMethod: aString
  525. Compiler new install: aString forClass: class protocol: category
  526. ! !
  527. Object subclass: #ExportMethodProtocol
  528. instanceVariableNames: 'name theClass'
  529. package: 'Platform-ImportExport'!
  530. !ExportMethodProtocol commentStamp!
  531. I am an abstraction for a method protocol in a class / metaclass.
  532. I know of my class, name and methods.
  533. I am used when exporting a package.!
  534. !ExportMethodProtocol methodsFor: 'accessing'!
  535. methods
  536. ^ (self theClass methodsInProtocol: self name)
  537. sorted: [ :a :b | a selector <= b selector ]
  538. !
  539. name
  540. ^ name
  541. !
  542. name: aString
  543. name := aString
  544. !
  545. ownMethods
  546. ^ (self theClass ownMethodsInProtocol: self name)
  547. sorted: [ :a :b | a selector <= b selector ]
  548. !
  549. theClass
  550. ^ theClass
  551. !
  552. theClass: aClass
  553. theClass := aClass
  554. ! !
  555. !ExportMethodProtocol class methodsFor: 'instance creation'!
  556. name: aString theClass: aClass
  557. ^ self new
  558. name: aString;
  559. theClass: aClass;
  560. yourself
  561. ! !
  562. Object subclass: #Importer
  563. instanceVariableNames: 'lastSection lastChunk'
  564. package: 'Platform-ImportExport'!
  565. !Importer commentStamp!
  566. I can import Amber code from a string in the chunk format.
  567. ## API
  568. Importer new import: aString!
  569. !Importer methodsFor: 'accessing'!
  570. lastChunk
  571. ^ lastChunk
  572. !
  573. lastSection
  574. ^ lastSection
  575. ! !
  576. !Importer methodsFor: 'fileIn'!
  577. import: aStream
  578. | chunk result parser lastEmpty |
  579. parser := ChunkParser on: aStream.
  580. lastEmpty := false.
  581. lastSection := 'n/a, not started'.
  582. lastChunk := nil.
  583. [
  584. [ chunk := parser nextChunk.
  585. chunk isNil ] whileFalse: [
  586. chunk
  587. ifEmpty: [ lastEmpty := true ]
  588. ifNotEmpty: [
  589. lastSection := chunk.
  590. result := Compiler new evaluateExpression: chunk.
  591. lastEmpty
  592. ifTrue: [
  593. lastEmpty := false.
  594. result scanFrom: parser ]] ].
  595. lastSection := 'n/a, finished'
  596. ] on: Error do: [:e | lastChunk := parser last. e resignal ].
  597. ! !
  598. Error subclass: #PackageCommitError
  599. instanceVariableNames: ''
  600. package: 'Platform-ImportExport'!
  601. !PackageCommitError commentStamp!
  602. I get signaled when an attempt to commit a package has failed.!
  603. Object subclass: #PackageHandler
  604. instanceVariableNames: ''
  605. package: 'Platform-ImportExport'!
  606. !PackageHandler commentStamp!
  607. I am responsible for handling package loading and committing.
  608. I should not be used directly. Instead, use the corresponding `Package` methods.!
  609. !PackageHandler methodsFor: 'accessing'!
  610. chunkContentsFor: aPackage
  611. ^ String streamContents: [ :str |
  612. self chunkExporter exportPackage: aPackage on: str ]
  613. !
  614. chunkExporterClass
  615. ^ ChunkExporter
  616. !
  617. commitPathJsFor: aPackage
  618. self subclassResponsibility
  619. !
  620. commitPathStFor: aPackage
  621. self subclassResponsibility
  622. !
  623. contentsFor: aPackage
  624. ^ String streamContents: [ :str |
  625. self exporter exportPackage: aPackage on: str ]
  626. !
  627. exporterClass
  628. self subclassResponsibility
  629. ! !
  630. !PackageHandler methodsFor: 'committing'!
  631. commit: aPackage
  632. self
  633. commit: aPackage
  634. onSuccess: []
  635. onError: [ :error |
  636. PackageCommitError new
  637. messageText: 'Commiting failed with reason: "' , (error responseText) , '"';
  638. signal ]
  639. !
  640. commit: aPackage onSuccess: aBlock onError: anotherBlock
  641. self
  642. commitJsFileFor: aPackage
  643. onSuccess: [
  644. self
  645. commitStFileFor: aPackage
  646. onSuccess: [ aPackage beClean. aBlock value ]
  647. onError: anotherBlock ]
  648. onError: anotherBlock
  649. !
  650. commitJsFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  651. self
  652. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  653. data: (self contentsFor: aPackage)
  654. onSuccess: aBlock
  655. onError: anotherBlock
  656. !
  657. commitStFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  658. self
  659. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  660. data: (self chunkContentsFor: aPackage)
  661. onSuccess: aBlock
  662. onError: anotherBlock
  663. ! !
  664. !PackageHandler methodsFor: 'error handling'!
  665. onCommitError: anError
  666. PackageCommitError new
  667. messageText: 'Commiting failed with reason: "' , (anError responseText) , '"';
  668. signal
  669. ! !
  670. !PackageHandler methodsFor: 'factory'!
  671. chunkExporter
  672. ^ self chunkExporterClass new
  673. !
  674. exporter
  675. ^ self exporterClass new
  676. ! !
  677. !PackageHandler methodsFor: 'loading'!
  678. load: aPackage
  679. self subclassResponsibility
  680. ! !
  681. !PackageHandler methodsFor: 'private'!
  682. ajaxPutAt: aURL data: aString onSuccess: aBlock onError: anotherBlock
  683. | xhr |
  684. xhr := Platform newXhr.
  685. xhr open: 'PUT' url: aURL async: true.
  686. xhr onreadystatechange: [
  687. xhr readyState = 4 ifTrue: [
  688. (xhr status >= 200 and: [ xhr status < 300 ])
  689. ifTrue: aBlock
  690. ifFalse: anotherBlock ]].
  691. xhr send: aString
  692. ! !
  693. PackageHandler subclass: #AmdPackageHandler
  694. instanceVariableNames: ''
  695. package: 'Platform-ImportExport'!
  696. !AmdPackageHandler commentStamp!
  697. I am responsible for handling package loading and committing.
  698. I should not be used directly. Instead, use the corresponding `Package` methods.!
  699. !AmdPackageHandler methodsFor: 'accessing'!
  700. commitPathJsFor: aPackage
  701. ^ self toUrl: (self namespaceFor: aPackage)
  702. !
  703. commitPathStFor: aPackage
  704. "If _source is not mapped, .st will be committed to .js path.
  705. It is recommended not to use _source as it can be deprecated."
  706. | path pathWithout |
  707. path := self toUrl: (self namespaceFor: aPackage), '/_source'.
  708. pathWithout := self commitPathJsFor: aPackage.
  709. ^ path = (pathWithout, '/_source') ifTrue: [ pathWithout ] ifFalse: [ path ]
  710. !
  711. exporterClass
  712. ^ AmdExporter
  713. ! !
  714. !AmdPackageHandler methodsFor: 'committing'!
  715. namespaceFor: aPackage
  716. ^ aPackage transport namespace
  717. ! !
  718. !AmdPackageHandler methodsFor: 'loading'!
  719. load: aPackage
  720. Smalltalk amdRequire
  721. ifNil: [ self error: 'AMD loader not present' ]
  722. ifNotNil: [ :require |
  723. require value: (Array with: (self namespaceFor: aPackage), '/', aPackage name ) ]
  724. ! !
  725. !AmdPackageHandler methodsFor: 'private'!
  726. toUrl: aString
  727. ^ Smalltalk amdRequire
  728. ifNil: [ self error: 'AMD loader not present' ]
  729. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  730. ! !
  731. !AmdPackageHandler class methodsFor: 'commit paths'!
  732. defaultNamespace
  733. ^ Smalltalk defaultAmdNamespace
  734. !
  735. defaultNamespace: aString
  736. Smalltalk defaultAmdNamespace: aString
  737. ! !
  738. Object subclass: #PackageTransport
  739. instanceVariableNames: 'package'
  740. package: 'Platform-ImportExport'!
  741. !PackageTransport commentStamp!
  742. I represent the transport mechanism used to commit a package.
  743. My concrete subclasses have a `#handler` to which committing is delegated.!
  744. !PackageTransport methodsFor: 'accessing'!
  745. commitHandlerClass
  746. self subclassResponsibility
  747. !
  748. definition
  749. ^ ''
  750. !
  751. package
  752. ^ package
  753. !
  754. package: aPackage
  755. package := aPackage
  756. !
  757. type
  758. ^ self class type
  759. ! !
  760. !PackageTransport methodsFor: 'committing'!
  761. commit
  762. self commitHandler commit: self package
  763. !
  764. commitOnSuccess: aBlock onError: anotherBlock
  765. self commitHandler
  766. commit: self package
  767. onSuccess: aBlock
  768. onError: anotherBlock
  769. ! !
  770. !PackageTransport methodsFor: 'converting'!
  771. asJavaScriptObject
  772. ^ #{ 'type' -> self type }
  773. ! !
  774. !PackageTransport methodsFor: 'factory'!
  775. commitHandler
  776. ^ self commitHandlerClass new
  777. ! !
  778. !PackageTransport methodsFor: 'initialization'!
  779. setupFromJson: anObject
  780. "no op. override if needed in subclasses"
  781. ! !
  782. !PackageTransport methodsFor: 'loading'!
  783. load
  784. self commitHandler load: self package
  785. ! !
  786. PackageTransport class instanceVariableNames: 'registry'!
  787. !PackageTransport class methodsFor: 'accessing'!
  788. classRegisteredFor: aString
  789. ^ registry at: aString
  790. !
  791. defaultType
  792. ^ AmdPackageTransport type
  793. !
  794. type
  795. "Override in subclasses"
  796. ^ nil
  797. ! !
  798. !PackageTransport class methodsFor: 'initialization'!
  799. initialize
  800. super initialize.
  801. self == PackageTransport
  802. ifTrue: [ registry := #{} ]
  803. ifFalse: [ self register ]
  804. ! !
  805. !PackageTransport class methodsFor: 'instance creation'!
  806. for: aString
  807. ^ (self classRegisteredFor: aString) new
  808. !
  809. fromJson: anObject
  810. anObject ifNil: [ ^ self for: self defaultType ].
  811. ^ (self for: anObject type)
  812. setupFromJson: anObject;
  813. yourself
  814. ! !
  815. !PackageTransport class methodsFor: 'registration'!
  816. register
  817. PackageTransport register: self
  818. !
  819. register: aClass
  820. aClass type ifNotNil: [
  821. registry at: aClass type put: aClass ]
  822. ! !
  823. PackageTransport subclass: #AmdPackageTransport
  824. instanceVariableNames: 'namespace'
  825. package: 'Platform-ImportExport'!
  826. !AmdPackageTransport commentStamp!
  827. I am the default transport for committing packages.
  828. See `AmdExporter` and `AmdPackageHandler`.!
  829. !AmdPackageTransport methodsFor: 'accessing'!
  830. commitHandlerClass
  831. ^ AmdPackageHandler
  832. !
  833. definition
  834. ^ String streamContents: [ :stream | stream
  835. write: { self class name. ' namespace: ' }; print: self namespace ]
  836. !
  837. namespace
  838. ^ namespace ifNil: [ self defaultNamespace ]
  839. !
  840. namespace: aString
  841. namespace := aString
  842. ! !
  843. !AmdPackageTransport methodsFor: 'actions'!
  844. setPath: aString
  845. "Set the path the the receiver's `namespace`"
  846. (require basicAt: 'config') value: #{
  847. 'paths' -> #{
  848. self namespace -> aString
  849. }
  850. }.
  851. ! !
  852. !AmdPackageTransport methodsFor: 'converting'!
  853. asJavaScriptObject
  854. ^ super asJavaScriptObject
  855. at: 'amdNamespace' put: self namespace;
  856. yourself
  857. ! !
  858. !AmdPackageTransport methodsFor: 'defaults'!
  859. defaultNamespace
  860. ^ Smalltalk defaultAmdNamespace
  861. ! !
  862. !AmdPackageTransport methodsFor: 'initialization'!
  863. setupFromJson: anObject
  864. self namespace: (anObject at: 'amdNamespace')
  865. ! !
  866. !AmdPackageTransport methodsFor: 'printing'!
  867. printOn: aStream
  868. super printOn: aStream.
  869. aStream
  870. nextPutAll: ' (AMD Namespace: ';
  871. nextPutAll: self namespace;
  872. nextPutAll: ')'
  873. ! !
  874. !AmdPackageTransport class methodsFor: 'accessing'!
  875. type
  876. ^ 'amd'
  877. ! !
  878. !AmdPackageTransport class methodsFor: 'instance creation'!
  879. namespace: aString
  880. ^ self new
  881. namespace: aString;
  882. yourself
  883. ! !
  884. !Class methodsFor: '*Platform-ImportExport'!
  885. exportBehaviorDefinitionTo: aStream using: anExporter
  886. anExporter exportDefinitionOf: self on: aStream
  887. ! !
  888. !Metaclass methodsFor: '*Platform-ImportExport'!
  889. exportBehaviorDefinitionTo: aStream using: anExporter
  890. anExporter exportMetaDefinitionOf: self instanceClass on: aStream
  891. ! !
  892. !Package methodsFor: '*Platform-ImportExport'!
  893. commit
  894. ^ self transport commit
  895. !
  896. load
  897. ^ self transport load
  898. !
  899. loadFromNamespace: aString
  900. ^ self transport
  901. namespace: aString;
  902. load
  903. ! !
  904. !Package class methodsFor: '*Platform-ImportExport'!
  905. load: aPackageName
  906. (self named: aPackageName) load
  907. !
  908. load: aPackageName fromNamespace: aString
  909. (self named: aPackageName) loadFromNamespace: aString
  910. ! !
  911. !TBehaviorProvider methodsFor: '*Platform-ImportExport'!
  912. methodsFor: aString
  913. ^ ClassProtocolReader new
  914. class: self category: aString;
  915. yourself
  916. !
  917. methodsFor: aString stamp: aStamp
  918. "Added for file-in compatibility, ignores stamp."
  919. ^ self methodsFor: aString
  920. ! !
  921. !TMasterBehavior methodsFor: '*Platform-ImportExport'!
  922. commentStamp
  923. ^ ClassCommentReader new
  924. class: self;
  925. yourself
  926. !
  927. commentStamp: aStamp prior: prior
  928. ^ self commentStamp
  929. ! !
  930. !Trait methodsFor: '*Platform-ImportExport'!
  931. exportBehaviorDefinitionTo: aStream using: anExporter
  932. anExporter exportTraitDefinitionOf: self on: aStream
  933. ! !