'From Squeak3.1alpha of 7 March 2001 [latest update: #4081] on 21 June 2001 at 6:16:56 pm'! "Change Set: dbLessCeleste Date: 21 June 2001 Author: Lex Spoon Allow Celeste to run without a database open. Such an empty Celeste would be well suited for the Tools flap...."! !Celeste commentStamp: 'ls 6/21/2001 17:25' prior: 0! I am the core of a mail reading and organizing program. The name "Celeste" is a reference to an earlier mail reader named "Babar", which was written at Xerox PARC by Steve Putz and John Maloney. This object provides a user interface and some higher-level functionality for the application. The foundation of of the mail reader is really the mail database, implemented by the class MailDB. Implementation note: the 'mailDB' instance variable can be nil. This way, it is possible to have a Celeste window with no DB currently loaded. All user-accessible functions that access mailDB should be careful to quietly do nothing if mailDB is nil.! ]style[(382 6 254)f1,f1LMailDB Comment;,f1! TestCase subclass: #CelesteTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! Smalltalk renameClassNamed: #TextBlock as: #PluggableTextAttribute! TextAction subclass: #PluggableTextAttribute instanceVariableNames: 'evalBlock ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! !PluggableTextAttribute commentStamp: 'ls 6/21/2001 18:06' prior: 0! An attribute which evaluates an arbitrary block when it is selected.! !Celeste methodsFor: 'open-close' stamp: 'ls 6/21/2001 18:01'! openDefaultDatabase "open the default database, creating it if it isn't present" self openOnDatabase: (MailDB openOn: Celeste defaultDBName). self changed: #categoryList.! ! !Celeste methodsFor: 'open-close' stamp: 'ls 6/20/2001 23:58'! openOnDatabase: aMailDB "Initialize myself for the mail database with the given root filename." mailDB _ aMailDB. currentCategory _ 'new'. lastCategory _ ''. subjectFilter _ ''. participantFilter _ ''. self setCategory: currentCategory. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 00:07'! addCategory "Create a new category with the user-specified name. This does nothing if the category already exists." | newCatName | mailDB ifNil: [ ^self ]. newCatName _ FillInTheBlank request: 'Name for new category?'. (newCatName isEmpty) ifTrue: [^self]. "user aborted" self requiredCategory: newCatName. self setCategory: newCatName. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/20/2001 23:59'! categoryList "Answer a list of categories for the categories pane." mailDB ifNil: [ ^#() ]. ^ mailDB allCategories ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 00:07'! compact "Salvage and Compact the messages file." | stats | mailDB ifNil: [ ^self ]. Transcript cr; show: 'Compacting message file...'. Cursor execute showWhile: [stats _ mailDB compact]. Transcript show: 'Done.'; cr. Transcript show: 'Recovered ', (stats at: 1) printString, ' message', (((stats at: 1) = 1) ifTrue: [', '] ifFalse: ['s, ']), (stats at: 2) printString, ' bytes. ', (stats at: 3) printString, ' active messages remain.'; cr. self setCategory: self category. "Flush all the displayed state"! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 00:08'! emptyTrash "Delete all messages in the '.trash.' category. WARNING: The messages will be totally removed from the Celeste index, and the .messages file will be marked so that the message contents are removed when it is next compressed." | msgList | mailDB ifNil: [ ^self ]. self requiredCategory: '.trash.'. msgList _ mailDB messagesIn: '.trash.'. "Look at ALL messages in the trash" "Remove from the list messages which are also in other categories" msgList _ msgList select: [ :msgID | (mailDB categoriesThatInclude: msgID) size = 1]. mailDB deleteAll: msgList. mailDB cleanUpCategories. self updateTOC. (mailDB messagesIn: '.trash.') isEmpty ifFalse: [self inform: 'Some messages were not removed because they are also filed in other categories'].! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:52'! exportCategory "Store the filtered message list of the current category to another mail database. The user is prompted for the name of the other database." | destDBName destDB | mailDB ifNil: [ ^self ]. currentCategory ifNil: [ ^self ]. destDBName _ FillInTheBlank request: 'Destination mail database?' initialAnswer: ''. (destDBName isEmpty) ifTrue: [^self]. destDB _ MailDB openOn: destDBName. (destDB isNil) ifTrue: [^self]. destDB mergeMessages: (self filteredMessagesIn: currentCategory) from: mailDB. destDB saveDB. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:52'! exportCategoryUnix "Store the filtered message list of the current category into a Eudora/Unix database" | destFileName destFile messageIds count | mailDB ifNil: [ ^self ]. currentCategory ifNil: [ ^self ]. destFileName _ FillInTheBlank request: 'Destination mail file?' initialAnswer: ''. (destFileName isEmpty) ifTrue: [^self]. destFile _ FileStream fileNamed: destFileName. destFile ifNil: [ ^self error: 'could not open file' ]. destFile setToEnd. messageIds _ self filteredMessagesIn: currentCategory. ('exporting ', messageIds size printString, ' messages') displayProgressAt: Sensor mousePoint from: 0 to: messageIds size during: [ :bar | count _ 0. messageIds do: [ :messageId | destFile nextPutAll: Celeste eudoraSeparator. (mailDB getMessage: messageId) text linesDo: [ :line | (line beginsWith: 'From ') ifTrue: [ destFile nextPut: $> ]. destFile nextPutAll: line. destFile cr ]. count _ count + 1. bar value: count. ]. ]. destFile close. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 00:08'! fetchMail "Append messages from the user's mailbox to this mail database." | server password msgCount | mailDB ifNil: [ ^self ]. server _ self class popServer. password _ self popPassword. password ifNil: [^ self]. self requiredCategory: 'new'. msgCount _ mailDB fetchMailFromPOP: server userName: self class popUserName password: password doFormatting: FormatWhenFetching deleteFromServer: DeleteInboxAfterFetching. msgCount < 0 ifTrue: [self inform: 'could not connect to the mail server'] ifFalse: [self inform: msgCount printString, ' messages fetched']. msgCount <= 0 ifTrue: [^ self]. self setCategory: 'new'. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 00:08'! findDuplicates "Find duplicate messages, and move the redundant copies to a given category." | duplicatesCategory | mailDB ifNil: [ ^self ]. duplicatesCategory _ FillInTheBlank request: 'File duplicates in category?' initialAnswer: '.duplicates.'. duplicatesCategory isEmpty ifTrue:[^ self]. self requiredCategory: duplicatesCategory. Utilities informUser: 'Searching for duplicates...' during: [mailDB fileDuplicatesIn: duplicatesCategory]. self setCategory: duplicatesCategory. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:52'! importIntoCategory "Add the messages from a Unix or Eudora format file into this category" | inboxPath count | mailDB ifNil: [ ^self ]. currentCategory ifNil: [ ^self ]. "get the file to import from" inboxPath _ ''. [ inboxPath _ FillInTheBlank request: 'file to import from?\(should be Eudora or Unix format)' withCRs. inboxPath isEmpty ifTrue: [ ^self ]. FileStream isAFileNamed: inboxPath ] whileFalse: [ self inform: 'file does not exist' ]. Utilities informUser: 'Fetching mail from ', inboxPath during: [ count _ mailDB importMailFrom: inboxPath intoCategory: currentCategory. ]. self inform: count printString, ' messages imported'. self updateTOC.! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:49'! nextCategory "Select the next category." | catList i | mailDB ifNil: [ ^self ]. catList _ self categoryList. (currentCategory isNil) ifTrue: [currentCategory _ catList last]. i _ catList indexOf: currentCategory. i < catList size ifTrue: [self setCategory: (catList at: i + 1)] ifFalse: [self setCategory: (catList at: 1)]. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:49'! previousCategory "Select the next category." | catList i | mailDB ifNil: [ ^self ]. catList _ self categoryList. (currentCategory isNil) ifTrue: [currentCategory _ catList last]. i _ catList indexOf: currentCategory. i > 1 ifTrue: [self setCategory: (catList at: i - 1)] ifFalse: [self setCategory: (catList at: catList size)]. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:52'! removeCategory "Remove the existing category with the user-specified name." | msgList | mailDB ifNil: [ ^self ]. currentCategory ifNil: [ ^self ]. msgList _ mailDB messagesIn: currentCategory. (mailDB messagesIn: '.trash.') do: [: id | msgList remove: id ifAbsent: []]. msgList isEmpty ifFalse: [ (self confirm: 'This category is not empty. Are you sure you wish to remove it?') ifFalse: [^self]]. mailDB removeCategory: currentCategory. self changed: #categoryList. self setCategory: nil. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:52'! renameCategory "Rename the category with the user-specified name." | newCatName | mailDB ifNil: [ ^self ]. currentCategory ifNil: [ ^self ]. newCatName _ FillInTheBlank request: 'New name?' initialAnswer: currentCategory. (newCatName isEmpty) ifTrue: [^self]. "user aborted" mailDB renameCategory: currentCategory to: newCatName. currentCategory _ newCatName. self changed: #categoryList.! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:49'! save "Snapshot the database to disk." mailDB ifNil: [ ^self ]. mailDB saveDB. ! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:49'! setCCList "Change the default cc: list for use in composing messages." mailDB ifNil: [ ^self ]. self class setCCList.! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:50'! setPopServer mailDB ifNil: [ ^self ]. ^self class setPopServer! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:50'! setPopUserName mailDB ifNil: [ ^self ]. userPassword _ nil. "Clear the password when a new username is set" ^self class setPopUserName! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:50'! setSmtpServer mailDB ifNil: [ ^self ]. ^self class setSmtpServer! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:50'! setUserName "Change the user's email name for use in composing messages." mailDB ifNil: [ ^self ]. self class setUserName.! ! !Celeste methodsFor: 'categories pane' stamp: 'ls 6/21/2001 17:50'! viewAllMessages mailDB ifNil: [ ^self ]. currentMessages _ self filteredMessagesIn: self category. self messages: currentMessages size from: currentMessages size. self cacheTOC. self changed: #tocEntryList. self changed: #tocEntry. self changed: #messageText! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:31'! autoFile "automatically pick a folder for the current message, and file the current message there" | folder | mailDB ifNil: [ ^self ]. folder := self chooseFilterForCurrentMessage. folder ifNil: [ ^self]. lastCategory := folder. mailDB file: currentMsgID inCategory: folder.! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:32'! autoMove "automatically pick a folder for the current message, and move the message there" | folder | mailDB ifNil: [ ^self ]. folder := self chooseFilterForCurrentMessage. folder ifNil: [ ^self]. lastCategory := folder. mailDB file: currentMsgID inCategory: folder. self removeMessage.! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:32'! deleteAll "Move all visible messages in the current category to '.trash.'." | | mailDB ifNil: [ ^self ]. self requiredCategory: '.trash.'. mailDB fileAll: currentMessages inCategory: '.trash.'. self removeAll.! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:32'! fileAgain "File the current message in the same category as last time." | newCatName | mailDB ifNil: [ ^self ]. (lastCategory isEmpty not) ifTrue: [newCatName _ lastCategory] ifFalse: [newCatName _ self getCategoryNameIfNone: [^self]]. mailDB file: currentMsgID inCategory: newCatName. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:32'! fileAll "File all visible messages in the current category in some other category as well." | newCatName msgList | mailDB ifNil: [ ^self ]. newCatName _ self getCategoryNameIfNone: [^self]. msgList _ self filteredMessagesIn: currentCategory. mailDB fileAll: msgList inCategory: newCatName. self updateTOC.! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:32'! fileMessage "File the current message in another category." | newCatName | mailDB ifNil: [ ^self ]. newCatName _ self getCategoryNameIfNone: [^self]. mailDB file: currentMsgID inCategory: newCatName. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! moveAll "Move all visible messages in the current category to another category." | newCatName | mailDB ifNil: [ ^self ]. newCatName _ self getCategoryNameIfNone: [^self]. newCatName = currentCategory ifTrue:[ ^self ]. mailDB fileAll: currentMessages inCategory: newCatName. self removeAll.! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! moveMessage "Move the current message to another category; this consists of filing it in the new category, and then removing it from the current category" | newCatName | mailDB ifNil: [ ^self ]. newCatName _ self getCategoryNameIfNone: [^self]. newCatName = currentCategory ifTrue: [ ^self ]. mailDB file: currentMsgID inCategory: newCatName. self removeMessage. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! nextMessage "Select the next message." | index | mailDB ifNil: [ ^self ]. (currentCategory isNil | currentMsgID isNil) ifTrue: [^ self]. index _ currentMessages indexOf: currentMsgID. index < currentMessages size ifTrue: [self setTOCEntry: ((self tocLists at: 1) at: index + 1)] ifFalse: [self setTOCEntry: ((self tocLists at: 1) at: 1)]. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! otherCategories "Prompt the user with a menu of all other categories in which the currently selected message appears. If the user chooses a category from this menu, go to that category." | otherCategories choice | mailDB ifNil: [ ^self ]. otherCategories _ (mailDB categoriesThatInclude: currentMsgID) asOrderedCollection. otherCategories remove: currentCategory ifAbsent: []. (otherCategories isEmpty) ifTrue: [^self]. choice _ (CustomMenu selections: otherCategories) startUp. choice = nil ifFalse: [self setCategory: choice].! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! partsMenu "Show a menu listing all the parts of this message, and let the user save the chosen part to a file" | menu currMessage part | currentMsgID ifNil: [ ^self ]. menu _ CustomMenu new. currMessage _ self currentMessage. currMessage atomicParts do: [:e | menu add: 'save ' , e printString action: e]. part _ menu startUp. part ifNotNil: [part save]! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! previousMessage "Select the previous message." | index | mailDB ifNil: [ ^self ]. (currentCategory isNil | currentMsgID isNil) ifTrue: [^ self]. index _ currentMessages indexOf: currentMsgID. index > 1 ifTrue: [self setTOCEntry: ((self tocLists at: 1) at: index - 1)] ifFalse: [self setTOCEntry: ((self tocLists at: 1) at: currentMessages size)]. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:33'! removeAll "Remove all presently listed messages from the current category." mailDB ifNil: [ ^self ]. mailDB removeAll: currentMessages fromCategory: currentCategory. currentMsgID _ nil. "Regenerate the (possibly empty) TOC for this category" self setCategory: currentCategory. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:34'! search "Search the text of all messages in the present category" | destCat matchString msgText | mailDB ifNil: [ ^self ]. destCat _ FillInTheBlank request: 'In what category should the search results be filed?' initialAnswer: '.search results.'. (destCat isEmpty) ifTrue: [^self]. matchString _ FillInTheBlank request: 'String sought in message text?' initialAnswer: ''. (matchString isEmpty) ifTrue: [^self]. self requiredCategory: destCat. (self filteredMessagesIn: currentCategory) do: [: msgID | msgText _ mailDB getText: msgID. ((msgText findString: matchString startingAt: 1) > 0) ifTrue: [mailDB file: msgID inCategory: destCat]]. self setCategory: destCat. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'ls 6/21/2001 17:34'! updateTOC "Update the table of contents after a moving, removing, or deleting a message. Select a message near the removed message in the table of contents if possible." | savedMsgID | mailDB ifNil: [ ^self ]. savedMsgID _ currentMsgID. "update the TOC listing without displaying any particular message" currentMsgID _ nil. self setCategory: currentCategory. self displayMessage: savedMsgID. "NB: self changed: #tocEntryList is already done above by setCategory: and can be slow" self changed: #outBoxStatus! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:34'! customFilterOff "Cancel custom filtering." mailDB ifNil: [ ^self ]. customFilterBlock ifNil: [ "it's already turned off" ^self ]. customFilterBlock _ nil. self updateTOC. self changed: #isCustomFilterOn.! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:34'! customFilterOn "Select or define and activate a custom filter." | filterName filterMenu | mailDB ifNil: [ ^self ]. filterMenu := CustomMenu new. currentMsgID ifNotNil: [ (self filtersFor: currentMsgID from: self filterNames) do: [ :name | filterMenu add: name action: name ]. filterMenu addLine.]. filterMenu add: '(none)' action: #none. filterMenu add: '' action: #define. filterMenu add: '' action: #edit. filterMenu add: '' action: #delete. filterMenu addLine. self filterNames do: [ :name | filterMenu add: name action: name ]. filterName _ filterMenu startUpWithCaption: 'Select a filter:'. filterName ifNil: [ ^self ]. filterName = #none ifTrue: [^self customFilterOff ]. filterName = #delete ifTrue: [ ^self deleteFilter]. filterName = #edit ifTrue: [filterName _ self editFilter] ifFalse: [ filterName = #define ifTrue: [filterName _ self defineFilter] ]. filterName ifNil: [ ^self ]. filterName isEmpty ifTrue: [^self]. customFilterBlock _ CustomFiltersCompiled at: filterName. self updateTOC. self changed: #isCustomFilterOn.! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:34'! defineFilter | filterName | mailDB ifNil: [ ^self ]. filterName _ FillInTheBlank request: 'Filter name?'. filterName isEmpty ifTrue: [^ '']. ^self editFilterNamed: filterName ! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:35'! deleteFilter | filterName | mailDB ifNil: [ ^self ]. CustomFilters isEmpty ifTrue: [^'']. filterName _ (CustomMenu selections: self filterNames) startUpWithCaption: 'Filter to delete?'. filterName = nil ifTrue: [^'']. CustomFilters removeKey: filterName ifAbsent: []. CustomFiltersCompiled removeKey: filterName ifAbsent: [].! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:35'! editCategoryFilter mailDB ifNil: [ ^self ]. self editFilterNamed: currentCategory! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:35'! editFilter | filterName | mailDB ifNil: [ ^self ]. CustomFilters isEmpty ifTrue: [^'']. filterName _ (CustomMenu selections: self filterNames) startUpWithCaption: 'Filter to edit?'. filterName = nil ifTrue: [^'']. ^self editFilterNamed: filterName filterExpr: (CustomFilters at: filterName)! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/20/2001 23:57'! filteredMessagesIn: categoryName | msgList | mailDB ifNil: [ ^#() ]. msgList _ mailDB messagesIn: categoryName. (participantFilter size > 0) ifTrue: [msgList _ msgList select: [: id | (mailDB getTOCentry: id) participantHas: participantFilter ]]. (subjectFilter size > 0) ifTrue: [msgList _ msgList select: [: id | (mailDB getTOCentry: id) subject includesSubstring: subjectFilter caseSensitive: false]]. "We do custom filters last so they have to apply to the smallest number of messages" (customFilterBlock notNil) ifTrue: [msgList _ msgList select: [: id | customFilterBlock value: (mailDB getTOCentry: id) ]]. ^msgList! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:35'! participantFilterOn "Show only those messages where a specified user is either the sender or a receiver." mailDB ifNil: [ ^self ]. participantFilter _ (currentMsgID isNil) ifTrue: [''] ifFalse: [(mailDB getTOCentry: currentMsgID) from]. participantFilter _ FillInTheBlank request: '''Participant:'' filter pattern?' initialAnswer: participantFilter. participantFilter _ participantFilter withBlanksTrimmed. self updateTOC. self changed: #isParticipantFilterOn.! ! !Celeste methodsFor: 'filtering' stamp: 'ls 6/21/2001 17:35'! subjectFilterOn "Show only those messages whose subject matches the currently selected message. The user is given a chance to edit the pattern string used to match 'Subject:' fields." mailDB ifNil: [ ^self ]. subjectFilter _ currentMsgID isNil ifTrue: [''] ifFalse: [(mailDB getTOCentry: currentMsgID) subject]. subjectFilter _ self normalizedSubject: subjectFilter. subjectFilter _ FillInTheBlank request: '''Subject:'' filter pattern?' initialAnswer: subjectFilter. self updateTOC. self changed: #isSubjectFilterOn! ! !Celeste methodsFor: 'message text pane' stamp: 'ls 6/21/2001 17:35'! compose "Make a MailSendTool for composing a new message." mailDB ifNil: [ ^self ]. self openSender: self composeText.! ! !Celeste methodsFor: 'message text pane' stamp: 'ls 6/21/2001 18:01'! doItReceiver ^self! ! !Celeste methodsFor: 'message text pane' stamp: 'ls 6/21/2001 17:35'! format mailDB ifNil: [ ^self ]. messageTextView editString: self formatedMessageText; hasUnacceptedEdits: true. ! ! !Celeste methodsFor: 'message text pane' stamp: 'ls 6/21/2001 18:00'! message "Answer the text of the currently selected message or nil if there isn't one." self isThisEverCalled . (currentMsgID isNil) ifTrue: [^''] ifFalse: [^(mailDB getText: currentMsgID) asText]! ! !Celeste methodsFor: 'message text pane' stamp: 'ls 6/21/2001 18:02'! messageText "Answer the text which makes up the complete message (header+body)" mailDB ifNil: [ ^self messageTextIfNoDB ]. (currentMsgID isNil) ifTrue: [^'']. "Always show the full message header for messages in the category .tosend. so that all special header lines are preserved, shown and can be edited." (currentCategory = '.tosend.') ifTrue: [^ mailDB getText: currentMsgID]. SuppressWorthlessHeaderFields ifTrue: [^ self currentMessage formattedText] ifFalse: [^ mailDB getText: currentMsgID]. ! ! !Celeste methodsFor: 'message text pane' stamp: 'ls 6/21/2001 18:11'! messageTextIfNoDB "return text to display to the user if there is no DB opened" | openCommand | openCommand := 'OPEN' asText. openCommand addAttribute: (PluggableTextAttribute evalBlock: [ self openDefaultDatabase ]). openCommand addAttribute: (TextColor blue). ^'No DB is currently open. Press ' asText, openCommand, ' to open the default database.'! ! !Celeste methodsFor: 'other' stamp: 'ls 6/21/2001 17:36'! changeMaxMessageCount | countString count | mailDB ifNil: [ ^self ]. countString _ FillInTheBlank request: 'Maximum number of messages displayed?' initialAnswer: self class messageCountLimit printString. countString isEmpty ifTrue: [^ self]. count _ countString asInteger max: 1. self class messageCountLimit: count. self setCategory: currentCategory! ! !Celeste methodsFor: 'other' stamp: 'ls 6/20/2001 23:59'! outBoxStatus | outgoing | outgoing _ mailDB ifNil: [ #() ] ifNotNil: [ mailDB messagesIn: '.tosend.' ]. outgoing isEmpty ifTrue: [^ 'no mail to be sent']. ^ 'messages in queue: ' , outgoing size printString! ! !Celeste methodsFor: 'sending mail' stamp: 'ls 6/21/2001 17:51'! 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: self class userName) first. [socket _ SMTPSocket usingServer: Celeste 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: 'instance creation' stamp: 'ls 6/21/2001 17:55'! defaultDBName "return the default database name to access" ^'EMAIL'! ! !Celeste class methodsFor: 'instance creation' stamp: 'ls 6/21/2001 17:29'! onDatabase: aMailDB "open a Celeste on the given MailDB" ^super new openOnDatabase: aMailDB! ! !Celeste class methodsFor: 'instance creation' stamp: 'ls 6/21/2001 17:56'! open "Open a MailReader on the default mail database." ^ self openOn: self defaultDBName! ! !Celeste class methodsFor: 'instance creation' stamp: 'ls 6/21/2001 00:06'! openOn: rootFilename "Open a MailReader on the mail database with the given root filename." |database | (MailDB isADBNamed: rootFilename) ifTrue: [ database _ MailDB openOn: rootFilename. ] ifFalse: [ database _ nil. "open an empty Celeste with a welcome message" ]. self openOnDatabase: database! ! !Celeste class methodsFor: 'common build' stamp: 'ls 6/21/2001 17:29'! openOnDatabase: aMailDB "Open a MailReader on the given mail database." | model topWindow title | model _ self onDatabase: aMailDB. title _ self defaultWindowTitle. Smalltalk isMorphic ifTrue: [topWindow _ self buildTopMorphicWindowTitled: title model: model. topWindow openInWorld] ifFalse: [topWindow _ self buildTopMVCWindowTitled: title model: model. topWindow controller open]. "in case the sender wants to know" ^ model! ! !CelesteTestCase methodsFor: 'running' stamp: 'ls 6/21/2001 17:48'! testGraceWithoutMailDB "test that a celeste without a mailDB loaded will gracefully accept all UI messages and do nothing" | dbLessCeleste menu | dbLessCeleste := Celeste onDatabase: nil. "try pressing all the buttons" (Celeste buildButtonsFor: dbLessCeleste) do: [ :button | button performAction. button performAction. ]. "try all the table-of-contents menu items" menu := MenuMorph new defaultTarget: dbLessCeleste. dbLessCeleste tocMenu: menu. menu items do: [ :menuItem | menuItem doButtonAction ]. "try all the category menu items" menu := MenuMorph new defaultTarget: dbLessCeleste. dbLessCeleste categoryMenu: menu. menu items do: [ :menuItem | menuItem doButtonAction ].! ! !MailDB methodsFor: 'open-create-save' stamp: 'ls 6/21/2001 00:11'! createDB "Create a new mail database." self openDB. "creates new DB files" self saveDB. "save the new mail database to disk"! ! !MailDB methodsFor: 'open-create-save' stamp: 'ls 6/21/2001 00:05'! dbStatus ^self class dbStatusFor: rootFilename! ! !MailDB methodsFor: 'copying' stamp: 'ls 6/21/2001 17:06'! veryDeepCopyWith: deepCopier "don't copy MailDB's -- they refer to external state in files, and the user almost certainly does not intend for a completely independent MailDB to be created" ^self! ! !MailDB class methodsFor: 'instance creation' stamp: 'ls 6/21/2001 00:05'! isADBNamed: dbname "return whether there is a MailDB on disk with the specified name" | status | status := self dbStatusFor: dbname. ^status ~~ #doesNotExist.! ! !MailDB class methodsFor: 'private' stamp: 'ls 6/21/2001 00:04'! dbStatusFor: rootFilename "See if the named databes exists. Since the database has several components, the answer is one of: #exists all files exist, and were created in the right order #partialDatabase only some of the files exist #doesNotExist none of the files exist" | dir localName messageFileExists indexFileExists categoriesFileExists messageFileTime categoriesFileTime | dir _ FileDirectory forFileName: rootFilename. localName _ FileDirectory localNameFor: rootFilename. messageFileExists _ dir includesKey: localName, '.messages'. indexFileExists _ dir includesKey: localName, '.index'. categoriesFileExists _ dir includesKey: localName, '.categories'. "Check if no parts of the database exist" (messageFileExists | indexFileExists | categoriesFileExists) ifFalse: [^ #doesNotExist]. "Check if the database was written in a normal sequence" (messageFileExists & indexFileExists & categoriesFileExists) ifTrue: [ messageFileTime _ (dir entryAt: localName, '.messages') modificationTime. categoriesFileTime _ (dir entryAt: localName, '.categories') modificationTime. "Unfortunately the strongest thing we can say is that the message file should be the oldest file on disk, and the categories file the newest" (messageFileTime <= categoriesFileTime) ifTrue: [^ #exists]. ]. ^ #partialDatabase ! ! !PluggableTextAttribute methodsFor: 'initialization' stamp: 'ls 6/21/2001 18:06'! evalBlock: aBlock evalBlock := aBlock! ! !PluggableTextAttribute methodsFor: 'clicking' stamp: 'ls 6/21/2001 18:13'! actOnClickFor: anObject evalBlock ifNil: [ ^self ]. evalBlock numArgs = 0 ifTrue: [ evalBlock value. ^true ]. evalBlock numArgs = 1 ifTrue: [ evalBlock value: anObject. ^true ]. self error: 'evalBlock should have 0 or 1 arguments'! ! !PluggableTextAttribute class methodsFor: 'instance creation' stamp: 'ls 6/21/2001 18:09'! evalBlock: aBlock ^super new evalBlock: aBlock! ! Celeste removeSelector: #createNewDatabase!