David T. Lewis uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-dtl.776.mcz
==================== Summary ====================
Name: Tools-dtl.776
Author: dtl
Time: 24 November 2017, 6:08:14.219652 pm
UUID: c9c948eb-74b4-426b-8378-50d3ed174f81
Ancestors: Tools-tpr.775
Remove unnecessary references to global World.
=============== Diff against Tools-tpr.775 ===============
Item was changed:
----- Method: Debugger>>contents:notifying: (in category 'accessing') -----
contents: aText notifying: aController
"The retrieved information has changed and its source must now be updated.
In this case, the retrieved information is the method of the selected context."
| result selector classOfMethod category h ctxt newMethod |
contextStackIndex = 0 ifTrue:
[^false].
self selectedContext isExecutingBlock ifTrue:
[h := self selectedContext activeHome.
h ifNil:
[self inform: 'Method for block not found on stack, can''t edit and continue'.
^false].
(self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' withCRs) ifFalse:
[^false].
self resetContext: h changeContents: false.
"N.B. Only reset the contents if the compilation succeeds. If contents are reset
when compilation fails both compiler error message and modifications are lost."
(result := self contents: aText notifying: aController) ifTrue:
[self contentsChanged].
^result].
classOfMethod := self selectedClass.
category := self selectedMessageCategoryName.
selector := self selectedClass newParser parseSelector: aText.
(selector == self selectedMessageName
or: [(self selectedMessageName beginsWith: 'DoIt')
and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse:
[self inform: 'can''t change selector'.
^false].
selector := classOfMethod
compile: aText
classified: category
notifying: aController.
selector ifNil: [^false]. "compile cancelled"
contents := aText.
newMethod := classOfMethod compiledMethodAt: selector.
newMethod isQuick ifTrue:
[self cutBackExecutionToSenderContext].
ctxt := interruptedProcess popTo: self selectedContext.
ctxt == self selectedContext
ifFalse:
[self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs]
ifTrue:
[newMethod isQuick ifFalse:
[interruptedProcess
restartTopWith: newMethod;
stepToSendOrReturn].
contextVariablesInspector object: nil].
self resetContext: ctxt.
Smalltalk isMorphic ifTrue:
+ [Project current world
- [World
addAlarm: #changed:
withArguments: #(contentsSelection)
for: self
at: (Time millisecondClockValue + 200)].
^true!
Item was changed:
----- Method: Debugger>>runUntil (in category 'code pane menu') -----
runUntil
"Step until an expression evaluates to other than false, reporting an error if it doesn't evaluate to true.
Remember the expression in an inst var. If shift is pressed when the expression is supplied, don't update the UI.
If shift is pressed while stepping, stop stepping. Using a user interrupt to break out would be more natural
but Squeak currently doesn't provide a UserInterrupt expection. It should do."
| expression receiver context method value lastUpdate updateUI breakOnShift |
expression := UIManager default
request: 'run until expression is true (shift to disable ui update; shift to break).'
initialAnswer: (untilExpression ifNil: 'boolean expression').
(expression isNil or: [expression isEmpty]) ifTrue:
[^self].
updateUI := breakOnShift := Sensor shiftPressed not.
untilExpression := expression.
context := self selectedContext.
receiver := context receiver.
method := receiver class evaluatorClass new
compiledMethodFor: untilExpression
in: context
to: receiver
notifying: nil
ifFail: [^ #failedDoit].
lastUpdate := Time millisecondClockValue.
Cursor execute showWhile:
[[self selectedContext == context
and: [context willReturn not
and: [(value := receiver with: context executeMethod: method) == false]]] whileTrue:
[interruptedProcess completeStep: self selectedContext.
self selectedContext == context ifTrue:
[self resetContext: interruptedProcess stepToSendOrReturn changeContents: false].
Time millisecondClockValue - lastUpdate > 50 ifTrue:
[updateUI ifTrue:
[self changed: #contentsSelection.
+ Project current world displayWorldSafely].
- World displayWorldSafely].
breakOnShift
ifTrue: [Sensor shiftPressed ifTrue:
[self changed: #contentsSelection.
self updateInspectors.
^self]]
ifFalse: [Sensor shiftPressed ifFalse: [breakOnShift := true]].
lastUpdate := Time millisecondClockValue]]].
self changed: #contentsSelection.
self updateInspectors.
(value ~~ false and: [value ~~ true]) ifTrue:
[UIManager default inform: 'expression ', (untilExpression contractTo: 40), ' answered ', (value printString contractTo: 20), '!!!!']!
David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.1374.mcz
==================== Summary ====================
Name: Morphic-dtl.1374
Author: dtl
Time: 24 November 2017, 6:04:14.470996 pm
UUID: 239c9e21-1d05-413f-9f42-9c5267e15696
Ancestors: Morphic-dtl.1373, Morphic-tpr.1373
Merge Morphic-tpr.1373 and Morphic-dtl.1373, and update Debugger>>morphicResumeProcess: to remove global World reference
=============== Diff against Morphic-dtl.1373 ===============
Item was changed:
----- Method: Debugger>>morphicResumeProcess: (in category '*Morphic-opening') -----
morphicResumeProcess: aTopView
| processToResume |
processToResume := interruptedProcess.
interruptedProcess := nil. "Before delete, so release doesn't terminate it"
aTopView delete.
+ Project current world displayWorld. "We have to redraw *before* resuming the old process."
- World displayWorld. "We have to redraw *before* resuming the old process."
Smalltalk installLowSpaceWatcher. "restart low space handler"
savedCursor
ifNotNil: [Cursor currentCursor: savedCursor].
processToResume isTerminated ifFalse: [
errorWasInUIProcess
ifTrue: [Project resumeProcess: processToResume]
ifFalse: [processToResume resume]].
"if old process was terminated, just terminate current one"
errorWasInUIProcess == false
ifFalse: [Processor terminateActive]!
Item was changed:
----- Method: DialogWindow>>update: (in category 'updating') -----
update: aspect
aspect == #buttons
ifTrue: [self updateButtonExtent].
+ aspect == #flash
+ ifTrue: [self flash].
+
^ super update: aspect!
David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.1373.mcz
==================== Summary ====================
Name: Morphic-dtl.1373
Author: dtl
Time: 22 November 2017, 10:25:57.941315 am
UUID: 2e41d807-bf5a-4f90-84aa-d0ac472bb023
Ancestors: Morphic-dtl.1372
Reorganize Morph>>delete for clarity, and remove reference to global World.
MorphicProject>>finalExitActions and finalEnterActions remove explicit references to global World and allow World be be removed for testing purposes.
=============== Diff against Morphic-dtl.1372 ===============
Item was changed:
----- Method: Morph>>delete (in category 'submorphs-add/remove') -----
delete
"Remove the receiver as a submorph of its owner and make its
new owner be nil."
+ | oldWorld |
-
- | aWorld |
self removeHalo.
+ (oldWorld := self world) ifNotNil: [
-
- self isInWorld ifTrue: [
self disableSubmorphFocusForHand: self activeHand.
self activeHand
releaseKeyboardFocus: self;
releaseMouseFocus: self].
+ owner ifNotNil: [
+ self privateDelete. "remove from world"
-
- "Preserve world reference for player notificaiton. See below."
- aWorld := self world ifNil: [World].
-
- owner ifNotNil:[
- self privateDelete.
self player ifNotNil: [:player |
+ oldWorld ifNotNil: [
+ player noteDeletionOf: self fromWorld: oldWorld]]].!
- player noteDeletionOf: self fromWorld: aWorld]].!
Item was added:
+ ----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
+ clearGlobalState
+ "Clean up global state. The global variables World, ActiveWorld, ActiveHand
+ and ActiveEvent provide convenient access to the state of the active project
+ in Morphic. Clear their prior values when leaving an active project. This
+ method may be removed if the use of global state variables is eliminated."
+
+ "If global World is defined, clear it now. The value is expected to be set
+ again as a new project is entered."
+ Smalltalk globals at: #World
+ ifPresent: [ :w | Smalltalk globals at: #World put: nil ].
+ ActiveWorld := ActiveHand := ActiveEvent := nil.
+ !
Item was changed:
----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
finalEnterActions: leavingProject
"Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate |
+ "If this image has a global World variable, update it now"
+ Smalltalk globals at: #World
+ ifPresent: [ :w | Smalltalk globals at: #World put: world ].
- World := world. "Signifies Morphic"
world install.
world transferRemoteServerFrom: leavingProject world.
"(revertFlag | saveForRevert | forceRevert) ifFalse: [
(Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
self storeSomeSegment]]."
"Transfer event recorder to me."
leavingProject isMorphic ifTrue: [
leavingProject world pauseEventRecorder ifNotNil: [:rec |
rec resumeIn: world]].
world triggerOpeningScripts.
self initializeMenus.
self projectParameters
at: #projectsToBeDeleted
ifPresent: [ :projectsToBeDeleted |
self removeParameter: #projectsToBeDeleted.
projectsToBeDeleted do: [:each | each delete]].
Locale switchAndInstallFontToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
thingsToUnhibernate do: [:each | each unhibernate].
world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator.
armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
navigator := world findA: navType.
(Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
[(navigator := navType new)
bottomLeft: world bottomLeft;
openInWorld: world].
navigator notNil & armsLengthCmd notNil ifTrue:
[navigator color: Color lightBlue].
armsLengthCmd notNil ifTrue:
[Preferences showFlapsWhenPublishing
ifFalse:
[self flapsSuppressed: true.
navigator ifNotNil: [navigator visible: false]].
armsLengthCmd openInWorld: world].
world reformulateUpdatingMenus.
world presenter positionStandardPlayer.
self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.!
Item was changed:
----- Method: MorphicProject>>finalExitActions: (in category 'enter') -----
finalExitActions: enteringProject
world triggerClosingScripts.
"Pause sound players, subject to preference settings"
(world hasProperty: #letTheMusicPlay)
ifTrue: [world removeProperty: #letTheMusicPlay]
ifFalse: [SoundService stop].
world sleep.
-
(world findA: ProjectNavigationMorph)
ifNotNil: [:navigator | navigator retractIfAppropriate].
+ self clearGlobalState.
-
- "Clean-up global state."
- World := nil.
- ActiveWorld := ActiveHand := ActiveEvent := nil.
Sensor flushAllButDandDEvents. !
Patrick Rein uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-pre.211.mcz
==================== Summary ====================
Name: Network-pre.211
Author: pre
Time: 22 November 2017, 2:44:47.445047 pm
UUID: 5a814be6-cf92-3443-9e5f-eaff4fbd54d1
Ancestors: Network-dtl.210
Adds a method to the SMTPClient for handling the cc and bcc to receiver conversion necessary to actually send mails through cc and bcc.
=============== Diff against Network-dtl.210 ===============
Item was changed:
----- Method: MailComposition>>doSendMail (in category 'private') -----
doSendMail
(SMTPClient openOnHostNamed: self smtpServer port: self smtpServerPort)
user: self smtpUser;
password: self smtpPassword;
login;
+ sendMailMessage: mailMessage!
- mailFrom: mailMessage from to: (mailMessage to findTokens: ',') text: mailMessage asSendableText.!
Item was added:
+ ----- Method: SMTPClient>>sendMailMessage:fromAddress: (in category '*Network-MailSending') -----
+ sendMailMessage: mailMessage fromAddress: sender
+ "Convenience mechanism to handle handling of receivers
+ between MailMessage objects and SMTP."
+
+ | mailMessageToSend recipients |
+ mailMessageToSend := mailMessage deepCopy.
+ recipients := (mailMessage to findTokens: ',') ,
+ (mailMessage cc findTokens: ',') ,
+ (mailMessage bcc findTokens: ',').
+ recipients := recipients asSet collect: [:r | r withBlanksTrimmed].
+ mailMessageToSend bcc: ''.
+
+ self
+ mailFrom: mailMessageToSend from
+ to: recipients
+ text: mailMessageToSend asSendableText!
tim Rowledge uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-tpr.1373.mcz
==================== Summary ====================
Name: Morphic-tpr.1373
Author: tpr
Time: 21 November 2017, 6:27:37.789438 pm
UUID: a1b0f707-a946-454c-83aa-48a269e5afaf
Ancestors: Morphic-dtl.1372
Add a tweak so that 'changed: #flash' can be used to make a dialog window wiggle when some input is not acceptable.
=============== Diff against Morphic-dtl.1372 ===============
Item was changed:
----- Method: DialogWindow>>update: (in category 'updating') -----
update: aspect
aspect == #buttons
ifTrue: [self updateButtonExtent].
+ aspect == #flash
+ ifTrue: [self flash].
+
^ super update: aspect!
tim Rowledge uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-tpr.775.mcz
==================== Summary ====================
Name: Tools-tpr.775
Author: tpr
Time: 21 November 2017, 6:24:43.547157 pm
UUID: 7acfda2c-b48e-4d7e-8504-abba58b1a5e8
Ancestors: Tools-dtl.774
Change FileSaverDialog etc to prefer to use filename suffices instead of general patterns - though the patterns still work - and rework the way they are built to allow a bit more flexibility.
Remove the text entry view from the FileChooserDialog since it served no very helpful purpose.
=============== Diff against Tools-dtl.774 ===============
Item was changed:
Model subclass: #FileAbstractSelectionDialog
+ instanceVariableNames: 'patternList directory directoryCache message listIndex fileName finalChoice nameList sizeList dateList'
- instanceVariableNames: 'pattern directory directoryCache message listIndex fileName finalChoice nameList sizeList dateList'
classVariableNames: ''
poolDictionaries: ''
category: 'Tools-FileDialogs'!
+ !FileAbstractSelectionDialog commentStamp: 'tpr 11/21/2017 18:18' prior: 0!
- !FileAbstractSelectionDialog commentStamp: 'tpr 11/13/2017 11:08' prior: 0!
FileAbstractSelectionDialog is the abstract superclass for the file chooser & saver modal dialogs.
The UI provides a message to the user, a text input field, a directory tree widget and a list of files within any chosen directory, and buttons to accept the selected file name/path or cancel the operation. See subclass comments and class side methods for specific usage examples.
Instance Variables
directory: <FileDirectory> used for the currently selected directory
directoryCache: <WeakIdentityKeyDictionary> used to cache a boolean to help us more quickly populate the directory tree widget when revisiting a directory
fileName: <String|nil> the name of the currently selected file, if any
finalChoice: <String|nil> pathname of the finally chosen file, returned as the result of accepting; nil is returned otherwise
list: <Array> the list of String of filenames (and date/size) that match the current pattern
listIndex: <Integer> list index of the currently selected file
+ patternList: <OrderedCollection of String> the patterns are held as a collection of string that may include * or # wildcards. See FileAbstractSelectionDialog>>#parsePatternString for details
- pattern: <String> the pattern is held as a string that may include * or # wildcasrds. See FileAbstractSelectionDialog>>#parsePatternString for details
message: <String> a message to the user to explain what is expected
nameList,DateList, sizeList: <Array> the list of file names matching the pattern and the appropriate date and size values, formatted for a PluggableMultiColumnListMorph!
Item was removed:
- ----- Method: FileAbstractSelectionDialog class>>open (in category 'instance creation') -----
- open
- "open a modal dialog to choose or save a file. Start the dialog with the default directory selected"
-
- ^self openOn: FileDirectory default
-
- !
Item was changed:
----- Method: FileAbstractSelectionDialog>>buildWith: (in category 'toolbuilder') -----
buildWith: builder
"assemble the spec for the common chooser/saver dialog UI"
+ ^self subclassResponsibility!
- | windowSpec window |
- windowSpec := self buildWindowWith: builder specs: {
- (self topConstantHeightFrame: self textViewHeight
- fromLeft: 0
- width: 1) -> [self buildTextInputWith: builder].
- (self frameOffsetFromTop: self textViewHeight
- fromLeft: 0.25
- width: 0.75
- offsetFromBottom: self buttonHeight) -> [self buildFileListWith: builder].
- (self frameOffsetFromTop: self textViewHeight
- fromLeft: 0
- width: 0.25
- offsetFromBottom: self buttonHeight) -> [self buildDirectoryTreeWith: builder].
- }.
- windowSpec buttons add:( builder pluggableButtonSpec new
- model: self;
- label: 'Accept';
- action: #acceptFileName).
- windowSpec buttons add:( builder pluggableButtonSpec new
- model: self;
- label: 'Cancel';
- action: #cancelFileChooser).
- window := builder build: windowSpec.
- self changed: #selectedPath.
- ^window
- !
Item was removed:
- ----- Method: FileAbstractSelectionDialog>>defaultPattern (in category 'path and pattern') -----
- defaultPattern
-
- ^'*'!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>defaultPatternList (in category 'path and pattern') -----
+ defaultPatternList
+
+ ^#('*')!
Item was changed:
----- Method: FileAbstractSelectionDialog>>directory (in category 'directory tree') -----
directory
"If nobody has set a specific directory we need a plausible default"
+ ^ directory ifNil: [ directory := FileDirectory default]!
- ^ directory ifNil: [ FileDirectory default]!
Item was changed:
----- Method: FileAbstractSelectionDialog>>directory: (in category 'directory tree') -----
directory: aFileDirectory
"Set the path of the directory to be displayed in the directory tree pane"
+ directory := aFileDirectory!
- self okToChange ifFalse: [ ^ self ].
- self modelSleep.
- directory := aFileDirectory.
- self modelWakeUp.
- self changed: #directory!
Item was changed:
----- Method: FileAbstractSelectionDialog>>entriesMatching: (in category 'file list') -----
entriesMatching: patternList
"Answer a list of directory entries which match any of the patterns.
See #parsePatternString for the pattern rules"
| entries |
"This odd clause helps supports MVC projects; the file list & directory views are built from a list that includes directories. In Morphic we filter out the directories because they are entirely handled by the direcctory tree morph"
entries := Smalltalk isMorphic
+ ifTrue:[self directory fileEntries ]
+ ifFalse:[self directory entries].
- ifTrue:[directory fileEntries ]
- ifFalse:[directory entries].
(patternList anySatisfy: [:each | each = '*'])
ifTrue: [^ entries].
^ entries select: [:entry | patternList anySatisfy: [:each | each match: entry name]]!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>fileListIndex: (in category 'file list') -----
+ fileListIndex: anInteger
+ "We've selected the file at the given index, so find the file name."
+
+ self okToChange ifFalse: [^ self].
+ listIndex := anInteger.
+ listIndex = 0
+ ifTrue: [fileName := nil]
+ ifFalse: [fileName := nameList at: anInteger]. "open the file selected"
+
+ self
+ changed: #fileListIndex;
+ changed: #inputText!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>getUserResponse (in category 'toolbuilder') -----
+ getUserResponse
+ "open the dialog modally and get a user response"
+
+ ToolBuilder open: self.
+ ^self finalChoice!
Item was changed:
----- Method: FileAbstractSelectionDialog>>initialize (in category 'initialize-release') -----
initialize
super initialize.
directoryCache := WeakIdentityKeyDictionary new.
listIndex := 0.
+ patternList := self defaultPatternList!
- pattern := self defaultPattern!
Item was changed:
----- Method: FileAbstractSelectionDialog>>listForPatterns: (in category 'path and pattern') -----
listForPatterns: arrayOfPatterns
+ "build lists of name, date and size for those file names which match any of the patterns in the array.
+ We use a Set to avoid duplicates and sort them by name"
- "return a list of those file names which match any of the patterns in the array."
| newList |
newList := Set new.
newList addAll: (self entriesMatching: arrayOfPatterns).
newList := newList sorted: [:a :b|
a name <= b name].
nameList := newList collect:[:e| e name].
dateList := newList collect:[:e| ((Date fromSeconds: e modificationTime )
printFormat: #(3 2 1 $. 1 1 2)) , ' ' ,
(String streamContents: [:s |
(Time fromSeconds: e modificationTime \\ 86400)
print24: true on: s])].
sizeList := newList collect:[:e| e fileSize asStringWithCommas]
!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>message: (in category 'ui details') -----
+ message: aStringOrText
+ "set the user message to be dispalyed at the top of the dialog - it should guide the user as to what they must do"
+
+ message := aStringOrText!
Item was removed:
- ----- Method: FileAbstractSelectionDialog>>parsePatternString (in category 'file list') -----
- parsePatternString
- "The pattern is held as a string that may have three simple tokens included along with normal characters;
- a) a ; or LF or CR splits the string into separate patterns and filenames matching any of them will be included in list
- b) a * matches any number of characters
- c) a # matches one character"
-
- | patterns |
- patterns := OrderedCollection new.
- (pattern findTokens: (String with: Character cr with: Character lf with: $;))
- do: [ :each |
- (each includes: $*) | (each includes: $#)
- ifTrue: [ patterns add: each]
- ifFalse: [each isEmpty
- ifTrue: [ patterns add: '*']
- ifFalse: [ patterns add: '*' , each , '*']]].
-
- ^patterns!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>parsePatternString: (in category 'file list') -----
+ parsePatternString: aStringOrNil
+ "The pattern is a string that may have three simple tokens included along with normal characters;
+ a) a ; or LF or CR splits the string into separate patterns and filenames matching any of them will be included in list
+ b) a * matches any number of characters
+ c) a # matches one character"
+
+ | patterns |
+ aStringOrNil ifNil:[^self defaultPatternList].
+ patterns := OrderedCollection new.
+ (aStringOrNil findTokens: (String with: Character cr with: Character lf with: $;))
+ do: [ :each |
+ (each includes: $*) | (each includes: $#)
+ ifTrue: [ patterns add: each]
+ ifFalse: [each isEmptyOrNil
+ ifTrue: [ patterns add: '*']
+ ifFalse: [ patterns add: '*' , each , '*']]].
+
+ ^patterns!
Item was changed:
----- Method: FileAbstractSelectionDialog>>pattern: (in category 'path and pattern') -----
pattern: textOrStringOrNil
+ "Make sure the pattern source string is neither nil nor empty.
+ We can strictly speaking handle arbitrary patterns to match against the filenames but in general we need to use suffices, so see #suffix: and #suffixList: "
- "Make sure the pattern source string is neither nil nor empty"
+ patternList := self parsePatternString: textOrStringOrNil!
- textOrStringOrNil
- ifNil: [pattern := '*']
- ifNotNil: [pattern := textOrStringOrNil asString].
- pattern isEmpty ifTrue: [pattern := '*']!
Item was changed:
----- Method: FileAbstractSelectionDialog>>selectedPath (in category 'path and pattern') -----
selectedPath
"Return an array of directories representing the path from directory up to the root; used to build the directory tree morph"
| top here |
top := FileDirectory root.
+ here := self directory.
- here := directory.
^(Array streamContents:[:s| | next |
s nextPut: here.
[next := here containingDirectory.
top pathName = next pathName] whileFalse:[
s nextPut: next.
here := next.
]]) reversed.!
Item was changed:
----- Method: FileAbstractSelectionDialog>>setDirectoryTo: (in category 'directory tree') -----
setDirectoryTo: dir
"Set the current directory shown in the FileList.
Does not allow setting the directory to nil since this blows up in various places."
dir ifNil:[^self].
+ "okToChange is probably redundant.
+ modelSleep/Wake is related to use of ServerDirectories, which are not yet hooked up"
+ self okToChange ifFalse: [ ^ self ].
+ self modelSleep.
self directory: dir.
+ self modelWakeUp.
+ self changed: #directory.
self updateFileList.
self changed: #inputText!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>suffix: (in category 'path and pattern') -----
+ suffix: textOrStringOrNil
+ "Make a pattern from a single filename suffix string, i.e. 'jpg'"
+
+ self suffixList: (Array with: textOrStringOrNil )!
Item was added:
+ ----- Method: FileAbstractSelectionDialog>>suffixList: (in category 'path and pattern') -----
+ suffixList: listOfStrings
+ "Make a pattern list from a one or more filename suffix strings in a list , i.e. #('jpg' 'mpeg') "
+
+ listOfStrings isEmptyOrNil
+ ifTrue: [patternList := self defaultPatternList]
+ ifFalse: [patternList := OrderedCollection new.
+ listOfStrings do: [:each|
+ each isEmptyOrNil ifFalse:[ patternList add: '*.',each] ] ]!
Item was changed:
----- Method: FileAbstractSelectionDialog>>updateFileList (in category 'file list') -----
updateFileList
+ "Update my files list with file names in the current directory that match the patternList."
- "Update my files list with file names in the current directory that match the pattern.
- The pattern string may have embedded newlines or semicolons; these separate multiple different patterns."
Cursor wait
+ showWhile: [self listForPatterns: patternList.
- showWhile: [self listForPatterns: self parsePatternString.
listIndex := 0.
self changed: #fileList]!
Item was changed:
FileAbstractSelectionDialog subclass: #FileChooserDialog
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Tools-FileDialogs'!
+ !FileChooserDialog commentStamp: 'tpr 11/21/2017 18:02' prior: 0!
- !FileChooserDialog commentStamp: 'tpr 11/13/2017 11:46' prior: 0!
A FileChooserDialog is a modal dialog to allow choosing a file. The full file name is returned, or nil if no selection was made.
- Users can enter a pattern in the text input field that will be read as a directory path and an optional pattern (see comments about pattern in my superclass) to define the files in the file list.
Normal usage would be
myFilename := FileChooserDialog openOn: myApplicationDefaultDirectory pattern: '*.myapp' message: 'Choose the file to load'
+ to find a file with a name matching *.myapp and with the directory initial choice set to myApplicationDefaultDirectory. Only filenames matching the pattern will appear in the file list view.
+ !
- to find a file with a name matching *.myapp and with the directory initial choice set to myApplicationDefaultDirectory. It would be quite possible to choose a file from any other directory and with any other pattern match if the user wishes, so the file name must be carefully checked.
-
- Simpler usage might be
- myFilename := FileChooserDialog open
- or
- myFilename := FileChoosverDialog openOn: FileDirectory default
- - see the class side methods for details. See my parent class for most implementation details!
Item was changed:
----- Method: FileChooserDialog class>>openOn: (in category 'instance creation') -----
openOn: aDirectory
"open a modal dialog to choose a file. Start the dialog with aDirectory selected and files matching the default 'everything' pattern"
+ ^self new directory: aDirectory;
+ getUserResponse!
- ^self openOn: aDirectory pattern: nil
-
- !
Item was removed:
- ----- Method: FileChooserDialog class>>openOn:pattern: (in category 'instance creation') -----
- openOn: aDirectory pattern: aPatternString
- "open a modal dialog to choose a file. Start the dialog with aDirectory selected and files matching the pattern"
-
- ^self new openOn: aDirectory pattern: aPatternString
-
- !
Item was removed:
- ----- Method: FileChooserDialog class>>openOn:pattern:message: (in category 'instance creation') -----
- openOn: aDirectory pattern: aPatternString message: messageString
- "open a modal dialog to choose a file. Start the dialog with aDirectory selected and files matching the pattern"
-
- ^self new openOn: aDirectory pattern: aPatternString message: messageString
-
- !
Item was added:
+ ----- Method: FileChooserDialog>>buildWith: (in category 'toolbuilder') -----
+ buildWith: builder
+ "assemble the spec for the chooser dialog UI"
+
+ | windowSpec window |
+ windowSpec := self buildWindowWith: builder specs: {
+ (self frameOffsetFromTop: 0
+ fromLeft: 0.25
+ width: 0.75
+ offsetFromBottom: self buttonHeight) -> [self buildFileListWith: builder].
+ (self frameOffsetFromTop: 0
+ fromLeft: 0
+ width: 0.25
+ offsetFromBottom: self buttonHeight) -> [self buildDirectoryTreeWith: builder].
+ }.
+ windowSpec buttons add:( builder pluggableButtonSpec new
+ model: self;
+ label: 'Accept';
+ action: #acceptFileName).
+ windowSpec buttons add:( builder pluggableButtonSpec new
+ model: self;
+ label: 'Cancel';
+ action: #cancelFileChooser).
+ window := builder build: windowSpec.
+ self changed: #selectedPath.
+ ^window
+ !
Item was removed:
- ----- Method: FileChooserDialog>>fileListIndex: (in category 'file list') -----
- fileListIndex: anInteger
- "We've selected the file at the given index, so find the file name."
-
- self okToChange ifFalse: [^ self].
- listIndex := anInteger.
- listIndex = 0
- ifTrue: [fileName := nil]
- ifFalse: [fileName :=nameList at: anInteger]. "open the file selected"
-
- self changed: #fileListIndex!
Item was removed:
- ----- Method: FileChooserDialog>>inputText (in category 'path and pattern') -----
- inputText
- "Answers path and pattern together"
-
- ^directory fullName, directory slash, pattern!
Item was removed:
- ----- Method: FileChooserDialog>>inputText: (in category 'path and pattern') -----
- inputText: stringOrText
- "both path and pattern are in the text, so split them apart and then change both directory and the match for the filenames before updating the file list"
-
- | base pat aString |
- aString := stringOrText asString.
- base := aString copyUpToLast: directory pathNameDelimiter.
- pat := aString copyAfterLast: directory pathNameDelimiter.
- self changed: #inputText. "avoid asking if it's okToChange"
-
- self directory: (FileDirectory on: base).
- self pattern: pat.
- self updateFileList.
- self changed: #inputText.
- self changed: #selectedPath.!
Item was removed:
- ----- Method: FileChooserDialog>>openOn:pattern: (in category 'initialize-release') -----
- openOn: aDirectory pattern: aPatternString
- "open a modal dialog to choose a file from aDirectory as filtered by aPattern"
-
- ^self openOn: aDirectory pattern: aPatternString message: nil
- !
Item was removed:
- ----- Method: FileChooserDialog>>openOn:pattern:message: (in category 'initialize-release') -----
- openOn: aDirectory pattern: aPatternString message: messageString
- "open a modal dialog to choose a file from aDirectory as filtered by aPattern"
-
- directory := aDirectory.
- self pattern: aPatternString.
- message := messageString.
-
- ToolBuilder open: self.
- ^self finalChoice!
Item was changed:
FileAbstractSelectionDialog subclass: #FileSaverDialog
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Tools-FileDialogs'!
+ !FileSaverDialog commentStamp: 'tpr 11/21/2017 17:53' prior: 0!
- !FileSaverDialog commentStamp: 'tpr 11/13/2017 11:49' prior: 0!
A FileSaverDialog is a modal dialog for choosing a file name to use for saving a file.
+
Users can enter a filename in the text input view that will
a) if it exists in the current directry listing, be selected
+ b) over ride any filenames in the current directory, providing a way to specify a completely new file.
- b) over ride any filenames in the current directry, providing a way to specify a completely new file.
This will not affect the selected directory path.
Normal usage would be
+ myFilename := FileSaverDialog openOnInitialFilename: myApp saveFileName
+ which would derive a directory, an initial filename and filename suffix from the given file name. Thus a typical application save might be
+ ... openOnInitialFilename: '/home/pi/myApp/examplePicture.jpg'
+ and would set the initial directory to /home/pi/myapp, the initial filename to examplePicture.jpg and set a suffix pattern of 'jpg'. Only filenames with the specified suffix will appear in the file list view. It is possible to specify several suffices, (see #suffixList:) and use wildcards within the suffix.
+
myFilename := FileSaverDialog openOn: myApplicationDefaultDirectory initialFilename: 'foo.myapp'
+ would set directory initial choice set to myApplicationDefaultDirectory and ignore any directory found in the filename. It would be quite possible to choose a file from any other directory and with any other name that matches the suffix if the user wishes, so the file name must be carefully checked.
- to find a file with a name matching foo.myapp and with the directory initial choice set to myApplicationDefaultDirectory. It would be quite possible to choose a file from any other directory and with any other name if the user wishes, so the file name must be carefully checked. The full set of options would invovle
- myFilename := FileSaverDialog openOn: myApplicationDefaultDirectory initialFilename: 'foo.myapp' pattern: '*.mya' message: 'Save your myApp file to ... '
+ The full set of options would involve
+ myFilename := FileSaverDialog openOn: myApplicationDefaultDirectory initialFilename: 'foo.myapp' suffix: 'mya' message: 'Save your myApp file to ... '
+
+ It is also possible to set a more general pattern to match filenames against but since this seems less useful for normal application usage ther are no convenience messages as yet.
+
+ See the class side methods for details. See my parent class for most implementation details!
- Simpler usage might be
- myFilename := FileSaverDialog open
- or
- myFilename := FileSaverDialog openOn: FileDirectory default
- - see the class side methods for details. See my parent class for most implementation details!
Item was changed:
----- Method: FileSaverDialog class>>openOn: (in category 'instance creation') -----
openOn: aDirectory
"open a modal dialog to save a file. Start the dialog with aDirectory selected and no suggested file name"
+ ^self new directory: aDirectory;
+ getUserResponse
- ^self new openOn: aDirectory initialFilename: nil
!
Item was changed:
----- Method: FileSaverDialog class>>openOn:initialFilename: (in category 'instance creation') -----
openOn: aDirectory initialFilename: aString
+ "open a modal dialog to save a file. Start the dialog with aDirectory selected and the suggested file name. Note that we set the directory after the initialFilename becuase we want a specific directory and not neccesarily the directory of the file"
- "open a modal dialog to save a file. Start the dialog with aDirectory selected and the suggested file name"
+ ^self new
+ initialFilename: aString;
+ directory: aDirectory;
+ getUserResponse
- ^self new openOn: aDirectory initialFilename: aString
!
Item was removed:
- ----- Method: FileSaverDialog class>>openOn:initialFilename:pattern: (in category 'instance creation') -----
- openOn: aDirectory initialFilename: aString pattern: patternString
- "open a modal dialog to save a file. Start the dialog with aDirectory selected and the suggested file name. Visible filenames are limited by the pattern"
-
- ^self new openOn: aDirectory initialFilename: aString pattern: patternString
-
- !
Item was removed:
- ----- Method: FileSaverDialog class>>openOn:initialFilename:pattern:message: (in category 'instance creation') -----
- openOn: aDirectory initialFilename: aString pattern: patternString message: messageString
- "open a modal dialog to save a file. Start the dialog with aDirectory selected and the suggested file name. Visible filenames are limited by the pattern. Use the messageString to explain what ther user needs to know"
-
- ^self new openOn: aDirectory initialFilename: aString pattern: patternString message: messageString
-
- !
Item was changed:
----- Method: FileSaverDialog class>>openOnInitialFilename: (in category 'instance creation') -----
+ openOnInitialFilename: filenameString
- openOnInitialFilename: aString
"open a modal dialog to save a file. Start the dialog with the default directory selected and the suggested file name"
+
+ ^self new initialFilename: filenameString;
+ getUserResponse
- ^self new openOn: FileDirectory default initialFilename: aString
!
Item was changed:
----- Method: FileSaverDialog>>buildWith: (in category 'toolbuilder') -----
buildWith: builder
+ "assemble the spec for the saver dialog UI and build the window"
- "assemble the spec for the common chooser/saver dialog UI"
+ | window windowSpec |
+ windowSpec := self buildWindowWith: builder specs: {
+ (self topConstantHeightFrame: self textViewHeight
+ fromLeft: 0
+ width: 1) -> [self buildTextInputWith: builder].
+ (self frameOffsetFromTop: self textViewHeight
+ fromLeft: 0.25
+ width: 0.75
+ offsetFromBottom: self buttonHeight) -> [self buildFileListWith: builder].
+ (self frameOffsetFromTop: self textViewHeight
+ fromLeft: 0
+ width: 0.25
+ offsetFromBottom: self buttonHeight) -> [self buildDirectoryTreeWith: builder].
+ }.
+ windowSpec buttons add:( builder pluggableButtonSpec new
+ model: self;
+ label: 'Accept';
+ action: #acceptFileName).
+ windowSpec buttons add:( builder pluggableButtonSpec new
+ model: self;
+ label: 'Cancel';
+ action: #cancelFileChooser).
+ window := builder build: windowSpec.
+ self changed: #selectedPath.
- | window |
- window := super buildWith: builder.
self inputText: fileName.
^window
!
Item was removed:
- ----- Method: FileSaverDialog>>fileListIndex: (in category 'file list') -----
- fileListIndex: anInteger
- "We've selected the file at the given index, so find the file name."
-
- self okToChange ifFalse: [^ self].
- listIndex := anInteger.
- listIndex = 0
- ifTrue: [fileName := nil]
- ifFalse: [fileName := nameList at: anInteger]. "open the file selected"
-
- self
- changed: #fileListIndex;
- changed: #inputText!
Item was added:
+ ----- Method: FileSaverDialog>>initialFilename: (in category 'initialize-release') -----
+ initialFilename: aFilename
+ "Set the initial choice of filename to highlight.
+ We split the potential filename to see if it includes a path and if so, use that as the chosen directory - the client can manually change that with a subsequent send of #directory: if wanted.
+ We split the root filename to find an extension and use that as the suffix - again, the client can manually change that later"
+
+ | e f p |
+ p := FileDirectory dirPathFor: aFilename.
+ p isEmpty ifFalse:[self directory: (FileDirectory on: p)].
+ f := FileDirectory localNameFor: aFilename.
+ fileName := f.
+ e := FileDirectory extensionFor: f.
+ e isEmpty ifFalse:[self suffix: e]!
Item was changed:
----- Method: FileSaverDialog>>inputText (in category 'filename') -----
inputText
"return the filename to appear in the text field"
+ ^fileName ifNil:['Enter a filename here or choose from list' translated]!
- ^fileName ifNil:['Enter a filename here']!
Item was changed:
----- Method: FileSaverDialog>>inputText: (in category 'filename') -----
inputText: aText
"user has entered a potential filename in the text field.
Check it against the current pattern; if it is ok we can accept it and then if it is a file in
the current list, highlight it.
If it would not match the pattern, alert the user as best we can"
| candidate |
candidate := aText asString.
+ (patternList anySatisfy: [:p | p match: candidate])
- (self parsePatternString anySatisfy: [:p | p match: candidate])
ifTrue: [fileName := candidate.
listIndex := nameList findFirst: [:nm | nm = fileName].
self changed: #fileListIndex.
^true]
ifFalse: [fileName := nil.
+ self changed: #flash.
^false]!
Item was removed:
- ----- Method: FileSaverDialog>>openOn:initialFilename: (in category 'initialize-release') -----
- openOn: aDirectory initialFilename: aFilename
- "open a modal dialog to choose a file name to save to aDirectory"
-
- ^self openOn: aDirectory initialFilename: aFilename pattern: nil!
Item was removed:
- ----- Method: FileSaverDialog>>openOn:initialFilename:pattern: (in category 'initialize-release') -----
- openOn: aDirectory initialFilename: aFilename pattern: patternString
- "open a modal dialog to choose a file name to save to aDirectory; limit visible files in the file list with the pattern"
-
- ^self openOn: aDirectory initialFilename: aFilename pattern: patternString message: nil
- !
Item was removed:
- ----- Method: FileSaverDialog>>openOn:initialFilename:pattern:message: (in category 'initialize-release') -----
- openOn: aDirectory initialFilename: aFilename pattern: patternString message: messageString
- "open a modal dialog to choose a file name to save to aDirectory; limit visible files in the file list with the pattern. Set the user message"
-
- directory := aDirectory.
- fileName := aFilename.
- message:= messageString.
- self pattern: patternString.
-
- ToolBuilder open: self.
- ^self finalChoice!
David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.1372.mcz
==================== Summary ====================
Name: Morphic-dtl.1372
Author: dtl
Time: 21 November 2017, 3:40:31.873793 pm
UUID: b7c42635-028a-4baa-abca-056362808bc7
Ancestors: Morphic-dtl.1371
Restore original versions of finalEnterActions: and finalExitActions: until they can be properly sorted out.
=============== Diff against Morphic-dtl.1371 ===============
Item was removed:
- ----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
- clearGlobalState
- "Clean up global state. The global variables World, ActiveWorld, ActiveHand and ActiveEvent
- provide convenient access to the state of the active project in Morphic. Clear their prior values
- when leaving an active project. This method may be removed if the use of global state variables
- is eliminated."
-
- (Smalltalk at: #World ifAbsent: [])
- ifNotNil: [ Smalltalk at: #World put: nil ]. "If global World is defined, clear it now"
- ActiveWorld := ActiveHand := ActiveEvent := nil.
- !
Item was changed:
----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
finalEnterActions: leavingProject
"Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate |
+ World := world. "Signifies Morphic"
- "If this image has a global World variable, update it now"
- (Smalltalk at: #World ifAbsent: [])
- ifNotNil: [ Smalltalk at: #World put: world ]. "Signifies Morphic"
world install.
world transferRemoteServerFrom: leavingProject world.
"(revertFlag | saveForRevert | forceRevert) ifFalse: [
(Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
self storeSomeSegment]]."
"Transfer event recorder to me."
leavingProject isMorphic ifTrue: [
leavingProject world pauseEventRecorder ifNotNil: [:rec |
rec resumeIn: world]].
world triggerOpeningScripts.
self initializeMenus.
self projectParameters
at: #projectsToBeDeleted
ifPresent: [ :projectsToBeDeleted |
self removeParameter: #projectsToBeDeleted.
projectsToBeDeleted do: [:each | each delete]].
Locale switchAndInstallFontToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
thingsToUnhibernate do: [:each | each unhibernate].
world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator.
armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
navigator := world findA: navType.
(Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
[(navigator := navType new)
bottomLeft: world bottomLeft;
openInWorld: world].
navigator notNil & armsLengthCmd notNil ifTrue:
[navigator color: Color lightBlue].
armsLengthCmd notNil ifTrue:
[Preferences showFlapsWhenPublishing
ifFalse:
[self flapsSuppressed: true.
navigator ifNotNil: [navigator visible: false]].
armsLengthCmd openInWorld: world].
world reformulateUpdatingMenus.
world presenter positionStandardPlayer.
self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.!
Item was changed:
----- Method: MorphicProject>>finalExitActions: (in category 'enter') -----
finalExitActions: enteringProject
world triggerClosingScripts.
"Pause sound players, subject to preference settings"
(world hasProperty: #letTheMusicPlay)
ifTrue: [world removeProperty: #letTheMusicPlay]
ifFalse: [SoundService stop].
world sleep.
+
(world findA: ProjectNavigationMorph)
ifNotNil: [:navigator | navigator retractIfAppropriate].
+
+ "Clean-up global state."
+ World := nil.
+ ActiveWorld := ActiveHand := ActiveEvent := nil.
- self clearGlobalState.
Sensor flushAllButDandDEvents. !
David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.1371.mcz
==================== Summary ====================
Name: Morphic-dtl.1371
Author: dtl
Time: 21 November 2017, 8:51:51.176344 am
UUID: d55fdc21-3a6f-44bd-a61f-99716b1cb7cf
Ancestors: Morphic-dtl.1370
Revert Morph>>delete change, because after calling #privateDelete, #isInWorld will always be false.
Fix unintended block var assignment in previous updates.
=============== Diff against Morphic-dtl.1370 ===============
Item was changed:
----- Method: Morph>>delete (in category 'submorphs-add/remove') -----
delete
"Remove the receiver as a submorph of its owner and make its
new owner be nil."
+ | aWorld |
self removeHalo.
self isInWorld ifTrue: [
self disableSubmorphFocusForHand: self activeHand.
self activeHand
releaseKeyboardFocus: self;
releaseMouseFocus: self].
+ "Preserve world reference for player notificaiton. See below."
+ aWorld := self world ifNil: [World].
+
+ owner ifNotNil:[
- owner ifNotNil: [
self privateDelete.
self player ifNotNil: [:player |
+ player noteDeletionOf: self fromWorld: aWorld]].!
- self isInWorld ifTrue: [
- player noteDeletionOf: self fromWorld: self world]]].!
Item was changed:
----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
clearGlobalState
"Clean up global state. The global variables World, ActiveWorld, ActiveHand and ActiveEvent
provide convenient access to the state of the active project in Morphic. Clear their prior values
when leaving an active project. This method may be removed if the use of global state variables
is eliminated."
+ (Smalltalk at: #World ifAbsent: [])
+ ifNotNil: [ Smalltalk at: #World put: nil ]. "If global World is defined, clear it now"
- (Smalltalk at: #World ifAbsent: []) ifNotNil: [:w | w := nil]. "If global World is defined, clear it now"
ActiveWorld := ActiveHand := ActiveEvent := nil.
!
Item was changed:
----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
finalEnterActions: leavingProject
"Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate |
"If this image has a global World variable, update it now"
(Smalltalk at: #World ifAbsent: [])
+ ifNotNil: [ Smalltalk at: #World put: world ]. "Signifies Morphic"
- ifNotNil: [:w | w := world]. "Signifies Morphic"
world install.
world transferRemoteServerFrom: leavingProject world.
"(revertFlag | saveForRevert | forceRevert) ifFalse: [
(Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
self storeSomeSegment]]."
"Transfer event recorder to me."
leavingProject isMorphic ifTrue: [
leavingProject world pauseEventRecorder ifNotNil: [:rec |
rec resumeIn: world]].
world triggerOpeningScripts.
self initializeMenus.
self projectParameters
at: #projectsToBeDeleted
ifPresent: [ :projectsToBeDeleted |
self removeParameter: #projectsToBeDeleted.
projectsToBeDeleted do: [:each | each delete]].
Locale switchAndInstallFontToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
thingsToUnhibernate do: [:each | each unhibernate].
world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator.
armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
navigator := world findA: navType.
(Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
[(navigator := navType new)
bottomLeft: world bottomLeft;
openInWorld: world].
navigator notNil & armsLengthCmd notNil ifTrue:
[navigator color: Color lightBlue].
armsLengthCmd notNil ifTrue:
[Preferences showFlapsWhenPublishing
ifFalse:
[self flapsSuppressed: true.
navigator ifNotNil: [navigator visible: false]].
armsLengthCmd openInWorld: world].
world reformulateUpdatingMenus.
world presenter positionStandardPlayer.
self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.!
David T. Lewis uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-dtl.217.mcz
==================== Summary ====================
Name: MorphicExtras-dtl.217
Author: dtl
Time: 20 November 2017, 7:32:14.452843 pm
UUID: b1677477-d4b1-4725-8506-e6d910979d16
Ancestors: MorphicExtras-dtl.216
Fix opening TabbedPalette from the objects catalog. A TabbedPalette is a morph that does not know its world, so use Project current world rather than #world. Also use Project current world in TabbedPalette class>>authoringPrototype.
=============== Diff against MorphicExtras-dtl.216 ===============
Item was changed:
----- Method: TabbedPalette class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
| aTabbedPalette aBook aTab |
aTabbedPalette := self new markAsPartsDonor.
aTabbedPalette pageSize: 200 @ 300.
aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue.
aTabbedPalette addMenuTab.
aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize.
aBook color: Color blue muchLighter.
aBook removeEverything; insertPage; showPageControls.
+ aBook currentPage addMorphBack: (Project current world drawingClass withForm: ScriptingSystem squeakyMouseForm).
- aBook currentPage addMorphBack: (self world drawingClass withForm: ScriptingSystem squeakyMouseForm).
aTab := aTabbedPalette addTabForBook: aBook.
aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize.
aBook color: Color red muchLighter.
aBook removeEverything; insertPage; showPageControls.
aBook currentPage addMorphBack: CurveMorph authoringPrototype.
aTabbedPalette addTabForBook: aBook.
aTabbedPalette selectTab: aTab.
aTabbedPalette beSticky.
aTabbedPalette tabsMorph hResizing: #spaceFill.
^ aTabbedPalette!
Item was changed:
----- Method: TabbedPalette>>addMenuTab (in category 'palette menu') -----
addMenuTab
"Add the menu tab. This is ancient code, not much in the spirit of anything current"
| aMenu aTab aGraphic sk |
aMenu := MenuMorph new defaultTarget: self.
aMenu stayUp: true.
"aMenu add: 'clear' translated action: #showNoPalette."
aMenu add: 'sort tabs' translated action: #sortTabs:.
aMenu add: 'choose new colors for tabs' translated action: #recolorTabs.
aMenu setProperty: #paletteMenu toValue: true.
"aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette."
aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated.
aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor.
tabsMorph laySubpartsOutInOneRow; layoutChanged.
aGraphic := ScriptingSystem formAtKey: 'TinyMenu'.
aGraphic ifNotNil:
[aTab removeAllMorphs.
+ aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic).
- aTab addMorph: (sk := self world drawingClass withForm: aGraphic).
sk position: aTab position.
sk lock.
aTab fitContents].
self layoutChanged!
David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.1370.mcz
==================== Summary ====================
Name: Morphic-dtl.1370
Author: dtl
Time: 20 November 2017, 3:57:16.432712 pm
UUID: c7def8b8-a7a4-4a98-8e18-f7781c42bfde
Ancestors: Morphic-dtl.1369
Remove remaining references to global World from package Morphic (not including extensions from other packages, e.g. Etoys).
Reorganize Morph>>delete to avoid dependence on global World, and call noteDeletionOf:fromWorld: only if the morph has a world (otherwise it must not be a costume, so the call is not required).
In finalEnterActions: and finalExitActions:, update World only if it is defined. This is to permit removal of the global for puposes of verifying that the system still works, but note that the intent is to retain the global definition both as a convenience and also for possible support of external packages that may contain references to well known globals.
=============== Diff against Morphic-dtl.1369 ===============
Item was changed:
----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
backgroundWorldDisplay
+ | world |
self flag: #bob. "really need a better way to do this"
"World displayWorldSafely."
"ugliness to try to track down a possible error"
+ world := Project current world.
+ [world displayWorld] ifError: [ :a :b |
-
- [Project current world displayWorld] ifError: [ :a :b |
| f |
stageCompleted := 999.
f := FileDirectory default fileNamed: 'bob.errors'.
f nextPutAll: a printString,' ',b printString; cr; cr.
+ f nextPutAll: 'worlds equal ',(formerWorld == world) printString; cr; cr.
- f nextPutAll: 'worlds equal ',(formerWorld == World) printString; cr; cr.
f nextPutAll: thisContext longStack; cr; cr.
f nextPutAll: formerProcess suspendedContext longStack; cr; cr.
f close. Beeper beep.
].
!
Item was changed:
----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'as yet unclassified') -----
forkProgressWatcher
[
+ | currentWorld killTarget |
+ currentWorld := Project current world.
- | killTarget |
[stageCompleted < 999 and:
[formerProject == Project current and:
+ [formerWorld == currentWorld and:
- [formerWorld == World and:
[translucentMorph world notNil and:
[formerProcess suspendedContext notNil and:
[Project uiProcess == formerProcess]]]]]] whileTrue: [
translucentMorph setProperty: #revealTimes toValue:
{(Time millisecondClockValue - start max: 1). (estimate * newRatio max: 1)}.
translucentMorph changed.
translucentMorph owner addMorphInLayer: translucentMorph.
(Time millisecondClockValue - WorldState lastCycleTime) abs > 500 ifTrue: [
self backgroundWorldDisplay
].
(Delay forMilliseconds: 100) wait.
].
translucentMorph removeProperty: #revealTimes.
self loadingHistoryAt: 'total' add: (Time millisecondClockValue - start max: 1).
killTarget := targetMorph ifNotNil: [
targetMorph valueOfProperty: #deleteOnProgressCompletion
].
+ formerWorld == currentWorld ifTrue: [
- formerWorld == World ifTrue: [
translucentMorph delete.
killTarget ifNotNil: [killTarget delete].
] ifFalse: [
translucentMorph privateDeleteWithAbsolutelyNoSideEffects.
killTarget ifNotNil: [killTarget privateDeleteWithAbsolutelyNoSideEffects].
].
] forkAt: Processor lowIOPriority.!
Item was changed:
----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'as yet unclassified') -----
withProgressDo: aBlock
| safetyFactor totals trialRect delta targetOwner |
Smalltalk isMorphic ifFalse: [^aBlock value].
formerProject := Project current.
+ formerWorld := formerProject world.
- formerWorld := World.
formerProcess := Processor activeProcess.
targetMorph
ifNil: [targetMorph := ProgressTargetRequestNotification signal].
targetMorph ifNil: [
trialRect := Rectangle center: Sensor cursorPoint extent: 80@80.
delta := trialRect amountToTranslateWithin: formerWorld bounds.
trialRect := trialRect translateBy: delta.
translucentMorph := TranslucentProgessMorph new
opaqueBackgroundColor: Color white;
bounds: trialRect;
openInWorld: formerWorld.
] ifNotNil: [
targetOwner := targetMorph owner.
translucentMorph := TranslucentProgessMorph new
setProperty: #morphicLayerNumber toValue: targetMorph morphicLayerNumber - 0.1;
bounds: targetMorph boundsInWorld;
openInWorld: targetMorph world.
].
stageCompleted := 0.
safetyFactor := 1.1. "better to guess high than low"
translucentMorph setProperty: #progressStageNumber toValue: 1.
translucentMorph hide.
targetOwner ifNotNil: [targetOwner hide].
totals := self loadingHistoryDataForKey: 'total'.
newRatio := 1.0.
estimate := totals size < 2 ifTrue: [
15000 "be a pessimist"
] ifFalse: [
(totals sum - totals max) / (totals size - 1 max: 1) * safetyFactor.
].
start := Time millisecondClockValue.
self forkProgressWatcher.
[
aBlock
on: ProgressInitiationException
do: [ :ex |
ex sendNotificationsTo: [ :min :max :curr |
"ignore this as it is inaccurate"
].
].
] on: ProgressNotification do: [ :note | | stageCompletedString |
translucentMorph show.
targetOwner ifNotNil: [targetOwner show].
note extraParam ifNotNil:[self addProgressDecoration: note extraParam].
stageCompletedString := (note messageText findTokens: ' ') first.
stageCompleted := (stageCompletedString copyUpTo: $:) asNumber.
cumulativeStageTime := Time millisecondClockValue - start max: 1.
prevData := self loadingHistoryDataForKey: stageCompletedString.
prevData isEmpty ifFalse: [
newRatio := (cumulativeStageTime / (prevData average max: 1)) asFloat.
].
self
loadingHistoryAt: stageCompletedString
add: cumulativeStageTime.
translucentMorph
setProperty: #progressStageNumber
toValue: stageCompleted + 1.
note resume.
].
stageCompleted := 999. "we may or may not get here"
!
Item was changed:
----- Method: FillInTheBlankMorph class>>requestPassword: (in category 'instance creation') -----
requestPassword: queryString
"Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels."
"use password font"
"FillInTheBlankMorph requestPassword: 'Password?'"
^ self
requestPassword: queryString
initialAnswer: ''
centerAt: Sensor cursorPoint
+ inWorld: Project current world
- inWorld: World
onCancelReturn: ''
acceptOnCR: true
!
Item was changed:
----- Method: Morph>>delete (in category 'submorphs-add/remove') -----
delete
"Remove the receiver as a submorph of its owner and make its
new owner be nil."
- | aWorld |
self removeHalo.
self isInWorld ifTrue: [
self disableSubmorphFocusForHand: self activeHand.
self activeHand
releaseKeyboardFocus: self;
releaseMouseFocus: self].
+ owner ifNotNil: [
- "Preserve world reference for player notificaiton. See below."
- aWorld := self world ifNil: [World].
-
- owner ifNotNil:[
self privateDelete.
self player ifNotNil: [:player |
+ self isInWorld ifTrue: [
+ player noteDeletionOf: self fromWorld: self world]]].!
- player noteDeletionOf: self fromWorld: aWorld]].!
Item was added:
+ ----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
+ clearGlobalState
+ "Clean up global state. The global variables World, ActiveWorld, ActiveHand and ActiveEvent
+ provide convenient access to the state of the active project in Morphic. Clear their prior values
+ when leaving an active project. This method may be removed if the use of global state variables
+ is eliminated."
+
+ (Smalltalk at: #World ifAbsent: []) ifNotNil: [:w | w := nil]. "If global World is defined, clear it now"
+ ActiveWorld := ActiveHand := ActiveEvent := nil.
+ !
Item was changed:
----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
finalEnterActions: leavingProject
"Perform the final actions necessary as the receiver project is entered"
| navigator armsLengthCmd navType thingsToUnhibernate |
+ "If this image has a global World variable, update it now"
+ (Smalltalk at: #World ifAbsent: [])
+ ifNotNil: [:w | w := world]. "Signifies Morphic"
- World := world. "Signifies Morphic"
world install.
world transferRemoteServerFrom: leavingProject world.
"(revertFlag | saveForRevert | forceRevert) ifFalse: [
(Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
self storeSomeSegment]]."
"Transfer event recorder to me."
leavingProject isMorphic ifTrue: [
leavingProject world pauseEventRecorder ifNotNil: [:rec |
rec resumeIn: world]].
world triggerOpeningScripts.
self initializeMenus.
self projectParameters
at: #projectsToBeDeleted
ifPresent: [ :projectsToBeDeleted |
self removeParameter: #projectsToBeDeleted.
projectsToBeDeleted do: [:each | each delete]].
Locale switchAndInstallFontToID: self localeID.
thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
thingsToUnhibernate do: [:each | each unhibernate].
world removeProperty: #thingsToUnhibernate.
navType := ProjectNavigationMorph preferredNavigator.
armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
navigator := world findA: navType.
(Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
[(navigator := navType new)
bottomLeft: world bottomLeft;
openInWorld: world].
navigator notNil & armsLengthCmd notNil ifTrue:
[navigator color: Color lightBlue].
armsLengthCmd notNil ifTrue:
[Preferences showFlapsWhenPublishing
ifFalse:
[self flapsSuppressed: true.
navigator ifNotNil: [navigator visible: false]].
armsLengthCmd openInWorld: world].
world reformulateUpdatingMenus.
world presenter positionStandardPlayer.
self assureMainDockingBarPresenceMatchesPreference.
world repairEmbeddedWorlds.!
Item was changed:
----- Method: MorphicProject>>finalExitActions: (in category 'enter') -----
finalExitActions: enteringProject
world triggerClosingScripts.
"Pause sound players, subject to preference settings"
(world hasProperty: #letTheMusicPlay)
ifTrue: [world removeProperty: #letTheMusicPlay]
ifFalse: [SoundService stop].
world sleep.
-
(world findA: ProjectNavigationMorph)
ifNotNil: [:navigator | navigator retractIfAppropriate].
+ self clearGlobalState.
-
- "Clean-up global state."
- World := nil.
- ActiveWorld := ActiveHand := ActiveEvent := nil.
Sensor flushAllButDandDEvents. !
Item was changed:
----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') -----
storeSegmentNoFile
"For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
| is currentWorld |
currentWorld := Project current world.
(currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'."
world isInMemory ifFalse: [^ self]. "already done"
world ifNil: [^ self]. world presenter ifNil: [^ self].
"Do this on project enter"
+ currentWorld flapTabs do: [:ft | ft referent adaptToWorld: currentWorld].
- currentWorld flapTabs do: [:ft | ft referent adaptToWorld: World].
"Hack to keep the Menu flap from pointing at my project"
"Preferences setPreference: #useGlobalFlaps toValue: false."
"Utilities globalFlapTabsIfAny do:
[:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false].
Utilities clobberFlapTabList. "
"project world deleteAllFlapArtifacts."
"self currentWorld deleteAllFlapArtifacts. "
ScrapBook default emptyScrapBook.
currentWorld checkCurrentHandForObjectToPaste2.
is := ImageSegment
copyFromRootsLocalFileFor: {world presenter. world} "world, and all Players"
sizeHint: 0.
is segment size < 800 ifTrue: ["debugging"
Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep].
is extract.
"is instVarAt: 2 put: is segment clone." "different memory"!