The Trunk: MorphicExtras-nice.218.mcz

Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-nice.218.mcz

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

Name: MorphicExtras-nice.218
Author: nice
Time: 26 November 2017, 11:17:28.596315 pm
UUID: c781b24f-85b2-4fca-941a-dd8c2852a640
Ancestors: MorphicExtras-dtl.217

Change fancy categorization of FancyMailComposition methods.

My arbitrary categorization might be less than perfect, but at least this makes testNoSpecialCategories pass.

=============== Diff against MorphicExtras-dtl.217 ===============

Item was changed:
+ ----- Method: FancyMailComposition>>addAttachment (in category 'actions') -----
- ----- 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 changed:
+ ----- Method: FancyMailComposition>>breakLines:atWidth: (in category 'private') -----
- ----- 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 changed:
+ ----- Method: FancyMailComposition>>breakLinesInMessage: (in category 'private') -----
- ----- 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 changed:
+ ----- Method: FancyMailComposition>>menuGet:shifted: (in category 'interface') -----
- ----- 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 changed:
+ ----- Method: FancyMailComposition>>messageText (in category 'accessing') -----
- ----- Method: FancyMailComposition>>messageText (in category '-- all --') -----
  messageText
        "return the current text"
        ^messageText.
  !

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

Item was changed:
+ ----- Method: FancyMailComposition>>morphicOpen (in category 'user interface') -----
- ----- 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 changed:
+ ----- Method: FancyMailComposition>>mvcOpen (in category 'user interface') -----
- ----- 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 changed:
+ ----- Method: FancyMailComposition>>open (in category 'user interface') -----
- ----- Method: FancyMailComposition>>open (in category '-- all --') -----
  open
        "open an interface"

        ^ Project current
                dispatchTo: self
                addPrefixAndSend: #Open
                withArguments: {}
  !

Item was changed:
+ ----- Method: FancyMailComposition>>perform:orSendTo: (in category 'private') -----
- ----- Method: FancyMailComposition>>perform:orSendTo: (in category '-- all --') -----
  perform: selector orSendTo: otherTarget

        (self respondsTo: selector)
                ifTrue: [^self perform: selector]
                ifFalse: [^otherTarget perform: selector]

        !

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

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

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

        ^ subject

        !

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

        subject := x.
        self changed: #subject.
        ^true!

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

        ^to!

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

        to := x.
        self changed: #to.
        ^true
        !