diff -r ea37f20258a7 -r 8e2fa160357f ProjectBrowser.st --- 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? + + ^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 @@ - ^ - - #(#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 + " + + + + ^ + #(#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.