modules/pkgwrite.st

   1 Package [
   2   PkgWriter
   3 ]
   4
   5
   6 class: PackageWriter [
   7   | file pkg visited |
   8
   9   ^write: pkgName to: fileName [
  10     | obj fl pkg |
  11     (pkg := Package find: pkgName) ifNil: [ self error: 'no package: ' + (pkgName asString) ].
  12     fl := File openWrite: fileName.
  13     obj := super new.
  14     self in: obj at: 1 put: fl.
  15     self in: obj at: 2 put: pkg.
  16     self in: obj at: 3 put: nil.
  17     obj writeSource.
  18     ^true
  19   ]
  20
  21   writeSource [
  22     visited := Dictionary new.
  23     self writeClasses.
  24   ]
  25
  26   inPackage: cls [
  27     ^pkg classes includes: cls asString asSymbol
  28   ]
  29
  30   writeClasses [
  31     file write: 'Package [\n'.
  32     file write: '  '.
  33     file write: pkg name asString.
  34     file newline.
  35     file write: ']\n\n\n'.
  36     pkg classes do: [:cls | self writeClass: cls ].
  37   ]
  38
  39   writeClass: cls [
  40     ((cls isKindOf: Class) and: [ cls isMeta not ]) ifTrue: [
  41       (visited includes: cls asString asSymbol) ifFalse: [
  42         visited at: cls asString asSymbol put: true.
  43         (self inPackage: cls super) ifTrue: [
  44           self writeClass: cls super.
  45         ].
  46         'writing ' print. cls asString printNl.
  47         self writeOneClass: cls.
  48       ].
  49     ].
  50   ]
  51
  52   writeOneClass: cls [
  53     | vars parent |
  54     parent := cls super.
  55     file write: parent asString + ' subclass: ' + cls asString + ' '.
  56     vars := cls class variables.
  57     ((vars notNil) and: [ vars size > 0 ]) ifTrue: [
  58       file write: '|'.
  59       vars do: [:v | file write: ' ' + v asString ].
  60       file write: ' | '.
  61     ].
  62     file write: '[\n'.
  63     vars := cls variables.
  64     ((vars notNil) and: [ vars size > 0 ]) ifTrue: [
  65       file write: '|'.
  66       vars do: [:v | file write: ' ' + v asString ].
  67       file write: ' |\n'.
  68     ].
  69     self writeMethodsOf: cls class asMeta: true.
  70     self writeMethodsOf: cls asMeta: false.
  71     file write: ']\n\n'.
  72   ]
  73
  74   writeMethodsOf: cls asMeta: isMeta [
  75     | methods |
  76     methods := cls methods.
  77     methods ifNil: [ ^nil ].
  78     methods do: [:m | self writeMethod: m of: cls asMeta: isMeta ]
  79   ]
  80
  81   "FIXME: skip method name"
  82   writeMethod: meth of: cls asMeta: isMeta [
  83     | txt c |
  84     file newline.
  85     isMeta ifTrue: [ file write: '^' ].
  86     txt := meth text asString.
  87     c := txt indexOf: String newline.
  88     file write: (txt from: 1 to: c-1) removeTrailingBlanks.
  89     file write: ' [\n'.
  90     file write: (txt from: c+1)  removeTrailingBlanks.
  91     "Verify if txt ends with a newline"
  92     file write: '\n]\n'.
  93   ]
  94 ]