samples/guiCB.st

   1 Requires [ gui ]
   2
   3 Package [
   4   Browser
   5 ]
   6
   7
   8 class: Browser [
   9   | dialog
  10     lbPackages
  11     lbClasses
  12     lbMethods
  13     lbVars
  14     edText
  15   |
  16
  17   ^new [
  18     | obj |
  19     (obj := self basicNew) createDialog.
  20     ^obj
  21   ]
  22
  23   createLBArea: aText lb: aLb [
  24     ^(GuiVBox new); expandable; attribute: 'SIZE' value: '0x0';
  25       add: (GuiLabel new: aText; expandableHorizontal; attribute: 'SIZE' value: '0x0');
  26       "add: (aLb expandable; attribute: 'SIZE' value: '100x90'; attribute: 'VISIBLECOLUMNS' value: '1');"
  27       add: (aLb expandable; attribute: 'SIZE' value: '0x90'; attribute: 'VISIBLECOLUMNS' value: '1');
  28       add: ((GuiHBox new; expandableHorizontal; attribute: 'SIZE' value: '0x0');
  29         add: (GuiButton new: 'Create'; expandableHorizontal; attribute: 'SIZE' value: '0x0');
  30         add: (GuiButton new: 'Remove'; expandableHorizontal; attribute: 'SIZE' value: '0x0'));
  31     .
  32   ]
  33
  34   createDialog [
  35     | vb  hb  pa ca ma va split |
  36
  37     lbPackages := GuiList new; action: [ self fillClasses ].
  38     lbClasses := GuiList new; action: [ self fillMethods. self fillVars ].
  39     lbMethods := GuiList new; action: [ self showMethod ].
  40     lbVars := GuiList new.
  41
  42     edText := GuiMultiEdit new; expandable; attribute: 'SIZE' value: '0x120'.
  43
  44     pa := self createLBArea: 'Packages' lb: lbPackages.
  45     ca := self createLBArea: 'Classes' lb: lbClasses.
  46     ma := self createLBArea: 'Methods' lb: lbMethods.
  47     va := self createLBArea: 'Variables' lb: lbVars.
  48
  49     split := GuiVSplit new: ma and: va.
  50     split := GuiVSplit new: ca and: split.
  51     split := GuiVSplit new: pa and: split.
  52
  53     (hb := GuiHBox new);
  54       add: (GuiButton new: 'Apply' action: [ self applyMethod ]; expandableHorizontal);
  55       add: (GuiButton new: 'GST-compile' action: [ self gstCompile ]; expandableHorizontal);
  56     .
  57
  58     (vb := GuiVBox new);
  59       add: split;
  60       add: edText;
  61       add: hb;
  62     .
  63
  64     dialog := GuiDialog new: 'LST Class Browser' widget: vb onClose: [ GuiSingleton setQuitFlag ].
  65     self show.
  66
  67     self fillPackages.
  68   ]
  69
  70   fillPackages [
  71     lbPackages empty.
  72     Package packages keysDo: [:p | lbPackages << p asString ].
  73   ]
  74
  75   fillClasses [
  76     | si pkg |
  77     lbClasses empty.
  78     lbMethods empty.
  79     lbVars empty.
  80     (si := lbPackages selected) ifNil: [ ^self ].
  81     si := lbPackages at: si.
  82     pkg := Package find: si asSymbol.
  83     pkg ifNil: [ ^self ].
  84     pkg := pkg classes.
  85     pkg do: [:c | (c isKindOf: Class) ifTrue: [ c isMeta ifFalse: [ lbClasses << c asString ]]].
  86   ]
  87
  88   fillMethods [
  89     | si cls |
  90     lbMethods empty.
  91     lbVars empty.
  92     (si := lbClasses selected) ifNil: [ ^self ].
  93     si := lbClasses at: si.
  94     cls := globals at: (si asSymbol) ifAbsent: [ ^self ].
  95     cls class methods do: [:mth | lbMethods << ('^' + mth name asString) ].
  96     cls methods do: [:mth | lbMethods << mth name asString ].
  97   ]
  98
  99   fillVars [
 100     | si cls |
 101     lbVars empty.
 102     (si := lbClasses selected) ifNil: [ ^self ].
 103     si := lbClasses at: si.
 104     cls := globals at: (si asSymbol) ifAbsent: [ ^self ].
 105     cls class instanceVariables do: [:vn | lbVars << ('^' + vn asString) ].
 106     cls instanceVariables do: [:vn | lbVars << vn asString ].
 107   ]
 108
 109   showMethod [
 110     | si cls mth isMeta m |
 111     edText empty.
 112     (si := lbClasses selected) ifNil: [ ^self ].
 113     si := lbClasses at: si.
 114     cls := globals at: (si asSymbol) ifAbsent: [ ^self ].
 115     (si := lbMethods selected) ifNil: [ ^self ].
 116     si := lbMethods at: si.
 117     si firstChar == $^ ifTrue: [ cls := cls class. mth := si from: 2. isMeta := '^' ] ifFalse: [ mth := si. isMeta := '' ].
 118     m := cls findMethodInAll: mth asSymbol ifAbsent: [ ^self ].
 119     edText value: isMeta + m text.
 120   ]
 121
 122   dialog [
 123     ^dialog
 124   ]
 125
 126   show [
 127     dialog show
 128   ]
 129
 130   hide [
 131     dialog hide
 132   ]
 133 ]
 134
 135
 136
 137 {
 138   | browser |
 139   System newProcessGroupWith: (Process newWithMethod: #REPL class: REPL new).
 140
 141   browser := Browser new.
 142   GuiSingleton add: browser dialog.
 143   browser show.
 144   GuiSingleton mainLoop.
 145 }