'From Squeak3.11alpha of 13 February 2010 [latest update: #9371] on 16 February 2010 at 11:25:32 am'!
MailComposition subclass: #FancyMailComposition
instanceVariableNames: 'theLinkToInclude to subject textFields'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-EToy-Download'!
!FancyMailComposition methodsFor: 'access' stamp: 'RAA 5/19/2000 18:48'!
subject
^subject
! !
!FancyMailComposition methodsFor: 'access' stamp: 'RAA 5/19/2000 19:02'!
subject: x
subject := x.
self changed: #subject.
^true! !
!FancyMailComposition methodsFor: 'access' stamp: 'RAA 5/19/2000 18:47'!
to
^to! !
!FancyMailComposition methodsFor: 'access' stamp: 'RAA 5/19/2000 19:02'!
to: x
to := x.
self changed: #to.
^true
! !
!FancyMailComposition methodsFor: 'actions' stamp: 'dvf 6/15/2002 19:09'!
completeTheMessage
| newText strm |
textFields do: [ :each | each hasUnacceptedEdits ifTrue: [ each accept ] ].
newText := String new: 200.
strm := WriteStream on: newText.
strm
nextPutAll: 'Content-Type: text/html'; cr;
nextPutAll: 'From: ', MailSender userName; cr;
nextPutAll: 'To: ',to; cr;
nextPutAll: 'Subject: ',subject; cr;
cr;
nextPutAll: '
';
nextPutAll: messageText asString asHtml;
nextPutAll: '
',theLinkToInclude,'
'.
^strm contents
! !
!FancyMailComposition methodsFor: 'actions' stamp: 'RAA 5/19/2000 12:53'!
sendNow
self submit: true
! !
!FancyMailComposition methodsFor: 'actions' stamp: 'RAA 5/19/2000 12:53'!
submit
self submit: false! !
!FancyMailComposition methodsFor: 'actions' stamp: 'mir 5/13/2003 10:58'!
submit: sendNow
| message |
messageText := self breakLines: self completeTheMessage atWidth: 999.
message := MailMessage from: messageText.
SMTPClient
deliverMailFrom: message from
to: (Array with: message to)
text: message text
usingServer: self smtpServer.
self forgetIt.
! !
!FancyMailComposition methodsFor: 'initialization' stamp: 'nk 7/3/2003 09:41'!
celeste: aCeleste to: argTo subject: argSubject initialText: aText theLinkToInclude: linkText
"self new celeste: Celeste current to: 'danielv@netvision.net.il' subject: 'Mysubj' initialText: 'atext' theLinkToInclude: 'linkText'"
to := argTo.
subject := argSubject.
messageText := aText.
theLinkToInclude := linkText.
textFields := #().
! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'RAA 7/7/2000 17:51'!
borderAndButtonColor
^Color r: 0.729 g: 0.365 b: 0.729! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'ar 11/9/2000 21:14'!
buttonWithAction: aSymbol label: labelString help: helpString
^self newColumn
wrapCentering: #center; cellPositioning: #topCenter;
addMorph: (
SimpleButtonMorph new
color: self borderAndButtonColor;
target: self;
actionSelector: aSymbol;
label: labelString;
setBalloonText: helpString
)
! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'RAA 7/7/2000 17:35'!
forgetIt
morphicWindow ifNotNil: [ morphicWindow delete ].
mvcWindow ifNotNil: [ mvcWindow controller close ].
! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'RAA 7/7/2000 17:42'!
newColumn
^AlignmentMorph newColumn color: self staticBackgroundColor! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'RAA 7/7/2000 17:41'!
newRow
^AlignmentMorph newRow color: self staticBackgroundColor! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'ar 11/10/2000 15:46'!
openInMorphic
"open an interface for sending a mail message with the given initial
text "
| buttonsList container toField subjectField |
buttonsList := self newRow.
buttonsList wrapCentering: #center; cellPositioning: #leftCenter.
buttonsList
addMorphBack: (
(self
buttonWithAction: #submit
label: 'send later'
help: 'add this to the queue of messages to be sent')
);
addMorphBack: (
(self
buttonWithAction: #sendNow
label: 'send now'
help: 'send this message immediately')
);
addMorphBack: (
(self
buttonWithAction: #forgetIt
label: 'forget it'
help: 'forget about sending this message')
).
morphicWindow := container := AlignmentMorphBob1 new
borderWidth: 8;
borderColor: self borderAndButtonColor;
color: Color white.
container
addMorphBack: (buttonsList vResizing: #shrinkWrap; minHeight: 25; yourself);
addMorphBack: ((self simpleString: 'To:') vResizing: #shrinkWrap; minHeight: 18; yourself);
addMorphBack: ((toField := PluggableTextMorph
on: self
text: #to
accept: #to:) hResizing: #spaceFill; vResizing: #rigid; height: 50; yourself
);
addMorphBack: ((self simpleString: 'Subject:') vResizing: #shrinkWrap; minHeight: 18; yourself);
addMorphBack: ((subjectField := PluggableTextMorph
on: self
text: #subject
accept: #subject:) hResizing: #spaceFill; vResizing: #rigid; height: 50; yourself
);
addMorphBack: ((self simpleString: 'Message:') vResizing: #shrinkWrap; minHeight: 18; yourself);
addMorphBack: ((textEditor := PluggableTextMorph
on: self
text: #messageText
accept: #messageText:) hResizing: #spaceFill; vResizing: #spaceFill; yourself
).
textFields := {toField. subjectField. textEditor}.
container
extent: 300@400;
openInWorld.! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'ar 11/9/2000 20:39'!
simpleString: aString
^self newRow
layoutInset: 2;
addMorphBack: (StringMorph contents: aString) lock! !
!FancyMailComposition methodsFor: 'morphic gui' stamp: 'RAA 7/7/2000 17:38'!
staticBackgroundColor
^Color veryLightGray! !