--- a/ProjectBrowser.st Sat Sep 18 16:34:35 1999 +0200
+++ b/ProjectBrowser.st Mon Sep 20 08:57:51 1999 +0200
@@ -192,6 +192,24 @@
constantNamed:#'ProjectBrowser filesIcon'
ifAbsentPut:[(Depth4Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@DQDQ@P@@@@@P@@@@@@@@@A@QDQDA@@@@DA@@@@@@@@@PDADQDPD@@A@PDQDQ@Q@@DA@QDQD@@@@PDADQDQDQ@A@PDQDQDQD@@A@QDQDQDP@@DADQDQDQ@@@@DQDQDQD@@@@QDQDQDP@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@C? O?@?>C?<O?8??3??/??????????O?<??0??C?<b') ; yourself); yourself]!
+methodIcon
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self methodIcon inspect
+ ImageEditor openOnClass:self andSelector:#methodIcon
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:#'ProjectBrowser methodIcon'
+ ifAbsentPut:[(Depth4Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DH@@@@@@@@4QA@@@@@@@TQDPP@@@@@@MDQDH@@@@@@PQDQA@@@@@@LTQA@@@@@@@@I@L@@@@@@@@QD@@@@@@@@@H@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 0 0 132 132 0 0 132 0 132 255 0 255]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@B@@\@C8@_0A? C?@G<@O @\@@ @@@@@@@@@b') ; yourself); yourself]!
+
methodsIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
@@ -241,10 +259,7 @@
^Icon
constantNamed:#'ProjectBrowser prerequisitesIcon'
- ifAbsentPut:[(Depth4Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@A8@D(@RPA80@C@^@=HRT/)^D$@C7#@RLAI@G(@@@@b') ; yourself); yourself]
-
- "Modified: / 23.3.1999 / 14:28:11 / cg"
-!
+ ifAbsentPut:[(Depth4Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@@Q@@@@@@@@@AD@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DP@@@@@AD@@Q@@@@@@DP@@@@@@@@@Q@@@@@@@@@@@@@@@@@@@@@@@AD@@@@@@@@@DP@@@@@@@@@@@@@@@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 127 127 127]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@A8@G(@^PA80@C@^@=8S7//^D<@C7#@^LA9@G(@@@@b') ; yourself); yourself]!
projectsIcon
"This resource specification was automatically generated
@@ -325,36 +340,34 @@
<resource: #canvas>
- ^
-
- #(#FullSpec
- #window:
- #(#WindowSpec
- #name: 'NewApplication'
- #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
- #level: 0
- #label: 'NewApplication'
- #min: #(#Point 10 10)
- #max: #(#Point 1280 1024)
- #bounds: #(#Rectangle 216 173 516 473)
- #usePreferredExtent: false
- )
- #component:
- #(#SpecCollection
- #collection:
- #(
- #(#DataSetSpec
- #name: 'classTable'
- #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #dataList: #classList
- #has3Dsepartors: false
- #columnHolder: #classTableColumns
- #columnAdaptor: #classTableAdaptor
- )
- )
- )
+ ^
+ #(#FullSpec
+ #name: #rightCanvasSpecForClassList
+ #window:
+ #(#WindowSpec
+ #label: 'NewApplication'
+ #name: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 420 49 720 349)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#DataSetSpec
+ #name: 'classTable'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #dataList: #classList
+ #has3Dsepartors: false
+ #columnHolder: #classTableColumns
+ #columnAdaptor: #classTableAdaptor
+ )
+ )
+
+ )
)
!
@@ -617,6 +630,96 @@
)
!
+rightCanvasSpecForFiles
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ProjectBrowser andSelector:#rightCanvasSpecForFiles
+ ProjectBrowser new openInterface:#rightCanvasSpecForFiles
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #rightCanvasSpecForFiles
+ #window:
+ #(#WindowSpec
+ #label: 'NewApplication'
+ #name: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 240 31 601 394)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#FramedBoxSpec
+ #label: 'File for system extensions & patches'
+ #name: 'FramedBox2'
+ #layout: #(#LayoutFrame 0 0.0 62 0.0 0 1.0 122 0)
+ #labelPosition: #topLeft
+ #translateLabel: true
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#InputFieldSpec
+ #name: 'methodsFileEntryField'
+ #layout: #(#LayoutFrame 0 0.0 1 0 0 1.0 23 0)
+ #activeHelpKey: #projectDir
+ #enableChannel: #currentProjectWasNotLoadedFromFile
+ #model: #methodsFile
+ #acceptChannel: #acceptChannel
+ #modifiedChannel: #modifiedChannel
+ #acceptOnPointerLeave: false
+ )
+ )
+
+ )
+ )
+ #(#HorizontalPanelViewSpec
+ #name: 'HorizontalPanel1'
+ #layout: #(#LayoutFrame 0 0 -30 1 0 1 0 1)
+ #horizontalLayout: #fitSpace
+ #verticalLayout: #center
+ #horizontalSpace: 3
+ #verticalSpace: 3
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#ActionButtonSpec
+ #label: 'Cancel'
+ #name: 'Button1'
+ #activeHelpKey: #cancel
+ #translateLabel: true
+ #model: #cancel
+ #enableChannel: #modifiedChannel
+ #actionValue: ''
+ #useDefaultExtent: true
+ )
+ #(#ActionButtonSpec
+ #label: 'OK'
+ #name: 'Button2'
+ #activeHelpKey: #accept
+ #translateLabel: true
+ #model: #accept
+ #enableChannel: #modifiedChannel
+ #useDefaultExtent: true
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+!
+
rightCanvasSpecForHTMLText
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -684,7 +787,7 @@
#name: 'NewApplication'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
- #bounds: #(#Rectangle 16 49 316 349)
+ #bounds: #(#Rectangle 162 22 462 322)
)
#component:
#(#SpecCollection
@@ -692,10 +795,10 @@
#(#DataSetSpec
#name: 'patchesTable'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #model: #selectedPatch
- #menu: #menu
+ #menu: #methodMenu
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
#dataList: #patchesList
#has3Dsepartors: false
#columnHolder: #patchesTableColumns
@@ -1474,20 +1577,41 @@
#value: #newProject
)
#(#MenuItem
+ #label: '-'
+ )
+ #(#MenuItem
#label: 'Load From...'
#translateLabel: true
#value: #openProject
)
#(#MenuItem
+ #label: 'Load Project Code'
+ #translateLabel: true
+ #value: #loadProjectCode
+ #enabled: #hasProjectSelectedAndProjectFilenameHolder
+ )
+ #(#MenuItem
#label: '-'
)
#(#MenuItem
- #label: 'Save'
+ #label: 'Save Project File'
#translateLabel: true
#value: #saveProject
#enabled: #hasProjectSelectedAndProjectFilenameHolder
)
#(#MenuItem
+ #label: 'Save Project Code'
+ #translateLabel: true
+ #value: #saveProjectCode
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'Save All'
+ #translateLabel: true
+ #value: #saveAll
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
#label: '-'
)
#(#MenuItem
@@ -1501,6 +1625,23 @@
)
)
#(#MenuItem
+ #label: 'Repository'
+ #translateLabel: true
+ #submenu:
+ #(#Menu
+ #(
+ #(#MenuItem
+ #label: 'CheckIn All'
+ #translateLabel: true
+ #value: #checkInProject
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ )
+ nil
+ nil
+ )
+ )
+ #(#MenuItem
#label: 'View'
#translateLabel: true
#submenu:
@@ -1552,6 +1693,7 @@
#label: 'All'
#translateLabel: true
#value: #buildAll
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
)
#(#MenuItem
#label: '-'
@@ -1559,7 +1701,26 @@
#(#MenuItem
#label: 'Make.proto && Makefile'
#translateLabel: true
- #value: #generateMakefiles
+ #value: #buildMakefiles
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'LoadAll file'
+ #translateLabel: true
+ #value: #buildLoadAllFile
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'Binary class library'
+ #translateLabel: true
+ #value: #buildClassLibrary
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'Zip archive'
+ #translateLabel: true
+ #value: #buildZipArchive
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
)
)
nil
@@ -1597,7 +1758,7 @@
)
!
-menu
+methodItemMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
@@ -1857,7 +2018,7 @@
#id: 'classColumn'
#labelAlignment: #left
#menu: #patchesMethodMenu
- #model: #classNameFromPatchesInfo:
+ #model: #classNameFromMethodInfo:
#doubleClickedSelector: #methodPatchDoubleClick:
#canSelect: false
)
@@ -1865,7 +2026,7 @@
#label: 'Selector'
#id: 'selectorColumn'
#labelAlignment: #left
- #model: #selectorFromPatchesInfo:
+ #model: #selectorFromMethodInfo:
#canSelect: false
)
)
@@ -2167,6 +2328,22 @@
].
!
+hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ ^ [ |dir|
+
+ dir := self projectDirectory value asFilename.
+ (dir exists and:[dir isDirectory]) ifTrue:[
+ (self hasProjectSelectedHolder value) ifTrue:[
+ self projectCodeIsLoaded value
+ ] ifFalse:[
+ false.
+ ]
+ ] ifFalse:[
+ false
+ ]
+ ].
+!
+
hasProjectSelectedHolder
|holder|
@@ -2342,6 +2519,20 @@
"Created: / 23.3.1999 / 14:18:05 / cg"
!
+methodsFile
+ "automatically generated by UIPainter ..."
+
+ |holder|
+
+ (holder := builder bindingAt:#methodsFile) isNil ifTrue:[
+ builder aspectAt:#methodsFile put:(holder := '' asValue).
+ holder onChangeSend:#value to:[modifiedChannel value:true].
+ ].
+ ^ holder.
+
+ "Created: / 23.3.1999 / 14:18:05 / cg"
+!
+
modifiedChannel
"automatically generated by UIPainter ..."
@@ -2363,6 +2554,19 @@
^ holder.
!
+projectCodeIsLoaded
+ "automatically generated by UIPainter ..."
+
+ |holder|
+
+ (holder := builder bindingAt:#projectCodeIsLoaded) isNil ifTrue:[
+ builder aspectAt:#projectCodeIsLoaded put:(holder := ValueHolder new).
+ ].
+ ^ holder.
+
+ "Created: / 23.3.1999 / 14:18:05 / cg"
+!
+
projectDirectory
"automatically generated by UIPainter ..."
@@ -2487,13 +2691,13 @@
"Created: / 23.3.1999 / 14:18:05 / cg"
!
-selectedPatch
+selectedPatchInRightCanvas
"automatically generated by UIPainter ..."
|holder|
- (holder := builder bindingAt:#selectedPatch) isNil ifTrue:[
- builder aspectAt:#selectedPatch put:(holder := ValueHolder new).
+ (holder := builder bindingAt:#selectedPatchInRightCanvas) isNil ifTrue:[
+ builder aspectAt:#selectedPatchInRightCanvas put:(holder := ValueHolder new).
].
^ holder.
!
@@ -2550,7 +2754,7 @@
|holder|
(holder := builder bindingAt:#showWhat) isNil ifTrue:[
- holder := ValueHolder with:#current.
+ holder := ValueHolder new.
builder aspectAt:#showWhat put:holder.
holder onChangeSend:#updateProjectTree to:self.
].
@@ -2616,6 +2820,9 @@
self hasClassNodeSelected ifTrue:[
^ self class classItemMenu
].
+ self hasMethodNodeSelected ifTrue:[
+ ^ self class methodItemMenu
+ ].
self hasPrerequisiteClassesNodeSelected ifTrue:[
^ self class prerequisiteClassesItemMenu
].
@@ -2632,6 +2839,27 @@
!ProjectBrowser methodsFor:'private'!
+addProjectNodeToTree:newNode
+ |aProject nodeToAdd path childNode|
+
+"/ projectTree add:newNode.
+
+ "/ insert into tree ...
+ nodeToAdd := projectTree.
+
+ path := newNode contents package asCollectionOfSubstringsSeparatedByAny:'/\:'.
+ path from:1 to:path size-1 do:[:part |
+ childNode := nodeToAdd children detect:[:child | child name = part] ifNone:nil.
+ childNode isNil ifTrue:[
+ nodeToAdd add:(childNode := ProjectTreeItem new name:part).
+ ].
+ nodeToAdd := childNode.
+ ].
+ newNode name:(path last).
+ nodeToAdd add:newNode.
+
+!
+
canAddClassToPrerequisites:aClassName
^ aClassName notNil
!
@@ -2696,6 +2924,15 @@
currentProject
|node|
+ node := self currentProjectNode.
+ node isNil ifTrue:[^ nil].
+ ^ node contents
+
+!
+
+currentProjectNode
+ |node|
+
node := self selectedTreeNode.
node isNil ifTrue:[^ nil].
@@ -2703,7 +2940,7 @@
node := node parent.
].
node notNil ifTrue:[
- ^ node contents
+ ^ node
].
^ nil
@@ -2745,6 +2982,27 @@
!
+hasMethodNodeSelected
+ |selectedNode|
+
+ selectedNode := self selectedTreeNode.
+ selectedNode isNil ifTrue:[^ false].
+
+ ^ selectedNode contents isAssociation
+ and:[selectedNode contents key == #method]
+
+!
+
+hasMethodsNodeSelected
+ |selectedNode|
+
+ selectedNode := self selectedTreeNode.
+ selectedNode isNil ifTrue:[^ false].
+
+ ^ selectedNode contents key == #patches
+
+!
+
hasNodeSelected
^ self selectedTreeNode notNil
@@ -2770,6 +3028,20 @@
!
+hasProjectSelected
+ |selectedNode node|
+
+ selectedNode := self selectedTreeNode.
+ selectedNode isNil ifTrue:[^ false].
+
+ node := selectedNode.
+ [node notNil] whileTrue:[
+ node isProjectNode ifTrue:[^ true].
+ node := node parent.
+ ].
+ ^ false.
+!
+
hasSubProjectsNodeSelected
|selectedNode|
@@ -2787,7 +3059,7 @@
propertiesNode docNode classesNode patchesNode subprojectsNode filesNode
commentNode prerequisitesNode analysisNode designNode codeNode
userDocNode userOverViewNode userGuideNode userRefManNode
- deploymentNode classIcon
+ deploymentNode classIcon methodIcon
prerequisiteProjectsNode prerequisiteClassesNode|
projectName := aProject name.
@@ -2876,10 +3148,24 @@
filesNode contents:#files.
filesNode icon:(self class filesIcon).
filesNode info:'Other files (bitmaps, data) contained in the project'.
+ filesNode spec:[self class rightCanvasSpecForFiles].
+
+ methodIcon := self class methodIcon.
patchesNode contents:#patches.
patchesNode icon:(self class methodsIcon).
patchesNode info:'Patches (system-changes) contained in the project'.
+ ((aProject methodInfo ? #()) copy sort:[:a :b |
+ a displayString < b displayString.
+ ])
+ do:[:aMethodInfo |
+ |cNode cName|
+
+ cNode := ProjectTreeItem name:(aMethodInfo className , ' ' , aMethodInfo methodName).
+ cNode contents:(#method -> aMethodInfo).
+ cNode icon:methodIcon.
+ patchesNode add:cNode.
+ ].
deploymentNode icon:(self class deploymentIcon).
deploymentNode spec:[self class rightCanvasSpecForDeployment].
@@ -2899,7 +3185,7 @@
!
readAspectsFromProject
- |p l|
+ |p type l ns|
p := self currentProject.
p notNil ifTrue:[
@@ -2907,11 +3193,24 @@
self rightCanvasTextHolder value:p comment.
].
+ self methodsFile value:(p propertyAt:#methodsFile).
+ self projectCodeIsLoaded value:(p isLoaded == true).
+ p isLoaded == true ifFalse:[
+ self valueOfInfoLabel value:'Projects code is not loaded.'
+ ].
+
self currentProjectWasNotLoadedFromFile value:p wasLoadedFromFile not.
- self projectType value:(p type).
+ (type := p type) == #classLibrary ifTrue:[
+ type := #library
+ ].
+ self projectType value:type.
self projectDirectory value:(p directory).
- self projectPackage value:(p packageName).
- self projectNamespace value:(p defaultNameSpace ? Smalltalk) name.
+ self projectPackage value:(p package).
+ ns := p defaultNameSpace ? Smalltalk.
+ ns isSymbol ifFalse:[
+ ns := ns name
+ ].
+ self projectNamespace value:ns.
self repositoryModule value:(p repositoryModule).
self repositoryDirectory value:(p repositoryDirectory).
@@ -2924,13 +3223,13 @@
self installDirectoryUnix
value:(p propertyAt:#installDirectoryUnix) ?
- ((p propertyAt:#installDirectory) ? '/opt/smalltalk').
+ ((p propertyAt:#installDirectory) ? '/opt/smalltalk/packages').
self installDirectoryWin32
value:(p propertyAt:#installDirectoryWin32) ?
- ((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX').
-"/ self installDirectoryVMS
-"/ value:(p propertyAt:#installDirectoryVMS) ?
-"/ ((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX').
+ ((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX\packages').
+ self installDirectoryVMS
+ value:(p propertyAt:#installDirectoryVMS) ?
+ ((p propertyAt:#installDirectory) ? 'SYS$SMALLTALKX:[PACKAGES]').
"/ self installDirectoryMacOS
"/ value:(p propertyAt:#installDirectoryMacOS) ?
"/ ((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX').
@@ -3021,35 +3320,37 @@
tree root:(root := ProjectTreeItem name:'invisibleRoot').
root hide:false.
- showWhat == #current ifTrue:[
- root add:(self nodeFor:Project current).
- ] ifFalse:[
- (Project knownProjects asOrderedCollection
- sort:[:a :b | a packageName < b packageName])
- do:[:aProject |
- |newNode nodeToAdd doShow childNode path|
-
- (doShow := showWhat == #all) ifFalse:[
- doShow := (aProject package startsWith:'stx:') not
+ showWhat notNil ifTrue:[
+ showWhat == #current ifTrue:[
+ root add:(self nodeFor:Project current).
+ ] ifFalse:[
+ (Project knownProjects asOrderedCollection
+ sort:[:a :b | a package < b package])
+ do:[:aProject |
+ |newNode nodeToAdd doShow childNode path|
+
+ (doShow := showWhat == #all) ifFalse:[
+ doShow := (aProject package startsWith:'stx:') not
+ ].
+
+ doShow ifTrue:[
+ newNode := self nodeFor:aProject.
+
+ "/ insert into tree ...
+ nodeToAdd := root.
+
+ path := aProject package asCollectionOfSubstringsSeparatedByAny:'/\:'.
+ path from:1 to:path size-1 do:[:part |
+ childNode := nodeToAdd children detect:[:child | child name = part] ifNone:nil.
+ childNode isNil ifTrue:[
+ nodeToAdd add:(childNode := ProjectTreeItem new name:part).
+ ].
+ nodeToAdd := childNode.
+ ].
+ newNode name:(path last).
+ nodeToAdd add:newNode.
+ ]
].
-
- doShow ifTrue:[
- newNode := self nodeFor:aProject.
-
- "/ insert into tree ...
- nodeToAdd := root.
-
- path := aProject package asCollectionOfSubstringsSeparatedByAny:'/\:'.
- path from:1 to:path size-1 do:[:part |
- childNode := nodeToAdd children detect:[:child | child name = part] ifNone:nil.
- childNode isNil ifTrue:[
- nodeToAdd add:(childNode := ProjectTreeItem new name:part).
- ].
- nodeToAdd := childNode.
- ].
- newNode name:(path last).
- nodeToAdd add:newNode.
- ]
].
].
projectTree := root.
@@ -3095,6 +3396,11 @@
self showClassDefinitionOf:selectedNode.
^ self.
].
+ self hasMethodNodeSelected ifTrue:[
+ self showMethodSourceOf:selectedNode.
+ ^ self.
+ ].
+
self currentCanvasHolder value:(self class emptyRightCanvasSpec).
self rightCanvasTextHolder value:''.
@@ -3116,10 +3422,18 @@
^ cInfo className
!
+classNameFromMethodInfo:pInfo
+ ^ pInfo className
+!
+
classNameFromPatchesInfo:pInfo
^ pInfo methodClass name
!
+selectorFromMethodInfo:pInfo
+ ^ pInfo methodName
+!
+
selectorFromPatchesInfo:pInfo
^ pInfo methodSelector
! !
@@ -3251,16 +3565,80 @@
!
+buildLoadAllFile
+ |p |
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ p createLoadAllFile.
+
+!
+
+checkInProject
+ |p classes methods anyMethodMissing|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ "/ check in classes ...
+
+ classes := p classes.
+ classes do:[:aClass |
+ |clsName|
+
+ aClass isBehavior ifFalse:[
+ aClass isSymbol ifTrue:[
+ clsName := aClass
+ ] ifFalse:[
+ clsName := aClass className
+ ].
+ Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , clsName).
+ ] ifTrue:[
+ aClass isLoaded ifFalse:[
+ Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , aClass name).
+ ] ifTrue:[
+ aClass owningClass isNil ifTrue:[ "/ skip private classes
+ self checkInClass:aClass.
+ ]
+ ]
+ ]
+ ].
+
+ "/ check methods ...
+
+ anyMethodMissing := false.
+ methods := p methods.
+ methods size > 0 ifTrue:[
+ methods do:[:aMethod |
+ aMethod isMethod ifFalse:[
+ Transcript showCR:('ProjectBrowser: cannot checkIn unloaded method: ' , aMethod className , ' ' , aMethod methodName).
+ anyMethodMissing := true.
+ ]
+ ].
+ anyMethodMissing ifTrue:[
+ Transcript showCR:'ProjectBrowser: cannot save method patches & extensions due to missing method(s)'.
+ ] ifFalse:[
+ self checkInMethods:methods
+ ].
+ ].
+
+ "/ check in the project file itself
+ self checkInProjectFile.
+
+!
+
inspectCurrentProject
- "make the selected Project the current project"
-
- |project selectedNode|
-
- self hasProjectNodeSelected ifTrue:[
- selectedNode := self selectedTreeNode.
- project := selectedNode contents.
-
- project inspect.
+ "inspect the current project"
+
+ self hasProjectSelected ifTrue:[
+ self currentProject inspect.
]
!
@@ -3284,7 +3662,7 @@
!
itemSelected:index
- |item action|
+ |item action info p|
self withWaitCursorDo:[
self updateRightCanvas.
@@ -3297,9 +3675,16 @@
action value:item.
].
- self valueOfInfoLabel value: item info.
-
- self hasProjectSelectedHolder value:self hasProjectNodeSelected.
+ info := item info.
+ info size == 0 ifTrue:[
+ ((p := self currentProject) notNil
+ and:[p isLoaded ~~ true]) ifTrue:[
+ info := 'Projects code is not loaded.'
+ ].
+ ].
+ self valueOfInfoLabel value:info.
+
+ self hasProjectSelectedHolder value:self hasProjectSelected.
"Modified: / 26.4.1999 / 22:49:20 / cg"
!
@@ -3324,14 +3709,99 @@
]
!
+loadProjectCode
+ |project filesToLoad methodsFile ns anyPatchClassMissing anyPatches|
+
+ project := self currentProject.
+ ns := project defaultNameSpace.
+ ns isSymbol ifTrue:[
+ ns := Namespace name:ns
+ ].
+ self withReadCursorDo:[
+ filesToLoad := OrderedCollection new.
+
+ "/ load all classes ...
+ project classInfo do:[:aClassInfo |
+ |className fileToLoad cls|
+
+ className := aClassInfo className.
+ fileToLoad := aClassInfo classFileName.
+ cls := ns at:className asSymbol.
+ cls notNil ifTrue:[
+ cls isBehavior ifFalse:[
+ (self confirm:('Attention: a global named ' , className , ' exists, but is not a class.\\Load anyway ?') withCRs)
+ ifFalse:[
+ fileToLoad := nil
+ ]
+ ] ifTrue:[
+ cls isLoaded ifTrue:[
+ fileToLoad := nil
+ ]
+ ]
+ ].
+ fileToLoad notNil ifTrue:[
+ filesToLoad add:fileToLoad
+ ].
+ ].
+
+ anyPatchClassMissing := false.
+ anyPatches := false.
+ project methodInfo do:[:aMethodInfo |
+ |className methodName mthd cls|
+
+ className := aMethodInfo className.
+ methodName := aMethodInfo methodName.
+ cls := Smalltalk at:className asSymbol.
+ (cls isNil or:[cls isBehavior not or:[cls isLoaded not]]) ifTrue:[
+ self warn:('Missing class: ' , className , ' (required for patches)').
+ anyPatchClassMissing := anyPatches := true.
+ ] ifFalse:[
+ "/ already present ?
+ (cls compiledMethodAt:methodName asSymbol) isNil ifTrue:[
+ anyPatches := true.
+ ]
+ ]
+ ].
+
+ (methodsFile := project propertyAt:#methodsFile) notNil ifTrue:[
+ anyPatches ifTrue:[
+ anyPatchClassMissing ifTrue:[
+ self warn:('Cannot load patches & extensions, due to missing class(es)')
+ ] ifFalse:[
+ filesToLoad add:methodsFile
+ ]
+ ]
+ ] ifFalse:[
+ anyPatches ifTrue:[
+ self warn:('No file for methods (patches & extensions) is defined in project')
+ ].
+ ].
+
+ filesToLoad size == 0 ifTrue:[
+ self information:'Projects code is already loaded.'
+ ] ifFalse:[
+ "/ load twice to avoid load-order trouble with superclasses ..
+ 2 timesRepeat:[
+ Class packageQuerySignal answer:project package asSymbol
+ do:[
+ filesToLoad do:[:fileToLoad |
+ Smalltalk fileIn:(project directory asFilename construct:fileToLoad) pathName
+ ]
+ ]
+ ]
+ ].
+ project isLoaded:true.
+ self readAspectsFromProject
+ ]
+!
+
makeCurrentProject
"make the selected Project the current project"
- |project selectedNode|
-
- self hasProjectNodeSelected ifTrue:[
- selectedNode := self selectedTreeNode.
- project := selectedNode contents.
+ |project|
+
+ self hasProjectSelected ifTrue:[
+ project := self currentProject.
Project current:project.
self showWhat value == #current ifTrue:[
@@ -3353,7 +3823,7 @@
|newNode|
newNode := self nodeFor:newProject.
- projectTree add:newNode.
+ self addProjectNodeToTree:newNode.
self projectTreeHolder root:projectTree.
"/ self projectTreeHolder selectNode:newNode.
"/ self projectTreeHolder expand:newNode.
@@ -3365,29 +3835,25 @@
!
newSubProject
- |selectedNode subProjectsNode newNode parentProject newProject|
-
- selectedNode := self selectedTreeNode.
-
- self hasProjectNodeSelected ifTrue:[
- parentProject := selectedNode contents.
- subProjectsNode := selectedNode children detect:[:child | child contents == #subprojects].
- ] ifFalse:[
- self hasSubProjectsNodeSelected ifTrue:[
- subProjectsNode := selectedNode.
- parentProject := selectedNode parent contents.
- ].
- ].
+ |projectNode subProjectsNode newNode parentProject newProject|
+
+ projectNode := self currentProjectNode.
+
+ projectNode notNil ifTrue:[
+ parentProject := projectNode contents.
+ subProjectsNode := projectNode children detect:[:child | child contents == #subprojects].
self halt.
- parentProject notNil ifTrue:[
- newProject := Project new.
- newNode := self nodeFor:newProject.
-
- parentProject addSubProject:newProject.
- subProjectsNode add:newNode.
- self projectTreeHolder root:projectTree.
- self projectTreeHolder selectNode:newNode.
+ parentProject notNil ifTrue:[
+ newProject := Project new.
+ newNode := self nodeFor:newProject.
+
+ parentProject addSubProject:newProject.
+ subProjectsNode add:newNode.
+ self projectTreeHolder root:projectTree.
+ self projectTreeHolder selectNode:newNode.
+ ]
]
+
!
openProject
@@ -3422,11 +3888,11 @@
!
renameProject
- |nm selectedNode selectedProject|
-
- self hasProjectNodeSelected ifTrue:[
- selectedNode := self selectedTreeNode.
- selectedProject := selectedNode contents.
+ |nm projectNode selectedProject|
+
+ projectNode := self currentProjectNode.
+ projectNode notNil ifTrue:[
+ selectedProject := projectNode contents.
nm := Dialog
request:'Rename to:'
@@ -3549,33 +4015,59 @@
self htmlDocumentURLHolder value:project documentationURL.
!
+showMethodSourceOf:anItem
+ |node methodInfo classOrClassName cls mthd text|
+
+ self hasMethodNodeSelected ifFalse:[^ self].
+
+ self currentCanvasHolder value:(self class rightCanvasSpecForEditableText).
+
+ node := self selectedTreeNode.
+ methodInfo := node contents value.
+ cls := Smalltalk at:methodInfo className asSymbol.
+ cls isNil ifTrue:[
+ text := 'The class is not (yet) loaded'.
+ ] ifFalse:[
+ mthd := cls compiledMethodAt:(methodInfo methodName asSymbol).
+ mthd isNil ifTrue:[
+ text := 'The method is not (yet) loaded'.
+ ] ifFalse:[
+ text := mthd source
+ ]
+ ].
+ self rightCanvasTextHolder value:text.
+
+!
+
showPatchesListOf:anItem
|projectItem project patches l|
projectItem := anItem parent.
project := projectItem contents.
- patches := project individualMethods.
- patches := patches collect:[:m | m who].
- patches := patches sort:[:w1 :w2 |
- |w1Nm w2Nm|
-
- w1Nm := w1 methodClass name.
- w2Nm := w2 methodClass name.
- w1Nm < w2Nm ifTrue:[
- true
- ] ifFalse:[
- w1Nm = w2Nm ifFalse:[
- false
- ] ifTrue:[
- w1 methodSelector < w2 methodSelector
- ]
- ]
- ].
-
- l := self patchesList.
- l removeAll.
- l addAll:patches.
+ self updatePatchesListForProject:project.
+
+"/ patches := project methods.
+"/ patches := patches collect:[:m | m who].
+"/ patches := patches sort:[:w1 :w2 |
+"/ |w1Nm w2Nm|
+"/
+"/ w1Nm := w1 methodClass name.
+"/ w2Nm := w2 methodClass name.
+"/ w1Nm < w2Nm ifTrue:[
+"/ true
+"/ ] ifFalse:[
+"/ w1Nm = w2Nm ifFalse:[
+"/ false
+"/ ] ifTrue:[
+"/ w1 methodSelector < w2 methodSelector
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ l := self patchesList.
+"/ l removeAll.
+"/ l addAll:patches.
self currentCanvasHolder value:(self class rightCanvasSpecForPatchesList).
!
@@ -3664,6 +4156,19 @@
"/ self notify:msg.
].
modifiedChannel value:false.
+!
+
+updatePatchesListForProject:aProject
+ |methodInfo l|
+
+ methodInfo := aProject methodInfo copy asOrderedCollection.
+ methodInfo sort:[:a :b | a displayString < b displayString].
+
+ l := self patchesList.
+ l removeAll.
+ l addAll:methodInfo.
+
+
! !
!ProjectBrowser methodsFor:'user actions - canvas'!
@@ -3724,22 +4229,57 @@
!
browseMethod
+ "browse the selected method (from tree)"
+
+ |patchWho mthdInfo cls mthd|
+
+ mthdInfo := self selectedTreeNode value value.
+ cls := Smalltalk at: mthdInfo className asSymbol.
+ cls notNil ifTrue:[
+ mthd := cls compiledMethodAt:(mthdInfo methodName asSymbol).
+ mthd notNil ifTrue:[
+ SystemBrowser browseClass:cls selector:mthdInfo methodName.
+ ^ self
+ ]
+ ].
+ self information:'Method not (yet) loaded.'
+!
+
+browseMethodFromCanvas
"browse the selected table-rows method (from patches canvas)"
|patchWho patchIndex|
- patchIndex := self selectedPatch value.
+ patchIndex := self selectedPatchInRightCanvas value.
patchWho := self patchesList at:patchIndex.
SystemBrowser browseClass:patchWho methodClass selector:patchWho methodSelector.
!
browseMethodFull
+ "browse the selected method (from tree)"
+
+ |patchWho mthdInfo cls mthd|
+
+ mthdInfo := self selectedTreeNode value value.
+ cls := Smalltalk at: mthdInfo className asSymbol.
+ cls notNil ifTrue:[
+ mthd := cls compiledMethodAt:(mthdInfo methodName asSymbol).
+ mthd notNil ifTrue:[
+ SystemBrowser openInClass:cls selector:mthdInfo methodName.
+ ^ self
+ ]
+ ].
+ self information:'Method not (yet) loaded.'
+
+!
+
+browseMethodFullFromCanvas
"browse the selected table-rows method (from patches canvas)"
|patchWho patchIndex|
- patchIndex := self selectedPatch value.
+ patchIndex := self selectedPatchInRightCanvas value.
patchWho := self patchesList at:patchIndex.
SystemBrowser openInClass:patchWho methodClass selector:patchWho methodSelector.