home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP08.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
19KB
|
569 lines
'Smalltalk Textbook Appendix 08'!
EngiVariable subclass: #EngiTextModel
instanceVariableNames: ''
classVariableNames: 'TextFileMenu TextMenuToOpen TextMenuToPopUp TextStyleMenu '
poolDictionaries: ''
category: 'Engi-Text'!
EngiTextModel comment:
'
Engi 0.02 (25 January 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiTextModel methodsFor: 'accessing'!
style
(self at: 2) isNil ifTrue: [self at: 2 put: TextAttributes default].
^self at: 2!
style: textAttributes
textAttributes isNil ifTrue: [^nil].
self at: 2 put: textAttributes.
self propagate!
text
(self at: 1) isNil ifTrue: [self at: 1 put: Text new].
^self at: 1!
text: aText
aText isNil ifTrue: [^nil].
self at: 1 put: aText asText.
self propagate! !
!EngiTextModel methodsFor: 'adaptor'!
text: aText from: aController
self at: 1 put: aText.
self at: 2 put: aController paragraph textStyle.
self propagate.
^true!
textMenuToOpen
^self class textMenuToOpen!
textMenuToPopUp
^self class textMenuToPopUp!
textSytleMenu
^self class textStyleMenu!
textViewToOpen
| textView edgeDecorator |
textView := TextView
on: self
aspect: #text
change: #text:from:
menu: #textMenuToOpen
initialSelection: nil.
textView controller paragraph textStyle: self style.
edgeDecorator := LookPreferences edgeDecorator on: textView.
edgeDecorator noMenuBar.
edgeDecorator useVerticalScrollBar.
edgeDecorator noHorizontalScrollBar.
^edgeDecorator!
textViewToPopUp
| textView edgeDecorator |
textView := TextView
on: self
aspect: #text
change: #text:from:
menu: #textMenuToPopUp
initialSelection: nil.
textView controller paragraph textStyle: self style.
edgeDecorator := LookPreferences edgeDecorator on: textView.
edgeDecorator noMenuBar.
edgeDecorator useVerticalScrollBar.
edgeDecorator noHorizontalScrollBar.
^edgeDecorator! !
!EngiTextModel methodsFor: 'viewing'!
open
| topWindow |
topWindow := self window: false.
topWindow open!
popUp
| topWindow |
topWindow := self window: true.
topWindow minimumSize: topWindow minimumSize + (0 @ 40).
^topWindow popUp!
window: popUp
| topWindow |
topWindow := EngiTopView
model: nil
label: 'Text'
minimumSize: 200 @ 100.
popUp = true
ifTrue: [topWindow add: self textViewToPopUp in: (0 @ 0 corner: 1 @ 1)]
ifFalse: [topWindow add: self textViewToOpen in: (0 @ 0 corner: 1 @ 1)].
^topWindow! !
!EngiTextModel methodsFor: 'menu messages'!
align: aText from: aController
aController align.
aController textHasChanged: true!
color: aText from: aController
| currentSelection anEmphasis colorValue |
currentSelection := aController selection.
currentSelection isEmpty
ifFalse:
[anEmphasis := currentSelection emphasisAt: 1.
(anEmphasis respondsTo: #detect:ifNone:)
ifTrue:
[colorValue := anEmphasis detect: [:each | (each isKindOf: Association)
and: [each key = #color]]
ifNone: [nil].
colorValue isNil ifFalse: [colorValue := colorValue value]]
ifFalse: [((anEmphasis isKindOf: Association)
and: [anEmphasis key = #color])
ifTrue: [colorValue := anEmphasis value]
ifFalse: [colorValue := nil]]].
colorValue isNil
ifTrue: [colorValue := EngiColorModel select]
ifFalse: [colorValue := EngiColorModel select: colorValue].
colorValue isNil ifTrue: [^nil].
currentSelection
addEmphasis: (Array with: #color -> colorValue)
removeEmphasis: #()
allowDuplicates: false.
aController replaceSelectionWith: currentSelection.
aController view flushCaches.
aController view invalidateRectangle: aController view bounds repairNow: true.
aController textHasChanged: true!
font: aText from: aController
| textAttributes fontDescription deviceFont leadInteger characterAttributes |
textAttributes := aController paragraph textStyle copy.
fontDescription := EngiFontModel selectFontDescription: textAttributes defaultFont.
fontDescription isNil ifTrue: [^nil].
deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
leadInteger := textAttributes lineGrid - deviceFont height.
characterAttributes := CharacterAttributes newWithDefaultAttributes.
characterAttributes setDefaultQuery: fontDescription.
textAttributes setCharacterAttributes: characterAttributes.
deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
textAttributes lineGrid: deviceFont height + leadInteger.
textAttributes baseline: deviceFont ascent.
aController paragraph textStyle: textAttributes.
aController view flushCaches.
aController view invalidateRectangle: aController view bounds repairNow: true.
aController textHasChanged: true!
indent: aText from: aController
| textAttributes firstIndent restIndent rightIndent aStream aString |
textAttributes := aController paragraph textStyle copy.
firstIndent := textAttributes firstIndent.
restIndent := textAttributes restIndent.
rightIndent := textAttributes rightIndent.
aStream := WriteStream on: (String new: 32).
aStream nextPutAll: firstIndent printString.
aStream nextPutAll: ', '.
aStream nextPutAll: restIndent printString.
aStream nextPutAll: ', '.
aStream nextPutAll: rightIndent printString.
aString := self class request: 'Indent: first, rest, right' default: aStream contents.
(aString isNil or: [aString isEmpty or: [aString = aStream contents]])
ifTrue: [^nil].
(self class errorSignal
handle:
[:exception |
Screen default ringBell.
Transcript cr; show: 'format error'.
exception returnWith: nil]
do:
[firstIndent := aString copyUpTo: $,.
aString := aString copyFrom: firstIndent size + 2 to: aString size.
restIndent := aString copyUpTo: $,.
aString := aString copyFrom: restIndent size + 2 to: aString size.
rightIndent := aString.
firstIndent := Compiler evaluate: firstIndent logged: false.
restIndent := Compiler evaluate: restIndent logged: false.
rightIndent := Compiler evaluate: rightIndent logged: false.
self yourself]) isNil ifTrue: [^nil].
textAttributes firstIndent: (firstIndent max: 0).
textAttributes restIndent: (restIndent max: 0).
textAttributes rightIndent: (rightIndent max: 0).
aController paragraph textStyle: textAttributes.
aController view flushCaches.
aController view invalidateRectangle: aController view bounds repairNow: true.
aController textHasChanged: true!
lead: aText from: aController
| textAttributes deviceFont leadInteger aString |
textAttributes := aController paragraph textStyle copy.
deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
leadInteger := textAttributes lineGrid - deviceFont height.
aString := self class request: 'Lead:' default: leadInteger printString.
(aString isNil or: [aString isEmpty or: [aString = leadInteger printString]])
ifTrue: [^nil].
(self class errorSignal
handle:
[:exception |
Screen default ringBell.
Transcript cr; show: 'format error'.
exception returnWith: nil]
do:
[leadInteger := Compiler evaluate: aString logged: false.
self yourself]) isNil ifTrue: [^nil].
deviceFont := Screen default defaultFontPolicy findFont: textAttributes defaultFont.
textAttributes lineGrid: deviceFont height + (leadInteger max: 0).
textAttributes baseline: deviceFont ascent.
aController paragraph textStyle: textAttributes.
aController view flushCaches.
aController view invalidateRectangle: aController view bounds repairNow: true.
aController textHasChanged: true!
new: aText from: aController
self class new open!
open: aText from: aController
| fileName fileStream binaryObjectStorage readBlockClosure className theText textAttributes textModel |
fileName := self class request: 'file name?'.
(fileName isNil or: [fileName isEmpty])
ifTrue: [^nil].
(self class errorSignal
handle:
[:exception |
Transcript cr; show: 'file not found'.
exception returnWith: nil]
do: [fileStream := fileName asFilename readStream]) isNil ifTrue: [^nil].
(self class errorSignal
handle:
[:exception |
Transcript cr; show: 'can not read boss'.
exception returnWith: nil]
do: [binaryObjectStorage := BinaryObjectStorage onOldNoScan: fileStream]) isNil ifTrue: [^nil