--- a/BrowserView.st Fri Oct 10 19:35:45 1997 +0200
+++ b/BrowserView.st Sat Oct 11 17:50:36 1997 +0200
@@ -647,54 +647,109 @@
!
classCategoryFileOut
+ "create a file 'categoryName.st' consisting of all classes in current category
+ into the current projects defaultDirectory."
+
+ self classCategoryFileOutAsk:false
+
+ "Modified: 11.10.1997 / 16:47:46 / cg"
+!
+
+classCategoryFileOutAs
+ "create a file consisting of all classes in the current category
+ into a file as user-specified."
+
+ self classCategoryFileOutAsk:true
+
+ "Modified: 11.10.1997 / 16:38:56 / cg"
+ "Created: 11.10.1997 / 16:44:35 / cg"
+!
+
+classCategoryFileOutAsk:doAsk
"create a file 'categoryName' consisting of all classes in current category"
|aStream fileName|
self checkClassCategorySelected ifFalse:[^ self].
(currentClassCategory startsWith:'*') ifTrue:[
- self warn:(resources string:'try a real category').
- ^ self
- ].
-
- fileName := currentClassCategory asString.
+ self warn:(resources string:'try a real category').
+ ^ self
+ ].
+
+ fileName := currentClassCategory asString , '.st'.
fileName replaceAll:Character space with:$_.
- "
- this test allows a smalltalk to be built without Projects/ChangeSets
- "
- Project notNil ifTrue:[
- fileName := Project currentProjectDirectory , fileName.
- ].
self withBusyCursorDo:[
- "
- if file exists, save original in a .sav file
- "
- fileName asFilename exists ifTrue:[
- self busyLabel:'saving existing %1' with:fileName.
- fileName asFilename copyTo:(fileName , '.sav')
- ].
-
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- self warn:'cannot create: %1' with:fileName
- ] ifFalse:[
- self busyLabel:'writing: %1' with:fileName.
- self allClassesInCategory:currentClassCategory inOrderDo:[:aClass |
- aClass isPrivate ifFalse:[
- (self listOfNamespaces includesIdentical:aClass nameSpace)
- ifTrue:[
- self busyLabel:'writing: %1' with:fileName.
- aClass fileOutOn:aStream.
- ]
- ]
- ].
- aStream close.
- ]
+ |saveName fileBox dir|
+
+ doAsk ifTrue:[
+ fileBox := FileSelectionBox
+ title:(resources string:'fileOut %1 as:' with:currentClassCategory)
+ okText:(resources string:'fileOut')
+ abortText:(resources string:'cancel')
+ action:[:fileName | saveName := fileName].
+ fileBox initialText:fileName.
+ dir := FileSelectionBox lastFileSelectionDirectory.
+ dir isNil ifTrue:[
+ "
+ this test allows a smalltalk to be built without Projects/ChangeSets
+ "
+ Project notNil ifTrue:[
+ dir := Project currentProjectDirectory
+ ]
+ ].
+ dir notNil ifTrue:[
+ fileBox directory:dir.
+ ].
+ fileBox showAtPointer.
+ fileBox destroy.
+ saveName isNil ifTrue:[
+ ^ self
+ ].
+ saveName isEmpty ifTrue:[
+ self warn:'bad name given'.
+ ^ self
+ ].
+ FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
+ fileName := saveName.
+ ] ifFalse:[
+ "
+ 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:[
+ self busyLabel:'saving existing %1' with:fileName.
+ fileName asFilename copyTo:(fileName , '.sav')
+ ].
+
+ aStream := FileStream newFileNamed:fileName.
+ aStream isNil ifTrue:[
+ self warn:'cannot create: %1' with:fileName
+ ] ifFalse:[
+ self busyLabel:'writing: %1' with:fileName.
+ self allClassesInCategory:currentClassCategory inOrderDo:[:aClass |
+ aClass isPrivate ifFalse:[
+ (self listOfNamespaces includesIdentical:aClass nameSpace)
+ ifTrue:[
+ self busyLabel:'writing: %1' with:fileName.
+ aClass fileOutOn:aStream.
+ ]
+ ]
+ ].
+ aStream close.
+ ]
].
self normalLabel.
- "Modified: 18.8.1997 / 15:42:26 / cg"
+ "Created: 11.10.1997 / 16:38:29 / cg"
+ "Modified: 11.10.1997 / 16:48:19 / cg"
!
classCategoryFileOutBinaryEach
@@ -858,174 +913,176 @@
|specialMenu m labels selectors shorties|
currentClassCategory notNil ifTrue:[
- labels := #(
- 'fileOut each binary ...'
- '-'
- 'repository history ...'
- 'validate class revisions'
- '-'
- 'checkin each ...'
- ).
- selectors := #(
- classCategoryFileOutBinaryEach
- nil
- classCategoryRepositoryHistory
- classCategoryValidateClassRevisions
- nil
- classCategoryCheckinEach
- ).
+ labels := #(
+ 'fileOut each binary ...'
+ '-'
+ 'repository history ...'
+ 'validate class revisions'
+ '-'
+ 'checkin each ...'
+ ).
+ selectors := #(
+ classCategoryFileOutBinaryEach
+ nil
+ classCategoryRepositoryHistory
+ classCategoryValidateClassRevisions
+ nil
+ classCategoryCheckinEach
+ ).
] ifFalse:[
- labels := #(
- 'repository history ...'
- ).
- selectors := #(
- classCategoryRepositoryHistory
- ).
+ labels := #(
+ 'repository history ...'
+ ).
+ selectors := #(
+ classCategoryRepositoryHistory
+ ).
].
specialMenu := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- receiver:self.
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self.
Smalltalk sourceCodeManager isNil ifTrue:[
- specialMenu disableAll:#(classCategoryRepositoryHistory
- classCategoryCheckinEach
- classCategoryValidateClassRevisions).
+ specialMenu disableAll:#(classCategoryRepositoryHistory
+ classCategoryCheckinEach
+ classCategoryValidateClassRevisions).
].
device ctrlDown ifTrue:[
- ^ specialMenu
+ ^ specialMenu
].
currentClassCategory isNil ifTrue:[
- labels := #(
+ labels := #(
"/ 'namespace ...'
"/ '-'
- 'clone'
- 'open for class ...'
- 'spawn full class'
- '-'
- 'update'
- 'find class ...'
- 'find method ...'
- '-'
- 'new class category ...'
- '='
- 'others'
- ).
- selectors := #(
+ 'clone'
+ 'open for class ...'
+ 'spawn full class'
+ '-'
+ 'update'
+ 'find class ...'
+ 'find method ...'
+ '-'
+ 'new class category ...'
+ '='
+ 'others'
+ ).
+ selectors := #(
"/ namespaceDialog
"/ nil
- classCategoryClone
- classCategoryOpenInClass
- classCategorySpawnFullClass
- nil
- classCategoryUpdate
- classCategoryFindClass
- classCategoryFindMethod
- nil
- classCategoryNewCategory
- nil
- otherMenu
- ).
- shorties := #(
+ classCategoryClone
+ classCategoryOpenInClass
+ classCategorySpawnFullClass
+ nil
+ classCategoryUpdate
+ classCategoryFindClass
+ classCategoryFindMethod
+ nil
+ classCategoryNewCategory
+ nil
+ otherMenu
+ ).
+ shorties := #(
"/ nil
"/ nil
- nil
- nil
- nil
- nil
- nil
- Find
- nil
- nil
- Cmdn
- nil
- #'Ctrl'
- ).
+ nil
+ nil
+ nil
+ nil
+ nil
+ Find
+ nil
+ nil
+ Cmdn
+ nil
+ #'Ctrl'
+ ).
] ifFalse:[
- labels := #(
- 'fileOut'
- 'fileOut each'
- 'printOut'
- 'printOut protocol'
- '-'
+ labels := #(
+ 'fileOut'
+ 'fileOut as ...'
+ 'fileOut each'
+ 'printOut'
+ 'printOut protocol'
+ '-'
"/ 'namespace ...'
"/ '-'
- 'clone'
- 'open for class ...'
- 'SPAWN_CATEGORY'
- 'spawn full class'
- '-'
- 'update'
- 'find class ...'
- 'find method ...'
- '-'
- 'new class category ...'
- 'rename ...'
- 'remove'
- '='
- 'others'
- ).
- selectors := #(
- classCategoryFileOut
- classCategoryFileOutEach
- classCategoryPrintOut
- classCategoryPrintOutProtocol
- nil
+ 'clone'
+ 'open for class ...'
+ 'SPAWN_CATEGORY'
+ 'spawn full class'
+ '-'
+ 'update'
+ 'find class ...'
+ 'find method ...'
+ '-'
+ 'new class category ...'
+ 'rename ...'
+ 'remove'
+ '='
+ 'others'
+ ).
+ selectors := #(
+ classCategoryFileOut
+ classCategoryFileOutAs
+ classCategoryFileOutEach
+ classCategoryPrintOut
+ classCategoryPrintOutProtocol
+ nil
"/ namespaceDialog
"/ nil
- classCategoryClone
- classCategoryOpenInClass
- classCategorySpawn
- classCategorySpawnFullClass
- nil
- classCategoryUpdate
- classCategoryFindClass
- classCategoryFindMethod
- nil
- classCategoryNewCategory
- classCategoryRename
- classCategoryRemove
- nil
- otherMenu
- ).
- shorties := #(
- nil
- nil
- nil
- nil
- nil
+ classCategoryClone
+ classCategoryOpenInClass
+ classCategorySpawn
+ classCategorySpawnFullClass
+ nil
+ classCategoryUpdate
+ classCategoryFindClass
+ classCategoryFindMethod
+ nil
+ classCategoryNewCategory
+ classCategoryRename
+ classCategoryRemove
+ nil
+ otherMenu
+ ).
+ shorties := #(
+ nil
+ nil
+ nil
+ nil
+ nil
"/ nil
"/ nil
- nil
- nil
- nil
- nil
- nil
- nil
- Find
- nil
- nil
- Cmdn
- nil
- nil
- nil
- #'Ctrl'
- ).
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ Find
+ nil
+ nil
+ Cmdn
+ nil
+ nil
+ nil
+ #'Ctrl'
+ ).
].
m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- accelerators:shorties.
+ labels:(resources array:labels)
+ selectors:selectors
+ accelerators:shorties.
m subMenuAt:#otherMenu put:specialMenu.
^ m
"Created: 14.9.1995 / 10:50:17 / claus"
- "Modified: 11.1.1997 / 21:38:33 / cg"
+ "Modified: 11.10.1997 / 16:43:54 / cg"
!
classCategoryNewCategory
@@ -1837,100 +1894,103 @@
it when exploring the system."
self doClassMenu:[:currentClass |
- |m s aStream isComment|
-
- aStream := TextStream on:(String new:200).
-
- "/
- "/ here, show it with a nameSpace pragma
- "/ and prefer short names.
- "/
- currentClass
- basicFileOutDefinitionOn:aStream
- withNameSpace:true.
-
- currentClass isLoaded ifTrue:[
- "
- add documentation as a comment, if there is any
- "
- m := currentClass class compiledMethodAt:#documentation.
- m notNil ifTrue:[
- s := m comment.
- isComment := false.
- ] ifFalse:[
- "try comment"
- s := currentClass comment.
- s notNil ifTrue:[
- s isEmpty ifTrue:[
- s := nil
- ] ifFalse:[
- (s includes:$") ifTrue:[
- s := s copy replaceAll:$" with:$'.
- ].
- isComment := true
- ]
- ]
- ].
- ].
- 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'.
- ] 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 nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
- aStream nextPutLine:' It will not be preserved when accepting a new class definition.'.
- ].
- aStream nextPut:$".
- aStream emphasis:nil.
-
- codeView contents:(aStream contents).
- codeView modified:false.
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
+ |m s aStream isComment|
+
+ aStream := TextStream on:(String new:200).
+
+ "/
+ "/ here, show it with a nameSpace pragma
+ "/ and prefer short names.
+ "/
+ currentClass
+ basicFileOutDefinitionOn:aStream
+ withNameSpace:true.
+
+ currentClass isLoaded ifTrue:[
+ "
+ add documentation as a comment, if there is any
+ "
+ m := currentClass class compiledMethodAt:#documentation.
+ m notNil ifTrue:[
+ s := m comment.
+ isComment := false.
+ ] ifFalse:[
+ "try comment"
+ s := currentClass comment.
+ s isString ifTrue:[
+ s isEmpty ifTrue:[
+ s := nil
+ ] ifFalse:[
+ (s includes:$") ifTrue:[
+ s := s copy replaceAll:$" with:$'.
+ ].
+ isComment := true
+ ]
+ ] ifFalse:[
+ "/ class redefines comment ?
+ s := nil
+ ]
+ ].
+ ].
+ 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'.
+ ] 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 nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
+ aStream nextPutLine:' It will not be preserved when accepting a new class definition.'.
+ ].
+ aStream nextPut:$".
+ aStream emphasis:nil.
+
+ codeView contents:(aStream contents).
+ codeView modified:false.
+ codeView acceptAction:[:theCode |
+ |ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
- codeView cursor:Cursor execute.
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
-
- Class nameSpaceQuerySignal answer:Smalltalk
- do:[
- (Compiler evaluate:theCode asString notifying:codeView compile:false)
- isBehavior ifTrue:[
- codeView modified:false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- ]
- ]
- ].
- ].
- codeView cursor:Cursor normal.
- ].
- codeView explainAction:nil.
-
- methodListView notNil ifTrue:[
- methodListView setSelection:nil
- ].
- aspect := #definition.
- self normalLabel
+ codeView cursor:Cursor execute.
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ Object abortSignal catch:[
+
+ Class nameSpaceQuerySignal answer:Smalltalk
+ do:[
+ (Compiler evaluate:theCode asString notifying:codeView compile:false)
+ isBehavior ifTrue:[
+ codeView modified:false.
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ ]
+ ]
+ ].
+ ].
+ codeView cursor:Cursor normal.
+ ].
+ codeView explainAction:nil.
+
+ methodListView notNil ifTrue:[
+ methodListView setSelection:nil
+ ].
+ aspect := #definition.
+ self normalLabel
]
- "Modified: 1.8.1997 / 11:54:10 / cg"
+ "Modified: 11.10.1997 / 16:25:42 / cg"
!
classDocumentation
@@ -10577,6 +10637,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.341 1997-10-09 12:09:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.342 1997-10-11 15:50:36 cg Exp $'
! !
BrowserView initialize!
--- a/BrwsrView.st Fri Oct 10 19:35:45 1997 +0200
+++ b/BrwsrView.st Sat Oct 11 17:50:36 1997 +0200
@@ -647,54 +647,109 @@
!
classCategoryFileOut
+ "create a file 'categoryName.st' consisting of all classes in current category
+ into the current projects defaultDirectory."
+
+ self classCategoryFileOutAsk:false
+
+ "Modified: 11.10.1997 / 16:47:46 / cg"
+!
+
+classCategoryFileOutAs
+ "create a file consisting of all classes in the current category
+ into a file as user-specified."
+
+ self classCategoryFileOutAsk:true
+
+ "Modified: 11.10.1997 / 16:38:56 / cg"
+ "Created: 11.10.1997 / 16:44:35 / cg"
+!
+
+classCategoryFileOutAsk:doAsk
"create a file 'categoryName' consisting of all classes in current category"
|aStream fileName|
self checkClassCategorySelected ifFalse:[^ self].
(currentClassCategory startsWith:'*') ifTrue:[
- self warn:(resources string:'try a real category').
- ^ self
- ].
-
- fileName := currentClassCategory asString.
+ self warn:(resources string:'try a real category').
+ ^ self
+ ].
+
+ fileName := currentClassCategory asString , '.st'.
fileName replaceAll:Character space with:$_.
- "
- this test allows a smalltalk to be built without Projects/ChangeSets
- "
- Project notNil ifTrue:[
- fileName := Project currentProjectDirectory , fileName.
- ].
self withBusyCursorDo:[
- "
- if file exists, save original in a .sav file
- "
- fileName asFilename exists ifTrue:[
- self busyLabel:'saving existing %1' with:fileName.
- fileName asFilename copyTo:(fileName , '.sav')
- ].
-
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- self warn:'cannot create: %1' with:fileName
- ] ifFalse:[
- self busyLabel:'writing: %1' with:fileName.
- self allClassesInCategory:currentClassCategory inOrderDo:[:aClass |
- aClass isPrivate ifFalse:[
- (self listOfNamespaces includesIdentical:aClass nameSpace)
- ifTrue:[
- self busyLabel:'writing: %1' with:fileName.
- aClass fileOutOn:aStream.
- ]
- ]
- ].
- aStream close.
- ]
+ |saveName fileBox dir|
+
+ doAsk ifTrue:[
+ fileBox := FileSelectionBox
+ title:(resources string:'fileOut %1 as:' with:currentClassCategory)
+ okText:(resources string:'fileOut')
+ abortText:(resources string:'cancel')
+ action:[:fileName | saveName := fileName].
+ fileBox initialText:fileName.
+ dir := FileSelectionBox lastFileSelectionDirectory.
+ dir isNil ifTrue:[
+ "
+ this test allows a smalltalk to be built without Projects/ChangeSets
+ "
+ Project notNil ifTrue:[
+ dir := Project currentProjectDirectory
+ ]
+ ].
+ dir notNil ifTrue:[
+ fileBox directory:dir.
+ ].
+ fileBox showAtPointer.
+ fileBox destroy.
+ saveName isNil ifTrue:[
+ ^ self
+ ].
+ saveName isEmpty ifTrue:[
+ self warn:'bad name given'.
+ ^ self
+ ].
+ FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName).
+ fileName := saveName.
+ ] ifFalse:[
+ "
+ 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:[
+ self busyLabel:'saving existing %1' with:fileName.
+ fileName asFilename copyTo:(fileName , '.sav')
+ ].
+
+ aStream := FileStream newFileNamed:fileName.
+ aStream isNil ifTrue:[
+ self warn:'cannot create: %1' with:fileName
+ ] ifFalse:[
+ self busyLabel:'writing: %1' with:fileName.
+ self allClassesInCategory:currentClassCategory inOrderDo:[:aClass |
+ aClass isPrivate ifFalse:[
+ (self listOfNamespaces includesIdentical:aClass nameSpace)
+ ifTrue:[
+ self busyLabel:'writing: %1' with:fileName.
+ aClass fileOutOn:aStream.
+ ]
+ ]
+ ].
+ aStream close.
+ ]
].
self normalLabel.
- "Modified: 18.8.1997 / 15:42:26 / cg"
+ "Created: 11.10.1997 / 16:38:29 / cg"
+ "Modified: 11.10.1997 / 16:48:19 / cg"
!
classCategoryFileOutBinaryEach
@@ -858,174 +913,176 @@
|specialMenu m labels selectors shorties|
currentClassCategory notNil ifTrue:[
- labels := #(
- 'fileOut each binary ...'
- '-'
- 'repository history ...'
- 'validate class revisions'
- '-'
- 'checkin each ...'
- ).
- selectors := #(
- classCategoryFileOutBinaryEach
- nil
- classCategoryRepositoryHistory
- classCategoryValidateClassRevisions
- nil
- classCategoryCheckinEach
- ).
+ labels := #(
+ 'fileOut each binary ...'
+ '-'
+ 'repository history ...'
+ 'validate class revisions'
+ '-'
+ 'checkin each ...'
+ ).
+ selectors := #(
+ classCategoryFileOutBinaryEach
+ nil
+ classCategoryRepositoryHistory
+ classCategoryValidateClassRevisions
+ nil
+ classCategoryCheckinEach
+ ).
] ifFalse:[
- labels := #(
- 'repository history ...'
- ).
- selectors := #(
- classCategoryRepositoryHistory
- ).
+ labels := #(
+ 'repository history ...'
+ ).
+ selectors := #(
+ classCategoryRepositoryHistory
+ ).
].
specialMenu := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- receiver:self.
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self.
Smalltalk sourceCodeManager isNil ifTrue:[
- specialMenu disableAll:#(classCategoryRepositoryHistory
- classCategoryCheckinEach
- classCategoryValidateClassRevisions).
+ specialMenu disableAll:#(classCategoryRepositoryHistory
+ classCategoryCheckinEach
+ classCategoryValidateClassRevisions).
].
device ctrlDown ifTrue:[
- ^ specialMenu
+ ^ specialMenu
].
currentClassCategory isNil ifTrue:[
- labels := #(
+ labels := #(
"/ 'namespace ...'
"/ '-'
- 'clone'
- 'open for class ...'
- 'spawn full class'
- '-'
- 'update'
- 'find class ...'
- 'find method ...'
- '-'
- 'new class category ...'
- '='
- 'others'
- ).
- selectors := #(
+ 'clone'
+ 'open for class ...'
+ 'spawn full class'
+ '-'
+ 'update'
+ 'find class ...'
+ 'find method ...'
+ '-'
+ 'new class category ...'
+ '='
+ 'others'
+ ).
+ selectors := #(
"/ namespaceDialog
"/ nil
- classCategoryClone
- classCategoryOpenInClass
- classCategorySpawnFullClass
- nil
- classCategoryUpdate
- classCategoryFindClass
- classCategoryFindMethod
- nil
- classCategoryNewCategory
- nil
- otherMenu
- ).
- shorties := #(
+ classCategoryClone
+ classCategoryOpenInClass
+ classCategorySpawnFullClass
+ nil
+ classCategoryUpdate
+ classCategoryFindClass
+ classCategoryFindMethod
+ nil
+ classCategoryNewCategory
+ nil
+ otherMenu
+ ).
+ shorties := #(
"/ nil
"/ nil
- nil
- nil
- nil
- nil
- nil
- Find
- nil
- nil
- Cmdn
- nil
- #'Ctrl'
- ).
+ nil
+ nil
+ nil
+ nil
+ nil
+ Find
+ nil
+ nil
+ Cmdn
+ nil
+ #'Ctrl'
+ ).
] ifFalse:[
- labels := #(
- 'fileOut'
- 'fileOut each'
- 'printOut'
- 'printOut protocol'
- '-'
+ labels := #(
+ 'fileOut'
+ 'fileOut as ...'
+ 'fileOut each'
+ 'printOut'
+ 'printOut protocol'
+ '-'
"/ 'namespace ...'
"/ '-'
- 'clone'
- 'open for class ...'
- 'SPAWN_CATEGORY'
- 'spawn full class'
- '-'
- 'update'
- 'find class ...'
- 'find method ...'
- '-'
- 'new class category ...'
- 'rename ...'
- 'remove'
- '='
- 'others'
- ).
- selectors := #(
- classCategoryFileOut
- classCategoryFileOutEach
- classCategoryPrintOut
- classCategoryPrintOutProtocol
- nil
+ 'clone'
+ 'open for class ...'
+ 'SPAWN_CATEGORY'
+ 'spawn full class'
+ '-'
+ 'update'
+ 'find class ...'
+ 'find method ...'
+ '-'
+ 'new class category ...'
+ 'rename ...'
+ 'remove'
+ '='
+ 'others'
+ ).
+ selectors := #(
+ classCategoryFileOut
+ classCategoryFileOutAs
+ classCategoryFileOutEach
+ classCategoryPrintOut
+ classCategoryPrintOutProtocol
+ nil
"/ namespaceDialog
"/ nil
- classCategoryClone
- classCategoryOpenInClass
- classCategorySpawn
- classCategorySpawnFullClass
- nil
- classCategoryUpdate
- classCategoryFindClass
- classCategoryFindMethod
- nil
- classCategoryNewCategory
- classCategoryRename
- classCategoryRemove
- nil
- otherMenu
- ).
- shorties := #(
- nil
- nil
- nil
- nil
- nil
+ classCategoryClone
+ classCategoryOpenInClass
+ classCategorySpawn
+ classCategorySpawnFullClass
+ nil
+ classCategoryUpdate
+ classCategoryFindClass
+ classCategoryFindMethod
+ nil
+ classCategoryNewCategory
+ classCategoryRename
+ classCategoryRemove
+ nil
+ otherMenu
+ ).
+ shorties := #(
+ nil
+ nil
+ nil
+ nil
+ nil
"/ nil
"/ nil
- nil
- nil
- nil
- nil
- nil
- nil
- Find
- nil
- nil
- Cmdn
- nil
- nil
- nil
- #'Ctrl'
- ).
+ nil
+ nil
+ nil
+ nil
+ nil
+ nil
+ Find
+ nil
+ nil
+ Cmdn
+ nil
+ nil
+ nil
+ #'Ctrl'
+ ).
].
m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- accelerators:shorties.
+ labels:(resources array:labels)
+ selectors:selectors
+ accelerators:shorties.
m subMenuAt:#otherMenu put:specialMenu.
^ m
"Created: 14.9.1995 / 10:50:17 / claus"
- "Modified: 11.1.1997 / 21:38:33 / cg"
+ "Modified: 11.10.1997 / 16:43:54 / cg"
!
classCategoryNewCategory
@@ -1837,100 +1894,103 @@
it when exploring the system."
self doClassMenu:[:currentClass |
- |m s aStream isComment|
-
- aStream := TextStream on:(String new:200).
-
- "/
- "/ here, show it with a nameSpace pragma
- "/ and prefer short names.
- "/
- currentClass
- basicFileOutDefinitionOn:aStream
- withNameSpace:true.
-
- currentClass isLoaded ifTrue:[
- "
- add documentation as a comment, if there is any
- "
- m := currentClass class compiledMethodAt:#documentation.
- m notNil ifTrue:[
- s := m comment.
- isComment := false.
- ] ifFalse:[
- "try comment"
- s := currentClass comment.
- s notNil ifTrue:[
- s isEmpty ifTrue:[
- s := nil
- ] ifFalse:[
- (s includes:$") ifTrue:[
- s := s copy replaceAll:$" with:$'.
- ].
- isComment := true
- ]
- ]
- ].
- ].
- 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'.
- ] 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 nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
- aStream nextPutLine:' It will not be preserved when accepting a new class definition.'.
- ].
- aStream nextPut:$".
- aStream emphasis:nil.
-
- codeView contents:(aStream contents).
- codeView modified:false.
- codeView acceptAction:[:theCode |
- |ns|
-
- currentClass notNil ifTrue:[
- ns := currentClass nameSpace
- ] ifFalse:[
- ns := nil
- ].
+ |m s aStream isComment|
+
+ aStream := TextStream on:(String new:200).
+
+ "/
+ "/ here, show it with a nameSpace pragma
+ "/ and prefer short names.
+ "/
+ currentClass
+ basicFileOutDefinitionOn:aStream
+ withNameSpace:true.
+
+ currentClass isLoaded ifTrue:[
+ "
+ add documentation as a comment, if there is any
+ "
+ m := currentClass class compiledMethodAt:#documentation.
+ m notNil ifTrue:[
+ s := m comment.
+ isComment := false.
+ ] ifFalse:[
+ "try comment"
+ s := currentClass comment.
+ s isString ifTrue:[
+ s isEmpty ifTrue:[
+ s := nil
+ ] ifFalse:[
+ (s includes:$") ifTrue:[
+ s := s copy replaceAll:$" with:$'.
+ ].
+ isComment := true
+ ]
+ ] ifFalse:[
+ "/ class redefines comment ?
+ s := nil
+ ]
+ ].
+ ].
+ 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'.
+ ] 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 nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
+ aStream nextPutLine:' It will not be preserved when accepting a new class definition.'.
+ ].
+ aStream nextPut:$".
+ aStream emphasis:nil.
+
+ codeView contents:(aStream contents).
+ codeView modified:false.
+ codeView acceptAction:[:theCode |
+ |ns|
+
+ currentClass notNil ifTrue:[
+ ns := currentClass nameSpace
+ ] ifFalse:[
+ ns := nil
+ ].
- codeView cursor:Cursor execute.
-
- Class nameSpaceQuerySignal handle:[:ex |
- ns isNil ifTrue:[
- ex reject
- ].
- ex proceedWith:ns
- ] do:[
- Object abortSignal catch:[
-
- Class nameSpaceQuerySignal answer:Smalltalk
- do:[
- (Compiler evaluate:theCode asString notifying:codeView compile:false)
- isBehavior ifTrue:[
- codeView modified:false.
- self classCategoryUpdate.
- self updateClassListWithScroll:false.
- ]
- ]
- ].
- ].
- codeView cursor:Cursor normal.
- ].
- codeView explainAction:nil.
-
- methodListView notNil ifTrue:[
- methodListView setSelection:nil
- ].
- aspect := #definition.
- self normalLabel
+ codeView cursor:Cursor execute.
+
+ Class nameSpaceQuerySignal handle:[:ex |
+ ns isNil ifTrue:[
+ ex reject
+ ].
+ ex proceedWith:ns
+ ] do:[
+ Object abortSignal catch:[
+
+ Class nameSpaceQuerySignal answer:Smalltalk
+ do:[
+ (Compiler evaluate:theCode asString notifying:codeView compile:false)
+ isBehavior ifTrue:[
+ codeView modified:false.
+ self classCategoryUpdate.
+ self updateClassListWithScroll:false.
+ ]
+ ]
+ ].
+ ].
+ codeView cursor:Cursor normal.
+ ].
+ codeView explainAction:nil.
+
+ methodListView notNil ifTrue:[
+ methodListView setSelection:nil
+ ].
+ aspect := #definition.
+ self normalLabel
]
- "Modified: 1.8.1997 / 11:54:10 / cg"
+ "Modified: 11.10.1997 / 16:25:42 / cg"
!
classDocumentation
@@ -10577,6 +10637,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.341 1997-10-09 12:09:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.342 1997-10-11 15:50:36 cg Exp $'
! !
BrowserView initialize!