--- 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
<resource: #keyboard ( #Find #Cmdn) >
+ <resource: #programMenu >
|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"
<resource: #keyboard ( #Cmdl #Cmdn #Cmdd) >
+ <resource: #programMenu >
|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
<resource: #keyboard ( #Cmds #Cmdi #Cmdg ) >
+ <resource: #programMenu >
|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
<resource: #keyboard (#Cmdn)>
+ <resource: #programMenu >
|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"
<resource: #keyboard ( #Cmds #Cmdi #Cmdg #Cmdt #Cmda) >
+ <resource: #programMenu >
|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
+ <resource: #programMenu >
+
|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!
--- 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
<resource: #keyboard ( #Find #Cmdn) >
+ <resource: #programMenu >
|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"
<resource: #keyboard ( #Cmdl #Cmdn #Cmdd) >
+ <resource: #programMenu >
|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
<resource: #keyboard ( #Cmds #Cmdi #Cmdg ) >
+ <resource: #programMenu >
|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
<resource: #keyboard (#Cmdn)>
+ <resource: #programMenu >
|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"
<resource: #keyboard ( #Cmds #Cmdi #Cmdg #Cmdt #Cmda) >
+ <resource: #programMenu >
|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
+ <resource: #programMenu >
+
|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!