diff -r a2d8e9cc28c9 -r 159098ddc555 BrowserView.st --- a/BrowserView.st Tue Dec 12 18:37:13 1995 +0100 +++ b/BrowserView.st Tue Dec 12 23:11:41 1995 +0100 @@ -11,16 +11,16 @@ " StandardSystemView subclass:#BrowserView - instanceVariableNames:'classCategoryListView classListView methodCategoryListView + instanceVariableNames:'classCategoryListView classListView methodCategoryListView methodListView classMethodListView codeView classToggle instanceToggle currentClassCategory currentClassHierarchy currentClass currentMethodCategory currentMethod currentSelector showInstance actualClass fullClass lastMethodCategory aspect variableListView fullProtocol lockUpdates autoSearch myLabel acceptClass lastSourceLogMessage' - classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon' - poolDictionaries:'' - category:'Interface-Browsers' + classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon' + poolDictionaries:'' + category:'Interface-Browsers' ! !BrowserView class methodsFor:'documentation'! @@ -1099,165 +1099,169 @@ (device ctrlDown and:[currentClass notNil]) ifTrue:[ - labels := #( - 'inspect class' - '-' - 'primitive definitions' - 'primitive variables' - 'primitive functions' - ). - selectors := #( - classInspect - nil - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions - ). - - labels := labels , #( - '-' - 'revision info' - 'compare with repository' - '-' - 'check into source repository' - 'fileIn from repository' - ). - - selectors := selectors , #( - nil - classRevisionInfo - classCompareWithNewestInRepository - nil - classCheckin - classLoadRevision - ). + labels := #( + 'inspect class' + '-' + 'primitive definitions' + 'primitive variables' + 'primitive functions' + ). + selectors := #( + classInspect + nil + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions + ). + + labels := labels , #( + '-' + 'container' + '-' + 'revision info' + 'compare with repository' + '-' + 'check into source repository' + 'fileIn from repository' + ). + + selectors := selectors , #( + nil + classModifyContainer + nil + classRevisionInfo + classCompareWithNewestInRepository + nil + classCheckin + classLoadRevision + ). ] ifFalse:[ - currentClass isNil ifTrue:[ - labels := #( - 'new class' - ). - selectors := #( - classNewClass - ). - ] ifFalse:[ - currentClass isLoaded ifFalse:[ - labels := #( - 'definition' - '-' - 'new class' - '-' - 'load ' - ). - selectors := #( - classDefinition - nil - classNewClass - nil - classLoad - ). - ] ifTrue:[ - fullProtocol ifTrue:[ - labels := #( - 'hierarchy' - 'definition' - 'comment' - 'class instvars' - ). - selectors := #( - classHierarchy - classDefinition - classComment - classClassInstVars - ). - ] ifFalse:[ - labels := #( - 'fileOut' - 'printOut' - 'printOut protocol' - " 'printOut full protocol' " - '-' - 'SPAWN_CLASS' - 'spawn full protocol' - 'spawn hierarchy' - 'spawn subclasses' - '-' - ). - selectors := #( - classFileOut - classPrintOut - classPrintOutProtocol - " classPrintOutFullProtocol " - nil - classSpawn - classSpawnFullProtocol - classSpawnHierarchy - classSpawnSubclasses - nil - ). - - fullClass ifFalse:[ - labels := labels , #( - 'hierarchy' - 'definition' - 'comment' - 'class instvars' - "/ 'protocols' - '-' - ). - selectors := selectors , #( - classHierarchy - classDefinition - classComment - classClassInstVars - "/ classProtocols - nil - ). - ]. - - labels := labels , #( - "/ 'variable search' - 'class refs' - '-' - 'new class' - 'new subclass' - 'rename ...' - 'remove' - ). - selectors := selectors , #( - "/ variables - classRefs - nil - classNewClass - classNewSubclass - classRename - classRemove - ). - currentClass wasAutoloaded ifTrue:[ - labels := labels , #( - 'unload' - ). - selectors := selectors , #( - classUnload - ). - ] - ] - ]. - ]. + currentClass isNil ifTrue:[ + labels := #( + 'new class' + ). + selectors := #( + classNewClass + ). + ] ifFalse:[ + currentClass isLoaded ifFalse:[ + labels := #( + 'definition' + '-' + 'new class' + '-' + 'load ' + ). + selectors := #( + classDefinition + nil + classNewClass + nil + classLoad + ). + ] ifTrue:[ + fullProtocol ifTrue:[ + labels := #( + 'hierarchy' + 'definition' + 'comment' + 'class instvars' + ). + selectors := #( + classHierarchy + classDefinition + classComment + classClassInstVars + ). + ] ifFalse:[ + labels := #( + 'fileOut' + 'printOut' + 'printOut protocol' + " 'printOut full protocol' " + '-' + 'SPAWN_CLASS' + 'spawn full protocol' + 'spawn hierarchy' + 'spawn subclasses' + '-' + ). + selectors := #( + classFileOut + classPrintOut + classPrintOutProtocol + " classPrintOutFullProtocol " + nil + classSpawn + classSpawnFullProtocol + classSpawnHierarchy + classSpawnSubclasses + nil + ). + + fullClass ifFalse:[ + labels := labels , #( + 'hierarchy' + 'definition' + 'comment' + 'class instvars' + "/ 'protocols' + '-' + ). + selectors := selectors , #( + classHierarchy + classDefinition + classComment + classClassInstVars + "/ classProtocols + nil + ). + ]. + + labels := labels , #( + "/ 'variable search' + 'class refs' + '-' + 'new class' + 'new subclass' + 'rename ...' + 'remove' + ). + selectors := selectors , #( + "/ variables + classRefs + nil + classNewClass + classNewSubclass + classRename + classRemove + ). + currentClass wasAutoloaded ifTrue:[ + labels := labels , #( + 'unload' + ). + selectors := selectors , #( + classUnload + ). + ] + ] + ]. + ]. ]. m := PopUpMenu - labels:(resources array:labels) - selectors:selectors. + labels:(resources array:labels) + selectors:selectors. (currentClass isNil or:[currentClass sourceCodeManager isNil]) ifTrue:[ - m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository). + m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository). ]. ^ m - "Modified: 7.12.1995 / 23:56:14 / cg" + "Modified: 12.12.1995 / 18:54:28 / cg" ! classNewClass @@ -1642,38 +1646,42 @@ "check a class into the source repository" currentClass isLoaded ifFalse:[ - self warn:'cannot checkin unloaded classes.'. - ^ self. + self warn:'cannot checkin unloaded classes.'. + ^ self. ]. self doClassMenu:[:currentClass | - |logMessage info mgr| - - mgr := (currentClass sourceCodeManager). - (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[ - ^ self classCreateSourceContainerFor:currentClass - ]. - - logMessage := Dialog - request:'enter a log message:' - initialAnswer:lastSourceLogMessage - onCancel:nil. - - logMessage notNil ifTrue:[ - lastSourceLogMessage := logMessage. - self busyLabel:'checking in %1' with:currentClass name. - (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[ - self warn:'checkin failed'. - ]. - aspect == #revisionInfo ifTrue:[ - self classListUpdate - ]. - self normalLabel. - ] + |logMessage info mgr| + + mgr := (currentClass sourceCodeManager). + info := mgr sourceInfoOfClass:currentClass. + (info isNil + or:[(info at:#classFileName ifAbsent:nil) isNil + or:[(info at:#module ifAbsent:nil) isNil + or:[(info at:#directory ifAbsent:nil) isNil]]]) ifTrue:[ + ^ self classCreateSourceContainerFor:currentClass + ]. + + logMessage := Dialog + request:'enter a log message:' + initialAnswer:lastSourceLogMessage + onCancel:nil. + + logMessage notNil ifTrue:[ + lastSourceLogMessage := logMessage. + self busyLabel:'checking in %1' with:currentClass name. + (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[ + self warn:'checkin failed'. + ]. + aspect == #revisionInfo ifTrue:[ + self classListUpdate + ]. + self normalLabel. + ] ] "Created: 23.11.1995 / 11:41:38 / cg" - "Modified: 9.12.1995 / 21:19:08 / cg" + "Modified: 12.12.1995 / 23:10:11 / cg" ! classCompareWithNewestInRepository @@ -1681,62 +1689,71 @@ with the most recent version found in the repository." currentClass isLoaded ifFalse:[ - self warn:'cannot compare unloaded classes.'. - ^ self. + self warn:'cannot compare unloaded classes.'. + ^ self. ]. self doClassMenu:[:currentClass | - |aStream comparedSource currentSource v rev revString mgr| - - mgr := currentClass sourceCodeManager. - - rev := Dialog request:'compare to revision: (empty for newest)'. - rev notNil ifTrue:[ - rev withoutSpaces isEmpty ifTrue:[ - self busyLabel:'extracting newest %1' with:currentClass name. - aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name. - revString := 'newest' - ] ifFalse:[ - self busyLabel:'extracting previous %1' with:currentClass name. - aStream := mgr sourceStreamFor:currentClass revision:rev. - revString := rev - ]. - aStream isNil ifTrue:[ - self warn:'could not extract source from repository'. - ^ self - ]. - comparedSource := aStream contents. - aStream close. - - self busyLabel:'generating current source ...' with:nil. - - aStream := '' writeStream. - currentClass fileOutOn:aStream withTimeStamp:false. - currentSource := aStream contents. - aStream close. - - self busyLabel:'comparing ...' with:nil. - v := DiffTextView - openOn:currentSource label:'current (' , currentClass revision , ')' - and:comparedSource label:'repository (' , revString , ')'. - v label:'comparing ' , currentClass name. - self normalLabel. - ] + |aStream comparedSource currentSource v rev revString thisRevString mgr| + + mgr := currentClass sourceCodeManager. + + rev := Dialog request:'compare to revision: (empty for newest)'. + rev notNil ifTrue:[ + rev withoutSpaces isEmpty ifTrue:[ + self busyLabel:'extracting newest %1' with:currentClass name. + aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name. + revString := 'newest' + ] ifFalse:[ + self busyLabel:'extracting previous %1' with:currentClass name. + aStream := mgr sourceStreamFor:currentClass revision:rev. + revString := rev + ]. + aStream isNil ifTrue:[ + self warn:'could not extract source from repository'. + ^ self + ]. + comparedSource := aStream contents. + aStream close. + + self busyLabel:'generating current source ...' with:nil. + + aStream := '' writeStream. + currentClass fileOutOn:aStream withTimeStamp:false. + currentSource := aStream contents. + aStream close. + + self busyLabel:'comparing ...' with:nil. + thisRevString := currentClass revision. + thisRevString isNil ifTrue:[ + thisRevString := '(no revision' + ]. + v := DiffTextView + openOn:currentSource label:'current (' , thisRevString , ')' + and:comparedSource label:'repository (' , revString , ')'. + v label:'comparing ' , currentClass name. + self normalLabel. + ] ] "Created: 14.11.1995 / 16:43:15 / cg" - "Modified: 9.12.1995 / 21:57:10 / cg" + "Modified: 12.12.1995 / 21:32:23 / cg" ! classCreateSourceContainerFor:aClass "let user specify the source-repository values for aClass" - self classDefineSourceContainerFor:aClass title:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs. - - "Modified: 9.12.1995 / 17:43:48 / cg" -! - -classDefineSourceContainerFor:aClass title:aTitle + self + classDefineSourceContainerFor:aClass + title:(resources string:'Repository information for %1' with:aClass name) + text:(resources string:'CREATE_REPOSITORY' with:currentClass name) + createDirectories:true + createContainer:true. + + "Modified: 12.12.1995 / 18:58:38 / cg" +! + +classDefineSourceContainerFor:aClass title:title text:boxText createDirectories:createDirs createContainer:createContainer "let user specify the source-repository values for aClass" |box @@ -1746,8 +1763,8 @@ check y component info fn project nm mgr| aClass isLoaded ifFalse:[ - self warn:'please load the class first'. - ^ self. + self warn:'please load the class first'. + ^ self. ]. "/ @@ -1760,14 +1777,14 @@ "/ try to extract some useful defaults from the current project "/ (Project notNil and:[(project := Project current) notNil]) ifTrue:[ - (nm := project repositoryDirectory) isNil ifTrue:[ - nm := project name - ]. - packageHolder value:nm. - - (nm := project repositoryModule) notNil ifTrue:[ - moduleHolder value:nm - ]. + (nm := project repositoryDirectory) isNil ifTrue:[ + nm := project name + ]. + packageHolder value:nm. + + (nm := project repositoryModule) notNil ifTrue:[ + moduleHolder value:nm + ]. ]. "/ @@ -1776,23 +1793,27 @@ "/ info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass. info notNil ifTrue:[ - (info includesKey:#module) ifTrue:[ - moduleHolder value:(info at:#module). - ]. - (info includesKey:#directory) ifTrue:[ - packageHolder value:(info at:#directory). - ]. - (info includesKey:#expectedFileName) ifTrue:[ - fn := (info at:#expectedFileName). - ] ifFalse:[ - (info includesKey:#classFileName) ifTrue:[ - fn := (info at:#classFileName). - ] - ] + (info includesKey:#module) ifTrue:[ + moduleHolder value:(info at:#module). + ]. + (info includesKey:#directory) ifTrue:[ + packageHolder value:(info at:#directory). + ]. + (info includesKey:#expectedFileName) ifTrue:[ + fn := (info at:#expectedFileName). + ] ifFalse:[ + (info includesKey:#fileName) ifTrue:[ + fn := (info at:#fileName). + ] ifFalse:[ + (info includesKey:#classFileName) ifTrue:[ + fn := (info at:#classFileName) , '.st'. + ] + ] + ] ]. fn isNil ifTrue:[ - fn := (Smalltalk fileNameForClass:aClass) , '.st'. + fn := (Smalltalk fileNameForClass:aClass) , '.st'. ]. fileNameHolder := fn asValue. @@ -1805,10 +1826,12 @@ "/ open a dialog for this "/ box := DialogBox new. - box label:(resources string:'Repository information for %1' with:aClass name). - - component := box addTextLabel:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs. + box label:title. + + component := box addTextLabel:boxText withCRs. component adjust:#left; borderWidth:0. + box addVerticalSpace. + box addVerticalSpace. y := box yPosition. component := box addTextLabel:(resources string:'Module:'). @@ -1841,64 +1864,80 @@ box showAtPointer. box accepted ifTrue:[ - aClass revisionString isNil ifTrue:[ - (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs) - ifFalse:[ - ^ self - ]. - aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass). - ]. - - module := moduleHolder value withoutSpaces. - package := packageHolder value withoutSpaces. - fileName := fileNameHolder value withoutSpaces. - - "/ - "/ check for the module - "/ - (mgr checkForExistingModule:module) ifFalse:[ - (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[ - ^ self. - ]. - (mgr createModule:module) ifFalse:[ - self warn:(resources string:'cannot create new module: %1' with:module). - ^ self. - ] - ]. - - "/ - "/ check for the package - "/ - (mgr checkForExistingModule:module package:package) ifFalse:[ - (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[ - ^ self. - ]. - (mgr createModule:module package:package) ifFalse:[ - self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module). - ^ self. - ] - ]. - - "/ - "/ check for the container itself - "/ - (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[ - self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs. - ^ self - ]. - - (mgr - createContainerFor:aClass - inModule:module - package:package - container:fileName) ifFalse:[ - self warn:(resources string:'failed to create container.'). - ^ self. - ]. + module := moduleHolder value withoutSpaces. + package := packageHolder value withoutSpaces. + fileName := fileNameHolder value withoutSpaces. + + aClass revisionString isNil ifTrue:[ + (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs) + ifFalse:[ + ^ self + ]. + aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass + inModule:module + package:package + container:fileName). + ]. + + "/ + "/ check for the module + "/ + (mgr checkForExistingModule:module) ifFalse:[ + createDirs ifFalse:[ + self warn:(resources string:'a module named %1 does not exist in the source code management' with:module). + ^ self + ]. + (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[ + ^ self. + ]. + (mgr createModule:module) ifFalse:[ + self warn:(resources string:'cannot create new module: %1' with:module). + ^ self. + ] + ]. + + "/ + "/ check for the package + "/ + (mgr checkForExistingModule:module package:package) ifFalse:[ + createDirs ifFalse:[ + self warn:(resources string:'a package named %1 does not exist module %2' with:module with:package). + ^ self + ]. + (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[ + ^ self. + ]. + (mgr createModule:module package:package) ifFalse:[ + self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module). + ^ self. + ] + ]. + + "/ + "/ check for the container itself + "/ + (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[ + self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs. + ^ self + ] ifFalse:[ + createContainer ifFalse:[ + self warn:(resources string:'no container exists for %1 in %2/%3' with:fileName with:module with:package). + ^ self + ] + ]. + + (mgr + createContainerFor:aClass + inModule:module + package:package + container:fileName) ifFalse:[ + self warn:(resources string:'failed to create container.'). + ^ self. + ]. ]. box destroy - "Modified: 9.12.1995 / 21:51:54 / cg" + "Modified: 12.12.1995 / 19:57:21 / cg" ! classLoadRevision @@ -1973,6 +2012,26 @@ "Modified: 9.12.1995 / 22:32:04 / cg" ! +classModifyContainer + "check a class into the source repository" + + currentClass isLoaded ifFalse:[ + self warn:'cannot checkin unloaded classes.'. + ^ self. + ]. + + self doClassMenu:[:currentClass | + self + classDefineSourceContainerFor:currentClass + title:(resources string:'Repository information for %1' with:currentClass name) + text:'defining/changing the source code container' + createDirectories:false createContainer:false. + ] + + "Created: 23.11.1995 / 11:41:38 / cg" + "Modified: 12.12.1995 / 18:58:02 / cg" +! + classRevisionInfo "show current classes revision info in codeView" @@ -6172,6 +6231,6 @@ !BrowserView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.67 1995-12-12 12:24:40 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.68 1995-12-12 22:11:41 cg Exp $' ! ! BrowserView initialize!