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
!