2
0

Importer-Exporter.st 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835
  1. Smalltalk current createPackage: 'Importer-Exporter'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Importer-Exporter'!
  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 methods ].
  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 sorting (dependency resolution) does not matter here.
  23. Not sorting improves the speed by a number of magnitude."
  24. Smalltalk current classes do: [ :each |
  25. {each. each class} do: [ :behavior |
  26. (behavior protocols includes: extensionName) ifTrue: [
  27. result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
  28. ^ result
  29. ! !
  30. !AbstractExporter methodsFor: 'convenience'!
  31. chunkEscape: aString
  32. "Replace all occurrences of !! with !!!! and trim at both ends."
  33. ^ (aString replace: '!!' with: '!!!!') trimBoth
  34. !
  35. classNameFor: aClass
  36. ^ aClass isMetaclass
  37. ifTrue: [ aClass instanceClass name, ' class' ]
  38. ifFalse: [
  39. aClass isNil
  40. ifTrue: [ 'nil' ]
  41. ifFalse: [ aClass name ] ]
  42. ! !
  43. !AbstractExporter methodsFor: 'output'!
  44. exportPackage: aPackage on: aStream
  45. self subclassResponsibility
  46. ! !
  47. AbstractExporter subclass: #ChunkExporter
  48. instanceVariableNames: ''
  49. package: 'Importer-Exporter'!
  50. !ChunkExporter commentStamp!
  51. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  52. I do not output any compiled code.!
  53. !ChunkExporter methodsFor: 'accessing'!
  54. extensionCategoriesOfPackage: aPackage
  55. "Issue #143: sort protocol alphabetically"
  56. | name map result |
  57. name := aPackage name.
  58. result := OrderedCollection new.
  59. (Package sortedClasses: Smalltalk current classes) do: [ :each |
  60. {each. each class} do: [ :aClass |
  61. map := Dictionary new.
  62. aClass protocolsDo: [ :category :methods |
  63. category = ('*', name) ifTrue: [ map at: category put: methods ] ].
  64. result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |
  65. MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].
  66. ^ result
  67. !
  68. ownCategoriesOfClass: aClass
  69. "Answer the protocols of aClass that are not package extensions"
  70. "Issue #143: sort protocol alphabetically"
  71. | map |
  72. map := Dictionary new.
  73. aClass protocolsDo: [ :each :methods |
  74. (each match: '^\*') ifFalse: [ map at: each put: methods ] ].
  75. ^ (map keys sorted: [ :a :b | a <= b ]) collect: [ :each |
  76. MethodCategory name: each theClass: aClass methods: (map at: each) ]
  77. !
  78. ownCategoriesOfMetaClass: aClass
  79. "Issue #143: sort protocol alphabetically"
  80. ^ self ownCategoriesOfClass: aClass class
  81. !
  82. ownMethodProtocolsOfClass: aClass
  83. "Answer a collection of ExportMethodProtocol object of aClass that are not package extensions"
  84. ^ aClass ownProtocols collect: [ :each |
  85. ExportMethodProtocol name: each theClass: aClass ]
  86. ! !
  87. !ChunkExporter methodsFor: 'output'!
  88. exportCategoryEpilogueOf: aCategory on: aStream
  89. aStream nextPutAll: ' !!'; lf; lf
  90. !
  91. exportCategoryPrologueOf: aCategory on: aStream
  92. aStream
  93. nextPutAll: '!!', (self classNameFor: aCategory theClass);
  94. nextPutAll: ' methodsFor: ''', aCategory name, '''!!'
  95. !
  96. exportDefinitionOf: aClass on: aStream
  97. "Chunk format."
  98. aStream
  99. nextPutAll: (self classNameFor: aClass superclass);
  100. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  101. tab; nextPutAll: 'instanceVariableNames: '''.
  102. aClass instanceVariableNames
  103. do: [ :each | aStream nextPutAll: each ]
  104. separatedBy: [ aStream nextPutAll: ' ' ].
  105. aStream
  106. nextPutAll: ''''; lf;
  107. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  108. aClass comment notEmpty ifTrue: [
  109. aStream
  110. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  111. nextPutAll: (self chunkEscape: aClass comment), '!!';lf ].
  112. aStream lf
  113. !
  114. exportMetaDefinitionOf: aClass on: aStream
  115. aClass class instanceVariableNames isEmpty ifFalse: [
  116. aStream
  117. nextPutAll: (self classNameFor: aClass class);
  118. nextPutAll: ' instanceVariableNames: '''.
  119. aClass class instanceVariableNames
  120. do: [ :each | aStream nextPutAll: each ]
  121. separatedBy: [ aStream nextPutAll: ' ' ].
  122. aStream
  123. nextPutAll: '''!!'; lf; lf ]
  124. !
  125. exportMethod: aMethod on: aStream
  126. aStream
  127. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  128. nextPutAll: '!!'
  129. !
  130. exportPackage: aPackage on: aStream
  131. self exportPackageDefinitionOf: aPackage on: aStream.
  132. aPackage sortedClasses do: [ :each |
  133. self exportDefinitionOf: each on: aStream.
  134. self
  135. exportProtocols: (self ownMethodProtocolsOfClass: each)
  136. on: aStream.
  137. self exportMetaDefinitionOf: each on: aStream.
  138. self
  139. exportProtocols: (self ownMethodProtocolsOfClass: each class)
  140. on: aStream ].
  141. self
  142. exportProtocols: (self extensionProtocolsOfPackage: aPackage)
  143. on: aStream
  144. !
  145. exportPackageDefinitionOf: aPackage on: aStream
  146. aStream
  147. nextPutAll: 'Smalltalk current createPackage: ''', aPackage name, '''!!';
  148. lf
  149. !
  150. exportProtocol: aProtocol on: aStream
  151. self exportProtocolPrologueOf: aProtocol on: aStream.
  152. aProtocol methods do: [ :method |
  153. self exportMethod: method on: aStream ].
  154. self exportProtocolEpilogueOf: aProtocol on: aStream
  155. !
  156. exportProtocolEpilogueOf: aProtocol on: aStream
  157. aStream nextPutAll: ' !!'; lf; lf
  158. !
  159. exportProtocolPrologueOf: aProtocol on: aStream
  160. aStream
  161. nextPutAll: '!!', (self classNameFor: aProtocol theClass);
  162. nextPutAll: ' methodsFor: ''', aProtocol name, '''!!'
  163. !
  164. exportProtocols: aCollection on: aStream
  165. aCollection do: [ :each |
  166. self exportProtocol: each on: aStream ]
  167. ! !
  168. AbstractExporter subclass: #Exporter
  169. instanceVariableNames: ''
  170. package: 'Importer-Exporter'!
  171. !Exporter commentStamp!
  172. I am responsible for outputting Amber code into a JavaScript string.
  173. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  174. ## Use case
  175. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  176. !Exporter methodsFor: 'accessing'!
  177. ownMethodsOfClass: aClass
  178. "Issue #143: sort methods alphabetically"
  179. ^ ((aClass methodDictionary values) sorted: [ :a :b | a selector <= b selector ])
  180. reject: [ :each | (each category match: '^\*') ]
  181. !
  182. ownMethodsOfMetaClass: aClass
  183. "Issue #143: sort methods alphabetically"
  184. ^ self ownMethodsOfClass: aClass class
  185. ! !
  186. !Exporter methodsFor: 'convenience'!
  187. classNameFor: aClass
  188. ^ aClass isMetaclass
  189. ifTrue: [ aClass instanceClass name, '.klass' ]
  190. ifFalse: [
  191. aClass isNil
  192. ifTrue: [ 'nil' ]
  193. ifFalse: [ aClass name ] ]
  194. ! !
  195. !Exporter methodsFor: 'output'!
  196. exportDefinitionOf: aClass on: aStream
  197. aStream
  198. lf;
  199. nextPutAll: 'smalltalk.addClass(';
  200. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  201. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  202. nextPutAll: ', ['.
  203. aClass instanceVariableNames
  204. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  205. separatedBy: [ aStream nextPutAll: ', ' ].
  206. aStream
  207. nextPutAll: '], ''';
  208. nextPutAll: aClass category, '''';
  209. nextPutAll: ');'.
  210. aClass comment notEmpty ifTrue: [
  211. aStream
  212. lf;
  213. nextPutAll: 'smalltalk.';
  214. nextPutAll: (self classNameFor: aClass);
  215. nextPutAll: '.comment=';
  216. nextPutAll: aClass comment asJavascript;
  217. nextPutAll: ';' ].
  218. aStream lf
  219. !
  220. exportMetaDefinitionOf: aClass on: aStream
  221. aStream lf.
  222. aClass class instanceVariableNames isEmpty ifFalse: [
  223. aStream
  224. nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
  225. nextPutAll: '.iVarNames = ['.
  226. aClass class instanceVariableNames
  227. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  228. separatedBy: [ aStream nextPutAll: ',' ].
  229. aStream nextPutAll: '];', String lf ]
  230. !
  231. exportMethod: aMethod on: aStream
  232. aStream
  233. nextPutAll: 'smalltalk.addMethod(';lf;
  234. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  235. nextPutAll: 'smalltalk.method({';lf;
  236. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  237. nextPutAll: 'category: ''', aMethod category, ''',';lf;
  238. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  239. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  240. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  241. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  242. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
  243. aStream
  244. lf;
  245. nextPutAll: '}),';lf;
  246. nextPutAll: 'smalltalk.', (self classNameFor: aMethod methodClass);
  247. nextPutAll: ');';lf;lf
  248. !
  249. exportPackage: aPackage on: aStream
  250. self
  251. exportPackagePrologueOf: aPackage on: aStream;
  252. exportPackageDefinitionOf: aPackage on: aStream;
  253. exportPackageTransportOf: aPackage on: aStream.
  254. aPackage sortedClasses do: [ :each |
  255. self exportDefinitionOf: each on: aStream.
  256. each ownMethods do: [ :method |
  257. self exportMethod: method on: aStream ].
  258. self exportMetaDefinitionOf: each on: aStream.
  259. each class ownMethods do: [ :method |
  260. self exportMethod: method on: aStream ] ].
  261. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  262. self exportMethod: each on: aStream ].
  263. self exportPackageEpilogueOf: aPackage on: aStream
  264. !
  265. exportPackageDefinitionOf: aPackage on: aStream
  266. aStream
  267. nextPutAll: 'smalltalk.addPackage(';
  268. nextPutAll: '''', aPackage name, ''');';
  269. lf
  270. !
  271. exportPackageEpilogueOf: aPackage on: aStream
  272. aStream
  273. nextPutAll: '})(global_smalltalk,global_nil,global__st);';
  274. lf
  275. !
  276. exportPackagePrologueOf: aPackage on: aStream
  277. aStream
  278. nextPutAll: '(function(smalltalk,nil,_st){';
  279. lf
  280. !
  281. exportPackageTransportOf: aPackage on: aStream
  282. aStream
  283. nextPutAll: 'smalltalk.packages[';
  284. nextPutAll: aPackage name asJavascript;
  285. nextPutAll: '].transport = ';
  286. nextPutAll: aPackage transport asJSONString;
  287. nextPutAll: ';';
  288. lf
  289. ! !
  290. Exporter subclass: #AmdExporter
  291. instanceVariableNames: 'namespace'
  292. package: 'Importer-Exporter'!
  293. !AmdExporter commentStamp!
  294. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  295. !AmdExporter methodsFor: 'output'!
  296. exportPackageEpilogueOf: aPackage on: aStream
  297. aStream
  298. nextPutAll: '});';
  299. lf
  300. !
  301. exportPackagePrologueOf: aPackage on: aStream
  302. aStream
  303. nextPutAll: 'define("';
  304. nextPutAll: (self amdNamespaceOfPackage: aPackage);
  305. nextPutAll: '/';
  306. nextPutAll: aPackage name;
  307. nextPutAll: '", ';
  308. nextPutAll: (#('amber_vm/smalltalk' 'amber_vm/nil' 'amber_vm/_st'), (self amdNamesOfPackages: aPackage loadDependencies)) asJavascript;
  309. nextPutAll: ', function(smalltalk,nil,_st){';
  310. lf
  311. ! !
  312. !AmdExporter methodsFor: 'private'!
  313. amdNamesOfPackages: anArray
  314. ^ (anArray
  315. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  316. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  317. !
  318. amdNamespaceOfPackage: aPackage
  319. ^ (aPackage transport type = 'amd')
  320. ifTrue: [ aPackage transport namespace ]
  321. ifFalse: [ nil ]
  322. ! !
  323. Object subclass: #ChunkParser
  324. instanceVariableNames: 'stream'
  325. package: 'Importer-Exporter'!
  326. !ChunkParser commentStamp!
  327. I am responsible for parsing aStream contents in the chunk format.
  328. ## API
  329. ChunkParser new
  330. stream: aStream;
  331. nextChunk!
  332. !ChunkParser methodsFor: 'accessing'!
  333. stream: aStream
  334. stream := aStream
  335. ! !
  336. !ChunkParser methodsFor: 'reading'!
  337. nextChunk
  338. "The chunk format (Smalltalk Interchange Format or Fileout format)
  339. is a trivial format but can be a bit tricky to understand:
  340. - Uses the exclamation mark as delimiter of chunks.
  341. - Inside a chunk a normal exclamation mark must be doubled.
  342. - A non empty chunk must be a valid Smalltalk expression.
  343. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  344. - The object created by the expression then takes over reading chunks.
  345. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  346. | char result chunk |
  347. result := '' writeStream.
  348. [ char := stream next.
  349. char notNil ] whileTrue: [
  350. char = '!!' ifTrue: [
  351. stream peek = '!!'
  352. ifTrue: [ stream next "skipping the escape double" ]
  353. ifFalse: [ ^ result contents trimBoth "chunk end marker found" ]].
  354. result nextPut: char ].
  355. ^ nil "a chunk needs to end with !!"
  356. ! !
  357. !ChunkParser class methodsFor: 'instance creation'!
  358. on: aStream
  359. ^ self new stream: aStream
  360. ! !
  361. Object subclass: #ExportMethodProtocol
  362. instanceVariableNames: 'name theClass'
  363. package: 'Importer-Exporter'!
  364. !ExportMethodProtocol commentStamp!
  365. I am an abstraction for a method protocol in a class / metaclass.
  366. I know of my class, name and methods.
  367. I am used when exporting a package.!
  368. !ExportMethodProtocol methodsFor: 'accessing'!
  369. methods
  370. ^ (self theClass methodsInProtocol: self name)
  371. sorted: [ :a :b | a selector <= b selector ]
  372. !
  373. name
  374. ^ name
  375. !
  376. name: aString
  377. name := aString
  378. !
  379. theClass
  380. ^ theClass
  381. !
  382. theClass: aClass
  383. theClass := aClass
  384. ! !
  385. !ExportMethodProtocol class methodsFor: 'instance creation'!
  386. name: aString theClass: aClass
  387. ^ self new
  388. name: aString;
  389. theClass: aClass;
  390. yourself
  391. ! !
  392. Object subclass: #Importer
  393. instanceVariableNames: ''
  394. package: 'Importer-Exporter'!
  395. !Importer commentStamp!
  396. I can import Amber code from a string in the chunk format.
  397. ## API
  398. Importer new import: aString!
  399. !Importer methodsFor: 'fileIn'!
  400. import: aStream
  401. | chunk result parser lastEmpty |
  402. parser := ChunkParser on: aStream.
  403. lastEmpty := false.
  404. [ chunk := parser nextChunk.
  405. chunk isNil ] whileFalse: [
  406. chunk isEmpty
  407. ifTrue: [ lastEmpty := true ]
  408. ifFalse: [
  409. result := Compiler new evaluateExpression: chunk.
  410. lastEmpty
  411. ifTrue: [
  412. lastEmpty := false.
  413. result scanFrom: parser ]] ]
  414. ! !
  415. InterfacingObject subclass: #PackageHandler
  416. instanceVariableNames: ''
  417. package: 'Importer-Exporter'!
  418. !PackageHandler commentStamp!
  419. I am responsible for handling package loading and committing.
  420. I should not be used directly. Instead, use the corresponding `Package` methods.!
  421. !PackageHandler methodsFor: 'accessing'!
  422. chunkContentsFor: aPackage
  423. ^ String streamContents: [ :str |
  424. self chunkExporter exportPackage: aPackage on: str ]
  425. !
  426. chunkExporterClass
  427. ^ ChunkExporter
  428. !
  429. commitPathJsFor: aPackage
  430. self subclassResponsibility
  431. !
  432. commitPathStFor: aPackage
  433. self subclassResponsibility
  434. !
  435. contentsFor: aPackage
  436. ^ String streamContents: [ :str |
  437. self exporter exportPackage: aPackage on: str ]
  438. !
  439. exporterClass
  440. ^ Exporter
  441. ! !
  442. !PackageHandler methodsFor: 'committing'!
  443. commit: aPackage
  444. {
  445. [ self commitStFileFor: aPackage ].
  446. [ self commitJsFileFor: aPackage ]
  447. }
  448. do: [ :each | each value ]
  449. displayingProgress: 'Committing package ', aPackage name
  450. !
  451. commitJsFileFor: aPackage
  452. self
  453. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  454. data: (self contentsFor: aPackage)
  455. !
  456. commitStFileFor: aPackage
  457. self
  458. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  459. data: (self chunkContentsFor: aPackage)
  460. ! !
  461. !PackageHandler methodsFor: 'factory'!
  462. chunkExporter
  463. ^ self chunkExporterClass new
  464. !
  465. exporter
  466. ^ self exporterClass new
  467. ! !
  468. !PackageHandler methodsFor: 'private'!
  469. ajaxPutAt: aURL data: aString
  470. self
  471. ajax: #{
  472. 'url' -> aURL.
  473. 'type' -> 'PUT'.
  474. 'data' -> aString.
  475. 'contentType' -> 'text/plain;charset=UTF-8'.
  476. 'error' -> [ :xhr | self alert: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"' ] }
  477. ! !
  478. PackageHandler subclass: #AmdPackageHandler
  479. instanceVariableNames: ''
  480. package: 'Importer-Exporter'!
  481. !AmdPackageHandler commentStamp!
  482. I am responsible for handling package loading and committing.
  483. I should not be used directly. Instead, use the corresponding `Package` methods.!
  484. !AmdPackageHandler methodsFor: 'accessing'!
  485. commitPathJsFor: aPackage
  486. ^ self toUrl: (self namespaceFor: aPackage)
  487. !
  488. commitPathStFor: aPackage
  489. "if _source is not mapped, .st commit will likely fail"
  490. ^ self toUrl: (self namespaceFor: aPackage), '/_source'.
  491. !
  492. exporterClass
  493. ^ AmdExporter
  494. ! !
  495. !AmdPackageHandler methodsFor: 'committing'!
  496. namespaceFor: aPackage
  497. ^ aPackage transport namespace
  498. ! !
  499. !AmdPackageHandler methodsFor: 'private'!
  500. toUrl: aString
  501. ^ Smalltalk current amdRequire
  502. ifNil: [ self error: 'AMD loader not present' ]
  503. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  504. ! !
  505. !AmdPackageHandler class methodsFor: 'commit paths'!
  506. defaultNamespace
  507. ^ Smalltalk current defaultAmdNamespace
  508. !
  509. defaultNamespace: aString
  510. Smalltalk current defaultAmdNamespace: aString
  511. ! !
  512. Object subclass: #PackageTransport
  513. instanceVariableNames: 'package'
  514. package: 'Importer-Exporter'!
  515. !PackageTransport commentStamp!
  516. I represent the transport mechanism used to commit a package.
  517. My concrete subclasses have a `#handler` to which committing is delegated.!
  518. !PackageTransport methodsFor: 'accessing'!
  519. commitHandlerClass
  520. self subclassResponsibility
  521. !
  522. definition
  523. ^ ''
  524. !
  525. package
  526. ^ package
  527. !
  528. package: aPackage
  529. package := aPackage
  530. !
  531. type
  532. ^ self class type
  533. ! !
  534. !PackageTransport methodsFor: 'committing'!
  535. commit
  536. self commitHandler commit: self package
  537. ! !
  538. !PackageTransport methodsFor: 'converting'!
  539. asJSON
  540. ^ #{ 'type' -> self type }
  541. ! !
  542. !PackageTransport methodsFor: 'factory'!
  543. commitHandler
  544. ^ self commitHandlerClass new
  545. ! !
  546. !PackageTransport methodsFor: 'initialization'!
  547. setupFromJson: anObject
  548. "no op. override if needed in subclasses"
  549. ! !
  550. PackageTransport class instanceVariableNames: 'registry'!
  551. !PackageTransport class methodsFor: 'accessing'!
  552. classRegisteredFor: aString
  553. ^ registry at: aString
  554. !
  555. defaultType
  556. ^ AmdPackageTransport type
  557. !
  558. type
  559. "Override in subclasses"
  560. ^ nil
  561. ! !
  562. !PackageTransport class methodsFor: 'initialization'!
  563. initialize
  564. super initialize.
  565. registry := #{}.
  566. self register
  567. ! !
  568. !PackageTransport class methodsFor: 'instance creation'!
  569. for: aString
  570. ^ (self classRegisteredFor: aString) new
  571. !
  572. fromJson: anObject
  573. anObject ifNil: [ ^ self for: self defaultType ].
  574. ^ (self for: anObject type)
  575. setupFromJson: anObject;
  576. yourself
  577. ! !
  578. !PackageTransport class methodsFor: 'registration'!
  579. register
  580. PackageTransport register: self
  581. !
  582. register: aClass
  583. aClass type ifNotNil: [
  584. registry at: aClass type put: aClass ]
  585. ! !
  586. PackageTransport subclass: #AmdPackageTransport
  587. instanceVariableNames: 'namespace'
  588. package: 'Importer-Exporter'!
  589. !AmdPackageTransport commentStamp!
  590. I am the default transport for committing packages.
  591. See `AmdExporter` and `AmdPackageHandler`.!
  592. !AmdPackageTransport methodsFor: 'accessing'!
  593. commitHandlerClass
  594. ^ AmdPackageHandler
  595. !
  596. definition
  597. ^ String streamContents: [ :stream |
  598. stream
  599. nextPutAll: self class name;
  600. nextPutAll: ' namespace: ';
  601. nextPutAll: '''', self namespace, '''' ]
  602. !
  603. namespace
  604. ^ namespace ifNil: [ self defaultNamespace ]
  605. !
  606. namespace: aString
  607. namespace := aString
  608. ! !
  609. !AmdPackageTransport methodsFor: 'converting'!
  610. asJSON
  611. ^ super asJSON
  612. at: 'amdNamespace' put: self namespace;
  613. yourself
  614. ! !
  615. !AmdPackageTransport methodsFor: 'defaults'!
  616. defaultNamespace
  617. ^ Smalltalk current defaultAmdNamespace
  618. ! !
  619. !AmdPackageTransport methodsFor: 'initialization'!
  620. setupFromJson: anObject
  621. self namespace: (anObject at: 'amdNamespace')
  622. ! !
  623. !AmdPackageTransport methodsFor: 'printing'!
  624. printOn: aStream
  625. super printOn: aStream.
  626. aStream
  627. nextPutAll: ' (AMD Namespace: ';
  628. nextPutAll: self namespace;
  629. nextPutAll: ')'
  630. ! !
  631. !AmdPackageTransport class methodsFor: 'accessing'!
  632. type
  633. ^ 'amd'
  634. ! !
  635. !AmdPackageTransport class methodsFor: 'instance creation'!
  636. namespace: aString
  637. ^ self new
  638. namespace: aString;
  639. yourself
  640. ! !
  641. !Package methodsFor: '*Importer-Exporter'!
  642. commit
  643. ^ self transport commit
  644. ! !