'From Squeak3.4beta of ''1 December 2002'' [latest update: #5147] on 10 December 2002 at 12:07:06 am'! "Change Set: CelesteCleanUp2 Date: 9 December 2002 Author: Daniel Vainsencher Add a basic GUI for sending emails that is not attached to Celeste. Uses SMTPSockets to directly send the mail."! Model subclass: #MailComposition instanceVariableNames: 'messageText textEditor morphicWindow mvcWindow ' classVariableNames: '' poolDictionaries: '' category: 'Network-MailSending'! !MailComposition commentStamp: '' prior: 0! a message being composed. When finished, it will be submitted via a Celeste.! MailComposition subclass: #FancyMailComposition instanceVariableNames: 'theLinkToInclude to subject textFields ' classVariableNames: '' poolDictionaries: '' category: 'Squeak-EToy-Download'! !MailComposition methodsFor: 'private' stamp: 'ls 2/10/2001 13:57'! breakLines: aString atWidth: width "break lines in the given string into shorter lines" | result start end atAttachment | result _ WriteStream on: (String new: (aString size * 50 // 49)). atAttachment _ false. aString asString linesDo: [ :line | (line beginsWith: '====') ifTrue: [ atAttachment _ true ]. atAttachment ifTrue: [ "at or after an attachment line; no more wrapping for the rest of the message" result nextPutAll: line. result cr ] ifFalse: [ (line beginsWith: '>') ifTrue: [ "it's quoted text; don't wrap it" result nextPutAll: line. result cr. ] ifFalse: [ "regular old line. Wrap it to multiple lines" start _ 1. "output one shorter line each time through this loop" [ start + width <= line size ] whileTrue: [ "find the end of the line" end _ start + width - 1. [end >= start and: [ (line at: (end+1)) isSeparator not ]] whileTrue: [ end _ end - 1 ]. end < start ifTrue: [ "a word spans the entire width!!" end _ start + width - 1 ]. "copy the line to the output" result nextPutAll: (line copyFrom: start to: end). result cr. "get ready for next iteration" start _ end+1. (line at: start) isSeparator ifTrue: [ start _ start + 1 ]. ]. "write out the final part of the line" result nextPutAll: (line copyFrom: start to: line size). result cr. ]. ]. ]. ^result contents! ! !MailComposition methodsFor: 'private' stamp: 'ls 2/10/2001 14:08'! breakLinesInMessage: message "reformat long lines in the specified message into shorter ones" message body mainType = 'text' ifTrue: [ "it's a single-part text message. reformat the text" | newBodyText | newBodyText := self breakLines: message bodyText atWidth: 72. message body: (MIMEDocument contentType: message body contentType content: newBodyText). ^self ]. message body isMultipart ifTrue: [ "multipart message; process the top-level parts. HACK: the parts are modified in place" message parts do: [ :part | part body mainType = 'text' ifTrue: [ | newBodyText | newBodyText := self breakLines: part bodyText atWidth: 72. part body: (MIMEDocument contentType: part body contentType content: newBodyText) ] ]. message regenerateBodyFromParts. ].! ! !MailComposition methodsFor: 'access' stamp: 'bf 3/9/2000 18:02'! messageText "return the current text" ^messageText isoToSqueak! ! !MailComposition methodsFor: 'access' stamp: 'bf 3/9/2000 18:26'! messageText: aText "change the current text" messageText _ aText squeakToIso. self changed: #messageText. ^true! ! !MailComposition methodsFor: 'access' stamp: 'dvf 5/11/2002 00:24'! smtpServer ^MailSender smtpServer! ! !MailComposition methodsFor: 'access' stamp: 'dvf 5/11/2002 00:24'! submit | message | "submit the message" textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. message := MailMessage from: messageText asString. self breakLinesInMessage: message. SMTPSocket deliverMailFrom: message from to: (Array with: message to) text: message text usingServer: self smtpServer. morphicWindow ifNotNil: [morphicWindow delete]. mvcWindow ifNotNil: [mvcWindow controller close]! ! !MailComposition methodsFor: 'interface' stamp: 'mdr 4/10/2001 14:27'! addAttachment | file fileResult fileName | textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. (fileResult _ StandardFileMenu oldFile) ifNotNil: [fileName _ fileResult directory fullNameFor: fileResult name. file _ FileStream readOnlyFileNamed: fileName. file ifNotNil: [file binary. self messageText: ((MailMessage from: self messageText asString) addAttachmentFrom: file withName: fileResult name; text). file close]] ! ! !MailComposition methodsFor: 'interface' stamp: 'ls 10/16/1998 09:11'! open "open an interface" Smalltalk isMorphic ifTrue: [ self openInMorphic ] ifFalse: [ self openInMVC ]! ! !MailComposition methodsFor: 'interface' stamp: 'ls 10/16/1998 09:17'! openInMVC | textView sendButton | mvcWindow _ StandardSystemView new label: 'Mister Postman'; minimumSize: 400@250; model: self. textView _ PluggableTextView on: self text: #messageText accept: #messageText:. textEditor _ textView controller. sendButton _ PluggableButtonView on: self getState: nil action: #submit. sendButton label: 'Send'. sendButton borderWidth: 1. sendButton window: (1@1 extent: 398@38). mvcWindow addSubView: sendButton. textView window: (0@40 corner: 400@250). mvcWindow addSubView: textView below: sendButton. mvcWindow controller open. ! ! !MailComposition methodsFor: 'interface' stamp: 'RAA 1/17/2001 14:20'! openInMorphic "open an interface for sending a mail message with the given initial text " | textMorph buttonsList sendButton attachmentButton | morphicWindow _ SystemWindow labelled: 'Mister Postman'. morphicWindow model: self. textEditor _ textMorph _ PluggableTextMorph on: self text: #messageText accept: #messageText:. morphicWindow addMorph: textMorph frame: (0 @ 0.1 corner: 1 @ 1). buttonsList _ AlignmentMorph newRow. sendButton _ PluggableButtonMorph on: self getState: nil action: #submit. sendButton hResizing: #spaceFill; vResizing: #spaceFill; label: 'send message'; setBalloonText: 'add this to the queue of messages to be sent'; onColor: Color white offColor: Color white. buttonsList addMorphBack: sendButton. attachmentButton _ PluggableButtonMorph on: self getState: nil action: #addAttachment. attachmentButton hResizing: #spaceFill; vResizing: #spaceFill; label: 'add attachment'; setBalloonText: 'Send a file with the message'; onColor: Color white offColor: Color white. buttonsList addMorphBack: attachmentButton. morphicWindow addMorph: buttonsList frame: (0 @ 0 extent: 1 @ 0.1). morphicWindow openInMVC! ! !MailComposition methodsFor: 'interface' stamp: 'dvf 5/11/2002 01:23'! sendMailMessage: aMailMessage self messageText: aMailMessage text! ! !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! ! !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: 'initialization' stamp: 'dvf 6/15/2002 18:34'! 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'" celeste _ aCeleste. to _ argTo. subject _ argSubject. messageText _ aText. theLinkToInclude _ linkText. textFields _ #(). ! ! !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: 'dvf 6/15/2002 19:17'! submit: sendNow | message | messageText _ self breakLines: self completeTheMessage atWidth: 999. message _ MailMessage from: messageText. SMTPSocket deliverMailFrom: message from to: (Array with: message to) text: message text usingServer: self smtpServer. self forgetIt. ! ! !MailComposition class methodsFor: 'instance creation' stamp: 'dvf 5/11/2002 00:40'! initialize super initialize. MailSender register: self.! ! !MailComposition class methodsFor: 'instance creation' stamp: 'dvf 5/11/2002 01:25'! sendMailMessage: aMailMessage | newComposition | newComposition _ self new. newComposition messageText: aMailMessage text; open! ! !MailComposition class methodsFor: 'instance creation' stamp: 'dvf 5/11/2002 00:40'! unload MailSender unregister: self ! ! MailComposition initialize!