The Trunk: Network-pre.207.mcz - Squeak-dev

10 Nov 2017


      Patrick Rein uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-pre.207.mcz
==================== Summary ====================
Name: Network-pre.207
Author: pre
Time: 10 November 2017, 4:40:14.388812 pm
UUID: 85f492c1-3470-bb43-afe5-bea036995824
Ancestors: Network-pre.206
A new MailComposition window allowing a more structured access to the underlying mail message.
=============== Diff against Network-pre.206 ===============
Item was changed:
  Model subclass: #MailComposition
+ 	instanceVariableNames: 'mailMessage'
- 	instanceVariableNames: 'messageText textEditor morphicWindow mvcWindow'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Network-MailSending'!
+ !MailComposition commentStamp: 'pre 5/16/2017 20:00' prior: 0!
+ a message being composed in a fancy way. The mail is send via the registered MailSender by default. Fields do not have to be saved, they are saved automatically on send. !
- !MailComposition commentStamp: '<historical>' prior: 0!
- a message being composed.  When finished, it will be submitted via a Celeste.!
Item was changed:
+ ----- Method: MailComposition class>>initialize (in category 'class initialization') -----
- ----- Method: MailComposition class>>initialize (in category 'instance creation') -----
  initialize
+ 
+ 	MailSender register: self !
- 	super initialize.
- 	MailSender register: self.!
Item was added:
+ ----- Method: MailComposition class>>open (in category 'opening') -----
+ open
+ 
+ 	^ ToolBuilder default open: self!
Item was added:
+ ----- Method: MailComposition class>>openOn: (in category 'opening') -----
+ openOn: aMessage
+ 
+ 	^ ToolBuilder default open: (self new on: aMessage; yourself)!
Item was changed:
+ ----- Method: MailComposition class>>sendMailMessage: (in category 'MailSender interface') -----
+ sendMailMessage: aMessage
+ 
+ 	self openOn: aMessage!
- ----- Method: MailComposition class>>sendMailMessage: (in category 'instance creation') -----
- sendMailMessage: aMailMessage
- 	| newComposition |
- 	newComposition := self new.
- 	newComposition messageText: aMailMessage text; open!
Item was changed:
+ ----- Method: MailComposition class>>unload (in category 'initialize-release') -----
- ----- Method: MailComposition class>>unload (in category 'instance creation') -----
  unload
MailSender unregister: self !
Item was added:
+ ----- Method: MailComposition>>addAttachment (in category 'actions') -----
+ addAttachment
+ 	| file fileResult fileName |
+ 	
+ 	self saveFields.
+ 
+ 	(fileResult := StandardFileMenu oldFile)
+ 		ifNotNil: 
+ 			[fileName := fileResult directory fullNameFor: fileResult name.
+ 			file := FileStream readOnlyFileNamed: fileName.
+ 			file ifNotNil:
+ 				[file binary.
+ 				mailMessage addAttachmentFrom: file withName: fileResult name.
+ 				file close.
+ 				self changed: #messageText]] !
Item was added:
+ ----- Method: MailComposition>>addAttachmentButtonLabel (in category 'ui constants') -----
+ addAttachmentButtonLabel
+ 
+ 	^ 'add attachment' translated!
Item was added:
+ ----- Method: MailComposition>>bccLabel (in category 'ui constants') -----
+ bccLabel
+ 
+ 	^ 'BCC' translated!
Item was added:
+ ----- Method: MailComposition>>buildButtonBarSpecWith: (in category 'toolbuilder') -----
+ buildButtonBarSpecWith: aBuilder
+ 	
+ 	| buttonBarSpec |
+ 	buttonBarSpec := aBuilder pluggablePanelSpec new
+ 		children: OrderedCollection new;
+ 		layout: #horizontal;
+ 		frame: (LayoutFrame new
+ 			leftFraction: 0 offset: 0;
+ 			topFraction: 0 offset: 0;
+ 			rightFraction: 1 offset: 0;
+ 			bottomFraction: 0 offset: self buttonBarHeight);
+ 		yourself.
+ 	
+ 	buttonBarSpec children add: (aBuilder pluggableButtonSpec new
+ 		model: self;
+ 		action: #sendMail;
+ 		label: #sendMailButtonLabel;
+ 		yourself).
+ 	
+ 	buttonBarSpec children add: (aBuilder pluggableButtonSpec new
+ 		model: self;
+ 		action: #addAttachment;
+ 		label: #addAttachmentButtonLabel;
+ 		yourself).
+ 		
+ 	buttonBarSpec children add: (aBuilder pluggableButtonSpec new
+ 		model: self;
+ 		action: #removeAttachment;
+ 		label: #removeAttachmentButtonLabel;
+ 		yourself).
+ 		
+ 	^ buttonBarSpec!
Item was added:
+ ----- Method: MailComposition>>buildWith: (in category 'toolbuilder') -----
+ buildWith: aBuilder
+ 
+ 	| windowSpec detailsPanelSpec textSpec |
+ 
+ 	windowSpec := aBuilder pluggableWindowSpec new
+ 		model: self;
+ 		label: self dialogTitle;
+ 		children: OrderedCollection new.
+ 		
+ 	windowSpec children add: (self buildButtonBarSpecWith: aBuilder).
+ 		
+ 	detailsPanelSpec := aBuilder pluggablePanelSpec new
+ 		children: OrderedCollection new;
+ 		layout: #vertical;
+ 		yourself.
+ 	windowSpec children add: detailsPanelSpec.
+ 	
+ 	self createDetailsFieldsIn: detailsPanelSpec by: aBuilder.
+ 	
+ 	detailsPanelSpec children: detailsPanelSpec children reversed.
+ 	detailsPanelSpec frame: (LayoutFrame new
+ 			leftFraction: 0 offset: 0;
+ 			topFraction: 0 offset: self buttonBarHeight;
+ 			rightFraction: 1 offset: 0;
+ 			bottomFraction: 0 offset: self buttonBarHeight + (detailsPanelSpec children size * self lineHeight)).
+ 			
+ 	textSpec := aBuilder pluggableTextSpec new
+ 		model: self;
+ 		indicateUnacceptedChanges: true;
+ 		getText: #messageText;
+ 		setText: #messageText:;
+ 		frame: (LayoutFrame new
+ 			leftFraction: 0 offset: 0;
+ 			topFraction: 0 offset: self buttonBarHeight + (detailsPanelSpec children size * self lineHeight);
+ 			rightFraction: 1 offset: 0;
+ 			bottomFraction: 1 offset: 0);
+ 		yourself.	
+ 	windowSpec children add: textSpec.
+ 	
+ 	^ aBuilder build: windowSpec!
Item was added:
+ ----- Method: MailComposition>>buttonBarHeight (in category 'ui constants') -----
+ buttonBarHeight
+ 
+ 	^ 25 "pixel"!
Item was added:
+ ----- Method: MailComposition>>ccLabel (in category 'ui constants') -----
+ ccLabel
+ 
+ 	^ 'CC' translated!
Item was added:
+ ----- Method: MailComposition>>createDetailsFieldsIn:by: (in category 'toolbuilder') -----
+ createDetailsFieldsIn: detailsPanelSpec by: aBuilder
+ 	
+    #((senderLabel messageSender messageSender:)
+ 	(recipientLabel messageRecipient messageRecipient:)
+ 	(ccLabel messageCC messageCC:)
+ 	(bccLabel messageBCC messageBCC:)
+ 	(subjectLabel messageSubject messageSubject:)) 
+ 		do: [:config | detailsPanelSpec children add: 
+ 				(self createFieldInputNamed: config first 
+ 					getter: config second 
+ 					setter: config third 
+ 					with: aBuilder)]
+ 	!
Item was added:
+ ----- Method: MailComposition>>createFieldInputNamed:getter:setter:with: (in category 'toolbuilder') -----
+ createFieldInputNamed: fieldLabelGetter getter: fieldGetter setter: fieldSetter with: aBuilder
+ 
+ 	^ aBuilder pluggableInputFieldSpec new
+ 		model: self;
+ 		indicateUnacceptedChanges: false;
+ 		getText: fieldGetter;
+ 		setText: fieldSetter;
+ 		frame: (LayoutFrame new
+ 			leftFraction: 0 offset: 0;
+ 			topFraction: 0 offset: 0;
+ 			rightFraction: 1 offset: 0;
+ 			bottomFraction: 0 offset: self lineHeight);
+ 		help: fieldLabelGetter;
+ 		yourself!
Item was added:
+ ----- Method: MailComposition>>dialogTitle (in category 'toolbuilder') -----
+ dialogTitle
+ 
+ 	^ 'mail editor' translated!
Item was added:
+ ----- Method: MailComposition>>doSendMail (in category 'private') -----
+ doSendMail
+ 
+ 	(SMTPClient openOnHostNamed: self smtpServer port: self smtpServerPort)
+ 		user: self smtpUser;
+ 		password: self smtpPassword;
+ 		login;
+ 		mailFrom: mailMessage from to: (mailMessage to findTokens: ',') text: mailMessage asSendableText.!
Item was added:
+ ----- Method: MailComposition>>initialize (in category 'initialize-release') -----
+ initialize
+ 
+ 	mailMessage := MailMessage empty!
Item was added:
+ ----- Method: MailComposition>>lineHeight (in category 'ui constants') -----
+ lineHeight
+ 
+ 	^ 25 "pixel"!
Item was added:
+ ----- Method: MailComposition>>messageBCC (in category 'access to mail object') -----
+ messageBCC
+ 
+ 	^ mailMessage bcc!
Item was added:
+ ----- Method: MailComposition>>messageBCC: (in category 'access to mail object') -----
+ messageBCC: emailAddresses
+ 
+ 	self flag: #TODO. "add validation"
+ 	mailMessage bcc: emailAddresses asString.
+ 	^ true!
Item was added:
+ ----- Method: MailComposition>>messageCC (in category 'access to mail object') -----
+ messageCC
+ 
+ 	^ mailMessage cc!
Item was added:
+ ----- Method: MailComposition>>messageCC: (in category 'access to mail object') -----
+ messageCC: emailAddresses
+ 
+ 	self flag: #TODO. "add validation"
+ 	mailMessage cc: emailAddresses asString.
+ 	^ true!
Item was added:
+ ----- Method: MailComposition>>messageRecipient (in category 'access to mail object') -----
+ messageRecipient
+ 
+ 	^ mailMessage to!
Item was added:
+ ----- Method: MailComposition>>messageRecipient: (in category 'access to mail object') -----
+ messageRecipient: emailAddresses
+ 
+ 	self flag: #TODO. "add validation"
+ 	mailMessage to: emailAddresses asString.
+ 	^ true!
Item was added:
+ ----- Method: MailComposition>>messageSender (in category 'access to mail object') -----
+ messageSender
+ 
+ 	^ mailMessage from!
Item was added:
+ ----- Method: MailComposition>>messageSender: (in category 'access to mail object') -----
+ messageSender: emailAddress
+ 
+ 	self flag: #TODO. "add validation"
+ 	mailMessage from: emailAddress asString.
+ 	^ true!
Item was added:
+ ----- Method: MailComposition>>messageSubject (in category 'access to mail object') -----
+ messageSubject
+ 
+ 	^ mailMessage subject!
Item was added:
+ ----- Method: MailComposition>>messageSubject: (in category 'access to mail object') -----
+ messageSubject: aSubject
+ 
+ 	self flag: #TODO. "add validation"
+ 	mailMessage subject: aSubject asString.
+ 	^ true!
Item was changed:
+ ----- Method: MailComposition>>messageText (in category 'access to mail object') -----
- ----- Method: MailComposition>>messageText (in category 'access') -----
  messageText
+ 
+ 	^ mailMessage bodyTextFormatted!
- 	"return the current text"
- 	^messageText.
- !
Item was changed:
+ ----- Method: MailComposition>>messageText: (in category 'access to mail object') -----
- ----- Method: MailComposition>>messageText: (in category 'access') -----
  messageText: aText
+ 
+ 	mailMessage body: ((MIMEDocument 
+ 		contentType: MIMEDocument contentTypePlainText
+ 		content: aText asString)
+ 			charset: 'UTF-8';
+ 			yourself).
+ 	^ true!
- 	"change the current text"
- 	messageText := aText.
- 	self changed: #messageText.
- 	^true!
Item was added:
+ ----- Method: MailComposition>>on: (in category 'initialize-release') -----
+ on: aMessage
+ 
+ 	mailMessage := aMessage!
Item was added:
+ ----- Method: MailComposition>>recipientLabel (in category 'ui constants') -----
+ recipientLabel
+ 
+ 	^ 'Recipients' translated!
Item was added:
+ ----- Method: MailComposition>>removeAttachment (in category 'actions') -----
+ removeAttachment
+ 	
+ 	| attachmentToBeRemoved |
+ 	
+ 	self saveFields.
+ 	attachmentToBeRemoved := UIManager default 
+ 		chooseFrom: (mailMessage attachments collect: [:m | m attachmentFileName ])
+ 		values: mailMessage attachments 
+ 		title: 'Choose attachment to be removed' translated.
+ 	mailMessage removeAttachment: attachmentToBeRemoved.
+ 	self changed: #messageText.!
Item was added:
+ ----- Method: MailComposition>>removeAttachmentButtonLabel (in category 'ui constants') -----
+ removeAttachmentButtonLabel
+ 
+ 	^ 'remove attachment' translated!
Item was added:
+ ----- Method: MailComposition>>saveFields (in category 'private') -----
+ saveFields
+ 	
+ 	(self dependents select: [:d | d hasUnacceptedEdits]) do: [:d | d accept].!
Item was added:
+ ----- Method: MailComposition>>sendMail (in category 'actions') -----
+ sendMail
+ 
+ 	self saveFields.
+ 	
+ 	[self doSendMail.
+ 	Project current addDeferredUIMessage: [self changed: #close]] 
+ 		forkAt: 30!
Item was added:
+ ----- Method: MailComposition>>sendMailButtonLabel (in category 'ui constants') -----
+ sendMailButtonLabel
+ 
+ 	^ 'send mail' translated!
Item was added:
+ ----- Method: MailComposition>>senderLabel (in category 'ui constants') -----
+ senderLabel
+ 
+ 	^ 'Sender' translated!
Item was added:
+ ----- Method: MailComposition>>smtpPassword (in category 'MailSender interface') -----
+ smtpPassword
+ 
+ 	^ MailSender userPassword!
Item was changed:
+ ----- Method: MailComposition>>smtpServer (in category 'MailSender interface') -----
- ----- Method: MailComposition>>smtpServer (in category 'access') -----
  smtpServer
+ 
+ 	^ MailSender smtpServer!
- 	^MailSender smtpServer!
Item was added:
+ ----- Method: MailComposition>>smtpServerPort (in category 'MailSender interface') -----
+ smtpServerPort
+ 
+ 	^ MailSender smtpServerPort!
Item was added:
+ ----- Method: MailComposition>>smtpUser (in category 'MailSender interface') -----
+ smtpUser
+ 
+ 	^ MailSender userName!
Item was added:
+ ----- Method: MailComposition>>subjectLabel (in category 'ui constants') -----
+ subjectLabel
+ 
+ 	^ 'Subject' translated!