This review requests consists of 3 changesets, for each of which I am appending a summary below: - genericDropSourceCode.cs - browse&drop-Monticello.cs - browse&drag-Tools+System.cs tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
Please review & let me know when I can merge it! :D
Best, Christoph
=============== Summary (genericDropSourceCode.cs) ===============
Change Set: genericDropSourceCode Date: 26 January 2022 Author: Christoph Thiede
This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace.
=============== Diff ===============
Object>>browse {*Tools-Browsing} · ct 1/26/2022 21:54 (changed) browse - ToolSet browseClass: self class + ^ ToolSet browseClass: self class
PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} · ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph | (self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode - ifTrue: [^ self dropSourceCode: dropped passenger event: evt]]. + ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. + (dropped passenger isString or: [dropped passenger isText]) + ifTrue: [^ self dropEditable: dropped passenger event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. " self presenter morph: aMorph droppedIntoPasteUpMorph: self." self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos]. self bringTopmostsToFront.
PasteUpMorph>>dropEditable:event: {event handling} · ct 1/27/2022 00:38 + dropEditable: aStringOrText event: evt + + ^ self dropTool: aStringOrText edit event: evt
PasteUpMorph>>dropSourceCode:event: {event handling} · ct 1/27/2022 00:37 (changed) dropSourceCode: anObject event: evt
- (anObject isMethodReference and: [anObject isValid]) - ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt]. - - (anObject isBehavior or: [anObject isCompiledMethod]) - ifTrue: [ - | tool window | - tool := anObject isBehavior - ifTrue: [Browser new - setClass: anObject] - ifFalse: [CodeHolder new - setClass: anObject methodClass - selector: anObject selector]. - window := ToolBuilder open: tool. - window center: evt position. - window bounds: (window bounds translatedToBeWithin: self bounds)]. - - anObject isString - ifTrue: [anObject edit]. + ^ self dropTool: anObject browse event: evt
PasteUpMorph>>dropTool:event: {event handling} · ct 1/27/2022 00:37 + dropTool: tool event: evt + + | window | + tool ifNil: [^ self]. + + window := tool containingWindow ifNil: [ToolBuilder open: tool]. + window center: evt position. + window bounds: (window bounds translatedToBeWithin: self bounds). + ^ window
PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} · ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph
^ self hasTransferMorphConverter or: [transferMorph dragTransferType = #filesAndDirectories] - or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph passenger isString or: [transferMorph passenger isText]]
String>>edit {*toolbuilder-kernel} · ct 1/26/2022 22:13 (changed) edit
- UIManager default edit: self. + ^ Project uiManager edit: self.
SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} · ct 1/26/2022 21:53 (changed) openAsTool "Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor." - + | meOrSimilarWindow | meOrSimilarWindow := self openInWorldExtent: self extent. - (Project uiManager openToolsAttachedToMouseCursor "and: [ | event | - event := self currentEvent. - event isMouse and: [event isMouseUp]]") ifTrue: [ - meOrSimilarWindow setProperty: #initialDrop toValue: true. - meOrSimilarWindow hasDropShadow: false. - self currentHand attachMorph: meOrSimilarWindow]. + (Project uiManager openToolsAttachedToMouseCursor + and: [ | event | + event := self currentEvent. + (event isMouse and: [event isMouseUp]) or: [event isDropEvent]]) + ifTrue: [ + meOrSimilarWindow setProperty: #initialDrop toValue: true. + meOrSimilarWindow hasDropShadow: false. + self currentHand attachMorph: meOrSimilarWindow]. ^ meOrSimilarWindow
Text>>edit {*ToolBuilder-Kernel} · ct 1/26/2022 22:13 (changed) edit
- UIManager default edit: self. + ^ Project uiManager edit: self.
=============== Summary (browse&drop-Monticello.cs) ===============
Change Set: browse&drop-Monticello Date: 27 January 2022 Author: Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too.
As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag:
=============== Diff ===============
MCClassDefinition>>browseVersions {browsing} · ct 1/26/2022 22:59 + browseVersions + + ^ self actualClass browse
MCConfiguration>>browse {actions} · ct 1/26/2022 22:02 (changed) browse | browser | browser := MCConfigurationBrowser new configuration: self copyForEdit. name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm]. - browser show + ^ browser show
MCDefinition>>browseVersions {browsing} · ct 1/26/2022 22:58 + browseVersions + + ^ nil
MCFileBasedRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy - (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) + ^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCMethodDefinition>>actualMethod {accessing} · ct 1/26/2022 22:39 + actualMethod + ^ self actualMethodIn: Environment current
MCMethodDefinition>>actualMethodIn: {accessing} · ct 1/27/2022 00:43 + actualMethodIn: anEnvironment + "Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed." + | class method | + class := (self actualClassIn: anEnvironment) ifNil: [^ nil]. + method := class compiledMethodAt: self selector ifAbsent: [nil]. + (method isNil or: [method timeStamp = self timeStamp]) + ifFalse: [method := (class changeRecordsAt: self selector) + detect: [:record | record stamp = self timeStamp] + ifNone: [nil]]. + ^ method
MCMethodDefinition>>browse {browsing} · ct 1/26/2022 23:00 (changed and recategorized) browse - | browser | - browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}). - browser - categorySelection: 1; - classSelection: 1. - classIsMeta ifTrue: [browser switchBeClass]. - browser - protocolSelection: 1; - methodSelection: 1; - showLabelled: 'Snapshot of ', self summary. - ^ browser + + ^ self actualMethod ifNotNil: [:method | method isCompiledMethod + ifTrue: [method browse] + ifFalse: [self browseVersions]]
MCMethodDefinition>>browseVersions {browsing} · ct 1/26/2022 23:00 + browseVersions + + ^ ToolSet browseVersionsOf: self actualClass selector: self selector
MCOperationsBrowser>>methodAt: {accessing} · ct 1/26/2022 22:53 + methodAt: index + + ^ self items at: index
MCOperationsBrowser>>widgetSpecs {ui} · ct 1/26/2022 22:51 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: text) (0 0.4 1 1)) ) ].
^ #( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0)) )
MCOperationsList>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass items: operations) show + ^ (self browserClass items: operations) show
MCPatch>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass forPatch: self) show + ^ (self browserClass forPatch: self) show
MCPatchOperation>>browse {browsing} · ct 1/26/2022 22:58 + browse + + ^ self definition browseVersions
MCRepository>>browse {user interface} · ct 1/26/2022 22:21 + browse + + ^ self morphicOpen
MCRepository>>morphicOpen {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen - self morphicOpen: nil + ^ self morphicOpen: nil
MCRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy - (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show + ^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCRepositoryInspector>>packageAt: {morphic ui} · ct 1/26/2022 22:24 + packageAt: index + ^ nil
MCRepositoryInspector>>versionAt: {morphic ui} · ct 1/26/2022 22:25 + versionAt: index + + ^ repository versionNamed: (self versionNames at: index)
MCSnapshotBrowser>>categoryAt: {listing} · ct 1/26/2022 22:36 + categoryAt: index + ^ nil
MCSnapshotBrowser>>classAt: {listing} · ct 1/26/2022 22:37 + classAt: index + | className environment | + className := self visibleClasses at: index. + environment := self environmentInDisplayingImage. + ^ environment at: className ifAbsent: + [environment valueOf: className]
MCSnapshotBrowser>>methodAt: {listing} · ct 1/26/2022 22:34 + methodAt: index + ^ self visibleMethods at: index
MCSnapshotBrowser>>protocolAt: {listing} · ct 1/26/2022 22:35 + protocolAt: index + ^ nil
MCSnapshotBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:24 (changed) widgetSpecs
Preferences annotationPanes ifFalse: [ ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((codePane: text) (0 0.4 1 1)) ) ].
^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4))
((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) )
MCTool>>dragType: {morphic ui} · ct 1/26/2022 22:16 + dragType: anObject + + ^ #sourceCode
MCToolWindowBuilder>>listMorph: {building-parts} · ct 1/26/2022 22:19 (changed) listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol - menu: (listSymbol, 'ListMenu:') asSymbol + menu: (listSymbol, 'ListMenu:') asSymbol + keystroke: nil + drag: (listSymbol, 'At:') asSymbol
MCToolWindowBuilder>>listMorph:selection: {building-parts} · ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol - self listMorph: listSymbol selection: selectionSymbol menu: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: nil
MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol - self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol - | list | - list := builder pluggableListSpec new. - list - model: tool; - list: listSymbol; - getIndex: selectionSymbol; - setIndex: (selectionSymbol, ':') asSymbol; - frame: currentFrame. - menuSymbol ifNotNil: [list menu: menuSymbol]. - keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. - window children add: list + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} · ct 1/26/2022 22:27 + listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol + | list | + list := builder pluggableListSpec new. + list + model: tool; + list: listSymbol; + getIndex: selectionSymbol; + setIndex: (selectionSymbol, ':') asSymbol; + frame: currentFrame; + dragItem: dragSymbol; + dragType: #dragType:. + menuSymbol ifNotNil: [list menu: menuSymbol]. + keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. + window children add: list
MCVersion>>browse {actions} · ct 1/27/2022 00:24 (changed) browse - (MCSnapshotBrowser forSnapshot: self snapshot) - label: 'Snapshot of ', self fileName; + ^ (MCSnapshotBrowser forSnapshot: self snapshot) + label: ('Snapshot of {1}' translated format: {self fileName}); show
MCVersionHistoryBrowser>>versionAt: {accessing} · ct 1/27/2022 00:16 + versionAt: index + ^ self repositoryGroup versionWithInfo: (self infos at: index)
MCVersionHistoryBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:16 (changed) widgetSpecs ^ #( - ((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1)) + ((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1)) ((textMorph: summary) (0.3 0 1 1)) )
MCVersionInspector>>browse {accessing} · ct 1/26/2022 22:02 (changed) browse - self version browse + ^ self version browse
MCWorkingCopy>>browse {ui} · ct 1/27/2022 00:25 (changed) browse
- (MCSnapshotBrowser forSnapshot: self package snapshot) - label: 'Snapshot Browser: ', self packageName; - show. + ^ (MCSnapshotBrowser forSnapshot: self package snapshot) + label: ('Snapshot Browser: {1}' translated format: {self packageName}); + show
MCWorkingCopyBrowser>>repositoryAt: {morphic ui} · ct 1/26/2022 22:20 + repositoryAt: index + ^ self repositories at: index
MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} · ct 1/26/2022 22:19 + workingCopyAt: index + ^ self workingCopies at: index
=============== Summary (browse&drag-Tools+System.cs) ===============
Change Set: browse&drag-Tools+System Date: 27 January 2022 Author: Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes.
All affected tools: - Change sorters (single + dual), change set browser - Dependency browser - Package browser - Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse)
=============== Postscript ===============
('accessing' author classChanges classRemoves editPostscript hasPostscript methodChanges methodInfoFromRemoval: name name: numberOfChanges postscriptHasDependents printOn: removePostscript structures superclasses) ('change logging' addClass: changeClass:from: event: noteNewMethod:forClass:selector:priorMethod: removeSelector:class:priorMethod:lastMethodInfo: renameClass:from:to:) ('class changes' changedClassNames changedClasses changedClassesDo: classChangeAt: commentClass: containsClass: fatDefForClass: noteClassForgotten: noteClassStructure: noteRemovalOf: reorganizeClass: trimHistory) ('converting' convertApril2000:using: convertToCurrentVersion:refStream:) ('fileIn/Out' askAddedInstVars: askRemovedInstVars: askRenames:addTo:using: assurePostscriptExists assurePreambleExists buildMessageForMailOutWithUser: checkForAlienAuthorship checkForAnyAlienAuthorship checkForConversionMethods checkForSlips checkForUnclassifiedMethods checkForUncommentedClasses checkForUncommentedMethods checkForUnsentMessages chooseSubjectPrefixForEmail defaultChangeSetDirectory fileOut fileOutChangesFor:on: fileOutOn: fileOutPSFor:on: fileOutPostscriptOn: fileOutPreambleOn: lookForSlips mailOut objectForDataStream: postscript postscriptString postscriptString: postscript: preamble preambleString preambleString: preambleTemplate preamble: setPreambleToSay: summaryString summaryStringDelta: verboseFileOut) ('initialize-release' beIsolationSetFor: clear initialize isMoribund veryDeepCopyWith: wither zapHistory) ('isolation layers' invoke isolatedProject isolationSet: revoke uninstall) ('method changes' adoptSelector:forClass: atSelector:class:put: changedMessageList changedMessageListAugmented changedMethods changedMethodsDo: hasAnyChangeForSelector: messageListForChangesWhich:ifNone: methodChangesAtClass: removeSelectorChanges:class: selectorsInClass:) ('moving changes' absorbClass:from: absorbMethod:class:from: absorbStructureOfClass:from: assimilateAllChangesFoundIn: editPreamble expungeEmptyClassChangeEntries expungeUniclasses forgetAllChangesFoundIn: forgetChangesForClass:in: hasPreamble methodsWithAnyInitialsOtherThan: methodsWithInitialsOtherThan: methodsWithoutComments removeClassAndMetaClassChanges: removeClassChanges: removePreamble) ('testing' belongsToAProject containsMethodAtPosition: correspondingProject isEmpty methodsWithoutClassifications okayToRemove okayToRemoveInforming: projectsBelongedTo) ('private' addCoherency: atClass:add: atClass:includes: atSelector:class: changed:with: changeRecorderFor: fileOutClassDefinition:on: oldNameFor:) ('*Monticello-testing' isForPackageLoad) ('*Etoys-Squeakland-fileIn/Out' checkForSUnit) ('*Tools-Browsing' browse)
=============== Diff ===============
ChangeSet>>browse {*Tools-Browsing} · ct 1/26/2022 22:03 + browse + + ^ ChangeSetBrowser openOn: self
ChangeSorter>>buildChangeSetListWith: {toolbuilder} · ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #changeSetList; getSelected: #currentCngSet; setSelected: #showChangeSetNamed:; menu: #changeSetMenu:shifted:; keyPress: #changeSetListKey:from:; dragItem: #dragChangeSet:; + dragType: #dragTypeForChangeSet:; autoDeselect: false. ^ listSpec
ChangeSorter>>buildClassListWith: {toolbuilder} · ct 1/26/2022 22:06 (changed) buildClassListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #classList; getSelected: #currentClassName; setSelected: #currentClassName:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; - dragItem: #dragClass:. + dragItem: #dragClass:; + dragType: #dragTypeForClass:. ^ listSpec
ChangeSorter>>buildMessageListWith: {toolbuilder} · ct 1/26/2022 22:07 (changed) buildMessageListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getSelected: #currentSelector; setSelected: #currentSelector:; menu: #messageMenu:shifted:; keyPress: #messageListKey:from:; - dragItem: #dragMessage:. + dragItem: #dragMessage:; + dragType: #dragTypeForMessage:. ^ listSpec
ChangeSorter>>dragTypeForChangeSet: {dragging} · ct 1/26/2022 22:04 + dragTypeForChangeSet: anIndex + + ^ #sourceCode
ChangeSorter>>dragTypeForClass: {dragging} · ct 1/26/2022 22:06 + dragTypeForClass: anIndex + + ^ #sourceCode
ChangeSorter>>dragTypeForMessage: {dragging} · ct 1/26/2022 22:06 + dragTypeForMessage: anIndex + + ^ #sourceCode
DependencyBrowser>>buildClassDepsWith: {toolbuilder} · ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Required Classes' ; list: #classDepsList; getIndex: #classDepsIndex; setIndex: #classDepsIndex:; menu: #classDepsMenu:; - keyPress: #classDepsKey:from:. + keyPress: #classDepsKey:from:; + dragItem: #dragFromClassDepAt:; + dragType: #dragTypeForClassDepAt:. ^listSpec
DependencyBrowser>>buildClassListWith: {toolbuilder} · ct 1/27/2022 00:07 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client classes' ; list: #classList; getIndex: #classListIndex; setIndex: #classListIndex:; menu: #classListMenu:; - keyPress: #classListKey:from:. + keyPress: #classListKey:from:; + dragItem: #dragFromClassAt:; + dragType: #dragTypeForClassAt:. ^listSpec
DependencyBrowser>>buildMessageListWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client methods' ; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:; - keyPress: #messageListKey:from:. + keyPress: #messageListKey:from:; + dragItem: #dragFromMessageAt:; + dragType: #dragTypeForMessageAt:. ^listSpec
DependencyBrowser>>buildPackageDepsWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. - listSpec + listSpec model: self; - name: 'Required Packages' ; - list: #packageDepsList; - getIndex: #packageDepsIndex; - setIndex: #packageDepsIndex:; - menu: #packageDepsMenu:; - keyPress: #packageDepsKey:from:. - ^listSpec + name: 'Required Packages'; + list: #packageDepsList; + getIndex: #packageDepsIndex; + setIndex: #packageDepsIndex:; + menu: #packageDepsMenu:; + keyPress: #packageDepsKey:from:; + dragItem: #dragFromPackageDepAt:; + dragType: #dragTypeForPackageDepAt:. + ^ listSpec
DependencyBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:06 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Packages' ; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageListMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec
DependencyBrowser>>dragFromClassAt: {class list} · ct 1/27/2022 00:08 + dragFromClassAt: anInteger + + ^ self environment classNamed: (self classList at: anInteger)
DependencyBrowser>>dragFromClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragFromClassDepAt: anInteger + + ^ self environment classNamed: (self classDeps at: anInteger)
DependencyBrowser>>dragFromMessageAt: {message list} · ct 1/27/2022 00:08 + dragFromMessageAt: anInteger + + ^ self selectedClass >> (self messageList at: anInteger)
DependencyBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:10 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger)
DependencyBrowser>>dragFromPackageDepAt: {package dependencies} · ct 1/27/2022 00:11 + dragFromPackageDepAt: anInteger + + ^ PackageInfo named: (self packageDeps at: anInteger)
DependencyBrowser>>dragTypeForClassAt: {class list} · ct 1/27/2022 00:07 + dragTypeForClassAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragTypeForClassDepAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForMessageAt: {message list} · ct 1/27/2022 00:08 + dragTypeForMessageAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:10 + dragTypeForPackageAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} · ct 1/27/2022 00:09 + dragTypeForPackageDepAt: anInteger + + ^ #sourceCode
PackagePaneBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:11 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: #packageList; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec
PackagePaneBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:12 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger)
PackagePaneBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:11 + dragTypeForPackageAt: anInteger + + ^ #sourceCode
PragmaPreference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse
- ToolSet + ^ ToolSet browse: self provider class - selector: self selectors first. + selector: self selectors first
Preference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse
- ToolSet + ^ ToolSet browse: Preferences class - selector: self selectors first. + selector: self selectors first
--- Sent from Squeak Inbox Talk ["genericDropSourceCode.1.cs"] ["browse&drop-Monticello.1.cs"] ["browse&drag-Tools+System.1.cs"]
On Thu, Jan 27, 2022 at 01:08:37AM +0100, christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/
Dave
Sorry, does this one work for you?
shorturl.at/coHX8http://shorturl.at/coHX8
________________________________ Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von David T. Lewis lewis@mail.msen.com Gesendet: Donnerstag, 27. Januar 2022 01:56:10 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Review Request: genericDropSourceCode.cs & complements
On Thu, Jan 27, 2022 at 01:08:37AM +0100, christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/
Dave
On Thu, Jan 27, 2022 at 01:32:02AM +0000, Thiede, Christoph wrote:
Sorry, does this one work for you?
shorturl.at/coHX8http://shorturl.at/coHX8
Yes, thank you!
Dave
Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von David T. Lewis lewis@mail.msen.com Gesendet: Donnerstag, 27. Januar 2022 01:56:10 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Review Request: genericDropSourceCode.cs & complements
On Thu, Jan 27, 2022 at 01:08:37AM +0100, christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/
Dave
Hi Christoph,
Is this already in trunk? To save Maui, I would've requested waiting for the next release, but it looks like I'm already too late.
Maui users have been dragging classes and methods out to the desktop since 2005 in order to actually *interact with objects*, not open random browsers for developers. It relies on the old way of providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore.
I think it's important that this remains completely generic and overridable to be able to do *anything*. I haven't had time to review it in depth yet, but a quick scan looks like it's coded to expect various IDE "Tools" and "sourceCode", which is a totally different planet than the one Maui wants to be on. Would someone please help me get this working again?
Thanks, Chris
On Wed, Jan 26, 2022 at 8:44 PM Christoph Thiede < christoph.thiede@student.hpi.uni-potsdam.de> wrote:
It's broken again. Here is the long URL:
https://rbm3bw.db.files.1drv.com/y4m4bCMKwvFkmqU7M_T9k764uIhsQlXDr8u8ekr_3d6...
Am 27.01.2022 02:48 schrieb "David T. Lewis" lewis@mail.msen.com:
On Thu, Jan 27, 2022 at 01:32:02AM +0000, Thiede, Christoph wrote:
Sorry, does this one work for you?
shorturl.at/coHX8http://shorturl.at/coHX8
Yes, thank you!
Dave
Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im
Auftrag von David T. Lewis lewis@mail.msen.com
Gesendet: Donnerstag, 27. Januar 2022 01:56:10 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Review Request: genericDropSourceCode.cs &
complements
On Thu, Jan 27, 2022 at 01:08:37AM +0100,
christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am
appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn
a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/
Dave
Hi Chris --
[...] providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore [...]
While Christoph's proposal is not in Trunk, we should fix that issue with the #transferMorphConverter. Currently, PasteUpMorph >> #acceptDroppingMorph:event: is inconsistent with wantsDroppedTransferMorph:. I think that a quick check for #hasTransferMorphConverter will do the trick. Then, both Maui and Vivide can work again as expected. :-)
Best, Marcel Am 28.01.2022 06:00:57 schrieb Chris Muller asqueaker@gmail.com: Hi Christoph,
Is this already in trunk? To save Maui, I would've requested waiting for the next release, but it looks like I'm already too late.
Maui users have been dragging classes and methods out to the desktop since 2005 in order to actually interact with objects, not open random browsers for developers. It relies on the old way of providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore.
I think it's important that this remains completely generic and overridable to be able to do anything. I haven't had time to review it in depth yet, but a quick scan looks like it's coded to expect various IDE "Tools" and "sourceCode", which is a totally different planet than the one Maui wants to be on. Would someone please help me get this working again?
Thanks, Chris
On Wed, Jan 26, 2022 at 8:44 PM Christoph Thiede <christoph.thiede@student.hpi.uni-potsdam.de [mailto:christoph.thiede@student.hpi.uni-potsdam.de]> wrote:
It's broken again. Here is the long URL:
https://rbm3bw.db.files.1drv.com/y4m4bCMKwvFkmqU7M_T9k764uIhsQlXDr8u8ekr_3d6... [https://rbm3bw.db.files.1drv.com/y4m4bCMKwvFkmqU7M_T9k764uIhsQlXDr8u8ekr_3d6...]
Am 27.01.2022 02:48 schrieb "David T. Lewis" <lewis@mail.msen.com [mailto:lewis@mail.msen.com]>:
On Thu, Jan 27, 2022 at 01:32:02AM +0000, Thiede, Christoph wrote:
Sorry, does this one work for you?
shorturl.at/coHX8 [http://shorturl.at/coHX8]<http://shorturl.at/coHX8 [http://shorturl.at/coHX8%5D%3E
Yes, thank you! Dave
Von: Squeak-dev <squeak-dev-bounces@lists.squeakfoundation.org [mailto:squeak-dev-bounces@lists.squeakfoundation.org]> im Auftrag von David T. Lewis <lewis@mail.msen.com [mailto:lewis@mail.msen.com]> Gesendet: Donnerstag, 27. Januar 2022 01:56:10 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Review Request: genericDropSourceCode.cs & complements
On Thu, Jan 27, 2022 at 01:08:37AM +0100, christoph.thiede@student.hpi.uni-potsdam.de [mailto:christoph.thiede@student.hpi.uni-potsdam.de] wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6 [https://shorturl.at/gkwC6]
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/ [https://www.shorturl.at/]
Dave
Fixed via Morphic-mt.1862.
This proposal is to extend the current possibility of dragging and dropping software artifacts from their tools into the world. It also includes support for Monticello tools.
Best, Marcel Am 28.01.2022 08:23:57 schrieb Marcel Taeumel marcel.taeumel@hpi.de: Hi Chris --
[...] providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore [...]
While Christoph's proposal is not in Trunk, we should fix that issue with the #transferMorphConverter. Currently, PasteUpMorph >> #acceptDroppingMorph:event: is inconsistent with wantsDroppedTransferMorph:. I think that a quick check for #hasTransferMorphConverter will do the trick. Then, both Maui and Vivide can work again as expected. :-)
Best, Marcel Am 28.01.2022 06:00:57 schrieb Chris Muller asqueaker@gmail.com: Hi Christoph,
Is this already in trunk? To save Maui, I would've requested waiting for the next release, but it looks like I'm already too late.
Maui users have been dragging classes and methods out to the desktop since 2005 in order to actually interact with objects, not open random browsers for developers. It relies on the old way of providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore.
I think it's important that this remains completely generic and overridable to be able to do anything. I haven't had time to review it in depth yet, but a quick scan looks like it's coded to expect various IDE "Tools" and "sourceCode", which is a totally different planet than the one Maui wants to be on. Would someone please help me get this working again?
Thanks, Chris
On Wed, Jan 26, 2022 at 8:44 PM Christoph Thiede <christoph.thiede@student.hpi.uni-potsdam.de [mailto:christoph.thiede@student.hpi.uni-potsdam.de]> wrote:
It's broken again. Here is the long URL:
https://rbm3bw.db.files.1drv.com/y4m4bCMKwvFkmqU7M_T9k764uIhsQlXDr8u8ekr_3d6... [https://rbm3bw.db.files.1drv.com/y4m4bCMKwvFkmqU7M_T9k764uIhsQlXDr8u8ekr_3d6...]
Am 27.01.2022 02:48 schrieb "David T. Lewis" <lewis@mail.msen.com [mailto:lewis@mail.msen.com]>:
On Thu, Jan 27, 2022 at 01:32:02AM +0000, Thiede, Christoph wrote:
Sorry, does this one work for you?
shorturl.at/coHX8 [http://shorturl.at/coHX8]<http://shorturl.at/coHX8 [http://shorturl.at/coHX8%5D%3E
Yes, thank you! Dave
Von: Squeak-dev <squeak-dev-bounces@lists.squeakfoundation.org [mailto:squeak-dev-bounces@lists.squeakfoundation.org]> im Auftrag von David T. Lewis <lewis@mail.msen.com [mailto:lewis@mail.msen.com]> Gesendet: Donnerstag, 27. Januar 2022 01:56:10 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Review Request: genericDropSourceCode.cs & complements
On Thu, Jan 27, 2022 at 01:08:37AM +0100, christoph.thiede@student.hpi.uni-potsdam.de [mailto:christoph.thiede@student.hpi.uni-potsdam.de] wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6 [https://shorturl.at/gkwC6]
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/ [https://www.shorturl.at/]
Dave
It looks like that fixed it and got me to my next problem, :) thanks!
- Chris
On Fri, Jan 28, 2022 at 1:29 AM Marcel Taeumel marcel.taeumel@hpi.de wrote:
Fixed via Morphic-mt.1862.
This proposal is to extend the current possibility of dragging and dropping software artifacts from their tools into the world. It also includes support for Monticello tools.
Best, Marcel
Am 28.01.2022 08:23:57 schrieb Marcel Taeumel marcel.taeumel@hpi.de:
Hi Chris --
[...] providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore [...]
While Christoph's proposal is not in Trunk, we should fix that issue with the #transferMorphConverter. Currently, PasteUpMorph >> #acceptDroppingMorph:event: is inconsistent with wantsDroppedTransferMorph:. I think that a quick check for #hasTransferMorphConverter will do the trick. Then, both Maui and Vivide can work again as expected. :-)
Best, Marcel
Am 28.01.2022 06:00:57 schrieb Chris Muller asqueaker@gmail.com:
Hi Christoph,
Is this already in trunk? To save Maui, I would've requested waiting for the next release, but it looks like I'm already too late.
Maui users have been dragging classes and methods out to the desktop since 2005 in order to actually interact with objects, not open random browsers for developers. It relies on the old way of providing the world a "transferMorphConverter" to implement this, which I can see is still there, but it's not working anymore.
I think it's important that this remains completely generic and overridable to be able to do anything. I haven't had time to review it in depth yet, but a quick scan looks like it's coded to expect various IDE "Tools" and "sourceCode", which is a totally different planet than the one Maui wants to be on. Would someone please help me get this working again?
Thanks, Chris
On Wed, Jan 26, 2022 at 8:44 PM Christoph Thiede christoph.thiede@student.hpi.uni-potsdam.de wrote:
It's broken again. Here is the long URL:
https://rbm3bw.db.files.1drv.com/y4m4bCMKwvFkmqU7M_T9k764uIhsQlXDr8u8ekr_3d6...
Am 27.01.2022 02:48 schrieb "David T. Lewis" lewis@mail.msen.com:
On Thu, Jan 27, 2022 at 01:32:02AM +0000, Thiede, Christoph wrote:
Sorry, does this one work for you?
shorturl.at/coHX8http://shorturl.at/coHX8
Yes, thank you!
Dave
Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von David T. Lewis lewis@mail.msen.com Gesendet: Donnerstag, 27. Januar 2022 01:56:10 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Review Request: genericDropSourceCode.cs & complements
On Thu, Jan 27, 2022 at 01:08:37AM +0100, christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
This link is not working for me, can you please check it?
The gkwC6 link just takes me back to https://www.shorturl.at/
Dave
Hi all,
here is an updated version that ensures that dropped methods are only opened in a compact CodeHolder rather than a full browser. Thanks to Marcel for the feedback!
To make this possible, PasteUpMorph>>#dropSourceCode:event: now checks whether the droppee understands #browseCompact and sends this message preferably instead of #browse. CompiledMethod and MethodReference implement this new selector and dispatch this via the ToolSet to CodeHolder. Not 100% sure whether the ToolSet abstraction is useful here.
---
Also, here is one more generic thought: With this changeset, we effectively provide the ToolBuilder significantly more information about the object being represented in a list. Thinking of this abstraction rather as a framework than as a libary only, why do we express this information in such a concealed way? If I were to build a new framework, instead of ...
listSpec dragItem: #dragFromPackageAt:; dragType: #dragTypeForPackageAt:
... I would design my spec class to simply understand ...
listSpec itemSourceCode: #packageAt:
... that is, just *inform* the ToolBuilder about the objects we are dealing with and leave it up to the ToolBuilder how to deal with this information, i.e., how to present it to the user or allow them to interact with it. We must not forget that the ToolBuilder is an abstraction from different UI frameworks, and drag'n'drop is just a concrete gesture in a specific framework. This also might be in line with [1] where I'd prefer something like #itemText over handling shortcuts in the model and invoking the Clipboard manually. In the end, new models would not even need to maintain a derived string list but simply provide the ToolBuilder with a) the original list of domain entities and b) an optional string conversion selector. By the way, this is also how we deal with icons and help texts already. Then the only inconveniene remains that currently, the model is made responsible for looking up the item in the list (all the ugly #'...At:' selectors ...).
tl;dr: Do you think it would it be a better idea to abstract from the concrete drag'n'drop gesture and just tell the ToolBuilder about the underlying object instances? We could still keep the existing drag/drop protocol on the pluggable classes for compatibilty reasons and Morphic-specific model implementations.
Best, Christoph
[1] http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-January/218745.h...
=============== Summary (genericDropSourceCode.2.cs) ===============
Change Set: genericDropSourceCode Date: 26 January 2022 Author: Christoph Thiede
This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace.
=============== Postscript ===============
ChangeSorter removeSelector: #open
=============== Diff ===============
CodeHolder>>open {toolbuilder} · ct 1/31/2022 00:18 + open + + ^ ToolBuilder open: self
CompiledMethod>>browseCompact {*Tools-Browsing} · ct 1/31/2022 00:15 + browseCompact + + ^ ToolSet browseMethodCompact: self
MethodReference>>browse {*Tools-Browsing} · ct 9/21/2019 18:01 (changed) browse
^ ToolSet browse: self actualClass selector: self selector
MethodReference>>browseCompact {*Tools-Browsing} · ct 1/31/2022 00:28 + browseCompact + + ^ ToolSet browseCompact: self actualClass selector: self selector
Object>>browse {*Tools-Browsing} · ct 1/26/2022 21:54 (changed) browse - ToolSet browseClass: self class + ^ ToolSet browseClass: self class
PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} · ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph | (self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode - ifTrue: [^ self dropSourceCode: dropped passenger event: evt]]. + ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. + (dropped passenger isString or: [dropped passenger isText]) + ifTrue: [^ self dropEditable: dropped passenger event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. " self presenter morph: aMorph droppedIntoPasteUpMorph: self." self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos]. self bringTopmostsToFront.
PasteUpMorph>>dropEditable:event: {event handling} · ct 1/27/2022 00:38 + dropEditable: aStringOrText event: evt + + ^ self dropTool: aStringOrText edit event: evt
PasteUpMorph>>dropSourceCode:event: {event handling} · ct 1/31/2022 00:21 (changed) dropSourceCode: anObject event: evt
- (anObject isMethodReference and: [anObject isValid]) - ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt]. + | browser | + browser := (anObject respondsTo: #browseCompact) + ifTrue: [anObject browseCompact] + ifFalse: [(anObject respondsTo: #browse) + ifTrue: [anObject browse]]. - (anObject isBehavior or: [anObject isCompiledMethod]) - ifTrue: [ - | tool window | - tool := anObject isBehavior - ifTrue: [Browser new - setClass: anObject] - ifFalse: [CodeHolder new - setClass: anObject methodClass - selector: anObject selector]. - window := ToolBuilder open: tool. - window center: evt position. - window bounds: (window bounds translatedToBeWithin: self bounds)]. - - anObject isString - ifTrue: [anObject edit]. + ^ self dropTool: browser event: evt
PasteUpMorph>>dropTool:event: {event handling} · ct 1/27/2022 00:37 + dropTool: tool event: evt + + | window | + tool ifNil: [^ self]. + + window := tool containingWindow ifNil: [ToolBuilder open: tool]. + window center: evt position. + window bounds: (window bounds translatedToBeWithin: self bounds). + ^ window
PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} · ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph
^ self hasTransferMorphConverter or: [transferMorph dragTransferType = #filesAndDirectories] - or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph passenger isString or: [transferMorph passenger isText]]
StandardToolSet class>>browseCompact:selector: {browsing} · ct 1/31/2022 00:18 + browseCompact: aClass selector: aSymbol + + ^ CodeHolder new + setClass: aClass + selector: aSymbol; + open
StandardToolSet class>>browseMethodCompact: {browsing} · ct 1/31/2022 00:17 + browseMethodCompact: aCompiledMethod + "Open the most convenient compact browser on aCompiledMethod, using a System Browser, a Versions Browser, or an Inspector." + + aCompiledMethod isInstalled + ifTrue: [^ self browseCompact: aCompiledMethod methodClass selector: aCompiledMethod selector]. + ^ self browseMethod: aCompiledMethod
String>>edit {*toolbuilder-kernel} · ct 1/26/2022 22:13 (changed) edit
- UIManager default edit: self. + ^ Project uiManager edit: self.
SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} · ct 1/26/2022 21:53 (changed) openAsTool "Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor." - + | meOrSimilarWindow | meOrSimilarWindow := self openInWorldExtent: self extent. - (Project uiManager openToolsAttachedToMouseCursor "and: [ | event | - event := self currentEvent. - event isMouse and: [event isMouseUp]]") ifTrue: [ - meOrSimilarWindow setProperty: #initialDrop toValue: true. - meOrSimilarWindow hasDropShadow: false. - self currentHand attachMorph: meOrSimilarWindow]. + (Project uiManager openToolsAttachedToMouseCursor + and: [ | event | + event := self currentEvent. + (event isMouse and: [event isMouseUp]) or: [event isDropEvent]]) + ifTrue: [ + meOrSimilarWindow setProperty: #initialDrop toValue: true. + meOrSimilarWindow hasDropShadow: false. + self currentHand attachMorph: meOrSimilarWindow]. ^ meOrSimilarWindow
Text>>edit {*ToolBuilder-Kernel} · ct 1/26/2022 22:13 (changed) edit
- UIManager default edit: self. + ^ Project uiManager edit: self.
ToolSet class>>browseMethod: {browsing} · ct 1/31/2022 00:16 (changed) browseMethod: aCompiledMethod - self default ifNil: [^ self inform: 'Cannot open Browser']. + self default ifNil: [^ self inform: 'Cannot open Browser' translated]. ^ self default browseMethod: aCompiledMethod
ToolSet class>>browseMethodCompact: {browsing} · ct 1/31/2022 00:20 + browseMethodCompact: aCompiledMethod + + self default ifNil: [^ self inform: 'Cannot open Browser' translated]. + ^ self default browseMethodCompact: aCompiledMethod
=============== Summary (browse&drop-Monticello.2.cs) ===============
Change Set: browse&drop-Monticello Date: 27 January 2022 Author: Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too.
As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag:
=============== Diff ===============
MCClassDefinition>>browseVersions {browsing} · ct 1/26/2022 22:59 + browseVersions + + ^ self actualClass browse
MCConfiguration>>browse {actions} · ct 1/26/2022 22:02 (changed) browse | browser | browser := MCConfigurationBrowser new configuration: self copyForEdit. name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm]. - browser show + ^ browser show
MCDefinition>>browseVersions {browsing} · ct 1/26/2022 22:58 + browseVersions + + ^ nil
MCFileBasedRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy - (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) + ^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCMethodDefinition>>actualMethod {accessing} · ct 1/26/2022 22:39 + actualMethod + ^ self actualMethodIn: Environment current
MCMethodDefinition>>actualMethodIn: {accessing} · ct 1/27/2022 00:43 + actualMethodIn: anEnvironment + "Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed." + | class method | + class := (self actualClassIn: anEnvironment) ifNil: [^ nil]. + method := class compiledMethodAt: self selector ifAbsent: [nil]. + (method isNil or: [method timeStamp = self timeStamp]) + ifFalse: [method := (class changeRecordsAt: self selector) + detect: [:record | record stamp = self timeStamp] + ifNone: [nil]]. + ^ method
MCMethodDefinition>>browse {browsing} · ct 1/26/2022 23:00 (changed and recategorized) browse - | browser | - browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}). - browser - categorySelection: 1; - classSelection: 1. - classIsMeta ifTrue: [browser switchBeClass]. - browser - protocolSelection: 1; - methodSelection: 1; - showLabelled: 'Snapshot of ', self summary. - ^ browser + + ^ self actualMethod ifNotNil: [:method | method isCompiledMethod + ifTrue: [method browse] + ifFalse: [self browseVersions]]
MCMethodDefinition>>browseVersions {browsing} · ct 1/26/2022 23:00 + browseVersions + + ^ ToolSet browseVersionsOf: self actualClass selector: self selector
MCOperationsBrowser>>methodAt: {accessing} · ct 1/26/2022 22:53 + methodAt: index + + ^ self items at: index
MCOperationsBrowser>>widgetSpecs {ui} · ct 1/26/2022 22:51 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: text) (0 0.4 1 1)) ) ].
^ #( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0)) )
MCOperationsList>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass items: operations) show + ^ (self browserClass items: operations) show
MCPatch>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass forPatch: self) show + ^ (self browserClass forPatch: self) show
MCPatchOperation>>browse {browsing} · ct 1/26/2022 22:58 + browse + + ^ self definition browseVersions
MCRepository>>browse {user interface} · ct 1/26/2022 22:21 + browse + + ^ self morphicOpen
MCRepository>>morphicOpen {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen - self morphicOpen: nil + ^ self morphicOpen: nil
MCRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy - (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show + ^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCRepositoryInspector>>packageAt: {morphic ui} · ct 1/26/2022 22:24 + packageAt: index + ^ nil
MCRepositoryInspector>>versionAt: {morphic ui} · ct 1/26/2022 22:25 + versionAt: index + + ^ repository versionNamed: (self versionNames at: index)
MCSnapshotBrowser>>categoryAt: {listing} · ct 1/26/2022 22:36 + categoryAt: index + ^ nil
MCSnapshotBrowser>>classAt: {listing} · ct 1/26/2022 22:37 + classAt: index + | className environment | + className := self visibleClasses at: index. + environment := self environmentInDisplayingImage. + ^ environment at: className ifAbsent: + [environment valueOf: className]
MCSnapshotBrowser>>methodAt: {listing} · ct 1/26/2022 22:34 + methodAt: index + ^ self visibleMethods at: index
MCSnapshotBrowser>>protocolAt: {listing} · ct 1/26/2022 22:35 + protocolAt: index + ^ nil
MCSnapshotBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:24 (changed) widgetSpecs
Preferences annotationPanes ifFalse: [ ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((codePane: text) (0 0.4 1 1)) ) ].
^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4))
((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) )
MCTool>>dragType: {morphic ui} · ct 1/26/2022 22:16 + dragType: anObject + + ^ #sourceCode
MCToolWindowBuilder>>listMorph: {building-parts} · ct 1/26/2022 22:19 (changed) listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol - menu: (listSymbol, 'ListMenu:') asSymbol + menu: (listSymbol, 'ListMenu:') asSymbol + keystroke: nil + drag: (listSymbol, 'At:') asSymbol
MCToolWindowBuilder>>listMorph:selection: {building-parts} · ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol - self listMorph: listSymbol selection: selectionSymbol menu: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: nil
MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol - self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol - | list | - list := builder pluggableListSpec new. - list - model: tool; - list: listSymbol; - getIndex: selectionSymbol; - setIndex: (selectionSymbol, ':') asSymbol; - frame: currentFrame. - menuSymbol ifNotNil: [list menu: menuSymbol]. - keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. - window children add: list + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} · ct 1/26/2022 22:27 + listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol + | list | + list := builder pluggableListSpec new. + list + model: tool; + list: listSymbol; + getIndex: selectionSymbol; + setIndex: (selectionSymbol, ':') asSymbol; + frame: currentFrame; + dragItem: dragSymbol; + dragType: #dragType:. + menuSymbol ifNotNil: [list menu: menuSymbol]. + keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. + window children add: list
MCVersion>>browse {actions} · ct 1/27/2022 00:24 (changed) browse - (MCSnapshotBrowser forSnapshot: self snapshot) - label: 'Snapshot of ', self fileName; + ^ (MCSnapshotBrowser forSnapshot: self snapshot) + label: ('Snapshot of {1}' translated format: {self fileName}); show
MCVersionHistoryBrowser>>versionAt: {accessing} · ct 1/27/2022 00:16 + versionAt: index + ^ self repositoryGroup versionWithInfo: (self infos at: index)
MCVersionHistoryBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:16 (changed) widgetSpecs ^ #( - ((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1)) + ((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1)) ((textMorph: summary) (0.3 0 1 1)) )
MCVersionInspector>>browse {accessing} · ct 1/26/2022 22:02 (changed) browse - self version browse + ^ self version browse
MCWorkingCopy>>browse {ui} · ct 1/27/2022 00:25 (changed) browse
- (MCSnapshotBrowser forSnapshot: self package snapshot) - label: 'Snapshot Browser: ', self packageName; - show. + ^ (MCSnapshotBrowser forSnapshot: self package snapshot) + label: ('Snapshot Browser: {1}' translated format: {self packageName}); + show
MCWorkingCopyBrowser>>repositoryAt: {morphic ui} · ct 1/26/2022 22:20 + repositoryAt: index + ^ self repositories at: index
MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} · ct 1/26/2022 22:19 + workingCopyAt: index + ^ self workingCopies at: index
=============== Summary (browse&drag-Tools+System.2.cs) ===============
Change Set: browse&drag-Tools+System Date: 27 January 2022 Author: Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes.
All affected tools: - Change sorters (single + dual), change set browser - Dependency browser - Package browser - Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse)
=============== Postscript ===============
('contents' aboutToStyle: contents:notifying: defineMessageFrom:notifying: selectedMessage) ('toolbuilder' buildClassDepsWith: buildClassListWith: buildMessageListWith: buildPackageDepsWith: buildPackageListWith: buildWith:) ('class list' classList classListIndex classListIndex: classListMenu: classListSelection dragFromClassAt: dragTypeForClassAt: selectPackage: selectedClass selectedClassName selectedClassOrMetaClass) ('package deps') ('message list' dragFromMessageAt: dragTypeForMessageAt: messageList messageListIndex messageListIndex: messageListMenu: messageListSelection selectedMessageName) ('package list' dragFromPackageAt: dragTypeForPackageAt: hasPackageSelected packageList packageList: packageListIndex packageListIndex: packageListKey:from: packageListMenu: packageListSelection selectedPackage selectedPackageName) ('initialize-release' initialize) ('accessing' autoSelectString autoSelectString: contentsSelection referencesToIt: selectedEnvironment windowTitle windowTitle:) ('morphic ui' representsSameBrowseeAs:) ('enumerating' depsForClassNamed:allSatisfy: depsForClassNamed:anySatisfy: depsForClassNamed:do: depsForPackageNamed:allSatisfy: depsForPackageNamed:anySatisfy: depsForPackageNamed:do:) ('class dependencies' classDeps classDepsIndex classDepsIndex: classDepsKey:from: classDepsList classDepsMenu: classDepsSelection dragFromClassDepAt: dragTypeForClassDepAt:) ('private - dependencies' computeClassDependenciesFor: computePackageAndClassDependencies: computePackageDependencies) ('package dependencies' dragFromPackageDepAt: dragTypeForPackageDepAt: packageDeps packageDepsIndex packageDepsIndex: packageDepsList packageDepsMenu: packageDepsSelection)
=============== Diff ===============
ChangeSet>>browse {*Tools-Browsing} · ct 1/26/2022 22:03 + browse + + ^ ChangeSetBrowser openOn: self
ChangeSorter>>buildChangeSetListWith: {toolbuilder} · ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #changeSetList; getSelected: #currentCngSet; setSelected: #showChangeSetNamed:; menu: #changeSetMenu:shifted:; keyPress: #changeSetListKey:from:; dragItem: #dragChangeSet:; + dragType: #dragTypeForChangeSet:; autoDeselect: false. ^ listSpec
ChangeSorter>>buildClassListWith: {toolbuilder} · ct 1/26/2022 22:06 (changed) buildClassListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #classList; getSelected: #currentClassName; setSelected: #currentClassName:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; - dragItem: #dragClass:. + dragItem: #dragClass:; + dragType: #dragTypeForClass:. ^ listSpec
ChangeSorter>>buildMessageListWith: {toolbuilder} · ct 1/26/2022 22:07 (changed) buildMessageListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getSelected: #currentSelector; setSelected: #currentSelector:; menu: #messageMenu:shifted:; keyPress: #messageListKey:from:; - dragItem: #dragMessage:. + dragItem: #dragMessage:; + dragType: #dragTypeForMessage:. ^ listSpec
ChangeSorter>>dragTypeForChangeSet: {dragging} · ct 1/26/2022 22:04 + dragTypeForChangeSet: anIndex + + ^ #sourceCode
ChangeSorter>>dragTypeForClass: {dragging} · ct 1/26/2022 22:06 + dragTypeForClass: anIndex + + ^ #sourceCode
ChangeSorter>>dragTypeForMessage: {dragging} · ct 1/26/2022 22:06 + dragTypeForMessage: anIndex + + ^ #sourceCode
DependencyBrowser>>buildClassDepsWith: {toolbuilder} · ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Required Classes' ; list: #classDepsList; getIndex: #classDepsIndex; setIndex: #classDepsIndex:; menu: #classDepsMenu:; - keyPress: #classDepsKey:from:. + keyPress: #classDepsKey:from:; + dragItem: #dragFromClassDepAt:; + dragType: #dragTypeForClassDepAt:. ^listSpec
DependencyBrowser>>buildClassListWith: {toolbuilder} · ct 1/27/2022 00:07 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client classes' ; list: #classList; getIndex: #classListIndex; setIndex: #classListIndex:; menu: #classListMenu:; - keyPress: #classListKey:from:. + keyPress: #classListKey:from:; + dragItem: #dragFromClassAt:; + dragType: #dragTypeForClassAt:. ^listSpec
DependencyBrowser>>buildMessageListWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client methods' ; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:; - keyPress: #messageListKey:from:. + keyPress: #messageListKey:from:; + dragItem: #dragFromMessageAt:; + dragType: #dragTypeForMessageAt:. ^listSpec
DependencyBrowser>>buildPackageDepsWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. - listSpec + listSpec model: self; - name: 'Required Packages' ; - list: #packageDepsList; - getIndex: #packageDepsIndex; - setIndex: #packageDepsIndex:; - menu: #packageDepsMenu:; - keyPress: #packageDepsKey:from:. - ^listSpec + name: 'Required Packages'; + list: #packageDepsList; + getIndex: #packageDepsIndex; + setIndex: #packageDepsIndex:; + menu: #packageDepsMenu:; + keyPress: #packageDepsKey:from:; + dragItem: #dragFromPackageDepAt:; + dragType: #dragTypeForPackageDepAt:. + ^ listSpec
DependencyBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:06 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Packages' ; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageListMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec
DependencyBrowser>>dragFromClassAt: {class list} · ct 1/27/2022 00:08 + dragFromClassAt: anInteger + + ^ self environment classNamed: (self classList at: anInteger)
DependencyBrowser>>dragFromClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragFromClassDepAt: anInteger + + ^ self environment classNamed: (self classDeps at: anInteger)
DependencyBrowser>>dragFromMessageAt: {message list} · ct 1/27/2022 00:08 + dragFromMessageAt: anInteger + + ^ self selectedClass >> (self messageList at: anInteger)
DependencyBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:10 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger)
DependencyBrowser>>dragFromPackageDepAt: {package dependencies} · ct 1/27/2022 00:11 + dragFromPackageDepAt: anInteger + + ^ PackageInfo named: (self packageDeps at: anInteger)
DependencyBrowser>>dragTypeForClassAt: {class list} · ct 1/27/2022 00:07 + dragTypeForClassAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragTypeForClassDepAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForMessageAt: {message list} · ct 1/27/2022 00:08 + dragTypeForMessageAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:10 + dragTypeForPackageAt: anInteger + + ^ #sourceCode
DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} · ct 1/27/2022 00:09 + dragTypeForPackageDepAt: anInteger + + ^ #sourceCode
PackagePaneBrowser>>buildPackageListWith: {toolbuilder} · ct 1/31/2022 00:24 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: #packageList; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageMenu:; keyPress: #packageListKey:from:. - ^listSpec + Browser browseWithDragNDrop ifTrue: [ + listSpec + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:]. + ^listSpec
PackagePaneBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:12 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger)
PackagePaneBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:11 + dragTypeForPackageAt: anInteger + + ^ #sourceCode
PragmaPreference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse
- ToolSet + ^ ToolSet browse: self provider class - selector: self selectors first. + selector: self selectors first
Preference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse
- ToolSet + ^ ToolSet browse: Preferences class - selector: self selectors first. + selector: self selectors first
--- Sent from Squeak Inbox Talk
On 2022-01-27T01:08:37+01:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
Please review & let me know when I can merge it! :D
Best, Christoph
=============== Summary (genericDropSourceCode.cs) ===============
Change Set:????????genericDropSourceCode Date:????????????26 January 2022 Author:????????????Christoph Thiede
This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace.
=============== Diff ===============
Object>>browse {*Tools-Browsing} ? ct 1/26/2022 21:54 (changed) browse
- ????ToolSet browseClass: self class
- ????^ ToolSet browseClass: self class
PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} ? ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt ????"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
????| aMorph | ????(self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ ????????dropped dragTransferType = #filesAndDirectories ????????????ifTrue: [^ self dropFiles: dropped passenger event: evt]. ????????dropped dragTransferType = #sourceCode
- ????????????ifTrue: [^ self dropSourceCode: dropped passenger event: evt]].
- ????????????ifTrue: [^ self dropSourceCode: dropped passenger event: evt].
- ????????(dropped passenger isString or: [dropped passenger isText])
- ????????????ifTrue: [^ self dropEditable: dropped passenger event: evt]].
???? ????aMorph := self morphToDropFrom: dropped. ????self isWorldMorph ????????ifFalse: [super acceptDroppingMorph: aMorph event: evt] ????????ifTrue: ????????????["Add the given morph to this world and start stepping it if it wants to be." ????????????aMorph isInWorld ifFalse: [aMorph position: evt position]. ????????????self addMorphFront: aMorph. ????????????(aMorph fullBounds intersects: self viewBox) ifFalse: ????????????????[Beeper beep. ????????????????aMorph position: self bounds center]]. ???? ????aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. ????aMorph allMorphsDo: "Establish any penDown morphs in new world" ????????[:m | | tfm mm | ????????m player ifNotNil: ????????????[m player getPenDown ifTrue: ????????????????[((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ????????????????????ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) ????????????????????????????????????forPlayer: m player]]]]. ???? ????self isPartsBin ????????ifTrue: ????????????[aMorph isPartsDonor: true. ????????????aMorph stopSteppingSelfAndSubmorphs. ????????????aMorph suspendEventHandler] ????????ifFalse: ????????????[self world startSteppingSubmorphsOf: aMorph]. ???? "????self presenter morph: aMorph droppedIntoPasteUpMorph: self." ????self showingListView ifTrue: ????????[self sortSubmorphsBy: (self valueOfProperty: #sortOrder). ????????self currentWorld abandonAllHalos]. ???? ????self bringTopmostsToFront.
PasteUpMorph>>dropEditable:event: {event handling} ? ct 1/27/2022 00:38
- dropEditable: aStringOrText event: evt
- ????^ self dropTool: aStringOrText edit event: evt
PasteUpMorph>>dropSourceCode:event: {event handling} ? ct 1/27/2022 00:37 (changed) dropSourceCode: anObject event: evt
- ????(anObject isMethodReference and: [anObject isValid])
- ????????ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt].
- ????
- ????(anObject isBehavior or: [anObject isCompiledMethod])
- ????????ifTrue: [
- ????????????| tool window |
- ????????????tool := anObject isBehavior
- ????????????????ifTrue: [Browser new
- ????????????????????setClass: anObject]
- ????????????????ifFalse: [CodeHolder new
- ????????????????????setClass: anObject methodClass
- ????????????????????selector: anObject selector].
- ????????????window := ToolBuilder open: tool.
- ????????????window center: evt position.
- ????????????window bounds: (window bounds translatedToBeWithin: self bounds)].
- ????
- ????anObject isString
- ????????ifTrue: [anObject edit].
- ????^ self dropTool: anObject browse event: evt
PasteUpMorph>>dropTool:event: {event handling} ? ct 1/27/2022 00:37
- dropTool: tool event: evt
- ????| window |
- ????tool ifNil: [^ self].
- ????
- ????window := tool containingWindow ifNil: [ToolBuilder open: tool].
- ????window center: evt position.
- ????window bounds: (window bounds translatedToBeWithin: self bounds).
- ????^ window
PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} ? ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph
????^ self hasTransferMorphConverter ????????or: [transferMorph dragTransferType = #filesAndDirectories]
- ????????or: [transferMorph dragTransferType = #sourceCode]
- ????????or: [transferMorph dragTransferType = #sourceCode]
- ????????or: [transferMorph passenger isString or: [transferMorph passenger isText]]
String>>edit {*toolbuilder-kernel} ? ct 1/26/2022 22:13 (changed) edit
- ????UIManager default edit: self.
- ????^ Project uiManager edit: self.
SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} ? ct 1/26/2022 21:53 (changed) openAsTool ????"Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor."
- ????
????| meOrSimilarWindow | ????meOrSimilarWindow := self openInWorldExtent: self extent.
- ????(Project uiManager openToolsAttachedToMouseCursor "and: [ | event |
- ????????event := self currentEvent.
- ????????event isMouse and: [event isMouseUp]]") ifTrue: [
- ????????meOrSimilarWindow setProperty: #initialDrop toValue: true.
- ????????meOrSimilarWindow hasDropShadow: false.
- ????????self currentHand attachMorph: meOrSimilarWindow].
- ????(Project uiManager openToolsAttachedToMouseCursor
- ????????and: [ | event |
- ????????????event := self currentEvent.
- ????????????(event isMouse and: [event isMouseUp]) or: [event isDropEvent]])
- ????????????????ifTrue: [
- ????????????????????meOrSimilarWindow setProperty: #initialDrop toValue: true.
- ????????????????????meOrSimilarWindow hasDropShadow: false.
- ????????????????????self currentHand attachMorph: meOrSimilarWindow].
????^ meOrSimilarWindow
Text>>edit {*ToolBuilder-Kernel} ? ct 1/26/2022 22:13 (changed) edit
- ????UIManager default edit: self.
- ????^ Project uiManager edit: self.
=============== Summary (browse&drop-Monticello.cs) ===============
Change Set:????????browse&drop-Monticello Date:????????????27 January 2022 Author:????????????Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too.
As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag:
=============== Diff ===============
MCClassDefinition>>browseVersions {browsing} ? ct 1/26/2022 22:59
- browseVersions
- ????^ self actualClass browse
MCConfiguration>>browse {actions} ? ct 1/26/2022 22:02 (changed) browse ????| browser | ????browser := MCConfigurationBrowser new configuration: self copyForEdit. ????name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm].
- ????browser show
- ????^ browser show
MCDefinition>>browseVersions {browsing} ? ct 1/26/2022 22:58
- browseVersions
- ????^ nil
MCFileBasedRepository>>morphicOpen: {user interface} ? ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy
- ????(MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy)
- ????^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy)
????????show
MCMethodDefinition>>actualMethod {accessing} ? ct 1/26/2022 22:39
- actualMethod
- ????^ self actualMethodIn: Environment current
MCMethodDefinition>>actualMethodIn: {accessing} ? ct 1/27/2022 00:43
- actualMethodIn: anEnvironment
- ????"Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed."
- ????| class method |
- ????class := (self actualClassIn: anEnvironment) ifNil: [^ nil].
- ????method := class compiledMethodAt: self selector ifAbsent: [nil].
- ????(method isNil or: [method timeStamp = self timeStamp])
- ????????ifFalse: [method := (class changeRecordsAt: self selector)
- ????????????detect: [:record | record stamp = self timeStamp]
- ????????????ifNone: [nil]].
- ????^ method
MCMethodDefinition>>browse {browsing} ? ct 1/26/2022 23:00 (changed and recategorized) browse
- ????| browser |
- ????browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}).
- ????browser
- ????????categorySelection: 1;
- ????????classSelection: 1.
- ????classIsMeta ifTrue: [browser switchBeClass].
- ????browser
- ????????protocolSelection: 1;
- ????????methodSelection: 1;
- ????????showLabelled: 'Snapshot of ', self summary.
- ????^ browser
- ????^ self actualMethod ifNotNil: [:method | method isCompiledMethod
- ????????ifTrue: [method browse]
- ????????ifFalse: [self browseVersions]]
MCMethodDefinition>>browseVersions {browsing} ? ct 1/26/2022 23:00
- browseVersions
- ????^ ToolSet browseVersionsOf: self actualClass selector: self selector
MCOperationsBrowser>>methodAt: {accessing} ? ct 1/26/2022 22:53
- methodAt: index
- ????^ self items at: index
MCOperationsBrowser>>widgetSpecs {ui} ? ct 1/26/2022 22:51 (changed) widgetSpecs ????Preferences annotationPanes ifFalse: [ ^#(
- ????????((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
- ????????((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0))
????????((textMorph: text) (0 0.4 1 1)) ????????) ].
????^ #(
- ????????((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
- ????????((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0))
????????((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ????????((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0)) ????)
MCOperationsList>>browse {ui} ? ct 1/26/2022 22:02 (changed) browse
- ????(self browserClass items: operations) show
- ????^ (self browserClass items: operations) show
MCPatch>>browse {ui} ? ct 1/26/2022 22:02 (changed) browse
- ????(self browserClass forPatch: self) show
- ????^ (self browserClass forPatch: self) show
MCPatchOperation>>browse {browsing} ? ct 1/26/2022 22:58
- browse
- ????^ self definition browseVersions
MCRepository>>browse {user interface} ? ct 1/26/2022 22:21
- browse
- ????^ self morphicOpen
MCRepository>>morphicOpen {user interface} ? ct 1/26/2022 22:21 (changed) morphicOpen
- ????self morphicOpen: nil
- ????^ self morphicOpen: nil
MCRepository>>morphicOpen: {user interface} ? ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy
- ????(MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
- ????^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCRepositoryInspector>>packageAt: {morphic ui} ? ct 1/26/2022 22:24
- packageAt: index
- ????^ nil
MCRepositoryInspector>>versionAt: {morphic ui} ? ct 1/26/2022 22:25
- versionAt: index
- ????^ repository versionNamed: (self versionNames at: index)
MCSnapshotBrowser>>categoryAt: {listing} ? ct 1/26/2022 22:36
- categoryAt: index
- ????^ nil
MCSnapshotBrowser>>classAt: {listing} ? ct 1/26/2022 22:37
- classAt: index
- ????| className environment |
- ????className := self visibleClasses at: index.
- ????environment := self environmentInDisplayingImage.
- ????^ environment at: className ifAbsent:
- ????????[environment valueOf: className]
MCSnapshotBrowser>>methodAt: {listing} ? ct 1/26/2022 22:34
- methodAt: index
- ????^ self visibleMethods at: index
MCSnapshotBrowser>>protocolAt: {listing} ? ct 1/26/2022 22:35
- protocolAt: index
- ????^ nil
MCSnapshotBrowser>>widgetSpecs {morphic ui} ? ct 1/27/2022 00:24 (changed) widgetSpecs
????Preferences annotationPanes ifFalse: [ ^#( ????????((listMorph: category) (0 0 0.25 0.4)) ????????((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ????????((listMorph: protocol) (0.50 0 0.75 0.4))
- ????????((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
- ????????((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4))
????????((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ????????((codePane: text) (0 0.4 1 1)) ????????) ].
????^#( ????????((listMorph: category) (0 0 0.25 0.4)) ????????((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ????????((listMorph: protocol) (0.50 0 0.75 0.4))
- ????????((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
- ????????((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4))
????????((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
????????((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ????????((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) ????????)
MCTool>>dragType: {morphic ui} ? ct 1/26/2022 22:16
- dragType: anObject
- ????^ #sourceCode
MCToolWindowBuilder>>listMorph: {building-parts} ? ct 1/26/2022 22:19 (changed) listMorph: listSymbol ????^ self ????????listMorph: (listSymbol, 'List') asSymbol ????????selection: (listSymbol, 'Selection') asSymbol
- ????????menu: (listSymbol, 'ListMenu:') asSymbol
- ????????menu: (listSymbol, 'ListMenu:') asSymbol
- ????????keystroke: nil
- ????????drag: (listSymbol, 'At:') asSymbol
MCToolWindowBuilder>>listMorph:selection: {building-parts} ? ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol
- ????self listMorph: listSymbol selection: selectionSymbol menu: nil
- ????^ self listMorph: listSymbol selection: selectionSymbol menu: nil
MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} ? ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol
- ????self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
- ????^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} ? ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol
- ????| list |
- ????list := builder pluggableListSpec new.
- ????list
- ????????model: tool;
- ????????list: listSymbol;
- ????????getIndex: selectionSymbol;
- ????????setIndex: (selectionSymbol, ':') asSymbol;
- ????????frame: currentFrame.
- ????menuSymbol ifNotNil: [list menu: menuSymbol].
- ????keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol].
- ????window children add: list
- ????^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} ? ct 1/26/2022 22:27
- listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol
- ????| list |
- ????list := builder pluggableListSpec new.
- ????list
- ????????model: tool;
- ????????list: listSymbol;
- ????????getIndex: selectionSymbol;
- ????????setIndex: (selectionSymbol, ':') asSymbol;
- ????????frame: currentFrame;
- ????????dragItem: dragSymbol;
- ????????dragType: #dragType:.
- ????menuSymbol ifNotNil: [list menu: menuSymbol].
- ????keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol].
- ????window children add: list
MCVersion>>browse {actions} ? ct 1/27/2022 00:24 (changed) browse
- ????(MCSnapshotBrowser forSnapshot: self snapshot)
- ????????label: 'Snapshot of ', self fileName;
- ????^ (MCSnapshotBrowser forSnapshot: self snapshot)
- ????????label: ('Snapshot of {1}' translated format: {self fileName});
????????show
MCVersionHistoryBrowser>>versionAt: {accessing} ? ct 1/27/2022 00:16
- versionAt: index
- ????^ self repositoryGroup versionWithInfo: (self infos at: index)
MCVersionHistoryBrowser>>widgetSpecs {morphic ui} ? ct 1/27/2022 00:16 (changed) widgetSpecs ????^ #(
- ????????((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1))
- ????????((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1))
????????((textMorph: summary) (0.3 0 1 1)) ???? ????)
MCVersionInspector>>browse {accessing} ? ct 1/26/2022 22:02 (changed) browse
- ????self version browse
- ????^ self version browse
MCWorkingCopy>>browse {ui} ? ct 1/27/2022 00:25 (changed) browse
- ????(MCSnapshotBrowser forSnapshot: self package snapshot)
- ????????????label: 'Snapshot Browser: ', self packageName;
- ????????????show.
- ????^ (MCSnapshotBrowser forSnapshot: self package snapshot)
- ????????????label: ('Snapshot Browser: {1}' translated format: {self packageName});
- ????????????show
MCWorkingCopyBrowser>>repositoryAt: {morphic ui} ? ct 1/26/2022 22:20
- repositoryAt: index
- ????^ self repositories at: index
MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} ? ct 1/26/2022 22:19
- workingCopyAt: index
- ????^ self workingCopies at: index
=============== Summary (browse&drag-Tools+System.cs) ===============
Change Set:????????browse&drag-Tools+System Date:????????????27 January 2022 Author:????????????Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes.
All affected tools:
- Change sorters (single + dual), change set browser
- Dependency browser
- Package browser
- Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse)
=============== Postscript ===============
('accessing' author classChanges classRemoves editPostscript hasPostscript methodChanges methodInfoFromRemoval: name name: numberOfChanges postscriptHasDependents printOn: removePostscript structures superclasses) ('change logging' addClass: changeClass:from: event: noteNewMethod:forClass:selector:priorMethod: removeSelector:class:priorMethod:lastMethodInfo: renameClass:from:to:) ('class changes' changedClassNames changedClasses changedClassesDo: classChangeAt: commentClass: containsClass: fatDefForClass: noteClassForgotten: noteClassStructure: noteRemovalOf: reorganizeClass: trimHistory) ('converting' convertApril2000:using: convertToCurrentVersion:refStream:) ('fileIn/Out' askAddedInstVars: askRemovedInstVars: askRenames:addTo:using: assurePostscriptExists assurePreambleExists buildMessageForMailOutWithUser: checkForAlienAuthorship checkForAnyAlienAuthorship checkForConversionMethods checkForSlips checkForUnclassifiedMethods checkForUncommentedClasses checkForUncommentedMethods checkForUnsentMessages chooseSubjectPrefixForEmail defaultChangeSetDirectory fileOut fileOutChangesFor:on: fileOutOn: fileOutPSFor:on: fileOutPostscriptOn: fileOutPreambleOn: lookForSlips mailOut objectForDataStream: postscript postscriptString postscriptString: postscript: preamble preambleString preambleString: preambleTemplate preamble: setPreambleToSay: summaryString summaryStringDelta: verboseFileOut) ('initialize-release' beIsolationSetFor: clear initialize isMoribund veryDeepCopyWith: wither zapHistory) ('isolation layers' invoke isolatedProject isolationSet: revoke uninstall) ('method changes' adoptSelector:forClass: atSelector:class:put: changedMessageList changedMessageListAugmented changedMethods changedMethodsDo: hasAnyChangeForSelector: messageListForChangesWhich:ifNone: methodChangesAtClass: removeSelectorChanges:class: selectorsInClass:) ('moving changes' absorbClass:from: absorbMethod:class:from: absorbStructureOfClass:from: assimilateAllChangesFoundIn: editPreamble expungeEmptyClassChangeEntries expungeUniclasses forgetAllChangesFoundIn: forgetChangesForClass:in: hasPreamble methodsWithAnyInitialsOtherThan: methodsWithInitialsOtherThan: methodsWithoutComments removeClassAndMetaClassChanges: removeClassChanges: removePreamble) ('testing' belongsToAProject containsMethodAtPosition: correspondingProject isEmpty methodsWithoutClassifications okayToRemove okayToRemoveInforming: projectsBelongedTo) ('private' addCoherency: atClass:add: atClass:includes: atSelector:class: changed:with: changeRecorderFor: fileOutClassDefinition:on: oldNameFor:) ('*Monticello-testing' isForPackageLoad) ('*Etoys-Squeakland-fileIn/Out' checkForSUnit) ('*Tools-Browsing' browse)
=============== Diff ===============
ChangeSet>>browse {*Tools-Browsing} ? ct 1/26/2022 22:03
- browse
- ????^ ChangeSetBrowser openOn: self
ChangeSorter>>buildChangeSetListWith: {toolbuilder} ? ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder
????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????list: #changeSetList; ????????getSelected: #currentCngSet; ????????setSelected: #showChangeSetNamed:; ????????menu: #changeSetMenu:shifted:; ????????keyPress: #changeSetListKey:from:; ????????dragItem: #dragChangeSet:;
- ????????dragType: #dragTypeForChangeSet:;
????????autoDeselect: false. ????^ listSpec
ChangeSorter>>buildClassListWith: {toolbuilder} ? ct 1/26/2022 22:06 (changed) buildClassListWith: builder
????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????list: #classList; ????????getSelected: #currentClassName; ????????setSelected: #currentClassName:; ????????menu: #classListMenu:shifted:; ????????keyPress: #classListKey:from:;
- ????????dragItem: #dragClass:.
- ????????dragItem: #dragClass:;
- ????????dragType: #dragTypeForClass:.
????^ listSpec
ChangeSorter>>buildMessageListWith: {toolbuilder} ? ct 1/26/2022 22:07 (changed) buildMessageListWith: builder
????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????list: #messageList; ????????getSelected: #currentSelector; ????????setSelected: #currentSelector:; ????????menu: #messageMenu:shifted:; ????????keyPress: #messageListKey:from:;
- ????????dragItem: #dragMessage:.
- ????????dragItem: #dragMessage:;
- ????????dragType: #dragTypeForMessage:.
????^ listSpec
ChangeSorter>>dragTypeForChangeSet: {dragging} ? ct 1/26/2022 22:04
- dragTypeForChangeSet: anIndex
- ????^ #sourceCode
ChangeSorter>>dragTypeForClass: {dragging} ? ct 1/26/2022 22:06
- dragTypeForClass: anIndex
- ????^ #sourceCode
ChangeSorter>>dragTypeForMessage: {dragging} ? ct 1/26/2022 22:06
- dragTypeForMessage: anIndex
- ????^ #sourceCode
DependencyBrowser>>buildClassDepsWith: {toolbuilder} ? ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Required Classes' ; ????????list: #classDepsList; ????????getIndex: #classDepsIndex; ????????setIndex: #classDepsIndex:; ????????menu: #classDepsMenu:;
- ????????keyPress: #classDepsKey:from:.
- ????????keyPress: #classDepsKey:from:;
- ????????dragItem: #dragFromClassDepAt:;
- ????????dragType: #dragTypeForClassDepAt:.
????^listSpec
DependencyBrowser>>buildClassListWith: {toolbuilder} ? ct 1/27/2022 00:07 (changed) buildClassListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Client classes' ; ????????list: #classList; ????????getIndex: #classListIndex; ????????setIndex: #classListIndex:; ????????menu: #classListMenu:;
- ????????keyPress: #classListKey:from:.
- ????????keyPress: #classListKey:from:;
- ????????dragItem: #dragFromClassAt:;
- ????????dragType: #dragTypeForClassAt:.
????^listSpec
DependencyBrowser>>buildMessageListWith: {toolbuilder} ? ct 1/27/2022 00:05 (changed) buildMessageListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Client methods' ; ????????list: #messageList; ????????getIndex: #messageListIndex; ????????setIndex: #messageListIndex:; ????????menu: #messageListMenu:;
- ????????keyPress: #messageListKey:from:.
- ????????keyPress: #messageListKey:from:;
- ????????dragItem: #dragFromMessageAt:;
- ????????dragType: #dragTypeForMessageAt:.
????^listSpec
DependencyBrowser>>buildPackageDepsWith: {toolbuilder} ? ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new.
- ????listSpec
- ????listSpec
????????model: self;
- ????????name: 'Required Packages' ;
- ????????list: #packageDepsList;
- ????????getIndex: #packageDepsIndex;
- ????????setIndex: #packageDepsIndex:;
- ????????menu: #packageDepsMenu:;
- ????????keyPress: #packageDepsKey:from:.
- ????^listSpec
- ????????name: 'Required Packages';
- ????????list: #packageDepsList;
- ????????getIndex: #packageDepsIndex;
- ????????setIndex: #packageDepsIndex:;
- ????????menu: #packageDepsMenu:;
- ????????keyPress: #packageDepsKey:from:;
- ????????dragItem: #dragFromPackageDepAt:;
- ????????dragType: #dragTypeForPackageDepAt:.
- ????^ listSpec
DependencyBrowser>>buildPackageListWith: {toolbuilder} ? ct 1/27/2022 00:06 (changed) buildPackageListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Packages' ; ????????list: #packageList; ????????getIndex: #packageListIndex; ????????setIndex: #packageListIndex:; ????????menu: #packageListMenu:;
- ????????keyPress: #packageListKey:from:.
- ????????keyPress: #packageListKey:from:;
- ????????dragItem: #dragFromPackageAt:;
- ????????dragType: #dragTypeForPackageAt:.
????^listSpec
DependencyBrowser>>dragFromClassAt: {class list} ? ct 1/27/2022 00:08
- dragFromClassAt: anInteger
- ????^ self environment classNamed: (self classList at: anInteger)
DependencyBrowser>>dragFromClassDepAt: {class dependencies} ? ct 1/27/2022 00:04
- dragFromClassDepAt: anInteger
- ????^ self environment classNamed: (self classDeps at: anInteger)
DependencyBrowser>>dragFromMessageAt: {message list} ? ct 1/27/2022 00:08
- dragFromMessageAt: anInteger
- ????^ self selectedClass >> (self messageList at: anInteger)
DependencyBrowser>>dragFromPackageAt: {package list} ? ct 1/27/2022 00:10
- dragFromPackageAt: anInteger
- ????^ PackageInfo named: (self packageList at: anInteger)
DependencyBrowser>>dragFromPackageDepAt: {package dependencies} ? ct 1/27/2022 00:11
- dragFromPackageDepAt: anInteger
- ????^ PackageInfo named: (self packageDeps at: anInteger)
DependencyBrowser>>dragTypeForClassAt: {class list} ? ct 1/27/2022 00:07
- dragTypeForClassAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} ? ct 1/27/2022 00:04
- dragTypeForClassDepAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForMessageAt: {message list} ? ct 1/27/2022 00:08
- dragTypeForMessageAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForPackageAt: {package list} ? ct 1/27/2022 00:10
- dragTypeForPackageAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} ? ct 1/27/2022 00:09
- dragTypeForPackageDepAt: anInteger
- ????^ #sourceCode
PackagePaneBrowser>>buildPackageListWith: {toolbuilder} ? ct 1/27/2022 00:11 (changed) buildPackageListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: #packageList; ????????list: #packageList; ????????getIndex: #packageListIndex; ????????setIndex: #packageListIndex:; ????????menu: #packageMenu:;
- ????????keyPress: #packageListKey:from:.
- ????????keyPress: #packageListKey:from:;
- ????????dragItem: #dragFromPackageAt:;
- ????????dragType: #dragTypeForPackageAt:.
????^listSpec
PackagePaneBrowser>>dragFromPackageAt: {package list} ? ct 1/27/2022 00:12
- dragFromPackageAt: anInteger
- ????^ PackageInfo named: (self packageList at: anInteger)
PackagePaneBrowser>>dragTypeForPackageAt: {package list} ? ct 1/27/2022 00:11
- dragTypeForPackageAt: anInteger
- ????^ #sourceCode
PragmaPreference>>browse {browsing} ? ct 1/26/2022 22:02 (changed) browse
- ????ToolSet
- ????^ ToolSet
????????browse: self provider class
- ????????selector: self selectors first.
- ????????selector: self selectors first
Preference>>browse {browsing} ? ct 1/26/2022 22:02 (changed) browse
- ????ToolSet
- ????^ ToolSet
????????browse: Preferences class
- ????????selector: self selectors first.
- ????????selector: self selectors first
Sent from Squeak Inbox Talk ["genericDropSourceCode.1.cs"] ["browse&drop-Monticello.1.cs"] ["browse&drag-Tools+System.1.cs"]
Hi Christoph,
I'm not sure if these commits are the cause of this, but it seems possible enough.
Dragging a messageName (method list item) from the right-most pane of a browser is a feature that has existed for some time, as I'm sure you know. It used to be that one could "cancel" the drag by returning the drag to its original source pane and releasing the mouse button. (I recall this would 'repel' the dragged morph and make the 'garbage can' sound, one of those cute Morphic animations.)
But now in 6.0beta-21848 (and earlier?), letting go of the drag with the pointer over the original position instead opens up a new window with a message list browser on the item that is no longer being dragged. I have uploading a screen recording here:
and created a GitHub issue here:
https://github.com/squeak-smalltalk/squeak-object-memory/issues/34
Can the previous behavior of canceling the drag and repelling the morph be resurrected? Or at least not open a window when the morph lands where it began.
Thanks, Tim J
On Jan 30, 2022, at 4:02 PM, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Hi all,
here is an updated version that ensures that dropped methods are only opened in a compact CodeHolder rather than a full browser. Thanks to Marcel for the feedback!
To make this possible, PasteUpMorph>>#dropSourceCode:event: now checks whether the droppee understands #browseCompact and sends this message preferably instead of #browse. CompiledMethod and MethodReference implement this new selector and dispatch this via the ToolSet to CodeHolder. Not 100% sure whether the ToolSet abstraction is useful here.
Also, here is one more generic thought: With this changeset, we effectively provide the ToolBuilder significantly more information about the object being represented in a list. Thinking of this abstraction rather as a framework than as a libary only, why do we express this information in such a concealed way? If I were to build a new framework, instead of ...
listSpec dragItem: #dragFromPackageAt:; dragType: #dragTypeForPackageAt:
... I would design my spec class to simply understand ...
listSpec itemSourceCode: #packageAt:
... that is, just *inform* the ToolBuilder about the objects we are dealing with and leave it up to the ToolBuilder how to deal with this information, i.e., how to present it to the user or allow them to interact with it. We must not forget that the ToolBuilder is an abstraction from different UI frameworks, and drag'n'drop is just a concrete gesture in a specific framework. This also might be in line with [1] where I'd prefer something like #itemText over handling shortcuts in the model and invoking the Clipboard manually. In the end, new models would not even need to maintain a derived string list but simply provide the ToolBuilder with a) the original list of domain entities and b) an optional string conversion selector. By the way, this is also how we deal with icons and help texts already. Then the only inconveniene remains that currently, the model is made responsible for looking up the item in the list (all the ugly #'...At:' selectors ...).
tl;dr: Do you think it would it be a better idea to abstract from the concrete drag'n'drop gesture and just tell the ToolBuilder about the underlying object instances? We could still keep the existing drag/drop protocol on the pluggable classes for compatibilty reasons and Morphic-specific model implementations.
Best, Christoph
[1] http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-January/218745.h... http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-January/218745.html
=============== Summary (genericDropSourceCode.2.cs) ===============
Change Set: genericDropSourceCode Date: 26 January 2022 Author: Christoph Thiede
This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace.
=============== Postscript ===============
ChangeSorter removeSelector: #open
=============== Diff ===============
CodeHolder>>open {toolbuilder} · ct 1/31/2022 00:18
- open
^ ToolBuilder open: self
CompiledMethod>>browseCompact {*Tools-Browsing} · ct 1/31/2022 00:15
- browseCompact
^ ToolSet browseMethodCompact: self
MethodReference>>browse {*Tools-Browsing} · ct 9/21/2019 18:01 (changed) browse
^ ToolSet browse: self actualClass selector: self selector
MethodReference>>browseCompact {*Tools-Browsing} · ct 1/31/2022 00:28
- browseCompact
^ ToolSet browseCompact: self actualClass selector: self selector
Object>>browse {*Tools-Browsing} · ct 1/26/2022 21:54 (changed) browse
ToolSet browseClass: self class
^ ToolSet browseClass: self class
PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} · ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
| aMorph | (self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode
ifTrue: [^ self dropSourceCode: dropped passenger event: evt]].
ifTrue: [^ self dropSourceCode: dropped passenger event: evt].
(dropped passenger isString or: [dropped passenger isText])
ifTrue: [^ self dropEditable: dropped passenger event: evt]].
aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]].
aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]].
self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph].
" self presenter morph: aMorph droppedIntoPasteUpMorph: self." self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos].
self bringTopmostsToFront.
PasteUpMorph>>dropEditable:event: {event handling} · ct 1/27/2022 00:38
- dropEditable: aStringOrText event: evt
^ self dropTool: aStringOrText edit event: evt
PasteUpMorph>>dropSourceCode:event: {event handling} · ct 1/31/2022 00:21 (changed) dropSourceCode: anObject event: evt
(anObject isMethodReference and: [anObject isValid])
ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt].
| browser |
browser := (anObject respondsTo: #browseCompact)
ifTrue: [anObject browseCompact]
ifFalse: [(anObject respondsTo: #browse)
ifTrue: [anObject browse]].
(anObject isBehavior or: [anObject isCompiledMethod])
ifTrue: [
| tool window |
tool := anObject isBehavior
ifTrue: [Browser new
setClass: anObject]
ifFalse: [CodeHolder new
setClass: anObject methodClass
selector: anObject selector].
window := ToolBuilder open: tool.
window center: evt position.
window bounds: (window bounds translatedToBeWithin: self bounds)].
anObject isString
ifTrue: [anObject edit].
^ self dropTool: browser event: evt
PasteUpMorph>>dropTool:event: {event handling} · ct 1/27/2022 00:37
- dropTool: tool event: evt
| window |
tool ifNil: [^ self].
window := tool containingWindow ifNil: [ToolBuilder open: tool].
window center: evt position.
window bounds: (window bounds translatedToBeWithin: self bounds).
^ window
PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} · ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph
^ self hasTransferMorphConverter or: [transferMorph dragTransferType = #filesAndDirectories]
or: [transferMorph dragTransferType = #sourceCode]
or: [transferMorph dragTransferType = #sourceCode]
or: [transferMorph passenger isString or: [transferMorph passenger isText]]
StandardToolSet class>>browseCompact:selector: {browsing} · ct 1/31/2022 00:18
- browseCompact: aClass selector: aSymbol
^ CodeHolder new
setClass: aClass
selector: aSymbol;
open
StandardToolSet class>>browseMethodCompact: {browsing} · ct 1/31/2022 00:17
- browseMethodCompact: aCompiledMethod
"Open the most convenient compact browser on aCompiledMethod, using a System Browser, a Versions Browser, or an Inspector."
aCompiledMethod isInstalled
ifTrue: [^ self browseCompact: aCompiledMethod methodClass selector: aCompiledMethod selector].
^ self browseMethod: aCompiledMethod
String>>edit {*toolbuilder-kernel} · ct 1/26/2022 22:13 (changed) edit
UIManager default edit: self.
^ Project uiManager edit: self.
SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} · ct 1/26/2022 21:53 (changed) openAsTool "Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor."
- | meOrSimilarWindow | meOrSimilarWindow := self openInWorldExtent: self extent.
(Project uiManager openToolsAttachedToMouseCursor "and: [ | event |
event := self currentEvent.
event isMouse and: [event isMouseUp]]") ifTrue: [
meOrSimilarWindow setProperty: #initialDrop toValue: true.
meOrSimilarWindow hasDropShadow: false.
self currentHand attachMorph: meOrSimilarWindow].
(Project uiManager openToolsAttachedToMouseCursor
and: [ | event |
event := self currentEvent.
(event isMouse and: [event isMouseUp]) or: [event isDropEvent]])
ifTrue: [
meOrSimilarWindow setProperty: #initialDrop toValue: true.
meOrSimilarWindow hasDropShadow: false.
^ meOrSimilarWindowself currentHand attachMorph: meOrSimilarWindow].
Text>>edit {*ToolBuilder-Kernel} · ct 1/26/2022 22:13 (changed) edit
UIManager default edit: self.
^ Project uiManager edit: self.
ToolSet class>>browseMethod: {browsing} · ct 1/31/2022 00:16 (changed) browseMethod: aCompiledMethod
self default ifNil: [^ self inform: 'Cannot open Browser'].
^ self default browseMethod: aCompiledMethodself default ifNil: [^ self inform: 'Cannot open Browser' translated].
ToolSet class>>browseMethodCompact: {browsing} · ct 1/31/2022 00:20
- browseMethodCompact: aCompiledMethod
self default ifNil: [^ self inform: 'Cannot open Browser' translated].
^ self default browseMethodCompact: aCompiledMethod
=============== Summary (browse&drop-Monticello.2.cs) ===============
Change Set: browse&drop-Monticello Date: 27 January 2022 Author: Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too.
As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag:
=============== Diff ===============
MCClassDefinition>>browseVersions {browsing} · ct 1/26/2022 22:59
- browseVersions
^ self actualClass browse
MCConfiguration>>browse {actions} · ct 1/26/2022 22:02 (changed) browse | browser | browser := MCConfigurationBrowser new configuration: self copyForEdit. name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm].
browser show
^ browser show
MCDefinition>>browseVersions {browsing} · ct 1/26/2022 22:58
- browseVersions
^ nil
MCFileBasedRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy
(MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy)
^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCMethodDefinition>>actualMethod {accessing} · ct 1/26/2022 22:39
- actualMethod
^ self actualMethodIn: Environment current
MCMethodDefinition>>actualMethodIn: {accessing} · ct 1/27/2022 00:43
- actualMethodIn: anEnvironment
"Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed."
| class method |
class := (self actualClassIn: anEnvironment) ifNil: [^ nil].
method := class compiledMethodAt: self selector ifAbsent: [nil].
(method isNil or: [method timeStamp = self timeStamp])
ifFalse: [method := (class changeRecordsAt: self selector)
detect: [:record | record stamp = self timeStamp]
ifNone: [nil]].
^ method
MCMethodDefinition>>browse {browsing} · ct 1/26/2022 23:00 (changed and recategorized) browse
| browser |
browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}).
browser
categorySelection: 1;
classSelection: 1.
classIsMeta ifTrue: [browser switchBeClass].
browser
protocolSelection: 1;
methodSelection: 1;
showLabelled: 'Snapshot of ', self summary.
^ browser
^ self actualMethod ifNotNil: [:method | method isCompiledMethod
ifTrue: [method browse]
ifFalse: [self browseVersions]]
MCMethodDefinition>>browseVersions {browsing} · ct 1/26/2022 23:00
- browseVersions
^ ToolSet browseVersionsOf: self actualClass selector: self selector
MCOperationsBrowser>>methodAt: {accessing} · ct 1/26/2022 22:53
- methodAt: index
^ self items at: index
MCOperationsBrowser>>widgetSpecs {ui} · ct 1/26/2022 22:51 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#(
((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: text) (0 0.4 1 1)) ) ].
^ #(
((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
)((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0))
MCOperationsList>>browse {ui} · ct 1/26/2022 22:02 (changed) browse
(self browserClass items: operations) show
^ (self browserClass items: operations) show
MCPatch>>browse {ui} · ct 1/26/2022 22:02 (changed) browse
(self browserClass forPatch: self) show
^ (self browserClass forPatch: self) show
MCPatchOperation>>browse {browsing} · ct 1/26/2022 22:58
- browse
^ self definition browseVersions
MCRepository>>browse {user interface} · ct 1/26/2022 22:21
- browse
^ self morphicOpen
MCRepository>>morphicOpen {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen
self morphicOpen: nil
^ self morphicOpen: nil
MCRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy
(MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCRepositoryInspector>>packageAt: {morphic ui} · ct 1/26/2022 22:24
- packageAt: index
^ nil
MCRepositoryInspector>>versionAt: {morphic ui} · ct 1/26/2022 22:25
- versionAt: index
^ repository versionNamed: (self versionNames at: index)
MCSnapshotBrowser>>categoryAt: {listing} · ct 1/26/2022 22:36
- categoryAt: index
^ nil
MCSnapshotBrowser>>classAt: {listing} · ct 1/26/2022 22:37
- classAt: index
| className environment |
className := self visibleClasses at: index.
environment := self environmentInDisplayingImage.
^ environment at: className ifAbsent:
[environment valueOf: className]
MCSnapshotBrowser>>methodAt: {listing} · ct 1/26/2022 22:34
- methodAt: index
^ self visibleMethods at: index
MCSnapshotBrowser>>protocolAt: {listing} · ct 1/26/2022 22:35
- protocolAt: index
^ nil
MCSnapshotBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:24 (changed) widgetSpecs
Preferences annotationPanes ifFalse: [ ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4))
((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((codePane: text) (0 0.4 1 1)) ) ].
^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4))
((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) )
MCTool>>dragType: {morphic ui} · ct 1/26/2022 22:16
- dragType: anObject
^ #sourceCode
MCToolWindowBuilder>>listMorph: {building-parts} · ct 1/26/2022 22:19 (changed) listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol
menu: (listSymbol, 'ListMenu:') asSymbol
menu: (listSymbol, 'ListMenu:') asSymbol
keystroke: nil
drag: (listSymbol, 'At:') asSymbol
MCToolWindowBuilder>>listMorph:selection: {building-parts} · ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol
self listMorph: listSymbol selection: selectionSymbol menu: nil
^ self listMorph: listSymbol selection: selectionSymbol menu: nil
MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol
self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol
| list |
list := builder pluggableListSpec new.
list
model: tool;
list: listSymbol;
getIndex: selectionSymbol;
setIndex: (selectionSymbol, ':') asSymbol;
frame: currentFrame.
menuSymbol ifNotNil: [list menu: menuSymbol].
keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol].
window children add: list
^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} · ct 1/26/2022 22:27
- listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol
| list |
list := builder pluggableListSpec new.
list
model: tool;
list: listSymbol;
getIndex: selectionSymbol;
setIndex: (selectionSymbol, ':') asSymbol;
frame: currentFrame;
dragItem: dragSymbol;
dragType: #dragType:.
menuSymbol ifNotNil: [list menu: menuSymbol].
keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol].
window children add: list
MCVersion>>browse {actions} · ct 1/27/2022 00:24 (changed) browse
(MCSnapshotBrowser forSnapshot: self snapshot)
label: 'Snapshot of ', self fileName;
^ (MCSnapshotBrowser forSnapshot: self snapshot)
label: ('Snapshot of {1}' translated format: {self fileName}); show
MCVersionHistoryBrowser>>versionAt: {accessing} · ct 1/27/2022 00:16
- versionAt: index
^ self repositoryGroup versionWithInfo: (self infos at: index)
MCVersionHistoryBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:16 (changed) widgetSpecs ^ #(
((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1))
((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1)) ((textMorph: summary) (0.3 0 1 1)) )
MCVersionInspector>>browse {accessing} · ct 1/26/2022 22:02 (changed) browse
self version browse
^ self version browse
MCWorkingCopy>>browse {ui} · ct 1/27/2022 00:25 (changed) browse
(MCSnapshotBrowser forSnapshot: self package snapshot)
label: 'Snapshot Browser: ', self packageName;
show.
^ (MCSnapshotBrowser forSnapshot: self package snapshot)
label: ('Snapshot Browser: {1}' translated format: {self packageName});
show
MCWorkingCopyBrowser>>repositoryAt: {morphic ui} · ct 1/26/2022 22:20
- repositoryAt: index
^ self repositories at: index
MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} · ct 1/26/2022 22:19
- workingCopyAt: index
^ self workingCopies at: index
=============== Summary (browse&drag-Tools+System.2.cs) ===============
Change Set: browse&drag-Tools+System Date: 27 January 2022 Author: Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes.
All affected tools:
- Change sorters (single + dual), change set browser
- Dependency browser
- Package browser
- Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse)
=============== Postscript ===============
('contents' aboutToStyle: contents:notifying: defineMessageFrom:notifying: selectedMessage) ('toolbuilder' buildClassDepsWith: buildClassListWith: buildMessageListWith: buildPackageDepsWith: buildPackageListWith: buildWith:) ('class list' classList classListIndex classListIndex: classListMenu: classListSelection dragFromClassAt: dragTypeForClassAt: selectPackage: selectedClass selectedClassName selectedClassOrMetaClass) ('package deps') ('message list' dragFromMessageAt: dragTypeForMessageAt: messageList messageListIndex messageListIndex: messageListMenu: messageListSelection selectedMessageName) ('package list' dragFromPackageAt: dragTypeForPackageAt: hasPackageSelected packageList packageList: packageListIndex packageListIndex: packageListKey:from: packageListMenu: packageListSelection selectedPackage selectedPackageName) ('initialize-release' initialize) ('accessing' autoSelectString autoSelectString: contentsSelection referencesToIt: selectedEnvironment windowTitle windowTitle:) ('morphic ui' representsSameBrowseeAs:) ('enumerating' depsForClassNamed:allSatisfy: depsForClassNamed:anySatisfy: depsForClassNamed:do: depsForPackageNamed:allSatisfy: depsForPackageNamed:anySatisfy: depsForPackageNamed:do:) ('class dependencies' classDeps classDepsIndex classDepsIndex: classDepsKey:from: classDepsList classDepsMenu: classDepsSelection dragFromClassDepAt: dragTypeForClassDepAt:) ('private - dependencies' computeClassDependenciesFor: computePackageAndClassDependencies: computePackageDependencies) ('package dependencies' dragFromPackageDepAt: dragTypeForPackageDepAt: packageDeps packageDepsIndex packageDepsIndex: packageDepsList packageDepsMenu: packageDepsSelection)
=============== Diff ===============
ChangeSet>>browse {*Tools-Browsing} · ct 1/26/2022 22:03
- browse
^ ChangeSetBrowser openOn: self
ChangeSorter>>buildChangeSetListWith: {toolbuilder} · ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #changeSetList; getSelected: #currentCngSet; setSelected: #showChangeSetNamed:; menu: #changeSetMenu:shifted:; keyPress: #changeSetListKey:from:; dragItem: #dragChangeSet:;
^ listSpecdragType: #dragTypeForChangeSet:; autoDeselect: false.
ChangeSorter>>buildClassListWith: {toolbuilder} · ct 1/26/2022 22:06 (changed) buildClassListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #classList; getSelected: #currentClassName; setSelected: #currentClassName:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:;
dragItem: #dragClass:.
dragItem: #dragClass:;
^ listSpecdragType: #dragTypeForClass:.
ChangeSorter>>buildMessageListWith: {toolbuilder} · ct 1/26/2022 22:07 (changed) buildMessageListWith: builder
| listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getSelected: #currentSelector; setSelected: #currentSelector:; menu: #messageMenu:shifted:; keyPress: #messageListKey:from:;
dragItem: #dragMessage:.
dragItem: #dragMessage:;
^ listSpecdragType: #dragTypeForMessage:.
ChangeSorter>>dragTypeForChangeSet: {dragging} · ct 1/26/2022 22:04
- dragTypeForChangeSet: anIndex
^ #sourceCode
ChangeSorter>>dragTypeForClass: {dragging} · ct 1/26/2022 22:06
- dragTypeForClass: anIndex
^ #sourceCode
ChangeSorter>>dragTypeForMessage: {dragging} · ct 1/26/2022 22:06
- dragTypeForMessage: anIndex
^ #sourceCode
DependencyBrowser>>buildClassDepsWith: {toolbuilder} · ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Required Classes' ; list: #classDepsList; getIndex: #classDepsIndex; setIndex: #classDepsIndex:; menu: #classDepsMenu:;
keyPress: #classDepsKey:from:.
keyPress: #classDepsKey:from:;
dragItem: #dragFromClassDepAt:;
^listSpecdragType: #dragTypeForClassDepAt:.
DependencyBrowser>>buildClassListWith: {toolbuilder} · ct 1/27/2022 00:07 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client classes' ; list: #classList; getIndex: #classListIndex; setIndex: #classListIndex:; menu: #classListMenu:;
keyPress: #classListKey:from:.
keyPress: #classListKey:from:;
dragItem: #dragFromClassAt:;
^listSpecdragType: #dragTypeForClassAt:.
DependencyBrowser>>buildMessageListWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client methods' ; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:;
keyPress: #messageListKey:from:.
keyPress: #messageListKey:from:;
dragItem: #dragFromMessageAt:;
^listSpecdragType: #dragTypeForMessageAt:.
DependencyBrowser>>buildPackageDepsWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new.
listSpec
listSpec model: self;
name: 'Required Packages' ;
list: #packageDepsList;
getIndex: #packageDepsIndex;
setIndex: #packageDepsIndex:;
menu: #packageDepsMenu:;
keyPress: #packageDepsKey:from:.
^listSpec
name: 'Required Packages';
list: #packageDepsList;
getIndex: #packageDepsIndex;
setIndex: #packageDepsIndex:;
menu: #packageDepsMenu:;
keyPress: #packageDepsKey:from:;
dragItem: #dragFromPackageDepAt:;
dragType: #dragTypeForPackageDepAt:.
^ listSpec
DependencyBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:06 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Packages' ; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageListMenu:;
keyPress: #packageListKey:from:.
keyPress: #packageListKey:from:;
dragItem: #dragFromPackageAt:;
^listSpecdragType: #dragTypeForPackageAt:.
DependencyBrowser>>dragFromClassAt: {class list} · ct 1/27/2022 00:08
- dragFromClassAt: anInteger
^ self environment classNamed: (self classList at: anInteger)
DependencyBrowser>>dragFromClassDepAt: {class dependencies} · ct 1/27/2022 00:04
- dragFromClassDepAt: anInteger
^ self environment classNamed: (self classDeps at: anInteger)
DependencyBrowser>>dragFromMessageAt: {message list} · ct 1/27/2022 00:08
- dragFromMessageAt: anInteger
^ self selectedClass >> (self messageList at: anInteger)
DependencyBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:10
- dragFromPackageAt: anInteger
^ PackageInfo named: (self packageList at: anInteger)
DependencyBrowser>>dragFromPackageDepAt: {package dependencies} · ct 1/27/2022 00:11
- dragFromPackageDepAt: anInteger
^ PackageInfo named: (self packageDeps at: anInteger)
DependencyBrowser>>dragTypeForClassAt: {class list} · ct 1/27/2022 00:07
- dragTypeForClassAt: anInteger
^ #sourceCode
DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} · ct 1/27/2022 00:04
- dragTypeForClassDepAt: anInteger
^ #sourceCode
DependencyBrowser>>dragTypeForMessageAt: {message list} · ct 1/27/2022 00:08
- dragTypeForMessageAt: anInteger
^ #sourceCode
DependencyBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:10
- dragTypeForPackageAt: anInteger
^ #sourceCode
DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} · ct 1/27/2022 00:09
- dragTypeForPackageDepAt: anInteger
^ #sourceCode
PackagePaneBrowser>>buildPackageListWith: {toolbuilder} · ct 1/31/2022 00:24 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: #packageList; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageMenu:; keyPress: #packageListKey:from:.
^listSpec
Browser browseWithDragNDrop ifTrue: [
listSpec
dragItem: #dragFromPackageAt:;
dragType: #dragTypeForPackageAt:].
^listSpec
PackagePaneBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:12
- dragFromPackageAt: anInteger
^ PackageInfo named: (self packageList at: anInteger)
PackagePaneBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:11
- dragTypeForPackageAt: anInteger
^ #sourceCode
PragmaPreference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse
ToolSet
^ ToolSet browse: self provider class
selector: self selectors first.
selector: self selectors first
Preference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse
ToolSet
^ ToolSet browse: Preferences class
selector: self selectors first.
selector: self selectors first
Sent from Squeak Inbox Talk https://github.com/hpi-swa-lab/squeak-inbox-talk
On 2022-01-27T01:08:37+01:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
This review requests consists of 3 changesets, for each of which I am appending a summary below:
- genericDropSourceCode.cs
- browse&drop-Monticello.cs
- browse&drag-Tools+System.cs
tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-)
Screencast: https://shorturl.at/gkwC6
Please review & let me know when I can merge it! :D
Best, Christoph
=============== Summary (genericDropSourceCode.cs) ===============
Change Set:????????genericDropSourceCode Date:????????????26 January 2022 Author:????????????Christoph Thiede
This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace.
=============== Diff ===============
Object>>browse {*Tools-Browsing} ? ct 1/26/2022 21:54 (changed) browse
- ????ToolSet browseClass: self class
- ????^ ToolSet browseClass: self class
PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} ? ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt ????"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
????| aMorph | ????(self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ ????????dropped dragTransferType = #filesAndDirectories ????????????ifTrue: [^ self dropFiles: dropped passenger event: evt]. ????????dropped dragTransferType = #sourceCode
- ????????????ifTrue: [^ self dropSourceCode: dropped passenger event: evt]].
- ????????????ifTrue: [^ self dropSourceCode: dropped passenger event: evt].
- ????????(dropped passenger isString or: [dropped passenger isText])
- ????????????ifTrue: [^ self dropEditable: dropped passenger event: evt]].
???? ????aMorph := self morphToDropFrom: dropped. ????self isWorldMorph ????????ifFalse: [super acceptDroppingMorph: aMorph event: evt] ????????ifTrue: ????????????["Add the given morph to this world and start stepping it if it wants to be." ????????????aMorph isInWorld ifFalse: [aMorph position: evt position]. ????????????self addMorphFront: aMorph. ????????????(aMorph fullBounds intersects: self viewBox) ifFalse: ????????????????[Beeper beep. ????????????????aMorph position: self bounds center]]. ???? ????aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. ????aMorph allMorphsDo: "Establish any penDown morphs in new world" ????????[:m | | tfm mm | ????????m player ifNotNil: ????????????[m player getPenDown ifTrue: ????????????????[((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ????????????????????ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) ????????????????????????????????????forPlayer: m player]]]]. ???? ????self isPartsBin ????????ifTrue: ????????????[aMorph isPartsDonor: true. ????????????aMorph stopSteppingSelfAndSubmorphs. ????????????aMorph suspendEventHandler] ????????ifFalse: ????????????[self world startSteppingSubmorphsOf: aMorph]. ???? "????self presenter morph: aMorph droppedIntoPasteUpMorph: self." ????self showingListView ifTrue: ????????[self sortSubmorphsBy: (self valueOfProperty: #sortOrder). ????????self currentWorld abandonAllHalos]. ???? ????self bringTopmostsToFront.
PasteUpMorph>>dropEditable:event: {event handling} ? ct 1/27/2022 00:38
- dropEditable: aStringOrText event: evt
- ????^ self dropTool: aStringOrText edit event: evt
PasteUpMorph>>dropSourceCode:event: {event handling} ? ct 1/27/2022 00:37 (changed) dropSourceCode: anObject event: evt
- ????(anObject isMethodReference and: [anObject isValid])
- ????????ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt].
- ????
- ????(anObject isBehavior or: [anObject isCompiledMethod])
- ????????ifTrue: [
- ????????????| tool window |
- ????????????tool := anObject isBehavior
- ????????????????ifTrue: [Browser new
- ????????????????????setClass: anObject]
- ????????????????ifFalse: [CodeHolder new
- ????????????????????setClass: anObject methodClass
- ????????????????????selector: anObject selector].
- ????????????window := ToolBuilder open: tool.
- ????????????window center: evt position.
- ????????????window bounds: (window bounds translatedToBeWithin: self bounds)].
- ????
- ????anObject isString
- ????????ifTrue: [anObject edit].
- ????^ self dropTool: anObject browse event: evt
PasteUpMorph>>dropTool:event: {event handling} ? ct 1/27/2022 00:37
- dropTool: tool event: evt
- ????| window |
- ????tool ifNil: [^ self].
- ????
- ????window := tool containingWindow ifNil: [ToolBuilder open: tool].
- ????window center: evt position.
- ????window bounds: (window bounds translatedToBeWithin: self bounds).
- ????^ window
PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} ? ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph
????^ self hasTransferMorphConverter ????????or: [transferMorph dragTransferType = #filesAndDirectories]
- ????????or: [transferMorph dragTransferType = #sourceCode]
- ????????or: [transferMorph dragTransferType = #sourceCode]
- ????????or: [transferMorph passenger isString or: [transferMorph passenger isText]]
String>>edit {*toolbuilder-kernel} ? ct 1/26/2022 22:13 (changed) edit
- ????UIManager default edit: self.
- ????^ Project uiManager edit: self.
SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} ? ct 1/26/2022 21:53 (changed) openAsTool ????"Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor."
- ????
????| meOrSimilarWindow | ????meOrSimilarWindow := self openInWorldExtent: self extent.
- ????(Project uiManager openToolsAttachedToMouseCursor "and: [ | event |
- ????????event := self currentEvent.
- ????????event isMouse and: [event isMouseUp]]") ifTrue: [
- ????????meOrSimilarWindow setProperty: #initialDrop toValue: true.
- ????????meOrSimilarWindow hasDropShadow: false.
- ????????self currentHand attachMorph: meOrSimilarWindow].
- ????(Project uiManager openToolsAttachedToMouseCursor
- ????????and: [ | event |
- ????????????event := self currentEvent.
- ????????????(event isMouse and: [event isMouseUp]) or: [event isDropEvent]])
- ????????????????ifTrue: [
- ????????????????????meOrSimilarWindow setProperty: #initialDrop toValue: true.
- ????????????????????meOrSimilarWindow hasDropShadow: false.
- ????????????????????self currentHand attachMorph: meOrSimilarWindow].
????^ meOrSimilarWindow
Text>>edit {*ToolBuilder-Kernel} ? ct 1/26/2022 22:13 (changed) edit
- ????UIManager default edit: self.
- ????^ Project uiManager edit: self.
=============== Summary (browse&drop-Monticello.cs) ===============
Change Set:????????browse&drop-Monticello Date:????????????27 January 2022 Author:????????????Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too.
As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag:
=============== Diff ===============
MCClassDefinition>>browseVersions {browsing} ? ct 1/26/2022 22:59
- browseVersions
- ????^ self actualClass browse
MCConfiguration>>browse {actions} ? ct 1/26/2022 22:02 (changed) browse ????| browser | ????browser := MCConfigurationBrowser new configuration: self copyForEdit. ????name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm].
- ????browser show
- ????^ browser show
MCDefinition>>browseVersions {browsing} ? ct 1/26/2022 22:58
- browseVersions
- ????^ nil
MCFileBasedRepository>>morphicOpen: {user interface} ? ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy
- ????(MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy)
- ????^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy)
????????show
MCMethodDefinition>>actualMethod {accessing} ? ct 1/26/2022 22:39
- actualMethod
- ????^ self actualMethodIn: Environment current
MCMethodDefinition>>actualMethodIn: {accessing} ? ct 1/27/2022 00:43
- actualMethodIn: anEnvironment
- ????"Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed."
- ????| class method |
- ????class := (self actualClassIn: anEnvironment) ifNil: [^ nil].
- ????method := class compiledMethodAt: self selector ifAbsent: [nil].
- ????(method isNil or: [method timeStamp = self timeStamp])
- ????????ifFalse: [method := (class changeRecordsAt: self selector)
- ????????????detect: [:record | record stamp = self timeStamp]
- ????????????ifNone: [nil]].
- ????^ method
MCMethodDefinition>>browse {browsing} ? ct 1/26/2022 23:00 (changed and recategorized) browse
- ????| browser |
- ????browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}).
- ????browser
- ????????categorySelection: 1;
- ????????classSelection: 1.
- ????classIsMeta ifTrue: [browser switchBeClass].
- ????browser
- ????????protocolSelection: 1;
- ????????methodSelection: 1;
- ????????showLabelled: 'Snapshot of ', self summary.
- ????^ browser
- ????^ self actualMethod ifNotNil: [:method | method isCompiledMethod
- ????????ifTrue: [method browse]
- ????????ifFalse: [self browseVersions]]
MCMethodDefinition>>browseVersions {browsing} ? ct 1/26/2022 23:00
- browseVersions
- ????^ ToolSet browseVersionsOf: self actualClass selector: self selector
MCOperationsBrowser>>methodAt: {accessing} ? ct 1/26/2022 22:53
- methodAt: index
- ????^ self items at: index
MCOperationsBrowser>>widgetSpecs {ui} ? ct 1/26/2022 22:51 (changed) widgetSpecs ????Preferences annotationPanes ifFalse: [ ^#(
- ????????((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
- ????????((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0))
????????((textMorph: text) (0 0.4 1 1)) ????????) ].
????^ #(
- ????????((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0))
- ????????((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0))
????????((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ????????((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0)) ????)
MCOperationsList>>browse {ui} ? ct 1/26/2022 22:02 (changed) browse
- ????(self browserClass items: operations) show
- ????^ (self browserClass items: operations) show
MCPatch>>browse {ui} ? ct 1/26/2022 22:02 (changed) browse
- ????(self browserClass forPatch: self) show
- ????^ (self browserClass forPatch: self) show
MCPatchOperation>>browse {browsing} ? ct 1/26/2022 22:58
- browse
- ????^ self definition browseVersions
MCRepository>>browse {user interface} ? ct 1/26/2022 22:21
- browse
- ????^ self morphicOpen
MCRepository>>morphicOpen {user interface} ? ct 1/26/2022 22:21 (changed) morphicOpen
- ????self morphicOpen: nil
- ????^ self morphicOpen: nil
MCRepository>>morphicOpen: {user interface} ? ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy
- ????(MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
- ????^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show
MCRepositoryInspector>>packageAt: {morphic ui} ? ct 1/26/2022 22:24
- packageAt: index
- ????^ nil
MCRepositoryInspector>>versionAt: {morphic ui} ? ct 1/26/2022 22:25
- versionAt: index
- ????^ repository versionNamed: (self versionNames at: index)
MCSnapshotBrowser>>categoryAt: {listing} ? ct 1/26/2022 22:36
- categoryAt: index
- ????^ nil
MCSnapshotBrowser>>classAt: {listing} ? ct 1/26/2022 22:37
- classAt: index
- ????| className environment |
- ????className := self visibleClasses at: index.
- ????environment := self environmentInDisplayingImage.
- ????^ environment at: className ifAbsent:
- ????????[environment valueOf: className]
MCSnapshotBrowser>>methodAt: {listing} ? ct 1/26/2022 22:34
- methodAt: index
- ????^ self visibleMethods at: index
MCSnapshotBrowser>>protocolAt: {listing} ? ct 1/26/2022 22:35
- protocolAt: index
- ????^ nil
MCSnapshotBrowser>>widgetSpecs {morphic ui} ? ct 1/27/2022 00:24 (changed) widgetSpecs
????Preferences annotationPanes ifFalse: [ ^#( ????????((listMorph: category) (0 0 0.25 0.4)) ????????((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ????????((listMorph: protocol) (0.50 0 0.75 0.4))
- ????????((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
- ????????((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4))
????????((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ????????((codePane: text) (0 0.4 1 1)) ????????) ].
????^#( ????????((listMorph: category) (0 0 0.25 0.4)) ????????((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ????????((listMorph: protocol) (0.50 0 0.75 0.4))
- ????????((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4))
- ????????((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4))
????????((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0))
????????((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ????????((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) ????????)
MCTool>>dragType: {morphic ui} ? ct 1/26/2022 22:16
- dragType: anObject
- ????^ #sourceCode
MCToolWindowBuilder>>listMorph: {building-parts} ? ct 1/26/2022 22:19 (changed) listMorph: listSymbol ????^ self ????????listMorph: (listSymbol, 'List') asSymbol ????????selection: (listSymbol, 'Selection') asSymbol
- ????????menu: (listSymbol, 'ListMenu:') asSymbol
- ????????menu: (listSymbol, 'ListMenu:') asSymbol
- ????????keystroke: nil
- ????????drag: (listSymbol, 'At:') asSymbol
MCToolWindowBuilder>>listMorph:selection: {building-parts} ? ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol
- ????self listMorph: listSymbol selection: selectionSymbol menu: nil
- ????^ self listMorph: listSymbol selection: selectionSymbol menu: nil
MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} ? ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol
- ????self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
- ????^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} ? ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol
- ????| list |
- ????list := builder pluggableListSpec new.
- ????list
- ????????model: tool;
- ????????list: listSymbol;
- ????????getIndex: selectionSymbol;
- ????????setIndex: (selectionSymbol, ':') asSymbol;
- ????????frame: currentFrame.
- ????menuSymbol ifNotNil: [list menu: menuSymbol].
- ????keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol].
- ????window children add: list
- ????^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil
MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} ? ct 1/26/2022 22:27
- listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol
- ????| list |
- ????list := builder pluggableListSpec new.
- ????list
- ????????model: tool;
- ????????list: listSymbol;
- ????????getIndex: selectionSymbol;
- ????????setIndex: (selectionSymbol, ':') asSymbol;
- ????????frame: currentFrame;
- ????????dragItem: dragSymbol;
- ????????dragType: #dragType:.
- ????menuSymbol ifNotNil: [list menu: menuSymbol].
- ????keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol].
- ????window children add: list
MCVersion>>browse {actions} ? ct 1/27/2022 00:24 (changed) browse
- ????(MCSnapshotBrowser forSnapshot: self snapshot)
- ????????label: 'Snapshot of ', self fileName;
- ????^ (MCSnapshotBrowser forSnapshot: self snapshot)
- ????????label: ('Snapshot of {1}' translated format: {self fileName});
????????show
MCVersionHistoryBrowser>>versionAt: {accessing} ? ct 1/27/2022 00:16
- versionAt: index
- ????^ self repositoryGroup versionWithInfo: (self infos at: index)
MCVersionHistoryBrowser>>widgetSpecs {morphic ui} ? ct 1/27/2022 00:16 (changed) widgetSpecs ????^ #(
- ????????((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1))
- ????????((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1))
????????((textMorph: summary) (0.3 0 1 1)) ???? ????)
MCVersionInspector>>browse {accessing} ? ct 1/26/2022 22:02 (changed) browse
- ????self version browse
- ????^ self version browse
MCWorkingCopy>>browse {ui} ? ct 1/27/2022 00:25 (changed) browse
- ????(MCSnapshotBrowser forSnapshot: self package snapshot)
- ????????????label: 'Snapshot Browser: ', self packageName;
- ????????????show.
- ????^ (MCSnapshotBrowser forSnapshot: self package snapshot)
- ????????????label: ('Snapshot Browser: {1}' translated format: {self packageName});
- ????????????show
MCWorkingCopyBrowser>>repositoryAt: {morphic ui} ? ct 1/26/2022 22:20
- repositoryAt: index
- ????^ self repositories at: index
MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} ? ct 1/26/2022 22:19
- workingCopyAt: index
- ????^ self workingCopies at: index
=============== Summary (browse&drag-Tools+System.cs) ===============
Change Set:????????browse&drag-Tools+System Date:????????????27 January 2022 Author:????????????Christoph Thiede
This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes.
All affected tools:
- Change sorters (single + dual), change set browser
- Dependency browser
- Package browser
- Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse)
=============== Postscript ===============
('accessing' author classChanges classRemoves editPostscript hasPostscript methodChanges methodInfoFromRemoval: name name: numberOfChanges postscriptHasDependents printOn: removePostscript structures superclasses) ('change logging' addClass: changeClass:from: event: noteNewMethod:forClass:selector:priorMethod: removeSelector:class:priorMethod:lastMethodInfo: renameClass:from:to:) ('class changes' changedClassNames changedClasses changedClassesDo: classChangeAt: commentClass: containsClass: fatDefForClass: noteClassForgotten: noteClassStructure: noteRemovalOf: reorganizeClass: trimHistory) ('converting' convertApril2000:using: convertToCurrentVersion:refStream:) ('fileIn/Out' askAddedInstVars: askRemovedInstVars: askRenames:addTo:using: assurePostscriptExists assurePreambleExists buildMessageForMailOutWithUser: checkForAlienAuthorship checkForAnyAlienAuthorship checkForConversionMethods checkForSlips checkForUnclassifiedMethods checkForUncommentedClasses checkForUncommentedMethods checkForUnsentMessages chooseSubjectPrefixForEmail defaultChangeSetDirectory fileOut fileOutChangesFor:on: fileOutOn: fileOutPSFor:on: fileOutPostscriptOn: fileOutPreambleOn: lookForSlips mailOut objectForDataStream: postscript postscriptString postscriptString: postscript: preamble preambleString preambleString: preambleTemplate preamble: setPreambleToSay: summaryString summaryStringDelta: verboseFileOut) ('initialize-release' beIsolationSetFor: clear initialize isMoribund veryDeepCopyWith: wither zapHistory) ('isolation layers' invoke isolatedProject isolationSet: revoke uninstall) ('method changes' adoptSelector:forClass: atSelector:class:put: changedMessageList changedMessageListAugmented changedMethods changedMethodsDo: hasAnyChangeForSelector: messageListForChangesWhich:ifNone: methodChangesAtClass: removeSelectorChanges:class: selectorsInClass:) ('moving changes' absorbClass:from: absorbMethod:class:from: absorbStructureOfClass:from: assimilateAllChangesFoundIn: editPreamble expungeEmptyClassChangeEntries expungeUniclasses forgetAllChangesFoundIn: forgetChangesForClass:in: hasPreamble methodsWithAnyInitialsOtherThan: methodsWithInitialsOtherThan: methodsWithoutComments removeClassAndMetaClassChanges: removeClassChanges: removePreamble) ('testing' belongsToAProject containsMethodAtPosition: correspondingProject isEmpty methodsWithoutClassifications okayToRemove okayToRemoveInforming: projectsBelongedTo) ('private' addCoherency: atClass:add: atClass:includes: atSelector:class: changed:with: changeRecorderFor: fileOutClassDefinition:on: oldNameFor:) ('*Monticello-testing' isForPackageLoad) ('*Etoys-Squeakland-fileIn/Out' checkForSUnit) ('*Tools-Browsing' browse)
=============== Diff ===============
ChangeSet>>browse {*Tools-Browsing} ? ct 1/26/2022 22:03
- browse
- ????^ ChangeSetBrowser openOn: self
ChangeSorter>>buildChangeSetListWith: {toolbuilder} ? ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder
????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????list: #changeSetList; ????????getSelected: #currentCngSet; ????????setSelected: #showChangeSetNamed:; ????????menu: #changeSetMenu:shifted:; ????????keyPress: #changeSetListKey:from:; ????????dragItem: #dragChangeSet:;
- ????????dragType: #dragTypeForChangeSet:;
????????autoDeselect: false. ????^ listSpec
ChangeSorter>>buildClassListWith: {toolbuilder} ? ct 1/26/2022 22:06 (changed) buildClassListWith: builder
????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????list: #classList; ????????getSelected: #currentClassName; ????????setSelected: #currentClassName:; ????????menu: #classListMenu:shifted:; ????????keyPress: #classListKey:from:;
- ????????dragItem: #dragClass:.
- ????????dragItem: #dragClass:;
- ????????dragType: #dragTypeForClass:.
????^ listSpec
ChangeSorter>>buildMessageListWith: {toolbuilder} ? ct 1/26/2022 22:07 (changed) buildMessageListWith: builder
????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????list: #messageList; ????????getSelected: #currentSelector; ????????setSelected: #currentSelector:; ????????menu: #messageMenu:shifted:; ????????keyPress: #messageListKey:from:;
- ????????dragItem: #dragMessage:.
- ????????dragItem: #dragMessage:;
- ????????dragType: #dragTypeForMessage:.
????^ listSpec
ChangeSorter>>dragTypeForChangeSet: {dragging} ? ct 1/26/2022 22:04
- dragTypeForChangeSet: anIndex
- ????^ #sourceCode
ChangeSorter>>dragTypeForClass: {dragging} ? ct 1/26/2022 22:06
- dragTypeForClass: anIndex
- ????^ #sourceCode
ChangeSorter>>dragTypeForMessage: {dragging} ? ct 1/26/2022 22:06
- dragTypeForMessage: anIndex
- ????^ #sourceCode
DependencyBrowser>>buildClassDepsWith: {toolbuilder} ? ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Required Classes' ; ????????list: #classDepsList; ????????getIndex: #classDepsIndex; ????????setIndex: #classDepsIndex:; ????????menu: #classDepsMenu:;
- ????????keyPress: #classDepsKey:from:.
- ????????keyPress: #classDepsKey:from:;
- ????????dragItem: #dragFromClassDepAt:;
- ????????dragType: #dragTypeForClassDepAt:.
????^listSpec
DependencyBrowser>>buildClassListWith: {toolbuilder} ? ct 1/27/2022 00:07 (changed) buildClassListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Client classes' ; ????????list: #classList; ????????getIndex: #classListIndex; ????????setIndex: #classListIndex:; ????????menu: #classListMenu:;
- ????????keyPress: #classListKey:from:.
- ????????keyPress: #classListKey:from:;
- ????????dragItem: #dragFromClassAt:;
- ????????dragType: #dragTypeForClassAt:.
????^listSpec
DependencyBrowser>>buildMessageListWith: {toolbuilder} ? ct 1/27/2022 00:05 (changed) buildMessageListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Client methods' ; ????????list: #messageList; ????????getIndex: #messageListIndex; ????????setIndex: #messageListIndex:; ????????menu: #messageListMenu:;
- ????????keyPress: #messageListKey:from:.
- ????????keyPress: #messageListKey:from:;
- ????????dragItem: #dragFromMessageAt:;
- ????????dragType: #dragTypeForMessageAt:.
????^listSpec
DependencyBrowser>>buildPackageDepsWith: {toolbuilder} ? ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new.
- ????listSpec
- ????listSpec
????????model: self;
- ????????name: 'Required Packages' ;
- ????????list: #packageDepsList;
- ????????getIndex: #packageDepsIndex;
- ????????setIndex: #packageDepsIndex:;
- ????????menu: #packageDepsMenu:;
- ????????keyPress: #packageDepsKey:from:.
- ????^listSpec
- ????????name: 'Required Packages';
- ????????list: #packageDepsList;
- ????????getIndex: #packageDepsIndex;
- ????????setIndex: #packageDepsIndex:;
- ????????menu: #packageDepsMenu:;
- ????????keyPress: #packageDepsKey:from:;
- ????????dragItem: #dragFromPackageDepAt:;
- ????????dragType: #dragTypeForPackageDepAt:.
- ????^ listSpec
DependencyBrowser>>buildPackageListWith: {toolbuilder} ? ct 1/27/2022 00:06 (changed) buildPackageListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: 'Packages' ; ????????list: #packageList; ????????getIndex: #packageListIndex; ????????setIndex: #packageListIndex:; ????????menu: #packageListMenu:;
- ????????keyPress: #packageListKey:from:.
- ????????keyPress: #packageListKey:from:;
- ????????dragItem: #dragFromPackageAt:;
- ????????dragType: #dragTypeForPackageAt:.
????^listSpec
DependencyBrowser>>dragFromClassAt: {class list} ? ct 1/27/2022 00:08
- dragFromClassAt: anInteger
- ????^ self environment classNamed: (self classList at: anInteger)
DependencyBrowser>>dragFromClassDepAt: {class dependencies} ? ct 1/27/2022 00:04
- dragFromClassDepAt: anInteger
- ????^ self environment classNamed: (self classDeps at: anInteger)
DependencyBrowser>>dragFromMessageAt: {message list} ? ct 1/27/2022 00:08
- dragFromMessageAt: anInteger
- ????^ self selectedClass >> (self messageList at: anInteger)
DependencyBrowser>>dragFromPackageAt: {package list} ? ct 1/27/2022 00:10
- dragFromPackageAt: anInteger
- ????^ PackageInfo named: (self packageList at: anInteger)
DependencyBrowser>>dragFromPackageDepAt: {package dependencies} ? ct 1/27/2022 00:11
- dragFromPackageDepAt: anInteger
- ????^ PackageInfo named: (self packageDeps at: anInteger)
DependencyBrowser>>dragTypeForClassAt: {class list} ? ct 1/27/2022 00:07
- dragTypeForClassAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} ? ct 1/27/2022 00:04
- dragTypeForClassDepAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForMessageAt: {message list} ? ct 1/27/2022 00:08
- dragTypeForMessageAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForPackageAt: {package list} ? ct 1/27/2022 00:10
- dragTypeForPackageAt: anInteger
- ????^ #sourceCode
DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} ? ct 1/27/2022 00:09
- dragTypeForPackageDepAt: anInteger
- ????^ #sourceCode
PackagePaneBrowser>>buildPackageListWith: {toolbuilder} ? ct 1/27/2022 00:11 (changed) buildPackageListWith: builder ????| listSpec | ????listSpec := builder pluggableListSpec new. ????listSpec ????????model: self; ????????name: #packageList; ????????list: #packageList; ????????getIndex: #packageListIndex; ????????setIndex: #packageListIndex:; ????????menu: #packageMenu:;
- ????????keyPress: #packageListKey:from:.
- ????????keyPress: #packageListKey:from:;
- ????????dragItem: #dragFromPackageAt:;
- ????????dragType: #dragTypeForPackageAt:.
????^listSpec
PackagePaneBrowser>>dragFromPackageAt: {package list} ? ct 1/27/2022 00:12
- dragFromPackageAt: anInteger
- ????^ PackageInfo named: (self packageList at: anInteger)
PackagePaneBrowser>>dragTypeForPackageAt: {package list} ? ct 1/27/2022 00:11
- dragTypeForPackageAt: anInteger
- ????^ #sourceCode
PragmaPreference>>browse {browsing} ? ct 1/26/2022 22:02 (changed) browse
- ????ToolSet
- ????^ ToolSet
????????browse: self provider class
- ????????selector: self selectors first.
- ????????selector: self selectors first
Preference>>browse {browsing} ? ct 1/26/2022 22:02 (changed) browse
- ????ToolSet
- ????^ ToolSet
????????browse: Preferences class
- ????????selector: self selectors first.
- ????????selector: self selectors first
Sent from Squeak Inbox Talk ["genericDropSourceCode.1.cs"] ["browse&drop-Monticello.1.cs"] ["browse&drag-Tools+System.1.cs"]
squeak-dev@lists.squeakfoundation.org