[Pkg] The Trunk: MorphicExtras-nice.218.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Dec 1 00:30:58 UTC 2017


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 at 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 at 1 extent: 398 at 38).
  	mvcWindow addSubView: sendButton.
  
  	textView window: (0 at 40 corner: 400 at 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
  	!



More information about the Packages mailing list