hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:ea37f20258a7
+:8e2fa160357f
 ^Icon
 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."
 "Do not manually edit this!! If it is corrupted,
 <resource: #image>
 ^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]
+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]!
-"Modified: / 23.3.1999 / 14:28:11 / cg"
-!
 projectsIcon
 "This resource specification was automatically generated
 by the ImageEditor of ST/X."
 ProjectBrowser new openInterface:#rightCanvasSpecForClassList
 "
 <resource: #canvas>
 ^
+#(#FullSpec
-#(#FullSpec
+#name: #rightCanvasSpecForClassList
 #window:
 #(#WindowSpec
-#name: 'NewApplication'
+#label: 'NewApplication'
-#layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+#name: 'NewApplication'
-#level: 0
+#min: #(#Point 10 10)
-#label: 'NewApplication'
+#max: #(#Point 1280 1024)
-#min: #(#Point 10 10)
+#bounds: #(#Rectangle 420 49 720 349)
-#max: #(#Point 1280 1024)
+)
-#bounds: #(#Rectangle 216 173 516 473)
+#component:
-#usePreferredExtent: false
+#(#SpecCollection
-)
+#collection: #(
-#component:
+#(#DataSetSpec
-#(#SpecCollection
+#name: 'classTable'
-#collection:
+#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
-#(
+#hasHorizontalScrollBar: true
-#(#DataSetSpec
+#hasVerticalScrollBar: true
-#name: 'classTable'
+#miniScrollerHorizontal: true
-#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+#dataList: #classList
-#hasHorizontalScrollBar: true
+#has3Dsepartors: false
-#hasVerticalScrollBar: true
+#columnHolder: #classTableColumns
-#dataList: #classList
+#columnAdaptor: #classTableAdaptor
-#has3Dsepartors: false
+)
-#columnHolder: #classTableColumns
+)
-#columnAdaptor: #classTableAdaptor
 )
-)
-)
 )
 !
 rightCanvasSpecForDeployment
 "This resource specification was automatically generated
 )
 )
 )
 !
+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."
 "Do not manually edit this!! If it is corrupted,
 #(#WindowSpec
 #label: 'NewApplication'
 #name: 'NewApplication'
 #min: #(#Point 10 10)
 #max: #(#Point 1280 1024)
-#bounds: #(#Rectangle 16 49 316 349)
+#bounds: #(#Rectangle 162 22 462 322)
 )
 #component:
 #(#SpecCollection
 #collection: #(
 #(#DataSetSpec
 #name: 'patchesTable'
 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
-#model: #selectedPatch
+#menu: #methodMenu
-#menu: #menu
 #hasHorizontalScrollBar: true
 #hasVerticalScrollBar: true
+#miniScrollerHorizontal: true
 #dataList: #patchesList
 #has3Dsepartors: false
 #columnHolder: #patchesTableColumns
 #columnAdaptor: #classTableAdaptor
 )
 #label: 'New'
 #translateLabel: true
 #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
 #label: 'Exit'
 #translateLabel: true
 #value: #closeRequest
+)
+)
+nil
+nil
+)
+)
+#(#MenuItem
+#label: 'Repository'
+#translateLabel: true
+#submenu:
+#(#Menu
+#(
+#(#MenuItem
+#label: 'CheckIn All'
+#translateLabel: true
+#value: #checkInProject
+#enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
 )
 )
 nil
 nil
 )
 #(
 #(#MenuItem
 #label: 'All'
 #translateLabel: true
 #value: #buildAll
+#enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
 )
 #(#MenuItem
 #label: '-'
 )
 #(#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
 nil
 )
 nil
 nil
 )
 !
-menu
+methodItemMenu
 "This resource specification was automatically generated
 by the MenuEditor of ST/X."
 "Do not manually edit this!! If it is corrupted,
 the MenuEditor may not be able to read the specification."
 #(#DataSetColumnSpec
 #label: 'Class'
 #id: 'classColumn'
 #labelAlignment: #left
 #menu: #patchesMethodMenu
-#model: #classNameFromPatchesInfo:
+#model: #classNameFromMethodInfo:
 #doubleClickedSelector: #methodPatchDoubleClick:
 #canSelect: false
 )
 #(#DataSetColumnSpec
 #label: 'Selector'
 #id: 'selectorColumn'
 #labelAlignment: #left
-#model: #selectorFromPatchesInfo:
+#model: #selectorFromMethodInfo:
 #canSelect: false
 )
 )
 ! !
 ^ [ |dir|
 dir := self projectDirectory value asFilename.
 (dir exists and:[dir isDirectory]) ifTrue:[
 self hasProjectSelectedHolder value
+] ifFalse:[
+false
+]
+].
+!
+hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+^ [ |dir|
+dir := self projectDirectory value asFilename.
+(dir exists and:[dir isDirectory]) ifTrue:[
+(self hasProjectSelectedHolder value) ifTrue:[
+self projectCodeIsLoaded value
+] ifFalse:[
+false.
+]
 ] ifFalse:[
 false
 ]
 ].
 !
 ^ holder.
 "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 ..."
 modifiedChannel isNil ifTrue:[
 modifiedChannel := false asValue.
 (holder := builder bindingAt:#patchesList) isNil ifTrue:[
 builder aspectAt:#patchesList put:(holder :=  List new).
 ].
 ^ 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 ..."
 ^ holder.
 "Created: / 23.3.1999 / 14:18:05 / cg"
 !
-selectedPatch
+selectedPatchInRightCanvas
 "automatically generated by UIPainter ..."
 |holder|
-(holder := builder bindingAt:#selectedPatch) isNil ifTrue:[
+(holder := builder bindingAt:#selectedPatchInRightCanvas) isNil ifTrue:[
-builder aspectAt:#selectedPatch put:(holder :=  ValueHolder new).
+builder aspectAt:#selectedPatchInRightCanvas put:(holder :=  ValueHolder new).
 ].
 ^ holder.
 !
 selectedProjectInPrerequisites
 showWhat
 |holder|
 (holder := builder bindingAt:#showWhat) isNil ifTrue:[
-holder := ValueHolder with:#current.
+holder := ValueHolder new.
 builder aspectAt:#showWhat put:holder.
 holder onChangeSend:#updateProjectTree to:self.
 ].
 ^ holder.
 ^ self class classesItemMenu
 ].
 self hasClassNodeSelected ifTrue:[
 ^ self class classItemMenu
 ].
+self hasMethodNodeSelected ifTrue:[
+^ self class methodItemMenu
+].
 self hasPrerequisiteClassesNodeSelected ifTrue:[
 ^ self class prerequisiteClassesItemMenu
 ].
 ^ nil
 !
 itemMenuPerformer
 ^ self
 ! !
 !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
 !
 !
 currentProject
 |node|
+node := self currentProjectNode.
+node isNil ifTrue:[^ nil].
+^ node contents
+!
+currentProjectNode
+|node|
 node := self selectedTreeNode.
 node isNil ifTrue:[^ nil].
 [node notNil and:[node isProjectNode not]] whileTrue:[
 node := node parent.
 ].
 node notNil ifTrue:[
-^ node contents
+^ node
 ].
 ^ nil
 !
 ^ selectedNode contents == #classes
 !
+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
 !
 selectedNode := self selectedTreeNode.
 selectedNode isNil ifTrue:[^ false].
 ^ selectedNode isProjectNode
+!
+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|
 |projectName pNode
 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.
 pNode := ProjectNode name:projectName.
 pNode contents:aProject.
 propertiesNode info:'Project propreties'.
 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].
 deploymentNode info:'Deployment & packaging specification.'.
 ^ projectTree
 !
 readAspectsFromProject
-|p l|
+|p type l ns|
 p := self currentProject.
 p notNil ifTrue:[
 self selectedTreeNode contents == #comment ifTrue:[
 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 projectPackage value:(p package).
-self projectNamespace value:(p defaultNameSpace ? Smalltalk) name.
+ns := p defaultNameSpace ? Smalltalk.
+ns isSymbol ifFalse:[
+ns := ns name
+].
+self projectNamespace value:ns.
 self repositoryModule value:(p repositoryModule).
 self repositoryDirectory value:(p repositoryDirectory).
 self deliverCompiledBinary value:(p propertyAt:#deliverCompiledBinary) ? false.
 self deliverSources value:(p propertyAt:#deliverSources) ? false.
 self deliverLoadAllFile value:(p propertyAt:#deliverLoadAllFile) ? false.
 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').
+((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX\packages').
-"/        self installDirectoryVMS
+self installDirectoryVMS
-"/                value:(p propertyAt:#installDirectoryVMS) ?
+value:(p propertyAt:#installDirectoryVMS) ?
-"/                        ((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX').
+((p propertyAt:#installDirectory) ? 'SYS$SMALLTALKX:[PACKAGES]').
 "/        self installDirectoryMacOS
 "/                value:(p propertyAt:#installDirectoryMacOS) ?
 "/                        ((p propertyAt:#installDirectory) ? '\Programme\SmalltalkX').
 l := p prerequisitePackages collect:[:entry |
 tree := SelectionInTree new.
 tree root:(root := ProjectTreeItem name:'invisibleRoot').
 root hide:false.
-showWhat == #current ifTrue:[
+showWhat notNil ifTrue:[
-root add:(self nodeFor:Project current).
+showWhat == #current ifTrue:[
-] ifFalse:[
+root add:(self nodeFor:Project current).
-(Project knownProjects asOrderedCollection
+] ifFalse:[
-sort:[:a :b | a packageName < b packageName])
+(Project knownProjects asOrderedCollection
-do:[:aProject |
+sort:[:a :b | a package < b package])
-|newNode nodeToAdd doShow childNode path|
+do:[:aProject |
+|newNode nodeToAdd doShow childNode path|
-(doShow := showWhat == #all) ifFalse:[
-doShow := (aProject package startsWith:'stx:') not
+(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.
 self projectTreeHolder root:projectTree.
 ].
 self hasClassNodeSelected ifTrue:[
 self showClassDefinitionOf:selectedNode.
 ^ self.
 ].
+self hasMethodNodeSelected ifTrue:[
+self showMethodSourceOf:selectedNode.
+^ self.
+].
 self currentCanvasHolder value:(self class emptyRightCanvasSpec).
 self rightCanvasTextHolder value:''.
 "Modified: / 23.3.1999 / 14:16:02 / cg"
 classNameFromClassInfo:cInfo
 ^ cInfo className
 !
+classNameFromMethodInfo:pInfo
+^ pInfo className
+!
 classNameFromPatchesInfo:pInfo
 ^ pInfo methodClass name
+!
+selectorFromMethodInfo:pInfo
+^ pInfo methodName
 !
 selectorFromPatchesInfo:pInfo
 ^ pInfo methodSelector
 ! !
 p createLoadAllFile
 ].
 !
+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"
+"inspect the current project"
-|project selectedNode|
+self hasProjectSelected ifTrue:[
+self currentProject inspect.
-self hasProjectNodeSelected ifTrue:[
-selectedNode := self selectedTreeNode.
-project := selectedNode contents.
-project inspect.
 ]
 !
 itemDoubleClicked:index
 |node classOrClassName cls|
 SystemBrowser browseClass:cls.
 ].
 !
 itemSelected:index
-|item action|
+|item action info p|
 self withWaitCursorDo:[
 self updateRightCanvas.
 ].
 self readAspectsFromProject.
 action := item action.
 action notNil ifTrue:[
 action value:item.
 ].
-self valueOfInfoLabel value: item info.
+info := item info.
+info size == 0 ifTrue:[
-self hasProjectSelectedHolder value:self hasProjectNodeSelected.
+((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"
 !
 loadClassesFromDirectory
 self newProject:newProject
 ]
 ]
 !
+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|
+|project|
-self hasProjectNodeSelected ifTrue:[
+self hasProjectSelected ifTrue:[
-selectedNode := self selectedTreeNode.
+project := self currentProject.
-project := selectedNode contents.
 Project current:project.
 self showWhat value == #current ifTrue:[
 self updateProjectTree
 ]
 newProject:newProject
 |newNode|
 newNode := self nodeFor:newProject.
-projectTree add:newNode.
+self addProjectNodeToTree:newNode.
 self projectTreeHolder root:projectTree.
 "/    self projectTreeHolder selectNode:newNode.
 "/    self projectTreeHolder expand:newNode.
 self readAspectsFromProject.
 self updateListOfRequiredPrerequisiteClasses.
 ]
 !
 newSubProject
-|selectedNode subProjectsNode newNode parentProject newProject|
+|projectNode subProjectsNode newNode parentProject newProject|
-selectedNode := self selectedTreeNode.
+projectNode := self currentProjectNode.
-self hasProjectNodeSelected ifTrue:[
+projectNode notNil ifTrue:[
-parentProject := selectedNode contents.
+parentProject := projectNode contents.
-subProjectsNode := selectedNode children detect:[:child | child contents == #subprojects].
+subProjectsNode := projectNode children detect:[:child | child contents == #subprojects].
-] ifFalse:[
-self hasSubProjectsNodeSelected ifTrue:[
-subProjectsNode := selectedNode.
-parentProject := selectedNode parent contents.
-].
-].
 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.
+]
 ]
 !
 openProject
 |fn|
 ]
 ]
 !
 renameProject
-|nm selectedNode selectedProject|
+|nm projectNode selectedProject|
-self hasProjectNodeSelected ifTrue:[
+projectNode := self currentProjectNode.
-selectedNode := self selectedTreeNode.
+projectNode notNil ifTrue:[
-selectedProject := selectedNode contents.
+selectedProject := projectNode contents.
 nm := Dialog
 request:'Rename to:'
 initialAnswer:selectedProject name.
 self currentCanvasHolder value:(self class rightCanvasSpecForHTMLText).
 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.
+self updatePatchesListForProject:project.
-patches := patches collect:[:m | m who].
-patches := patches sort:[:w1 :w2 |
+"/    patches := project methods.
-|w1Nm w2Nm|
+"/    patches := patches collect:[:m | m who].
+"/    patches := patches sort:[:w1 :w2 |
-w1Nm := w1 methodClass name.
+"/                        |w1Nm w2Nm|
-w2Nm := w2 methodClass name.
+"/
-w1Nm < w2Nm ifTrue:[
+"/                        w1Nm := w1 methodClass name.
-true
+"/                        w2Nm := w2 methodClass name.
-] ifFalse:[
+"/                        w1Nm < w2Nm ifTrue:[
-w1Nm = w2Nm ifFalse:[
+"/                            true
-false
+"/                        ] ifFalse:[
-] ifTrue:[
+"/                            w1Nm = w2Nm ifFalse:[
-w1 methodSelector < w2 methodSelector
+"/                                false
-]
+"/                            ] ifTrue:[
-]
+"/                                w1 methodSelector < w2 methodSelector
-].
+"/                            ]
+"/                        ]
-l := self patchesList.
+"/                       ].
-l removeAll.
+"/
-l addAll:patches.
+"/    l := self patchesList.
+"/    l removeAll.
+"/    l addAll:patches.
 self currentCanvasHolder value:(self class rightCanvasSpecForPatchesList).
 !
 showReadOnlyText:someText
 , ' of the projects ' , nTotal printString , ' classes are not loaded'.
 ].
 "/        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'!
 accept
 self accept
 !
 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.
 !

changeset 1218	8e2fa160357f
parent 1210	30bd57bbe9ce
child 1219	0bcf1df24277