Hi Everyone,

I just fixed a niggly that I've had with Celeste for a long time.  If 
you're one of those people who wants to leave mail on a POP3 server so
you can pop it from other clients, and you pull your hair out every time
Celeste downloads _ALL_ your messages each time you check your mail, this
enhancement is for you.

I even remembered to add a preamble this time ;-)

There are a couple more things that I'd like to add, but I think this
is a decent start.  Hope you enjoy it,

Josh


--------------------------------------------

'From Squeak 2.4c of May 10, 1999 on 16 June 1999 at 10:09:46 am'!
"Change Set:		CelesteTweaks
Date:			16 June 1999
Author:			Joshua Gargus

Adds a few features to Celeste.  This is the big one: allows Celeste to use the optional POP3 UIDL command to determine whether a message has already been downloaded.  If so, it doesn't download it again.  It will act just as before for servers that do no
t support the UIDL command.

The menu command 'delete duplicates' was added to the category menu.  This was a stop-gap feature before the above was implemented.

Finally, I fixed a small bug in the example text in the filtering editing window.
"!

Object subclass: #MailMessage
	instanceVariableNames: 'time from to cc subject text body uidl '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Interface-Mail Reader'!

!Celeste methodsFor: 'categories pane' stamp: 'jcg 5/26/1999 19:00'!
categoryMenu: aMenu
	"Answer the menu for the categories pane."

	| labels lineSeparations selectors lines |
	labels _ 'save\fetch mail\send queued mail\add category' withCRs.
	lineSeparations _ #(1 2).
	selectors _ #(save fetchMail sendQueuedMail addCategory).

	"add extra commands if a normal category is selected"
	((currentCategory notNil) and:
	 [(currentCategory ~= '.all.') &
	  (currentCategory ~= '.unclassified.')])
		ifTrue: [
			labels _ labels, '\rename category\remove category\import into category\export category (Celeste)\export category (Unix/Eudora)' withCRs.
			lineSeparations _ lineSeparations, #(3 3).
			selectors _ selectors, #(renameCategory removeCategory importIntoCategory exportCategory exportCategoryUnix)]
		ifFalse: [
			lineSeparations _ lineSeparations, #(1)].

	labels _ labels, '\empty trash\compact\find duplicates\delete duplicates\toggle headers\set user name\set cc: list\set POP server\set POP username\set SMTP server' withCRs.
	lineSeparations _ lineSeparations, #(4 1 5).
	selectors _ selectors, #(emptyTrash compact findDuplicates deleteDuplicates toggleSuppressHeaders setUserName setCCList setPopServer setPopUserName setSmtpServer).

	"add toggle for whether to delete messages on download"
	DeleteInboxAfterFetching
		ifTrue: [labels _ labels, '\leave messages on server' withCRs.
			selectors _ selectors, #(keepMessagesOnServer)]
		ifFalse: [labels _ labels, '\don''t leave messages on server' withCRs.
			selectors _ selectors, #(deleteMessagesAfterFetching)].
	lineSeparations _ lineSeparations, #(1).

	"convert lineSeperations into absolute line positions"
	lines _ lineSeparations copyFrom: 1 to: (lineSeparations size - 1).
	(2 to: lines size) do: [:i |
		lines at: i put: ((lines at: i) + (lines at: i-1))].

	^ aMenu labels: labels lines: lines  selections: selectors
! !

!Celeste methodsFor: 'categories pane' stamp: 'jcg 5/26/1999 18:52'!
deleteDuplicates
	mailDB deleteDuplicates.
! !

!Celeste methodsFor: 'filtering' stamp: 'jcg 6/16/1999 09:37'!
editFilterNamed: filterName filterExpr: oldExpr

	| newDefinition |
	newDefinition _ FillInTheBlank
		request:
'Enter a filter definition where "m" is the message being testing. The expression can send
"fromHas:", "toHas:", "ccHas:", "subjectHas:", "participantHas:", or "textHas:" to m to test for
inclusion of a string--or one of an array of strings--in a field. It can also test m''s time
and/or date and can combine several tests with logical operators. Examples:
 
     m fromHas: ''johnm''                       -- messages from johnm
     m participantHas: ''johnm''                -- messages from, to, or cc-ing johnm
     m textHas: #(''squeak'' ''smalltalk'' ''java'')      -- messages with any of these words
     m subjectHas: #(0 1 2 3 4 5 6 7 8 9)       -- numbers in lists treated as strings
 
NOTE: "textHas:" is very slow, since it must read the message from disk.'
		initialAnswer: oldExpr.
	newDefinition isEmpty ifTrue: [^''].
	CustomFilters at: filterName put: newDefinition.
	^newDefinition! !


!MailDB methodsFor: 'fetch-import-export' stamp: 'jcg 6/16/1999 03:05'!
fetchMailFromPOP: server userName: userName password: password doFormatting: doFormatting deleteFromServer: deleteFromServer
	"Download mail from the given POP3 mail server and append it this mail database. Answer the number of messages fetched. If doFormatting is true, messages will be formatted as they are received. If deleteFromServer is true, then messages will be removed f
rom the POP3 server after being successfully retrieved. (Note: If there is a failure while fetching mail, all messages will be left on the server.)"

	| popConnection msgCount actuallyDownloaded |
	Socket initializeNetwork.
	popConnection _ POPSocket new
		serverName: server;	
		userName: userName;
		password: password;
		addProgressObserver: Transcript.
	Utilities
		informUser: 'connecting to ', server
		during: [popConnection connectToPOP].
	popConnection isConnected ifFalse: [^ -1].

	msgCount _ popConnection numMessages.
	msgCount > 0 
	ifTrue: [actuallyDownloaded _ self 
								fetchMessageCount: msgCount
								fromPOPConnection: popConnection
								doFormatting: doFormatting.

		deleteFromServer ifTrue: [
			self removeMessageCount: msgCount fromPOPConnection: popConnection]]
	ifFalse: [actuallyDownloaded _ 0].

	popConnection disconnectFromPOP.
	^ actuallyDownloaded
! !

!MailDB methodsFor: 'fetch-import-export' stamp: 'jcg 6/16/1999 03:05'!
fetchMessageCount: msgCount fromPOPConnection: popConnection doFormatting: doFormatting
	"Download the given number of messages from the given open POP3 connection. If doFormatting is true, messages will be formatted as they are received."

	| nextID msgText allUIDLs allMessageNums msg location |
	nextID _ self nextUnusedID.

	"JCG: Collect all of the uidls currently in the mail file; then we can check if we've already downloaded the message."

	allUIDLs _ (self messagesIn: '.all.') 
		collect: [:id | (self getMessage: id) uidl]
		thenSelect: [:uidl | uidl isNil not].

	Utilities informUser: 'checking how many messages need to be downloaded.'
	during: [
		allMessageNums _ (popConnection retreiveAllUIDLs
			collect: [:pair | 
				(allUIDLs includes: pair second) ifTrue: [nil] ifFalse: [pair first asNumber]]
			thenSelect: [:num | num isNil not])
			asSortedCollection].

	messageFile beginAppend.

	"MessageTally spyOn: ["
	('Downloading ', allMessageNums size printString, ' messages...')
		displayProgressAt: Sensor mousePoint
		from: 0
		to: allMessageNums size
		during: [:progressBar |
			allMessageNums do: [:messageNum |
				progressBar value: messageNum.
				popConnection isConnected ifFalse: [
					popConnection destroy.  "network error"
					messageFile endAppend.
					LastID _ nextID.
					self saveDB.
					^ self inform: 'Server connection unexpectedly closed.'].

				"get a message"
				msgText _ popConnection retrieveMessage: messageNum.
				
				"save that message"
				msg _ MailMessage from: msgText.
				doFormatting ifTrue: [msg format].
				location _ messageFile basicAppend: msg text id: nextID.
				indexFile
					at: nextID
					put: (IndexFileEntry
						message: msg
						location: location
						messageFile: messageFile
						msgID: nextID).
				categoriesFile file: nextID inCategory: 'new'.
				nextID _ nextID + 1]].
	"]." "'MessageTally spyOn:' ends"

	messageFile endAppend.
	LastID _ nextID.
	self saveDB.

	^ allMessageNums size.! !

!MailDB methodsFor: 'housekeeping' stamp: 'jcg 5/26/1999 18:52'!
deleteDuplicates

	self deleteAll: (self findDuplicates)
! !


!MailMessage methodsFor: 'initialize-release' stamp: 'jcg 6/16/1999 00:28'!
from: aString 
	"Parse the given string to initialize myself. The given string will become 
	my text."
	| parseStream isMime contentType bodyText contentTransferEncoding |

	time _ 0.
	from _ to _ cc _ subject _ ''.
	text _ self removeTrailingSeparators: aString.
	parseStream _ ReadStream on: text.
	isMime _ false.
	contentType _ 'text/plain'.
	contentTransferEncoding _ nil.
	self fieldsFrom: parseStream do: 
		[:fName :fValue | 
		fName = 'date' ifTrue: [time _ self timeFrom: fValue].
		fName = 'from' ifTrue: [from _ fValue].
		fName = 'to'
			ifTrue: [to isEmpty
					ifTrue: [to _ fValue]
					ifFalse: [to _ to , ', ' , fValue]].
		fName = 'cc'
			ifTrue: [cc isEmpty
					ifTrue: [cc _ fValue]
					ifFalse: [cc _ cc , ', ' , fValue]].
		fName = 'subject' ifTrue: [subject _ fValue].
		fName = 'mime-version' ifTrue: [isMime _ true].
		fName = 'content-type' ifTrue: [contentType _ fValue].
		fName = 'content-transfer-encoding' ifTrue: [contentTransferEncoding _ fValue asLowercase].
		fName = 'x-uidl' ifTrue: [uidl _ fValue]].
	bodyText _ parseStream upToEnd.
	contentTransferEncoding = 'base64'
		ifTrue: 
			[bodyText _ Base64MimeConverter mimeDecodeToChars: (ReadStream on: bodyText).
			bodyText _ bodyText contents].
	contentTransferEncoding = 'quoted-printable' ifTrue: [ bodyText _ bodyText decodeQuotedPrintable ].
	isMime
		ifTrue: [body _ MIMEDocument contentType: contentType content: bodyText]
		ifFalse: [body _ MIMEDocument contentType: 'text/plain' content: bodyText]! !

!MailMessage methodsFor: 'access' stamp: 'jcg 6/15/1999 23:41'!
uidl

	^uidl! !


!POPSocket methodsFor: 'low-level protocol' stamp: 'jcg 6/16/1999 09:55'!
retreiveAllUIDLs
	"return a Collection of two-element Arrays, where the first element is the message number and the second is the UIDL corresponding to it.  Because UIDL is an optional POP3 instruction, we should fail gracefully.  We do this by returning an empty collecti
on."

	| response collection |

	collection _ OrderedCollection new.

	self sendCommand: 'UIDL'.
	response _ self getResponse.
	(response beginsWith: '+OK') ifFalse: [ ^collection ].

	"If we get here, response will now hold the tokens parsed from the multi-line response."
	response _ self getMultilineResponse findTokens: Character separators.

	"I'm not sure if 'Array with: response removeFirst with: responseRemoveFirst' is a smart thing to do; is the behavior defined? or even if it works, might it change?  I'm just going to play it safe."
	[response size = 0] whileFalse: [ 
		collection add: (Array with: response first with: response second).
		response removeFirst. response removeFirst].

	^ collection.



	! !

!POPSocket methodsFor: 'low-level protocol' stamp: 'jcg 6/16/1999 09:56'!
retrieveUIDL: number
	"retrieve the 'unique-id listing' for the numbered message.  Because UIDL is an optional POP3 instruction, we should fail gracefully.  We do this by returning nil."
	| response |

	self sendCommand: 'UIDL ', number printString.
	response _ self getResponse.
	(response beginsWith: '+OK') ifFalse: [ ^ nil ].

	^ (response findTokens: Character separators) third.



		
	! !