StrongtalkSource/CommentOutliner.dlt

   1 Delta define: #CommentOutliner as: (\r
   2 (Class subclassOf: 'MirrorOutliner[Mirror]' instanceVariables: 'codeView <CodeView>')) !\r
   3 \r
   4 (Delta mirrorFor: #CommentOutliner) revision: '$Revision: 1.5 $'!\r
   5 \r
   6 (Delta mirrorFor: #CommentOutliner) group: 'outliner'!\r
   7 \r
   8 (Delta mirrorFor: #CommentOutliner)\r
   9 comment: \r
  10 '(c) 1995-1997 Sun Microsystems, Inc. ALL RIGHTS RESERVED. \r
  11 Use and distribution of this software is subject to the terms of the attached source license.'!\r
  12 \r
  13 ! (Delta mirrorFor: #CommentOutliner) methodsFor: 'private' !\r
  14 \r
  15 \r
  16 buildBody ^ <Visual>\r
  17 \r
  18 | result <Visual> |\r
  19 \r
  20         self codeView: (self    buildCodeViewGetModel: [ self commentAsGlyphs ]\r
  21                                                                         setModelOnSuccess: [ :blk <[]> | self storeAndOnSuccess: blk ]).\r
  22         result := self editorBorderFor: self codeView.\r
  23         self addLicenseButton. "Hack!!"\r
  24         ^result.\r
  25 !\r
  26 \r
  27 buildClosedHeader ^ <Visual>\r
  28 \r
  29         ^(StringGlyph for: self closedHeaderTitle painter: self sectionPainter) asVisual!\r
  30 \r
  31 buildOpenHeader ^ <Visual>\r
  32 \r
  33         ^(StringGlyph for: self openHeaderTitle painter: self sectionPainter) asVisual!\r
  34 \r
  35 closedHeaderTitle ^ <Str>\r
  36 \r
  37         | s <Str> |\r
  38         s := self comment readStream upTo: Character cr.\r
  39         (s isEmpty or: [ (s includes: $.) not ]) \r
  40                 ifTrue: [ ^self openHeaderTitle ].\r
  41 \r
  42         ('*copyright*' platformMatch: s)                                        "Temporary solution for Dave :-)"\r
  43                 ifTrue: [ ^self openHeaderTitle ].\r
  44 \r
  45         ^(s readStream upTo: $.), '.'\r
  46 !\r
  47 \r
  48 codeView ^<CodeView>\r
  49 \r
  50         ^codeView!\r
  51 \r
  52 codeView: cv <CodeView>\r
  53 \r
  54         codeView := cv!\r
  55 \r
  56 comment ^ <Str>\r
  57 \r
  58         ^self mirror comment!\r
  59 \r
  60 comment: s <Str>\r
  61 \r
  62         self mirror comment: s!\r
  63 \r
  64 commentAsGlyphs ^ <CharGlyphs>\r
  65 \r
  66         ^self standardTextForString: self mirror comment painter:self codePainter.!\r
  67 \r
  68 openHeaderTitle ^ <Str>\r
  69 \r
  70         ^'Comment'!\r
  71 \r
  72 storeAndOnSuccess: blk <[]>\r
  73 \r
  74         self comment: (self charGlyphModelAsString: self codeView).\r
  75         self updateClosedHeader.\r
  76         blk value.\r
  77 \r
  78 ! !\r
  79 \r
  80 ! (Delta mirrorFor: #CommentOutliner) methodsFor: 'menus' !\r
  81 \r
  82 \r
  83 hasMenu ^<Boolean>\r
  84 \r
  85         ^true!\r
  86 \r
  87 menuBar ^<Menu>\r
  88 \r
  89         ^Menu new\r
  90                 add: (MenuAction new\r
  91                                         name: '&Remove comment';\r
  92                                         active: [ self comment isEmpty not ];\r
  93                                         action: [ self removeComment ])! !\r
  94 \r
  95 ! (Delta mirrorFor: #CommentOutliner) methodsFor: 'dependencies' !\r
  96 \r
  97 \r
  98 update: aspect <Object> with: value <Object>\r
  99 \r
 100         self inSessionProcessDo: [\r
 101                 aspect = #comment\r
 102                         ifTrue: [       self updateClosedHeader.\r
 103                                                         self  codeView notNil \r
 104                                                                 ifTrue: [       self codeView model = self commentAsGlyphs\r
 105                                                                                                         ifFalse: [      self codeView model: self commentAsGlyphs ] ] ] ]\r
 106 ! !\r
 107 \r
 108 ! (Delta mirrorFor: #CommentOutliner) methodsFor: 'control' !\r
 109 \r
 110 \r
 111 removeComment\r
 112 \r
 113         | removeBlk <[]> |\r
 114         removeBlk := [ \r
 115                 self comment: ''. \r
 116                 self updateClosedHeader. \r
 117                 self updateBody.\r
 118                 self open: false ].\r
 119 \r
 120         self codeView isNil \r
 121                 ifTrue: removeBlk\r
 122                 ifFalse: [ self codeView closeRequest: removeBlk ]\r
 123 ! !\r
 124 \r
 125 ! (Delta mirrorFor: #CommentOutliner) methodsFor: 'private-licensing' !\r
 126 \r
 127 \r
 128 addLicenseButton\r
 129 \r
 130 | glyphs <OrderedCollection[SeqCltn[Glyph]]> i <Integer> j <Integer>  |\r
 131 \r
 132 ('*Sun Microsystems, Inc. ALL RIGHTS RESERVED*' match: self mirror comment)\r
 133   ifFalse:[^self]. "Only insert license link for Sun copyrighted code"\r
 134 glyphs := OrderedCollection[SeqCltn[Glyph]] new.\r
 135 "Add a cr so the license button is on the last line by itself"\r
 136 glyphs add: (OrderedCollection[Glyph] with:\r
 137                                                                 (self codeView charGlyphFor: Character cr)).\r
 138 glyphs add: (\r
 139   OrderedCollection[Glyph] new \r
 140      add: self licenseButton;                                               \r
 141      yourself).\r
 142 i := self codeView linearIndexFor: self codeView endSpot.\r
 143 i = 1 ifTrue:[ j := 1] ifFalse:[ j := i  - 1].\r
 144 self codeView linearSelection: j ,, i.\r
 145 self codeView replaceSelectionWithGlyphs: glyphs.\r
 146 self codeView hasBeenChanged: false.\r
 147 self adjustCodeViewFrame.!\r
 148 \r
 149 adjustCodeViewFrame\r
 150 \r
 151 | frame <Frame> |\r
 152 \r
 153         frame := Frame coerce: self codeView  visual parent else: [ nil ].\r
 154         frame notNil ifTrue: [  frame border: self defaultEditorBorder ]!\r
 155 \r
 156 licenseButton ^ <Button>\r
 157 \r
 158 | blk <[]> |\r
 159 \r
 160 blk := Smalltalk\r
 161                 blockToEvaluateFor: 'Smalltalk license'\r
 162                 receiver: Smalltalk\r
 163                 ifError: [ :err <Str> :pos <Int> |\r
 164                         Transcript cr; show: 'Error in CommentOutliner.'; cr.\r
 165                         ^blk value ].\r
 166 ^Button labeled: 'View Source License' action: [ :b <Button> | blk fork ].! !\r
 167 \r