# HG changeset patch # User Claus Gittinger # Date 878063172 -3600 # Node ID 34c98fc48b14edafc07d641e0ac78bfbacc785dd # Parent 35f172e5657abdba0800e3fe01249d530a653d6f show resource-icon; better variableList (classInstVars) diff -r 35f172e5657a -r 34c98fc48b14 BrowserView.st --- a/BrowserView.st Sat Oct 25 01:11:06 1997 +0200 +++ b/BrowserView.st Tue Oct 28 19:26:12 1997 +0100 @@ -10,8 +10,6 @@ hereby transferred. " -'From Smalltalk/X, Version:3.2.1 on 14-oct-1997 at 11:20:25 pm' ! - StandardSystemView subclass:#BrowserView instanceVariableNames:'classCategoryListView classListView methodCategoryListView methodListView classMethodListView codeView classToggle @@ -22,9 +20,10 @@ lockUpdates autoSearch myLabel acceptClass lastSourceLogMessage lastCategory lastModule lastPackage lastMethodMoveClass namespaceList allNamespaces gotClassList classList selectorList - showAllNamespaces' + showAllNamespaces classInstVarsInVarList' classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon - StopIcon TraceIcon TimeIcon' + StopIcon TraceIcon TimeIcon CanvasIcon MenuIcon ImageIcon + ShowResourceIcons' poolDictionaries:'' category:'Interface-Browsers' ! @@ -76,6 +75,8 @@ "Browser configuration; (values can be changed from your private startup file)" + ShowResourceIcons := true. + " setting this to false, the removeClass function will remove classes WITHOUT checking for instances. Otherwise, @@ -97,22 +98,72 @@ CheckForInstancesWhenRemovingClasses := false RememberAspect := true RememberAspect := false + ShowResourceIcons := true + ShowResourceIcons := false " - "Created: 23.11.1995 / 11:35:58 / cg" - "Modified: 23.11.1995 / 11:36:34 / cg" + "Created: / 23.11.1995 / 11:35:58 / cg" + "Modified: / 27.10.1997 / 17:34:25 / cg" ! ! !BrowserView class methodsFor:'cleanup'! lowSpaceCleanup - DefaultIcon := nil - - "Created: 18.4.1996 / 16:46:40 / cg" + DefaultIcon := StopIcon := TraceIcon := TimeIcon := nil + + "Created: / 18.4.1996 / 16:46:40 / cg" + "Modified: / 25.10.1997 / 19:30:32 / cg" ! ! !BrowserView class methodsFor:'defaults'! +canvasIcon + "answer an icon to mark canvas (windowSpec) methods" + + |canvasIcon| + + CanvasIcon notNil ifTrue:[^ CanvasIcon]. + + canvasIcon := Depth1Image + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + ). + canvasIcon mask:(ImageMask + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + )). + canvasIcon maskedPixelsAre0:true. + canvasIcon colorMap:(Array with:Color white with:Color black). + CanvasIcon := canvasIcon. + ^ canvasIcon + + " + CanvasIcon := nil + " + + "Modified: / 28.10.1997 / 12:47:18 / cg" +! + defaultIcon "return the browsers default window icon" @@ -142,6 +193,105 @@ "Modified: 15.8.1997 / 15:29:16 / cg" ! +imageIcon + "answer an icon to mark image (menuSpec) methods" + + |imageIcon| + + ImageIcon notNil ifTrue:[^ ImageIcon]. + + imageIcon := Depth2Image + width:10 + height:10 + fromArray:#( + 4r0000 4r0000 4r0000 + 4r0111 4r1111 4r1000 + 4r0111 4r2221 4r1000 + 4r0112 4r2222 4r1000 + 4r0111 4r2221 4r1000 + 4r0111 4r1311 4r1000 + 4r0111 4r1311 4r1000 + 4r0111 4r1311 4r1000 + 4r0222 4r2222 4r1000 + 4r0000 4r0000 4r0000 + ). + + imageIcon colorMap:(Array + with:Color black + with:(Color rgbValue:16radd8e6) + with:(Color rgbValue:16r00cd00) + with:(Color rgbValue:16r853e26) + ). + ImageIcon := imageIcon. + ^ imageIcon + + " + ImageIcon := nil. + self imageIcon inspect + " + + "Created: / 28.10.1997 / 13:42:54 / cg" + "Modified: / 28.10.1997 / 14:09:39 / cg" +! + +menuIcon + "answer an icon to mark menu (menuSpec) methods" + + |menuIcon| + + MenuIcon notNil ifTrue:[^ MenuIcon]. + + menuIcon := Depth1Image + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + ). + menuIcon mask:(ImageMask + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + )). + menuIcon maskedPixelsAre0:true. + menuIcon colorMap:(Array with:Color white with:Color black). + MenuIcon := menuIcon. + ^ menuIcon + + " + MenuIcon := nil + " + + "Created: / 27.10.1997 / 00:38:06 / cg" + "Modified: / 27.10.1997 / 00:45:45 / cg" +! + +programMenuIcon + "answer an icon to mark programmed-menu (menuSpec) methods" + + ^ self menuIcon + + "Created: / 28.10.1997 / 13:40:49 / cg" +! + stopIcon "answer an icon to mark breakPointed methods" @@ -719,7 +869,7 @@ this test allows a smalltalk to be built without Projects/ChangeSets " Project notNil ifTrue:[ - fileName := Project currentProjectDirectory , fileName. + fileName := Project currentProjectDirectory asFilename constructString: fileName. ]. ]. @@ -750,8 +900,8 @@ ]. self normalLabel. - "Created: 11.10.1997 / 16:38:29 / cg" - "Modified: 11.10.1997 / 16:48:19 / cg" + "Created: / 11.10.1997 / 16:38:29 / cg" + "Modified: / 28.10.1997 / 14:35:50 / cg" ! classCategoryFileOutBinaryEach @@ -911,6 +1061,7 @@ classCategoryMenu + |specialMenu m labels selectors shorties| @@ -1084,8 +1235,8 @@ m subMenuAt:#otherMenu put:specialMenu. ^ m - "Created: 14.9.1995 / 10:50:17 / claus" - "Modified: 11.10.1997 / 17:08:16 / cg" + "Created: / 14.9.1995 / 10:50:17 / claus" + "Modified: / 27.10.1997 / 20:45:52 / cg" ! classCategoryNewCategory @@ -1890,7 +2041,7 @@ ! classDefinition - "show class definition in codeView and setup accept-action for + "show class definition in View and setup accept-action for a class-definition change. Extract documentation either from a documentation method or from the comment - not a biggy, but beginners will like @@ -1938,14 +2089,19 @@ aStream cr; cr; cr; cr; cr. aStream emphasis:(#color -> (Color red:0 green:0 blue:25)). s isNil ifTrue:[ - aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation found'. + aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation method found'. ] ifFalse:[ aStream nextPut:$" ; cr; nextPutLine:' Documentation:'. aStream cr; nextPutLine:s; cr. aStream nextPutLine:' Notice: '. - aStream nextPutAll:' the above string has been extracted from the classes '. + aStream nextPutAll:' the above text has been extracted from the classes '. aStream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']). - aStream nextPutLine:' It will not be preserved when accepting a new class definition.'. + aStream nextPutLine:' Any change in it will be lost if you ''accept'' here.'. + aStream nextPutAll:' To change the '. + aStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation']). + aStream nextPutAll:', switch to the '. + aStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation method']). + aStream nextPutLine:' and ''accept'' any changes there.'. ]. aStream nextPut:$". aStream emphasis:nil. @@ -1993,7 +2149,7 @@ self normalLabel ] - "Modified: 11.10.1997 / 16:25:42 / cg" + "Modified: / 25.10.1997 / 12:46:05 / cg" ! classDocumentation @@ -2260,291 +2416,292 @@ "sent by classListView to ask for the menu" + |specialMenu labels selectors shorties m newClassMenu spawnMenu idx| currentClass isNil ifTrue:[ - labels := #( - 'fileIn new from repository ...' - ). - - selectors := #( - classLoadNewRevision - ). + labels := #( + 'fileIn new from repository ...' + ). + + selectors := #( + classLoadNewRevision + ). ] ifFalse:[ - labels := #( - 'fileOut binary' - '-' - 'inspect class' - 'inspect instances' - '-' - 'make private class ...' - 'make public class' - '-' - 'primitive definitions' - 'primitive variables' - 'primitive functions' - '-' - 'source container ...' - 'remove source container ...' - '-' - 'revision log' - 'compare with repository ...' - '-' - 'check into source repository' - 'fileIn from repository ...' - ). - selectors := #( - classFileOutBinary - nil - classInspect - classInstancesInspect - nil - classMakePrivate - classMakePublic - nil - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions - nil - classModifyContainer - classRemoveContainer - nil - classRevisionInfo - classCompareWithRepository - nil - classCheckin - classLoadRevision - ). + labels := #( + 'fileOut binary' + '-' + 'inspect class' + 'inspect instances' + '-' + 'make private class ...' + 'make public class' + '-' + 'primitive definitions' + 'primitive variables' + 'primitive functions' + '-' + 'source container ...' + 'remove source container ...' + '-' + 'revision log' + 'compare with repository ...' + '-' + 'check into source repository' + 'fileIn from repository ...' + ). + selectors := #( + classFileOutBinary + nil + classInspect + classInstancesInspect + nil + classMakePrivate + classMakePublic + nil + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions + nil + classModifyContainer + classRemoveContainer + nil + classRevisionInfo + classCompareWithRepository + nil + classCheckin + classLoadRevision + ). ]. specialMenu := PopUpMenu - labels:(resources array:labels) - selectors:selectors - receiver:self. + labels:(resources array:labels) + selectors:selectors + receiver:self. currentClass notNil ifTrue:[ - currentClass sourceCodeManager isNil ifTrue:[ - specialMenu disableAll:#(classModifyContainer classRemoveContainer - classRevisionInfo - classLoadRevision classCheckin - classCompareWithRepository). - ]. - currentClass isPrivate ifTrue:[ - specialMenu disableAll:#( - classFileOutBinary - classMakePrivate - classModifyContainer - classRemoveContainer - classRevisionInfo - classLoadRevision classCheckin - classCompareWithRepository - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions). - ] ifFalse:[ - specialMenu disableAll:#( - classFileOutBinary - classMakePublic - ) - ] + currentClass sourceCodeManager isNil ifTrue:[ + specialMenu disableAll:#(classModifyContainer classRemoveContainer + classRevisionInfo + classLoadRevision classCheckin + classCompareWithRepository). + ]. + currentClass isPrivate ifTrue:[ + specialMenu disableAll:#( + classFileOutBinary + classMakePrivate + classModifyContainer + classRemoveContainer + classRevisionInfo + classLoadRevision classCheckin + classCompareWithRepository + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions). + ] ifFalse:[ + specialMenu disableAll:#( + classFileOutBinary + classMakePublic + ) + ] ] ifFalse:[ - SourceCodeManager isNil ifTrue:[ - specialMenu disableAll:#(classLoadNewRevision) - ] + SourceCodeManager isNil ifTrue:[ + specialMenu disableAll:#(classLoadNewRevision) + ] ]. (currentClass notNil and:[currentClass isLoaded not]) ifTrue:[ - specialMenu disableAll:#( - classInstancesInspect - classFileOutBinary - classMakePrivate - classMakePublic - classModifyContainer - classRemoveContainer - classRevisionInfo - classLoadRevision - classCheckin - classCompareWithRepository - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions). + specialMenu disableAll:#( + classInstancesInspect + classFileOutBinary + classMakePrivate + classMakePublic + classModifyContainer + classRemoveContainer + classRevisionInfo + classLoadRevision + classCheckin + classCompareWithRepository + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions). ]. device ctrlDown ifTrue:[ - ^ specialMenu + ^ specialMenu ]. currentClass isNil ifTrue:[ - labels := #( - 'new class' - ). - selectors := #( - classNewClass - ). + labels := #( + 'new class' + ). + selectors := #( + classNewClass + ). ] ifFalse:[ - currentClass isLoaded ifFalse:[ - labels := #( - 'documentation' - '-' - 'class refs' - '-' - 'new class' - '-' - 'load' - ). - selectors := #( - classDocumentation - nil - classRefs - nil - classNewClass - nil - classLoad - ). - ] ifTrue:[ - fullProtocol ifTrue:[ - labels := #( - 'hierarchy' - 'definition' - 'documentation' - 'comment' - 'class instvars' - ). - selectors := #( - classHierarchy - classDefinition - classDocumentation - classComment - classClassInstVars - ). - ] ifFalse:[ - labels := #( - 'fileOut' - 'fileOut as ...' - 'printOut' - 'printOut protocol' - " 'printOut full protocol' " - '-' - 'spawn ...' - '-' - ). - selectors := #( - classFileOut - classFileOutAs - classPrintOut - classPrintOutProtocol - " classPrintOutFullProtocol " - nil - spawnMenu - nil - ). - - spawnMenu := PopUpMenu - labels:(resources array:#('class' 'full protocol' 'hierarchy' 'subclasses')) - selectors:#(classSpawn classSpawnFullProtocol classSpawnHierarchy classSpawnSubclasses). - - - fullClass ifFalse:[ - labels := labels , #( - 'hierarchy' - 'definition' - 'documentation' - 'comment' - 'class instvars' - "/ 'protocols' - '-' - ). - selectors := selectors , #( - classHierarchy - classDefinition - classDocumentation - classComment - classClassInstVars - "/ classProtocols - nil - ). - ]. - - labels := labels , #( - 'class refs' - '-' - 'new ...' - ). - selectors := selectors , #( - classRefs - nil - newClassMenu - ). - - newClassMenu := PopUpMenu - labels:(resources array:#('class' 'subclass' 'private class')) - selectors:#(classNewClass classNewSubclass classNewPrivateClass). - - labels := labels , #( - 'rename ...' - 'remove' - ). - selectors := selectors , #( - classRename - classRemove - ). - - currentClass wasAutoloaded ifTrue:[ - labels := labels , #( - 'unload' - ). - selectors := selectors , #( - classUnload - ). - ] - ] - ]. + currentClass isLoaded ifFalse:[ + labels := #( + 'documentation' + '-' + 'class refs' + '-' + 'new class' + '-' + 'load' + ). + selectors := #( + classDocumentation + nil + classRefs + nil + classNewClass + nil + classLoad + ). + ] ifTrue:[ + fullProtocol ifTrue:[ + labels := #( + 'hierarchy' + 'definition' + 'documentation' + 'comment' + 'class instvars' + ). + selectors := #( + classHierarchy + classDefinition + classDocumentation + classComment + classClassInstVars + ). + ] ifFalse:[ + labels := #( + 'fileOut' + 'fileOut as ...' + 'printOut' + 'printOut protocol' + " 'printOut full protocol' " + '-' + 'spawn ...' + '-' + ). + selectors := #( + classFileOut + classFileOutAs + classPrintOut + classPrintOutProtocol + " classPrintOutFullProtocol " + nil + spawnMenu + nil + ). + + spawnMenu := PopUpMenu + labels:(resources array:#('class' 'full protocol' 'hierarchy' 'subclasses')) + selectors:#(classSpawn classSpawnFullProtocol classSpawnHierarchy classSpawnSubclasses). + + + fullClass ifFalse:[ + labels := labels , #( + 'hierarchy' + 'definition' + 'documentation' + 'comment' + 'class instvars' + "/ 'protocols' + '-' + ). + selectors := selectors , #( + classHierarchy + classDefinition + classDocumentation + classComment + classClassInstVars + "/ classProtocols + nil + ). + ]. + + labels := labels , #( + 'class refs' + '-' + 'new ...' + ). + selectors := selectors , #( + classRefs + nil + newClassMenu + ). + + newClassMenu := PopUpMenu + labels:(resources array:#('class' 'subclass' 'private class')) + selectors:#(classNewClass classNewSubclass classNewPrivateClass). + + labels := labels , #( + 'rename ...' + 'remove' + ). + selectors := selectors , #( + classRename + classRemove + ). + + currentClass wasAutoloaded ifTrue:[ + labels := labels , #( + 'unload' + ). + selectors := selectors , #( + classUnload + ). + ] + ] + ]. ]. shorties := (Array new:labels size) , #(nil #'Ctrl'). (idx := selectors identityIndexOf:#classNewClass) ~~ 0 ifTrue:[ - shorties at:idx put:#Cmdn + shorties at:idx put:#Cmdn ]. (idx := selectors identityIndexOf:#classLoad) ~~ 0 ifTrue:[ - shorties at:idx put:#Cmdl + shorties at:idx put:#Cmdl ]. (idx := selectors identityIndexOf:#classDocumentation) ~~ 0 ifTrue:[ - shorties at:idx put:#Cmdd + shorties at:idx put:#Cmdd ]. labels := labels , #( - '=' - 'others' - ). + '=' + 'others' + ). selectors := selectors , #( - nil - otherMenu - ). + nil + otherMenu + ). m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. newClassMenu notNil ifTrue:[ - m subMenuAt:#newClassMenu put:newClassMenu. + m subMenuAt:#newClassMenu put:newClassMenu. ]. spawnMenu notNil ifTrue:[ - m subMenuAt:#spawnMenu put:spawnMenu. + m subMenuAt:#spawnMenu put:spawnMenu. ]. (currentClass notNil and:[currentClass isPrivate]) ifTrue:[ - m disableAll:#( - classFileOut - ) + m disableAll:#( + classFileOut + ) ]. m subMenuAt:#otherMenu put:specialMenu. ^ m - "Modified: 3.7.1997 / 13:16:28 / cg" + "Modified: / 27.10.1997 / 20:45:56 / cg" ! classNewClass @@ -4613,40 +4770,40 @@ ! renameCurrentClassTo:aString - "helper - do the rename" + "helper - do the class-rename" self doClassMenu:[:currentClass | - |oldSym cls| - - "/ check if the target already exists - confirm if so. - - (cls := Smalltalk classNamed:aString) notNil ifTrue:[ - (self confirm:(resources string:'WARN_RENAME' - with:aString - with:cls category) withCRs) - ifFalse:[^ self] - ]. - - oldSym := currentClass name asSymbol. - - "/ - "/ renaming is actually more complicated as one might - "/ think (care for classVariables, privateClasses etc.) - "/ Smalltalk knows all about that ... - - Smalltalk renameClass:currentClass to:aString. - - self updateClassList. - self updateMethodCategoryListWithScroll:false. - self updateMethodListWithScroll:false. - self withBusyCursorDo:[ - Transcript showCR:('searching for users of ' , oldSym); endEntry. - SystemBrowser browseReferendsOf:oldSym warnIfNone:false - ] + |oldSym cls| + + "/ check if the target already exists - confirm if so. + + (cls := Smalltalk classNamed:aString) notNil ifTrue:[ + (self confirm:(resources string:'WARN_RENAME' + with:aString + with:cls category) withCRs) + ifFalse:[^ self] + ]. + + oldSym := currentClass name asSymbol. + + "/ + "/ renaming is actually more complicated as one might + "/ think (care for classVariables, privateClasses etc.) + "/ Smalltalk knows all about that ... + + Smalltalk renameClass:currentClass to:aString. + + self updateClassList. + self updateMethodCategoryListWithScroll:false. + self updateMethodListWithScroll:false. + self withBusyCursorDo:[ + Transcript showCR:('searching for users of ' , oldSym); endEntry. + SystemBrowser browseReferendsOf:oldSym warnIfNone:false + ] ] - "Created: 25.11.1995 / 13:02:53 / cg" - "Modified: 18.8.1997 / 15:44:33 / cg" + "Created: / 25.11.1995 / 13:02:53 / cg" + "Modified: / 25.10.1997 / 19:37:55 / cg" ! switchToClass:newClass @@ -4840,220 +4997,221 @@ "fileout all methods into one source file" |list classString selectorString cls mth outStream fileName append - fileBox| + fileBox f| append := false. fileBox := FileSaveBox - title:(resources string:'save methods in:') - okText:(resources string:'save') - abortText:(resources string:'cancel') - action:[:fName | fileName := fName]. + title:(resources string:'save methods in:') + okText:(resources string:'save') + abortText:(resources string:'cancel') + action:[:fName | fileName := fName]. fileBox appendAction:[:fName | fileName := fName. append := true]. fileBox initialText:'some_methods.st'. Project notNil ifTrue:[ - fileBox directory:Project currentProjectDirectory + fileBox directory:Project currentProjectDirectory ]. fileBox showAtPointer. - fileName notNil ifTrue:[ - " - if file exists, save original in a .sav file - " - fileName asFilename exists ifTrue:[ - fileName asFilename copyTo:(fileName , '.sav') - ]. - append ifTrue:[ - outStream := FileStream appendingOldFileNamed:fileName - ] ifFalse:[ - outStream := FileStream newFileNamed:fileName. - ]. - outStream isNil ifTrue:[ - ^ self warn:'cannot create: %1' with:fileName - ]. - self withBusyCursorDo:[ - list := classMethodListView list. - list do:[:line | - self busyLabel:'writing: ' with:line. - - classString := self classNameFromClassMethodString:line. - selectorString := self selectorFromClassMethodString:line. - - cls := self findClassNamed:classString. - cls isNil ifTrue:[ - self warn:'oops class %1 is gone' with:classString - ] ifFalse:[ - mth := cls compiledMethodAt:(selectorString asSymbol). - Class fileOutErrorSignal handle:[:ex | - |box answer| - box := YesNoBox - title:('fileOut error: ' - , ex errorString - , '\\continue anyway ?') withCRs - yesText:'continue' - noText:'abort'. - answer := box confirm. - box destroy. - answer ifTrue:[ - ex proceed - ]. - self normalLabel. - ^ self - ] do:[ - cls fileOutMethod:mth on:outStream. - ] - ] - ]. - outStream close. - self normalLabel. - ] + fileName isNil ifTrue:[^ self]. + + " + if file exists, save original in a .sav file + " + (f := fileName asFilename) exists ifTrue:[ + f copyTo:(f withSuffix: 'sav') + ]. + append ifTrue:[ + outStream := FileStream appendingOldFileNamed:fileName + ] ifFalse:[ + outStream := FileStream newFileNamed:fileName. + ]. + outStream isNil ifTrue:[ + ^ self warn:'cannot create: %1' with:fileName + ]. + self withBusyCursorDo:[ + list := classMethodListView list. + list do:[:line | + self busyLabel:'writing: ' with:line. + + classString := self classNameFromClassMethodString:line. + selectorString := self selectorFromClassMethodString:line. + + cls := self findClassNamed:classString. + cls isNil ifTrue:[ + self warn:'oops class %1 is gone' with:classString + ] ifFalse:[ + mth := cls compiledMethodAt:(selectorString asSymbol). + Class fileOutErrorSignal handle:[:ex | + |box answer| + box := YesNoBox + title:('fileOut error: ' + , ex errorString + , '\\continue anyway ?') withCRs + yesText:'continue' + noText:'abort'. + answer := box confirm. + box destroy. + answer ifTrue:[ + ex proceed + ]. + self normalLabel. + ^ self + ] do:[ + cls fileOutMethod:mth on:outStream. + ] + ] + ]. + outStream close. + self normalLabel. ] - "Modified: 17.6.1996 / 16:51:11 / stefan" - "Modified: 18.8.1997 / 15:43:43 / cg" + "Modified: / 17.6.1996 / 16:51:11 / stefan" + "Modified: / 28.10.1997 / 14:39:48 / cg" ! classMethodMenu + |labels selectors shorties m specialMenu| (currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[ - labels := #( - 'inspect method' - '-' - 'remove break/trace' - ). - - selectors := #( - methodInspect - nil - methodRemoveBreakOrTrace - ). + labels := #( + 'inspect method' + '-' + 'remove break/trace' + ). + + selectors := #( + methodInspect + nil + methodRemoveBreakOrTrace + ). ] ifFalse:[ - labels := #( - 'inspect method' - '-' - 'breakpoint' - 'breakpoint in ...' - '-' - 'trace' - 'trace sender' - 'trace full walkback' - '-' - 'start timing' - 'start counting' - 'start mem usage' - ). - - selectors := #( - methodInspect - nil - methodBreakPoint - methodBreakPointInProcess - nil - methodTrace - methodTraceSender - methodTraceFull - nil - methodStartTiming - methodStartCounting - methodStartMemoryUsage - ). + labels := #( + 'inspect method' + '-' + 'breakpoint' + 'breakpoint in ...' + '-' + 'trace' + 'trace sender' + 'trace full walkback' + '-' + 'start timing' + 'start counting' + 'start mem usage' + ). + + selectors := #( + methodInspect + nil + methodBreakPoint + methodBreakPointInProcess + nil + methodTrace + methodTraceSender + methodTraceFull + nil + methodStartTiming + methodStartCounting + methodStartMemoryUsage + ). ]. specialMenu := PopUpMenu - labels:(resources array:labels) - selectors:selectors. + labels:(resources array:labels) + selectors:selectors. device ctrlDown ifTrue:[ - currentMethod isNil ifTrue:[ - classMethodListView flash. - ^ nil - ]. - - ^ specialMenu + currentMethod isNil ifTrue:[ + classMethodListView flash. + ^ nil + ]. + + ^ specialMenu ]. labels := #( - 'fileOut' - 'fileOut all' - 'printOut' - '-' - 'browse' - 'spawn' - 'spawn class' - 'spawn full protocol' - 'spawn hierarchy' - '-' - 'senders ...' - 'implementors ...' - 'globals ...' + 'fileOut' + 'fileOut all' + 'printOut' + '-' + 'browse' + 'spawn' + 'spawn class' + 'spawn full protocol' + 'spawn hierarchy' + '-' + 'senders ...' + 'implementors ...' + 'globals ...' "/ '-' "/ 'breakpoint' "/ 'trace' "/ 'trace sender' - '-' - 'remove' - '-' - 'others' - ). + '-' + 'remove' + '-' + 'others' + ). shorties := #( - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - #Cmds - #Cmdi - #Cmdg + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + #Cmds + #Cmdi + #Cmdg "/ nil "/ nil "/ nil "/ nil - nil - nil - nil - #'Ctrl' - ). + nil + nil + nil + #'Ctrl' + ). selectors := #( - methodFileOut - classMethodFileOutAll - methodPrintOut - nil - classMethodBrowse - methodSpawn - classSpawn - classSpawnFullProtocol - classSpawnHierarchy - nil - methodSenders - methodImplementors - methodGlobalReferends + methodFileOut + classMethodFileOutAll + methodPrintOut + nil + classMethodBrowse + methodSpawn + classSpawn + classSpawnFullProtocol + classSpawnHierarchy + nil + methodSenders + methodImplementors + methodGlobalReferends "/ nil "/ methodBreakPoint "/ methodTrace "/ methodTraceSender - nil - methodRemove - nil - othersMenu - ). + nil + methodRemove + nil + othersMenu + ). m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. m subMenuAt:#othersMenu put:specialMenu. ^ m - "Modified: 7.3.1997 / 19:33:14 / cg" + "Modified: / 27.10.1997 / 20:46:00 / cg" ! ! !BrowserView methodsFor:'class-method stuff'! @@ -5359,68 +5517,69 @@ v := classCategoryListView. v notNil ifTrue:[ - v action:[:lineNr | self classCategorySelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - v list size == 0 ifTrue:[ - v list:(self listOfAllClassCategories). - ]. - " - tell classCategoryListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu. + v action:[:lineNr | self classCategorySelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + v list size == 0 ifTrue:[ + v list:(self listOfAllClassCategories). + ]. + " + tell classCategoryListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu. ]. v := classListView. v notNil ifTrue:[ - v action:[:lineNr | self classSelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell classListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#classMenu. + v action:[:lineNr | self classSelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell classListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#classMenu. ]. v := methodCategoryListView. v notNil ifTrue:[ - v action:[:lineNr | self methodCategorySelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell methodCategoryListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu. + v action:[:lineNr | self methodCategorySelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell methodCategoryListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu. ]. v := methodListView. v notNil ifTrue:[ - v action:[:lineNr | self methodSelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell methodListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu. + v action:[:lineNr | self methodSelection:lineNr]. + v doubleClickAction:[:lineNr | self methodDoubleClick:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell methodListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu. ]. v := classMethodListView. v notNil ifTrue:[ - v action:[:lineNr | self classMethodSelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell classMethodListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu. + v action:[:lineNr | self classMethodSelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell classMethodListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu. ]. v := variableListView. v notNil ifTrue:[ - v action:[:lineNr | self variableSelection:lineNr]. - v ignoreReselect:false. - v toggleSelect:true. - v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu. + v action:[:lineNr | self variableSelection:lineNr]. + v ignoreReselect:false. + v toggleSelect:true. + v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu. ]. " @@ -5428,11 +5587,11 @@ fullProtocol browsers better show the end initially " fullProtocol ifTrue:[ - classListView scrollToBottom. + classListView scrollToBottom. ] - "Modified: 26.5.1996 / 15:59:13 / cg" - "Created: 24.7.1997 / 18:14:59 / cg" + "Created: / 24.7.1997 / 18:14:59 / cg" + "Modified: / 27.10.1997 / 00:29:30 / cg" ! terminate @@ -5615,18 +5774,17 @@ |vpanel hpanel frame v spc nsHolder| styleSheet is3D ifTrue:[ - spc := ViewSpacing. + spc := ViewSpacing. ] ifFalse:[ - spc := 0 - ]. - - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) - in:self. + spc := 0 + ]. + + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. v := HVScrollableView for:SelectionInListView - miniScrollerH:true miniScrollerV:false - in:hpanel. + miniScrollerH:true miniScrollerV:false + in:hpanel. v origin:(0.0 @ 0.0) corner:(0.25 @ 1.0). classCategoryListView := v scrolledView. classCategoryListView delegate:self. @@ -5665,9 +5823,9 @@ namespaceList model:nsHolder. namespaceList label menuHolder:self; menuMessage:#nameSpaceMenu. nsHolder onChangeSend:#value - to:[ - self changeNameSpaceTo:nsHolder value - ]. + to:[ + self changeNameSpaceTo:nsHolder value + ]. v := HVScrollableView for:SelectionInListView miniScrollerH:true miniScrollerV:false in:hpanel. v origin:(0.5 @ 0.0) corner:(0.75 @ 1.0). @@ -5678,7 +5836,7 @@ self createCodeViewIn:vpanel - "Modified: 24.6.1997 / 18:55:17 / cg" + "Modified: / 25.10.1997 / 19:26:14 / cg" ! setupForClass:aClass @@ -5686,9 +5844,7 @@ |vpanel hpanel frame v| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. frame := View origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)in:hpanel. @@ -5698,12 +5854,12 @@ v := ScrollableView for:SelectionInListView in:frame. v origin:(0.0 @ 0.0) extent:[frame width - @ - (frame height - - ViewSpacing - - instanceToggle height - - instanceToggle borderWidth - + v borderWidth)]. + @ + (frame height + - ViewSpacing + - instanceToggle height + - instanceToggle borderWidth + + v borderWidth)]. methodCategoryListView := v scrolledView. methodCategoryListView delegate:self. @@ -5717,7 +5873,7 @@ self updateCodeView. self classDefinition. - "Modified: 27.10.1996 / 14:17:06 / cg" + "Modified: / 25.10.1997 / 19:26:26 / cg" ! setupForClass:aClass methodCategory:aMethodCategory @@ -5725,9 +5881,7 @@ |vpanel v| - vpanel := VariableVerticalPanel - origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. v := self createMethodListViewIn:vpanel atX:0.0. v corner:(1.0 @ 0.25). @@ -5741,7 +5895,7 @@ self updateMethodList. self updateCodeView. - "Modified: 2.3.1996 / 16:10:44 / cg" + "Modified: / 25.10.1997 / 19:26:35 / cg" ! setupForClass:aClass selector:selector @@ -5769,9 +5923,7 @@ |vpanel hpanel frame v| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel. @@ -5792,7 +5944,7 @@ self updateMethodList. self updateCodeView - "Modified: 27.10.1996 / 14:17:24 / cg" + "Modified: / 25.10.1997 / 19:26:49 / cg" ! setupForClassHierarchy:aClass @@ -5800,9 +5952,7 @@ |vpanel hpanel frame v cls| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. " notice: we use a different ratio here @@ -5822,7 +5972,7 @@ cls := aClass. cls isMeta ifTrue:[ - cls := cls soleInstance + cls := cls soleInstance ]. currentClassHierarchy := currentClass := actualClass := cls. self updateClassList. @@ -5832,10 +5982,10 @@ self updateCodeView. aClass isMeta ifTrue:[ - self instanceProtocol:false - ]. - - "Modified: 27.10.1996 / 14:17:30 / cg" + self instanceProtocol:false + ]. + + "Modified: / 25.10.1997 / 19:26:58 / cg" ! setupForClassList:aList @@ -5851,8 +6001,7 @@ |vpanel hpanel frame l v| - vpanel := VariableVerticalPanel - origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel. @@ -5868,13 +6017,13 @@ self createCodeViewIn:vpanel. l := (aList collect:[:entry | - entry isBehavior ifTrue:[ - entry name - ] ifFalse:[ - entry - ]]) asOrderedCollection. + entry isBehavior ifTrue:[ + entry name + ] ifFalse:[ + entry + ]]) asOrderedCollection. doSort ifTrue:[ - l sort. + l sort. ]. classListView list:l. gotClassList := true. @@ -5883,8 +6032,8 @@ self updateMethodList. self updateCodeView - "Created: 28.5.1996 / 13:52:47 / cg" - "Modified: 4.1.1997 / 19:45:30 / cg" + "Created: / 28.5.1996 / 13:52:47 / cg" + "Modified: / 25.10.1997 / 19:27:07 / cg" ! setupForFullClass @@ -5892,9 +6041,7 @@ |vpanel hpanel v| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. @@ -5911,6 +6058,8 @@ fullClass := true. self updateCodeView + + "Modified: / 25.10.1997 / 19:27:18 / cg" ! setupForFullClassProtocol:aClass @@ -5918,9 +6067,7 @@ |vpanel hpanel frame v cls| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. " notice: we use a different ratio here @@ -5943,7 +6090,7 @@ cls := aClass. cls isMeta ifTrue:[ - cls := cls soleInstance + cls := cls soleInstance ]. currentClassHierarchy := actualClass := acceptClass := currentClass := cls. fullProtocol := true. @@ -5954,10 +6101,10 @@ self updateCodeView. self updateVariableList. aClass isMeta ifTrue:[ - self instanceProtocol:false - ]. - - "Modified: 27.10.1996 / 14:17:47 / cg" + self instanceProtocol:false + ]. + + "Modified: / 25.10.1997 / 19:27:27 / cg" ! setupForList:aList @@ -5965,10 +6112,7 @@ |vpanel v| - vpanel := VariableVerticalPanel - origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. v := ScrollableView for:SelectionInListView in:vpanel. v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25). @@ -5980,14 +6124,14 @@ self createCodeViewIn:vpanel. aList size == 1 ifTrue:[ - classMethodListView setSelection:1. - self classMethodSelection:1. + classMethodListView setSelection:1. + self classMethodSelection:1. ]. self updateCodeView. "/ kludge - get trap icons self updateClassMethodListWithScroll:false keepSelection:true - "Modified: 3.3.1997 / 15:26:48 / cg" + "Modified: / 25.10.1997 / 19:27:40 / cg" ! ! !BrowserView methodsFor:'method category list menu'! @@ -6084,98 +6228,91 @@ cls := currentClass class. self withBusyCursorDo:[ - |nm names source| - - "/ add version method containing RCS template - "/ but only if not already present and its not a private class. - - cls isPrivate ifFalse:[ - (cls includesSelector:#version) ifFalse:[ - Compiler compile: + |nm names source| + + "/ add version method containing RCS template + "/ but only if not already present and its not a private class. + + cls isPrivate ifFalse:[ + (cls includesSelector:#version) ifFalse:[ + Compiler compile: 'version ^ ''$' , 'Header$'' ' - forClass:cls - inCategory:'documentation'. - ] - ]. - - "/ add copyright method containing your/your companies - "/ copyright template but only if not already present. - "/ this is only added, if specified in the - "/ COPYRIGHT_TEMPLATE_FILE resources. - - (cls includesSelector:#copyright) ifFalse:[ - fn := resources at:#'COPYRIGHT_TEMPLATE_FILE' default:nil. - fn notNil ifTrue:[ - fn := fn asFilename. - fn exists ifTrue:[ - txt := fn contents asString - ] - ]. - - txt notNil ifTrue:[ - txt := txt bindWith:(Date today year). - Compiler compile: + forClass:cls + inCategory:'documentation'. + ] + ]. + + "/ add copyright method containing your/your companies + "/ copyright template but only if not already present. + "/ this is only added, if specified in the + "/ COPYRIGHT_TEMPLATE_FILE resources. + + (cls includesSelector:#copyright) ifFalse:[ + fn := resources at:#'COPYRIGHT_TEMPLATE_FILE' default:nil. + fn notNil ifTrue:[ + fn := fn asFilename. + fn exists ifTrue:[ + txt := fn contents asString + ] + ]. + + txt notNil ifTrue:[ + txt := txt bindWith:(Date today year). + Compiler compile: 'copyright " ' , txt , ' " ' forClass:cls - inCategory:'documentation'. - ] - ]. - - "/ add documentation method containing doc template - "/ but only if not already present. - - (cls includesSelector:#documentation) ifFalse:[ - Compiler compile: + inCategory:'documentation'. + ] + ]. + + "/ add documentation method containing doc template + "/ but only if not already present. + + (cls includesSelector:#documentation) ifFalse:[ + Compiler compile: 'documentation " documentation to be added. " ' forClass:cls - inCategory:'documentation'. - ]. - - "/ add examples method containing examples template - "/ but only if not already present. - - (cls includesSelector:#examples) ifFalse:[ - Compiler compile: + inCategory:'documentation'. + ]. + + "/ add examples method containing examples template + "/ but only if not already present. + + (cls includesSelector:#examples) ifFalse:[ + Compiler compile: 'examples " examples to be added. " ' forClass:cls - inCategory:'documentation'. - ]. - - "/ add history method containing created-entry - "/ but only if not already present. - - (cls includesSelector:#history) ifFalse:[ - histStream := ReadWriteStream on: String new. - histStream nextPutLine: 'history'. - HistoryLine isBehavior ifTrue:[ - histStream nextPutLine: (HistoryLine newCreated printString). - ] ifFalse:[ - histStream cr. - ]. - Compiler compile:(histStream contents) - forClass:cls - inCategory:'documentation'. - ]. - - self instanceProtocol:false. - self switchToMethodNamed:#documentation + inCategory:'documentation'. + ]. + + "/ add history method containing created-entry + "/ but only if not already present. + + (cls includesSelector:#history) ifFalse:[ + HistoryManager notNil ifTrue:[ + HistoryManager createInitialHistoryMethodIn:cls + ]. + ]. + + self instanceProtocol:false. + self switchToMethodNamed:#documentation "/ self updateMethodCategoryListWithScroll:false. "/ self updateMethodListWithScroll:false ] - "Modified: 18.8.1997 / 15:44:13 / cg" + "Modified: / 24.10.1997 / 02:42:38 / cg" ! methodCategoryFileOut @@ -6201,62 +6338,65 @@ self whenMethodCategorySelected:[ - |fileName outStream| - - fileName := currentMethodCategory , '.st'. - fileName replaceAll:Character space with:$_. - " - this test allows a smalltalk to be built without Projects/ChangeSets - " - Project notNil ifTrue:[ - fileName := Project currentProjectDirectory , fileName. - ]. - " - if file exists, save original in a .sav file - " - fileName asFilename exists ifTrue:[ - fileName asFilename copyTo:(fileName , '.sav') - ]. - outStream := FileStream newFileNamed:fileName. - outStream isNil ifTrue:[ - ^ self warn:'cannot create: %1' with:fileName - ]. - - self busyLabel:'saving: ' with:currentMethodCategory. - Class fileOutErrorSignal handle:[:ex | - self warn:'cannot create: %1' with:ex parameter. - ex return - ] do:[ - Smalltalk allBehaviorsDo:[:class | - |hasMethodsInThisCategory| - - hasMethodsInThisCategory := false. - class methodDictionary do:[:method | - method category = currentMethodCategory ifTrue:[ - hasMethodsInThisCategory := true - ] - ]. - hasMethodsInThisCategory ifTrue:[ - class fileOutCategory:currentMethodCategory on:outStream. - outStream cr - ]. - hasMethodsInThisCategory := false. - class class methodDictionary do:[:method | - method category = currentMethodCategory ifTrue:[ - hasMethodsInThisCategory := true - ] - ]. - hasMethodsInThisCategory ifTrue:[ - class class fileOutCategory:currentMethodCategory on:outStream. - outStream cr - ] - ]. - ]. - outStream close. - self normalLabel. - ]. - - "Modified: 7.6.1996 / 09:03:56 / stefan" + |fileName outStream| + + fileName := (currentMethodCategory , '.st') asFilename. + fileName makeLegalFilename. + " + this test allows a smalltalk to be built without Projects/ChangeSets + " + Project notNil ifTrue:[ + fileName := Project currentProjectDirectory asFilename construct: fileName name. + ]. + " + if file exists, save original in a .sav file + " + fileName exists ifTrue:[ + fileName copyTo:(fileName withSuffix: 'sav') + ]. + + fileName := fileName pathName. + outStream := FileStream newFileNamed:fileName. + outStream isNil ifTrue:[ + ^ self warn:'cannot create: %1' with:fileName + ]. + + self busyLabel:'saving: ' with:currentMethodCategory. + Class fileOutErrorSignal handle:[:ex | + self warn:'cannot create: %1' with:ex parameter. + ex return + ] do:[ + Smalltalk allBehaviorsDo:[:class | + |hasMethodsInThisCategory| + + hasMethodsInThisCategory := false. + class methodDictionary do:[:method | + method category = currentMethodCategory ifTrue:[ + hasMethodsInThisCategory := true + ] + ]. + hasMethodsInThisCategory ifTrue:[ + class fileOutCategory:currentMethodCategory on:outStream. + outStream cr + ]. + hasMethodsInThisCategory := false. + class class methodDictionary do:[:method | + method category = currentMethodCategory ifTrue:[ + hasMethodsInThisCategory := true + ] + ]. + hasMethodsInThisCategory ifTrue:[ + class class fileOutCategory:currentMethodCategory on:outStream. + outStream cr + ] + ]. + ]. + outStream close. + self normalLabel. + ]. + + "Modified: / 7.6.1996 / 09:03:56 / stefan" + "Modified: / 28.10.1997 / 14:37:32 / cg" ! methodCategoryFindAnyMethod @@ -6283,114 +6423,115 @@ methodCategoryMenu + |labels selectors shorties i m varSel s| currentClass isNil ifTrue:[ - methodCategoryListView flash. - ^ nil + methodCategoryListView flash. + ^ nil ]. labels := #(). selectors := #(). currentMethodCategory notNil ifTrue:[ - labels := labels , #( - 'fileOut' - 'fileOut all' - 'printOut' - '-' - 'SPAWN_METHODCATEGORY' - 'spawn category' - '-' - ). - - selectors := selectors , #( - methodCategoryFileOut - methodCategoryFileOutAll - methodCategoryPrintOut - nil - methodCategorySpawn - methodCategorySpawnCategory - nil - ). + labels := labels , #( + 'fileOut' + 'fileOut all' + 'printOut' + '-' + 'SPAWN_METHODCATEGORY' + 'spawn category' + '-' + ). + + selectors := selectors , #( + methodCategoryFileOut + methodCategoryFileOutAll + methodCategoryPrintOut + nil + methodCategorySpawn + methodCategorySpawnCategory + nil + ). ]. labels := labels , #( - 'find method here ...' - 'find method ...' - '-' - 'new category ...' - 'copy category ...' - ). + 'find method here ...' + 'find method ...' + '-' + 'new category ...' + 'copy category ...' + ). selectors := selectors , #( - methodCategoryFindMethod - methodCategoryFindAnyMethod - nil - methodCategoryNewCategory - methodCategoryCopyCategory - ). + methodCategoryFindMethod + methodCategoryFindAnyMethod + nil + methodCategoryNewCategory + methodCategoryCopyCategory + ). showInstance ifFalse:[ - labels := labels , #( 'create access methods' ). - selectors := selectors , #( #methodCategoryCreateDocumentationMethods ). + labels := labels , #( 'create access methods' ). + selectors := selectors , #( #methodCategoryCreateDocumentationMethods ). ] ifTrue:[ - (variableListView notNil - and:[(varSel := variableListView selectionValue) notNil]) ifTrue:[ - s := 'create access methods (for ''%1'')' - ] ifFalse:[ - s := 'create access methods (for all)' - ]. - s := resources string:s with:varSel. - labels := labels , (Array with:s). - selectors := selectors , #( - methodCategoryCreateAccessMethods - ). + (variableListView notNil + and:[(varSel := variableListView selectionValue) notNil]) ifTrue:[ + s := 'create access methods (for ''%1'')' + ] ifFalse:[ + s := 'create access methods (for all)' + ]. + s := resources string:s with:varSel. + labels := labels , (Array with:s). + selectors := selectors , #( + methodCategoryCreateAccessMethods + ). ]. currentMethodCategory notNil ifTrue:[ - labels := labels , #( - '-' - 'rename ...' - 'remove' - ). - - selectors := selectors , #( - nil - methodCategoryRename - methodCategoryRemove - ). + labels := labels , #( + '-' + 'rename ...' + 'remove' + ). + + selectors := selectors , #( + nil + methodCategoryRename + methodCategoryRemove + ). ]. showInstance ifFalse:[ - labels := labels copy. - selectors := selectors copy. - i := labels indexOf:'create access methods'. - labels at:i put:'create documentation stubs'. - selectors at:i put:#methodCategoryCreateDocumentationMethods + labels := labels copy. + selectors := selectors copy. + i := labels indexOf:'create access methods'. + labels at:i put:'create documentation stubs'. + selectors at:i put:#methodCategoryCreateDocumentationMethods ]. shorties := Array new:(selectors size). (selectors includes:#methodCategoryNewCategory) ifTrue:[ - shorties at:(selectors indexOf:#methodCategoryNewCategory) put:#Cmdn + shorties at:(selectors indexOf:#methodCategoryNewCategory) put:#Cmdn ]. m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. currentClass isLoaded ifFalse:[ - m disableAll:#( - methodCategoryNewCategory - methodCategoryCopyCategory - methodCategoryCreateAccessMethods - ) + m disableAll:#( + methodCategoryNewCategory + methodCategoryCopyCategory + methodCategoryCreateAccessMethods + ) ]. ^ m - "Modified: 4.7.1997 / 10:03:55 / cg" + "Modified: / 27.10.1997 / 20:46:04 / cg" ! methodCategoryNewCategory @@ -7130,6 +7271,7 @@ "return a popupmenu as appropriate for the methodList" + |specialMenu m labels selectors shorties newLabels newSelectors @@ -7141,193 +7283,193 @@ localSearchLabels localSearchSelectors| currentMethod notNil ifTrue:[ - currentMethod isWrapped ifTrue:[ - (MessageTracer notNil - and:[MessageTracer isCountingMemoryUsage:currentMethod]) ifTrue:[ - brkLabels := #( - '-' - 'stop mem usage' - ). - - brkSelectors := #( - nil - methodStopMemoryUsage - ) - ] ifFalse:[ - (MessageTracer notNil - and:[MessageTracer isCounting:currentMethod]) ifTrue:[ - brkLabels := #( - '-' - 'stop counting' - ). - - brkSelectors := #( - nil - methodStopCounting - ) - ] ifFalse:[ - currentMethod isTimed ifTrue:[ - brkLabels := #( - '-' - 'stop timing' - ). - - brkSelectors := #( - nil - methodStopTiming - ) - ] ifFalse:[ - currentMethod isTraced ifTrue:[ - brkLabels := #( - '-' - 'remove trace' - ). - ] ifFalse:[ - brkLabels := #( - '-' - 'remove breakpoint' - ). - ]. - - brkSelectors := #( - nil - methodRemoveBreakOrTrace - ) - ] - ] - ] - ] ifFalse:[ - brkLabels := #( - '-' - 'breakpoint' - 'breakpoint in ...' - '-' - 'trace' - 'trace sender' - 'trace full walkback' - '-' - 'start timing' - 'start counting' - 'start mem usage' - ). - - brkSelectors := #( - nil - methodBreakPoint - methodBreakPointInProcess - nil - methodTrace - methodTraceSender - methodTraceFull - nil - methodStartTiming - methodStartCounting - methodStartMemoryUsage - ) - ]. - - Method methodPrivacySupported ifTrue:[ - labels := #( - 'inspect method' - 'compile to machine code' - 'decompile' - '-' - 'make public' - 'make private' - 'make protected' - 'make ignored' - ). - selectors := #( - methodInspect - methodSTCCompile - methodDecompile - nil - methodMakePublic - methodMakePrivate - methodMakeProtected - methodMakeIgnored - ) - ] ifFalse:[ - labels := #( - 'inspect method' - 'compile to machine code' - 'decompile' - ). - selectors := #( - methodInspect - methodSTCCompile - methodDecompile - ) - ]. - - actualClass isMeta ifTrue:[ - labels := #( - 'invoke method' - '-' - ) - , labels. - selectors := #( - methodInvoke - nil - ) - , selectors. - ]. - - labels := labels , brkLabels. - selectors := selectors , brkSelectors. - - specialMenu := PopUpMenu - labels:(resources array:labels) - selectors:selectors. - - currentMethod isPublic ifTrue:[ - specialMenu disable:#methodMakePublic - ]. - currentMethod isPrivate ifTrue:[ - specialMenu disable:#methodMakePrivate - ]. - currentMethod isProtected ifTrue:[ - specialMenu disable:#methodMakeProtected - ]. - currentMethod isIgnored ifTrue:[ - specialMenu disable:#methodMakeIgnored - ]. + currentMethod isWrapped ifTrue:[ + (MessageTracer notNil + and:[MessageTracer isCountingMemoryUsage:currentMethod]) ifTrue:[ + brkLabels := #( + '-' + 'stop mem usage' + ). + + brkSelectors := #( + nil + methodStopMemoryUsage + ) + ] ifFalse:[ + (MessageTracer notNil + and:[MessageTracer isCounting:currentMethod]) ifTrue:[ + brkLabels := #( + '-' + 'stop counting' + ). + + brkSelectors := #( + nil + methodStopCounting + ) + ] ifFalse:[ + currentMethod isTimed ifTrue:[ + brkLabels := #( + '-' + 'stop timing' + ). + + brkSelectors := #( + nil + methodStopTiming + ) + ] ifFalse:[ + currentMethod isTraced ifTrue:[ + brkLabels := #( + '-' + 'remove trace' + ). + ] ifFalse:[ + brkLabels := #( + '-' + 'remove breakpoint' + ). + ]. + + brkSelectors := #( + nil + methodRemoveBreakOrTrace + ) + ] + ] + ] + ] ifFalse:[ + brkLabels := #( + '-' + 'breakpoint' + 'breakpoint in ...' + '-' + 'trace' + 'trace sender' + 'trace full walkback' + '-' + 'start timing' + 'start counting' + 'start mem usage' + ). + + brkSelectors := #( + nil + methodBreakPoint + methodBreakPointInProcess + nil + methodTrace + methodTraceSender + methodTraceFull + nil + methodStartTiming + methodStartCounting + methodStartMemoryUsage + ) + ]. + + Method methodPrivacySupported ifTrue:[ + labels := #( + 'inspect method' + 'compile to machine code' + 'decompile' + '-' + 'make public' + 'make private' + 'make protected' + 'make ignored' + ). + selectors := #( + methodInspect + methodSTCCompile + methodDecompile + nil + methodMakePublic + methodMakePrivate + methodMakeProtected + methodMakeIgnored + ) + ] ifFalse:[ + labels := #( + 'inspect method' + 'compile to machine code' + 'decompile' + ). + selectors := #( + methodInspect + methodSTCCompile + methodDecompile + ) + ]. + + actualClass isMeta ifTrue:[ + labels := #( + 'invoke method' + '-' + ) + , labels. + selectors := #( + methodInvoke + nil + ) + , selectors. + ]. + + labels := labels , brkLabels. + selectors := selectors , brkSelectors. + + specialMenu := PopUpMenu + labels:(resources array:labels) + selectors:selectors. + + currentMethod isPublic ifTrue:[ + specialMenu disable:#methodMakePublic + ]. + currentMethod isPrivate ifTrue:[ + specialMenu disable:#methodMakePrivate + ]. + currentMethod isProtected ifTrue:[ + specialMenu disable:#methodMakeProtected + ]. + currentMethod isIgnored ifTrue:[ + specialMenu disable:#methodMakeIgnored + ]. ]. device ctrlDown ifTrue:[ - currentMethod isNil ifTrue:[ - methodListView flash. - ^ nil - ]. - - ^ specialMenu + currentMethod isNil ifTrue:[ + methodListView flash. + ^ nil + ]. + + ^ specialMenu ]. sepLocalLabels := sepLocalSelectors := #(). searchLabels := #( - 'senders ...' - 'implementors ...' - 'globals ...' - 'string search ...' - 'apropos ...' - ). + 'senders ...' + 'implementors ...' + 'globals ...' + 'string search ...' + 'apropos ...' + ). searchSelectors := #( - methodSenders - methodImplementors - methodGlobalReferends - methodStringSearch - methodAproposSearch - ). + methodSenders + methodImplementors + methodGlobalReferends + methodStringSearch + methodAproposSearch + ). searchShorties := #( - Cmds - Cmdi - Cmdg - Cmdt - Cmda - ). + Cmds + Cmdi + Cmdg + Cmdt + Cmda + ). "/ currentClass notNil ifTrue:[ "/ localSearchLabels := #( @@ -7351,141 +7493,161 @@ "/ ]. currentMethodCategory notNil ifTrue:[ - sepLocalLabels := #('-'). sepLocalSelectors := #(nil). - - newLabels := #( - 'new method' - ). - - newSelectors := #( - methodNewMethod - ). + sepLocalLabels := #('-'). sepLocalSelectors := #(nil). + + (currentClass notNil + and:[showInstance not + and:[currentClass isSubclassOf:ApplicationModel]]) ifTrue:[ + newLabels := #( + 'new method' + 'new window spec' + 'new menu spec' + '-' + ). + + newSelectors := #( + methodNewMethod + methodNewWindowSpec + methodNewMenuSpec + nil + ). + ] ifFalse:[ + newLabels := #( + 'new method' + '-' + ). + + newSelectors := #( + methodNewMethod + nil + ). + ] ] ifFalse:[ - newLabels := newSelectors := #() + newLabels := newSelectors := #() ]. currentMethod notNil ifTrue:[ - fileLabels := #( - 'fileOut' - 'printOut' - '-' - 'SPAWN_METHOD' - '-' - ). - - fileSelectors := #( - methodFileOut - methodPrintOut - nil - methodSpawn - nil - ). - - sepLocalLabels := #('-'). sepLocalSelectors := #(nil). - - mthdLabels := #( - 'change category ...' - 'move ...' - 'remove' - '-' - 'compare with previous' - 'back to previous' - ). - - mthdSelectors := #( - methodChangeCategory - methodMove - methodRemove - nil - methodCompareWithPreviousVersion - methodPreviousVersion - ). + fileLabels := #( + 'fileOut' + 'printOut' + '-' + 'SPAWN_METHOD' + '-' + ). + + fileSelectors := #( + methodFileOut + methodPrintOut + nil + methodSpawn + nil + ). + + sepLocalLabels := #('-'). sepLocalSelectors := #(nil). + + mthdLabels := #( + 'change category ...' + 'move ...' + 'remove' + '-' + 'compare with previous' + 'back to previous' + ). + + mthdSelectors := #( + methodChangeCategory + methodMove + methodRemove + nil + methodCompareWithPreviousVersion + methodPreviousVersion + ). ] ifFalse:[ - fileLabels := fileSelectors := #(). - mthdLabels := mthdSelectors := #(). + fileLabels := fileSelectors := #(). + mthdLabels := mthdSelectors := #(). ]. labels := - fileLabels , - searchLabels , + fileLabels , + searchLabels , "/ localSearchLabels , - sepLocalLabels , - newLabels , - mthdLabels. + sepLocalLabels , + newLabels , + mthdLabels. selectors := - fileSelectors , - searchSelectors , + fileSelectors , + searchSelectors , "/ localSearchSelectors , - sepLocalSelectors , - newSelectors , - mthdSelectors . + sepLocalSelectors , + newSelectors , + mthdSelectors . shorties := (Array new:(fileSelectors size)) - , searchShorties - , (Array new:(localSearchSelectors size - + sepLocalSelectors size - + newSelectors size - + mthdSelectors size)). + , searchShorties + , (Array new:(localSearchSelectors size + + sepLocalSelectors size + + newSelectors size + + mthdSelectors size)). specialMenu notNil ifTrue:[ - labels := labels , #( - '=' - 'others' - ). - selectors := selectors , #( - nil - #otherMenu - ). - shorties := shorties , #( nil #'Ctrl') + labels := labels , #( + '=' + 'others' + ). + selectors := selectors , #( + nil + #otherMenu + ). + shorties := shorties , #( nil #'Ctrl') ]. m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. specialMenu notNil ifTrue:[ - m subMenuAt:#otherMenu put:specialMenu. + m subMenuAt:#otherMenu put:specialMenu. ]. currentMethod notNil ifTrue:[ - currentMethod isPrivate ifTrue:[ - m disable:#methodMakePrivate - ]. - currentMethod isProtected ifTrue:[ - m disable:#methodMakeProtected - ]. - currentMethod isPublic ifTrue:[ - m disable:#methodMakePublic - ]. - currentMethod isIgnored ifTrue:[ - m disable:#methodMakeIgnored - ]. - - (currentMethod code notNil - or:[Compiler canCreateMachineCode not]) ifTrue:[ - m disable:#methodSTCCompile - ]. - currentMethod byteCode isNil ifTrue:[ - m disable:#methodDecompile - ]. - - currentMethod previousVersion isNil ifTrue:[ - m disable:#methodPreviousVersion. - m disable:#methodCompareWithPreviousVersion - ] + currentMethod isPrivate ifTrue:[ + m disable:#methodMakePrivate + ]. + currentMethod isProtected ifTrue:[ + m disable:#methodMakeProtected + ]. + currentMethod isPublic ifTrue:[ + m disable:#methodMakePublic + ]. + currentMethod isIgnored ifTrue:[ + m disable:#methodMakeIgnored + ]. + + (currentMethod code notNil + or:[Compiler canCreateMachineCode not]) ifTrue:[ + m disable:#methodSTCCompile + ]. + currentMethod byteCode isNil ifTrue:[ + m disable:#methodDecompile + ]. + + currentMethod previousVersion isNil ifTrue:[ + m disable:#methodPreviousVersion. + m disable:#methodCompareWithPreviousVersion + ] ]. ^ m - "Created: 23.11.1995 / 12:02:29 / cg" - "Modified: 18.12.1995 / 16:20:07 / stefan" - "Modified: 15.4.1997 / 10:19:00 / cg" - "Modified: 29.4.1997 / 11:20:59 / dq" + "Created: / 23.11.1995 / 12:02:29 / cg" + "Modified: / 18.12.1995 / 16:20:07 / stefan" + "Modified: / 29.4.1997 / 11:20:59 / dq" + "Modified: / 28.10.1997 / 12:35:15 / cg" ! methodMove @@ -7558,6 +7720,26 @@ "Modified: 25.6.1997 / 13:58:56 / cg" ! +methodNewMenuSpec + "open a MenuEditor" + + |specSel| + + currentClass isNil ifTrue:[ + ^ self warn:'select/create a class first'. + ]. + currentMethodCategory isNil ifTrue:[ + ^ self warn:'select/create a method category first'. + ]. + + (actualClass implements:#menuSpec) ifFalse:[ + specSel := #menuSpec + ]. + MenuEditor openOnClass:currentClass andSelector:specSel + + "Created: / 28.10.1997 / 12:42:00 / cg" +! + methodNewMethod "prepare for definition of a new method - put a template into code view and define accept-action to compile it" @@ -7580,6 +7762,26 @@ "Modified: 25.5.1996 / 13:02:44 / cg" ! +methodNewWindowSpec + "open GUI Painter" + + |specSel| + + currentClass isNil ifTrue:[ + ^ self warn:'select/create a class first'. + ]. + currentMethodCategory isNil ifTrue:[ + ^ self warn:'select/create a method category first'. + ]. + + (actualClass implements:#windowSpec) ifFalse:[ + specSel := #windowSpec + ]. + UIPainter openOnClass:currentClass andSelector:specSel + + "Modified: / 28.10.1997 / 12:40:35 / cg" +! + methodPreviousVersion "switch back to the previous version (undo last change)" @@ -7893,28 +8095,58 @@ "answer a method list entry (gimmic: adding a little image to breakPointed methods)" - |s icn| + |s icn resources| s := aMethod printStringForBrowserWithSelector:selector. + + "/ + "/ wrap icons (i.e. break- or trace points) + "/ have higher prio ... + "/ aMethod isWrapped ifTrue:[ - (s endsWith:' !!') ifTrue:[ - s := s copyWithoutLast:2 - ]. - aMethod isBreakpointed ifTrue:[ - icn := self stopIcon - ] ifFalse:[ - aMethod isTimed ifTrue:[ - icn := self timeIcon - ] ifFalse:[ - icn := self traceIcon - ] - ]. - ^ LabelAndIcon icon:icn string:s + (s endsWith:' !!') ifTrue:[ + s := s copyWithoutLast:2 + ]. + aMethod isBreakpointed ifTrue:[ + icn := self stopIcon + ] ifFalse:[ + aMethod isTimed ifTrue:[ + icn := self timeIcon + ] ifFalse:[ + icn := self traceIcon + ] + ]. + ]. + + icn isNil ifTrue:[ + ShowResourceIcons ~~ false ifTrue:[ + (resources := aMethod resources) notNil ifTrue:[ + (resources includesKey:#canvas) ifTrue:[ + icn := self canvasIcon + ] ifFalse:[ + (resources includesKey:#menu) ifTrue:[ + icn := self menuIcon + ] ifFalse:[ + (resources includesKey:#image) ifTrue:[ + icn := self imageIcon + ] ifFalse:[ + (resources includesKey:#programMenu) ifTrue:[ + icn := self programMenuIcon + ] + ] + ] + ] + ]. + ]. + ]. + + icn notNil ifTrue:[ + ^ LabelAndIcon icon:icn string:s ]. ^ s - "Created: 22.10.1996 / 19:51:00 / cg" - "Modified: 11.4.1997 / 17:16:19 / cg" + "Created: / 22.10.1996 / 19:51:00 / cg" + "Modified: / 28.10.1997 / 13:39:38 / cg" ! listOfAllMethodsInCategory:aCategory inFullProtocolHierarchyOfClass:aClass @@ -8066,6 +8298,27 @@ "Modified: 30.7.1997 / 15:29:16 / cg" ! +methodDoubleClick:lineNr + |resources| + + currentMethod notNil ifTrue:[ + currentMethod hasResource ifTrue:[ + resources := currentMethod resources. + (resources includesKey:#canvas) ifTrue:[ + UIPainter openOnClass:currentClass andSelector:currentSelector. + ^ self + ]. + (resources includesKey:#menu) ifTrue:[ + MenuEditor openOnClass:currentClass andSelector:currentSelector. + ^ self + ]. + ] + ] + + "Created: / 27.10.1997 / 00:29:58 / cg" + "Modified: / 28.10.1997 / 12:45:05 / cg" +! + methodSelection:lineNr "user clicked on a method line - show code" @@ -8356,52 +8609,54 @@ "/ update the list, caring for traps. classMethodListView list do:[:entry | - |cls sel mthd s icn| - - cls := self classFromClassMethodString:entry string. - sel := self selectorFromClassMethodString:entry string. - (cls isNil or:[sel isNil]) ifTrue:[ - "/ method is gone ? - s := entry string. - (s endsWith:'???') ifFalse:[ - s := s , ' ???'. - ]. - newList add:s - ] ifFalse:[ - mthd := cls compiledMethodAt:(sel asSymbol). - mthd isNil ifTrue:[ - newList add:cls name , ' ' , sel , ' ???' - ] ifFalse:[ - s := cls name , ' ' , (mthd printStringForBrowserWithSelector:sel). - mthd isWrapped ifTrue:[ - (s endsWith:' !!') ifTrue:[ - s := s copyWithoutLast:2 - ]. - (s endsWith:' !!') ifTrue:[ - s := s copyWithoutLast:2 - ]. - mthd isBreakpointed ifTrue:[ - icn := self stopIcon - ] ifFalse:[ - mthd isTimed ifTrue:[ - icn := self timeIcon - ] ifFalse:[ - icn := self traceIcon - ] - ]. - newList add:(LabelAndIcon icon:icn string:s) - ] ifFalse:[ - newList add:s - ]. - ]. - ]. + |cls sel mthd s icn| + + cls := self classFromClassMethodString:entry string. + sel := self selectorFromClassMethodString:entry string. + (cls isNil or:[sel isNil]) ifTrue:[ + "/ method is gone ? + s := entry string. + (s endsWith:'???') ifFalse:[ + s := s , ' ???'. + ]. + newList add:s + ] ifFalse:[ + mthd := cls compiledMethodAt:(sel asSymbol). + mthd isNil ifTrue:[ + newList add:cls name , ' ' , sel , ' ???' + ] ifFalse:[ + newList add:(self listEntryForMethod:mthd selector:(cls name , ' ' , sel)) + +"/ s := cls name , ' ' , (mthd printStringForBrowserWithSelector:sel). +"/ mthd isWrapped ifTrue:[ +"/ (s endsWith:' !!') ifTrue:[ +"/ s := s copyWithoutLast:2 +"/ ]. +"/ (s endsWith:' !!') ifTrue:[ +"/ s := s copyWithoutLast:2 +"/ ]. +"/ mthd isBreakpointed ifTrue:[ +"/ icn := self stopIcon +"/ ] ifFalse:[ +"/ mthd isTimed ifTrue:[ +"/ icn := self timeIcon +"/ ] ifFalse:[ +"/ icn := self traceIcon +"/ ] +"/ ]. +"/ newList add:(LabelAndIcon icon:icn string:s) +"/ ] ifFalse:[ +"/ newList add:s +"/ ]. + ]. + ]. ]. classMethodListView setList:newList. classMethodListView setSelection:selection. - "Modified: 18.12.1995 / 22:54:04 / stefan" - "Created: 3.3.1997 / 15:10:15 / cg" - "Modified: 24.4.1997 / 17:14:23 / cg" + "Modified: / 18.12.1995 / 22:54:04 / stefan" + "Created: / 3.3.1997 / 15:10:15 / cg" + "Modified: / 26.10.1997 / 16:52:32 / cg" ! updateMethodList @@ -9565,29 +9820,36 @@ is defined; needs either #instVarNames or #classVarNames as aSelector." - |cls homeClass| + |cls homeClass list| " first, find the class, where the variable is declared " cls := currentClass. [cls notNil] whileTrue:[ - ((cls perform:aSelector) includes:aVariableName) ifTrue:[ - homeClass := cls. - cls := nil. - ] ifFalse:[ - cls := cls superclass - ] + aSelector == #classInstVarNames ifTrue:[ + list := cls class instVarNames + ] ifFalse:[ + list := cls perform:aSelector + ]. + (list includes:aVariableName) ifTrue:[ + homeClass := cls. + cls := nil. + ] ifFalse:[ + cls := cls superclass + ] ]. homeClass isNil ifTrue:[ - "nope, must be one below ... (could optimize a bit, by searching down - for the declaring class ... - " - homeClass := currentClass + "nope, must be one below ... (could optimize a bit, by searching down + for the declaring class ... + " + homeClass := currentClass ] ifFalse:[ "/ Transcript showCR:'starting search in ' , homeClass name. ]. ^ homeClass + + "Modified: / 25.10.1997 / 20:26:25 / cg" ! hideMethodCategoryList @@ -9901,12 +10163,48 @@ !BrowserView methodsFor:'private - defaults'! +canvasIcon + "answer an icon to mark canvas (windowSpec) methods" + + ^ self class canvasIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 26.10.1997 / 16:25:54 / cg" +! + commentEmphasis ^ (#color -> (Color red:0 green:0 blue:25)) "Created: 1.8.1997 / 12:36:14 / cg" ! +imageIcon + "answer an icon to mark image methods" + + ^ self class imageIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 28.10.1997 / 13:35:35 / cg" +! + +menuIcon + "answer an icon to mark menu (menuSpec) methods" + + ^ self class menuIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 27.10.1997 / 00:41:04 / cg" +! + +programMenuIcon + "answer an icon to mark programmed-menu (menuSpec) methods" + + ^ self class programMenuIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 28.10.1997 / 13:35:16 / cg" +! + stopIcon "answer an icon to mark breakPointed methods" @@ -9990,106 +10288,148 @@ !BrowserView methodsFor:'variable list menu'! -allClassOrInstVarRefsTitle:title access:access mods:modifications - "show an enterbox for instVar to search for" - - self doClassMenu:[:currentClass | - |box| - - box := self enterBoxForVariableSearch:title. - box action:[:aVariableName | - |homeClass| - - aVariableName isEmpty ifFalse:[ - self withSearchCursorDo:[ - homeClass := self findClassOfVariable:aVariableName accessWith:access. - access == #classVarNames ifTrue:[ - SystemBrowser - browseClassRefsTo:aVariableName - under:homeClass - modificationsOnly:modifications - ] ifFalse:[ - SystemBrowser - browseInstRefsTo:aVariableName - under:homeClass - modificationsOnly:modifications - ] - ] - ] - ]. - box showAtPointer - ] - - "Created: 23.11.1995 / 14:13:24 / cg" +allClassInstVarMods + "show an enterbox for classVar to search for" + + self allVarRefsTitle:'class instance variable to browse all modifications of:' + access:#classInstVarNames + mods:true + + "Modified: / 25.10.1997 / 20:19:49 / cg" + "Created: / 25.10.1997 / 20:21:48 / cg" +! + +allClassInstVarRefs + "show an enterbox for classVar to search for" + + self allVarRefsTitle:'class instance variable to browse all references to:' + access:#classInstVarNames + mods:false + + "Modified: / 25.10.1997 / 20:20:09 / cg" + "Created: / 25.10.1997 / 20:22:14 / cg" ! allClassVarMods "show an enterbox for classVar to search for" - self allClassOrInstVarRefsTitle:'class variable to browse modifications of:' - access:#classVarNames - mods:true + self allVarRefsTitle:'class variable to browse all modifications of:' + access:#classVarNames + mods:true + + "Modified: / 25.10.1997 / 20:22:24 / cg" ! allClassVarRefs "show an enterbox for classVar to search for" - self allClassOrInstVarRefsTitle:'class variable to browse references to:' - access:#classVarNames - mods:false + self allVarRefsTitle:'class variable to browse all references to:' + access:#classVarNames + mods:false + + "Modified: / 25.10.1997 / 20:22:30 / cg" ! allInstVarMods "show an enterbox for instVar to search for" - self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:' - access:#instVarNames - mods:true + self allVarRefsTitle:'instance variable to browse all modifications of:' + access:#instVarNames + mods:true + + "Modified: / 25.10.1997 / 20:22:35 / cg" ! allInstVarRefs "show an enterbox for instVar to search for" - self allClassOrInstVarRefsTitle:'instance variable to browse references to:' - access:#instVarNames - mods:false + self allVarRefsTitle:'instance variable to browse all references to:' + access:#instVarNames + mods:false + + "Modified: / 25.10.1997 / 20:22:40 / cg" +! + +allVarRefsTitle:title access:access mods:modifications + "show an enterbox for instVar to search for" + + self doClassMenu:[:currentClass | + |box| + + box := self enterBoxForVariableSearch:title. + box action:[:aVariableName | + |homeClass| + + aVariableName isEmpty ifFalse:[ + self withSearchCursorDo:[ + homeClass := self findClassOfVariable:aVariableName accessWith:access. + access == #classVarNames ifTrue:[ + SystemBrowser + browseClassRefsTo:aVariableName + under:homeClass + modificationsOnly:modifications + ] ifFalse:[ + access == #classInstVarNames ifTrue:[ + SystemBrowser + browseInstRefsTo:aVariableName + under:homeClass class + modificationsOnly:modifications + ] ifFalse:[ + SystemBrowser + browseInstRefsTo:aVariableName + under:homeClass + modificationsOnly:modifications + ] + ] + ] + ] + ]. + box showAtPointer + ] + + "Created: / 25.10.1997 / 20:19:26 / cg" +! + +classInstVarMods + "show an enterbox for classVar to search for" + + self varRefsOrModsTitle:'class instance variable to browse modifications of:' + access:#classInstVarNames + mods:true + + "Modified: / 25.10.1997 / 20:17:41 / cg" + "Created: / 25.10.1997 / 20:21:04 / cg" +! + +classInstVarRefs + "show an enterbox for classVar to search for" + + self varRefsOrModsTitle:'class instance variable to browse references to:' + access:#classInstVarNames + mods:false + + "Modified: / 25.10.1997 / 20:17:23 / cg" + "Created: / 25.10.1997 / 20:21:19 / cg" ! classVarMods "show an enterbox for classVar to search for" - self classVarRefsOrModsTitle:'class variable to browse modifications of:' - mods:true + self varRefsOrModsTitle:'class variable to browse modifications of:' + access:#classVarNames + mods:true + + "Modified: / 25.10.1997 / 20:17:41 / cg" ! classVarRefs "show an enterbox for classVar to search for" - self classVarRefsOrModsTitle:'class variable to browse references to:' - mods:false -! - -classVarRefsOrModsTitle:title mods:mods - "show an enterbox for classVar to search for" - - self doClassMenu:[:currentClass | - |box| - - box := self enterBoxForVariableSearch:title. - box action:[:aString | - aString notEmpty ifTrue:[ - self withSearchCursorDo:[ - SystemBrowser - browseClassRefsTo:aString - in:(Array with:currentClass) - modificationsOnly:mods - ] - ] - ]. - box showAtPointer - ] - - "Created: 23.11.1995 / 14:12:56 / cg" + self varRefsOrModsTitle:'class variable to browse references to:' + access:#classVarNames + mods:false + + "Modified: / 25.10.1997 / 20:17:23 / cg" ! enterBoxForVariableSearch:title @@ -10111,38 +10451,69 @@ instVarMods "show an enterbox for instVar to search for" - self instVarRefsOrModsTitle:'instance variable to browse modifications of:' - mods:true + self varRefsOrModsTitle:'instance variable to browse modifications of:' + access:#instVarNames + mods:true + + "Modified: / 25.10.1997 / 20:14:52 / cg" ! instVarRefs "show an enterbox for instVar to search for" - self instVarRefsOrModsTitle:'instance variable to browse references to:' - mods:false -! - -instVarRefsOrModsTitle:title mods:mods + self varRefsOrModsTitle:'instance variable to browse references to:' + access:#instVarNames + mods:false + + "Modified: / 25.10.1997 / 20:14:27 / cg" +! + +showClassInstVars + classInstVarsInVarList := true. + self updateVariableList. + + "Created: / 25.10.1997 / 19:43:04 / cg" + "Modified: / 25.10.1997 / 19:43:41 / cg" +! + +showClassVars + classInstVarsInVarList := false. + self updateVariableList. + + "Created: / 25.10.1997 / 19:42:55 / cg" + "Modified: / 25.10.1997 / 19:43:35 / cg" +! + +varRefsOrModsTitle:title access:accessor mods:mods "show an enterbox for instvar to search for" self doClassMenu:[:currentClass | - |box| - - box := self enterBoxForVariableSearch:title. - box action:[:aString | - aString notEmpty ifTrue:[ - self withSearchCursorDo:[ - SystemBrowser - browseInstRefsTo:aString - in:(Array with:currentClass) - modificationsOnly:mods - ] - ] - ]. - box showAtPointer + |box| + + box := self enterBoxForVariableSearch:title. + box action:[:aString | + aString notEmpty ifTrue:[ + self withSearchCursorDo:[ + |sel classes| + + sel := #'browseInstRefsTo:in:modificationsOnly:'. + accessor == #classInstVarNames ifTrue:[ + classes := Array with:currentClass class. + ] ifFalse:[ + classes := Array with:currentClass. + accessor == #classVarNames ifTrue:[ + sel := #'browseClassRefsTo:in:modificationsOnly:' + ] + ]. + SystemBrowser perform:sel with:aString with:classes with:mods + ] + ] + ]. + box showAtPointer ] - "Created: 23.11.1995 / 14:12:40 / cg" + "Created: / 25.10.1997 / 20:12:52 / cg" + "Modified: / 25.10.1997 / 21:10:34 / cg" ! varTypeInfo @@ -10268,56 +10639,101 @@ ! variableListMenu + + |labels selectors m| currentClass isNil ifTrue:[ - variableListView flash. - ^ nil - ]. - - labels := #( - 'instvar refs ...' - 'classvar refs ...' - 'all instvar refs ...' - 'all classvar refs ...' - '-' - 'instvar mods ...' - 'classvar mods ...' - 'all instvar mods ...' - 'all classvar mods ...' - ). - selectors := #( - instVarRefs - classVarRefs - allInstVarRefs - allClassVarRefs - nil - instVarMods - classVarMods - allInstVarMods - allClassVarMods - ). + variableListView flash. + ^ nil + ]. + + showInstance ifFalse:[ + labels := #( + 'class instvar refs ...' + 'class instvar mods ...' + 'classvar refs ...' + 'classvar mods ...' + '-' + 'all class instvar refs ...' + 'all class instvar mods ...' + 'all classvar refs ...' + 'all classvar mods ...' + ). + selectors := #( + classInstVarRefs + classInstVarMods + classVarRefs + classVarMods + nil + allClassInstVarRefs + allClassInstVarMods + allClassVarRefs + allClassVarMods + ). + ] ifTrue:[ + labels := #( + 'instvar refs ...' + 'instvar mods ...' + 'classvar refs ...' + 'classvar mods ...' + '-' + 'all instvar refs ...' + 'all classvar refs ...' + 'all instvar mods ...' + 'all classvar mods ...' + ). + selectors := #( + instVarRefs + instVarMods + classVarRefs + classVarMods + nil + allInstVarRefs + allClassVarRefs + allInstVarMods + allClassVarMods + ). + ]. + + showInstance ifFalse:[ + classInstVarsInVarList == true ifTrue:[ + labels := labels , #('-' 'show classVars'). + selectors := selectors , #(nil #showClassVars). + ] ifFalse:[ + labels := labels , #('-' 'show classInstVars'). + selectors := selectors , #(nil #showClassInstVars). + ]. + ]. ("showInstance and:[" variableListView hasSelection "]" ) ifTrue:[ - labels := labels , #( - '-' - 'type information' - ). - selectors := selectors , #( - nil - varTypeInfo - ). - ]. - - m := PopUpMenu labels:(resources array:labels) - selectors:selectors. + labels := labels , #( + '-' + 'type information' + ). + selectors := selectors , #( + nil + varTypeInfo + ). + ]. + + m := PopUpMenu + labels:(resources array:labels) + selectors:selectors. + + currentClass instSize == 0 ifTrue:[ + m disableAll:#(instVarRefs instVarMods). + currentClass subclasses size == 0 ifTrue:[ + m disableAll:#(allInstVarRefs allInstVarMods). + ] + ]. currentClass isLoaded ifFalse:[ - m disableAll + m disableAll ]. ^ m - "Modified: 3.1.1997 / 11:57:27 / cg" + "Modified: / 27.10.1997 / 20:45:17 / cg" ! variableSelection:lineNr @@ -10417,94 +10833,97 @@ name isNil ifTrue:[^ self]. self withSearchCursorDo:[ - |classes filter any supers| - - classes := Array with:actualClass. - (currentClassHierarchy notNil and:[fullProtocol]) ifTrue:[ - supers := actualClass allSuperclasses. - supers notNil ifTrue:[ - classes := classes , supers. - ]. - redefinedSelectors := IdentitySet new. - ]. - - filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false. - - methodListView notNil ifTrue:[ - methodList := methodListView list. - ]. - methodCategoryListView notNil ifTrue:[ - methodCategoryList := methodCategoryListView list. - ]. - - any := false. - - " - highlight the method that ref this variable - " - classes do:[:someClass | - (fullProtocol - and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[ - someClass methodDictionary keysAndValuesDo:[:selector :method | - (inCat - or:[methodList notNil - and:[methodList includes:selector]]) - ifTrue:[ - (redefinedSelectors isNil - or:[(redefinedSelectors includes:selector) not]) - ifTrue:[ - (filter value:someClass value:method value:selector) ifTrue:[ - |idx cat| - - (inCat - and:[methodCategoryList notNil]) ifTrue:[ - cat := method category. - " - highlight the methodCategory - " - idx := methodCategoryListView list indexOf:cat. - idx ~~ 0 ifTrue:[ - entry := methodCategoryListView at:idx. - entry := self hilightEntryFor:entry. - methodCategoryListView at:idx put:entry + |classes filter any supers| + + classes := Array with:actualClass. + (currentClassHierarchy notNil and:[fullProtocol]) ifTrue:[ + supers := actualClass allSuperclasses. + supers notNil ifTrue:[ + classes := classes , supers. + ]. + redefinedSelectors := IdentitySet new. + ]. + + filter := SystemBrowser + filterToSearchRefsTo:name + classVars:(showInstance not and:[classInstVarsInVarList ~~ true]) + modificationsOnly:false. + + methodListView notNil ifTrue:[ + methodList := methodListView list. + ]. + methodCategoryListView notNil ifTrue:[ + methodCategoryList := methodCategoryListView list. + ]. + + any := false. + + " + highlight the method that ref this variable + " + classes do:[:someClass | + (fullProtocol + and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[ + someClass methodDictionary keysAndValuesDo:[:selector :method | + (inCat + or:[methodList notNil + and:[methodList includes:selector]]) + ifTrue:[ + (redefinedSelectors isNil + or:[(redefinedSelectors includes:selector) not]) + ifTrue:[ + (filter value:someClass value:method value:selector) ifTrue:[ + |idx cat| + + (inCat + and:[methodCategoryList notNil]) ifTrue:[ + cat := method category. + " + highlight the methodCategory + " + idx := methodCategoryListView list indexOf:cat. + idx ~~ 0 ifTrue:[ + entry := methodCategoryListView at:idx. + entry := self hilightEntryFor:entry. + methodCategoryListView at:idx put:entry "/ methodCategoryListView attributeAt:idx put:#bold. - ]. - ]. - - (inMethods - and:[methodList notNil]) ifTrue:[ - " - highlight the method - " - idx := methodListView list - findFirst:[:item | item string = selector - or:[item string startsWith:(selector , ' ')] - ]. - idx ~~ 0 ifTrue:[ - entry := methodListView at:idx. - entry := self hilightEntryFor:entry. - methodListView at:idx put:entry + ]. + ]. + + (inMethods + and:[methodList notNil]) ifTrue:[ + " + highlight the method + " + idx := methodListView list + findFirst:[:item | item string = selector + or:[item string startsWith:(selector , ' ')] + ]. + idx ~~ 0 ifTrue:[ + entry := methodListView at:idx. + entry := self hilightEntryFor:entry. + methodListView at:idx put:entry "/ methodListView attributeAt:idx put:#bold. - ]. - any := true - ]. - ]. - redefinedSelectors notNil ifTrue:[ - redefinedSelectors add:selector - ] - ] - ] - ] - ] - ]. - any ifTrue:[ - self setSearchPattern:name - ] + ]. + any := true + ]. + ]. + redefinedSelectors notNil ifTrue:[ + redefinedSelectors add:selector + ] + ] + ] + ] + ] + ]. + any ifTrue:[ + self setSearchPattern:name + ] ] - "Created: 23.11.1995 / 14:12:08 / cg" - "Modified: 5.6.1996 / 11:38:19 / stefan" - "Modified: 22.10.1996 / 23:37:25 / cg" + "Created: / 23.11.1995 / 14:12:08 / cg" + "Modified: / 5.6.1996 / 11:38:19 / stefan" + "Modified: / 25.10.1997 / 21:02:47 / cg" ! hilightMethodsInMethodList @@ -10572,7 +10991,9 @@ ! updateVariableList - |l subList last nameAccessSelector class oldSelection| + "update the variable list - either show instVars, classVars or classInstVars" + + |l subList last nameAccessSelector class oldSelection askMeta| variableListView isNil ifTrue:[^ self]. @@ -10580,70 +11001,78 @@ l := OrderedCollection new. " - show classVars, if classProtocol is shown (instead of classInstance vars) + show classVars/classInstVars, + if classProtocol is shown (instead of classInstance vars) " + askMeta := false. showInstance ifTrue:[ - nameAccessSelector := #instVarNames + nameAccessSelector := #instVarNames ] ifFalse:[ - nameAccessSelector := #classVarNames - ]. - -"/ class := currentClass notNil ifTrue:[currentClass] ifFalse:[actualClass]. -"/ class isNil ifTrue:[class := currentClassHierarchy]. + classInstVarsInVarList == true ifTrue:[ + nameAccessSelector := #instVarNames. + askMeta := true. + ] ifFalse:[ + nameAccessSelector := #classVarNames + ] + ]. class := currentClassHierarchy notNil ifTrue:[ - currentClassHierarchy + currentClassHierarchy ] ifFalse:[ - currentClass + currentClass ]. class := currentClass. fullProtocol ifTrue:[ - class := currentClassHierarchy + class := currentClassHierarchy ]. class isNil ifTrue:[ - variableListView list:nil. - ^ self + variableListView list:nil. + ^ self ]. class withAllSuperclasses do:[:aClass | - |ignore| - - ignore := fullProtocol - and:[classListView valueIsInSelection:(aClass name asString)]. - ignore ifFalse:[ - subList := aClass perform:nameAccessSelector. - subList size ~~ 0 ifTrue:[ - l := l , (subList asOrderedCollection reverse). - l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------'). - ] - ] + |ignore| + + ignore := fullProtocol + and:[classListView valueIsInSelection:(aClass name asString)]. + ignore ifFalse:[ + askMeta ifTrue:[ + subList := aClass class perform:nameAccessSelector. + ] ifFalse:[ + subList := aClass perform:nameAccessSelector. + ]. + subList size ~~ 0 ifTrue:[ + l := l , (subList asOrderedCollection reverse). + l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------'). + ] + ] ]. l reverse. variableListView setAttributes:nil. l ~= variableListView list ifTrue:[ - variableListView list:l. + variableListView list:l. ]. l keysAndValuesDo:[:index :entry | - (entry startsWith:'---') ifTrue:[ - variableListView attributeAt:index put:#disabled. - last := index - ] + (entry startsWith:'---') ifTrue:[ + variableListView attributeAt:index put:#disabled. + last := index + ] ]. last notNil ifTrue:[variableListView scrollToLine:last]. oldSelection notNil ifTrue:[ - variableListView setSelectElement:oldSelection. - self hilightMethodsInMethodCategoryList:true inMethodList:true. + variableListView setSelectElement:oldSelection. + self hilightMethodsInMethodCategoryList:true inMethodList:true. ] - "Modified: 27.10.1996 / 15:48:02 / cg" + "Modified: / 25.10.1997 / 21:01:11 / cg" ! ! !BrowserView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.344 1997-10-15 11:15:55 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.345 1997-10-28 18:26:12 cg Exp $' ! ! BrowserView initialize! diff -r 35f172e5657a -r 34c98fc48b14 BrwsrView.st --- a/BrwsrView.st Sat Oct 25 01:11:06 1997 +0200 +++ b/BrwsrView.st Tue Oct 28 19:26:12 1997 +0100 @@ -10,8 +10,6 @@ hereby transferred. " -'From Smalltalk/X, Version:3.2.1 on 14-oct-1997 at 11:20:25 pm' ! - StandardSystemView subclass:#BrowserView instanceVariableNames:'classCategoryListView classListView methodCategoryListView methodListView classMethodListView codeView classToggle @@ -22,9 +20,10 @@ lockUpdates autoSearch myLabel acceptClass lastSourceLogMessage lastCategory lastModule lastPackage lastMethodMoveClass namespaceList allNamespaces gotClassList classList selectorList - showAllNamespaces' + showAllNamespaces classInstVarsInVarList' classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon - StopIcon TraceIcon TimeIcon' + StopIcon TraceIcon TimeIcon CanvasIcon MenuIcon ImageIcon + ShowResourceIcons' poolDictionaries:'' category:'Interface-Browsers' ! @@ -76,6 +75,8 @@ "Browser configuration; (values can be changed from your private startup file)" + ShowResourceIcons := true. + " setting this to false, the removeClass function will remove classes WITHOUT checking for instances. Otherwise, @@ -97,22 +98,72 @@ CheckForInstancesWhenRemovingClasses := false RememberAspect := true RememberAspect := false + ShowResourceIcons := true + ShowResourceIcons := false " - "Created: 23.11.1995 / 11:35:58 / cg" - "Modified: 23.11.1995 / 11:36:34 / cg" + "Created: / 23.11.1995 / 11:35:58 / cg" + "Modified: / 27.10.1997 / 17:34:25 / cg" ! ! !BrowserView class methodsFor:'cleanup'! lowSpaceCleanup - DefaultIcon := nil - - "Created: 18.4.1996 / 16:46:40 / cg" + DefaultIcon := StopIcon := TraceIcon := TimeIcon := nil + + "Created: / 18.4.1996 / 16:46:40 / cg" + "Modified: / 25.10.1997 / 19:30:32 / cg" ! ! !BrowserView class methodsFor:'defaults'! +canvasIcon + "answer an icon to mark canvas (windowSpec) methods" + + |canvasIcon| + + CanvasIcon notNil ifTrue:[^ CanvasIcon]. + + canvasIcon := Depth1Image + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + ). + canvasIcon mask:(ImageMask + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + )). + canvasIcon maskedPixelsAre0:true. + canvasIcon colorMap:(Array with:Color white with:Color black). + CanvasIcon := canvasIcon. + ^ canvasIcon + + " + CanvasIcon := nil + " + + "Modified: / 28.10.1997 / 12:47:18 / cg" +! + defaultIcon "return the browsers default window icon" @@ -142,6 +193,105 @@ "Modified: 15.8.1997 / 15:29:16 / cg" ! +imageIcon + "answer an icon to mark image (menuSpec) methods" + + |imageIcon| + + ImageIcon notNil ifTrue:[^ ImageIcon]. + + imageIcon := Depth2Image + width:10 + height:10 + fromArray:#( + 4r0000 4r0000 4r0000 + 4r0111 4r1111 4r1000 + 4r0111 4r2221 4r1000 + 4r0112 4r2222 4r1000 + 4r0111 4r2221 4r1000 + 4r0111 4r1311 4r1000 + 4r0111 4r1311 4r1000 + 4r0111 4r1311 4r1000 + 4r0222 4r2222 4r1000 + 4r0000 4r0000 4r0000 + ). + + imageIcon colorMap:(Array + with:Color black + with:(Color rgbValue:16radd8e6) + with:(Color rgbValue:16r00cd00) + with:(Color rgbValue:16r853e26) + ). + ImageIcon := imageIcon. + ^ imageIcon + + " + ImageIcon := nil. + self imageIcon inspect + " + + "Created: / 28.10.1997 / 13:42:54 / cg" + "Modified: / 28.10.1997 / 14:09:39 / cg" +! + +menuIcon + "answer an icon to mark menu (menuSpec) methods" + + |menuIcon| + + MenuIcon notNil ifTrue:[^ MenuIcon]. + + menuIcon := Depth1Image + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + 2r10000000 2r01000000 + 2r10000000 2r01000000 + 2r11111111 2r11000000 + ). + menuIcon mask:(ImageMask + width:10 + height:10 + fromArray:#( + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + 2r11111111 2r11000000 + )). + menuIcon maskedPixelsAre0:true. + menuIcon colorMap:(Array with:Color white with:Color black). + MenuIcon := menuIcon. + ^ menuIcon + + " + MenuIcon := nil + " + + "Created: / 27.10.1997 / 00:38:06 / cg" + "Modified: / 27.10.1997 / 00:45:45 / cg" +! + +programMenuIcon + "answer an icon to mark programmed-menu (menuSpec) methods" + + ^ self menuIcon + + "Created: / 28.10.1997 / 13:40:49 / cg" +! + stopIcon "answer an icon to mark breakPointed methods" @@ -719,7 +869,7 @@ this test allows a smalltalk to be built without Projects/ChangeSets " Project notNil ifTrue:[ - fileName := Project currentProjectDirectory , fileName. + fileName := Project currentProjectDirectory asFilename constructString: fileName. ]. ]. @@ -750,8 +900,8 @@ ]. self normalLabel. - "Created: 11.10.1997 / 16:38:29 / cg" - "Modified: 11.10.1997 / 16:48:19 / cg" + "Created: / 11.10.1997 / 16:38:29 / cg" + "Modified: / 28.10.1997 / 14:35:50 / cg" ! classCategoryFileOutBinaryEach @@ -911,6 +1061,7 @@ classCategoryMenu + |specialMenu m labels selectors shorties| @@ -1084,8 +1235,8 @@ m subMenuAt:#otherMenu put:specialMenu. ^ m - "Created: 14.9.1995 / 10:50:17 / claus" - "Modified: 11.10.1997 / 17:08:16 / cg" + "Created: / 14.9.1995 / 10:50:17 / claus" + "Modified: / 27.10.1997 / 20:45:52 / cg" ! classCategoryNewCategory @@ -1890,7 +2041,7 @@ ! classDefinition - "show class definition in codeView and setup accept-action for + "show class definition in View and setup accept-action for a class-definition change. Extract documentation either from a documentation method or from the comment - not a biggy, but beginners will like @@ -1938,14 +2089,19 @@ aStream cr; cr; cr; cr; cr. aStream emphasis:(#color -> (Color red:0 green:0 blue:25)). s isNil ifTrue:[ - aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation found'. + aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation method found'. ] ifFalse:[ aStream nextPut:$" ; cr; nextPutLine:' Documentation:'. aStream cr; nextPutLine:s; cr. aStream nextPutLine:' Notice: '. - aStream nextPutAll:' the above string has been extracted from the classes '. + aStream nextPutAll:' the above text has been extracted from the classes '. aStream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']). - aStream nextPutLine:' It will not be preserved when accepting a new class definition.'. + aStream nextPutLine:' Any change in it will be lost if you ''accept'' here.'. + aStream nextPutAll:' To change the '. + aStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation']). + aStream nextPutAll:', switch to the '. + aStream nextPutAll:(isComment ifTrue:['comment'] ifFalse:['documentation method']). + aStream nextPutLine:' and ''accept'' any changes there.'. ]. aStream nextPut:$". aStream emphasis:nil. @@ -1993,7 +2149,7 @@ self normalLabel ] - "Modified: 11.10.1997 / 16:25:42 / cg" + "Modified: / 25.10.1997 / 12:46:05 / cg" ! classDocumentation @@ -2260,291 +2416,292 @@ "sent by classListView to ask for the menu" + |specialMenu labels selectors shorties m newClassMenu spawnMenu idx| currentClass isNil ifTrue:[ - labels := #( - 'fileIn new from repository ...' - ). - - selectors := #( - classLoadNewRevision - ). + labels := #( + 'fileIn new from repository ...' + ). + + selectors := #( + classLoadNewRevision + ). ] ifFalse:[ - labels := #( - 'fileOut binary' - '-' - 'inspect class' - 'inspect instances' - '-' - 'make private class ...' - 'make public class' - '-' - 'primitive definitions' - 'primitive variables' - 'primitive functions' - '-' - 'source container ...' - 'remove source container ...' - '-' - 'revision log' - 'compare with repository ...' - '-' - 'check into source repository' - 'fileIn from repository ...' - ). - selectors := #( - classFileOutBinary - nil - classInspect - classInstancesInspect - nil - classMakePrivate - classMakePublic - nil - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions - nil - classModifyContainer - classRemoveContainer - nil - classRevisionInfo - classCompareWithRepository - nil - classCheckin - classLoadRevision - ). + labels := #( + 'fileOut binary' + '-' + 'inspect class' + 'inspect instances' + '-' + 'make private class ...' + 'make public class' + '-' + 'primitive definitions' + 'primitive variables' + 'primitive functions' + '-' + 'source container ...' + 'remove source container ...' + '-' + 'revision log' + 'compare with repository ...' + '-' + 'check into source repository' + 'fileIn from repository ...' + ). + selectors := #( + classFileOutBinary + nil + classInspect + classInstancesInspect + nil + classMakePrivate + classMakePublic + nil + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions + nil + classModifyContainer + classRemoveContainer + nil + classRevisionInfo + classCompareWithRepository + nil + classCheckin + classLoadRevision + ). ]. specialMenu := PopUpMenu - labels:(resources array:labels) - selectors:selectors - receiver:self. + labels:(resources array:labels) + selectors:selectors + receiver:self. currentClass notNil ifTrue:[ - currentClass sourceCodeManager isNil ifTrue:[ - specialMenu disableAll:#(classModifyContainer classRemoveContainer - classRevisionInfo - classLoadRevision classCheckin - classCompareWithRepository). - ]. - currentClass isPrivate ifTrue:[ - specialMenu disableAll:#( - classFileOutBinary - classMakePrivate - classModifyContainer - classRemoveContainer - classRevisionInfo - classLoadRevision classCheckin - classCompareWithRepository - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions). - ] ifFalse:[ - specialMenu disableAll:#( - classFileOutBinary - classMakePublic - ) - ] + currentClass sourceCodeManager isNil ifTrue:[ + specialMenu disableAll:#(classModifyContainer classRemoveContainer + classRevisionInfo + classLoadRevision classCheckin + classCompareWithRepository). + ]. + currentClass isPrivate ifTrue:[ + specialMenu disableAll:#( + classFileOutBinary + classMakePrivate + classModifyContainer + classRemoveContainer + classRevisionInfo + classLoadRevision classCheckin + classCompareWithRepository + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions). + ] ifFalse:[ + specialMenu disableAll:#( + classFileOutBinary + classMakePublic + ) + ] ] ifFalse:[ - SourceCodeManager isNil ifTrue:[ - specialMenu disableAll:#(classLoadNewRevision) - ] + SourceCodeManager isNil ifTrue:[ + specialMenu disableAll:#(classLoadNewRevision) + ] ]. (currentClass notNil and:[currentClass isLoaded not]) ifTrue:[ - specialMenu disableAll:#( - classInstancesInspect - classFileOutBinary - classMakePrivate - classMakePublic - classModifyContainer - classRemoveContainer - classRevisionInfo - classLoadRevision - classCheckin - classCompareWithRepository - classPrimitiveDefinitions - classPrimitiveVariables - classPrimitiveFunctions). + specialMenu disableAll:#( + classInstancesInspect + classFileOutBinary + classMakePrivate + classMakePublic + classModifyContainer + classRemoveContainer + classRevisionInfo + classLoadRevision + classCheckin + classCompareWithRepository + classPrimitiveDefinitions + classPrimitiveVariables + classPrimitiveFunctions). ]. device ctrlDown ifTrue:[ - ^ specialMenu + ^ specialMenu ]. currentClass isNil ifTrue:[ - labels := #( - 'new class' - ). - selectors := #( - classNewClass - ). + labels := #( + 'new class' + ). + selectors := #( + classNewClass + ). ] ifFalse:[ - currentClass isLoaded ifFalse:[ - labels := #( - 'documentation' - '-' - 'class refs' - '-' - 'new class' - '-' - 'load' - ). - selectors := #( - classDocumentation - nil - classRefs - nil - classNewClass - nil - classLoad - ). - ] ifTrue:[ - fullProtocol ifTrue:[ - labels := #( - 'hierarchy' - 'definition' - 'documentation' - 'comment' - 'class instvars' - ). - selectors := #( - classHierarchy - classDefinition - classDocumentation - classComment - classClassInstVars - ). - ] ifFalse:[ - labels := #( - 'fileOut' - 'fileOut as ...' - 'printOut' - 'printOut protocol' - " 'printOut full protocol' " - '-' - 'spawn ...' - '-' - ). - selectors := #( - classFileOut - classFileOutAs - classPrintOut - classPrintOutProtocol - " classPrintOutFullProtocol " - nil - spawnMenu - nil - ). - - spawnMenu := PopUpMenu - labels:(resources array:#('class' 'full protocol' 'hierarchy' 'subclasses')) - selectors:#(classSpawn classSpawnFullProtocol classSpawnHierarchy classSpawnSubclasses). - - - fullClass ifFalse:[ - labels := labels , #( - 'hierarchy' - 'definition' - 'documentation' - 'comment' - 'class instvars' - "/ 'protocols' - '-' - ). - selectors := selectors , #( - classHierarchy - classDefinition - classDocumentation - classComment - classClassInstVars - "/ classProtocols - nil - ). - ]. - - labels := labels , #( - 'class refs' - '-' - 'new ...' - ). - selectors := selectors , #( - classRefs - nil - newClassMenu - ). - - newClassMenu := PopUpMenu - labels:(resources array:#('class' 'subclass' 'private class')) - selectors:#(classNewClass classNewSubclass classNewPrivateClass). - - labels := labels , #( - 'rename ...' - 'remove' - ). - selectors := selectors , #( - classRename - classRemove - ). - - currentClass wasAutoloaded ifTrue:[ - labels := labels , #( - 'unload' - ). - selectors := selectors , #( - classUnload - ). - ] - ] - ]. + currentClass isLoaded ifFalse:[ + labels := #( + 'documentation' + '-' + 'class refs' + '-' + 'new class' + '-' + 'load' + ). + selectors := #( + classDocumentation + nil + classRefs + nil + classNewClass + nil + classLoad + ). + ] ifTrue:[ + fullProtocol ifTrue:[ + labels := #( + 'hierarchy' + 'definition' + 'documentation' + 'comment' + 'class instvars' + ). + selectors := #( + classHierarchy + classDefinition + classDocumentation + classComment + classClassInstVars + ). + ] ifFalse:[ + labels := #( + 'fileOut' + 'fileOut as ...' + 'printOut' + 'printOut protocol' + " 'printOut full protocol' " + '-' + 'spawn ...' + '-' + ). + selectors := #( + classFileOut + classFileOutAs + classPrintOut + classPrintOutProtocol + " classPrintOutFullProtocol " + nil + spawnMenu + nil + ). + + spawnMenu := PopUpMenu + labels:(resources array:#('class' 'full protocol' 'hierarchy' 'subclasses')) + selectors:#(classSpawn classSpawnFullProtocol classSpawnHierarchy classSpawnSubclasses). + + + fullClass ifFalse:[ + labels := labels , #( + 'hierarchy' + 'definition' + 'documentation' + 'comment' + 'class instvars' + "/ 'protocols' + '-' + ). + selectors := selectors , #( + classHierarchy + classDefinition + classDocumentation + classComment + classClassInstVars + "/ classProtocols + nil + ). + ]. + + labels := labels , #( + 'class refs' + '-' + 'new ...' + ). + selectors := selectors , #( + classRefs + nil + newClassMenu + ). + + newClassMenu := PopUpMenu + labels:(resources array:#('class' 'subclass' 'private class')) + selectors:#(classNewClass classNewSubclass classNewPrivateClass). + + labels := labels , #( + 'rename ...' + 'remove' + ). + selectors := selectors , #( + classRename + classRemove + ). + + currentClass wasAutoloaded ifTrue:[ + labels := labels , #( + 'unload' + ). + selectors := selectors , #( + classUnload + ). + ] + ] + ]. ]. shorties := (Array new:labels size) , #(nil #'Ctrl'). (idx := selectors identityIndexOf:#classNewClass) ~~ 0 ifTrue:[ - shorties at:idx put:#Cmdn + shorties at:idx put:#Cmdn ]. (idx := selectors identityIndexOf:#classLoad) ~~ 0 ifTrue:[ - shorties at:idx put:#Cmdl + shorties at:idx put:#Cmdl ]. (idx := selectors identityIndexOf:#classDocumentation) ~~ 0 ifTrue:[ - shorties at:idx put:#Cmdd + shorties at:idx put:#Cmdd ]. labels := labels , #( - '=' - 'others' - ). + '=' + 'others' + ). selectors := selectors , #( - nil - otherMenu - ). + nil + otherMenu + ). m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. newClassMenu notNil ifTrue:[ - m subMenuAt:#newClassMenu put:newClassMenu. + m subMenuAt:#newClassMenu put:newClassMenu. ]. spawnMenu notNil ifTrue:[ - m subMenuAt:#spawnMenu put:spawnMenu. + m subMenuAt:#spawnMenu put:spawnMenu. ]. (currentClass notNil and:[currentClass isPrivate]) ifTrue:[ - m disableAll:#( - classFileOut - ) + m disableAll:#( + classFileOut + ) ]. m subMenuAt:#otherMenu put:specialMenu. ^ m - "Modified: 3.7.1997 / 13:16:28 / cg" + "Modified: / 27.10.1997 / 20:45:56 / cg" ! classNewClass @@ -4613,40 +4770,40 @@ ! renameCurrentClassTo:aString - "helper - do the rename" + "helper - do the class-rename" self doClassMenu:[:currentClass | - |oldSym cls| - - "/ check if the target already exists - confirm if so. - - (cls := Smalltalk classNamed:aString) notNil ifTrue:[ - (self confirm:(resources string:'WARN_RENAME' - with:aString - with:cls category) withCRs) - ifFalse:[^ self] - ]. - - oldSym := currentClass name asSymbol. - - "/ - "/ renaming is actually more complicated as one might - "/ think (care for classVariables, privateClasses etc.) - "/ Smalltalk knows all about that ... - - Smalltalk renameClass:currentClass to:aString. - - self updateClassList. - self updateMethodCategoryListWithScroll:false. - self updateMethodListWithScroll:false. - self withBusyCursorDo:[ - Transcript showCR:('searching for users of ' , oldSym); endEntry. - SystemBrowser browseReferendsOf:oldSym warnIfNone:false - ] + |oldSym cls| + + "/ check if the target already exists - confirm if so. + + (cls := Smalltalk classNamed:aString) notNil ifTrue:[ + (self confirm:(resources string:'WARN_RENAME' + with:aString + with:cls category) withCRs) + ifFalse:[^ self] + ]. + + oldSym := currentClass name asSymbol. + + "/ + "/ renaming is actually more complicated as one might + "/ think (care for classVariables, privateClasses etc.) + "/ Smalltalk knows all about that ... + + Smalltalk renameClass:currentClass to:aString. + + self updateClassList. + self updateMethodCategoryListWithScroll:false. + self updateMethodListWithScroll:false. + self withBusyCursorDo:[ + Transcript showCR:('searching for users of ' , oldSym); endEntry. + SystemBrowser browseReferendsOf:oldSym warnIfNone:false + ] ] - "Created: 25.11.1995 / 13:02:53 / cg" - "Modified: 18.8.1997 / 15:44:33 / cg" + "Created: / 25.11.1995 / 13:02:53 / cg" + "Modified: / 25.10.1997 / 19:37:55 / cg" ! switchToClass:newClass @@ -4840,220 +4997,221 @@ "fileout all methods into one source file" |list classString selectorString cls mth outStream fileName append - fileBox| + fileBox f| append := false. fileBox := FileSaveBox - title:(resources string:'save methods in:') - okText:(resources string:'save') - abortText:(resources string:'cancel') - action:[:fName | fileName := fName]. + title:(resources string:'save methods in:') + okText:(resources string:'save') + abortText:(resources string:'cancel') + action:[:fName | fileName := fName]. fileBox appendAction:[:fName | fileName := fName. append := true]. fileBox initialText:'some_methods.st'. Project notNil ifTrue:[ - fileBox directory:Project currentProjectDirectory + fileBox directory:Project currentProjectDirectory ]. fileBox showAtPointer. - fileName notNil ifTrue:[ - " - if file exists, save original in a .sav file - " - fileName asFilename exists ifTrue:[ - fileName asFilename copyTo:(fileName , '.sav') - ]. - append ifTrue:[ - outStream := FileStream appendingOldFileNamed:fileName - ] ifFalse:[ - outStream := FileStream newFileNamed:fileName. - ]. - outStream isNil ifTrue:[ - ^ self warn:'cannot create: %1' with:fileName - ]. - self withBusyCursorDo:[ - list := classMethodListView list. - list do:[:line | - self busyLabel:'writing: ' with:line. - - classString := self classNameFromClassMethodString:line. - selectorString := self selectorFromClassMethodString:line. - - cls := self findClassNamed:classString. - cls isNil ifTrue:[ - self warn:'oops class %1 is gone' with:classString - ] ifFalse:[ - mth := cls compiledMethodAt:(selectorString asSymbol). - Class fileOutErrorSignal handle:[:ex | - |box answer| - box := YesNoBox - title:('fileOut error: ' - , ex errorString - , '\\continue anyway ?') withCRs - yesText:'continue' - noText:'abort'. - answer := box confirm. - box destroy. - answer ifTrue:[ - ex proceed - ]. - self normalLabel. - ^ self - ] do:[ - cls fileOutMethod:mth on:outStream. - ] - ] - ]. - outStream close. - self normalLabel. - ] + fileName isNil ifTrue:[^ self]. + + " + if file exists, save original in a .sav file + " + (f := fileName asFilename) exists ifTrue:[ + f copyTo:(f withSuffix: 'sav') + ]. + append ifTrue:[ + outStream := FileStream appendingOldFileNamed:fileName + ] ifFalse:[ + outStream := FileStream newFileNamed:fileName. + ]. + outStream isNil ifTrue:[ + ^ self warn:'cannot create: %1' with:fileName + ]. + self withBusyCursorDo:[ + list := classMethodListView list. + list do:[:line | + self busyLabel:'writing: ' with:line. + + classString := self classNameFromClassMethodString:line. + selectorString := self selectorFromClassMethodString:line. + + cls := self findClassNamed:classString. + cls isNil ifTrue:[ + self warn:'oops class %1 is gone' with:classString + ] ifFalse:[ + mth := cls compiledMethodAt:(selectorString asSymbol). + Class fileOutErrorSignal handle:[:ex | + |box answer| + box := YesNoBox + title:('fileOut error: ' + , ex errorString + , '\\continue anyway ?') withCRs + yesText:'continue' + noText:'abort'. + answer := box confirm. + box destroy. + answer ifTrue:[ + ex proceed + ]. + self normalLabel. + ^ self + ] do:[ + cls fileOutMethod:mth on:outStream. + ] + ] + ]. + outStream close. + self normalLabel. ] - "Modified: 17.6.1996 / 16:51:11 / stefan" - "Modified: 18.8.1997 / 15:43:43 / cg" + "Modified: / 17.6.1996 / 16:51:11 / stefan" + "Modified: / 28.10.1997 / 14:39:48 / cg" ! classMethodMenu + |labels selectors shorties m specialMenu| (currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[ - labels := #( - 'inspect method' - '-' - 'remove break/trace' - ). - - selectors := #( - methodInspect - nil - methodRemoveBreakOrTrace - ). + labels := #( + 'inspect method' + '-' + 'remove break/trace' + ). + + selectors := #( + methodInspect + nil + methodRemoveBreakOrTrace + ). ] ifFalse:[ - labels := #( - 'inspect method' - '-' - 'breakpoint' - 'breakpoint in ...' - '-' - 'trace' - 'trace sender' - 'trace full walkback' - '-' - 'start timing' - 'start counting' - 'start mem usage' - ). - - selectors := #( - methodInspect - nil - methodBreakPoint - methodBreakPointInProcess - nil - methodTrace - methodTraceSender - methodTraceFull - nil - methodStartTiming - methodStartCounting - methodStartMemoryUsage - ). + labels := #( + 'inspect method' + '-' + 'breakpoint' + 'breakpoint in ...' + '-' + 'trace' + 'trace sender' + 'trace full walkback' + '-' + 'start timing' + 'start counting' + 'start mem usage' + ). + + selectors := #( + methodInspect + nil + methodBreakPoint + methodBreakPointInProcess + nil + methodTrace + methodTraceSender + methodTraceFull + nil + methodStartTiming + methodStartCounting + methodStartMemoryUsage + ). ]. specialMenu := PopUpMenu - labels:(resources array:labels) - selectors:selectors. + labels:(resources array:labels) + selectors:selectors. device ctrlDown ifTrue:[ - currentMethod isNil ifTrue:[ - classMethodListView flash. - ^ nil - ]. - - ^ specialMenu + currentMethod isNil ifTrue:[ + classMethodListView flash. + ^ nil + ]. + + ^ specialMenu ]. labels := #( - 'fileOut' - 'fileOut all' - 'printOut' - '-' - 'browse' - 'spawn' - 'spawn class' - 'spawn full protocol' - 'spawn hierarchy' - '-' - 'senders ...' - 'implementors ...' - 'globals ...' + 'fileOut' + 'fileOut all' + 'printOut' + '-' + 'browse' + 'spawn' + 'spawn class' + 'spawn full protocol' + 'spawn hierarchy' + '-' + 'senders ...' + 'implementors ...' + 'globals ...' "/ '-' "/ 'breakpoint' "/ 'trace' "/ 'trace sender' - '-' - 'remove' - '-' - 'others' - ). + '-' + 'remove' + '-' + 'others' + ). shorties := #( - nil - nil - nil - nil - nil - nil - nil - nil - nil - nil - #Cmds - #Cmdi - #Cmdg + nil + nil + nil + nil + nil + nil + nil + nil + nil + nil + #Cmds + #Cmdi + #Cmdg "/ nil "/ nil "/ nil "/ nil - nil - nil - nil - #'Ctrl' - ). + nil + nil + nil + #'Ctrl' + ). selectors := #( - methodFileOut - classMethodFileOutAll - methodPrintOut - nil - classMethodBrowse - methodSpawn - classSpawn - classSpawnFullProtocol - classSpawnHierarchy - nil - methodSenders - methodImplementors - methodGlobalReferends + methodFileOut + classMethodFileOutAll + methodPrintOut + nil + classMethodBrowse + methodSpawn + classSpawn + classSpawnFullProtocol + classSpawnHierarchy + nil + methodSenders + methodImplementors + methodGlobalReferends "/ nil "/ methodBreakPoint "/ methodTrace "/ methodTraceSender - nil - methodRemove - nil - othersMenu - ). + nil + methodRemove + nil + othersMenu + ). m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. m subMenuAt:#othersMenu put:specialMenu. ^ m - "Modified: 7.3.1997 / 19:33:14 / cg" + "Modified: / 27.10.1997 / 20:46:00 / cg" ! ! !BrowserView methodsFor:'class-method stuff'! @@ -5359,68 +5517,69 @@ v := classCategoryListView. v notNil ifTrue:[ - v action:[:lineNr | self classCategorySelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - v list size == 0 ifTrue:[ - v list:(self listOfAllClassCategories). - ]. - " - tell classCategoryListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu. + v action:[:lineNr | self classCategorySelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + v list size == 0 ifTrue:[ + v list:(self listOfAllClassCategories). + ]. + " + tell classCategoryListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu. ]. v := classListView. v notNil ifTrue:[ - v action:[:lineNr | self classSelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell classListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#classMenu. + v action:[:lineNr | self classSelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell classListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#classMenu. ]. v := methodCategoryListView. v notNil ifTrue:[ - v action:[:lineNr | self methodCategorySelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell methodCategoryListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu. + v action:[:lineNr | self methodCategorySelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell methodCategoryListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu. ]. v := methodListView. v notNil ifTrue:[ - v action:[:lineNr | self methodSelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell methodListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu. + v action:[:lineNr | self methodSelection:lineNr]. + v doubleClickAction:[:lineNr | self methodDoubleClick:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell methodListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu. ]. v := classMethodListView. v notNil ifTrue:[ - v action:[:lineNr | self classMethodSelection:lineNr]. - v selectConditionBlock:checkBlock. - v ignoreReselect:false. - " - tell classMethodListView to ask for the menu - " - v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu. + v action:[:lineNr | self classMethodSelection:lineNr]. + v selectConditionBlock:checkBlock. + v ignoreReselect:false. + " + tell classMethodListView to ask for the menu + " + v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu. ]. v := variableListView. v notNil ifTrue:[ - v action:[:lineNr | self variableSelection:lineNr]. - v ignoreReselect:false. - v toggleSelect:true. - v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu. + v action:[:lineNr | self variableSelection:lineNr]. + v ignoreReselect:false. + v toggleSelect:true. + v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu. ]. " @@ -5428,11 +5587,11 @@ fullProtocol browsers better show the end initially " fullProtocol ifTrue:[ - classListView scrollToBottom. + classListView scrollToBottom. ] - "Modified: 26.5.1996 / 15:59:13 / cg" - "Created: 24.7.1997 / 18:14:59 / cg" + "Created: / 24.7.1997 / 18:14:59 / cg" + "Modified: / 27.10.1997 / 00:29:30 / cg" ! terminate @@ -5615,18 +5774,17 @@ |vpanel hpanel frame v spc nsHolder| styleSheet is3D ifTrue:[ - spc := ViewSpacing. + spc := ViewSpacing. ] ifFalse:[ - spc := 0 - ]. - - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) - in:self. + spc := 0 + ]. + + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. v := HVScrollableView for:SelectionInListView - miniScrollerH:true miniScrollerV:false - in:hpanel. + miniScrollerH:true miniScrollerV:false + in:hpanel. v origin:(0.0 @ 0.0) corner:(0.25 @ 1.0). classCategoryListView := v scrolledView. classCategoryListView delegate:self. @@ -5665,9 +5823,9 @@ namespaceList model:nsHolder. namespaceList label menuHolder:self; menuMessage:#nameSpaceMenu. nsHolder onChangeSend:#value - to:[ - self changeNameSpaceTo:nsHolder value - ]. + to:[ + self changeNameSpaceTo:nsHolder value + ]. v := HVScrollableView for:SelectionInListView miniScrollerH:true miniScrollerV:false in:hpanel. v origin:(0.5 @ 0.0) corner:(0.75 @ 1.0). @@ -5678,7 +5836,7 @@ self createCodeViewIn:vpanel - "Modified: 24.6.1997 / 18:55:17 / cg" + "Modified: / 25.10.1997 / 19:26:14 / cg" ! setupForClass:aClass @@ -5686,9 +5844,7 @@ |vpanel hpanel frame v| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. frame := View origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)in:hpanel. @@ -5698,12 +5854,12 @@ v := ScrollableView for:SelectionInListView in:frame. v origin:(0.0 @ 0.0) extent:[frame width - @ - (frame height - - ViewSpacing - - instanceToggle height - - instanceToggle borderWidth - + v borderWidth)]. + @ + (frame height + - ViewSpacing + - instanceToggle height + - instanceToggle borderWidth + + v borderWidth)]. methodCategoryListView := v scrolledView. methodCategoryListView delegate:self. @@ -5717,7 +5873,7 @@ self updateCodeView. self classDefinition. - "Modified: 27.10.1996 / 14:17:06 / cg" + "Modified: / 25.10.1997 / 19:26:26 / cg" ! setupForClass:aClass methodCategory:aMethodCategory @@ -5725,9 +5881,7 @@ |vpanel v| - vpanel := VariableVerticalPanel - origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. v := self createMethodListViewIn:vpanel atX:0.0. v corner:(1.0 @ 0.25). @@ -5741,7 +5895,7 @@ self updateMethodList. self updateCodeView. - "Modified: 2.3.1996 / 16:10:44 / cg" + "Modified: / 25.10.1997 / 19:26:35 / cg" ! setupForClass:aClass selector:selector @@ -5769,9 +5923,7 @@ |vpanel hpanel frame v| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel. @@ -5792,7 +5944,7 @@ self updateMethodList. self updateCodeView - "Modified: 27.10.1996 / 14:17:24 / cg" + "Modified: / 25.10.1997 / 19:26:49 / cg" ! setupForClassHierarchy:aClass @@ -5800,9 +5952,7 @@ |vpanel hpanel frame v cls| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. " notice: we use a different ratio here @@ -5822,7 +5972,7 @@ cls := aClass. cls isMeta ifTrue:[ - cls := cls soleInstance + cls := cls soleInstance ]. currentClassHierarchy := currentClass := actualClass := cls. self updateClassList. @@ -5832,10 +5982,10 @@ self updateCodeView. aClass isMeta ifTrue:[ - self instanceProtocol:false - ]. - - "Modified: 27.10.1996 / 14:17:30 / cg" + self instanceProtocol:false + ]. + + "Modified: / 25.10.1997 / 19:26:58 / cg" ! setupForClassList:aList @@ -5851,8 +6001,7 @@ |vpanel hpanel frame l v| - vpanel := VariableVerticalPanel - origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel. @@ -5868,13 +6017,13 @@ self createCodeViewIn:vpanel. l := (aList collect:[:entry | - entry isBehavior ifTrue:[ - entry name - ] ifFalse:[ - entry - ]]) asOrderedCollection. + entry isBehavior ifTrue:[ + entry name + ] ifFalse:[ + entry + ]]) asOrderedCollection. doSort ifTrue:[ - l sort. + l sort. ]. classListView list:l. gotClassList := true. @@ -5883,8 +6032,8 @@ self updateMethodList. self updateCodeView - "Created: 28.5.1996 / 13:52:47 / cg" - "Modified: 4.1.1997 / 19:45:30 / cg" + "Created: / 28.5.1996 / 13:52:47 / cg" + "Modified: / 25.10.1997 / 19:27:07 / cg" ! setupForFullClass @@ -5892,9 +6041,7 @@ |vpanel hpanel v| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel. @@ -5911,6 +6058,8 @@ fullClass := true. self updateCodeView + + "Modified: / 25.10.1997 / 19:27:18 / cg" ! setupForFullClassProtocol:aClass @@ -5918,9 +6067,7 @@ |vpanel hpanel frame v cls| - vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. " notice: we use a different ratio here @@ -5943,7 +6090,7 @@ cls := aClass. cls isMeta ifTrue:[ - cls := cls soleInstance + cls := cls soleInstance ]. currentClassHierarchy := actualClass := acceptClass := currentClass := cls. fullProtocol := true. @@ -5954,10 +6101,10 @@ self updateCodeView. self updateVariableList. aClass isMeta ifTrue:[ - self instanceProtocol:false - ]. - - "Modified: 27.10.1996 / 14:17:47 / cg" + self instanceProtocol:false + ]. + + "Modified: / 25.10.1997 / 19:27:27 / cg" ! setupForList:aList @@ -5965,10 +6112,7 @@ |vpanel v| - vpanel := VariableVerticalPanel - origin:(0.0 @ 0.0) - corner:(1.0 @ 1.0) - in:self. + vpanel := VariableVerticalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self. v := ScrollableView for:SelectionInListView in:vpanel. v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25). @@ -5980,14 +6124,14 @@ self createCodeViewIn:vpanel. aList size == 1 ifTrue:[ - classMethodListView setSelection:1. - self classMethodSelection:1. + classMethodListView setSelection:1. + self classMethodSelection:1. ]. self updateCodeView. "/ kludge - get trap icons self updateClassMethodListWithScroll:false keepSelection:true - "Modified: 3.3.1997 / 15:26:48 / cg" + "Modified: / 25.10.1997 / 19:27:40 / cg" ! ! !BrowserView methodsFor:'method category list menu'! @@ -6084,98 +6228,91 @@ cls := currentClass class. self withBusyCursorDo:[ - |nm names source| - - "/ add version method containing RCS template - "/ but only if not already present and its not a private class. - - cls isPrivate ifFalse:[ - (cls includesSelector:#version) ifFalse:[ - Compiler compile: + |nm names source| + + "/ add version method containing RCS template + "/ but only if not already present and its not a private class. + + cls isPrivate ifFalse:[ + (cls includesSelector:#version) ifFalse:[ + Compiler compile: 'version ^ ''$' , 'Header$'' ' - forClass:cls - inCategory:'documentation'. - ] - ]. - - "/ add copyright method containing your/your companies - "/ copyright template but only if not already present. - "/ this is only added, if specified in the - "/ COPYRIGHT_TEMPLATE_FILE resources. - - (cls includesSelector:#copyright) ifFalse:[ - fn := resources at:#'COPYRIGHT_TEMPLATE_FILE' default:nil. - fn notNil ifTrue:[ - fn := fn asFilename. - fn exists ifTrue:[ - txt := fn contents asString - ] - ]. - - txt notNil ifTrue:[ - txt := txt bindWith:(Date today year). - Compiler compile: + forClass:cls + inCategory:'documentation'. + ] + ]. + + "/ add copyright method containing your/your companies + "/ copyright template but only if not already present. + "/ this is only added, if specified in the + "/ COPYRIGHT_TEMPLATE_FILE resources. + + (cls includesSelector:#copyright) ifFalse:[ + fn := resources at:#'COPYRIGHT_TEMPLATE_FILE' default:nil. + fn notNil ifTrue:[ + fn := fn asFilename. + fn exists ifTrue:[ + txt := fn contents asString + ] + ]. + + txt notNil ifTrue:[ + txt := txt bindWith:(Date today year). + Compiler compile: 'copyright " ' , txt , ' " ' forClass:cls - inCategory:'documentation'. - ] - ]. - - "/ add documentation method containing doc template - "/ but only if not already present. - - (cls includesSelector:#documentation) ifFalse:[ - Compiler compile: + inCategory:'documentation'. + ] + ]. + + "/ add documentation method containing doc template + "/ but only if not already present. + + (cls includesSelector:#documentation) ifFalse:[ + Compiler compile: 'documentation " documentation to be added. " ' forClass:cls - inCategory:'documentation'. - ]. - - "/ add examples method containing examples template - "/ but only if not already present. - - (cls includesSelector:#examples) ifFalse:[ - Compiler compile: + inCategory:'documentation'. + ]. + + "/ add examples method containing examples template + "/ but only if not already present. + + (cls includesSelector:#examples) ifFalse:[ + Compiler compile: 'examples " examples to be added. " ' forClass:cls - inCategory:'documentation'. - ]. - - "/ add history method containing created-entry - "/ but only if not already present. - - (cls includesSelector:#history) ifFalse:[ - histStream := ReadWriteStream on: String new. - histStream nextPutLine: 'history'. - HistoryLine isBehavior ifTrue:[ - histStream nextPutLine: (HistoryLine newCreated printString). - ] ifFalse:[ - histStream cr. - ]. - Compiler compile:(histStream contents) - forClass:cls - inCategory:'documentation'. - ]. - - self instanceProtocol:false. - self switchToMethodNamed:#documentation + inCategory:'documentation'. + ]. + + "/ add history method containing created-entry + "/ but only if not already present. + + (cls includesSelector:#history) ifFalse:[ + HistoryManager notNil ifTrue:[ + HistoryManager createInitialHistoryMethodIn:cls + ]. + ]. + + self instanceProtocol:false. + self switchToMethodNamed:#documentation "/ self updateMethodCategoryListWithScroll:false. "/ self updateMethodListWithScroll:false ] - "Modified: 18.8.1997 / 15:44:13 / cg" + "Modified: / 24.10.1997 / 02:42:38 / cg" ! methodCategoryFileOut @@ -6201,62 +6338,65 @@ self whenMethodCategorySelected:[ - |fileName outStream| - - fileName := currentMethodCategory , '.st'. - fileName replaceAll:Character space with:$_. - " - this test allows a smalltalk to be built without Projects/ChangeSets - " - Project notNil ifTrue:[ - fileName := Project currentProjectDirectory , fileName. - ]. - " - if file exists, save original in a .sav file - " - fileName asFilename exists ifTrue:[ - fileName asFilename copyTo:(fileName , '.sav') - ]. - outStream := FileStream newFileNamed:fileName. - outStream isNil ifTrue:[ - ^ self warn:'cannot create: %1' with:fileName - ]. - - self busyLabel:'saving: ' with:currentMethodCategory. - Class fileOutErrorSignal handle:[:ex | - self warn:'cannot create: %1' with:ex parameter. - ex return - ] do:[ - Smalltalk allBehaviorsDo:[:class | - |hasMethodsInThisCategory| - - hasMethodsInThisCategory := false. - class methodDictionary do:[:method | - method category = currentMethodCategory ifTrue:[ - hasMethodsInThisCategory := true - ] - ]. - hasMethodsInThisCategory ifTrue:[ - class fileOutCategory:currentMethodCategory on:outStream. - outStream cr - ]. - hasMethodsInThisCategory := false. - class class methodDictionary do:[:method | - method category = currentMethodCategory ifTrue:[ - hasMethodsInThisCategory := true - ] - ]. - hasMethodsInThisCategory ifTrue:[ - class class fileOutCategory:currentMethodCategory on:outStream. - outStream cr - ] - ]. - ]. - outStream close. - self normalLabel. - ]. - - "Modified: 7.6.1996 / 09:03:56 / stefan" + |fileName outStream| + + fileName := (currentMethodCategory , '.st') asFilename. + fileName makeLegalFilename. + " + this test allows a smalltalk to be built without Projects/ChangeSets + " + Project notNil ifTrue:[ + fileName := Project currentProjectDirectory asFilename construct: fileName name. + ]. + " + if file exists, save original in a .sav file + " + fileName exists ifTrue:[ + fileName copyTo:(fileName withSuffix: 'sav') + ]. + + fileName := fileName pathName. + outStream := FileStream newFileNamed:fileName. + outStream isNil ifTrue:[ + ^ self warn:'cannot create: %1' with:fileName + ]. + + self busyLabel:'saving: ' with:currentMethodCategory. + Class fileOutErrorSignal handle:[:ex | + self warn:'cannot create: %1' with:ex parameter. + ex return + ] do:[ + Smalltalk allBehaviorsDo:[:class | + |hasMethodsInThisCategory| + + hasMethodsInThisCategory := false. + class methodDictionary do:[:method | + method category = currentMethodCategory ifTrue:[ + hasMethodsInThisCategory := true + ] + ]. + hasMethodsInThisCategory ifTrue:[ + class fileOutCategory:currentMethodCategory on:outStream. + outStream cr + ]. + hasMethodsInThisCategory := false. + class class methodDictionary do:[:method | + method category = currentMethodCategory ifTrue:[ + hasMethodsInThisCategory := true + ] + ]. + hasMethodsInThisCategory ifTrue:[ + class class fileOutCategory:currentMethodCategory on:outStream. + outStream cr + ] + ]. + ]. + outStream close. + self normalLabel. + ]. + + "Modified: / 7.6.1996 / 09:03:56 / stefan" + "Modified: / 28.10.1997 / 14:37:32 / cg" ! methodCategoryFindAnyMethod @@ -6283,114 +6423,115 @@ methodCategoryMenu + |labels selectors shorties i m varSel s| currentClass isNil ifTrue:[ - methodCategoryListView flash. - ^ nil + methodCategoryListView flash. + ^ nil ]. labels := #(). selectors := #(). currentMethodCategory notNil ifTrue:[ - labels := labels , #( - 'fileOut' - 'fileOut all' - 'printOut' - '-' - 'SPAWN_METHODCATEGORY' - 'spawn category' - '-' - ). - - selectors := selectors , #( - methodCategoryFileOut - methodCategoryFileOutAll - methodCategoryPrintOut - nil - methodCategorySpawn - methodCategorySpawnCategory - nil - ). + labels := labels , #( + 'fileOut' + 'fileOut all' + 'printOut' + '-' + 'SPAWN_METHODCATEGORY' + 'spawn category' + '-' + ). + + selectors := selectors , #( + methodCategoryFileOut + methodCategoryFileOutAll + methodCategoryPrintOut + nil + methodCategorySpawn + methodCategorySpawnCategory + nil + ). ]. labels := labels , #( - 'find method here ...' - 'find method ...' - '-' - 'new category ...' - 'copy category ...' - ). + 'find method here ...' + 'find method ...' + '-' + 'new category ...' + 'copy category ...' + ). selectors := selectors , #( - methodCategoryFindMethod - methodCategoryFindAnyMethod - nil - methodCategoryNewCategory - methodCategoryCopyCategory - ). + methodCategoryFindMethod + methodCategoryFindAnyMethod + nil + methodCategoryNewCategory + methodCategoryCopyCategory + ). showInstance ifFalse:[ - labels := labels , #( 'create access methods' ). - selectors := selectors , #( #methodCategoryCreateDocumentationMethods ). + labels := labels , #( 'create access methods' ). + selectors := selectors , #( #methodCategoryCreateDocumentationMethods ). ] ifTrue:[ - (variableListView notNil - and:[(varSel := variableListView selectionValue) notNil]) ifTrue:[ - s := 'create access methods (for ''%1'')' - ] ifFalse:[ - s := 'create access methods (for all)' - ]. - s := resources string:s with:varSel. - labels := labels , (Array with:s). - selectors := selectors , #( - methodCategoryCreateAccessMethods - ). + (variableListView notNil + and:[(varSel := variableListView selectionValue) notNil]) ifTrue:[ + s := 'create access methods (for ''%1'')' + ] ifFalse:[ + s := 'create access methods (for all)' + ]. + s := resources string:s with:varSel. + labels := labels , (Array with:s). + selectors := selectors , #( + methodCategoryCreateAccessMethods + ). ]. currentMethodCategory notNil ifTrue:[ - labels := labels , #( - '-' - 'rename ...' - 'remove' - ). - - selectors := selectors , #( - nil - methodCategoryRename - methodCategoryRemove - ). + labels := labels , #( + '-' + 'rename ...' + 'remove' + ). + + selectors := selectors , #( + nil + methodCategoryRename + methodCategoryRemove + ). ]. showInstance ifFalse:[ - labels := labels copy. - selectors := selectors copy. - i := labels indexOf:'create access methods'. - labels at:i put:'create documentation stubs'. - selectors at:i put:#methodCategoryCreateDocumentationMethods + labels := labels copy. + selectors := selectors copy. + i := labels indexOf:'create access methods'. + labels at:i put:'create documentation stubs'. + selectors at:i put:#methodCategoryCreateDocumentationMethods ]. shorties := Array new:(selectors size). (selectors includes:#methodCategoryNewCategory) ifTrue:[ - shorties at:(selectors indexOf:#methodCategoryNewCategory) put:#Cmdn + shorties at:(selectors indexOf:#methodCategoryNewCategory) put:#Cmdn ]. m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. currentClass isLoaded ifFalse:[ - m disableAll:#( - methodCategoryNewCategory - methodCategoryCopyCategory - methodCategoryCreateAccessMethods - ) + m disableAll:#( + methodCategoryNewCategory + methodCategoryCopyCategory + methodCategoryCreateAccessMethods + ) ]. ^ m - "Modified: 4.7.1997 / 10:03:55 / cg" + "Modified: / 27.10.1997 / 20:46:04 / cg" ! methodCategoryNewCategory @@ -7130,6 +7271,7 @@ "return a popupmenu as appropriate for the methodList" + |specialMenu m labels selectors shorties newLabels newSelectors @@ -7141,193 +7283,193 @@ localSearchLabels localSearchSelectors| currentMethod notNil ifTrue:[ - currentMethod isWrapped ifTrue:[ - (MessageTracer notNil - and:[MessageTracer isCountingMemoryUsage:currentMethod]) ifTrue:[ - brkLabels := #( - '-' - 'stop mem usage' - ). - - brkSelectors := #( - nil - methodStopMemoryUsage - ) - ] ifFalse:[ - (MessageTracer notNil - and:[MessageTracer isCounting:currentMethod]) ifTrue:[ - brkLabels := #( - '-' - 'stop counting' - ). - - brkSelectors := #( - nil - methodStopCounting - ) - ] ifFalse:[ - currentMethod isTimed ifTrue:[ - brkLabels := #( - '-' - 'stop timing' - ). - - brkSelectors := #( - nil - methodStopTiming - ) - ] ifFalse:[ - currentMethod isTraced ifTrue:[ - brkLabels := #( - '-' - 'remove trace' - ). - ] ifFalse:[ - brkLabels := #( - '-' - 'remove breakpoint' - ). - ]. - - brkSelectors := #( - nil - methodRemoveBreakOrTrace - ) - ] - ] - ] - ] ifFalse:[ - brkLabels := #( - '-' - 'breakpoint' - 'breakpoint in ...' - '-' - 'trace' - 'trace sender' - 'trace full walkback' - '-' - 'start timing' - 'start counting' - 'start mem usage' - ). - - brkSelectors := #( - nil - methodBreakPoint - methodBreakPointInProcess - nil - methodTrace - methodTraceSender - methodTraceFull - nil - methodStartTiming - methodStartCounting - methodStartMemoryUsage - ) - ]. - - Method methodPrivacySupported ifTrue:[ - labels := #( - 'inspect method' - 'compile to machine code' - 'decompile' - '-' - 'make public' - 'make private' - 'make protected' - 'make ignored' - ). - selectors := #( - methodInspect - methodSTCCompile - methodDecompile - nil - methodMakePublic - methodMakePrivate - methodMakeProtected - methodMakeIgnored - ) - ] ifFalse:[ - labels := #( - 'inspect method' - 'compile to machine code' - 'decompile' - ). - selectors := #( - methodInspect - methodSTCCompile - methodDecompile - ) - ]. - - actualClass isMeta ifTrue:[ - labels := #( - 'invoke method' - '-' - ) - , labels. - selectors := #( - methodInvoke - nil - ) - , selectors. - ]. - - labels := labels , brkLabels. - selectors := selectors , brkSelectors. - - specialMenu := PopUpMenu - labels:(resources array:labels) - selectors:selectors. - - currentMethod isPublic ifTrue:[ - specialMenu disable:#methodMakePublic - ]. - currentMethod isPrivate ifTrue:[ - specialMenu disable:#methodMakePrivate - ]. - currentMethod isProtected ifTrue:[ - specialMenu disable:#methodMakeProtected - ]. - currentMethod isIgnored ifTrue:[ - specialMenu disable:#methodMakeIgnored - ]. + currentMethod isWrapped ifTrue:[ + (MessageTracer notNil + and:[MessageTracer isCountingMemoryUsage:currentMethod]) ifTrue:[ + brkLabels := #( + '-' + 'stop mem usage' + ). + + brkSelectors := #( + nil + methodStopMemoryUsage + ) + ] ifFalse:[ + (MessageTracer notNil + and:[MessageTracer isCounting:currentMethod]) ifTrue:[ + brkLabels := #( + '-' + 'stop counting' + ). + + brkSelectors := #( + nil + methodStopCounting + ) + ] ifFalse:[ + currentMethod isTimed ifTrue:[ + brkLabels := #( + '-' + 'stop timing' + ). + + brkSelectors := #( + nil + methodStopTiming + ) + ] ifFalse:[ + currentMethod isTraced ifTrue:[ + brkLabels := #( + '-' + 'remove trace' + ). + ] ifFalse:[ + brkLabels := #( + '-' + 'remove breakpoint' + ). + ]. + + brkSelectors := #( + nil + methodRemoveBreakOrTrace + ) + ] + ] + ] + ] ifFalse:[ + brkLabels := #( + '-' + 'breakpoint' + 'breakpoint in ...' + '-' + 'trace' + 'trace sender' + 'trace full walkback' + '-' + 'start timing' + 'start counting' + 'start mem usage' + ). + + brkSelectors := #( + nil + methodBreakPoint + methodBreakPointInProcess + nil + methodTrace + methodTraceSender + methodTraceFull + nil + methodStartTiming + methodStartCounting + methodStartMemoryUsage + ) + ]. + + Method methodPrivacySupported ifTrue:[ + labels := #( + 'inspect method' + 'compile to machine code' + 'decompile' + '-' + 'make public' + 'make private' + 'make protected' + 'make ignored' + ). + selectors := #( + methodInspect + methodSTCCompile + methodDecompile + nil + methodMakePublic + methodMakePrivate + methodMakeProtected + methodMakeIgnored + ) + ] ifFalse:[ + labels := #( + 'inspect method' + 'compile to machine code' + 'decompile' + ). + selectors := #( + methodInspect + methodSTCCompile + methodDecompile + ) + ]. + + actualClass isMeta ifTrue:[ + labels := #( + 'invoke method' + '-' + ) + , labels. + selectors := #( + methodInvoke + nil + ) + , selectors. + ]. + + labels := labels , brkLabels. + selectors := selectors , brkSelectors. + + specialMenu := PopUpMenu + labels:(resources array:labels) + selectors:selectors. + + currentMethod isPublic ifTrue:[ + specialMenu disable:#methodMakePublic + ]. + currentMethod isPrivate ifTrue:[ + specialMenu disable:#methodMakePrivate + ]. + currentMethod isProtected ifTrue:[ + specialMenu disable:#methodMakeProtected + ]. + currentMethod isIgnored ifTrue:[ + specialMenu disable:#methodMakeIgnored + ]. ]. device ctrlDown ifTrue:[ - currentMethod isNil ifTrue:[ - methodListView flash. - ^ nil - ]. - - ^ specialMenu + currentMethod isNil ifTrue:[ + methodListView flash. + ^ nil + ]. + + ^ specialMenu ]. sepLocalLabels := sepLocalSelectors := #(). searchLabels := #( - 'senders ...' - 'implementors ...' - 'globals ...' - 'string search ...' - 'apropos ...' - ). + 'senders ...' + 'implementors ...' + 'globals ...' + 'string search ...' + 'apropos ...' + ). searchSelectors := #( - methodSenders - methodImplementors - methodGlobalReferends - methodStringSearch - methodAproposSearch - ). + methodSenders + methodImplementors + methodGlobalReferends + methodStringSearch + methodAproposSearch + ). searchShorties := #( - Cmds - Cmdi - Cmdg - Cmdt - Cmda - ). + Cmds + Cmdi + Cmdg + Cmdt + Cmda + ). "/ currentClass notNil ifTrue:[ "/ localSearchLabels := #( @@ -7351,141 +7493,161 @@ "/ ]. currentMethodCategory notNil ifTrue:[ - sepLocalLabels := #('-'). sepLocalSelectors := #(nil). - - newLabels := #( - 'new method' - ). - - newSelectors := #( - methodNewMethod - ). + sepLocalLabels := #('-'). sepLocalSelectors := #(nil). + + (currentClass notNil + and:[showInstance not + and:[currentClass isSubclassOf:ApplicationModel]]) ifTrue:[ + newLabels := #( + 'new method' + 'new window spec' + 'new menu spec' + '-' + ). + + newSelectors := #( + methodNewMethod + methodNewWindowSpec + methodNewMenuSpec + nil + ). + ] ifFalse:[ + newLabels := #( + 'new method' + '-' + ). + + newSelectors := #( + methodNewMethod + nil + ). + ] ] ifFalse:[ - newLabels := newSelectors := #() + newLabels := newSelectors := #() ]. currentMethod notNil ifTrue:[ - fileLabels := #( - 'fileOut' - 'printOut' - '-' - 'SPAWN_METHOD' - '-' - ). - - fileSelectors := #( - methodFileOut - methodPrintOut - nil - methodSpawn - nil - ). - - sepLocalLabels := #('-'). sepLocalSelectors := #(nil). - - mthdLabels := #( - 'change category ...' - 'move ...' - 'remove' - '-' - 'compare with previous' - 'back to previous' - ). - - mthdSelectors := #( - methodChangeCategory - methodMove - methodRemove - nil - methodCompareWithPreviousVersion - methodPreviousVersion - ). + fileLabels := #( + 'fileOut' + 'printOut' + '-' + 'SPAWN_METHOD' + '-' + ). + + fileSelectors := #( + methodFileOut + methodPrintOut + nil + methodSpawn + nil + ). + + sepLocalLabels := #('-'). sepLocalSelectors := #(nil). + + mthdLabels := #( + 'change category ...' + 'move ...' + 'remove' + '-' + 'compare with previous' + 'back to previous' + ). + + mthdSelectors := #( + methodChangeCategory + methodMove + methodRemove + nil + methodCompareWithPreviousVersion + methodPreviousVersion + ). ] ifFalse:[ - fileLabels := fileSelectors := #(). - mthdLabels := mthdSelectors := #(). + fileLabels := fileSelectors := #(). + mthdLabels := mthdSelectors := #(). ]. labels := - fileLabels , - searchLabels , + fileLabels , + searchLabels , "/ localSearchLabels , - sepLocalLabels , - newLabels , - mthdLabels. + sepLocalLabels , + newLabels , + mthdLabels. selectors := - fileSelectors , - searchSelectors , + fileSelectors , + searchSelectors , "/ localSearchSelectors , - sepLocalSelectors , - newSelectors , - mthdSelectors . + sepLocalSelectors , + newSelectors , + mthdSelectors . shorties := (Array new:(fileSelectors size)) - , searchShorties - , (Array new:(localSearchSelectors size - + sepLocalSelectors size - + newSelectors size - + mthdSelectors size)). + , searchShorties + , (Array new:(localSearchSelectors size + + sepLocalSelectors size + + newSelectors size + + mthdSelectors size)). specialMenu notNil ifTrue:[ - labels := labels , #( - '=' - 'others' - ). - selectors := selectors , #( - nil - #otherMenu - ). - shorties := shorties , #( nil #'Ctrl') + labels := labels , #( + '=' + 'others' + ). + selectors := selectors , #( + nil + #otherMenu + ). + shorties := shorties , #( nil #'Ctrl') ]. m := PopUpMenu - labels:(resources array:labels) - selectors:selectors - accelerators:shorties. + labels:(resources array:labels) + selectors:selectors + accelerators:shorties. specialMenu notNil ifTrue:[ - m subMenuAt:#otherMenu put:specialMenu. + m subMenuAt:#otherMenu put:specialMenu. ]. currentMethod notNil ifTrue:[ - currentMethod isPrivate ifTrue:[ - m disable:#methodMakePrivate - ]. - currentMethod isProtected ifTrue:[ - m disable:#methodMakeProtected - ]. - currentMethod isPublic ifTrue:[ - m disable:#methodMakePublic - ]. - currentMethod isIgnored ifTrue:[ - m disable:#methodMakeIgnored - ]. - - (currentMethod code notNil - or:[Compiler canCreateMachineCode not]) ifTrue:[ - m disable:#methodSTCCompile - ]. - currentMethod byteCode isNil ifTrue:[ - m disable:#methodDecompile - ]. - - currentMethod previousVersion isNil ifTrue:[ - m disable:#methodPreviousVersion. - m disable:#methodCompareWithPreviousVersion - ] + currentMethod isPrivate ifTrue:[ + m disable:#methodMakePrivate + ]. + currentMethod isProtected ifTrue:[ + m disable:#methodMakeProtected + ]. + currentMethod isPublic ifTrue:[ + m disable:#methodMakePublic + ]. + currentMethod isIgnored ifTrue:[ + m disable:#methodMakeIgnored + ]. + + (currentMethod code notNil + or:[Compiler canCreateMachineCode not]) ifTrue:[ + m disable:#methodSTCCompile + ]. + currentMethod byteCode isNil ifTrue:[ + m disable:#methodDecompile + ]. + + currentMethod previousVersion isNil ifTrue:[ + m disable:#methodPreviousVersion. + m disable:#methodCompareWithPreviousVersion + ] ]. ^ m - "Created: 23.11.1995 / 12:02:29 / cg" - "Modified: 18.12.1995 / 16:20:07 / stefan" - "Modified: 15.4.1997 / 10:19:00 / cg" - "Modified: 29.4.1997 / 11:20:59 / dq" + "Created: / 23.11.1995 / 12:02:29 / cg" + "Modified: / 18.12.1995 / 16:20:07 / stefan" + "Modified: / 29.4.1997 / 11:20:59 / dq" + "Modified: / 28.10.1997 / 12:35:15 / cg" ! methodMove @@ -7558,6 +7720,26 @@ "Modified: 25.6.1997 / 13:58:56 / cg" ! +methodNewMenuSpec + "open a MenuEditor" + + |specSel| + + currentClass isNil ifTrue:[ + ^ self warn:'select/create a class first'. + ]. + currentMethodCategory isNil ifTrue:[ + ^ self warn:'select/create a method category first'. + ]. + + (actualClass implements:#menuSpec) ifFalse:[ + specSel := #menuSpec + ]. + MenuEditor openOnClass:currentClass andSelector:specSel + + "Created: / 28.10.1997 / 12:42:00 / cg" +! + methodNewMethod "prepare for definition of a new method - put a template into code view and define accept-action to compile it" @@ -7580,6 +7762,26 @@ "Modified: 25.5.1996 / 13:02:44 / cg" ! +methodNewWindowSpec + "open GUI Painter" + + |specSel| + + currentClass isNil ifTrue:[ + ^ self warn:'select/create a class first'. + ]. + currentMethodCategory isNil ifTrue:[ + ^ self warn:'select/create a method category first'. + ]. + + (actualClass implements:#windowSpec) ifFalse:[ + specSel := #windowSpec + ]. + UIPainter openOnClass:currentClass andSelector:specSel + + "Modified: / 28.10.1997 / 12:40:35 / cg" +! + methodPreviousVersion "switch back to the previous version (undo last change)" @@ -7893,28 +8095,58 @@ "answer a method list entry (gimmic: adding a little image to breakPointed methods)" - |s icn| + |s icn resources| s := aMethod printStringForBrowserWithSelector:selector. + + "/ + "/ wrap icons (i.e. break- or trace points) + "/ have higher prio ... + "/ aMethod isWrapped ifTrue:[ - (s endsWith:' !!') ifTrue:[ - s := s copyWithoutLast:2 - ]. - aMethod isBreakpointed ifTrue:[ - icn := self stopIcon - ] ifFalse:[ - aMethod isTimed ifTrue:[ - icn := self timeIcon - ] ifFalse:[ - icn := self traceIcon - ] - ]. - ^ LabelAndIcon icon:icn string:s + (s endsWith:' !!') ifTrue:[ + s := s copyWithoutLast:2 + ]. + aMethod isBreakpointed ifTrue:[ + icn := self stopIcon + ] ifFalse:[ + aMethod isTimed ifTrue:[ + icn := self timeIcon + ] ifFalse:[ + icn := self traceIcon + ] + ]. + ]. + + icn isNil ifTrue:[ + ShowResourceIcons ~~ false ifTrue:[ + (resources := aMethod resources) notNil ifTrue:[ + (resources includesKey:#canvas) ifTrue:[ + icn := self canvasIcon + ] ifFalse:[ + (resources includesKey:#menu) ifTrue:[ + icn := self menuIcon + ] ifFalse:[ + (resources includesKey:#image) ifTrue:[ + icn := self imageIcon + ] ifFalse:[ + (resources includesKey:#programMenu) ifTrue:[ + icn := self programMenuIcon + ] + ] + ] + ] + ]. + ]. + ]. + + icn notNil ifTrue:[ + ^ LabelAndIcon icon:icn string:s ]. ^ s - "Created: 22.10.1996 / 19:51:00 / cg" - "Modified: 11.4.1997 / 17:16:19 / cg" + "Created: / 22.10.1996 / 19:51:00 / cg" + "Modified: / 28.10.1997 / 13:39:38 / cg" ! listOfAllMethodsInCategory:aCategory inFullProtocolHierarchyOfClass:aClass @@ -8066,6 +8298,27 @@ "Modified: 30.7.1997 / 15:29:16 / cg" ! +methodDoubleClick:lineNr + |resources| + + currentMethod notNil ifTrue:[ + currentMethod hasResource ifTrue:[ + resources := currentMethod resources. + (resources includesKey:#canvas) ifTrue:[ + UIPainter openOnClass:currentClass andSelector:currentSelector. + ^ self + ]. + (resources includesKey:#menu) ifTrue:[ + MenuEditor openOnClass:currentClass andSelector:currentSelector. + ^ self + ]. + ] + ] + + "Created: / 27.10.1997 / 00:29:58 / cg" + "Modified: / 28.10.1997 / 12:45:05 / cg" +! + methodSelection:lineNr "user clicked on a method line - show code" @@ -8356,52 +8609,54 @@ "/ update the list, caring for traps. classMethodListView list do:[:entry | - |cls sel mthd s icn| - - cls := self classFromClassMethodString:entry string. - sel := self selectorFromClassMethodString:entry string. - (cls isNil or:[sel isNil]) ifTrue:[ - "/ method is gone ? - s := entry string. - (s endsWith:'???') ifFalse:[ - s := s , ' ???'. - ]. - newList add:s - ] ifFalse:[ - mthd := cls compiledMethodAt:(sel asSymbol). - mthd isNil ifTrue:[ - newList add:cls name , ' ' , sel , ' ???' - ] ifFalse:[ - s := cls name , ' ' , (mthd printStringForBrowserWithSelector:sel). - mthd isWrapped ifTrue:[ - (s endsWith:' !!') ifTrue:[ - s := s copyWithoutLast:2 - ]. - (s endsWith:' !!') ifTrue:[ - s := s copyWithoutLast:2 - ]. - mthd isBreakpointed ifTrue:[ - icn := self stopIcon - ] ifFalse:[ - mthd isTimed ifTrue:[ - icn := self timeIcon - ] ifFalse:[ - icn := self traceIcon - ] - ]. - newList add:(LabelAndIcon icon:icn string:s) - ] ifFalse:[ - newList add:s - ]. - ]. - ]. + |cls sel mthd s icn| + + cls := self classFromClassMethodString:entry string. + sel := self selectorFromClassMethodString:entry string. + (cls isNil or:[sel isNil]) ifTrue:[ + "/ method is gone ? + s := entry string. + (s endsWith:'???') ifFalse:[ + s := s , ' ???'. + ]. + newList add:s + ] ifFalse:[ + mthd := cls compiledMethodAt:(sel asSymbol). + mthd isNil ifTrue:[ + newList add:cls name , ' ' , sel , ' ???' + ] ifFalse:[ + newList add:(self listEntryForMethod:mthd selector:(cls name , ' ' , sel)) + +"/ s := cls name , ' ' , (mthd printStringForBrowserWithSelector:sel). +"/ mthd isWrapped ifTrue:[ +"/ (s endsWith:' !!') ifTrue:[ +"/ s := s copyWithoutLast:2 +"/ ]. +"/ (s endsWith:' !!') ifTrue:[ +"/ s := s copyWithoutLast:2 +"/ ]. +"/ mthd isBreakpointed ifTrue:[ +"/ icn := self stopIcon +"/ ] ifFalse:[ +"/ mthd isTimed ifTrue:[ +"/ icn := self timeIcon +"/ ] ifFalse:[ +"/ icn := self traceIcon +"/ ] +"/ ]. +"/ newList add:(LabelAndIcon icon:icn string:s) +"/ ] ifFalse:[ +"/ newList add:s +"/ ]. + ]. + ]. ]. classMethodListView setList:newList. classMethodListView setSelection:selection. - "Modified: 18.12.1995 / 22:54:04 / stefan" - "Created: 3.3.1997 / 15:10:15 / cg" - "Modified: 24.4.1997 / 17:14:23 / cg" + "Modified: / 18.12.1995 / 22:54:04 / stefan" + "Created: / 3.3.1997 / 15:10:15 / cg" + "Modified: / 26.10.1997 / 16:52:32 / cg" ! updateMethodList @@ -9565,29 +9820,36 @@ is defined; needs either #instVarNames or #classVarNames as aSelector." - |cls homeClass| + |cls homeClass list| " first, find the class, where the variable is declared " cls := currentClass. [cls notNil] whileTrue:[ - ((cls perform:aSelector) includes:aVariableName) ifTrue:[ - homeClass := cls. - cls := nil. - ] ifFalse:[ - cls := cls superclass - ] + aSelector == #classInstVarNames ifTrue:[ + list := cls class instVarNames + ] ifFalse:[ + list := cls perform:aSelector + ]. + (list includes:aVariableName) ifTrue:[ + homeClass := cls. + cls := nil. + ] ifFalse:[ + cls := cls superclass + ] ]. homeClass isNil ifTrue:[ - "nope, must be one below ... (could optimize a bit, by searching down - for the declaring class ... - " - homeClass := currentClass + "nope, must be one below ... (could optimize a bit, by searching down + for the declaring class ... + " + homeClass := currentClass ] ifFalse:[ "/ Transcript showCR:'starting search in ' , homeClass name. ]. ^ homeClass + + "Modified: / 25.10.1997 / 20:26:25 / cg" ! hideMethodCategoryList @@ -9901,12 +10163,48 @@ !BrowserView methodsFor:'private - defaults'! +canvasIcon + "answer an icon to mark canvas (windowSpec) methods" + + ^ self class canvasIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 26.10.1997 / 16:25:54 / cg" +! + commentEmphasis ^ (#color -> (Color red:0 green:0 blue:25)) "Created: 1.8.1997 / 12:36:14 / cg" ! +imageIcon + "answer an icon to mark image methods" + + ^ self class imageIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 28.10.1997 / 13:35:35 / cg" +! + +menuIcon + "answer an icon to mark menu (menuSpec) methods" + + ^ self class menuIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 27.10.1997 / 00:41:04 / cg" +! + +programMenuIcon + "answer an icon to mark programmed-menu (menuSpec) methods" + + ^ self class programMenuIcon + + "Modified: / 7.4.1997 / 17:31:40 / cg" + "Created: / 28.10.1997 / 13:35:16 / cg" +! + stopIcon "answer an icon to mark breakPointed methods" @@ -9990,106 +10288,148 @@ !BrowserView methodsFor:'variable list menu'! -allClassOrInstVarRefsTitle:title access:access mods:modifications - "show an enterbox for instVar to search for" - - self doClassMenu:[:currentClass | - |box| - - box := self enterBoxForVariableSearch:title. - box action:[:aVariableName | - |homeClass| - - aVariableName isEmpty ifFalse:[ - self withSearchCursorDo:[ - homeClass := self findClassOfVariable:aVariableName accessWith:access. - access == #classVarNames ifTrue:[ - SystemBrowser - browseClassRefsTo:aVariableName - under:homeClass - modificationsOnly:modifications - ] ifFalse:[ - SystemBrowser - browseInstRefsTo:aVariableName - under:homeClass - modificationsOnly:modifications - ] - ] - ] - ]. - box showAtPointer - ] - - "Created: 23.11.1995 / 14:13:24 / cg" +allClassInstVarMods + "show an enterbox for classVar to search for" + + self allVarRefsTitle:'class instance variable to browse all modifications of:' + access:#classInstVarNames + mods:true + + "Modified: / 25.10.1997 / 20:19:49 / cg" + "Created: / 25.10.1997 / 20:21:48 / cg" +! + +allClassInstVarRefs + "show an enterbox for classVar to search for" + + self allVarRefsTitle:'class instance variable to browse all references to:' + access:#classInstVarNames + mods:false + + "Modified: / 25.10.1997 / 20:20:09 / cg" + "Created: / 25.10.1997 / 20:22:14 / cg" ! allClassVarMods "show an enterbox for classVar to search for" - self allClassOrInstVarRefsTitle:'class variable to browse modifications of:' - access:#classVarNames - mods:true + self allVarRefsTitle:'class variable to browse all modifications of:' + access:#classVarNames + mods:true + + "Modified: / 25.10.1997 / 20:22:24 / cg" ! allClassVarRefs "show an enterbox for classVar to search for" - self allClassOrInstVarRefsTitle:'class variable to browse references to:' - access:#classVarNames - mods:false + self allVarRefsTitle:'class variable to browse all references to:' + access:#classVarNames + mods:false + + "Modified: / 25.10.1997 / 20:22:30 / cg" ! allInstVarMods "show an enterbox for instVar to search for" - self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:' - access:#instVarNames - mods:true + self allVarRefsTitle:'instance variable to browse all modifications of:' + access:#instVarNames + mods:true + + "Modified: / 25.10.1997 / 20:22:35 / cg" ! allInstVarRefs "show an enterbox for instVar to search for" - self allClassOrInstVarRefsTitle:'instance variable to browse references to:' - access:#instVarNames - mods:false + self allVarRefsTitle:'instance variable to browse all references to:' + access:#instVarNames + mods:false + + "Modified: / 25.10.1997 / 20:22:40 / cg" +! + +allVarRefsTitle:title access:access mods:modifications + "show an enterbox for instVar to search for" + + self doClassMenu:[:currentClass | + |box| + + box := self enterBoxForVariableSearch:title. + box action:[:aVariableName | + |homeClass| + + aVariableName isEmpty ifFalse:[ + self withSearchCursorDo:[ + homeClass := self findClassOfVariable:aVariableName accessWith:access. + access == #classVarNames ifTrue:[ + SystemBrowser + browseClassRefsTo:aVariableName + under:homeClass + modificationsOnly:modifications + ] ifFalse:[ + access == #classInstVarNames ifTrue:[ + SystemBrowser + browseInstRefsTo:aVariableName + under:homeClass class + modificationsOnly:modifications + ] ifFalse:[ + SystemBrowser + browseInstRefsTo:aVariableName + under:homeClass + modificationsOnly:modifications + ] + ] + ] + ] + ]. + box showAtPointer + ] + + "Created: / 25.10.1997 / 20:19:26 / cg" +! + +classInstVarMods + "show an enterbox for classVar to search for" + + self varRefsOrModsTitle:'class instance variable to browse modifications of:' + access:#classInstVarNames + mods:true + + "Modified: / 25.10.1997 / 20:17:41 / cg" + "Created: / 25.10.1997 / 20:21:04 / cg" +! + +classInstVarRefs + "show an enterbox for classVar to search for" + + self varRefsOrModsTitle:'class instance variable to browse references to:' + access:#classInstVarNames + mods:false + + "Modified: / 25.10.1997 / 20:17:23 / cg" + "Created: / 25.10.1997 / 20:21:19 / cg" ! classVarMods "show an enterbox for classVar to search for" - self classVarRefsOrModsTitle:'class variable to browse modifications of:' - mods:true + self varRefsOrModsTitle:'class variable to browse modifications of:' + access:#classVarNames + mods:true + + "Modified: / 25.10.1997 / 20:17:41 / cg" ! classVarRefs "show an enterbox for classVar to search for" - self classVarRefsOrModsTitle:'class variable to browse references to:' - mods:false -! - -classVarRefsOrModsTitle:title mods:mods - "show an enterbox for classVar to search for" - - self doClassMenu:[:currentClass | - |box| - - box := self enterBoxForVariableSearch:title. - box action:[:aString | - aString notEmpty ifTrue:[ - self withSearchCursorDo:[ - SystemBrowser - browseClassRefsTo:aString - in:(Array with:currentClass) - modificationsOnly:mods - ] - ] - ]. - box showAtPointer - ] - - "Created: 23.11.1995 / 14:12:56 / cg" + self varRefsOrModsTitle:'class variable to browse references to:' + access:#classVarNames + mods:false + + "Modified: / 25.10.1997 / 20:17:23 / cg" ! enterBoxForVariableSearch:title @@ -10111,38 +10451,69 @@ instVarMods "show an enterbox for instVar to search for" - self instVarRefsOrModsTitle:'instance variable to browse modifications of:' - mods:true + self varRefsOrModsTitle:'instance variable to browse modifications of:' + access:#instVarNames + mods:true + + "Modified: / 25.10.1997 / 20:14:52 / cg" ! instVarRefs "show an enterbox for instVar to search for" - self instVarRefsOrModsTitle:'instance variable to browse references to:' - mods:false -! - -instVarRefsOrModsTitle:title mods:mods + self varRefsOrModsTitle:'instance variable to browse references to:' + access:#instVarNames + mods:false + + "Modified: / 25.10.1997 / 20:14:27 / cg" +! + +showClassInstVars + classInstVarsInVarList := true. + self updateVariableList. + + "Created: / 25.10.1997 / 19:43:04 / cg" + "Modified: / 25.10.1997 / 19:43:41 / cg" +! + +showClassVars + classInstVarsInVarList := false. + self updateVariableList. + + "Created: / 25.10.1997 / 19:42:55 / cg" + "Modified: / 25.10.1997 / 19:43:35 / cg" +! + +varRefsOrModsTitle:title access:accessor mods:mods "show an enterbox for instvar to search for" self doClassMenu:[:currentClass | - |box| - - box := self enterBoxForVariableSearch:title. - box action:[:aString | - aString notEmpty ifTrue:[ - self withSearchCursorDo:[ - SystemBrowser - browseInstRefsTo:aString - in:(Array with:currentClass) - modificationsOnly:mods - ] - ] - ]. - box showAtPointer + |box| + + box := self enterBoxForVariableSearch:title. + box action:[:aString | + aString notEmpty ifTrue:[ + self withSearchCursorDo:[ + |sel classes| + + sel := #'browseInstRefsTo:in:modificationsOnly:'. + accessor == #classInstVarNames ifTrue:[ + classes := Array with:currentClass class. + ] ifFalse:[ + classes := Array with:currentClass. + accessor == #classVarNames ifTrue:[ + sel := #'browseClassRefsTo:in:modificationsOnly:' + ] + ]. + SystemBrowser perform:sel with:aString with:classes with:mods + ] + ] + ]. + box showAtPointer ] - "Created: 23.11.1995 / 14:12:40 / cg" + "Created: / 25.10.1997 / 20:12:52 / cg" + "Modified: / 25.10.1997 / 21:10:34 / cg" ! varTypeInfo @@ -10268,56 +10639,101 @@ ! variableListMenu + + |labels selectors m| currentClass isNil ifTrue:[ - variableListView flash. - ^ nil - ]. - - labels := #( - 'instvar refs ...' - 'classvar refs ...' - 'all instvar refs ...' - 'all classvar refs ...' - '-' - 'instvar mods ...' - 'classvar mods ...' - 'all instvar mods ...' - 'all classvar mods ...' - ). - selectors := #( - instVarRefs - classVarRefs - allInstVarRefs - allClassVarRefs - nil - instVarMods - classVarMods - allInstVarMods - allClassVarMods - ). + variableListView flash. + ^ nil + ]. + + showInstance ifFalse:[ + labels := #( + 'class instvar refs ...' + 'class instvar mods ...' + 'classvar refs ...' + 'classvar mods ...' + '-' + 'all class instvar refs ...' + 'all class instvar mods ...' + 'all classvar refs ...' + 'all classvar mods ...' + ). + selectors := #( + classInstVarRefs + classInstVarMods + classVarRefs + classVarMods + nil + allClassInstVarRefs + allClassInstVarMods + allClassVarRefs + allClassVarMods + ). + ] ifTrue:[ + labels := #( + 'instvar refs ...' + 'instvar mods ...' + 'classvar refs ...' + 'classvar mods ...' + '-' + 'all instvar refs ...' + 'all classvar refs ...' + 'all instvar mods ...' + 'all classvar mods ...' + ). + selectors := #( + instVarRefs + instVarMods + classVarRefs + classVarMods + nil + allInstVarRefs + allClassVarRefs + allInstVarMods + allClassVarMods + ). + ]. + + showInstance ifFalse:[ + classInstVarsInVarList == true ifTrue:[ + labels := labels , #('-' 'show classVars'). + selectors := selectors , #(nil #showClassVars). + ] ifFalse:[ + labels := labels , #('-' 'show classInstVars'). + selectors := selectors , #(nil #showClassInstVars). + ]. + ]. ("showInstance and:[" variableListView hasSelection "]" ) ifTrue:[ - labels := labels , #( - '-' - 'type information' - ). - selectors := selectors , #( - nil - varTypeInfo - ). - ]. - - m := PopUpMenu labels:(resources array:labels) - selectors:selectors. + labels := labels , #( + '-' + 'type information' + ). + selectors := selectors , #( + nil + varTypeInfo + ). + ]. + + m := PopUpMenu + labels:(resources array:labels) + selectors:selectors. + + currentClass instSize == 0 ifTrue:[ + m disableAll:#(instVarRefs instVarMods). + currentClass subclasses size == 0 ifTrue:[ + m disableAll:#(allInstVarRefs allInstVarMods). + ] + ]. currentClass isLoaded ifFalse:[ - m disableAll + m disableAll ]. ^ m - "Modified: 3.1.1997 / 11:57:27 / cg" + "Modified: / 27.10.1997 / 20:45:17 / cg" ! variableSelection:lineNr @@ -10417,94 +10833,97 @@ name isNil ifTrue:[^ self]. self withSearchCursorDo:[ - |classes filter any supers| - - classes := Array with:actualClass. - (currentClassHierarchy notNil and:[fullProtocol]) ifTrue:[ - supers := actualClass allSuperclasses. - supers notNil ifTrue:[ - classes := classes , supers. - ]. - redefinedSelectors := IdentitySet new. - ]. - - filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false. - - methodListView notNil ifTrue:[ - methodList := methodListView list. - ]. - methodCategoryListView notNil ifTrue:[ - methodCategoryList := methodCategoryListView list. - ]. - - any := false. - - " - highlight the method that ref this variable - " - classes do:[:someClass | - (fullProtocol - and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[ - someClass methodDictionary keysAndValuesDo:[:selector :method | - (inCat - or:[methodList notNil - and:[methodList includes:selector]]) - ifTrue:[ - (redefinedSelectors isNil - or:[(redefinedSelectors includes:selector) not]) - ifTrue:[ - (filter value:someClass value:method value:selector) ifTrue:[ - |idx cat| - - (inCat - and:[methodCategoryList notNil]) ifTrue:[ - cat := method category. - " - highlight the methodCategory - " - idx := methodCategoryListView list indexOf:cat. - idx ~~ 0 ifTrue:[ - entry := methodCategoryListView at:idx. - entry := self hilightEntryFor:entry. - methodCategoryListView at:idx put:entry + |classes filter any supers| + + classes := Array with:actualClass. + (currentClassHierarchy notNil and:[fullProtocol]) ifTrue:[ + supers := actualClass allSuperclasses. + supers notNil ifTrue:[ + classes := classes , supers. + ]. + redefinedSelectors := IdentitySet new. + ]. + + filter := SystemBrowser + filterToSearchRefsTo:name + classVars:(showInstance not and:[classInstVarsInVarList ~~ true]) + modificationsOnly:false. + + methodListView notNil ifTrue:[ + methodList := methodListView list. + ]. + methodCategoryListView notNil ifTrue:[ + methodCategoryList := methodCategoryListView list. + ]. + + any := false. + + " + highlight the method that ref this variable + " + classes do:[:someClass | + (fullProtocol + and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[ + someClass methodDictionary keysAndValuesDo:[:selector :method | + (inCat + or:[methodList notNil + and:[methodList includes:selector]]) + ifTrue:[ + (redefinedSelectors isNil + or:[(redefinedSelectors includes:selector) not]) + ifTrue:[ + (filter value:someClass value:method value:selector) ifTrue:[ + |idx cat| + + (inCat + and:[methodCategoryList notNil]) ifTrue:[ + cat := method category. + " + highlight the methodCategory + " + idx := methodCategoryListView list indexOf:cat. + idx ~~ 0 ifTrue:[ + entry := methodCategoryListView at:idx. + entry := self hilightEntryFor:entry. + methodCategoryListView at:idx put:entry "/ methodCategoryListView attributeAt:idx put:#bold. - ]. - ]. - - (inMethods - and:[methodList notNil]) ifTrue:[ - " - highlight the method - " - idx := methodListView list - findFirst:[:item | item string = selector - or:[item string startsWith:(selector , ' ')] - ]. - idx ~~ 0 ifTrue:[ - entry := methodListView at:idx. - entry := self hilightEntryFor:entry. - methodListView at:idx put:entry + ]. + ]. + + (inMethods + and:[methodList notNil]) ifTrue:[ + " + highlight the method + " + idx := methodListView list + findFirst:[:item | item string = selector + or:[item string startsWith:(selector , ' ')] + ]. + idx ~~ 0 ifTrue:[ + entry := methodListView at:idx. + entry := self hilightEntryFor:entry. + methodListView at:idx put:entry "/ methodListView attributeAt:idx put:#bold. - ]. - any := true - ]. - ]. - redefinedSelectors notNil ifTrue:[ - redefinedSelectors add:selector - ] - ] - ] - ] - ] - ]. - any ifTrue:[ - self setSearchPattern:name - ] + ]. + any := true + ]. + ]. + redefinedSelectors notNil ifTrue:[ + redefinedSelectors add:selector + ] + ] + ] + ] + ] + ]. + any ifTrue:[ + self setSearchPattern:name + ] ] - "Created: 23.11.1995 / 14:12:08 / cg" - "Modified: 5.6.1996 / 11:38:19 / stefan" - "Modified: 22.10.1996 / 23:37:25 / cg" + "Created: / 23.11.1995 / 14:12:08 / cg" + "Modified: / 5.6.1996 / 11:38:19 / stefan" + "Modified: / 25.10.1997 / 21:02:47 / cg" ! hilightMethodsInMethodList @@ -10572,7 +10991,9 @@ ! updateVariableList - |l subList last nameAccessSelector class oldSelection| + "update the variable list - either show instVars, classVars or classInstVars" + + |l subList last nameAccessSelector class oldSelection askMeta| variableListView isNil ifTrue:[^ self]. @@ -10580,70 +11001,78 @@ l := OrderedCollection new. " - show classVars, if classProtocol is shown (instead of classInstance vars) + show classVars/classInstVars, + if classProtocol is shown (instead of classInstance vars) " + askMeta := false. showInstance ifTrue:[ - nameAccessSelector := #instVarNames + nameAccessSelector := #instVarNames ] ifFalse:[ - nameAccessSelector := #classVarNames - ]. - -"/ class := currentClass notNil ifTrue:[currentClass] ifFalse:[actualClass]. -"/ class isNil ifTrue:[class := currentClassHierarchy]. + classInstVarsInVarList == true ifTrue:[ + nameAccessSelector := #instVarNames. + askMeta := true. + ] ifFalse:[ + nameAccessSelector := #classVarNames + ] + ]. class := currentClassHierarchy notNil ifTrue:[ - currentClassHierarchy + currentClassHierarchy ] ifFalse:[ - currentClass + currentClass ]. class := currentClass. fullProtocol ifTrue:[ - class := currentClassHierarchy + class := currentClassHierarchy ]. class isNil ifTrue:[ - variableListView list:nil. - ^ self + variableListView list:nil. + ^ self ]. class withAllSuperclasses do:[:aClass | - |ignore| - - ignore := fullProtocol - and:[classListView valueIsInSelection:(aClass name asString)]. - ignore ifFalse:[ - subList := aClass perform:nameAccessSelector. - subList size ~~ 0 ifTrue:[ - l := l , (subList asOrderedCollection reverse). - l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------'). - ] - ] + |ignore| + + ignore := fullProtocol + and:[classListView valueIsInSelection:(aClass name asString)]. + ignore ifFalse:[ + askMeta ifTrue:[ + subList := aClass class perform:nameAccessSelector. + ] ifFalse:[ + subList := aClass perform:nameAccessSelector. + ]. + subList size ~~ 0 ifTrue:[ + l := l , (subList asOrderedCollection reverse). + l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------'). + ] + ] ]. l reverse. variableListView setAttributes:nil. l ~= variableListView list ifTrue:[ - variableListView list:l. + variableListView list:l. ]. l keysAndValuesDo:[:index :entry | - (entry startsWith:'---') ifTrue:[ - variableListView attributeAt:index put:#disabled. - last := index - ] + (entry startsWith:'---') ifTrue:[ + variableListView attributeAt:index put:#disabled. + last := index + ] ]. last notNil ifTrue:[variableListView scrollToLine:last]. oldSelection notNil ifTrue:[ - variableListView setSelectElement:oldSelection. - self hilightMethodsInMethodCategoryList:true inMethodList:true. + variableListView setSelectElement:oldSelection. + self hilightMethodsInMethodCategoryList:true inMethodList:true. ] - "Modified: 27.10.1996 / 15:48:02 / cg" + "Modified: / 25.10.1997 / 21:01:11 / cg" ! ! !BrowserView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.344 1997-10-15 11:15:55 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.345 1997-10-28 18:26:12 cg Exp $' ! ! BrowserView initialize!