home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP08.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  19KB  |  569 lines
  1.  
  2. 'Smalltalk Textbook Appendix 08'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiVariable subclass: #EngiTextModel
  9.     instanceVariableNames: ''
  10.     classVariableNames: 'TextFileMenu TextMenuToOpen TextMenuToPopUp TextStyleMenu '
  11.     poolDictionaries: ''
  12.     category: 'Engi-Text'!
  13. EngiTextModel comment:
  14. '
  15.  
  16. Engi 0.02 (25 January 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiTextModel methodsFor: 'accessing'!
  23.  
  24. style
  25.     (self at: 2) isNil ifTrue: [self at: 2 put: TextAttributes default].
  26.     ^self at: 2!
  27.  
  28. style: textAttributes 
  29.     textAttributes isNil ifTrue: [^nil].
  30.     self at: 2 put: textAttributes.
  31.     self propagate!
  32.  
  33. text
  34.     (self at: 1) isNil ifTrue: [self at: 1 put: Text new].
  35.     ^self at: 1!
  36.  
  37. text: aText 
  38.     aText isNil ifTrue: [^nil].
  39.     self at: 1 put: aText asText.
  40.     self propagate! !
  41.  
  42. !EngiTextModel methodsFor: 'adaptor'!
  43.  
  44. text: aText from: aController 
  45.     self at: 1 put: aText.
  46.     self at: 2 put: aController paragraph textStyle.
  47.     self propagate.
  48.     ^true!
  49.  
  50. textMenuToOpen
  51.     ^self class textMenuToOpen!
  52.  
  53. textMenuToPopUp
  54.     ^self class textMenuToPopUp!
  55.  
  56. textSytleMenu
  57.     ^self class textStyleMenu!
  58.  
  59. textViewToOpen
  60.     | textView edgeDecorator |
  61.     textView := TextView
  62.                 on: self
  63.                 aspect: #text
  64.                 change: #text:from:
  65.                 menu: #textMenuToOpen
  66.                 initialSelection: nil.
  67.     textView controller paragraph textStyle: self style.
  68.     edgeDecorator := LookPreferences edgeDecorator on: textView.
  69.     edgeDecorator noMenuBar.
  70.     edgeDecorator useVerticalScrollBar.
  71.     edgeDecorator noHorizontalScrollBar.
  72.     ^edgeDecorator!
  73.  
  74. textViewToPopUp
  75.     | textView edgeDecorator |
  76.     textView := TextView
  77.                 on: self
  78.                 aspect: #text
  79.                 change: #text:from:
  80.                 menu: #textMenuToPopUp
  81.                 initialSelection: nil.
  82.     textView controller paragraph textStyle: self style.
  83.     edgeDecorator := LookPreferences edgeDecorator on: textView.
  84.     edgeDecorator noMenuBar.
  85.     edgeDecorator useVerticalScrollBar.
  86.     edgeDecorator noHorizontalScrollBar.
  87.     ^edgeDecorator! !
  88.  
  89. !EngiTextModel methodsFor: 'viewing'!
  90.  
  91. open
  92.     | topWindow |
  93.     topWindow := self window: false.
  94.     topWindow open!
  95.  
  96. popUp
  97.     | topWindow |
  98.     topWindow := self window: true.
  99.     topWindow minimumSize: topWindow minimumSize + (0 @ 40).
  100.     ^topWindow popUp!
  101.  
  102. window: popUp 
  103.     | topWindow |
  104.     topWindow := EngiTopView
  105.                 model: nil
  106.                 label: 'Text'
  107.                 minimumSize: 200 @ 100.
  108.     popUp = true
  109.         ifTrue: [topWindow add: self textViewToPopUp in: (0 @ 0 corner: 1 @ 1)]
  110.         ifFalse: [topWindow add: self textViewToOpen in: (0 @ 0 corner: 1 @ 1)].
  111.     ^topWindow! !
  112.  
  113. !EngiTextModel methodsFor: 'menu messages'!
  114.  
  115. align: aText from: aController 
  116.     aController align.
  117.     aController textHasChanged: true!
  118.  
  119. color: aText from: aController 
  120.     | currentSelection anEmphasis colorValue |
  121.     currentSelection := aController selection.
  122.     currentSelection isEmpty
  123.         ifFalse: 
  124.             [anEmphasis := currentSelection emphasisAt: 1.
  125.             (anEmphasis respondsTo: #detect:ifNone:)
  126.                 ifTrue: 
  127.                     [colorValue := anEmphasis detect: [:each | (each isKindOf: Association)
  128.                                     and: [each key = #color]]
  129.                                 ifNone: [nil].
  130.                     colorValue isNil ifFalse: [colorValue := colorValue value]]
  131.                 ifFalse: [((anEmphasis isKindOf: Association)
  132.                         and: [anEmphasis key = #color])
  133.                         ifTrue: [colorValue := anEmphasis value]
  134.                         ifFalse: [colorValue := nil]]].
  135.     colorValue isNil
  136.         ifTrue: [colorValue := EngiColorModel select]
  137.         ifFalse: [colorValue := EngiColorModel select: colorValue].
  138.     colorValue isNil ifTrue: [^nil].
  139.     currentSelection
  140.         addEmphasis: (Array with: #color -> colorValue)
  141.         removeEmphasis: #()
  142.         allowDuplicates: false.
  143.     aController replaceSelectionWith: currentSelection.
  144.     aController view flushCaches.
  145.     aController view invalidateRectangle: aController view bounds repairNow: true.
  146.     aController textHasChanged: true!
  147.  
  148. font: aText from: aController 
  149.     | textAttributes fontDescription deviceFont leadInteger characterAttributes |
  150.     textAttributes := aController paragraph textStyle copy.
  151.     fontDescription := EngiFontModel selectFontDescription: textAttributes defaultFont.
  152.     fontDescription isNil ifTrue: [^nil].
  153.     deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
  154.     leadInteger := textAttributes lineGrid - deviceFont height.
  155.     characterAttributes := CharacterAttributes newWithDefaultAttributes.
  156.     characterAttributes setDefaultQuery: fontDescription.
  157.     textAttributes setCharacterAttributes: characterAttributes.
  158.     deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
  159.     textAttributes lineGrid: deviceFont height + leadInteger.
  160.     textAttributes baseline: deviceFont ascent.
  161.     aController paragraph textStyle: textAttributes.
  162.     aController view flushCaches.
  163.     aController view invalidateRectangle: aController view bounds repairNow: true.
  164.     aController textHasChanged: true!
  165.  
  166. indent: aText from: aController 
  167.     | textAttributes firstIndent restIndent rightIndent aStream aString |
  168.     textAttributes := aController paragraph textStyle copy.
  169.     firstIndent := textAttributes firstIndent.
  170.     restIndent := textAttributes restIndent.
  171.     rightIndent := textAttributes rightIndent.
  172.     aStream := WriteStream on: (String new: 32).
  173.     aStream nextPutAll: firstIndent printString.
  174.     aStream nextPutAll: ', '.
  175.     aStream nextPutAll: restIndent printString.
  176.     aStream nextPutAll: ', '.
  177.     aStream nextPutAll: rightIndent printString.
  178.     aString := self class request: 'Indent: first, rest, right' default: aStream contents.
  179.     (aString isNil or: [aString isEmpty or: [aString = aStream contents]])
  180.         ifTrue: [^nil].
  181.     (self class errorSignal
  182.         handle: 
  183.             [:exception | 
  184.             Screen default ringBell.
  185.             Transcript cr; show: 'format error'.
  186.             exception returnWith: nil]
  187.         do: 
  188.             [firstIndent := aString copyUpTo: $,.
  189.             aString := aString copyFrom: firstIndent size + 2 to: aString size.
  190.             restIndent := aString copyUpTo: $,.
  191.             aString := aString copyFrom: restIndent size + 2 to: aString size.
  192.             rightIndent := aString.
  193.             firstIndent := Compiler evaluate: firstIndent logged: false.
  194.             restIndent := Compiler evaluate: restIndent logged: false.
  195.             rightIndent := Compiler evaluate: rightIndent logged: false.
  196.             self yourself]) isNil ifTrue: [^nil].
  197.     textAttributes firstIndent: (firstIndent max: 0).
  198.     textAttributes restIndent: (restIndent max: 0).
  199.     textAttributes rightIndent: (rightIndent max: 0).
  200.     aController paragraph textStyle: textAttributes.
  201.     aController view flushCaches.
  202.     aController view invalidateRectangle: aController view bounds repairNow: true.
  203.     aController textHasChanged: true!
  204.  
  205. lead: aText from: aController 
  206.     | textAttributes deviceFont leadInteger aString |
  207.     textAttributes := aController paragraph textStyle copy.
  208.     deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
  209.     leadInteger := textAttributes lineGrid - deviceFont height.
  210.     aString := self class request: 'Lead:' default: leadInteger printString.
  211.     (aString isNil or: [aString isEmpty or: [aString = leadInteger printString]])
  212.         ifTrue: [^nil].
  213.     (self class errorSignal
  214.         handle: 
  215.             [:exception | 
  216.             Screen default ringBell.
  217.             Transcript cr; show: 'format error'.
  218.             exception returnWith: nil]
  219.         do: 
  220.             [leadInteger := Compiler evaluate: aString logged: false.
  221.             self yourself]) isNil ifTrue: [^nil].
  222.     deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
  223.     textAttributes lineGrid: deviceFont height + (leadInteger max: 0).
  224.     textAttributes baseline: deviceFont ascent.
  225.     aController paragraph textStyle: textAttributes.
  226.     aController view flushCaches.
  227.     aController view invalidateRectangle: aController view bounds repairNow: true.
  228.     aController textHasChanged: true!
  229.  
  230. new: aText from: aController 
  231.     self class new open!
  232.  
  233. open: aText from: aController 
  234.     | fileName fileStream binaryObjectStorage readBlockClosure className theText textAttributes textModel |
  235.     fileName := self class request: 'file name?'.
  236.     (fileName isNil or: [fileName isEmpty])
  237.         ifTrue: [^nil].
  238.     (self class errorSignal
  239.         handle: 
  240.             [:exception | 
  241.             Transcript cr; show: 'file not found'.
  242.             exception returnWith: nil]
  243.         do: [fileStream := fileName asFilename readStream]) isNil ifTrue: [^nil].
  244.     (self class errorSignal
  245.         handle: 
  246.             [:exception | 
  247.             Transcript cr; show: 'can not read boss'.
  248.             exception returnWith: nil]
  249.         do: [binaryObjectStorage := BinaryObjectStorage onOldNoScan: fileStream]) isNil ifTrue: [^nil