The Trunk: MorphicExtras-pre.213.mcz

Patrick Rein uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-pre.213.mcz

==================== Summary ====================

Name: MorphicExtras-pre.213
Author: pre
Time: 10 November 2017, 4:38:54.614812 pm
UUID: 981d5423-d82a-334d-ab1b-fee6122876ee
Ancestors: MorphicExtras-dtl.212

Reworks the FancyMailComposition to make it independent of the base MailComposition in order to make it possible to refactor the MailComposition class.

=============== Diff against MorphicExtras-dtl.212 ===============

Item was changed:
+ Model subclass: #FancyMailComposition
+ instanceVariableNames: 'messageText textEditor morphicWindow mvcWindow theLinkToInclude to subject textFields'
- MailComposition subclass: #FancyMailComposition
- instanceVariableNames: 'theLinkToInclude to subject textFields'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'MorphicExtras-EToy-Download'!

Item was added:
+ ----- Method: FancyMailComposition>>addAttachment (in category '-- all --') -----
+ addAttachment
+ | file fileResult fileName |
+ textEditor
+ ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]].
+
+ (fileResult := StandardFileMenu oldFile)
+ ifNotNil:
+ [fileName := fileResult directory fullNameFor: fileResult name.
+ file := FileStream readOnlyFileNamed: fileName.
+ file ifNotNil:
+ [file binary.
+ self messageText:
+ ((MailMessage from: self messageText asString)
+ addAttachmentFrom: file withName: fileResult name; text).
+ file close]] !

Item was added:
+ ----- Method: FancyMailComposition>>breakLines:atWidth: (in category '-- all --') -----
+ breakLines: aString  atWidth: width
+ "break lines in the given string into shorter lines"
+ | result atAttachment |
+
+ result := WriteStream on: (String new: (aString size * 50 // 49)).
+
+ atAttachment := false.
+ aString asString linesDo: [ :line | | start end |
+ (line beginsWith: '====') ifTrue: [ atAttachment := true ].
+ atAttachment ifTrue: [
+ "at or after an attachment line; no more wrapping for the rest of the message"
+ result nextPutAll: line.  result cr ]
+ ifFalse: [
+ (line beginsWith: '>') ifTrue: [
+ "it's quoted text; don't wrap it"
+ result nextPutAll: line. result cr. ]
+ ifFalse: [
+ "regular old line.  Wrap it to multiple lines"
+ start := 1.
+ "output one shorter line each time through this loop"
+ [ start + width <= line size ] whileTrue: [
+
+ "find the end of the line"
+ end := start + width - 1.
+ [end >= start and: [ (line at: (end+1)) isSeparator not ]] whileTrue: [
+ end := end - 1 ].
+ end < start ifTrue: [
+ "a word spans the entire width!!"
+ end := start + width - 1 ].
+
+ "copy the line to the output"
+ result nextPutAll: (line copyFrom: start to: end).
+ result cr.
+
+ "get ready for next iteration"
+ start := end+1.
+ (line at: start) isSeparator ifTrue: [ start := start + 1 ].
+ ].
+
+ "write out the final part of the line"
+ result nextPutAll: (line copyFrom: start to: line size).
+ result cr.
+ ].
+ ].
+ ].
+
+ ^result contents!

Item was added:
+ ----- Method: FancyMailComposition>>breakLinesInMessage: (in category '-- all --') -----
+ breakLinesInMessage: message
+ "reformat long lines in the specified message into shorter ones"
+ self flag: #TODO. "Maybe deprecated"
+ message body  mainType = 'text' ifTrue: [
+ "it's a single-part text message.  reformat the text"
+ | newBodyText |
+ newBodyText := self breakLines: message bodyText  atWidth: 72.
+ message body: (MIMEDocument contentType: message body contentType content: newBodyText).
+
+ ^self ].
+
+ message body isMultipart ifTrue: [
+ "multipart message; process the top-level parts.  HACK: the parts are modified in place"
+ message parts do: [ :part |
+ part body mainType = 'text' ifTrue: [
+ | newBodyText |
+ newBodyText := self breakLines: part bodyText atWidth: 72.
+ part body: (MIMEDocument contentType: part body contentType content: newBodyText) ] ].
+ message regenerateBodyFromParts. ].!

Item was added:
+ ----- Method: FancyMailComposition>>menuGet:shifted: (in category '-- all --') -----
+ menuGet: aMenu shifted: shifted
+
+ aMenu addList: {
+ {'find...(f)' translated. #find}.
+ {'find selection again (g)' translated. #findAgain}.
+ #-.
+ {'accept (s)' translated. #accept}.
+ {'send message' translated.  #submit}}.
+
+ ^aMenu.!

Item was added:
+ ----- Method: FancyMailComposition>>messageText (in category '-- all --') -----
+ messageText
+ "return the current text"
+ ^messageText.
+ !

Item was added:
+ ----- Method: FancyMailComposition>>messageText: (in category '-- all --') -----
+ messageText: aText
+ "change the current text"
+ messageText := aText.
+ self changed: #messageText.
+ ^true!

Item was added:
+ ----- Method: FancyMailComposition>>morphicOpen (in category '-- all --') -----
+ morphicOpen
+ "open an interface for sending a mail message with the given initial
+ text "
+ | textMorph buttonsList sendButton attachmentButton |
+ morphicWindow := SystemWindow labelled: 'Mister Postman'.
+ morphicWindow model: self.
+ textEditor := textMorph := PluggableTextMorph
+ on: self
+ text: #messageText
+ accept: #messageText:
+ readSelection: nil
+ menu: #menuGet:shifted:.
+ morphicWindow addMorph: textMorph frame: (0 @ 0.1 corner: 1 @ 1).
+ buttonsList := AlignmentMorph newRow.
+ sendButton := PluggableButtonMorph
+ on: self
+ getState: nil
+ action: #submit.
+ sendButton
+ hResizing: #spaceFill;
+ vResizing: #spaceFill;
+ label: 'send message';
+ setBalloonText: 'Accept any unaccepted edits and add this to the queue of messages to be sent';
+ onColor: Color white offColor: Color white.
+ buttonsList addMorphBack: sendButton.
+
+ attachmentButton := PluggableButtonMorph
+ on: self
+ getState: nil
+ action: #addAttachment.
+ attachmentButton
+ hResizing: #spaceFill;
+ vResizing: #spaceFill;
+ label: 'add attachment';
+ setBalloonText: 'Send a file with the message';
+ onColor: Color white offColor: Color white.
+ buttonsList addMorphBack: attachmentButton.
+
+ morphicWindow addMorph: buttonsList frame: (0 @ 0 extent: 1 @ 0.1).
+ morphicWindow openInWorld!

Item was added:
+ ----- Method: FancyMailComposition>>mvcOpen (in category '-- all --') -----
+ mvcOpen
+ | textView sendButton  |
+
+ mvcWindow := StandardSystemView new
+ label: 'Mister Postman';
+ minimumSize: 400@250;
+ model: self.
+
+ textView := PluggableTextView
+ on: self
+ text: #messageText
+ accept: #messageText:.
+ textEditor := textView controller.
+
+ sendButton := PluggableButtonView
+ on: self
+ getState: nil
+ action: #submit.
+ sendButton label: 'Send'.
+ sendButton borderWidth: 1.
+
+ sendButton window: (1@1 extent: 398@38).
+ mvcWindow addSubView: sendButton.
+
+ textView window: (0@40 corner: 400@250).
+ mvcWindow addSubView: textView below: sendButton.
+
+ mvcWindow controller open.
+
+
+ !

Item was added:
+ ----- Method: FancyMailComposition>>open (in category '-- all --') -----
+ open
+ "open an interface"
+
+ ^ Project current
+ dispatchTo: self
+ addPrefixAndSend: #Open
+ withArguments: {}
+ !

Item was added:
+ ----- Method: FancyMailComposition>>perform:orSendTo: (in category '-- all --') -----
+ perform: selector orSendTo: otherTarget
+
+ (self respondsTo: selector)
+ ifTrue: [^self perform: selector]
+ ifFalse: [^otherTarget perform: selector]
+
+ !

Item was added:
+ ----- Method: FancyMailComposition>>sendMailMessage: (in category '-- all --') -----
+ sendMailMessage: aMailMessage
+ self messageText: aMailMessage text!

Item was added:
+ ----- Method: FancyMailComposition>>smtpServer (in category '-- all --') -----
+ smtpServer
+ ^MailSender smtpServer!

Item was changed:
+ ----- Method: FancyMailComposition>>subject (in category 'access') -----
- ----- Method: FancyMailComposition>>subject (in category 'accessing') -----
  subject
 
+ ^ subject
- ^subject
 
  !

Item was changed:
+ ----- Method: FancyMailComposition>>subject: (in category 'access') -----
- ----- Method: FancyMailComposition>>subject: (in category 'accessing') -----
  subject: x
 
  subject := x.
  self changed: #subject.
  ^true!

Item was changed:
+ ----- Method: FancyMailComposition>>to (in category 'access') -----
- ----- Method: FancyMailComposition>>to (in category 'accessing') -----
  to
 
  ^to!

Item was changed:
+ ----- Method: FancyMailComposition>>to: (in category 'access') -----
- ----- Method: FancyMailComposition>>to: (in category 'accessing') -----
  to: x
 
  to := x.
  self changed: #to.
  ^true
  !