The Trunk: Network-pre.207.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Network-pre.207.mcz

commits-2
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!