'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 29 March 2003 at 6:09:18 pm'! "Change Set: CelesteCleanUp3 Date: 9 December 2002 Author: Daniel Vainsencher Refactor MailMessage not to depend on Celeste. Change Celeste to use the sending account details from MailSender. Redefine CelesteComposition by subclassing MailComposition. "! MailComposition subclass: #CelesteComposition instanceVariableNames: 'celeste ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! !Celeste methodsFor: 'categories pane'! setSmtpServer mailDB ifNil: [ ^self ]. ^MailSender setSmtpServer! ! !Celeste methodsFor: 'categories pane'! setUserName "Change the user's email name for use in composing messages." mailDB ifNil: [ ^self ]. MailSender setUserName.! ! !Celeste methodsFor: 'sending mail'! composeText "Answer the template for a new message." ^ String streamContents: [:str | str nextPutAll: 'From: '. str nextPutAll: MailSender userName; cr. str nextPutAll: 'To: '; cr. str nextPutAll: 'Subject: '; cr. Celeste ccList isEmpty ifFalse: [ str nextPutAll: 'Cc: '. str nextPutAll: Celeste ccList; cr]. str cr]. ! ! !Celeste methodsFor: 'sending mail'! forwardTextFor: msgID "Answer the template for forwarding the message with the given ID." | msg separator | msg := self currentMessage. ^String streamContents: [ :str | "From header" str nextPutAll: 'From: '; nextPutAll: MailSender userName; cr. "Put a blank To" str nextPutAll: 'To: '; cr. "Add a subject modified from the original" str nextPutAll: 'Subject: (fwd) '. str nextPutAll: msg subject. str cr. "Add auto-cc if it's been set" Celeste ccList isEmpty ifFalse: [ str nextPutAll: 'Cc: '. str nextPutAll: Celeste ccList; cr]. "add the mime headers to make it multi-part" separator := MailMessage generateSeparator. str nextPutAll: 'MIME-Version: 1.0'; cr. str nextPutAll: 'Content-type: multipart/mixed; boundary="'. str nextPutAll: separator; nextPut: $". str cr. "skip down to the main part of the message" str cr. str nextPutAll: '--'; nextPutAll: separator; cr. str nextPutAll: 'Content-type: text/plain'; cr; cr. "insert the forwarded message" str cr; cr; nextPutAll: '====forwarded===='; cr; cr. str nextPutAll: '--'; nextPutAll: separator; cr. str nextPutAll: 'Content-type: message/rfc822'; cr; cr. str nextPutAll: msg text; cr. "final separator" str nextPutAll: '--'; nextPutAll: separator; nextPutAll: '--'; cr. ].! ! !Celeste methodsFor: 'sending mail'! replyTextFor: msgID "Answer the template for a reply to the message with the given ID." | msg s anyCCs replyaddress | msg _ mailDB getMessage: msgID. s _ WriteStream on: (String new: 500). "add From:" s nextPutAll: 'From: ', MailSender userName; cr. "add Subject:" ((msg subject asLowercase indexOfSubCollection: 're:' startingAt: 1) ~= 0) ifTrue: [s nextPutAll: 'Subject: ', msg subject] ifFalse: [s nextPutAll: 'Subject: Re: ', msg subject]. s cr. "add To:" "Use the Reply-To: address if there is one, otherwise the From: address" replyaddress _ msg from. msg headerFieldsNamed: 'reply-to' do: [ :destAdd | replyaddress _ destAdd ]. s nextPutAll: 'To: ', replyaddress; cr. "add CC:s from the message and from the user's CC list" s nextPutAll: 'CC: '. anyCCs _ false. (msg to isEmpty) ifFalse: [ anyCCs ifTrue:[ s nextPutAll: ', '] ifFalse: [ anyCCs _ true ]. s nextPutAll: msg to ]. (msg cc isEmpty) ifFalse: [ anyCCs ifTrue: [ s nextPutAll: ', ' ] ifFalse: [ anyCCs _ true ]. s nextPutAll: msg cc ]. (Celeste ccList isEmpty) ifFalse: [ anyCCs ifTrue: [ s nextPutAll: ', ' ] ifFalse: [ anyCCs _ true ]. s nextPutAll: Celeste ccList ]. s cr. "add contents of previous message" s cr. s nextPutAll: msg from; nextPutAll: ' wrote:'; cr. msg bodyText linesDo: [ :line | s nextPutAll: '> '. s nextPutAll: line. s cr ]. s cr. ^s contents! ! !Celeste methodsFor: 'sending mail'! sendMail: aCollectionOfMessages "Send to the SMTP server." | sender n message recipients socket | self requiredCategory: '.sent.'. self preSendAuthentication. sender _ (MailAddressParser addressesIn: MailSender userName) first. [socket _ SMTPSocket usingServer: MailSender smtpServer] ifError: [ :a :b | self error: 'error opening connection to mail server']. ('sending ', aCollectionOfMessages size printString, ' messages...') displayProgressAt: Sensor mousePoint from: 1 to: aCollectionOfMessages size during: [:progressBar | n _ 0. aCollectionOfMessages do: [:id | progressBar value: (n _ n + 1). message _ mailDB getMessage: id. recipients _ Set new. recipients addAll: (MailAddressParser addressesIn: message to). recipients addAll: (MailAddressParser addressesIn: message cc). [socket mailFrom: sender to: recipients text: message text. "send this one message on the stream" mailDB remove: id fromCategory: '.tosend.'. mailDB file: id inCategory: '.sent.' ] ifError: [ :a :b | self error: 'error posting mail'] ]]. socket quit; close. mailDB saveDB. (self category = '.tosend.') | (self category = '.sent.') ifTrue: [self updateTOC]. ! ! !Celeste methodsFor: 'sending mail'! sendQueuedMail "Post queued messages to the SMTP server." | outgoing sender n message recipients socket | mailDB ifNil: [ ^self ]. outgoing _ mailDB messagesIn: '.tosend.'. outgoing isEmpty ifTrue: [^ self inform: 'no mail to be sent']. self requiredCategory: '.sent.'. self preSendAuthentication. sender _ (MailAddressParser addressesIn: MailSender userName) first. [socket _ SMTPSocket usingServer: MailSender smtpServer] ifError: [:a :b | self error: 'error opening connection to mail server']. 'sending ' , outgoing size printString , ' messages...' displayProgressAt: Sensor mousePoint from: 1 to: outgoing size during: [:progressBar | n _ 0. outgoing do: [:id | progressBar value: (n _ n + 1). message _ mailDB getMessage: id. recipients _ Set new. recipients addAll: (MailAddressParser addressesIn: message to). recipients addAll: (MailAddressParser addressesIn: message cc). [socket mailFrom: sender to: recipients text: message text. "send this one message on the stream" mailDB remove: id fromCategory: '.tosend.'. mailDB file: id inCategory: '.sent.'] ifError: [:a :b | self error: 'error posting mail']]]. socket quit; close. mailDB saveDB. self category = '.tosend.' | (self category = '.sent.') ifTrue: [self updateTOC]. self changed: #outBoxStatus! ! !Celeste class methodsFor: 'class initialization' stamp: 'dvf 12/9/2002 19:22'! initialize "Celeste initialize" "user preferences" CCList _ nil. DeleteInboxAfterFetching _ false. PopServer _ nil. PopUserName _ nil. SuppressWorthlessHeaderFields _ true. "options with no UI; just set their values directly" FormatWhenFetching _ false. "dictionary of custom filters" CustomFilters _ Dictionary new. MessageCountLimit _ 200. "Add global preferences" Preferences addPreferenceForOptionalCelesteStatusPane. Preferences addPreferenceForCelesteShowingAttachmentsFlag. ! ! !CelesteComposition methodsFor: 'access' stamp: 'dvf 5/11/2002 00:22'! submit | message msgID | "submit the message" textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. message := MailMessage from: messageText asString. self breakLinesInMessage: message. msgID _ (celeste isActive ifTrue: [celeste] ifFalse: [Celeste current]) queueMessageWithText: message text. msgID ifNil: [^self]. "There was an error, so do not close" morphicWindow ifNotNil: [morphicWindow delete]. mvcWindow ifNotNil: [mvcWindow controller close] ! ! !CelesteComposition methodsFor: 'initialization' stamp: 'dvf 5/11/2002 01:21'! celeste: aCeleste initialText: aText celeste _ aCeleste. messageText _ aText.! ! !CelesteComposition class methodsFor: 'instance creation' stamp: 'dvf 5/11/2002 01:21'! celeste: aCeleste initialText: initialText "create an instance for the given mail reader, editting the given text" ^self new celeste: aCeleste initialText: initialText! ! !CelesteComposition class methodsFor: 'instance creation' stamp: 'dvf 5/11/2002 01:22'! openForCeleste: aCeleste initialText: initialText "open a composition window for the given mail reader, editting the given text" (self celeste: aCeleste initialText: initialText) open! ! !CelesteComposition class methodsFor: 'as yet unclassified' stamp: 'dvf 5/17/2002 16:01'! initialize super initialize. MailSender register: self.! ! !CelesteComposition class methodsFor: 'as yet unclassified' stamp: 'dvf 5/11/2002 01:25'! sendMailMessage: aMailMessage self openForCeleste: Celeste current initialText: aMailMessage text! ! !CelesteComposition class methodsFor: 'as yet unclassified' stamp: 'dvf 5/17/2002 16:01'! unload MailSender unregister: self ! ! !MailMessage methodsFor: 'parsing' stamp: 'dvf 5/10/2002 21:43'! fieldsFrom: aStream do: aBlock "Invoke the given block with each of the header fields from the given stream. The block arguments are the field name and value. The streams position is left right after the empty line separating header and body." | savedLine line s | savedLine _ self readStringLineFrom: aStream. [aStream atEnd] whileFalse: [ line _ savedLine. (line isEmpty) ifTrue: [^self]. "quit when we hit a blank line" [savedLine _ self readStringLineFrom: aStream. (savedLine size > 0) and: [savedLine first isSeparator]] whileTrue: [ "lines starting with white space are continuation lines" s _ ReadStream on: savedLine. s skipSeparators. line _ line, ' ', s upToEnd]. self reportField: line withBlanksTrimmed to: aBlock]. "process final header line of a body-less message" (savedLine isEmpty) ifFalse: [self reportField: savedLine withBlanksTrimmed to: aBlock]. ! ! !MailMessage methodsFor: 'parsing' stamp: 'dvf 5/10/2002 21:43'! readStringLineFrom: aStream "Read and answer the next line from the given stream. Consume the carriage return but do not append it to the string." | | ^aStream upTo: Character cr! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'ads 3/29/2003 18:05'! bodyTextFormatted "Answer a version of the text in my body suitable for display. This will parse multipart forms, decode HTML, and other such things" "check for multipart" self body isMultipart ifTrue: [ "check for alternative forms" self body isMultipartAlternative ifTrue: [ "it's multipart/alternative. search for a part that we can display, biasing towards nicer formats" #('text/html' 'text/plain') do: [ :format | self parts do: [ :part | part body contentType = format ifTrue: [ ^part bodyTextFormatted ] ] ]. "couldn't find a desirable part to display; just display the first part" ^self parts first bodyTextFormatted ]. "not alternative parts. put something for each part" ^Text streamContents: [ :str | self parts do: [ :part | ((#('text' 'multipart') includes: part body mainType) or: [ part body contentType = 'message/rfc822']) ifTrue: [ "try to inline the message part" str nextPutAll: part bodyTextFormatted. ] ifFalse: [ |descript | str cr. descript := part name ifNil: [ 'attachment' ]. str nextPutAll: (Text string: '[', descript, ']' attribute: (TextMessageLink message: part)). ] ] ]. ]. "check for HTML" (self body contentType = 'text/html' and: [Smalltalk includesKey: #HtmlParser]) ifTrue: [^(HtmlParser parse: (ReadStream on: body content)) formattedText]. "check for an embedded message" self body contentType = 'message/rfc822' ifTrue: [ ^(MailMessage from: self body content) formattedText ]. "nothing special--just return the text" ^body content. ! ! CelesteComposition initialize! CelesteComposition removeSelector: #addAttachment! CelesteComposition removeSelector: #breakLines:atWidth:! CelesteComposition removeSelector: #breakLinesInMessage:! CelesteComposition removeSelector: #messageText! CelesteComposition removeSelector: #messageText:! CelesteComposition removeSelector: #open! CelesteComposition removeSelector: #openInMVC! CelesteComposition removeSelector: #openInMorphic! MailComposition subclass: #CelesteComposition instanceVariableNames: 'celeste ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! Celeste initialize!