2
0

Kernel-ImportExport.st 21 KB

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