Squeak-dev January 2023

squeak-dev@lists.squeakfoundation.org

31 participants
225 discussions

Squeak 6.0: Graphics-mt.531.mcz
by commits＠source.squeak.org 23 Jan '23

23 Jan '23

Marcel Taeumel uploaded a new version of Graphics to project Squeak 6.0: http://source.squeak.org/squeak60/Graphics-mt.531.mcz ==================== Summary ==================== Name: Graphics-mt.531 Author: mt Time: 23 January 2023, 1:21:56.866167 pm UUID: 0e5b64e3-dd2a-3245-a8c4-46b1fa72db3c Ancestors: Graphics-mt.530 Fix issue of leaking file handles in our new GIFReadWriter. =============== Diff against Graphics-mt.530 =============== Item was changed: ----- Method: GIFReadWriter class>>formsFromFileNamed: (in category 'image reading/writing') ----- + formsFromFileNamed: aFilePath + + ^ self formsFromStream: (FileStream readOnlyFileNamed: aFilePath)! - formsFromFileNamed: aFile - ^ (self on: aFile asDirectoryEntry readStream binary) - readHeader; - readBody; - yourself! Item was changed: ----- Method: GIFReadWriter class>>formsFromStream: (in category 'image reading/writing') ----- formsFromStream: aBinaryStream + + | result | + self flag: #misnomer. "mt: This message does NOT return a collection of forms." + result := (self on: aBinaryStream) - ^ (self on: aBinaryStream) readHeader; readBody; + yourself. + + self flag: #workaround. "mt: Avoid leaking open file handles." + result close. + + ^ result! - yourself!

1 0

The Trunk: Graphics-mt.538.mcz
by commits＠source.squeak.org 23 Jan '23

23 Jan '23

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.538.mcz ==================== Summary ==================== Name: Graphics-mt.538 Author: mt Time: 23 January 2023, 1:21:45.37588 pm UUID: 0d6f4808-2e2e-494c-9b2c-92f7d0c7a0eb Ancestors: Graphics-mt.537 Fix issue of leaking file handles in our new GIFReadWriter. I will backport this to 6.0. Document the misnomer that should not be changed at this point. I think. =============== Diff against Graphics-mt.537 =============== Item was changed: ----- Method: GIFReadWriter class>>formsFromFileNamed: (in category 'image reading/writing') ----- + formsFromFileNamed: aFilePath + + ^ self formsFromStream: (FileStream readOnlyFileNamed: aFilePath)! - formsFromFileNamed: aFile - ^ (self on: aFile asDirectoryEntry readStream binary) - readHeader; - readBody; - yourself! Item was changed: ----- Method: GIFReadWriter class>>formsFromStream: (in category 'image reading/writing') ----- formsFromStream: aBinaryStream + + | result | + self flag: #misnomer. "mt: This message does NOT return a collection of forms." + result := (self on: aBinaryStream) - ^ (self on: aBinaryStream) readHeader; readBody; + yourself. + + self flag: #workaround. "mt: Avoid leaking open file handles." + result close. + + ^ result! - yourself!

1 0

Squeak By Example 5.3
by G B 23 Jan '23

23 Jan '23

There is a pdf of Squeak By Example 5.3, but I can't find a printed and bound edition. There is a copy of the old 2007 or 2011 edition of the book for sale on Amazon, but not the updated one for 5.3. Can I upload the SBE 5.3 pdf to lulu.com and have color printed and bound book created so I can purchase it for myself? I don't want to break any copyright laws. Even though the pdf is freely available, I don't know if having it printed is permitted. Thank you.

3 3

The Trunk: System-mt.1384.mcz
by commits＠source.squeak.org 23 Jan '23

23 Jan '23

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1384.mcz ==================== Summary ==================== Name: System-mt.1384 Author: mt Time: 20 January 2023, 3:48:54.016382 pm UUID: 85b1fd2e-0162-b54c-b735-f046350d97ad Ancestors: System-mt.1383 Move (1) recursive-error detection and (2) stack-to-file logging from Debugger class to ToolSet/Project so that custom (process) debugging tools cannot omit to include these features. Note that, by now, most of the actual "debugging logic" is simply contained in - Context and Process (for code simulation, i.e., step into etc.) - Project and subclasses (for GUI/system responsiveness protection, i.e., recursive error detection, project fallback, emergency evaluator, ...) It's now easier to write a custom debugger, install it through a custom toolset, and then use it for the next unhandled error. =============== Diff against System-mt.1383 =============== Item was changed: ----- Method: Process>>debug (in category '*System-debugging') ----- debug "See the comment in #debugWithTitle:full:contents:." + ^ self debugWithTitle: 'Debugger' translated! - ^ self debugWithTitle: nil! Item was added: + ----- Method: Project>>debugProcess:inDialog: (in category 'scheduling & debugging') ----- + debugProcess: aProcess inDialog: aMessageText + "Inform the user about a debugging incident where no interactive debugger is available. Give a choice between #terminate and #inspect. Suspend the process anway." + + self addDeferredUIMessage: [ + (self uiManager confirm: aMessageText, '\\Terminate process?' translated withCRs) + ifTrue: [aProcess terminateAggressively] + ifFalse: [aProcess inspect]]. + + self suspendProcessSafely: aProcess. + + ^ nil "There is no debugger tool to answer."! Item was added: + ----- Method: Project>>guardRecursiveError:during: (in category 'scheduling & debugging') ----- + guardRecursiveError: errorMessage during: workBlock + + "If the active process re-enters this method again, something went wrong with invoking the debugger." + Processor activeProcess hasRecursiveError + ifTrue: [ + Processor activeProcess clearErrorRecursionFlag. + ToolSet handleRecursiveError: errorMessage]. + + "If project-specific debuggers mess up, we have to flag that recursion here." + Processor activeProcess setErrorRecursionFlag. + ^ workBlock ensure: [Processor activeProcess clearErrorRecursionFlag]! Item was changed: ----- Method: SmalltalkImage>>logError:inContext:to: (in category 'miscellaneous') ----- logError: errMsg inContext: aContext to: aFilename "Log the error message and a stack trace to the given file." + FileStream forceNewFileNamed: aFilename do: [:stream | + stream nextPutAll: (errMsg ifNil: ['(unspecified error)']); cr. + aContext errorReportOn: stream].! - | ff | - FileDirectory default deleteFileNamed: aFilename ifAbsent: []. - (ff := FileStream fileNamed: aFilename) ifNil: [^ self "avoid recursive errors"]. - - ff nextPutAll: errMsg; cr. - aContext errorReportOn: ff. - ff close.! Item was added: + ----- Method: SmalltalkImage>>tryLogSqueakError:inContext: (in category 'miscellaneous') ----- + tryLogSqueakError: errorMessage inContext: aContext + "Log error message and stack trace in file. Can be disabled via preference. Guard errors to avoid recursive error." + + Preferences logDebuggerStackToFile ifFalse: [^ false]. + + [Smalltalk logSqueakError: errorMessage inContext: aContext] + on: Error do: [:ex | + Preferences disable: #logDebuggerStackToFile. + ToolSet debugException: ex. + ^ false]. + + ^ true! Item was changed: ----- Method: ToolSet class>>debugProcess:context:label:contents:fullView: (in category 'debugging') ----- debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool + "Open a debugger on the given process, which might be active, suspended, or terminated. You can also use the convenience protocol for debugging on Process and ProcessorScheduler. + + NOTE that you SHOULD NOT pass 'Processor activeProcess' directly to this method to avoid mixing code simulation with genuine code execution. Always use the indirection via ProcessorScheduler >>#debug... See also the comment in Process >> #debugWithTitle:full:contents:." - "Open a debugger on the given process, which might be active, suspended, or terminated. You can also use the convenience protocol for debugging on Process and ProcessorScheduler. NOTE that you should not pass Processor activeProcess directly to this method. Always use the indirection via ProcessorScheduler >>#debug... See also the comment in Process >> #debugWithTitle:full:contents:." + "First, guard this incident to detect and handle recursive errors." + ^ Project current guardRecursiveError: aString during: [ + + "In any case, log the debugging incident into an external file." + Smalltalk tryLogSqueakError: aString inContext: aContext. + + self default + ifNotNil: [:toolSet | + "Let the current tool set decide about the best tool for the job." + toolSet + debugProcess: aProcess context: aContext + label: aString contents: contents + fullView: aBool] + ifNil: [ + "There is no tool set!! :-O ... Inform the user in a simple dialog." + Project current + debugProcess: aProcess + inDialog: ('No debugger available for process:\\ Name: {1}\ Hash: {2}\ Context: {3}\ Title: {4}\ Message: {5}' translated withCRs + format: {aProcess name. aProcess hash. aContext. aString. contents})] ]! - ^ self default - ifNil: [(self confirm: 'Debugger request -- proceed?' translated) ifFalse: [Processor terminateActive]] - ifNotNil: [:ts | ts debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool]!

3 2

The Inbox: HelpSystem-Core-tpr.142.partial.mcz
by commits＠source.squeak.org 23 Jan '23

23 Jan '23

A new version of HelpSystem-Core was added to project The Inbox: http://source.squeak.org/inbox/HelpSystem-Core-tpr.142.partial.mcz ==================== Summary ==================== Name: HelpSystem-Core-tpr.142.partial Author: tpr Time: 22 January 2023, 4:13:14.055631 pm UUID: c34bf4e5-69a7-49eb-9876-28dae77c065c Ancestors: HelpSystem-Core-tpr.141, HelpSystem-Core-ct.124 Start on incorporating ct's helpbrower enhancements =============== Diff against HelpSystem-Core-tpr.141 =============== Item was changed: ----- Method: AbstractHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic + "If this topic is editable, this will be the callback to update its contents."! - "If this topic is editable, this will be the callback to update its contents." - ^ false! Item was added: + ----- Method: AbstractHelpTopic>>canAddSubtopic (in category 'testing') ----- + canAddSubtopic + + ^ false! Item was added: + ----- Method: AbstractHelpTopic>>canRemoveSubtopic (in category 'testing') ----- + canRemoveSubtopic + + ^ false! Item was added: + ----- Method: AbstractHelpTopic>>isClassBasedHelpTopic (in category 'testing') ----- + isClassBasedHelpTopic + + ^ false! Item was changed: ----- Method: AbstractHelpTopic>>topicMenu:parentTopic: (in category 'menus') ----- topicMenu: aMenu parentTopic: parentTopic + | editMenu | - (self canBrowseTopicFromParent: parentTopic) - ifTrue: [ - aMenu - add: 'browse (b)' translated - target: self - selector: #browseTopicFromParent: - argumentList: {parentTopic}; - addLine ]. aMenu + add: 'Inspect (i)' translated target: self action: #inspect; + add: 'Explore (I)' translated target: self action: #explore. + (self canBrowseTopicFromParent: parentTopic) ifTrue: + [aMenu + add: 'Browse (b)' translated + target: self + selector: #browseTopicFromParent: + argumentList: {parentTopic} ]. - add: 'inspect (i)' translated target: self action: #inspect; - add: 'explore (I)' translated target: self action: #explore. + editMenu := aMenu class new target: self. + self canAddSubtopic ifTrue: + [editMenu + add: 'Add topic...' translated + target: self + action: #addSubtopic ]. + parentTopic canRemoveSubtopic ifTrue: + [editMenu + add: 'Remove topic (x)' translated + target: parentTopic + selector: #removeSubtopic: + argumentList: {self} ]. + editMenu hasItems ifTrue: + [aMenu + addLine; + addAllFrom: editMenu ]. + ^ aMenu! Item was changed: ----- Method: AbstractHelpTopic>>topicMenuKey:fromParent: (in category 'menus') ----- topicMenuKey: aChar fromParent: parentTopic aChar caseOf: { [$b] -> [(self canBrowseTopicFromParent: parentTopic) ifTrue: [ self browseTopicFromParent: parentTopic ]]. [$i] -> [self inspect]. + [$I] -> [self explore]. + [$x] -> [parentTopic canRemoveSubtopic ifTrue: [ + parentTopic removeSubtopic: self ]] } - [$I] -> [self explore] } otherwise: [^ false]. ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>addMethodTopic (in category 'editing') ----- + addMethodTopic + + | title key needsToStorePages oldPages topic | + title := UIManager default request: 'Please enter a topic name:' translated. + title isEmptyOrNil ifTrue: [^ nil]. + key := self makeUniqueKeyFrom: (title asIdentifier: false). + needsToStorePages := self needsToStorePages. + needsToStorePages ifTrue: [ + (self okToWriteSelector: #pages) + ifFalse: [^ false]. + oldPages := self helpClass pages]. + topic := HelpTopic named: title. + topic key: key. + self accept: '' for: topic. + needsToStorePages ifTrue: [ + self storePages: (oldPages copyWith: key)]. + self refresh. + ^ self subtopics detect: [:other | other key = key]! Item was added: + ----- Method: ClassBasedHelpTopic>>addSubclassTopic (in category 'editing') ----- + addSubclassTopic + + | className title subclass | + title := UIManager default request: 'Please enter a book name:' translated. + title isEmptyOrNil ifTrue: [^ nil]. + className := UIManager default + request: 'Please enter a class name:' translated + initialAnswer: (title asIdentifier: true). + className isEmptyOrNil ifTrue: [^ nil]. + className := className asSymbol. + Smalltalk at: className ifPresent: + [:class | self inform: 'Class already exists' translated. + ^ nil]. + subclass := self helpClass subclass: className + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self helpClass category. + subclass theMetaClass compile: + (String streamContents: + [:stream | + stream nextPutAll: #bookName; + crtab; nextPutAll: '<generated>'; + crtab; nextPut: $^; + store: title]) + classified: #accessing. + subclass asHelpTopic storePages: #(). + self refresh. + ^ self subtopics detect: + [:topic | + topic isClassBasedHelpTopic and: [topic helpClass = subclass]]! Item was added: + ----- Method: ClassBasedHelpTopic>>addSubtopic (in category 'editing') ----- + addSubtopic + + | strategy | + strategy := UIManager default + chooseFrom: (#('Add a method' 'Add a subclass') collect: #translated) + values: #(addMethodTopic addSubclassTopic) + title: 'Choose kind of subtopic' translated. + strategy ifNil: [^ self]. + ^ self perform: strategy! Item was added: + ----- Method: ClassBasedHelpTopic>>canAddSubtopic (in category 'testing') ----- + canAddSubtopic + + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>canRemoveSubtopic (in category 'testing') ----- + canRemoveSubtopic + + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>isClassBasedHelpTopic (in category 'testing') ----- + isClassBasedHelpTopic + + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>makeUniqueKeyFrom: (in category 'editing') ----- + makeUniqueKeyFrom: aKey + + | keyIndex newKey | + newKey := aKey. + keyIndex := 0. + [(self subtopics anySatisfy: [:existing | existing key = newKey])] + whileTrue: [newKey := newKey , (keyIndex := keyIndex + 1)]. + ^ newKey asSymbol! Item was added: + ----- Method: ClassBasedHelpTopic>>needsToStorePages (in category 'testing') ----- + needsToStorePages + + | method | + method := self helpClass theMetaClass lookupSelector: #pages. + method ifNil: [^ true]. + ^ (method hasPragma: #pageInvariant) not! Item was added: + ----- Method: ClassBasedHelpTopic>>okToRemoveClass (in category 'editing') ----- + okToRemoveClass + + | message | + message := ( + 'Are you certain that you want to remove\the class {1}\' + , (self helpClass subclasses ifEmpty: [''] ifNotEmpty: ['and all its {2} subclasses\']) + , 'from the system?') + withCRs translated format: {self helpClass. self helpClass subclasses size}. + ^ self confirm: message! Item was added: + ----- Method: ClassBasedHelpTopic>>removeSubtopic: (in category 'editing') ----- + removeSubtopic: aTopic + + | needsToStorePages oldPages | + aTopic isClassBasedHelpTopic ifTrue: + [| result | + result := aTopic removeTopicClass. + result ifTrue: [self refresh]. + ^ result]. + + aTopic key ifNil: + [self inform: 'Could not find topic' translated. + ^ false]. + + (self confirm: ('Are you sure you want to REMOVE the topic "{1}" from "{2}"?' translated format: {aTopic title. self title})) + ifFalse: [^ false]. + + (needsToStorePages := self needsToStorePages) ifTrue: + [(self okToWriteSelector: #pages) + ifFalse: [^ false]. + oldPages := self helpClass pages]. + + (self systemNavigation + confirmAndRemoveSelector: aTopic key + class: self helpClass theMetaClass) + ifFalse: [^ false]. + + needsToStorePages ifTrue: + [self storePages: (oldPages copyWithout: aTopic key)]. + self refresh. + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>removeTopicClass (in category 'editing') ----- + removeTopicClass + + self okToRemoveClass ifFalse: [^ false]. + self helpClass removeFromSystem. + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>storePages: (in category 'editing') ----- + storePages: keys + + | class | + class := self helpClass theMetaClass. + class + compile: (String streamContents: [:stream | + stream + nextPutAll: 'pages'. + (class includesSelector: #pages) + ifFalse: [ stream + crtab; nextPutAll: '<pageInvariant>'; + crtab; nextPutAll: '^ self class methodsInCategory: #pages' ] + ifTrue: [ stream + crtab; nextPutAll: '<generated>'; + crtab; nextPut: $^; + store: keys ]]) + classified: #accessing.! Item was changed: ----- Method: ClassBasedHelpTopic>>updateSubtopics (in category 'updating') ----- updateSubtopics "build a list of subtopics; start with the list of page names specified by the helpClass' #pages method, remembering that it is an ordered list of - selectors that return a HelpTopic, - or the name of a class that must in turn provide help topics etc. This allows for hierarchies with 'subtrees in the middle'. The order of the pages reflects the order of the selectors and class names given. Then all the subclasses that are not #ignore'd and not already included are added. Finally the list of class names and messages is used to assemble the actual help topics. Questions: is it actually useful to include the possibility of class names as per the CustomHelpHelpBuilder>createTopicFrom: code? is the #ignore testing worth keeping?" | pages | pages := (self helpClass pages collect: [:pageSelectorOrClassName | (Smalltalk hasClassNamed: pageSelectorOrClassName asString) ifTrue: [Smalltalk classNamed: pageSelectorOrClassName asString] ifFalse: [pageSelectorOrClassName]]) asOrderedCollection. self helpClass subclasses + reject: [:cls | cls ignore] - select: [:cls | cls ignore not] thenDo: [:cls | pages addIfNotPresent: cls]. ^ subtopics := pages withIndexCollect: [:pageSelectorOrClass :pagePriority | pageSelectorOrClass isBehavior ifFalse: [(self helpClass perform: pageSelectorOrClass) priority: pagePriority - pages size; key: pageSelectorOrClass; in: [:topic | "Use my choice of styling if my subtopics do not care." topic shouldStyle ifNil: [topic shouldStyle: self usesCodeStyling]]; yourself] ifTrue: [pageSelectorOrClass asHelpTopic]]! Item was changed: ----- Method: DirectoryBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic FileStream forceNewFileNamed: subtopic fileEntry fullName do: [:strm | strm nextChunkPutWithStyle: newContents]. - ^ true ! Item was changed: ----- Method: FileBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic FileStream forceNewFileNamed: self fileEntry fullName do: [:strm | strm nextChunkPutWithStyle: newContents]. + - ^ true !

1 0

The Trunk: Tools-mt.1186.mcz
by commits＠source.squeak.org 20 Jan '23

20 Jan '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1186.mcz ==================== Summary ==================== Name: Tools-mt.1186 Author: mt Time: 20 January 2023, 6:50:26.795382 pm UUID: 19c7a120-92c1-fd49-a0fd-96a76f3285c1 Ancestors: Tools-mt.1185 Complements System-mt.1385 =============== Diff against Tools-mt.1185 =============== Item was added: + ----- Method: Debugger>>initialExtentKey (in category 'initialize-release') ----- + initialExtentKey + + ^ { self class name . self isNotifier }! Item was changed: ----- Method: Debugger>>openFullFromNotifier: (in category 'initialize-release') ----- openFullFromNotifier: topView "Create a full debugger to replace the given view." + RealEstateAgent rememberExtentFor: self. self initializeFull. topView model: nil. "so close won't release me." self breakDependents. ^ ToolBuilder default close: topView; open: self label: topView label "Keep the label."! Item was changed: ----- Method: Inspector>>replaceInspectorWithExplorer (in category 'toolbuilder') ----- replaceInspectorWithExplorer "Switch to an explorer tool. If there are custom fields, the user can choose to not discard them, which will just spawn a new explorer tool besides this inspector." | window currentBounds | self flag: #todo. "ct: In the long term, we should try to communicate specific selectors (here: #expression) along the observer pattern for requests such as #acceptChanges or #wantToChange instead of exploiting contentsTyped etc." (self okToDiscardCustomFields and: [contentsTyped notNil ==> [self confirm: 'Changes have not been saved. Is it OK to cancel those changes?' translated orCancel: [^ self]]]) ifFalse: [^ self object explore]. self customFields removeAll. self changed: #contents. "Reset value pane contents before accepting all contents" self changed: #acceptChanges. "We copy the current state anyway. See below." + RealEstateAgent rememberExtentFor: self. currentBounds := ToolBuilder default class getBoundsForWindow: self containingWindow. "Close first because MVC fiddles around with processes." self changed: #close. window := ToolSet explore: self object. "---- In MVC, the lines after this will not be executed ---" window model setExpression: self expression. ToolBuilder default class setBoundsForWindow: window to: currentBounds.! Item was added: + ----- Method: MessageSet>>initialExtentKey (in category 'initialize-release') ----- + initialExtentKey + + ^ { self class name . windowLabel hash}! Item was changed: ----- Method: ObjectExplorer>>inspectObject (in category 'toolbuilder') ----- inspectObject "Switch to an inspector tool." | window currentBounds | + RealEstateAgent rememberExtentFor: self. currentBounds := ToolBuilder findDefault getBoundsForWindow: self containingWindow. "Close first because MVC fiddles around with processes." self changed: #close. window := ToolSet inspect: self rootObject. "---- In MVC, the lines after this will not be executed ---" window model setExpression: self expression. ToolBuilder findDefault setBoundsForWindow: window to: currentBounds.!

1 0

The Trunk: ToolBuilder-Morphic-mt.324.mcz
by commits＠source.squeak.org 20 Jan '23

20 Jan '23

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.324.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.324 Author: mt Time: 20 January 2023, 6:49:45.023382 pm UUID: e0f58c03-a2e9-7e41-be5a-6d358b029d59 Ancestors: ToolBuilder-Morphic-tpr.323 Complements System-mt.1385 =============== Diff against ToolBuilder-Morphic-tpr.323 =============== Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableWindow: (in category 'widgets required') ----- buildPluggableWindow: aSpec + | widget initialExtent | - | widget | aSpec layout == #proportional ifFalse:[ "This needs to be implemented - probably by adding a single pane and then the rest" ^self error: 'Not implemented'. ]. widget := (self windowClassFor: aSpec) new. self register: widget id: aSpec name. widget model: aSpec model. "Set child dependent layout properties." MorphicProject worldGridEnabled ifTrue: [ "Snap both #position and #extent to grid." aSpec horizontalResizing ifNil: [aSpec horizontalResizing: #spaceFill]. aSpec verticalResizing ifNil: [aSpec verticalResizing: #spaceFill]]. self setLayoutHintsFor: widget spec: aSpec. widget layoutInset: (aSpec padding ifNil: [self windowPadding]). widget morphicLayerNumber: widget class windowLayer. self flag: #todo. "ct: Below, there is a lot of duplication with #buildPluggablePanel:. Can we factor out some of this, or even just collect all children in a PluggablePanelMorph?" widget cellGap: (aSpec spacing ifNil: [self windowSpacing]). widget wantsGrips: true. widget wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). "Now create the children." panes := OrderedCollection new. aSpec children isSymbol ifTrue: [ widget getChildrenSelector: aSpec children. widget update: aSpec children] ifFalse: [ widget rebuildPaneAfter: [ self buildAll: aSpec children in: widget]]. widget setUpdatablePanesFrom: panes. aSpec defaultFocus ifNotNil: [:name | widget defaultFocusMorph: name]. aSpec label ifNotNil: [:label| label isSymbol ifTrue:[widget getLabelSelector: label] ifFalse:[widget setLabel: label]]. aSpec multiWindowStyle notNil ifTrue: [widget savedMultiWindowState: (SavedMultiWindowState on: aSpec model)]. widget closeWindowSelector: aSpec closeAction. self buildHelpFor: widget spec: aSpec. + initialExtent := (RealEstateAgent savedExtentFor: aSpec model) + ifNil: [aSpec extent ifNil: [widget initialExtent]]. widget bounds: (RealEstateAgent initialFrameFor: widget + initialExtent: (initialExtent * RealEstateAgent windowScaleFactor * RealEstateAgent scaleFactor) rounded - initialExtent: ((aSpec extent ifNil:[widget initialExtent]) * RealEstateAgent windowScaleFactor * RealEstateAgent scaleFactor) rounded world: self currentWorld). widget refreshWindowColor. ^ widget!

1 0

The Trunk: ToolBuilder-MVC-mt.71.mcz
by commits＠source.squeak.org 20 Jan '23

20 Jan '23

Marcel Taeumel uploaded a new version of ToolBuilder-MVC to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-MVC-mt.71.mcz ==================== Summary ==================== Name: ToolBuilder-MVC-mt.71 Author: mt Time: 20 January 2023, 6:49:34.480382 pm UUID: b0ca3358-ad8a-b54a-a6d2-cf0439a5563f Ancestors: ToolBuilder-MVC-mt.70 Complements System-mt.1385 =============== Diff against ToolBuilder-MVC-mt.70 =============== Item was changed: ----- Method: MVCToolBuilder>>buildPluggableWindow: (in category 'widgets required') ----- buildPluggableWindow: aSpec | widget children label | topSize := 0@0 corner: 640@480. aSpec layout == #proportional ifFalse:[ "This needs to be implemented - probably by adding a single pane and then the rest" ^self error: 'Not implemented'. ]. widget := StandardSystemView new. self register: widget id: aSpec name. widget model: aSpec model. label := aSpec label. label isSymbol ifTrue: [label := aSpec model perform: label]. label isNil ifFalse: [widget setLabel: label]. children := aSpec children. children isSymbol ifTrue:[ "This isn't implemented by StandardSystemView, so we fake it" children := widget model perform: children. ]. + ((RealEstateAgent savedExtentFor: aSpec model) + ifNil: [aSpec extent]) ifNotNil: [:initialExtent | + topSize := 0@0 extent: initialExtent]. + self flag: #fixme. "ct: Explicit spec extent is ignored in StandardSystemView >> #resizeInitially, called by StandardSystemController >> #open[NoTerminate]. See MorphicToolBuilder implementation and RealEstateAgent class >> #initialFrameFor:initialExtent:world:." - aSpec extent ifNotNil:[topSize := 0@0 extent: aSpec extent]. widget window: topSize. panes := OrderedCollection new. self buildAll: children in: widget. widget setUpdatablePanesFrom: panes. ^widget!

1 0

The Trunk: ST80-mt.289.mcz
by commits＠source.squeak.org 20 Jan '23

20 Jan '23

Marcel Taeumel uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-mt.289.mcz ==================== Summary ==================== Name: ST80-mt.289 Author: mt Time: 20 January 2023, 6:49:19.776382 pm UUID: 9be26961-243c-2649-bb65-e850b7ce8afc Ancestors: ST80-mt.288 Complements System-mt.1385 =============== Diff against ST80-mt.288 =============== Item was added: + ----- Method: StandardSystemView>>extent (in category 'framing compatibility') ----- + extent + + ^ self viewport extent! Item was changed: + ----- Method: StandardSystemView>>initialExtent (in category 'framing compatibility') ----- - ----- Method: StandardSystemView>>initialExtent (in category 'framing') ----- initialExtent "Answer the desired extent for the receiver when it is first opened on the screen. " ^ model initialExtent min: maximumSize max: minimumSize! Item was changed: ----- Method: StandardSystemView>>release (in category 'initialize-release') ----- release + RealEstateAgent rememberExtentFor: model. model windowIsClosing; release. self isCollapsed ifTrue: [savedSubViews do: [:v | v release]]. super release. !

1 0

The Trunk: PreferenceBrowser-mt.155.mcz
by commits＠source.squeak.org 20 Jan '23

20 Jan '23

Marcel Taeumel uploaded a new version of PreferenceBrowser to project The Trunk: http://source.squeak.org/trunk/PreferenceBrowser-mt.155.mcz ==================== Summary ==================== Name: PreferenceBrowser-mt.155 Author: mt Time: 20 January 2023, 6:49:09.406382 pm UUID: 6e676602-7bfe-f846-922f-7dc9b403571f Ancestors: PreferenceBrowser-mt.154 Complements System-mt.1385 =============== Diff against PreferenceBrowser-mt.154 =============== Item was added: + ----- Method: PreferenceBrowser>>initialExtentKey (in category 'initialize-release') ----- + initialExtentKey + + ^ { self class name . title }! Item was changed: ----- Method: PreferenceBrowserMorph>>initializeWithModel: (in category 'initialization') ----- initializeWithModel: aPreferenceBrowser lastKeystrokeTime := 0. lastKeystrokes := ''. self defaultFocusMorph: #search; hResizing: #spaceFill; "Snap #extent to grid if enabled. See #worldGridEnabled." vResizing: #spaceFill; "Snap #extent to grid if enabled. See #worldGridEnabled." model: aPreferenceBrowser; setLabel: self model windowTitle; name: 'PreferenceBrowser'; addMorph: self rootPanel fullFrame: self rootPanelLayoutFrame; addMorph: self newButtonRow fullFrame: self buttonRowLayoutFrame; "Set bounds like the MorphicToolBuilder does when building windows." bounds: (RealEstateAgent initialFrameFor: self + initialExtent: ((RealEstateAgent savedExtentFor: aPreferenceBrowser) + ifNil: [aPreferenceBrowser initialExtent] + ifNotNil: [:initialExtent | (initialExtent * RealEstateAgent scaleFactor) rounded]) - initialExtent: aPreferenceBrowser initialExtent world: self currentWorld).!

1 0

← Newer
1
...
6
7
8
9
10
11
12
...
23
Older →

Jump to page: