--- a/CBrowser.st Fri Feb 24 18:00:43 1995 +0100
+++ b/CBrowser.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,7 +10,7 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-nov-1994 at 21:36:13'!
+'From Smalltalk/X, Version:2.10.4 on 26-feb-1995 at 5:18:24 am'!
StandardSystemView subclass:#ChangesBrowser
instanceVariableNames:'changeListView codeView changeFileName changeChunks
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.24 1995-02-19 15:53:48 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.25 1995-02-28 21:54:57 claus Exp $
'!
!ChangesBrowser class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.24 1995-02-19 15:53:48 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/CBrowser.st,v 1.25 1995-02-28 21:54:57 claus Exp $
"
!
@@ -74,12 +74,6 @@
"
! !
-!ChangesBrowser class methodsFor:'defaults'!
-
-defaultLabel
- ^ 'Changes Browser'
-! !
-
!ChangesBrowser class methodsFor:'instance creation'!
new
@@ -104,47 +98,14 @@
^ true
! !
-!ChangesBrowser methodsFor:'menu stuff'!
-
-disableMenuEntries
- "enable all entries refering to a selected change"
+!ChangesBrowser class methodsFor:'defaults'!
- #(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
- doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
- doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
- do:[:sel |
- changeListView middleButtonMenu disable:sel
- ].
-!
-
-enableMenuEntries
- "enable all entries refering to a selected change"
-
- #(doApply doApplyClassRest doApplyRest
- doDelete doDeleteRest doDeleteClassRest
- doDeleteClassAll
- doCompare doMakePatch doSaveChangeInFile doMakePermanent
- doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
- do:[:sel |
- changeListView middleButtonMenu enable:sel
- ].
+defaultLabel
+ ^ 'Changes Browser'
! !
!ChangesBrowser methodsFor:'private'!
-clearCodeView
- self unselect "changeListView deselect".
- codeView contents:nil.
- changeNrShown := nil
-!
-
-unselect
- "common unselect"
-
- changeListView deselect.
- self disableMenuEntries
-!
-
streamForChange:changeNr
"answer a stream for change"
@@ -157,6 +118,26 @@
^ aStream
!
+autoSelect:changeNr
+ "select a change"
+
+ self class autoSelectNext ifTrue:[
+ (changeNr <= changePositions size) ifTrue:[
+ changeListView selection:changeNr.
+ self changeSelection:changeNr.
+ ^ self
+ ]
+ ].
+ self clearCodeView.
+ changeListView selection:nil.
+!
+
+clearCodeView
+ self unselect "changeListView deselect".
+ codeView contents:nil.
+ changeNrShown := nil
+!
+
applyChange:changeNr
"fileIn a change"
@@ -198,23 +179,18 @@
].
!
+unselect
+ "common unselect"
+
+ changeListView deselect.
+!
+
setChangeList
"extract type-information from changes and stuff into top selection
view"
changeListView setList:changeHeaderLines expandTabs:false.
"/ changeListView deselect.
- self disableMenuEntries
-!
-
-silentDeleteChange:changeNr
- "delete a change do not update changeListView"
-
- anyChanges := true.
- changeChunks removeIndex:changeNr.
- changePositions removeIndex:changeNr.
- changeClassNames removeIndex:changeNr.
- changeHeaderLines removeIndex:changeNr
!
readChangesFileInBackground:inBackground
@@ -277,6 +253,8 @@
"
aStream skipSeparators.
chunkPos := aStream position.
+
+
sawExcla := aStream peekFor:excla.
chunkText := aStream nextChunk.
chunkText notNil ifTrue:[
@@ -316,7 +294,11 @@
"
first, assume doIt - then lets have a more detailed look ...
"
- changeType := '(doIt)'.
+ (chunkText startsWith:'''---- file') ifTrue:[
+ changeType := ''.
+ ] ifFalse:[
+ changeType := '(doIt)'.
+ ].
changeString := (chunkText contractTo:maxLen).
p := Parser parseExpression:chunkText.
@@ -360,7 +342,17 @@
changeType := '(category change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
]
- ]
+ ].
+ (#(#'subclass:'
+ #'variableSubclass:'
+ #'variableByteSubclass:'
+ #'variableWordSubclass:'
+ #'variableLongSubclass:'
+ #'variableFloatSubclass:'
+ #'variableDoubleSubclass:'
+ ) includes:sel) ifTrue:[
+ changeType := '(class definition)'.
+ ].
].
] ifTrue:[
|done first p sel cls text|
@@ -484,39 +476,14 @@
^ s
!
-autoSelect:changeNr
- "select a change"
-
- self class autoSelectNext ifTrue:[
- (changeNr <= changePositions size) ifTrue:[
- changeListView selection:changeNr.
- self changeSelection:changeNr.
- ^ self
- ]
- ].
- self clearCodeView.
- changeListView selection:nil.
- self disableMenuEntries
-!
+silentDeleteChange:changeNr
+ "delete a change do not update changeListView"
-autoSelectOrEnd:changeNr
- "select the next change or the last"
-
- |last|
-
- last := changePositions size.
- changeNr < last ifTrue:[
- self autoSelect:changeNr
- ] ifFalse:[
- changeListView selection:last .
- self changeSelection:last.
- ]
-!
-
-autoSelectLast
- "select the last change"
-
- self autoSelect:(changePositions size)
+ anyChanges := true.
+ changeChunks removeIndex:changeNr.
+ changePositions removeIndex:changeNr.
+ changeClassNames removeIndex:changeNr.
+ changeHeaderLines removeIndex:changeNr
!
classNameOfChange:changeNr
@@ -591,7 +558,8 @@
"
is it a change in a class-description ?
"
- ('subclass:*' match:sel) ifTrue:[
+ (('subclass:*' match:sel)
+ or:[('variable*subclass:*' match:sel)]) ifTrue:[
arg1Tree := aParseTree arg1.
(arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
name := arg1Tree value asString.
@@ -643,6 +611,112 @@
^ nil
!
+autoSelectOrEnd:changeNr
+ "select the next change or the last"
+
+ |last|
+
+ last := changePositions size.
+ changeNr < last ifTrue:[
+ self autoSelect:changeNr
+ ] ifFalse:[
+ changeListView selection:last .
+ self changeSelection:last.
+ ]
+!
+
+withSelectedChangeDo:aBlock
+ "just a helper, check for a selected change and evaluate aBlock
+ with busy cursor"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ aBlock value:changeNr
+ ]
+ ]
+!
+
+autoSelectLast
+ "select the last change"
+
+ self autoSelect:(changePositions size)
+!
+
+compareChange:changeNr
+ "compare a change with current version"
+
+ |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
+ parser sel oldMethod outcome showDiff d t1 t2|
+
+ aStream := self streamForChange:changeNr.
+ aStream isNil ifTrue:[^ self].
+
+ sawExcla := aStream peekFor:(aStream class chunkSeparator).
+ chunk := aStream nextChunk.
+ sawExcla ifFalse:[
+ outcome := 'not comparable ...'
+ ] ifTrue:[
+ parseTree := Parser parseExpression:chunk.
+ (parseTree notNil and:[parseTree isMessage]) ifTrue:[
+ (parseTree selector == #methodsFor:) ifTrue:[
+ thisClass := (parseTree receiver evaluate).
+ thisClass isBehavior ifTrue:[
+ showDiff := false.
+
+ cat := parseTree arg1 evaluate.
+ newSource := aStream nextChunk.
+ parser := Parser parseMethod:newSource in:thisClass.
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ sel := parser selector.
+ oldMethod := thisClass compiledMethodAt:sel.
+ oldMethod notNil ifTrue:[
+ (oldMethod category = cat) ifFalse:[
+ Transcript showCr:'category changed.'.
+ ].
+ oldSource := oldMethod source.
+ (oldSource = newSource) ifTrue:[
+ outcome := 'same source'
+ ] ifFalse:[
+ "/
+ "/ compare for tabulator <-> space changes
+ "/ before showing diff ...
+ "/
+ t1 := oldSource asString withTabsExpanded.
+ t2 := newSource asString withTabsExpanded.
+ t1 = t2 ifTrue:[
+ outcome := 'same source (tabs <-> spaces)'
+ ] ifFalse:[
+ outcome := 'source changed.'.
+ showDiff := true
+ ]
+ ]
+ ] ifFalse:[
+ outcome := 'method does not exist.'
+ ]
+ ] ifFalse:[
+ outcome := 'change unparsable.'
+ ].
+ (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
+ d := DiffTextView openOn:oldSource and:newSource.
+ d label:'differences (current left; change right)'.
+ ]
+ ] ifFalse:[
+ outcome := 'class does not exist.'
+ ]
+ ] ifFalse:[
+ outcome := 'not comparable.'
+ ]
+ ] ifFalse:[
+ outcome := 'not comparable.'
+ ]
+ ].
+ Transcript showCr:outcome.
+ aStream close.
+!
+
writeBackChanges
"write back the changes file"
@@ -710,73 +784,6 @@
!
-queryCloseText
- "made this a method for easy redefinition in subclasses"
-
- ^ 'Quit without updating changeFile ?'
-!
-
-compareChange:changeNr
- "compare a change with current version"
-
- |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
- parser sel oldMethod outcome showDiff d|
-
- aStream := self streamForChange:changeNr.
- aStream isNil ifTrue:[^ self].
-
- sawExcla := aStream peekFor:(aStream class chunkSeparator).
- chunk := aStream nextChunk.
- sawExcla ifFalse:[
- outcome := 'not comparable ...'
- ] ifTrue:[
- parseTree := Parser parseExpression:chunk.
- (parseTree notNil and:[parseTree isMessage]) ifTrue:[
- (parseTree selector == #methodsFor:) ifTrue:[
- thisClass := (parseTree receiver evaluate).
- thisClass isBehavior ifTrue:[
- showDiff := false.
- cat := parseTree arg1 evaluate.
- newSource := aStream nextChunk.
- parser := Parser parseMethod:newSource in:thisClass.
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- sel := parser selector.
- oldMethod := thisClass compiledMethodAt:sel.
- oldMethod notNil ifTrue:[
- (oldMethod category = cat) ifFalse:[
- Transcript showCr:'category changed.'.
- ].
- oldSource := oldMethod source.
- (oldSource = newSource) ifTrue:[
- outcome := 'same source'
- ] ifFalse:[
- outcome := 'source changed.'.
- showDiff := true
- ]
- ] ifFalse:[
- outcome := 'method does not exist.'
- ]
- ] ifFalse:[
- outcome := 'change unparsable.'
- ].
- (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
- d := DiffTextView openOn:oldSource and:newSource.
- d label:'differences (current left; change right)'.
- ]
- ] ifFalse:[
- outcome := 'class does not exist.'
- ]
- ] ifFalse:[
- outcome := 'not comparable.'
- ]
- ] ifFalse:[
- outcome := 'not comparable.'
- ]
- ].
- Transcript showCr:outcome.
- aStream close.
-!
-
deleteChangesFrom:start to:stop
"delete a range of changes"
@@ -788,6 +795,12 @@
!
+queryCloseText
+ "made this a method for easy redefinition in subclasses"
+
+ ^ 'Quit without updating changeFile ?'
+!
+
changeFileName:aFileName
changeFileName := aFileName
!
@@ -873,149 +886,18 @@
! !
-!ChangesBrowser methodsFor:'initialize / release'!
-
-initialize
- |frame v|
-
- super initialize.
-
- changeFileName := 'changes'.
-
- frame := VariableVerticalPanel origin:(0.0 @ 0.0)
- corner:(1.0 @ 1.0)
- borderWidth:0
- in:self.
-
- v := ScrollableView for:SelectionInListView in:frame.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
- changeListView := v scrolledView.
- changeListView delegate:self.
-
- v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame.
- v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
- codeView := v scrolledView.
- codeView readOnly.
-
- anyChanges := false.
- ObjectMemory addDependent:self. "to get shutdown-update"
-!
+!ChangesBrowser methodsFor:'user interaction'!
-initializeMiddleButtonMenu
- |labels|
-
- labels := resources array:#(
- 'apply change'
- 'apply changes to end'
- 'apply changes for this class to end'
- 'apply all changes'
- '-'
- 'delete'
- 'delete to end'
- 'delete changes for this class to end'
- 'delete all changes for this class'
- '-'
- 'update'
- 'compress'
- 'compare with current version'
- 'browse class'
- '-'
- 'make change a patch'
-"/ 'update sourcefile from change'
-"/ '-'
- 'save change in file ...'
- 'save changes to end in file ...'
- 'save changes for this class to end in file ...'
- 'save all changes for this class in file ...'
- '-'
- 'writeback changeFile').
+doApply
+ "user wants a change to be applied"
- changeListView
- middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(
- doApply
- doApplyRest
- doApplyClassRest
- doApplyAll
- nil
- doDelete
- doDeleteRest
- doDeleteClassRest
- doDeleteClassAll
- nil
- doUpdate
- doCompress
- doCompare
- doBrowse
- nil
- doMakePatch
-"/ doMakePermanent
-"/ nil
- doSave
- doSaveRest
- doSaveClassRest
- doSaveClassAll
- nil
- doWriteBack)
- receiver:self
- for:changeListView)
-!
-
-realize
- super realize.
- self readChangesFileInBackground:true.
- self setChangeList.
- changeListView action:[:lineNr | self changeSelection:lineNr].
- self disableMenuEntries.
-!
-
-focusSequence
- ^ Array with:changeListView with:codeView
+ self withSelectedChangeDo:[:changeNr |
+ skipSignal := nil.
+ self applyChange:changeNr.
+ self autoSelect:(changeNr + 1)
+ ]
!
-update:what
- |box|
-
- (what == #aboutToExit) ifTrue:[
- "
- smalltalk is about to shut down -
- - if change list was modified, ask user and save if requested.
- "
- anyChanges ifTrue:[
- shown ifFalse:[
- self unrealize.
- self realize
- ].
- self raise.
-
- box := YesNoBox new.
- box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs.
- box noText:(resources at:'don''t update').
- box okText:(resources at:'update').
- box yesAction:[self writeBackChanges]
- noAction:[].
- box showAtPointer
- ].
- ^ self
- ].
- super update:what
-! !
-
-!ChangesBrowser methodsFor:'event handling '!
-
-keyPress:key x:x y:y view:view
- "this method is reached via delegation from the changeListView"
-
- key == #Delete ifTrue:[
- self doDelete.
- ^ self
- ].
- changeListView keyPress:key x:x y:y
-! !
-
-!ChangesBrowser methodsFor:'user interaction'!
-
changeSelection:lineNr
"show a change in the codeView"
@@ -1032,22 +914,7 @@
codeView contents:chunk.
codeView acceptAction:[:theCode | self doApply "noChangesAllowed"].
changeNrShown := lineNr.
- self enableMenuEntries
-!
-doApply
- "user wants a change to be applied"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- skipSignal := nil.
- self applyChange:changeNr.
- self autoSelect:(changeNr + 1)
- ]
- ]
!
noChangesAllowed
@@ -1095,35 +962,61 @@
]
!
+doCompare
+ "compare change with current system version
+ - give a note in transcript"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ self compareChange:changeNr
+ ]
+ ]
+!
+
saveClass:aClassName from:startNr
"user wants changes from current to end to be appended to a file"
- |changeNr fileBox|
+ |changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- |thisClassName|
+ fileName := DialogView
+ requestFileName:'append changes for class to:'
+ default:''
+ ok:'append'
+ abort:'abort'
+ pattern:'*.chg'.
+
+ fileName notNil ifTrue:[
+ self withCursor:(Cursor write) do:[
+ startNr to:(changePositions size) do:[:changeNr |
+ |thisClassName|
- self withCursor:(Cursor write) do:[
- startNr to:(changePositions size) do:[:changeNr |
- thisClassName := self classNameOfChange:changeNr.
- thisClassName = aClassName ifTrue:[
- changeListView selection:changeNr.
- (self appendChange:changeNr toFile:fileName) ifFalse:[
- ^ self
- ]
- ]
- ]
- ]
- ].
+ thisClassName := self classNameOfChange:changeNr.
+ thisClassName = aClassName ifTrue:[
+ changeListView selection:changeNr.
+ (self appendChange:changeNr toFile:fileName) ifFalse:[
+ ^ self
+ ]
+ ]
+ ]
+ ]
+ ].
+ ]
+!
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
+doDelete
+ "delete currently selected change"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self deleteChange:changeNr.
+ self autoSelectOrEnd:changeNr
]
!
@@ -1144,62 +1037,50 @@
doSaveRest
"user wants changes from current to end to be appended to a file"
- |changeNr fileBox|
+ |changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- self withCursor:(Cursor write) do:[
- changeNr to:(changePositions size) do:[:changeNr |
- changeListView selection:changeNr.
- (self appendChange:changeNr toFile:fileName) ifFalse:[
- ^ self
- ]
- ]
- ]
- ].
+ fileName := DialogView
+ requestFileName:'append changes to:'
+ default:''
+ ok:'append'
+ abort:'abort'
+ pattern:'*.chg'.
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
- ]
-!
-
-doDelete
- "delete currently selected change"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self deleteChange:changeNr.
- self autoSelectOrEnd:changeNr
+ fileName notNil ifTrue:[
+ self withCursor:(Cursor write) do:[
+ changeNr to:(changePositions size) do:[:changeNr |
+ changeListView selection:changeNr.
+ (self appendChange:changeNr toFile:fileName) ifFalse:[
+ ^ self
+ ]
+ ]
+ ]
+ ].
]
!
doSave
"user wants a change to be appended to a file"
- |changeNr fileBox|
+ |changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- self withCursor:(Cursor write) do:[
- self appendChange:changeNr toFile:fileName.
- ].
- self autoSelect:(changeNr + 1)
- ].
+ fileName := DialogView
+ requestFileName:'append change to:'
+ default:''
+ ok:'append'
+ abort:'abort'
+ pattern:'*.chg'.
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
+ fileName notNil ifTrue:[
+ self withCursor:(Cursor write) do:[
+ self appendChange:changeNr toFile:fileName.
+ ].
+ self autoSelect:(changeNr + 1)
+ ].
]
!
@@ -1209,8 +1090,8 @@
self readChangesFileInBackground:true.
realized ifTrue:[
self setChangeList.
- changeListView hasSelection ifTrue:[self enableMenuEntries]
]
+
!
doMakePermanent
@@ -1247,25 +1128,6 @@
]
!
-doApplyRest
- "user wants all changes from changeNr to be applied"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- self clearCodeView.
- skipSignal isNil ifTrue:[skipSignal := Signal new].
- changeNr to:(changePositions size) do:[:changeNr |
- changeListView selection:changeNr.
- self applyChange:changeNr
- ].
- self autoSelect:changePositions size.
- ]
- ]
-!
-
doDeleteRest
"delete all changes from current to the end"
@@ -1422,6 +1284,20 @@
]
!
+doApplyRest
+ "user wants all changes from changeNr to be applied"
+
+ self withSelectedChangeDo:[:changeNr |
+ self clearCodeView.
+ skipSignal isNil ifTrue:[skipSignal := Signal new].
+ changeNr to:(changePositions size) do:[:changeNr |
+ changeListView selection:changeNr.
+ self applyChange:changeNr
+ ].
+ self autoSelect:changePositions size.
+ ]
+!
+
doApplyAll
"user wants all changes to be applied"
@@ -1436,43 +1312,6 @@
]
!
-doCompare
- "compare change with current system version
- - give a note in transcript"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- self compareChange:changeNr
- ]
- ]
-!
-
-doDeleteClassRest
- "delete rest of changes with same class as currently selected change"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- | classNameToDelete |
-
- classNameToDelete := self classNameOfChange:changeNr.
- classNameToDelete notNil ifTrue:[
- changeListView selection:nil.
- self silentDeleteChangesFor:classNameToDelete
- from:changeNr
- to:(changePositions size).
- self setChangeList.
- self autoSelectOrEnd:changeNr
- ]
- ]
- ]
-!
-
doWriteBack
"write back the list onto the changes file"
@@ -1487,25 +1326,38 @@
]
!
+doDeleteClassRest
+ "delete rest of changes with same class as currently selected change"
+
+ self withSelectedChangeDo:[:changeNr |
+ | classNameToDelete |
+
+ classNameToDelete := self classNameOfChange:changeNr.
+ classNameToDelete notNil ifTrue:[
+ changeListView selection:nil.
+ self silentDeleteChangesFor:classNameToDelete
+ from:changeNr
+ to:(changePositions size).
+ self setChangeList.
+ self autoSelectOrEnd:changeNr
+ ]
+ ]
+!
+
doDeleteClassAll
"delete all changes with same class as currently selected change"
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- | classNameToDelete |
+ self withSelectedChangeDo:[:changeNr |
+ | classNameToDelete |
- classNameToDelete := self classNameOfChange:changeNr.
- classNameToDelete notNil ifTrue:[
- changeListView selection:nil.
- self silentDeleteChangesFor:classNameToDelete
- from:1
- to:(changePositions size).
- self setChangeList.
- self autoSelectOrEnd:changeNr
- ]
+ classNameToDelete := self classNameOfChange:changeNr.
+ classNameToDelete notNil ifTrue:[
+ changeListView selection:nil.
+ self silentDeleteChangesFor:classNameToDelete
+ from:1
+ to:(changePositions size).
+ self setChangeList.
+ self autoSelectOrEnd:changeNr
]
]
!
@@ -1513,50 +1365,200 @@
doApplyClassRest
"user wants all changes for this class from changeNr to be applied"
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- |thisClassName classNameToApply lastChange|
+ self withSelectedChangeDo:[:changeNr |
+ |thisClassName classNameToApply lastChange|
- classNameToApply := self classNameOfChange:changeNr.
- classNameToApply notNil ifTrue:[
- self clearCodeView.
- skipSignal isNil ifTrue:[skipSignal := Signal new].
- changeNr to:(changePositions size) do:[:changeNr |
- thisClassName := self classNameOfChange:changeNr.
- thisClassName = classNameToApply ifTrue:[
- changeListView selection:changeNr.
- self applyChange:changeNr.
- lastChange := changeNr
- ].
+ classNameToApply := self classNameOfChange:changeNr.
+ classNameToApply notNil ifTrue:[
+ self clearCodeView.
+ skipSignal isNil ifTrue:[skipSignal := Signal new].
+ changeNr to:(changePositions size) do:[:changeNr |
+ thisClassName := self classNameOfChange:changeNr.
+ thisClassName = classNameToApply ifTrue:[
+ changeListView selection:changeNr.
+ self applyChange:changeNr.
+ lastChange := changeNr
].
- self autoSelect:lastChange.
- ]
+ ].
+ self autoSelect:lastChange.
]
]
! !
+!ChangesBrowser methodsFor:'initialize / release'!
+
+initialize
+ |frame v|
+
+ super initialize.
+
+ changeFileName := 'changes'.
+
+ frame := VariableVerticalPanel origin:(0.0 @ 0.0)
+ corner:(1.0 @ 1.0)
+ borderWidth:0
+ in:self.
+
+ v := ScrollableView for:SelectionInListView in:frame.
+ v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
+ changeListView := v scrolledView.
+ changeListView delegate:self.
+ changeListView model:self; menu:#changeListMenu.
+
+ v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame.
+ v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
+ codeView := v scrolledView.
+ codeView readOnly.
+
+ anyChanges := false.
+ ObjectMemory addDependent:self. "to get shutdown-update"
+!
+
+focusSequence
+ ^ Array with:changeListView with:codeView
+!
+
+realize
+ super realize.
+ self readChangesFileInBackground:true.
+ self setChangeList.
+ changeListView action:[:lineNr | self changeSelection:lineNr].
+
+!
+
+update:what
+ |box|
+
+ (what == #aboutToExit) ifTrue:[
+ "
+ smalltalk is about to shut down -
+ - if change list was modified, ask user and save if requested.
+ "
+ anyChanges ifTrue:[
+ shown ifFalse:[
+ self unrealize.
+ self realize
+ ].
+ self raise.
+
+ box := YesNoBox new.
+ box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs.
+ box noText:(resources at:'don''t update').
+ box okText:(resources at:'update').
+ box yesAction:[self writeBackChanges]
+ noAction:[].
+ box showAtPointer
+ ].
+ ^ self
+ ].
+ super update:what
+!
+
+changeListMenu
+ |labels selectors m|
+
+ labels := #(
+ 'apply change'
+ 'apply changes to end'
+ 'apply changes for this class to end'
+ 'apply all changes'
+ '-'
+ 'delete'
+ 'delete to end'
+ 'delete changes for this class to end'
+ 'delete all changes for this class'
+ '-'
+ 'update'
+ 'compress'
+ 'compare with current version'
+ 'browse class'
+ '-'
+ 'make change a patch'
+"/ 'update sourcefile from change'
+"/ '-'
+ 'save change in file ...'
+ 'save changes to end in file ...'
+ 'save changes for this class to end in file ...'
+ 'save all changes for this class in file ...'
+ '-'
+ 'writeback changeFile').
+
+ selectors := #(
+ doApply
+ doApplyRest
+ doApplyClassRest
+ doApplyAll
+ nil
+ doDelete
+ doDeleteRest
+ doDeleteClassRest
+ doDeleteClassAll
+ nil
+ doUpdate
+ doCompress
+ doCompare
+ doBrowse
+ nil
+ doMakePatch
+"/ doMakePermanent
+"/ nil
+ doSave
+ doSaveRest
+ doSaveClassRest
+ doSaveClassAll
+ nil
+ doWriteBack
+ ).
+
+ m := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors.
+
+ changeListView hasSelection ifFalse:[
+ #(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
+ doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
+ doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
+ do:[:sel |
+ m disable:sel
+ ].
+ ].
+ ^ m
+
+
+! !
+
+!ChangesBrowser methodsFor:'event handling '!
+
+keyPress:key x:x y:y view:view
+ "this method is reached via delegation from the changeListView"
+
+ key == #Delete ifTrue:[
+ self doDelete.
+ ^ self
+ ].
+ changeListView keyPress:key x:x y:y
+! !
+
!ChangesBrowser methodsFor:'termination'!
terminate
"window manager wants us to go away"
- |box|
+ |box action|
anyChanges ifTrue:[
- box := OptionBox title:'' numberOfOptions:3.
- box title:(resources at:'close ChangesBrowser.\\changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs.
- box buttonTitles:(resources array:#('abort' 'don''t update' 'update')).
- box actions:(Array with:[^ self]
- with:[self destroy]
- with:[self writeBackChanges. self destroy]
- ).
- box showAtPointer.
- ] ifFalse:[
- self destroy
- ]
+ action := OptionBox
+ request:(resources at:'changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs
+ label:'ChangesBrowser'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('abort' 'don''t update' 'update')
+ values:#(#abort #ignore #save).
+ action == #abort ifTrue:[^ self].
+ action == #save ifTrue:[
+ self writeBackChanges
+ ].
+ ].
+ self destroy
!
destroy
@@ -1585,38 +1587,7 @@
Show the bad change in the codeView and let codeView hilight the error;
no corrections allowed here therefore return false"
- |action|
-
- (changeNrProcessed ~~ changeNrShown) ifTrue:[
- self changeSelection:changeNrProcessed
- ].
- (skipSignal notNil) ifTrue:[
-
- codeView highlightingErrorPosition:relPos to:relEndPos do:[
- |box|
-
- "
- start dialog - make certain cleanup is done
- "
- box := OptionBox title:aString numberOfOptions:3.
- box buttonTitles:#('abort' 'skip' 'continue').
- box actions:(Array with:[action := #abort]
- with:[action := #skip]
- with:[action := #continue]).
- box showAtPointer
- ].
-
- action == #abort ifTrue:[
- Object abortSignal raise.
- ^ false
- ].
- action == #skip ifTrue:[
- skipSignal raise.
- ^ false
- ].
- ^ false
- ].
- codeView error:aString position:relPos to:relEndPos.
+ self error:aString position:relPos to:relEndPos.
^ false
!
@@ -1644,12 +1615,12 @@
"
start dialog - make certain cleanup is done
"
- box := OptionBox title:aString numberOfOptions:3.
- box buttonTitles:#('abort' 'skip' 'continue').
- box actions:(Array with:[action := #abort]
- with:[action := #skip]
- with:[action := #continue]).
- box showAtPointer
+ action := OptionBox
+ request:aString
+ label:'Error'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('abort' 'skip' 'continue')
+ values:#(#abort #skip #continue).
].
action == #abort ifTrue:[
@@ -1664,4 +1635,3 @@
].
^ codeView error:aString position:relPos to:relEndPos
! !
-
--- a/ChangesBrowser.st Fri Feb 24 18:00:43 1995 +0100
+++ b/ChangesBrowser.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,7 +10,7 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.4 on 6-nov-1994 at 21:36:13'!
+'From Smalltalk/X, Version:2.10.4 on 26-feb-1995 at 5:18:24 am'!
StandardSystemView subclass:#ChangesBrowser
instanceVariableNames:'changeListView codeView changeFileName changeChunks
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.24 1995-02-19 15:53:48 claus Exp $
+$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.25 1995-02-28 21:54:57 claus Exp $
'!
!ChangesBrowser class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.24 1995-02-19 15:53:48 claus Exp $
+$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.25 1995-02-28 21:54:57 claus Exp $
"
!
@@ -74,12 +74,6 @@
"
! !
-!ChangesBrowser class methodsFor:'defaults'!
-
-defaultLabel
- ^ 'Changes Browser'
-! !
-
!ChangesBrowser class methodsFor:'instance creation'!
new
@@ -104,47 +98,14 @@
^ true
! !
-!ChangesBrowser methodsFor:'menu stuff'!
-
-disableMenuEntries
- "enable all entries refering to a selected change"
+!ChangesBrowser class methodsFor:'defaults'!
- #(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
- doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
- doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
- do:[:sel |
- changeListView middleButtonMenu disable:sel
- ].
-!
-
-enableMenuEntries
- "enable all entries refering to a selected change"
-
- #(doApply doApplyClassRest doApplyRest
- doDelete doDeleteRest doDeleteClassRest
- doDeleteClassAll
- doCompare doMakePatch doSaveChangeInFile doMakePermanent
- doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
- do:[:sel |
- changeListView middleButtonMenu enable:sel
- ].
+defaultLabel
+ ^ 'Changes Browser'
! !
!ChangesBrowser methodsFor:'private'!
-clearCodeView
- self unselect "changeListView deselect".
- codeView contents:nil.
- changeNrShown := nil
-!
-
-unselect
- "common unselect"
-
- changeListView deselect.
- self disableMenuEntries
-!
-
streamForChange:changeNr
"answer a stream for change"
@@ -157,6 +118,26 @@
^ aStream
!
+autoSelect:changeNr
+ "select a change"
+
+ self class autoSelectNext ifTrue:[
+ (changeNr <= changePositions size) ifTrue:[
+ changeListView selection:changeNr.
+ self changeSelection:changeNr.
+ ^ self
+ ]
+ ].
+ self clearCodeView.
+ changeListView selection:nil.
+!
+
+clearCodeView
+ self unselect "changeListView deselect".
+ codeView contents:nil.
+ changeNrShown := nil
+!
+
applyChange:changeNr
"fileIn a change"
@@ -198,23 +179,18 @@
].
!
+unselect
+ "common unselect"
+
+ changeListView deselect.
+!
+
setChangeList
"extract type-information from changes and stuff into top selection
view"
changeListView setList:changeHeaderLines expandTabs:false.
"/ changeListView deselect.
- self disableMenuEntries
-!
-
-silentDeleteChange:changeNr
- "delete a change do not update changeListView"
-
- anyChanges := true.
- changeChunks removeIndex:changeNr.
- changePositions removeIndex:changeNr.
- changeClassNames removeIndex:changeNr.
- changeHeaderLines removeIndex:changeNr
!
readChangesFileInBackground:inBackground
@@ -277,6 +253,8 @@
"
aStream skipSeparators.
chunkPos := aStream position.
+
+
sawExcla := aStream peekFor:excla.
chunkText := aStream nextChunk.
chunkText notNil ifTrue:[
@@ -316,7 +294,11 @@
"
first, assume doIt - then lets have a more detailed look ...
"
- changeType := '(doIt)'.
+ (chunkText startsWith:'''---- file') ifTrue:[
+ changeType := ''.
+ ] ifFalse:[
+ changeType := '(doIt)'.
+ ].
changeString := (chunkText contractTo:maxLen).
p := Parser parseExpression:chunkText.
@@ -360,7 +342,17 @@
changeType := '(category change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
]
- ]
+ ].
+ (#(#'subclass:'
+ #'variableSubclass:'
+ #'variableByteSubclass:'
+ #'variableWordSubclass:'
+ #'variableLongSubclass:'
+ #'variableFloatSubclass:'
+ #'variableDoubleSubclass:'
+ ) includes:sel) ifTrue:[
+ changeType := '(class definition)'.
+ ].
].
] ifTrue:[
|done first p sel cls text|
@@ -484,39 +476,14 @@
^ s
!
-autoSelect:changeNr
- "select a change"
-
- self class autoSelectNext ifTrue:[
- (changeNr <= changePositions size) ifTrue:[
- changeListView selection:changeNr.
- self changeSelection:changeNr.
- ^ self
- ]
- ].
- self clearCodeView.
- changeListView selection:nil.
- self disableMenuEntries
-!
+silentDeleteChange:changeNr
+ "delete a change do not update changeListView"
-autoSelectOrEnd:changeNr
- "select the next change or the last"
-
- |last|
-
- last := changePositions size.
- changeNr < last ifTrue:[
- self autoSelect:changeNr
- ] ifFalse:[
- changeListView selection:last .
- self changeSelection:last.
- ]
-!
-
-autoSelectLast
- "select the last change"
-
- self autoSelect:(changePositions size)
+ anyChanges := true.
+ changeChunks removeIndex:changeNr.
+ changePositions removeIndex:changeNr.
+ changeClassNames removeIndex:changeNr.
+ changeHeaderLines removeIndex:changeNr
!
classNameOfChange:changeNr
@@ -591,7 +558,8 @@
"
is it a change in a class-description ?
"
- ('subclass:*' match:sel) ifTrue:[
+ (('subclass:*' match:sel)
+ or:[('variable*subclass:*' match:sel)]) ifTrue:[
arg1Tree := aParseTree arg1.
(arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
name := arg1Tree value asString.
@@ -643,6 +611,112 @@
^ nil
!
+autoSelectOrEnd:changeNr
+ "select the next change or the last"
+
+ |last|
+
+ last := changePositions size.
+ changeNr < last ifTrue:[
+ self autoSelect:changeNr
+ ] ifFalse:[
+ changeListView selection:last .
+ self changeSelection:last.
+ ]
+!
+
+withSelectedChangeDo:aBlock
+ "just a helper, check for a selected change and evaluate aBlock
+ with busy cursor"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ aBlock value:changeNr
+ ]
+ ]
+!
+
+autoSelectLast
+ "select the last change"
+
+ self autoSelect:(changePositions size)
+!
+
+compareChange:changeNr
+ "compare a change with current version"
+
+ |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
+ parser sel oldMethod outcome showDiff d t1 t2|
+
+ aStream := self streamForChange:changeNr.
+ aStream isNil ifTrue:[^ self].
+
+ sawExcla := aStream peekFor:(aStream class chunkSeparator).
+ chunk := aStream nextChunk.
+ sawExcla ifFalse:[
+ outcome := 'not comparable ...'
+ ] ifTrue:[
+ parseTree := Parser parseExpression:chunk.
+ (parseTree notNil and:[parseTree isMessage]) ifTrue:[
+ (parseTree selector == #methodsFor:) ifTrue:[
+ thisClass := (parseTree receiver evaluate).
+ thisClass isBehavior ifTrue:[
+ showDiff := false.
+
+ cat := parseTree arg1 evaluate.
+ newSource := aStream nextChunk.
+ parser := Parser parseMethod:newSource in:thisClass.
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ sel := parser selector.
+ oldMethod := thisClass compiledMethodAt:sel.
+ oldMethod notNil ifTrue:[
+ (oldMethod category = cat) ifFalse:[
+ Transcript showCr:'category changed.'.
+ ].
+ oldSource := oldMethod source.
+ (oldSource = newSource) ifTrue:[
+ outcome := 'same source'
+ ] ifFalse:[
+ "/
+ "/ compare for tabulator <-> space changes
+ "/ before showing diff ...
+ "/
+ t1 := oldSource asString withTabsExpanded.
+ t2 := newSource asString withTabsExpanded.
+ t1 = t2 ifTrue:[
+ outcome := 'same source (tabs <-> spaces)'
+ ] ifFalse:[
+ outcome := 'source changed.'.
+ showDiff := true
+ ]
+ ]
+ ] ifFalse:[
+ outcome := 'method does not exist.'
+ ]
+ ] ifFalse:[
+ outcome := 'change unparsable.'
+ ].
+ (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
+ d := DiffTextView openOn:oldSource and:newSource.
+ d label:'differences (current left; change right)'.
+ ]
+ ] ifFalse:[
+ outcome := 'class does not exist.'
+ ]
+ ] ifFalse:[
+ outcome := 'not comparable.'
+ ]
+ ] ifFalse:[
+ outcome := 'not comparable.'
+ ]
+ ].
+ Transcript showCr:outcome.
+ aStream close.
+!
+
writeBackChanges
"write back the changes file"
@@ -710,73 +784,6 @@
!
-queryCloseText
- "made this a method for easy redefinition in subclasses"
-
- ^ 'Quit without updating changeFile ?'
-!
-
-compareChange:changeNr
- "compare a change with current version"
-
- |aStream chunk sawExcla parseTree thisClass cat oldSource newSource
- parser sel oldMethod outcome showDiff d|
-
- aStream := self streamForChange:changeNr.
- aStream isNil ifTrue:[^ self].
-
- sawExcla := aStream peekFor:(aStream class chunkSeparator).
- chunk := aStream nextChunk.
- sawExcla ifFalse:[
- outcome := 'not comparable ...'
- ] ifTrue:[
- parseTree := Parser parseExpression:chunk.
- (parseTree notNil and:[parseTree isMessage]) ifTrue:[
- (parseTree selector == #methodsFor:) ifTrue:[
- thisClass := (parseTree receiver evaluate).
- thisClass isBehavior ifTrue:[
- showDiff := false.
- cat := parseTree arg1 evaluate.
- newSource := aStream nextChunk.
- parser := Parser parseMethod:newSource in:thisClass.
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- sel := parser selector.
- oldMethod := thisClass compiledMethodAt:sel.
- oldMethod notNil ifTrue:[
- (oldMethod category = cat) ifFalse:[
- Transcript showCr:'category changed.'.
- ].
- oldSource := oldMethod source.
- (oldSource = newSource) ifTrue:[
- outcome := 'same source'
- ] ifFalse:[
- outcome := 'source changed.'.
- showDiff := true
- ]
- ] ifFalse:[
- outcome := 'method does not exist.'
- ]
- ] ifFalse:[
- outcome := 'change unparsable.'
- ].
- (showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
- d := DiffTextView openOn:oldSource and:newSource.
- d label:'differences (current left; change right)'.
- ]
- ] ifFalse:[
- outcome := 'class does not exist.'
- ]
- ] ifFalse:[
- outcome := 'not comparable.'
- ]
- ] ifFalse:[
- outcome := 'not comparable.'
- ]
- ].
- Transcript showCr:outcome.
- aStream close.
-!
-
deleteChangesFrom:start to:stop
"delete a range of changes"
@@ -788,6 +795,12 @@
!
+queryCloseText
+ "made this a method for easy redefinition in subclasses"
+
+ ^ 'Quit without updating changeFile ?'
+!
+
changeFileName:aFileName
changeFileName := aFileName
!
@@ -873,149 +886,18 @@
! !
-!ChangesBrowser methodsFor:'initialize / release'!
-
-initialize
- |frame v|
-
- super initialize.
-
- changeFileName := 'changes'.
-
- frame := VariableVerticalPanel origin:(0.0 @ 0.0)
- corner:(1.0 @ 1.0)
- borderWidth:0
- in:self.
-
- v := ScrollableView for:SelectionInListView in:frame.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
- changeListView := v scrolledView.
- changeListView delegate:self.
-
- v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame.
- v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
- codeView := v scrolledView.
- codeView readOnly.
-
- anyChanges := false.
- ObjectMemory addDependent:self. "to get shutdown-update"
-!
+!ChangesBrowser methodsFor:'user interaction'!
-initializeMiddleButtonMenu
- |labels|
-
- labels := resources array:#(
- 'apply change'
- 'apply changes to end'
- 'apply changes for this class to end'
- 'apply all changes'
- '-'
- 'delete'
- 'delete to end'
- 'delete changes for this class to end'
- 'delete all changes for this class'
- '-'
- 'update'
- 'compress'
- 'compare with current version'
- 'browse class'
- '-'
- 'make change a patch'
-"/ 'update sourcefile from change'
-"/ '-'
- 'save change in file ...'
- 'save changes to end in file ...'
- 'save changes for this class to end in file ...'
- 'save all changes for this class in file ...'
- '-'
- 'writeback changeFile').
+doApply
+ "user wants a change to be applied"
- changeListView
- middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(
- doApply
- doApplyRest
- doApplyClassRest
- doApplyAll
- nil
- doDelete
- doDeleteRest
- doDeleteClassRest
- doDeleteClassAll
- nil
- doUpdate
- doCompress
- doCompare
- doBrowse
- nil
- doMakePatch
-"/ doMakePermanent
-"/ nil
- doSave
- doSaveRest
- doSaveClassRest
- doSaveClassAll
- nil
- doWriteBack)
- receiver:self
- for:changeListView)
-!
-
-realize
- super realize.
- self readChangesFileInBackground:true.
- self setChangeList.
- changeListView action:[:lineNr | self changeSelection:lineNr].
- self disableMenuEntries.
-!
-
-focusSequence
- ^ Array with:changeListView with:codeView
+ self withSelectedChangeDo:[:changeNr |
+ skipSignal := nil.
+ self applyChange:changeNr.
+ self autoSelect:(changeNr + 1)
+ ]
!
-update:what
- |box|
-
- (what == #aboutToExit) ifTrue:[
- "
- smalltalk is about to shut down -
- - if change list was modified, ask user and save if requested.
- "
- anyChanges ifTrue:[
- shown ifFalse:[
- self unrealize.
- self realize
- ].
- self raise.
-
- box := YesNoBox new.
- box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs.
- box noText:(resources at:'don''t update').
- box okText:(resources at:'update').
- box yesAction:[self writeBackChanges]
- noAction:[].
- box showAtPointer
- ].
- ^ self
- ].
- super update:what
-! !
-
-!ChangesBrowser methodsFor:'event handling '!
-
-keyPress:key x:x y:y view:view
- "this method is reached via delegation from the changeListView"
-
- key == #Delete ifTrue:[
- self doDelete.
- ^ self
- ].
- changeListView keyPress:key x:x y:y
-! !
-
-!ChangesBrowser methodsFor:'user interaction'!
-
changeSelection:lineNr
"show a change in the codeView"
@@ -1032,22 +914,7 @@
codeView contents:chunk.
codeView acceptAction:[:theCode | self doApply "noChangesAllowed"].
changeNrShown := lineNr.
- self enableMenuEntries
-!
-doApply
- "user wants a change to be applied"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- skipSignal := nil.
- self applyChange:changeNr.
- self autoSelect:(changeNr + 1)
- ]
- ]
!
noChangesAllowed
@@ -1095,35 +962,61 @@
]
!
+doCompare
+ "compare change with current system version
+ - give a note in transcript"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self withCursor:(Cursor execute) do:[
+ self compareChange:changeNr
+ ]
+ ]
+!
+
saveClass:aClassName from:startNr
"user wants changes from current to end to be appended to a file"
- |changeNr fileBox|
+ |changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- |thisClassName|
+ fileName := DialogView
+ requestFileName:'append changes for class to:'
+ default:''
+ ok:'append'
+ abort:'abort'
+ pattern:'*.chg'.
+
+ fileName notNil ifTrue:[
+ self withCursor:(Cursor write) do:[
+ startNr to:(changePositions size) do:[:changeNr |
+ |thisClassName|
- self withCursor:(Cursor write) do:[
- startNr to:(changePositions size) do:[:changeNr |
- thisClassName := self classNameOfChange:changeNr.
- thisClassName = aClassName ifTrue:[
- changeListView selection:changeNr.
- (self appendChange:changeNr toFile:fileName) ifFalse:[
- ^ self
- ]
- ]
- ]
- ]
- ].
+ thisClassName := self classNameOfChange:changeNr.
+ thisClassName = aClassName ifTrue:[
+ changeListView selection:changeNr.
+ (self appendChange:changeNr toFile:fileName) ifFalse:[
+ ^ self
+ ]
+ ]
+ ]
+ ]
+ ].
+ ]
+!
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
+doDelete
+ "delete currently selected change"
+
+ |changeNr|
+
+ changeNr := changeListView selection.
+ changeNr notNil ifTrue:[
+ self deleteChange:changeNr.
+ self autoSelectOrEnd:changeNr
]
!
@@ -1144,62 +1037,50 @@
doSaveRest
"user wants changes from current to end to be appended to a file"
- |changeNr fileBox|
+ |changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- self withCursor:(Cursor write) do:[
- changeNr to:(changePositions size) do:[:changeNr |
- changeListView selection:changeNr.
- (self appendChange:changeNr toFile:fileName) ifFalse:[
- ^ self
- ]
- ]
- ]
- ].
+ fileName := DialogView
+ requestFileName:'append changes to:'
+ default:''
+ ok:'append'
+ abort:'abort'
+ pattern:'*.chg'.
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
- ]
-!
-
-doDelete
- "delete currently selected change"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self deleteChange:changeNr.
- self autoSelectOrEnd:changeNr
+ fileName notNil ifTrue:[
+ self withCursor:(Cursor write) do:[
+ changeNr to:(changePositions size) do:[:changeNr |
+ changeListView selection:changeNr.
+ (self appendChange:changeNr toFile:fileName) ifFalse:[
+ ^ self
+ ]
+ ]
+ ]
+ ].
]
!
doSave
"user wants a change to be appended to a file"
- |changeNr fileBox|
+ |changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
- fileBox := FileSelectionBox new.
- fileBox title:'append change to:'.
- fileBox okText:'append'.
- fileBox abortText:'cancel'.
- fileBox action:[:fileName |
- self withCursor:(Cursor write) do:[
- self appendChange:changeNr toFile:fileName.
- ].
- self autoSelect:(changeNr + 1)
- ].
+ fileName := DialogView
+ requestFileName:'append change to:'
+ default:''
+ ok:'append'
+ abort:'abort'
+ pattern:'*.chg'.
- fileBox pattern:'*.chg'.
- fileBox showAtPointer
+ fileName notNil ifTrue:[
+ self withCursor:(Cursor write) do:[
+ self appendChange:changeNr toFile:fileName.
+ ].
+ self autoSelect:(changeNr + 1)
+ ].
]
!
@@ -1209,8 +1090,8 @@
self readChangesFileInBackground:true.
realized ifTrue:[
self setChangeList.
- changeListView hasSelection ifTrue:[self enableMenuEntries]
]
+
!
doMakePermanent
@@ -1247,25 +1128,6 @@
]
!
-doApplyRest
- "user wants all changes from changeNr to be applied"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- self clearCodeView.
- skipSignal isNil ifTrue:[skipSignal := Signal new].
- changeNr to:(changePositions size) do:[:changeNr |
- changeListView selection:changeNr.
- self applyChange:changeNr
- ].
- self autoSelect:changePositions size.
- ]
- ]
-!
-
doDeleteRest
"delete all changes from current to the end"
@@ -1422,6 +1284,20 @@
]
!
+doApplyRest
+ "user wants all changes from changeNr to be applied"
+
+ self withSelectedChangeDo:[:changeNr |
+ self clearCodeView.
+ skipSignal isNil ifTrue:[skipSignal := Signal new].
+ changeNr to:(changePositions size) do:[:changeNr |
+ changeListView selection:changeNr.
+ self applyChange:changeNr
+ ].
+ self autoSelect:changePositions size.
+ ]
+!
+
doApplyAll
"user wants all changes to be applied"
@@ -1436,43 +1312,6 @@
]
!
-doCompare
- "compare change with current system version
- - give a note in transcript"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- self compareChange:changeNr
- ]
- ]
-!
-
-doDeleteClassRest
- "delete rest of changes with same class as currently selected change"
-
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- | classNameToDelete |
-
- classNameToDelete := self classNameOfChange:changeNr.
- classNameToDelete notNil ifTrue:[
- changeListView selection:nil.
- self silentDeleteChangesFor:classNameToDelete
- from:changeNr
- to:(changePositions size).
- self setChangeList.
- self autoSelectOrEnd:changeNr
- ]
- ]
- ]
-!
-
doWriteBack
"write back the list onto the changes file"
@@ -1487,25 +1326,38 @@
]
!
+doDeleteClassRest
+ "delete rest of changes with same class as currently selected change"
+
+ self withSelectedChangeDo:[:changeNr |
+ | classNameToDelete |
+
+ classNameToDelete := self classNameOfChange:changeNr.
+ classNameToDelete notNil ifTrue:[
+ changeListView selection:nil.
+ self silentDeleteChangesFor:classNameToDelete
+ from:changeNr
+ to:(changePositions size).
+ self setChangeList.
+ self autoSelectOrEnd:changeNr
+ ]
+ ]
+!
+
doDeleteClassAll
"delete all changes with same class as currently selected change"
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- | classNameToDelete |
+ self withSelectedChangeDo:[:changeNr |
+ | classNameToDelete |
- classNameToDelete := self classNameOfChange:changeNr.
- classNameToDelete notNil ifTrue:[
- changeListView selection:nil.
- self silentDeleteChangesFor:classNameToDelete
- from:1
- to:(changePositions size).
- self setChangeList.
- self autoSelectOrEnd:changeNr
- ]
+ classNameToDelete := self classNameOfChange:changeNr.
+ classNameToDelete notNil ifTrue:[
+ changeListView selection:nil.
+ self silentDeleteChangesFor:classNameToDelete
+ from:1
+ to:(changePositions size).
+ self setChangeList.
+ self autoSelectOrEnd:changeNr
]
]
!
@@ -1513,50 +1365,200 @@
doApplyClassRest
"user wants all changes for this class from changeNr to be applied"
- |changeNr|
-
- changeNr := changeListView selection.
- changeNr notNil ifTrue:[
- self withCursor:(Cursor execute) do:[
- |thisClassName classNameToApply lastChange|
+ self withSelectedChangeDo:[:changeNr |
+ |thisClassName classNameToApply lastChange|
- classNameToApply := self classNameOfChange:changeNr.
- classNameToApply notNil ifTrue:[
- self clearCodeView.
- skipSignal isNil ifTrue:[skipSignal := Signal new].
- changeNr to:(changePositions size) do:[:changeNr |
- thisClassName := self classNameOfChange:changeNr.
- thisClassName = classNameToApply ifTrue:[
- changeListView selection:changeNr.
- self applyChange:changeNr.
- lastChange := changeNr
- ].
+ classNameToApply := self classNameOfChange:changeNr.
+ classNameToApply notNil ifTrue:[
+ self clearCodeView.
+ skipSignal isNil ifTrue:[skipSignal := Signal new].
+ changeNr to:(changePositions size) do:[:changeNr |
+ thisClassName := self classNameOfChange:changeNr.
+ thisClassName = classNameToApply ifTrue:[
+ changeListView selection:changeNr.
+ self applyChange:changeNr.
+ lastChange := changeNr
].
- self autoSelect:lastChange.
- ]
+ ].
+ self autoSelect:lastChange.
]
]
! !
+!ChangesBrowser methodsFor:'initialize / release'!
+
+initialize
+ |frame v|
+
+ super initialize.
+
+ changeFileName := 'changes'.
+
+ frame := VariableVerticalPanel origin:(0.0 @ 0.0)
+ corner:(1.0 @ 1.0)
+ borderWidth:0
+ in:self.
+
+ v := ScrollableView for:SelectionInListView in:frame.
+ v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
+ changeListView := v scrolledView.
+ changeListView delegate:self.
+ changeListView model:self; menu:#changeListMenu.
+
+ v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame.
+ v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
+ codeView := v scrolledView.
+ codeView readOnly.
+
+ anyChanges := false.
+ ObjectMemory addDependent:self. "to get shutdown-update"
+!
+
+focusSequence
+ ^ Array with:changeListView with:codeView
+!
+
+realize
+ super realize.
+ self readChangesFileInBackground:true.
+ self setChangeList.
+ changeListView action:[:lineNr | self changeSelection:lineNr].
+
+!
+
+update:what
+ |box|
+
+ (what == #aboutToExit) ifTrue:[
+ "
+ smalltalk is about to shut down -
+ - if change list was modified, ask user and save if requested.
+ "
+ anyChanges ifTrue:[
+ shown ifFalse:[
+ self unrealize.
+ self realize
+ ].
+ self raise.
+
+ box := YesNoBox new.
+ box title:(resources at:'ChangesBrowser:\changefile has not been updated from the modified changelist.\\Update before exiting ?') withCRs.
+ box noText:(resources at:'don''t update').
+ box okText:(resources at:'update').
+ box yesAction:[self writeBackChanges]
+ noAction:[].
+ box showAtPointer
+ ].
+ ^ self
+ ].
+ super update:what
+!
+
+changeListMenu
+ |labels selectors m|
+
+ labels := #(
+ 'apply change'
+ 'apply changes to end'
+ 'apply changes for this class to end'
+ 'apply all changes'
+ '-'
+ 'delete'
+ 'delete to end'
+ 'delete changes for this class to end'
+ 'delete all changes for this class'
+ '-'
+ 'update'
+ 'compress'
+ 'compare with current version'
+ 'browse class'
+ '-'
+ 'make change a patch'
+"/ 'update sourcefile from change'
+"/ '-'
+ 'save change in file ...'
+ 'save changes to end in file ...'
+ 'save changes for this class to end in file ...'
+ 'save all changes for this class in file ...'
+ '-'
+ 'writeback changeFile').
+
+ selectors := #(
+ doApply
+ doApplyRest
+ doApplyClassRest
+ doApplyAll
+ nil
+ doDelete
+ doDeleteRest
+ doDeleteClassRest
+ doDeleteClassAll
+ nil
+ doUpdate
+ doCompress
+ doCompare
+ doBrowse
+ nil
+ doMakePatch
+"/ doMakePermanent
+"/ nil
+ doSave
+ doSaveRest
+ doSaveClassRest
+ doSaveClassAll
+ nil
+ doWriteBack
+ ).
+
+ m := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors.
+
+ changeListView hasSelection ifFalse:[
+ #(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
+ doDeleteClassAll doCompare doMakePatch doSaveChangeInFile doMakePermanent
+ doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse)
+ do:[:sel |
+ m disable:sel
+ ].
+ ].
+ ^ m
+
+
+! !
+
+!ChangesBrowser methodsFor:'event handling '!
+
+keyPress:key x:x y:y view:view
+ "this method is reached via delegation from the changeListView"
+
+ key == #Delete ifTrue:[
+ self doDelete.
+ ^ self
+ ].
+ changeListView keyPress:key x:x y:y
+! !
+
!ChangesBrowser methodsFor:'termination'!
terminate
"window manager wants us to go away"
- |box|
+ |box action|
anyChanges ifTrue:[
- box := OptionBox title:'' numberOfOptions:3.
- box title:(resources at:'close ChangesBrowser.\\changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs.
- box buttonTitles:(resources array:#('abort' 'don''t update' 'update')).
- box actions:(Array with:[^ self]
- with:[self destroy]
- with:[self writeBackChanges. self destroy]
- ).
- box showAtPointer.
- ] ifFalse:[
- self destroy
- ]
+ action := OptionBox
+ request:(resources at:'changefile has not been updated from the modified changelist.\\Update before closing ?') withCRs
+ label:'ChangesBrowser'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('abort' 'don''t update' 'update')
+ values:#(#abort #ignore #save).
+ action == #abort ifTrue:[^ self].
+ action == #save ifTrue:[
+ self writeBackChanges
+ ].
+ ].
+ self destroy
!
destroy
@@ -1585,38 +1587,7 @@
Show the bad change in the codeView and let codeView hilight the error;
no corrections allowed here therefore return false"
- |action|
-
- (changeNrProcessed ~~ changeNrShown) ifTrue:[
- self changeSelection:changeNrProcessed
- ].
- (skipSignal notNil) ifTrue:[
-
- codeView highlightingErrorPosition:relPos to:relEndPos do:[
- |box|
-
- "
- start dialog - make certain cleanup is done
- "
- box := OptionBox title:aString numberOfOptions:3.
- box buttonTitles:#('abort' 'skip' 'continue').
- box actions:(Array with:[action := #abort]
- with:[action := #skip]
- with:[action := #continue]).
- box showAtPointer
- ].
-
- action == #abort ifTrue:[
- Object abortSignal raise.
- ^ false
- ].
- action == #skip ifTrue:[
- skipSignal raise.
- ^ false
- ].
- ^ false
- ].
- codeView error:aString position:relPos to:relEndPos.
+ self error:aString position:relPos to:relEndPos.
^ false
!
@@ -1644,12 +1615,12 @@
"
start dialog - make certain cleanup is done
"
- box := OptionBox title:aString numberOfOptions:3.
- box buttonTitles:#('abort' 'skip' 'continue').
- box actions:(Array with:[action := #abort]
- with:[action := #skip]
- with:[action := #continue]).
- box showAtPointer
+ action := OptionBox
+ request:aString
+ label:'Error'
+ form:(WarningBox iconBitmap)
+ buttonLabels:#('abort' 'skip' 'continue')
+ values:#(#abort #skip #continue).
].
action == #abort ifTrue:[
@@ -1664,4 +1635,3 @@
].
^ codeView error:aString position:relPos to:relEndPos
! !
-
--- a/ConInspV.st Fri Feb 24 18:00:43 1995 +0100
+++ b/ConInspV.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,8 +10,10 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 28-feb-1995 at 2:11:55 am'!
+
InspectorView subclass:#ContextInspectorView
- instanceVariableNames:'inspectedContext showingTemporaries'
+ instanceVariableNames:'inspectedContext values names showingTemporaries'
classVariableNames:''
poolDictionaries:''
category:'Interface-Inspector'
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/ConInspV.st,v 1.8 1995-02-06 00:59:36 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/ConInspV.st,v 1.9 1995-02-28 21:55:45 claus Exp $
'!
!ContextInspectorView class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/ConInspV.st,v 1.8 1995-02-06 00:59:36 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/ConInspV.st,v 1.9 1995-02-28 21:55:45 claus Exp $
"
!
@@ -52,29 +54,29 @@
"
! !
-!ContextInspectorView methodsFor:'initialization'!
+!ContextInspectorView methodsFor:'private'!
-initialize
- super initialize.
- showingTemporaries := false.
+setDoitActionIn:aWorkspace for:aContext
+ aWorkspace doItAction:[:theCode |
+ Compiler evaluate:theCode
+ in:aContext
+ receiver:nil
+ notifying:aWorkspace
+ logged:true
+ ifFail:nil
+ ]
!
-initializeListViewMiddleButtonMenus
- menu1 := PopUpMenu
- labels:(resources array:#(
- 'inspect'
- 'basicInspect'
- '-'
- 'show temporaries'
- ))
- selectors:#(
- doInspect
- doBasicInspect
- nil
- showTemporaries
- )
- receiver:self
- for:listView.
+valueAtLine:lineNr
+ "helper - return the value of the selected entry"
+
+ ^ values at:lineNr.
+
+
+!
+
+fieldList
+ ^ names
! !
!ContextInspectorView methodsFor:'accessing'!
@@ -82,17 +84,17 @@
inspect:con
"set the context to be inspected"
- |aList homeContext method names rec sel implementorClass
+ |aList homeContext method homeNames rec sel implementorClass
argNames varNames tmpNames m|
+ hasMore := false.
inspectedObject := nil.
inspectedContext := con.
- self initializeListViewMiddleButtonMenus.
- listView setMiddleButtonMenu:menu1.
con isNil ifTrue:[
- inspectedValues := nil.
- listView contents:nil.
+ names := nil.
+ values := nil.
+ listView list:nil.
^ self
].
@@ -104,12 +106,11 @@
"its a cheap blocks context"
rec := con receiver.
sel := con selector.
- names := #().
+ homeNames := OrderedCollection new.
] ifFalse:[
rec := homeContext receiver.
sel := homeContext selector.
-"/ implementorClass := homeContext searchClass whichClassImplements:sel.
implementorClass := homeContext methodClass.
implementorClass notNil ifTrue:[
method := implementorClass compiledMethodAt:sel.
@@ -123,66 +124,66 @@
].
method notNil ifTrue:[
method source notNil ifTrue:[
- names := method methodArgAndVarNames.
- names isNil ifTrue:[
- names := #()
- ]
+ homeNames := method methodArgAndVarNames.
+ ]
+ ]
+ ].
+
+ "
+ create dummy names for method vars (if there is no source available)
+ "
+ homeNames isNil ifTrue:[
+ homeNames := OrderedCollection new.
+ 1 to:homeContext numArgs do:[:index |
+ homeNames add:('mArg' , index printString)
+ ].
+ 1 to:homeContext nvars do:[:index |
+ homeNames add:('mVar' , index printString)
+ ].
+ showingTemporaries ifTrue:[
+ 1 to:homeContext ntemp do:[:index |
+ homeNames add:('mTmp' , index printString)
]
]
].
].
- "create dummy names (if there is no source available)"
- names isNil ifTrue:[
- names := OrderedCollection new.
- 1 to:homeContext numArgs do:[:index |
- names add:('mArg' , index printString)
- ].
- 1 to:homeContext nvars do:[:index |
- names add:('mVar' , index printString)
- ].
- showingTemporaries ifTrue:[
- 1 to:homeContext ntemp do:[:index |
- names add:('mTmp' , index printString)
- ]
- ]
- ].
-
- aList := OrderedCollection new.
-
"
stupid: should find the block via the contexts
method-home and put real names in here
"
con isBlockContext ifTrue:[
+ names := OrderedCollection new.
+
argNames := (1 to:(con numArgs)) collect:[:i | 'arg' , i printString].
- aList addAll:argNames.
+ names addAll:argNames.
varNames := (1 to:(con nvars)) collect:[:i | 'var' , i printString].
- aList addAll:varNames.
+ names addAll:varNames.
showingTemporaries ifTrue:[
tmpNames := (1 to:(con ntemp)) collect:[:i | 'tmp' , i printString].
- aList addAll:tmpNames.
+ names addAll:tmpNames.
].
- aList addAll:names.
+ names addAll:homeNames.
- inspectedValues := Array withAll:(con argsAndVars).
+ values := Array withAll:(con argsAndVars).
(showingTemporaries and:[con ntemp ~~ 0]) ifTrue:[
- inspectedValues := inspectedValues , con temporaries
+ values := values , con temporaries
].
homeContext notNil ifTrue:[
- inspectedValues := inspectedValues , homeContext argsAndVars.
+ values := values , homeContext argsAndVars.
(showingTemporaries and:[homeContext ntemp ~~ 0])ifTrue:[
- inspectedValues := inspectedValues , homeContext temporaries
+ values := values , homeContext temporaries
].
].
] ifFalse:[
- aList addAll:names.
- inspectedValues := homeContext argsAndVars
+ names := homeNames.
+ values := homeContext argsAndVars
].
- listView contents:aList.
+
+ listView list:names.
workspace contents:nil.
self setDoitActionIn:workspace for:con.
@@ -192,23 +193,25 @@
"release inspected object"
inspectedContext := nil.
+ names := values := nil.
super release
! !
-!ContextInspectorView methodsFor:'private'!
+!ContextInspectorView methodsFor:'user actions'!
+
+showSelection:lineNr
+ "user clicked on an entry - show value in workspace"
+
+ workspace replace:(values at:lineNr) displayString.
+ selectedLine := lineNr
-setDoitActionIn:aWorkspace for:aContext
- aWorkspace doItAction:[:theCode |
- Compiler evaluate:theCode
- in:aContext
- receiver:nil
- notifying:aWorkspace
- logged:true
- ifFail:nil
- ]
-! !
+
+!
-!ContextInspectorView methodsFor:'user actions'!
+showTemporaries
+ showingTemporaries := true.
+ self inspect:inspectedContext
+!
doAccept:theText
|value|
@@ -223,18 +226,51 @@
].
!
-showTemporaries
- menu1 labelAt:#showTempraries put:(resources string:'hide temporaries').
- menu1 selectorAt:#showTempraries put:#hideTemporaries.
- showingTemporaries := true.
- self inspect:inspectedContext
-!
-
hideTemporaries
- menu1 labelAt:#hideTempraries put:(resources string:'show temporaries').
- menu1 selectorAt:#hideTempraries put:#showTemporaries.
showingTemporaries := false.
self inspect:inspectedContext
! !
+!ContextInspectorView methodsFor:'initialization'!
+initialize
+ super initialize.
+ showingTemporaries := false.
+
+!
+
+fieldMenu
+ |labels selectors|
+
+ showingTemporaries ifFalse:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'show temporaries'
+ ).
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ showTemporaries
+ )
+ ] ifTrue:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'hide temporaries'
+ ).
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ hideTemporaries
+ )
+ ].
+
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+! !
--- a/ContextInspectorView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/ContextInspectorView.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,8 +10,10 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 28-feb-1995 at 2:11:55 am'!
+
InspectorView subclass:#ContextInspectorView
- instanceVariableNames:'inspectedContext showingTemporaries'
+ instanceVariableNames:'inspectedContext values names showingTemporaries'
classVariableNames:''
poolDictionaries:''
category:'Interface-Inspector'
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/ContextInspectorView.st,v 1.8 1995-02-06 00:59:36 claus Exp $
+$Header: /cvs/stx/stx/libtool/ContextInspectorView.st,v 1.9 1995-02-28 21:55:45 claus Exp $
'!
!ContextInspectorView class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/ContextInspectorView.st,v 1.8 1995-02-06 00:59:36 claus Exp $
+$Header: /cvs/stx/stx/libtool/ContextInspectorView.st,v 1.9 1995-02-28 21:55:45 claus Exp $
"
!
@@ -52,29 +54,29 @@
"
! !
-!ContextInspectorView methodsFor:'initialization'!
+!ContextInspectorView methodsFor:'private'!
-initialize
- super initialize.
- showingTemporaries := false.
+setDoitActionIn:aWorkspace for:aContext
+ aWorkspace doItAction:[:theCode |
+ Compiler evaluate:theCode
+ in:aContext
+ receiver:nil
+ notifying:aWorkspace
+ logged:true
+ ifFail:nil
+ ]
!
-initializeListViewMiddleButtonMenus
- menu1 := PopUpMenu
- labels:(resources array:#(
- 'inspect'
- 'basicInspect'
- '-'
- 'show temporaries'
- ))
- selectors:#(
- doInspect
- doBasicInspect
- nil
- showTemporaries
- )
- receiver:self
- for:listView.
+valueAtLine:lineNr
+ "helper - return the value of the selected entry"
+
+ ^ values at:lineNr.
+
+
+!
+
+fieldList
+ ^ names
! !
!ContextInspectorView methodsFor:'accessing'!
@@ -82,17 +84,17 @@
inspect:con
"set the context to be inspected"
- |aList homeContext method names rec sel implementorClass
+ |aList homeContext method homeNames rec sel implementorClass
argNames varNames tmpNames m|
+ hasMore := false.
inspectedObject := nil.
inspectedContext := con.
- self initializeListViewMiddleButtonMenus.
- listView setMiddleButtonMenu:menu1.
con isNil ifTrue:[
- inspectedValues := nil.
- listView contents:nil.
+ names := nil.
+ values := nil.
+ listView list:nil.
^ self
].
@@ -104,12 +106,11 @@
"its a cheap blocks context"
rec := con receiver.
sel := con selector.
- names := #().
+ homeNames := OrderedCollection new.
] ifFalse:[
rec := homeContext receiver.
sel := homeContext selector.
-"/ implementorClass := homeContext searchClass whichClassImplements:sel.
implementorClass := homeContext methodClass.
implementorClass notNil ifTrue:[
method := implementorClass compiledMethodAt:sel.
@@ -123,66 +124,66 @@
].
method notNil ifTrue:[
method source notNil ifTrue:[
- names := method methodArgAndVarNames.
- names isNil ifTrue:[
- names := #()
- ]
+ homeNames := method methodArgAndVarNames.
+ ]
+ ]
+ ].
+
+ "
+ create dummy names for method vars (if there is no source available)
+ "
+ homeNames isNil ifTrue:[
+ homeNames := OrderedCollection new.
+ 1 to:homeContext numArgs do:[:index |
+ homeNames add:('mArg' , index printString)
+ ].
+ 1 to:homeContext nvars do:[:index |
+ homeNames add:('mVar' , index printString)
+ ].
+ showingTemporaries ifTrue:[
+ 1 to:homeContext ntemp do:[:index |
+ homeNames add:('mTmp' , index printString)
]
]
].
].
- "create dummy names (if there is no source available)"
- names isNil ifTrue:[
- names := OrderedCollection new.
- 1 to:homeContext numArgs do:[:index |
- names add:('mArg' , index printString)
- ].
- 1 to:homeContext nvars do:[:index |
- names add:('mVar' , index printString)
- ].
- showingTemporaries ifTrue:[
- 1 to:homeContext ntemp do:[:index |
- names add:('mTmp' , index printString)
- ]
- ]
- ].
-
- aList := OrderedCollection new.
-
"
stupid: should find the block via the contexts
method-home and put real names in here
"
con isBlockContext ifTrue:[
+ names := OrderedCollection new.
+
argNames := (1 to:(con numArgs)) collect:[:i | 'arg' , i printString].
- aList addAll:argNames.
+ names addAll:argNames.
varNames := (1 to:(con nvars)) collect:[:i | 'var' , i printString].
- aList addAll:varNames.
+ names addAll:varNames.
showingTemporaries ifTrue:[
tmpNames := (1 to:(con ntemp)) collect:[:i | 'tmp' , i printString].
- aList addAll:tmpNames.
+ names addAll:tmpNames.
].
- aList addAll:names.
+ names addAll:homeNames.
- inspectedValues := Array withAll:(con argsAndVars).
+ values := Array withAll:(con argsAndVars).
(showingTemporaries and:[con ntemp ~~ 0]) ifTrue:[
- inspectedValues := inspectedValues , con temporaries
+ values := values , con temporaries
].
homeContext notNil ifTrue:[
- inspectedValues := inspectedValues , homeContext argsAndVars.
+ values := values , homeContext argsAndVars.
(showingTemporaries and:[homeContext ntemp ~~ 0])ifTrue:[
- inspectedValues := inspectedValues , homeContext temporaries
+ values := values , homeContext temporaries
].
].
] ifFalse:[
- aList addAll:names.
- inspectedValues := homeContext argsAndVars
+ names := homeNames.
+ values := homeContext argsAndVars
].
- listView contents:aList.
+
+ listView list:names.
workspace contents:nil.
self setDoitActionIn:workspace for:con.
@@ -192,23 +193,25 @@
"release inspected object"
inspectedContext := nil.
+ names := values := nil.
super release
! !
-!ContextInspectorView methodsFor:'private'!
+!ContextInspectorView methodsFor:'user actions'!
+
+showSelection:lineNr
+ "user clicked on an entry - show value in workspace"
+
+ workspace replace:(values at:lineNr) displayString.
+ selectedLine := lineNr
-setDoitActionIn:aWorkspace for:aContext
- aWorkspace doItAction:[:theCode |
- Compiler evaluate:theCode
- in:aContext
- receiver:nil
- notifying:aWorkspace
- logged:true
- ifFail:nil
- ]
-! !
+
+!
-!ContextInspectorView methodsFor:'user actions'!
+showTemporaries
+ showingTemporaries := true.
+ self inspect:inspectedContext
+!
doAccept:theText
|value|
@@ -223,18 +226,51 @@
].
!
-showTemporaries
- menu1 labelAt:#showTempraries put:(resources string:'hide temporaries').
- menu1 selectorAt:#showTempraries put:#hideTemporaries.
- showingTemporaries := true.
- self inspect:inspectedContext
-!
-
hideTemporaries
- menu1 labelAt:#hideTempraries put:(resources string:'show temporaries').
- menu1 selectorAt:#hideTempraries put:#showTemporaries.
showingTemporaries := false.
self inspect:inspectedContext
! !
+!ContextInspectorView methodsFor:'initialization'!
+initialize
+ super initialize.
+ showingTemporaries := false.
+
+!
+
+fieldMenu
+ |labels selectors|
+
+ showingTemporaries ifFalse:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'show temporaries'
+ ).
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ showTemporaries
+ )
+ ] ifTrue:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'hide temporaries'
+ ).
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ hideTemporaries
+ )
+ ].
+
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+! !
--- a/DebugView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/DebugView.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,28 +10,26 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 25-feb-1995 at 9:36:24 am'!
+
StandardSystemView subclass:#DebugView
- instanceVariableNames:'busy haveControl exitAction canContinue
- contextView codeView
- receiverInspector contextInspector
- contextArray selectedContext
- catchBlock grabber traceView tracing
- bigStep skipLineNr steppedContextAddress canAbort
- abortButton terminateButton continueButton
- stepButton sendButton returnButton restartButton
- exclusive inspecting nChainShown
- inspectedProcess updateProcess
- monitorToggle stepping steppedContextLineno actualContext inWrap'
- classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'
- poolDictionaries:''
- category:'Interface-Debugger'
+ instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView
+ receiverInspector contextInspector contextArray selectedContext
+ catchBlock grabber traceView tracing bigStep skipLineNr
+ steppedContextAddress canAbort abortButton terminateButton
+ continueButton stepButton sendButton returnButton restartButton
+ exclusive inspecting nChainShown inspectedProcess updateProcess
+ monitorToggle stepping steppedContextLineno actualContext inWrap'
+ classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'
+ poolDictionaries:''
+ category:'Interface-Debugger'
!
DebugView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.26 1995-02-22 01:24:35 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.27 1995-02-28 21:55:50 claus Exp $
'!
!DebugView class methodsFor:'documentation'!
@@ -52,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.26 1995-02-22 01:24:35 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.27 1995-02-28 21:55:50 claus Exp $
"
!
@@ -88,6 +86,20 @@
!DebugView class methodsFor:'instance creation'!
+enterUnconditional:aContext withMessage:aString
+ "enter a debugger - do not check for recursive invocation"
+
+ |aDebugger|
+
+ StepInterruptPending := nil.
+ aDebugger := self new.
+ aDebugger setLabelFor:aString in:Processor activeProcess.
+ aDebugger enter:aContext.
+ ^ nil
+
+ "nil halt"
+!
+
new
"return a new DebugView - return a cached debugger if it already
exists"
@@ -119,53 +131,6 @@
^ debugger
!
-newExclusive
- "return a debugger for exclusive display access"
-
- |debugger|
-
- debugger := super new.
- debugger label:'Debugger'.
- debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
- debugger exclusive:true.
- ^ debugger
-!
-
-newDebugger
- "force creation of a new debugger"
-
- CachedDebugger := nil.
- CachedExclusive := nil.
- OpenDebuggers := nil.
-
- "
- DebugView newDebugger
- "
-!
-
-enterWithMessage:aString
- "the standard way of entering the debugger - sent from Objects
- error- and halt messages"
-
- ^ self enter:(thisContext sender) withMessage:aString
-
- "Debugger enterWithMessage:'hi there'"
-!
-
-enter
- "another way of entering the debugger"
-
- ^ self enter:(thisContext sender) withMessage:'Debugger'
-
- "Debugger enter"
-!
-
-enter:aContext
- "enter the debugger on aContext"
-
- ^ self enter:aContext withMessage:'Debugger'
-!
-
enter:aContext withMessage:aString
"enter a debugger; if this is a recursive invocation, enter
a MiniDebugger instead.
@@ -200,18 +165,28 @@
^ self enterUnconditional:aContext withMessage:aString
!
-enterUnconditional:aContext withMessage:aString
- "enter a debugger - do not check for recursive invocation"
+newExclusive
+ "return a debugger for exclusive display access"
- |aDebugger|
+ |debugger|
- StepInterruptPending := nil.
- aDebugger := self new.
- aDebugger setLabelFor:aString in:Processor activeProcess.
- aDebugger enter:aContext.
- ^ nil
+ debugger := super new.
+ debugger label:'Debugger'.
+ debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
+ debugger exclusive:true.
+ ^ debugger
+!
- "nil halt"
+newDebugger
+ "force creation of a new debugger"
+
+ CachedDebugger := nil.
+ CachedExclusive := nil.
+ OpenDebuggers := nil.
+
+ "
+ DebugView newDebugger
+ "
!
openOn:aProcess
@@ -237,6 +212,81 @@
aDebugger iconLabel:'Debugger'.
aDebugger openOn:aProcess.
^ nil
+!
+
+enterWithMessage:aString
+ "the standard way of entering the debugger - sent from Objects
+ error- and halt messages"
+
+ ^ self enter:(thisContext sender) withMessage:aString
+
+ "Debugger enterWithMessage:'hi there'"
+!
+
+enter
+ "another way of entering the debugger"
+
+ ^ self enter:(thisContext sender) withMessage:'Debugger'
+
+ "Debugger enter"
+!
+
+enter:aContext
+ "enter the debugger on aContext"
+
+ ^ self enter:aContext withMessage:'Debugger'
+! !
+
+!DebugView methodsFor:'private control loop'!
+
+controlLoop
+ "this is a kludge:
+ start a dispatchloop which exits when
+ either continue, return or step is pressed
+ "
+
+ haveControl := true.
+ [haveControl] whileTrue:[
+ self controlLoopCatchingErrors
+ ].
+ catchBlock := nil.
+!
+
+controlLoopCatchingErrors
+ "setup a self removing catch-block"
+ catchBlock := [catchBlock := nil. ^ nil].
+
+ exclusive ifTrue:[
+ "if we do not have multiple processes or its a system process
+ we start another dispatch loop, which exits when
+ either continue, return or step is pressed
+ or (via the catchBlock) if an error occurs.
+ Since our display is an extra exclusive one
+ all processing for normal views stops here ...
+ "
+ device dispatchModalWhile:[haveControl]
+ ] ifFalse:[
+ "we do have multiple processes -
+ simply enter the DebugViews-Windowgroup event loop.
+ effectively suspending event processing for the currently
+ active group.
+ "
+ SignalSet anySignal handle:[:ex |
+ |answer|
+
+ answer := self confirm:('error in debugger: ' , ex errorString , '\\debug again ?') withCRs.
+ answer ifTrue:[
+ Debugger enterUnconditional:(ex suspendedContext) withMessage:'error in debugger: ' , ex errorString.
+ ] ifFalse:[
+ 'ignored error in debugger: ' errorPrint.
+ ex errorString errorPrintNL.
+ ].
+ ex return.
+ ] do:[
+ windowGroup eventLoopWhile:[true]
+ ].
+ ].
+ catchBlock := nil.
! !
!DebugView methodsFor:'initialization'!
@@ -330,6 +380,10 @@
in:hpanel
!
+createOnTop
+ ^ false "true"
+!
+
initializeMiddleButtonMenu
|labels m|
@@ -366,9 +420,9 @@
m := (PopUpMenu
labels:labels
selectors:#(
- doShowMore
+ showMore
nil
- doSkip
+ skip
nil
"
doContinue
@@ -382,17 +436,18 @@
doRestart
nil
"
- doRemoveBreakpoint
- doRemoveAllBreakpoints
- nil
- doImplementors
- doSenders
+ removeBreakpoint
+ removeAllBreakpoints
nil
- doInspectContext
+ browseClass
+ implementors
+ senders
nil
- doQuickTerminate
+ inspectContext
nil
- doExit
+ quickTerminate
+ nil
+ exit
)
receiver:self
for:contextView).
@@ -402,21 +457,30 @@
inspecting ifTrue:[
m notNil ifTrue:[
m disable:#doTraceStep.
- m disable:#doRemoveBreakpoint.
+ m disable:#removeBreakpoint.
].
]
!
+setLabelFor:aMessage in:aProcess
+ |l nm|
+
+ l := aMessage , ' ('.
+ nm := aProcess name.
+ nm notNil ifTrue:[
+ l := l , (nm contractTo:17) , '-'.
+ ].
+ l := l , aProcess id printString , ')'.
+ self label:l.
+
+!
+
addToCurrentProject
"ignored here"
^ self
!
-createOnTop
- ^ false "true"
-!
-
realize
super realize.
exclusive ifTrue:[
@@ -433,19 +497,689 @@
priority:(inspectedProcess priority + 2 min:16).
]
]
+! !
+
+!DebugView methodsFor:'private'!
+
+cacheMyself
+ "remember myself for next debug session"
+
+ "caching the last debugger will make the next debugger appear
+ faster, since no resources have to be allocated in the display.
+ We have to be careful to release all refs to the debuggee, though.
+ Otherwise, the GC will not be able to release it"
+
+ busy := false.
+ codeView acceptAction:nil.
+ codeView doItAction:nil.
+ codeView contents:nil.
+ receiverInspector release.
+ contextInspector release.
+ inspectedProcess := nil.
+ exitAction := nil.
+ contextArray := nil.
+ selectedContext := actualContext := nil.
+ catchBlock := nil.
+ grabber := nil.
+ self autoUpdateOff.
+
+ exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
+!
+
+showError:message
+ codeView contents:(resources string:message).
+ codeView flash
+!
+
+interrestingContextFrom:aContext
+ "return an interresting contexts offset, or nil.
+ This is the context initially shown in the walkback.
+ We move up the calling chain, skipping all intermediate Signal
+ and Exception contexts, to present the context in which the error
+ actually occured.
+ Just for your convenience :-)"
+
+ |c found offset sel prev ex|
+
+ "somewhere, at the bottom, there must be a raise ..."
+
+ c := aContext.
+ 1 to:5 do:[:i |
+ c isNil ifTrue:[^ 1 "^ nil"].
+ sel := c selector.
+ (sel == #raise) ifTrue:[
+ (c receiver isKindOf:Exception) ifTrue:[
+ ex := c receiver
+ ].
+ offset := i.
+ found := c
+ ].
+ c := c sender.
+ ].
+
+ "
+ if this is a noHandler exception, skip forward
+ to the erronous context
+ "
+ ex notNil ifTrue:[
+ ex signal == Signal noHandlerSignal ifTrue:[
+ c := ex suspendedContext
+ ]
+ ].
+
+ (c := found) isNil ifTrue:[^ 1].
+
+ "
+ got it; move up, skipping all intermediate Signal and
+ Exception contexts
+ "
+ prev := nil.
+ [
+ ((c receiver isSignal)
+ or:[(c receiver isKindOf:Exception)])
+ ] whileTrue:[
+ prev := c.
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
+ ].
+
+ "
+ now, we are one above the raise
+ "
+
+ "
+ if the sender of the raise is one of objects error methods ...
+ "
+ ( #( halt halt:
+ error error:
+ doesNotUnderstand:
+ subclassResponsibility
+ primitiveFailed) includes:c selector)
+ ifTrue:[
+ c selector == #doesNotUnderstand: ifTrue:[
+ "
+ one more up, to get to the originating context
+ "
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
+ ].
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
+ ] ifFalse:[
+ "
+ ok, got the raise - if its a BreakPoint, look for the sender
+ "
+ (MessageTracer notNil and:[prev receiver == MessageTracer breakpointSignal]) ifTrue:[
+ offset := offset + 1
+ ].
+ ].
+
+ ^ offset
+!
+
+inspectedProcess
+ ^ inspectedProcess
+!
+
+busy
+ ^ busy
+!
+
+stepping
+ ^ stepping
+!
+
+setContext:aContext
+ "show calling chain from aContext in the walk-back listview"
+
+ |con text method caller caller2 m|
+
+ (contextArray notNil and:[aContext == (contextArray at:1)]) ifTrue:[
+ "no change"
+ ^ false
+ ].
+
+ m := contextView middleButtonMenu.
+ m notNil ifTrue:[
+ m disable:#showMore.
+ ].
+
+ aContext isNil ifTrue:[
+ text := Array with:'** no context **'.
+ contextArray := nil.
+ ] ifFalse:[
+ text := OrderedCollection new:nChainShown.
+ contextArray := OrderedCollection new:nChainShown.
+ con := aContext.
+
+ "
+ get them all
+ "
+ [con notNil and:[contextArray size <= nChainShown]] whileTrue:[
+ contextArray add:con.
+ (MoreDebuggingDetail == true) ifTrue:[
+ text add:(((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString).
+ ] ifFalse:[
+ text add:con printString.
+ ].
+
+ method := con method.
+ (method notNil and:[method isWrapped]) ifTrue:[
+ "
+ kludge: if its a wrapped method, then hide the wrap-call
+ "
+ caller := con sender.
+ (caller notNil and:[caller receiver == method originalMethod]) ifTrue:[
+ caller2 := caller sender.
+ (caller2 notNil and:[caller2 method == method]) ifTrue:[
+ con := caller2
+ ]
+ ].
+ caller := caller2 := nil
+ ].
+ con := con sender
+ ].
+
+ "
+ did we reach the end ?
+ "
+ (con isNil or:[con sender isNil]) ifTrue:[
+
+ "
+ the very last one is the startup context
+ (in main) - it has nil as receiver and nil as selector
+ "
+ contextArray last selector isNil ifTrue:[
+ contextArray removeLast.
+ text removeLast
+ ]
+ ] ifFalse:[
+ m notNil ifTrue:[
+ m enable:#showMore.
+ text add:(resources string:'*** more walkback follows - click here to see them ***')
+ ].
+ ].
+ ].
+
+ contextView setList:text.
+ receiverInspector release.
+ contextInspector release.
+
+ m notNil ifTrue:[
+ m disable:#removeBreakpoint.
+ m disable:#implementors.
+ m disable:#senders.
+ m disable:#browseClass.
+ ].
+ ^ true
+!
+
+showTerminated
+ self showError:'** the process has terminated **'
+!
+
+processAction:aBlock
+ "do something, then update the context list"
+
+ inspectedProcess isDead ifTrue:[
+ self showTerminated.
+ ^ self
+ ].
+ inspectedProcess interruptWith:aBlock.
+ "
+ give the process a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+!
+
+interruptProcessWith:aBlock
+ "let inspected process do something, then update the context list"
+
+ self processAction:[inspectedProcess interruptWith:aBlock.]
+!
+
+exclusive:aBoolean
+ exclusive := aBoolean
+!
+
+unstep
+ stepping := false.
+ bigStep := false.
+ steppedContextAddress := nil.
+ exitAction := nil
!
-setLabelFor:aMessage in:aProcess
- |l nm|
+updateContext
+ |oldContext idx|
+
+ inspectedProcess state == #dead ifTrue:[
+ self showTerminated.
+ ^ self
+ ].
+
+ oldContext := selectedContext.
+ (self setContext:(inspectedProcess suspendedContext)) ifTrue:[
+ oldContext notNil ifTrue:[
+ contextArray notNil ifTrue:[
+ idx := contextArray identityIndexOf:oldContext.
+ idx ~~ 0 ifTrue:[
+ self showSelection:idx
+ ] ifFalse:[
+ codeView contents:('** context returned **')
+ ]
+ ]
+ ]
+ ]
+! !
+
+!DebugView methodsFor:'basic'!
+
+enter:aContext
+ "enter the debugger - get and display the context, then start an
+ exclusive event loop on top of eveything else"
+
+ |con selection m idx retval s|
+
+ busy := true.
+ inspecting := false.
+ inspectedProcess := Processor activeProcess.
+ stepping := false.
+ bigStep := false.
+ nChainShown := 50.
+
+ "if debugger is entered while a box has grabbed the
+ pointer, we must ungrab - otherwise X wont talk to
+ us here
+ "
+ (grabber := device activePointerGrab) notNil ifTrue:[
+ device ungrabPointer
+ ].
+
+ terminateButton enable.
+
+ drawableId notNil ifTrue:[
+ "not the first time - realize at old position"
+ terminateButton turnOffWithoutRedraw.
+ continueButton turnOffWithoutRedraw.
+ returnButton turnOffWithoutRedraw.
+ restartButton turnOffWithoutRedraw.
+ abortButton turnOffWithoutRedraw.
+ stepButton turnOffWithoutRedraw.
+ sendButton turnOffWithoutRedraw.
+ ] ifFalse:[
+ exclusive ifFalse:[
+ windowGroup isNil ifTrue:[
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ ].
+ ].
+ self iconLabel:'Debugger'.
+ ].
+
+ "
+ get the walkback list
+ "
+ self setContext:aContext.
+
+ "
+ and find the one context to show initially
+ - if we came here by a send (single step), its the top context;
+ - if we came here by a step (i.e. bigStep), its the top context
+ (for ifs and whiles) or the sender (for regular sends).
+ - otherwise, we came here by some signal raise, and we are interrested
+ in the context where the raise actually occured.
+ "
+ exitAction == #step ifTrue:[
+ selection := 1.
+ steppedContextAddress notNil ifTrue:[
+ "
+ if we came here by a big-step, show the method where we are
+ "
+ (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+ selection := 1
+ ] ifFalse:[
+ (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+ selection := 2
+ ]
+ ].
+ "
+ for bigStep, we could also be in a block below the actual method ...
+ "
+ (aContext home notNil and:[
+ (ObjectMemory addressOf:aContext home) == steppedContextAddress]) ifTrue:[
+ selection := 1
+ ] ifFalse:[
+ (aContext sender home notNil and:[
+ (ObjectMemory addressOf:aContext sender home) == steppedContextAddress]) ifTrue:[
+ selection := 2
+ ]
+ ].
+ ]
+ ] ifFalse:[
+ steppedContextAddress isNil ifTrue:[
+ "
+ preselect a more interresting context, (where halt/raise was ...)
+ "
+ selection := self interrestingContextFrom:aContext.
+ ] ifFalse:[
+ "
+ if we came here by a big-step, show the method where we are
+ "
+ (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+ selection := 1
+ ] ifFalse:[
+ (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+ selection := 2
+ ]
+ ]
+ ]
+ ].
+
+ selection notNil ifTrue:[
+ self showSelection:selection.
+ contextView selection:selection.
+ selection > 1 ifTrue:[
+ contextView scrollToLine:(selection - 1)
+ ]
+ ].
+
+ m := contextView middleButtonMenu.
+ m notNil ifTrue:[
+ canAbort := inspecting or:[Object abortSignal isHandled].
+ canAbort ifTrue:[
+ abortButton enable.
+ m enable:#doAbort.
+ ] ifFalse:[
+ abortButton disable.
+ m disable:#doAbort.
+ ].
+ exclusive ifTrue:[
+ terminateButton disable.
+ m disable:#doTerminate.
+ ] ifFalse:[
+ terminateButton enable.
+ m enable:#doTerminate.
+ ]
+ ].
+
+ "
+ drawableId is nil, if this is a new debugger. Then do a realize.
+ Otherwise, its probably better to do a rerealize, which shows the
+ view at the previous position, without a need for the user to set the
+ position again
+ "
+ drawableId notNil ifTrue:[
+ self rerealize
+ ] ifFalse:[
+ self realize.
+ ].
+
+ "
+ bring us to the top
+ "
+ self raise.
+ Display synchronizeOutput.
+
+ canContinue := true.
+ exitAction := nil.
+
+ "
+ enter private event handling loop. This is left (and we come back here again)
+ when any button was pressed which requires continuation of the debuggee or
+ closedown of the debugger.
+ "
+
+ [self controlLoop] valueOnUnwindDo:[self destroy].
+
+ "
+ release all context stuff.
+ This is required to avoid keeping references to the debuggees objects
+ forever. (since the debugger is reused for faster startup next time)
+ "
+ contextArray := nil.
+ codeView acceptAction:nil.
+ contextView contents:nil.
+ receiverInspector release.
+ contextInspector release.
+
+ (exitAction ~~ #step) ifTrue:[
+ self unrealize.
+ device synchronizeOutput.
+
+ (exitAction == #abort) ifTrue:[
+ self cacheMyself.
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ Object abortSignal raise.
+ ].
+ 'abort failed' errorPrintNL
+ ].
- l := aMessage , ' ('.
- nm := aProcess name.
- nm notNil ifTrue:[
- l := l , (nm contractTo:17) , '-'.
+ (exitAction == #return) ifTrue:[
+ selectedContext notNil ifTrue:[
+ "
+ if there is a selection in the codeView,
+ evaluate it and use the result as return value
+ "
+"/ disabled for now, there is almost always a selection (the current line)
+"/ and that is syntactically incorrect ...
+"/ ... leading to a popup warning from the codeView
+"/
+"/ codeView hasSelection ifTrue:[
+"/ s := codeView selection asString.
+"/ Object errorSignal handle:[:ex |
+"/ 'DEBUGGER: error - returning nil' printNL.
+"/ retval := nil.
+"/ ex return
+"/ ] do:[
+"/ retval := codeView doItAction value:s.
+"/ ].
+"/ ].
+
+ con := selectedContext.
+ self cacheMyself.
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ con unwind:retval.
+ ].
+ 'cannot return from selected context' errorPrintNL
+ ]
+ ].
+
+ (exitAction == #restart) ifTrue:[
+ selectedContext notNil ifTrue:[
+ con := selectedContext.
+ self cacheMyself.
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ con unwindAndRestart.
+ ].
+ 'cannot restart selected context' errorPrintNL
+ ]
+ ].
+
+ (exitAction == #quickTerminate) ifTrue:[
+ self cacheMyself.
+ Processor activeProcess terminateNoSignal
+ ].
+
+ (exitAction == #terminate) ifTrue:[
+ self cacheMyself.
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ Processor activeProcess terminate.
+ ].
+ 'cannot terminate process' errorPrintNL
+ ]
+ ].
+
+ selectedContext := actualContext := nil.
+
+ grabber notNil ifTrue:[
+ device grabPointerInView:grabber.
+ grabber := nil.
].
- l := l , aProcess id printString , ')'.
- self label:l.
+
+ (exitAction == #step) ifTrue:[
+ "
+ schedule another stepInterrupt
+ - must enter myself into the collection of open debuggers,
+ in case the stepping process comes back again via a halt or signal
+ before the step is finished. In this case, the stepping debugger should
+ come up (instead of a new one)
+ - must flush caches since optimized methods not always
+ look for pending interrupts
+ "
+ OpenDebuggers isNil ifTrue:[
+ OpenDebuggers := WeakArray with:self
+ ] ifFalse:[
+ (OpenDebuggers includes:self) ifFalse:[
+ idx := OpenDebuggers identityIndexOf:nil.
+ idx ~~ 0 ifTrue:[
+ OpenDebuggers at:idx put:self
+ ] ifFalse:[
+ OpenDebuggers := OpenDebuggers copyWith:self
+ ]
+ ]
+ ].
+ self label:'single stepping - please wait ...'.
+ stepping := true.
+
+ ObjectMemory stepInterruptHandler:self.
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := 1.
+ InterruptPending := 1.
+ InStepInterrupt := nil
+ ] ifFalse:[
+ OpenDebuggers notNil ifTrue:[
+ idx := OpenDebuggers identityIndexOf:self.
+ idx ~~ 0 ifTrue:[
+ OpenDebuggers at:idx put:nil
+ ]
+ ].
+ self cacheMyself.
+ ]
+!
+
+openOn:aProcess
+ "enter the debugger on a process -
+ in this case, we are just inspecting the context chain of the process,
+ not running on top of the debugged process, but as a separate
+ one. (think of it as an inspector showing more detail, and offering
+ some more control operations)"
+
+ |bpanel updateButton stopButton dummy|
+
+ busy := true.
+ bigStep := false.
+ inspecting := true.
+ inspectedProcess := aProcess.
+ nChainShown := 50.
+
+ bpanel := abortButton superView.
+
+ stopButton := Button new.
+ stopButton label:(resources at:'stop');
+ action:[self doStop].
+ bpanel addSubView:stopButton after:continueButton.
+
+ dummy := View extent:(20 @ 5) in:bpanel.
+ dummy borderWidth:0; level:0.
+"/ stepButton destroy.
+"/ sendButton destroy.
+
+ updateButton := Button
+ label:(resources at:'update')
+ action:[self updateContext]
+ in:bpanel.
+ monitorToggle := Toggle in:bpanel.
+ monitorToggle label:(resources at:'monitor').
+ monitorToggle pressAction:[self autoUpdateOn].
+ monitorToggle releaseAction:[self autoUpdateOff].
+
+ "can only look into process - context chain is not active"
+ canContinue := true.
+
+ terminateButton enable.
+ abortButton enable.
+
+ sendButton disable.
+ stepButton disable.
+"/ continueButton disable.
+"/ returnButton disable.
+"/ restartButton disable.
+
+ aProcess isNil ifTrue:[
+ terminateButton disable.
+ abortButton disable.
+ continueButton disable.
+ returnButton disable.
+ restartButton disable.
+ ] ifFalse:[
+ aProcess suspendedContext isNil ifTrue:[
+ terminateButton disable.
+ ].
+
+ self setContext:aProcess suspendedContext.
+
+ catchBlock := [
+ catchBlock := nil.
+ contextArray := nil.
+ selectedContext := actualContext := nil.
+ (exitAction == #terminate) ifTrue:[
+ aProcess terminate.
+ ].
+ (exitAction == #quickTerminate) ifTrue:[
+ aProcess terminateNoSignal.
+ ].
+ super destroy
+ ].
+ ].
+ self open
+!
+
+enter
+ "enter the debugger - on the sending context"
+
+ |where|
+
+ busy := true.
+
+ where := thisContext. "enter"
+ where := where sender. "the calling context"
+ where notNil ifTrue:[
+ (where receiver == DebugView) ifTrue:[
+ where := where sender
+ ]
+ "where is now interrupted methods context"
+ ].
+ ^ self enter:where
! !
!DebugView methodsFor:'interrupt handling'!
@@ -662,739 +1396,6 @@
self enter:thisContext sender
! !
-!DebugView methodsFor:'basic'!
-
-enter
- "enter the debugger - on the sending context"
-
- |where|
-
- busy := true.
-
- where := thisContext. "enter"
- where := where sender. "the calling context"
- where notNil ifTrue:[
- (where receiver == DebugView) ifTrue:[
- where := where sender
- ]
- "where is now interrupted methods context"
- ].
- ^ self enter:where
-!
-
-enter:aContext
- "enter the debugger - get and display the context, then start an
- exclusive event loop on top of eveything else"
-
- |con selection m idx retval s|
-
- busy := true.
- inspecting := false.
- inspectedProcess := Processor activeProcess.
- stepping := false.
- bigStep := false.
- nChainShown := 50.
-
- "if debugger is entered while a box has grabbed the
- pointer, we must ungrab - otherwise X wont talk to
- us here
- "
- (grabber := device activePointerGrab) notNil ifTrue:[
- device ungrabPointer
- ].
-
- terminateButton enable.
-
- drawableId notNil ifTrue:[
- "not the first time - realize at old position"
- terminateButton turnOffWithoutRedraw.
- continueButton turnOffWithoutRedraw.
- returnButton turnOffWithoutRedraw.
- restartButton turnOffWithoutRedraw.
- abortButton turnOffWithoutRedraw.
- stepButton turnOffWithoutRedraw.
- sendButton turnOffWithoutRedraw.
- ] ifFalse:[
- exclusive ifFalse:[
- windowGroup isNil ifTrue:[
- windowGroup := WindowGroup new.
- windowGroup addTopView:self.
- ].
- ].
- self iconLabel:'Debugger'.
- ].
-
- "
- get the walkback list
- "
- self setContext:aContext.
-
- "
- and find the one context to show initially
- - if we came here by a send (single step), its the top context;
- - if we came here by a step (i.e. bigStep), its the top context
- (for ifs and whiles) or the sender (for regular sends).
- - otherwise, we came here by some signal raise, and we are interrested
- in the context where the raise actually occured.
- "
- exitAction == #step ifTrue:[
- selection := 1.
- steppedContextAddress notNil ifTrue:[
- "
- if we came here by a big-step, show the method where we are
- "
- (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
- selection := 1
- ] ifFalse:[
- (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
- selection := 2
- ]
- ].
- "
- for bigStep, we could also be in a block below the actual method ...
- "
- (aContext home notNil and:[
- (ObjectMemory addressOf:aContext home) == steppedContextAddress]) ifTrue:[
- selection := 1
- ] ifFalse:[
- (aContext sender home notNil and:[
- (ObjectMemory addressOf:aContext sender home) == steppedContextAddress]) ifTrue:[
- selection := 2
- ]
- ].
- ]
- ] ifFalse:[
- steppedContextAddress isNil ifTrue:[
- "
- preselect a more interresting context, (where halt/raise was ...)
- "
- selection := self interrestingContextFrom:aContext.
- ] ifFalse:[
- "
- if we came here by a big-step, show the method where we are
- "
- (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
- selection := 1
- ] ifFalse:[
- (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
- selection := 2
- ]
- ]
- ]
- ].
-
- selection notNil ifTrue:[
- self showSelection:selection.
- contextView selection:selection.
- selection > 1 ifTrue:[
- contextView scrollToLine:(selection - 1)
- ]
- ].
-
- m := contextView middleButtonMenu.
- m notNil ifTrue:[
- canAbort := inspecting or:[Object abortSignal isHandled].
- canAbort ifTrue:[
- abortButton enable.
- m enable:#doAbort.
- ] ifFalse:[
- abortButton disable.
- m disable:#doAbort.
- ].
- exclusive ifTrue:[
- terminateButton disable.
- m disable:#doTerminate.
- ] ifFalse:[
- terminateButton enable.
- m enable:#doTerminate.
- ]
- ].
-
- "
- drawableId is nil, if this is a new debugger. Then do a realize.
- Otherwise, its probably better to do a rerealize, which shows the
- view at the previous position, without a need for the user to set the
- position again
- "
- drawableId notNil ifTrue:[
- self rerealize
- ] ifFalse:[
- self realize.
- ].
-
- "
- bring us to the top
- "
- self raise.
- Display synchronizeOutput.
-
- canContinue := true.
- exitAction := nil.
-
- "
- enter private event handling loop. This is left (and we come back here again)
- when any button was pressed which requires continuation of the debuggee or
- closedown of the debugger.
- "
- self controlLoop.
-
- "
- release all context stuff.
- This is required to avoid keeping references to the debuggees objects
- forever. (since the debugger is reused for faster startup next time)
- "
- contextArray := nil.
- codeView acceptAction:nil.
- contextView contents:nil.
- receiverInspector release.
- contextInspector release.
-
- (exitAction ~~ #step) ifTrue:[
- self unrealize.
- device synchronizeOutput.
-
- (exitAction == #abort) ifTrue:[
- self cacheMyself.
- "
- have to catch errors occuring in unwind-blocks
- "
- Object errorSignal handle:[:ex |
- 'ignored error while unwinding: ' errorPrint.
- ex errorString errorPrintNL.
- ex proceed
- ] do:[
- Object abortSignal raise.
- ].
- 'abort failed' errorPrintNL
- ].
-
- (exitAction == #return) ifTrue:[
- selectedContext notNil ifTrue:[
- "
- if there is a selection in the codeView,
- evaluate it and use the result as return value
- "
-"/ disabled for now, there is almost always a selection (the current line)
-"/ and that is syntactically incorrect ...
-"/ ... leading to a popup warning from the codeView
-"/
-"/ codeView hasSelection ifTrue:[
-"/ s := codeView selection asString.
-"/ Object errorSignal handle:[:ex |
-"/ 'DEBUGGER: error - returning nil' printNL.
-"/ retval := nil.
-"/ ex return
-"/ ] do:[
-"/ retval := codeView doItAction value:s.
-"/ ].
-"/ ].
-
- con := selectedContext.
- self cacheMyself.
- "
- have to catch errors occuring in unwind-blocks
- "
- Object errorSignal handle:[:ex |
- 'ignored error while unwinding: ' errorPrint.
- ex errorString errorPrintNL.
- ex proceed
- ] do:[
- con unwind:retval.
- ].
- 'cannot return from selected context' errorPrintNL
- ]
- ].
-
- (exitAction == #restart) ifTrue:[
- selectedContext notNil ifTrue:[
- con := selectedContext.
- self cacheMyself.
- "
- have to catch errors occuring in unwind-blocks
- "
- Object errorSignal handle:[:ex |
- 'ignored error while unwinding: ' errorPrint.
- ex errorString errorPrintNL.
- ex proceed
- ] do:[
- con unwindAndRestart.
- ].
- 'cannot restart selected context' errorPrintNL
- ]
- ].
-
- (exitAction == #quickTerminate) ifTrue:[
- self cacheMyself.
- Processor activeProcess terminateNoSignal
- ].
-
- (exitAction == #terminate) ifTrue:[
- self cacheMyself.
- "
- have to catch errors occuring in unwind-blocks
- "
- Object errorSignal handle:[:ex |
- 'ignored error while unwinding: ' errorPrint.
- ex errorString errorPrintNL.
- ex proceed
- ] do:[
- Processor activeProcess terminate.
- ].
- 'cannot terminate process' errorPrintNL
- ]
- ].
-
- selectedContext := actualContext := nil.
-
- grabber notNil ifTrue:[
- device grabPointerInView:grabber.
- grabber := nil.
- ].
-
- (exitAction == #step) ifTrue:[
- "
- schedule another stepInterrupt
- - must enter myself into the collection of open debuggers,
- in case the stepping process comes back again via a halt or signal
- before the step is finished. In this case, the stepping debugger should
- come up (instead of a new one)
- - must flush caches since optimized methods not always
- look for pending interrupts
- "
- OpenDebuggers isNil ifTrue:[
- OpenDebuggers := WeakArray with:self
- ] ifFalse:[
- (OpenDebuggers includes:self) ifFalse:[
- idx := OpenDebuggers identityIndexOf:nil.
- idx ~~ 0 ifTrue:[
- OpenDebuggers at:idx put:self
- ] ifFalse:[
- OpenDebuggers := OpenDebuggers copyWith:self
- ]
- ]
- ].
- self label:'single stepping - please wait ...'.
- stepping := true.
-
- ObjectMemory stepInterruptHandler:self.
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1.
- InStepInterrupt := nil
- ] ifFalse:[
- OpenDebuggers notNil ifTrue:[
- idx := OpenDebuggers identityIndexOf:self.
- idx ~~ 0 ifTrue:[
- OpenDebuggers at:idx put:nil
- ]
- ].
- self cacheMyself.
- ]
-!
-
-openOn:aProcess
- "enter the debugger on a process -
- in this case, we are just inspecting the context chain of the process,
- not running on top of the debugged process, but as a separate
- one. (think of it as an inspector showing more detail, and offering
- some more control operations)"
-
- |bpanel updateButton stopButton dummy|
-
- busy := true.
- bigStep := false.
- inspecting := true.
- inspectedProcess := aProcess.
- nChainShown := 50.
-
- bpanel := abortButton superView.
-
- stopButton := Button new.
- stopButton label:(resources at:'stop');
- action:[self doStop].
- bpanel addSubView:stopButton after:continueButton.
-
- dummy := View extent:(20 @ 5) in:bpanel.
- dummy borderWidth:0; level:0.
-
-"/ stepButton destroy.
-"/ sendButton destroy.
-
- updateButton := Button
- label:(resources at:'update')
- action:[self updateContext]
- in:bpanel.
- monitorToggle := Toggle in:bpanel.
- monitorToggle label:(resources at:'monitor').
- monitorToggle pressAction:[self autoUpdateOn].
- monitorToggle releaseAction:[self autoUpdateOff].
-
- "can only look into process - context chain is not active"
- canContinue := true.
-
- terminateButton enable.
- abortButton enable.
-
- sendButton disable.
- stepButton disable.
-"/ continueButton disable.
-"/ returnButton disable.
-"/ restartButton disable.
-
- aProcess isNil ifTrue:[
- terminateButton disable.
- abortButton disable.
- continueButton disable.
- returnButton disable.
- restartButton disable.
- ] ifFalse:[
- aProcess suspendedContext isNil ifTrue:[
- terminateButton disable.
- ].
-
- self setContext:aProcess suspendedContext.
-
- catchBlock := [
- catchBlock := nil.
- contextArray := nil.
- selectedContext := actualContext := nil.
- (exitAction == #terminate) ifTrue:[
- aProcess terminate.
- ].
- (exitAction == #quickTerminate) ifTrue:[
- aProcess terminateNoSignal.
- ].
- super destroy
- ].
- ].
- self open
-! !
-
-!DebugView methodsFor:'private control loop'!
-
-controlLoop
- "this is a kludge:
- start a dispatchloop which exits when
- either continue, return or step is pressed
- "
-
- haveControl := true.
- [haveControl] whileTrue:[
- self controlLoopCatchingErrors
- ].
- catchBlock := nil.
-!
-
-controlLoopCatchingErrors
- "setup a self removing catch-block"
- catchBlock := [catchBlock := nil. ^ nil].
-
- exclusive ifTrue:[
- "if we do not have multiple processes or its a system process
- we start another dispatch loop, which exits when
- either continue, return or step is pressed
- or (via the catchBlock) if an error occurs.
- Since our display is an extra exclusive one
- all processing for normal views stops here ...
- "
- device dispatchModalWhile:[haveControl]
- ] ifFalse:[
- "we do have multiple processes -
- simply enter the DebugViews-Windowgroup event loop.
- effectively suspending event processing for the currently
- active group.
- "
- SignalSet anySignal handle:[:ex |
- |answer|
-
- answer := self confirm:('error in debugger: ' , ex errorString , '\\debug again ?') withCRs.
- answer ifTrue:[
- Debugger enterUnconditional:(ex suspendedContext) withMessage:'error in debugger: ' , ex errorString.
- ] ifFalse:[
- 'ignored error in debugger: ' errorPrint.
- ex errorString errorPrintNL.
- ].
- ex return.
- ] do:[
- windowGroup eventLoopWhile:[true]
- ].
- ].
- catchBlock := nil.
-! !
-
-!DebugView methodsFor:'private'!
-
-cacheMyself
- "remember myself for next debug session"
-
- "caching the last debugger will make the next debugger appear
- faster, since no resources have to be allocated in the display.
- We have to be careful to release all refs to the debuggee, though.
- Otherwise, the GC will not be able to release it"
-
- busy := false.
- codeView acceptAction:nil.
- codeView doItAction:nil.
- codeView contents:nil.
- receiverInspector release.
- contextInspector release.
- inspectedProcess := nil.
- exitAction := nil.
- contextArray := nil.
- selectedContext := actualContext := nil.
- catchBlock := nil.
- grabber := nil.
- self autoUpdateOff.
-
- exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
-!
-
-inspectedProcess
- ^ inspectedProcess
-!
-
-busy
- ^ busy
-!
-
-stepping
- ^ stepping
-!
-
-showError:message
- codeView contents:(resources string:message).
- codeView flash
-!
-
-showTerminated
- self showError:'** the process has terminated **'
-!
-
-processAction:aBlock
- "do something, then update the context list"
-
- inspectedProcess isDead ifTrue:[
- self showTerminated.
- ^ self
- ].
- inspectedProcess interruptWith:aBlock.
- "
- give the process a chance to run, then update
- "
- (Delay forSeconds:0.2) wait.
- self setContext:(inspectedProcess suspendedContext).
-!
-
-interruptProcessWith:aBlock
- "let inspected process do something, then update the context list"
-
- self processAction:[inspectedProcess interruptWith:aBlock.]
-!
-
-exclusive:aBoolean
- exclusive := aBoolean
-!
-
-unstep
- stepping := false.
- bigStep := false.
- steppedContextAddress := nil.
- exitAction := nil
-!
-
-interrestingContextFrom:aContext
- "return an interresting contexts offset, or nil.
- This is the context initially shown in the walkback.
- We move up the calling chain, skipping all intermediate Signal
- and Exception contexts, to present the context in which the error
- actually occured.
- Just for your convenience :-)"
-
- |c found offset sel prev ex|
-
- "somewhere, at the bottom, there must be a raise ..."
-
- c := aContext.
- 1 to:5 do:[:i |
- c isNil ifTrue:[^ 1 "^ nil"].
- sel := c selector.
- (sel == #raise) ifTrue:[
- (c receiver isKindOf:Exception) ifTrue:[
- ex := c receiver
- ].
- offset := i.
- found := c
- ].
- c := c sender.
- ].
-
- "
- if this is a noHandler exception, skip forward
- to the erronous context
- "
- ex notNil ifTrue:[
- ex signal == Signal noHandlerSignal ifTrue:[
- c := ex suspendedContext
- ]
- ].
-
- (c := found) isNil ifTrue:[^ 1].
-
- "
- got it; move up, skipping all intermediate Signal and
- Exception contexts
- "
- prev := nil.
- [
- ((c receiver isSignal)
- or:[(c receiver isKindOf:Exception)])
- ] whileTrue:[
- prev := c.
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
- ].
-
- "
- now, we are one above the raise
- "
-
- "
- if the sender of the raise is one of objects error methods ...
- "
- ( #( halt halt:
- error error:
- doesNotUnderstand:
- subclassResponsibility
- primitiveFailed) includes:c selector)
- ifTrue:[
- c selector == #doesNotUnderstand: ifTrue:[
- "
- one more up, to get to the originating context
- "
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
- ].
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
- ] ifFalse:[
- "
- ok, got the raise - if its a BreakPoint, look for the sender
- "
- (MessageTracer notNil and:[prev receiver == MessageTracer breakpointSignal]) ifTrue:[
- offset := offset + 1
- ].
- ].
-
- ^ offset
-!
-
-setContext:aContext
- "show calling chain from aContext in the walk-back listview"
-
- |con text method caller caller2 m|
-
- (contextArray notNil and:[aContext == (contextArray at:1)]) ifTrue:[
- "no change"
- ^ false
- ].
-
- m := contextView middleButtonMenu.
- m notNil ifTrue:[
- m disable:#doShowMore.
- ].
-
- aContext isNil ifTrue:[
- text := Array with:'** no context **'.
- contextArray := nil.
- ] ifFalse:[
- text := OrderedCollection new:nChainShown.
- contextArray := OrderedCollection new:nChainShown.
- con := aContext.
-
- "
- get them all
- "
- [con notNil and:[contextArray size <= nChainShown]] whileTrue:[
- contextArray add:con.
- (MoreDebuggingDetail == true) ifTrue:[
- text add:(((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString).
- ] ifFalse:[
- text add:con printString.
- ].
-
- method := con method.
- (method notNil and:[method isWrapped]) ifTrue:[
- "
- kludge: if its a wrapped method, then hide the wrap-call
- "
- caller := con sender.
- (caller notNil and:[caller receiver == method originalMethod]) ifTrue:[
- caller2 := caller sender.
- (caller2 notNil and:[caller2 method == method]) ifTrue:[
- con := caller2
- ]
- ].
- caller := caller2 := nil
- ].
- con := con sender
- ].
-
- "
- did we reach the end ?
- "
- (con isNil or:[con sender isNil]) ifTrue:[
-
- "
- the very last one is the startup context
- (in main) - it has nil as receiver and nil as selector
- "
- contextArray last selector isNil ifTrue:[
- contextArray removeLast.
- text removeLast
- ]
- ] ifFalse:[
- m notNil ifTrue:[
- m enable:#doShowMore.
- text add:(resources string:'*** more walkback follows - click here to see them ***')
- ].
- ].
- ].
-
- contextView setList:text.
- receiverInspector release.
- contextInspector release.
-
- m notNil ifTrue:[
- m disable:#doRemoveBreakpoint.
- m disable:#doImplementors.
- m disable:#doSenders.
- ].
- ^ true
-!
-
-updateContext
- |oldContext idx|
-
- inspectedProcess state == #dead ifTrue:[
- self showTerminated.
- ^ self
- ].
-
- oldContext := selectedContext.
- (self setContext:(inspectedProcess suspendedContext)) ifTrue:[
- oldContext notNil ifTrue:[
- contextArray notNil ifTrue:[
- idx := contextArray identityIndexOf:oldContext.
- idx ~~ 0 ifTrue:[
- self showSelection:idx
- ] ifFalse:[
- codeView contents:('** context returned **')
- ]
- ]
- ]
- ]
-! !
-
!DebugView methodsFor:'user interaction'!
showSelection:lineNr
@@ -1413,7 +1414,7 @@
con isNil ifTrue:[
line := contextView list at:lineNr.
(line startsWith:'**') ifTrue:[
- self doShowMore.
+ self showMore.
contextView selection:lineNr.
con := contextArray at:lineNr
]
@@ -1519,18 +1520,64 @@
m := contextView middleButtonMenu.
m notNil ifTrue:[
- m enable:#doImplementors.
- m enable:#doSenders.
- m enable:#doInspectContext.
+ m enable:#implementors.
+ m enable:#senders.
+ m enable:#inspectContext.
(method notNil and:[method isWrapped]) ifTrue:[
- m enable:#doRemoveBreakpoint.
+ m enable:#removeBreakpoint.
] ifFalse:[
- m disable:#doRemoveBreakpoint.
+ m disable:#removeBreakpoint.
]
]
!
+destroy
+ "closing the debugger implies an abort or continue"
+
+ contextView middleButtonMenu hide.
+
+ "
+ we manually release all private data, since the Debugger
+ is cached for reuse - thus the memory would not be collectable
+ otherwise.
+ "
+ codeView acceptAction:nil.
+ codeView doItAction:nil.
+ codeView contents:nil.
+ catchBlock := nil.
+
+ receiverInspector release.
+ contextInspector release.
+ inspectedProcess := nil.
+ exitAction := nil.
+ contextArray := nil.
+ selectedContext := actualContext := nil.
+ grabber := nil.
+ self autoUpdateOff.
+
+ inspecting ifFalse:[
+ exclusive ifTrue:[
+ CachedExclusive == self ifTrue:[
+ CachedExclusive := nil.
+ ]
+ ] ifFalse:[
+ CachedDebugger == self ifTrue:[
+ CachedDebugger := nil
+ ]
+ ].
+
+ inspecting ifFalse:[
+ canAbort ifTrue:[
+ self doAbort.
+ ] ifFalse:[
+ self doContinue
+ ]
+ ].
+ ].
+ super destroy "/ 1.12.94
+!
+
codeAccept:someCode
"user wants some code to be recompiled - must unwind stack since everything above
and including selected method cannot be continued."
@@ -1590,61 +1637,57 @@
].
].
codeView cursor:Cursor normal
+! !
+
+!DebugView methodsFor:'menu / button actions'!
+
+doAbort
+ "abort - send Object>>abortSignal, which is usually cought
+ at save places (for example: in the event loop) and returns back
+ from whatever the process is doing, but does not terminate it."
+
+ inspecting ifTrue:[
+ inspectedProcess isDead ifTrue:[
+ self showTerminated.
+ ^ self
+ ].
+ (Object abortSignal isHandledIn:inspectedProcess suspendedContext) ifFalse:[
+ self showError:'** the process does not handle the abort signal **'
+ ] ifTrue:[
+ self interruptProcessWith:[Object abortSignal raise].
+ ].
+ ^ self
+ ].
+
+ steppedContextAddress := nil.
+ haveControl := false.
+ exitAction := #abort.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[
+ abortButton turnOff.
+ catchBlock value.
+ 'DEBUGGER: oops, abort failed' errorPrintNL.
+ ]
+ ].
+ ^ self.
+
+"obsolete ..."
+"/ Processor activeProcess id == 0 ifTrue:[
+"/ "dont allow termination of main-thread"
+"/ exitAction := #abort
+"/ ] ifFalse:[
+"/ exitAction := #terminate
+"/ ]
!
-destroy
- "closing the debugger implies an abort or continue"
-
- contextView middleButtonMenu hide.
-
- "
- we manually release all private data, since the Debugger
- is cached for reuse - thus the memory would not be collectable
- otherwise.
- "
- codeView acceptAction:nil.
- codeView doItAction:nil.
- codeView contents:nil.
- catchBlock := nil.
-
- receiverInspector release.
- contextInspector release.
- inspectedProcess := nil.
- exitAction := nil.
- contextArray := nil.
- selectedContext := actualContext := nil.
- grabber := nil.
- self autoUpdateOff.
-
- inspecting ifFalse:[
- exclusive ifTrue:[
- CachedExclusive == self ifTrue:[
- CachedExclusive := nil.
- ]
- ] ifFalse:[
- CachedDebugger == self ifTrue:[
- CachedDebugger := nil
- ]
- ].
-
- inspecting ifFalse:[
- canAbort ifTrue:[
- self doAbort.
- ] ifFalse:[
- self doContinue
- ]
- ].
- ].
- super destroy "/ 1.12.94
-!
-
-doExit
+exit
"exit from menu: immediate exit from smalltalk"
Smalltalk exit
!
-doRemoveBreakpoint
+removeBreakpoint
"remove breakpoint on the selected contexts method - if any"
|implementorClass method|
@@ -1660,16 +1703,33 @@
MessageTracer unwrapMethod:method
]
].
- contextView middleButtonMenu disable:#doRemoveBreakpoint.
+ contextView middleButtonMenu disable:#removeBreakpoint.
!
-doRemoveAllBreakpoints
+removeAllBreakpoints
"remove all trace & breakpoints - if any"
MessageTracer unwrapAllMethods
!
-doSenders
+browseClass
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
+ SystemBrowser browseClass:(selectedContext method who at:1).
+!
+
+autoUpdateOff
+ "stop the update process"
+
+ updateProcess notNil ifTrue:[
+ monitorToggle lampColor:(Color yellow).
+ updateProcess terminate.
+ updateProcess := nil
+ ]
+!
+
+senders
"open a browser on the senders"
selectedContext isNil ifTrue:[
@@ -1678,7 +1738,7 @@
SystemBrowser browseAllCallsOn:selectedContext selector.
!
-doImplementors
+implementors
"open a browser on the implementors"
selectedContext isNil ifTrue:[
@@ -1687,7 +1747,7 @@
SystemBrowser browseImplementorsOf:selectedContext selector.
!
-doShowMore
+showMore
"double number of contexts shown"
|oldSelection con|
@@ -1768,7 +1828,7 @@
self doStep:nil
!
-doSkip
+skip
"step from menu"
codeView cursorLine notNil ifTrue:[
@@ -1776,53 +1836,26 @@
]
!
-doTraceStep
- "tracestep - not implemented yet"
-
- canContinue ifTrue:[
- tracing := true.
- self doStep
- ]
-!
-
-doAbort
- "abort - send Object>>abortSignal, which is usually cought
- at save places (for example: in the event loop) and returns back
- from whatever the process is doing, but does not terminate it."
+doReturn
+ "return - the selected context will do a ^nil"
inspecting ifTrue:[
- inspectedProcess isDead ifTrue:[
- self showTerminated.
- ^ self
- ].
- (Object abortSignal isHandledIn:inspectedProcess suspendedContext) ifFalse:[
- self showError:'** the process does not handle the abort signal **'
- ] ifTrue:[
- self interruptProcessWith:[Object abortSignal raise].
- ].
- ^ self
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
+ self interruptProcessWith:[selectedContext unwind].
+ ^ self
].
steppedContextAddress := nil.
haveControl := false.
- exitAction := #abort.
+ exitAction := #return.
ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[
- abortButton turnOff.
- catchBlock value.
- 'DEBUGGER: oops, abort failed' errorPrintNL.
- ]
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ 'DEBUGGER: oops, return failed' errorPrintNL.
+ returnButton turnOff.
].
- ^ self.
-
-"obsolete ..."
-"/ Processor activeProcess id == 0 ifTrue:[
-"/ "dont allow termination of main-thread"
-"/ exitAction := #abort
-"/ ] ifFalse:[
-"/ exitAction := #terminate
-"/ ]
!
doTerminate
@@ -1847,48 +1880,13 @@
].
!
-doQuickTerminate
- "quick terminate - the process will get no chance for cleanup actions"
-
- inspecting ifTrue:[
- self processAction:[inspectedProcess terminateNoSignal].
- ^ self
- ].
+doTraceStep
+ "tracestep - not implemented yet"
- steppedContextAddress := nil.
- haveControl := false.
- exitAction := #quickTerminate.
- ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- inspecting ifFalse:[
- 'DEBUGGER: oops, terminate failed' errorPrintNL.
- self warn:'terminate failed'.
- ].
- terminateButton turnOff.
- ].
-!
-
-doReturn
- "return - the selected context will do a ^nil"
-
- inspecting ifTrue:[
- selectedContext isNil ifTrue:[
- ^ self showError:'** select a context first **'
- ].
- self interruptProcessWith:[selectedContext return].
- ^ self
- ].
-
- steppedContextAddress := nil.
- haveControl := false.
- exitAction := #return.
- ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- 'DEBUGGER: oops, return failed' errorPrintNL.
- returnButton turnOff.
- ].
+ canContinue ifTrue:[
+ tracing := true.
+ self doStep
+ ]
!
doRestart
@@ -1913,6 +1911,28 @@
].
!
+quickTerminate
+ "quick terminate - the process will get no chance for cleanup actions"
+
+ inspecting ifTrue:[
+ self processAction:[inspectedProcess terminateNoSignal].
+ ^ self
+ ].
+
+ steppedContextAddress := nil.
+ haveControl := false.
+ exitAction := #quickTerminate.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ inspecting ifFalse:[
+ 'DEBUGGER: oops, terminate failed' errorPrintNL.
+ self warn:'terminate failed'.
+ ].
+ terminateButton turnOff.
+ ].
+!
+
doTrace
"tracing - not really implemented ..."
@@ -1986,7 +2006,7 @@
]
!
-doInspectContext
+inspectContext
"launch an inspector on the currently selected context"
contextView selection notNil ifTrue:[
@@ -1996,16 +2016,6 @@
]
!
-autoUpdateOff
- "stop the update process"
-
- updateProcess notNil ifTrue:[
- monitorToggle lampColor:(Color yellow).
- updateProcess terminate.
- updateProcess := nil
- ]
-!
-
autoUpdateOn
"fork a subprocess which updates the contextList in regular intervals"
@@ -2032,3 +2042,4 @@
]
! !
+
--- a/DictInspV.st Fri Feb 24 18:00:43 1995 +0100
+++ b/DictInspV.st Tue Feb 28 22:57:00 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/DictInspV.st,v 1.10 1995-02-06 00:59:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/DictInspV.st,v 1.11 1995-02-28 21:55:46 claus Exp $
'!
!DictionaryInspectorView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/DictInspV.st,v 1.10 1995-02-06 00:59:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/DictInspV.st,v 1.11 1995-02-28 21:55:46 claus Exp $
"
!
@@ -142,7 +142,7 @@
!DictionaryInspectorView methodsFor:'private'!
-listOfNames
+fieldList
"return a list of names for the selectionlist. Leave hasMore as
true, if a '...' entry should be added."
@@ -169,44 +169,48 @@
!DictionaryInspectorView methodsFor:'initialization'!
-initializeListViewMiddleButtonMenus
+fieldMenu
|labels selectors|
inspectedObject == Smalltalk ifTrue:[
- labels := resources array:#(
- 'inspect'
- 'inspect key'
- 'basicInspect'
- 'references'
- '-'
- 'add key'
- 'remove key').
- selectors := #(doInspect
+ labels := #(
+ 'inspect'
+ 'inspect key'
+ 'basicInspect'
+ 'references'
+ '-'
+ 'add key'
+ 'remove key'
+ ).
+ selectors := #(
+ doInspect
doInspectKey
doBasicInspect
doReferences
nil
doAddKey
- doRemoveKey).
+ doRemoveKey
+ ).
] ifFalse:[
- labels := resources array:#(
- 'inspect'
- 'inspect key'
- 'basicInspect'
- '-'
- 'add key'
- 'remove key').
- selectors := #(doInspect
+ labels := #(
+ 'inspect'
+ 'inspect key'
+ 'basicInspect'
+ '-'
+ 'add key'
+ 'remove key'
+ ).
+ selectors := #(
+ doInspect
doInspectKey
doBasicInspect
nil
doAddKey
- doRemoveKey).
+ doRemoveKey
+ ).
].
- menu1 := (PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- receiver:self
- for:listView).
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
! !
--- a/DictionaryInspectorView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/DictionaryInspectorView.st Tue Feb 28 22:57:00 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/DictionaryInspectorView.st,v 1.10 1995-02-06 00:59:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/DictionaryInspectorView.st,v 1.11 1995-02-28 21:55:46 claus Exp $
'!
!DictionaryInspectorView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/DictionaryInspectorView.st,v 1.10 1995-02-06 00:59:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/DictionaryInspectorView.st,v 1.11 1995-02-28 21:55:46 claus Exp $
"
!
@@ -142,7 +142,7 @@
!DictionaryInspectorView methodsFor:'private'!
-listOfNames
+fieldList
"return a list of names for the selectionlist. Leave hasMore as
true, if a '...' entry should be added."
@@ -169,44 +169,48 @@
!DictionaryInspectorView methodsFor:'initialization'!
-initializeListViewMiddleButtonMenus
+fieldMenu
|labels selectors|
inspectedObject == Smalltalk ifTrue:[
- labels := resources array:#(
- 'inspect'
- 'inspect key'
- 'basicInspect'
- 'references'
- '-'
- 'add key'
- 'remove key').
- selectors := #(doInspect
+ labels := #(
+ 'inspect'
+ 'inspect key'
+ 'basicInspect'
+ 'references'
+ '-'
+ 'add key'
+ 'remove key'
+ ).
+ selectors := #(
+ doInspect
doInspectKey
doBasicInspect
doReferences
nil
doAddKey
- doRemoveKey).
+ doRemoveKey
+ ).
] ifFalse:[
- labels := resources array:#(
- 'inspect'
- 'inspect key'
- 'basicInspect'
- '-'
- 'add key'
- 'remove key').
- selectors := #(doInspect
+ labels := #(
+ 'inspect'
+ 'inspect key'
+ 'basicInspect'
+ '-'
+ 'add key'
+ 'remove key'
+ ).
+ selectors := #(
+ doInspect
doInspectKey
doBasicInspect
nil
doAddKey
- doRemoveKey).
+ doRemoveKey
+ ).
].
- menu1 := (PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- receiver:self
- for:listView).
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
! !
--- a/EvMonitor.st Fri Feb 24 18:00:43 1995 +0100
+++ b/EvMonitor.st Tue Feb 28 22:57:00 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/EvMonitor.st,v 1.5 1995-02-06 00:59:50 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/EvMonitor.st,v 1.6 1995-02-28 21:56:01 claus Exp $
'!
!EventMonitor class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/EvMonitor.st,v 1.5 1995-02-06 00:59:50 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/EvMonitor.st,v 1.6 1995-02-28 21:56:01 claus Exp $
"
!
@@ -144,9 +144,9 @@
!EventMonitor methodsFor:'realization'!
initEvents
- self enableButtonEvents.
+"/ self enableButtonEvents.
+"/ self enableButtonMotionEvents.
self enableMotionEvents.
- self enableButtonMotionEvents.
self enableKeyReleaseEvents.
self enableEnterLeaveEvents.
self enableEvent:#visibilityChange
--- a/EventMonitor.st Fri Feb 24 18:00:43 1995 +0100
+++ b/EventMonitor.st Tue Feb 28 22:57:00 1995 +0100
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/EventMonitor.st,v 1.5 1995-02-06 00:59:50 claus Exp $
+$Header: /cvs/stx/stx/libtool/EventMonitor.st,v 1.6 1995-02-28 21:56:01 claus Exp $
'!
!EventMonitor class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/EventMonitor.st,v 1.5 1995-02-06 00:59:50 claus Exp $
+$Header: /cvs/stx/stx/libtool/EventMonitor.st,v 1.6 1995-02-28 21:56:01 claus Exp $
"
!
@@ -144,9 +144,9 @@
!EventMonitor methodsFor:'realization'!
initEvents
- self enableButtonEvents.
+"/ self enableButtonEvents.
+"/ self enableButtonMotionEvents.
self enableMotionEvents.
- self enableButtonMotionEvents.
self enableKeyReleaseEvents.
self enableEnterLeaveEvents.
self enableEvent:#visibilityChange
--- a/FBrowser.st Fri Feb 24 18:00:43 1995 +0100
+++ b/FBrowser.st Tue Feb 28 22:57:00 1995 +0100
@@ -19,7 +19,8 @@
myName killButton compressTabs lockUpdate
previousDirectory currentFileName timeOfFileRead
tabSpec'
- classVariableNames:'DirectoryHistory DirectoryHistoryWhere HistorySize'
+ classVariableNames:'DirectoryHistory DirectoryHistoryWhere HistorySize
+ DefaultIcon'
poolDictionaries:''
category:'Interface-Browsers'
!
@@ -28,7 +29,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.30 1995-02-18 20:22:09 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.31 1995-02-28 21:56:54 claus Exp $
'!
!FileBrowser class methodsFor:'documentation'!
@@ -49,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.30 1995-02-18 20:22:09 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.31 1995-02-28 21:56:54 claus Exp $
"
!
@@ -100,6 +101,18 @@
"
! !
+!FileBrowser class methodsFor:'defaults'!
+
+defaultIcon
+ DefaultIcon isNil ifTrue:[
+ DefaultIcon := Form
+ fromFile:(ClassResources at:'ICON_FILE'
+ default:'FBrowser.xbm')
+ resolution:100.
+ ].
+ ^ DefaultIcon
+! !
+
!FileBrowser methodsFor:'initialization'!
initialize
@@ -138,8 +151,7 @@
myName := (resources string:self class name).
self label:myName.
- self icon:(Form fromFile:(resources at:'ICON_FILE' default:'FBrowser.xbm')
- resolution:100).
+ self icon:self class defaultIcon.
labelFrame := View origin:(0.0 @ 0.0)
corner:(1.0 @ (font height * 2))
@@ -180,7 +192,8 @@
].
labelView adjust:#right.
labelView borderWidth:0.
- self initializeLabelMiddleButtonMenu.
+ labelView model:self; menu:#labelMenu.
+ labelFrame model:self; menu:#labelMenu.
killButton := Button label:(resources string:'kill') in:self.
killButton origin:(halfSpacing @ halfSpacing)
@@ -204,6 +217,7 @@
fileListView doubleClickAction:[:lineNr | self fileSelect:lineNr.
self fileGet].
fileListView multipleSelectOk:true.
+ fileListView model:self; menu:#fileListMenu.
v := self initializeSubViewIn:frame.
v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
@@ -243,132 +257,9 @@
!
focusSequence
- ^ Array with:filterField with:fileListView with:subView
-!
-
-realize
- self initializeFileListMiddleButtonMenu.
- super realize.
-"/ self updateCurrentDirectory
-!
-
-initializeLabelMiddleButtonMenu
- |labels selectors args menu|
-
- labelView notNil ifTrue:[
- labels := resources array:#(
- 'copy path'
- '-'
- 'up'
- 'back'
- 'change to home-directory'
- 'change directory ...'
- ).
-
- selectors := #(
- copyPath
- nil
- changeToParentDirectory
- changeToPreviousDirectory
- changeToHomeDirectory
- changeCurrentDirectory
- ).
-
- args := Array new:(labels size).
-
- DirectoryHistory size > 0 ifTrue:[
- labels := labels copyWith:'-'.
- selectors := selectors copyWith:nil.
- args := args copyWith:nil.
-
- DirectoryHistory do:[:dirName |
- labels := labels copyWith:dirName.
- selectors := selectors copyWith:#changeDirectoryTo:.
- args := args copyWith:dirName
- ]
- ].
-
- menu := (PopUpMenu
- labels:labels
- selectors:selectors
- args:args
- receiver:self
- for:labelView).
- previousDirectory isNil ifTrue:[
- menu disable:#changeToPreviousDirectory.
- ].
- labelView middleButtonMenu:menu.
- labelView superView middleButtonMenu:menu.
- ]
-!
-
-initializeFileListMiddleButtonMenu
- |labels|
+ "return the sequence in which ALT-CursorRight steps focus"
- fileListView notNil ifTrue:[
- labels := resources array:#(
- 'spawn'
- '-'
- 'get contents'
- 'insert contents'
- 'show info'
- 'show full info'
- 'fileIn'
- '-'
- 'update'
- '-'
- 'execute unix command ...'
- 'st/x tools'
- '-'
- 'remove'
- 'rename ...'
- '-'
- 'display long list'
- 'show all files'
- '-'
- 'create directory ...'
- 'create file ...').
-
- fileListView
- middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(fileSpawn
- nil
- fileGet
- fileInsert
- fileGetInfo
- fileGetLongInfo
- fileFileIn
- nil
- updateCurrentDirectory
- nil
- fileExecute
- stxTools
- nil
- fileRemove
- fileRename
- nil
- changeDisplayMode
- changeDotFileVisibility
- nil
- newDirectory
- newFile)
- receiver:self
- for:fileListView).
-
- fileListView middleButtonMenu
- subMenuAt:#stxTools put:(PopUpMenu
- labels:#(
- 'Changes browser'
- 'Editor '
- )
- selectors:#(
- openChangesBrowser
- openEditor
- )
- receiver:self
- for:fileListView)
- ]
+ ^ Array with:filterField with:fileListView with:subView
! !
!FileBrowser methodsFor:'events'!
@@ -378,7 +269,6 @@
"
whant to know about changed history
"
- DirectoryHistory addDependent:self.
self updateCurrentDirectory
!
@@ -947,7 +837,6 @@
].
DirectoryHistory addFirst:path.
DirectoryHistoryWhere addFirst:pos.
- DirectoryHistory changed.
].
^ self
@@ -1621,7 +1510,6 @@
ObjectMemory removeDependent:self.
Processor removeTimedBlock:checkBlock.
checkBlock := nil.
- DirectoryHistory removeDependent:self.
super destroy
!
@@ -1657,10 +1545,6 @@
].
^ self
].
- changedObject == DirectoryHistory ifTrue:[
- self initializeLabelMiddleButtonMenu.
- ^ self
- ].
changedObject == tabSpec ifTrue:[
fileListView redraw
].
@@ -1668,6 +1552,53 @@
!FileBrowser methodsFor:'pathField user interaction'!
+labelMenu
+ |labels selectors args menu|
+
+ labels := #(
+ 'copy path'
+ '-'
+ 'up'
+ 'back'
+ 'change to home-directory'
+ 'change directory ...'
+ ).
+
+ selectors := #(
+ copyPath
+ nil
+ changeToParentDirectory
+ changeToPreviousDirectory
+ changeToHomeDirectory
+ changeCurrentDirectory
+ ).
+
+ args := Array new:(labels size).
+
+ DirectoryHistory size > 0 ifTrue:[
+ labels := labels copyWith:'-'.
+ selectors := selectors copyWith:nil.
+ args := args copyWith:nil.
+
+ DirectoryHistory do:[:dirName |
+ labels := labels copyWith:dirName.
+ selectors := selectors copyWith:#changeDirectoryTo:.
+ args := args copyWith:dirName
+ ]
+ ].
+
+ menu := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+ args:args
+ receiver:self.
+
+ previousDirectory isNil ifTrue:[
+ menu disable:#changeToPreviousDirectory.
+ ].
+ ^menu.
+!
+
copyPath
"copy current path into cut & paste buffer"
@@ -1721,6 +1652,79 @@
!FileBrowser methodsFor:'fileList user interaction'!
+fileListMenu
+ "return the menu to show in the fileList"
+
+ |labels selectors m|
+
+ labels := #(
+ 'spawn'
+ '-'
+ 'get contents'
+ 'insert contents'
+ 'show info'
+ 'show full info'
+ 'fileIn'
+ '-'
+ 'update'
+ '-'
+ 'execute unix command ...'
+ 'st/x tools'
+ '-'
+ 'remove'
+ 'rename ...'
+ '-'
+ 'display long list'
+ 'show all files'
+ '-'
+ 'create directory ...'
+ 'create file ...'
+ ).
+
+ selectors := #(
+ fileSpawn
+ nil
+ fileGet
+ fileInsert
+ fileGetInfo
+ fileGetLongInfo
+ fileFileIn
+ nil
+ updateCurrentDirectory
+ nil
+ fileExecute
+ stxTools
+ nil
+ fileRemove
+ fileRename
+ nil
+ changeDisplayMode
+ changeDotFileVisibility
+ nil
+ newDirectory
+ newFile
+ ).
+
+
+ m := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self.
+
+ m subMenuAt:#stxTools
+ put:(PopUpMenu
+ labels:#(
+ 'Changes browser'
+ 'Editor '
+ )
+ selectors:#(
+ openChangesBrowser
+ openEditor
+ )
+ receiver:self).
+ ^m
+!
+
fileSpawn
"start another FileBrowser on the selected directory or
on the same directory if none is selected."
--- a/FileBrowser.st Fri Feb 24 18:00:43 1995 +0100
+++ b/FileBrowser.st Tue Feb 28 22:57:00 1995 +0100
@@ -19,7 +19,8 @@
myName killButton compressTabs lockUpdate
previousDirectory currentFileName timeOfFileRead
tabSpec'
- classVariableNames:'DirectoryHistory DirectoryHistoryWhere HistorySize'
+ classVariableNames:'DirectoryHistory DirectoryHistoryWhere HistorySize
+ DefaultIcon'
poolDictionaries:''
category:'Interface-Browsers'
!
@@ -28,7 +29,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.30 1995-02-18 20:22:09 claus Exp $
+$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.31 1995-02-28 21:56:54 claus Exp $
'!
!FileBrowser class methodsFor:'documentation'!
@@ -49,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.30 1995-02-18 20:22:09 claus Exp $
+$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.31 1995-02-28 21:56:54 claus Exp $
"
!
@@ -100,6 +101,18 @@
"
! !
+!FileBrowser class methodsFor:'defaults'!
+
+defaultIcon
+ DefaultIcon isNil ifTrue:[
+ DefaultIcon := Form
+ fromFile:(ClassResources at:'ICON_FILE'
+ default:'FBrowser.xbm')
+ resolution:100.
+ ].
+ ^ DefaultIcon
+! !
+
!FileBrowser methodsFor:'initialization'!
initialize
@@ -138,8 +151,7 @@
myName := (resources string:self class name).
self label:myName.
- self icon:(Form fromFile:(resources at:'ICON_FILE' default:'FBrowser.xbm')
- resolution:100).
+ self icon:self class defaultIcon.
labelFrame := View origin:(0.0 @ 0.0)
corner:(1.0 @ (font height * 2))
@@ -180,7 +192,8 @@
].
labelView adjust:#right.
labelView borderWidth:0.
- self initializeLabelMiddleButtonMenu.
+ labelView model:self; menu:#labelMenu.
+ labelFrame model:self; menu:#labelMenu.
killButton := Button label:(resources string:'kill') in:self.
killButton origin:(halfSpacing @ halfSpacing)
@@ -204,6 +217,7 @@
fileListView doubleClickAction:[:lineNr | self fileSelect:lineNr.
self fileGet].
fileListView multipleSelectOk:true.
+ fileListView model:self; menu:#fileListMenu.
v := self initializeSubViewIn:frame.
v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
@@ -243,132 +257,9 @@
!
focusSequence
- ^ Array with:filterField with:fileListView with:subView
-!
-
-realize
- self initializeFileListMiddleButtonMenu.
- super realize.
-"/ self updateCurrentDirectory
-!
-
-initializeLabelMiddleButtonMenu
- |labels selectors args menu|
-
- labelView notNil ifTrue:[
- labels := resources array:#(
- 'copy path'
- '-'
- 'up'
- 'back'
- 'change to home-directory'
- 'change directory ...'
- ).
-
- selectors := #(
- copyPath
- nil
- changeToParentDirectory
- changeToPreviousDirectory
- changeToHomeDirectory
- changeCurrentDirectory
- ).
-
- args := Array new:(labels size).
-
- DirectoryHistory size > 0 ifTrue:[
- labels := labels copyWith:'-'.
- selectors := selectors copyWith:nil.
- args := args copyWith:nil.
-
- DirectoryHistory do:[:dirName |
- labels := labels copyWith:dirName.
- selectors := selectors copyWith:#changeDirectoryTo:.
- args := args copyWith:dirName
- ]
- ].
-
- menu := (PopUpMenu
- labels:labels
- selectors:selectors
- args:args
- receiver:self
- for:labelView).
- previousDirectory isNil ifTrue:[
- menu disable:#changeToPreviousDirectory.
- ].
- labelView middleButtonMenu:menu.
- labelView superView middleButtonMenu:menu.
- ]
-!
-
-initializeFileListMiddleButtonMenu
- |labels|
+ "return the sequence in which ALT-CursorRight steps focus"
- fileListView notNil ifTrue:[
- labels := resources array:#(
- 'spawn'
- '-'
- 'get contents'
- 'insert contents'
- 'show info'
- 'show full info'
- 'fileIn'
- '-'
- 'update'
- '-'
- 'execute unix command ...'
- 'st/x tools'
- '-'
- 'remove'
- 'rename ...'
- '-'
- 'display long list'
- 'show all files'
- '-'
- 'create directory ...'
- 'create file ...').
-
- fileListView
- middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(fileSpawn
- nil
- fileGet
- fileInsert
- fileGetInfo
- fileGetLongInfo
- fileFileIn
- nil
- updateCurrentDirectory
- nil
- fileExecute
- stxTools
- nil
- fileRemove
- fileRename
- nil
- changeDisplayMode
- changeDotFileVisibility
- nil
- newDirectory
- newFile)
- receiver:self
- for:fileListView).
-
- fileListView middleButtonMenu
- subMenuAt:#stxTools put:(PopUpMenu
- labels:#(
- 'Changes browser'
- 'Editor '
- )
- selectors:#(
- openChangesBrowser
- openEditor
- )
- receiver:self
- for:fileListView)
- ]
+ ^ Array with:filterField with:fileListView with:subView
! !
!FileBrowser methodsFor:'events'!
@@ -378,7 +269,6 @@
"
whant to know about changed history
"
- DirectoryHistory addDependent:self.
self updateCurrentDirectory
!
@@ -947,7 +837,6 @@
].
DirectoryHistory addFirst:path.
DirectoryHistoryWhere addFirst:pos.
- DirectoryHistory changed.
].
^ self
@@ -1621,7 +1510,6 @@
ObjectMemory removeDependent:self.
Processor removeTimedBlock:checkBlock.
checkBlock := nil.
- DirectoryHistory removeDependent:self.
super destroy
!
@@ -1657,10 +1545,6 @@
].
^ self
].
- changedObject == DirectoryHistory ifTrue:[
- self initializeLabelMiddleButtonMenu.
- ^ self
- ].
changedObject == tabSpec ifTrue:[
fileListView redraw
].
@@ -1668,6 +1552,53 @@
!FileBrowser methodsFor:'pathField user interaction'!
+labelMenu
+ |labels selectors args menu|
+
+ labels := #(
+ 'copy path'
+ '-'
+ 'up'
+ 'back'
+ 'change to home-directory'
+ 'change directory ...'
+ ).
+
+ selectors := #(
+ copyPath
+ nil
+ changeToParentDirectory
+ changeToPreviousDirectory
+ changeToHomeDirectory
+ changeCurrentDirectory
+ ).
+
+ args := Array new:(labels size).
+
+ DirectoryHistory size > 0 ifTrue:[
+ labels := labels copyWith:'-'.
+ selectors := selectors copyWith:nil.
+ args := args copyWith:nil.
+
+ DirectoryHistory do:[:dirName |
+ labels := labels copyWith:dirName.
+ selectors := selectors copyWith:#changeDirectoryTo:.
+ args := args copyWith:dirName
+ ]
+ ].
+
+ menu := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+ args:args
+ receiver:self.
+
+ previousDirectory isNil ifTrue:[
+ menu disable:#changeToPreviousDirectory.
+ ].
+ ^menu.
+!
+
copyPath
"copy current path into cut & paste buffer"
@@ -1721,6 +1652,79 @@
!FileBrowser methodsFor:'fileList user interaction'!
+fileListMenu
+ "return the menu to show in the fileList"
+
+ |labels selectors m|
+
+ labels := #(
+ 'spawn'
+ '-'
+ 'get contents'
+ 'insert contents'
+ 'show info'
+ 'show full info'
+ 'fileIn'
+ '-'
+ 'update'
+ '-'
+ 'execute unix command ...'
+ 'st/x tools'
+ '-'
+ 'remove'
+ 'rename ...'
+ '-'
+ 'display long list'
+ 'show all files'
+ '-'
+ 'create directory ...'
+ 'create file ...'
+ ).
+
+ selectors := #(
+ fileSpawn
+ nil
+ fileGet
+ fileInsert
+ fileGetInfo
+ fileGetLongInfo
+ fileFileIn
+ nil
+ updateCurrentDirectory
+ nil
+ fileExecute
+ stxTools
+ nil
+ fileRemove
+ fileRename
+ nil
+ changeDisplayMode
+ changeDotFileVisibility
+ nil
+ newDirectory
+ newFile
+ ).
+
+
+ m := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self.
+
+ m subMenuAt:#stxTools
+ put:(PopUpMenu
+ labels:#(
+ 'Changes browser'
+ 'Editor '
+ )
+ selectors:#(
+ openChangesBrowser
+ openEditor
+ )
+ receiver:self).
+ ^m
+!
+
fileSpawn
"start another FileBrowser on the selected directory or
on the same directory if none is selected."
--- a/InspView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/InspView.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,20 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 28-feb-1995 at 2:12:00 am'!
+
View subclass:#InspectorView
- instanceVariableNames:'listView workspace
- inspectedObject selectedLine
- inspectedValues nShown hasMore menu1 menu2'
- classVariableNames:'DefaultIcon'
- poolDictionaries:''
- category:'Interface-Inspector'
+ instanceVariableNames:'listView workspace inspectedObject selectedLine nShown hasMore'
+ classVariableNames:'DefaultIcon'
+ poolDictionaries:''
+ category:'Interface-Inspector'
!
InspectorView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/InspView.st,v 1.16 1995-02-22 11:08:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/InspView.st,v 1.17 1995-02-28 21:55:41 claus Exp $
'!
!InspectorView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/InspView.st,v 1.16 1995-02-22 11:08:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/InspView.st,v 1.17 1995-02-28 21:55:41 claus Exp $
"
!
@@ -79,31 +79,8 @@
"
! !
-!InspectorView class methodsFor:'defaults'!
-
-defaultIcon
- DefaultIcon isNil ifTrue:[
- DefaultIcon := Form fromFile:'Inspector.xbm' resolution:100
- ].
- ^ DefaultIcon
-! !
-
!InspectorView class methodsFor:'instance creation'!
-for:anObject
- "create and launch a new inspector for anObject.
- This protocol is a historic leftover - this method will vanish."
-
- ^ self openOn:anObject
-!
-
-inspect:anObject
- "create and launch a new inspector for anObject.
- This protocol is a historic leftover - this method will vanish."
-
- ^ self openOn:anObject
-!
-
openOn:anObject
"create and launch a new inspector for anObject"
@@ -118,7 +95,7 @@
topView := StandardSystemView
label:('Inspector on: ' , nm)
- icon:self class defaultIcon
+ icon:self defaultIcon
minExtent:(100 @ 100).
topView extent:(Display extent // 3).
@@ -137,113 +114,87 @@
InspectorView openOn:(Array new:400)
DictionaryInspectorView openOn:(IdentityDictionary new)
"
-! !
-
-!InspectorView methodsFor:'initialization'!
-
-initialize
- |v panel|
-
- super initialize.
-
- panel := VariableHorizontalPanel
- origin:(0.0 @ 0.0)
- corner:(1.0 @ 1.0)
- in:self.
+!
- v := HVScrollableView
- for:SelectionInListView
- miniScrollerH:true
- miniScrollerV:false
- in:panel.
- v origin:(0.0 @ 0.0) corner:(0.3 @ 1.0).
-
- listView := v scrolledView.
- listView action:[:lineNr | self showSelection:lineNr].
- listView doubleClickAction:[:lineNr | self doInspect].
- listView ignoreReselect:false.
+for:anObject
+ "create and launch a new inspector for anObject.
+ This protocol is a historic leftover - this method will vanish."
- v := HVScrollableView
- for:CodeView
- miniScrollerH:true
- miniScrollerV:false
- in:panel.
- v origin:(0.3 @ 0.0) corner:(1.0 @ 1.0).
- workspace := v scrolledView.
-
- workspace acceptAction:[:theText | self doAccept:theText asString].
-
- nShown := 100.
- self initializeListViewMiddleButtonMenus
+ ^ self openOn:anObject
!
-initializeListViewMiddleButtonMenus
- menu1 := PopUpMenu
- labels:(resources array:#(
- 'inspect'
- 'basicInspect'
-"/ '-'
-"/ 'owners'
- ))
- selectors:#(
- doInspect
- doBasicInspect
-"/ nil
-"/ inspectOwners
- )
- receiver:self
- for:listView.
- menu2 := PopUpMenu
- labels:(resources array:#(
- 'inspect'
- 'basicInspect'
- '-'
- 'show more'
- ))
- selectors:#(doInspect doBasicInspect nil showMore)
- receiver:self
- for:listView.
+inspect:anObject
+ "create and launch a new inspector for anObject.
+ This protocol is a historic leftover - this method will vanish."
+
+ ^ self openOn:anObject
+! !
+
+!InspectorView class methodsFor:'defaults'!
+
+defaultIcon
+ DefaultIcon isNil ifTrue:[
+ DefaultIcon := Form fromFile:'Inspector.xbm' resolution:100
+ ].
+ ^ DefaultIcon
+! !
+
+!InspectorView methodsFor:'accessing'!
+
+inspect:anObject
+ "define the object to be inspected"
+
+ |aList sameObject|
+
+ sameObject := anObject == inspectedObject.
+ inspectedObject := anObject.
+
+ hasMore := false.
+ aList := self fieldList.
+ hasMore ifTrue:[
+ aList add:' ... '
+ ].
+
+ sameObject ifTrue:[
+ listView setContents:aList.
+ listView selection:1.
+ ] ifFalse:[
+ listView contents:aList
+ ].
+
+ workspace contents:nil.
+ self setDoItAction.
+
+ selectedLine := nil
!
-mapped
- "delayed setup of lists till map-time -
- this makes startup of inspectors a bit faster"
-
- |o|
-
- super mapped.
- "
- kludge to trick inspect:, which ignores setting the
- same object again ...
- "
- o := inspectedObject.
- inspectedObject := nil.
- self inspect:o
-! !
-
-!InspectorView methodsFor:'release'!
-
-release
- "release inpected object. This is normally not needed,
- since the garbage collector will find this memory alone.
- However, if some applications keeps inspectors (for example,
- the debugger does this), this would be freed very late."
-
-"
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ].
-"
- inspectedObject := nil.
- inspectedValues := nil.
- workspace doItAction:nil.
- workspace contents:nil.
- listView contents:nil
+listView
+ ^ listView
! !
!InspectorView methodsFor:'private'!
-listOfNames
+setDoItAction
+ workspace doItAction:[:theCode |
+ (inspectedObject class compilerClass)
+ evaluate:theCode
+ in:nil
+ receiver:inspectedObject
+ notifying:workspace
+ logged:true
+ ifFail:nil
+ ].
+
+!
+
+showMore
+ hasMore ifTrue:[
+ nShown := nShown * 2.
+ self inspect:inspectedObject
+ ]
+!
+
+fieldList
"return a list of names to show in the selectionList.
Leave hasMore as true, if a '...' entry should be added."
@@ -266,120 +217,88 @@
(n > nShown) ifTrue:[
n := nShown.
hasMore := true.
- listView setMiddleButtonMenu:menu2.
- ] ifFalse:[
- listView setMiddleButtonMenu:menu1.
].
1 to:n do:[:index |
aList add:(index printString)
].
].
^ aList
+! !
+
+!InspectorView methodsFor:'user interaction'!
+
+showSelection:lineNr
+ "user clicked on an instvar - show value in workspace"
+
+ |val string index|
+
+ (hasMore and:[lineNr == listView list size]) ifTrue:[
+ "clicked on the '...' entry"
+ self showMore.
+ listView selection:lineNr.
+ ].
+
+ lineNr == 1 ifTrue:[
+ "selecting self also does a re-set, this allows updating the list"
+ self inspect:inspectedObject.
+ ].
+ val := self valueAtLine:lineNr.
+ string := val displayString.
+ workspace replace:string.
+ selectedLine := lineNr.
+!
+
+destroy
+ inspectedObject := nil.
+ super destroy
!
-showMore
- hasMore ifTrue:[
- nShown := nShown * 2.
- self inspect:inspectedObject
+valueAtLine:lineNr
+ "helper - return the value of the selected entry"
+
+ |index instSize|
+
+ lineNr == 1 ifTrue:[
+ ^ inspectedObject
+ ].
+ index := lineNr - 1. "/ skip self
+ instSize := inspectedObject class instSize.
+
+ (inspectedObject class isVariable not
+ or:[index <= instSize]) ifTrue:[
+ ^ inspectedObject instVarAt:index
+ ].
+ index := index - instSize.
+ ^ inspectedObject basicAt:index
+!
+
+doInspect
+ "user selected inspect-menu entry"
+
+ self doInspect:false
+!
+
+doInspect:basic
+ "user selected inspect-menu entry"
+
+ |objectToInspect|
+
+ selectedLine notNil ifTrue:[
+ objectToInspect := self valueAtLine:selectedLine.
+ basic ifTrue:[
+ objectToInspect basicInspect
+ ] ifFalse:[
+ objectToInspect inspect
+ ]
]
!
-setDoItAction
- workspace doItAction:[:theCode |
- (inspectedObject class compilerClass)
- evaluate:theCode
- in:nil
- receiver:inspectedObject
- notifying:workspace
- logged:true
- ifFail:nil
- ].
-
-! !
-
-!InspectorView methodsFor:'accessing'!
-
-inspect:anObject
- "define the object to be inspected"
-
- |aList sameObject|
-
- sameObject := anObject == inspectedObject.
-"
- sameObject ifFalse:[
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ]
- ].
-"
- inspectedObject := anObject.
- self initializeListViewMiddleButtonMenus.
- listView setMiddleButtonMenu:menu1.
-"/ realized ifFalse:[^ self].
-
- hasMore := false.
- aList := self listOfNames.
- hasMore ifTrue:[
- aList add:' ... '
- ].
-
- sameObject ifTrue:[
- listView setContents:aList
- ] ifFalse:[
- listView contents:aList
- ].
-
- workspace contents:nil.
- self setDoItAction.
+doBasicInspect
+ "user selected inspect-menu entry"
-"
- sameObject ifFalse:[
- inspectedObject notNil ifTrue:[
- inspectedObject addDependent:self
- ]
- ].
-"
- inspectedValues := nil.
- selectedLine := nil
+ self doInspect:true
!
-inspect:anObject values:valueArray names:nameArray
- listView contents:nameArray.
- workspace contents:nil.
-"
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ].
-"
- inspectedObject := anObject.
-"
- inspectedObject notNil ifTrue:[
- inspectedObject addDependent:self
- ].
-"
- inspectedValues := valueArray.
- selectedLine := nil
-!
-
-inspectValues:valueArray names:nameArray
- listView contents:nameArray.
- workspace contents:nil.
-"
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ].
-"
- inspectedObject := nil.
- inspectedValues := valueArray.
- selectedLine := nil
-!
-
-listView
- ^ listView
-! !
-
-!InspectorView methodsFor:'user interaction'!
-
keyPress:aKey x:x y:y
"all my input is passed on to the workspace-field"
@@ -400,77 +319,6 @@
]
!
-destroy
- inspectedObject notNil ifTrue:[
-"
- inspectedObject removeDependent:self.
-"
- inspectedObject := nil
- ].
- menu1 notNil ifTrue:[
- menu1 destroy. menu1 := nil.
- ].
- menu2 notNil ifTrue:[
- menu2 destroy. menu2 := nil.
- ].
- inspectedValues := nil.
- super destroy
-!
-
-valueAtLine:lineNr
- "helper - return the value of the selected entry"
-
- |index|
-
- inspectedValues notNil ifTrue:[
- ^ inspectedValues at:lineNr
- ].
-
- lineNr == 1 ifTrue:[
- ^ inspectedObject
- ].
- index := lineNr - 1. "/ skip self
- (inspectedObject class isVariable) ifFalse:[
- ^ inspectedObject instVarAt:index
- ].
- index <= (inspectedObject class instSize) ifTrue:[
- ^ inspectedObject instVarAt:index
- ].
- index := index - inspectedObject class instSize.
- ^ inspectedObject basicAt:index
-!
-
-showSelection:lineNr
- "user clicked on an instvar - show value in workspace"
-
- |val string index|
-
-"
- workspace contents:nil.
-"
- (hasMore and:[lineNr == listView list size]) ifTrue:[
- "clicked on the '...' entry"
- self showMore.
- listView selection:lineNr.
- ].
-
- (inspectedValues isNil
- and:[lineNr == 1]) ifTrue:[
- "selecting self also does a re-set, this allows updating the list"
- self inspect:inspectedObject.
- val := inspectedObject
- ] ifFalse:[
- val := self valueAtLine:lineNr
- ].
- string := val displayString.
-"
- workspace cursorToTop.
-"
- workspace replace:string.
-
- selectedLine := lineNr
-!
-
doAccept:theText
|value index|
@@ -478,57 +326,25 @@
evaluate:theText
receiver:inspectedObject
notifying:workspace.
- inspectedValues isNil ifTrue:[
- selectedLine notNil ifTrue:[
- selectedLine == 1 ifFalse:[
- index := selectedLine - 1.
- (inspectedObject class isVariable) ifFalse:[
+
+ selectedLine notNil ifTrue:[
+ selectedLine == 1 ifFalse:[
+ index := selectedLine - 1.
+ (inspectedObject class isVariable) ifFalse:[
+ inspectedObject instVarAt:index put:value
+ ] ifTrue:[
+ index <= (inspectedObject class instSize) ifTrue:[
inspectedObject instVarAt:index put:value
- ] ifTrue:[
- index <= (inspectedObject class instSize) ifTrue:[
- inspectedObject instVarAt:index put:value
- ] ifFalse:[
- index := index - inspectedObject class instSize.
- inspectedObject basicAt:index put:value
- ]
+ ] ifFalse:[
+ index := index - inspectedObject class instSize.
+ inspectedObject basicAt:index put:value
]
]
]
- ] ifFalse:[
- selectedLine notNil ifTrue:[
- inspectedValues at:selectedLine put:value
- ]
].
inspectedObject changed
!
-doInspect:basic
- "user selected inspect-menu entry"
-
- |objectToInspect|
-
- selectedLine notNil ifTrue:[
- objectToInspect := self valueAtLine:selectedLine.
- basic ifTrue:[
- objectToInspect basicInspect
- ] ifFalse:[
- objectToInspect inspect
- ]
- ]
-!
-
-doInspect
- "user selected inspect-menu entry"
-
- self doInspect:false
-!
-
-doBasicInspect
- "user selected inspect-menu entry"
-
- self doInspect:true
-!
-
inspectOwners
"open an inspector on owners of the inspectedObject.
(this is a secret function)"
@@ -569,3 +385,115 @@
dict inspect
]
! !
+
+!InspectorView methodsFor:'initialization'!
+
+mapped
+ "delayed setup of lists till map-time -
+ this makes startup of inspectors a bit faster"
+
+ |o|
+
+ super mapped.
+ "
+ kludge to trick inspect:, which ignores setting the
+ same object again ...
+ "
+ o := inspectedObject.
+ inspectedObject := nil.
+ self inspect:o
+!
+
+initialize
+ |v panel|
+
+ super initialize.
+
+ panel := VariableHorizontalPanel
+ origin:(0.0 @ 0.0)
+ corner:(1.0 @ 1.0)
+ in:self.
+
+ v := HVScrollableView
+ for:SelectionInListView
+ miniScrollerH:true
+ miniScrollerV:false
+ in:panel.
+ v origin:(0.0 @ 0.0) corner:(0.3 @ 1.0).
+
+ listView := v scrolledView.
+ listView action:[:lineNr | self showSelection:lineNr].
+ listView doubleClickAction:[:lineNr | self doInspect].
+ listView ignoreReselect:false.
+ listView model:self; menu:#fieldMenu.
+
+ v := HVScrollableView
+ for:CodeView
+ miniScrollerH:true
+ miniScrollerV:false
+ in:panel.
+ v origin:(0.3 @ 0.0) corner:(1.0 @ 1.0).
+ workspace := v scrolledView.
+
+ workspace acceptAction:[:theText | self doAccept:theText asString].
+
+ nShown := 100.
+ hasMore := false.
+!
+
+fieldMenu
+ |labels selectors|
+
+ hasMore ifTrue:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'show more'
+ ).
+
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ showMore
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+"/ '-'
+"/ 'owners'
+ ).
+
+ selectors := #(
+ doInspect
+ doBasicInspect
+"/ nil
+"/ inspectOwners
+ ).
+ ].
+
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+! !
+
+!InspectorView methodsFor:'release'!
+
+release
+ "release inpected object. This is normally not needed,
+ since the garbage collector will find this memory alone.
+ However, if some applications keeps inspectors (for example,
+ the debugger does this), this would be freed very late."
+
+"
+ inspectedObject notNil ifTrue:[
+ inspectedObject removeDependent:self
+ ].
+"
+ inspectedObject := nil.
+ workspace doItAction:nil.
+ workspace contents:nil.
+ listView contents:nil
+! !
--- a/InspectorView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/InspectorView.st Tue Feb 28 22:57:00 1995 +0100
@@ -10,20 +10,20 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 28-feb-1995 at 2:12:00 am'!
+
View subclass:#InspectorView
- instanceVariableNames:'listView workspace
- inspectedObject selectedLine
- inspectedValues nShown hasMore menu1 menu2'
- classVariableNames:'DefaultIcon'
- poolDictionaries:''
- category:'Interface-Inspector'
+ instanceVariableNames:'listView workspace inspectedObject selectedLine nShown hasMore'
+ classVariableNames:'DefaultIcon'
+ poolDictionaries:''
+ category:'Interface-Inspector'
!
InspectorView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.16 1995-02-22 11:08:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.17 1995-02-28 21:55:41 claus Exp $
'!
!InspectorView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.16 1995-02-22 11:08:44 claus Exp $
+$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.17 1995-02-28 21:55:41 claus Exp $
"
!
@@ -79,31 +79,8 @@
"
! !
-!InspectorView class methodsFor:'defaults'!
-
-defaultIcon
- DefaultIcon isNil ifTrue:[
- DefaultIcon := Form fromFile:'Inspector.xbm' resolution:100
- ].
- ^ DefaultIcon
-! !
-
!InspectorView class methodsFor:'instance creation'!
-for:anObject
- "create and launch a new inspector for anObject.
- This protocol is a historic leftover - this method will vanish."
-
- ^ self openOn:anObject
-!
-
-inspect:anObject
- "create and launch a new inspector for anObject.
- This protocol is a historic leftover - this method will vanish."
-
- ^ self openOn:anObject
-!
-
openOn:anObject
"create and launch a new inspector for anObject"
@@ -118,7 +95,7 @@
topView := StandardSystemView
label:('Inspector on: ' , nm)
- icon:self class defaultIcon
+ icon:self defaultIcon
minExtent:(100 @ 100).
topView extent:(Display extent // 3).
@@ -137,113 +114,87 @@
InspectorView openOn:(Array new:400)
DictionaryInspectorView openOn:(IdentityDictionary new)
"
-! !
-
-!InspectorView methodsFor:'initialization'!
-
-initialize
- |v panel|
-
- super initialize.
-
- panel := VariableHorizontalPanel
- origin:(0.0 @ 0.0)
- corner:(1.0 @ 1.0)
- in:self.
+!
- v := HVScrollableView
- for:SelectionInListView
- miniScrollerH:true
- miniScrollerV:false
- in:panel.
- v origin:(0.0 @ 0.0) corner:(0.3 @ 1.0).
-
- listView := v scrolledView.
- listView action:[:lineNr | self showSelection:lineNr].
- listView doubleClickAction:[:lineNr | self doInspect].
- listView ignoreReselect:false.
+for:anObject
+ "create and launch a new inspector for anObject.
+ This protocol is a historic leftover - this method will vanish."
- v := HVScrollableView
- for:CodeView
- miniScrollerH:true
- miniScrollerV:false
- in:panel.
- v origin:(0.3 @ 0.0) corner:(1.0 @ 1.0).
- workspace := v scrolledView.
-
- workspace acceptAction:[:theText | self doAccept:theText asString].
-
- nShown := 100.
- self initializeListViewMiddleButtonMenus
+ ^ self openOn:anObject
!
-initializeListViewMiddleButtonMenus
- menu1 := PopUpMenu
- labels:(resources array:#(
- 'inspect'
- 'basicInspect'
-"/ '-'
-"/ 'owners'
- ))
- selectors:#(
- doInspect
- doBasicInspect
-"/ nil
-"/ inspectOwners
- )
- receiver:self
- for:listView.
- menu2 := PopUpMenu
- labels:(resources array:#(
- 'inspect'
- 'basicInspect'
- '-'
- 'show more'
- ))
- selectors:#(doInspect doBasicInspect nil showMore)
- receiver:self
- for:listView.
+inspect:anObject
+ "create and launch a new inspector for anObject.
+ This protocol is a historic leftover - this method will vanish."
+
+ ^ self openOn:anObject
+! !
+
+!InspectorView class methodsFor:'defaults'!
+
+defaultIcon
+ DefaultIcon isNil ifTrue:[
+ DefaultIcon := Form fromFile:'Inspector.xbm' resolution:100
+ ].
+ ^ DefaultIcon
+! !
+
+!InspectorView methodsFor:'accessing'!
+
+inspect:anObject
+ "define the object to be inspected"
+
+ |aList sameObject|
+
+ sameObject := anObject == inspectedObject.
+ inspectedObject := anObject.
+
+ hasMore := false.
+ aList := self fieldList.
+ hasMore ifTrue:[
+ aList add:' ... '
+ ].
+
+ sameObject ifTrue:[
+ listView setContents:aList.
+ listView selection:1.
+ ] ifFalse:[
+ listView contents:aList
+ ].
+
+ workspace contents:nil.
+ self setDoItAction.
+
+ selectedLine := nil
!
-mapped
- "delayed setup of lists till map-time -
- this makes startup of inspectors a bit faster"
-
- |o|
-
- super mapped.
- "
- kludge to trick inspect:, which ignores setting the
- same object again ...
- "
- o := inspectedObject.
- inspectedObject := nil.
- self inspect:o
-! !
-
-!InspectorView methodsFor:'release'!
-
-release
- "release inpected object. This is normally not needed,
- since the garbage collector will find this memory alone.
- However, if some applications keeps inspectors (for example,
- the debugger does this), this would be freed very late."
-
-"
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ].
-"
- inspectedObject := nil.
- inspectedValues := nil.
- workspace doItAction:nil.
- workspace contents:nil.
- listView contents:nil
+listView
+ ^ listView
! !
!InspectorView methodsFor:'private'!
-listOfNames
+setDoItAction
+ workspace doItAction:[:theCode |
+ (inspectedObject class compilerClass)
+ evaluate:theCode
+ in:nil
+ receiver:inspectedObject
+ notifying:workspace
+ logged:true
+ ifFail:nil
+ ].
+
+!
+
+showMore
+ hasMore ifTrue:[
+ nShown := nShown * 2.
+ self inspect:inspectedObject
+ ]
+!
+
+fieldList
"return a list of names to show in the selectionList.
Leave hasMore as true, if a '...' entry should be added."
@@ -266,120 +217,88 @@
(n > nShown) ifTrue:[
n := nShown.
hasMore := true.
- listView setMiddleButtonMenu:menu2.
- ] ifFalse:[
- listView setMiddleButtonMenu:menu1.
].
1 to:n do:[:index |
aList add:(index printString)
].
].
^ aList
+! !
+
+!InspectorView methodsFor:'user interaction'!
+
+showSelection:lineNr
+ "user clicked on an instvar - show value in workspace"
+
+ |val string index|
+
+ (hasMore and:[lineNr == listView list size]) ifTrue:[
+ "clicked on the '...' entry"
+ self showMore.
+ listView selection:lineNr.
+ ].
+
+ lineNr == 1 ifTrue:[
+ "selecting self also does a re-set, this allows updating the list"
+ self inspect:inspectedObject.
+ ].
+ val := self valueAtLine:lineNr.
+ string := val displayString.
+ workspace replace:string.
+ selectedLine := lineNr.
+!
+
+destroy
+ inspectedObject := nil.
+ super destroy
!
-showMore
- hasMore ifTrue:[
- nShown := nShown * 2.
- self inspect:inspectedObject
+valueAtLine:lineNr
+ "helper - return the value of the selected entry"
+
+ |index instSize|
+
+ lineNr == 1 ifTrue:[
+ ^ inspectedObject
+ ].
+ index := lineNr - 1. "/ skip self
+ instSize := inspectedObject class instSize.
+
+ (inspectedObject class isVariable not
+ or:[index <= instSize]) ifTrue:[
+ ^ inspectedObject instVarAt:index
+ ].
+ index := index - instSize.
+ ^ inspectedObject basicAt:index
+!
+
+doInspect
+ "user selected inspect-menu entry"
+
+ self doInspect:false
+!
+
+doInspect:basic
+ "user selected inspect-menu entry"
+
+ |objectToInspect|
+
+ selectedLine notNil ifTrue:[
+ objectToInspect := self valueAtLine:selectedLine.
+ basic ifTrue:[
+ objectToInspect basicInspect
+ ] ifFalse:[
+ objectToInspect inspect
+ ]
]
!
-setDoItAction
- workspace doItAction:[:theCode |
- (inspectedObject class compilerClass)
- evaluate:theCode
- in:nil
- receiver:inspectedObject
- notifying:workspace
- logged:true
- ifFail:nil
- ].
-
-! !
-
-!InspectorView methodsFor:'accessing'!
-
-inspect:anObject
- "define the object to be inspected"
-
- |aList sameObject|
-
- sameObject := anObject == inspectedObject.
-"
- sameObject ifFalse:[
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ]
- ].
-"
- inspectedObject := anObject.
- self initializeListViewMiddleButtonMenus.
- listView setMiddleButtonMenu:menu1.
-"/ realized ifFalse:[^ self].
-
- hasMore := false.
- aList := self listOfNames.
- hasMore ifTrue:[
- aList add:' ... '
- ].
-
- sameObject ifTrue:[
- listView setContents:aList
- ] ifFalse:[
- listView contents:aList
- ].
-
- workspace contents:nil.
- self setDoItAction.
+doBasicInspect
+ "user selected inspect-menu entry"
-"
- sameObject ifFalse:[
- inspectedObject notNil ifTrue:[
- inspectedObject addDependent:self
- ]
- ].
-"
- inspectedValues := nil.
- selectedLine := nil
+ self doInspect:true
!
-inspect:anObject values:valueArray names:nameArray
- listView contents:nameArray.
- workspace contents:nil.
-"
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ].
-"
- inspectedObject := anObject.
-"
- inspectedObject notNil ifTrue:[
- inspectedObject addDependent:self
- ].
-"
- inspectedValues := valueArray.
- selectedLine := nil
-!
-
-inspectValues:valueArray names:nameArray
- listView contents:nameArray.
- workspace contents:nil.
-"
- inspectedObject notNil ifTrue:[
- inspectedObject removeDependent:self
- ].
-"
- inspectedObject := nil.
- inspectedValues := valueArray.
- selectedLine := nil
-!
-
-listView
- ^ listView
-! !
-
-!InspectorView methodsFor:'user interaction'!
-
keyPress:aKey x:x y:y
"all my input is passed on to the workspace-field"
@@ -400,77 +319,6 @@
]
!
-destroy
- inspectedObject notNil ifTrue:[
-"
- inspectedObject removeDependent:self.
-"
- inspectedObject := nil
- ].
- menu1 notNil ifTrue:[
- menu1 destroy. menu1 := nil.
- ].
- menu2 notNil ifTrue:[
- menu2 destroy. menu2 := nil.
- ].
- inspectedValues := nil.
- super destroy
-!
-
-valueAtLine:lineNr
- "helper - return the value of the selected entry"
-
- |index|
-
- inspectedValues notNil ifTrue:[
- ^ inspectedValues at:lineNr
- ].
-
- lineNr == 1 ifTrue:[
- ^ inspectedObject
- ].
- index := lineNr - 1. "/ skip self
- (inspectedObject class isVariable) ifFalse:[
- ^ inspectedObject instVarAt:index
- ].
- index <= (inspectedObject class instSize) ifTrue:[
- ^ inspectedObject instVarAt:index
- ].
- index := index - inspectedObject class instSize.
- ^ inspectedObject basicAt:index
-!
-
-showSelection:lineNr
- "user clicked on an instvar - show value in workspace"
-
- |val string index|
-
-"
- workspace contents:nil.
-"
- (hasMore and:[lineNr == listView list size]) ifTrue:[
- "clicked on the '...' entry"
- self showMore.
- listView selection:lineNr.
- ].
-
- (inspectedValues isNil
- and:[lineNr == 1]) ifTrue:[
- "selecting self also does a re-set, this allows updating the list"
- self inspect:inspectedObject.
- val := inspectedObject
- ] ifFalse:[
- val := self valueAtLine:lineNr
- ].
- string := val displayString.
-"
- workspace cursorToTop.
-"
- workspace replace:string.
-
- selectedLine := lineNr
-!
-
doAccept:theText
|value index|
@@ -478,57 +326,25 @@
evaluate:theText
receiver:inspectedObject
notifying:workspace.
- inspectedValues isNil ifTrue:[
- selectedLine notNil ifTrue:[
- selectedLine == 1 ifFalse:[
- index := selectedLine - 1.
- (inspectedObject class isVariable) ifFalse:[
+
+ selectedLine notNil ifTrue:[
+ selectedLine == 1 ifFalse:[
+ index := selectedLine - 1.
+ (inspectedObject class isVariable) ifFalse:[
+ inspectedObject instVarAt:index put:value
+ ] ifTrue:[
+ index <= (inspectedObject class instSize) ifTrue:[
inspectedObject instVarAt:index put:value
- ] ifTrue:[
- index <= (inspectedObject class instSize) ifTrue:[
- inspectedObject instVarAt:index put:value
- ] ifFalse:[
- index := index - inspectedObject class instSize.
- inspectedObject basicAt:index put:value
- ]
+ ] ifFalse:[
+ index := index - inspectedObject class instSize.
+ inspectedObject basicAt:index put:value
]
]
]
- ] ifFalse:[
- selectedLine notNil ifTrue:[
- inspectedValues at:selectedLine put:value
- ]
].
inspectedObject changed
!
-doInspect:basic
- "user selected inspect-menu entry"
-
- |objectToInspect|
-
- selectedLine notNil ifTrue:[
- objectToInspect := self valueAtLine:selectedLine.
- basic ifTrue:[
- objectToInspect basicInspect
- ] ifFalse:[
- objectToInspect inspect
- ]
- ]
-!
-
-doInspect
- "user selected inspect-menu entry"
-
- self doInspect:false
-!
-
-doBasicInspect
- "user selected inspect-menu entry"
-
- self doInspect:true
-!
-
inspectOwners
"open an inspector on owners of the inspectedObject.
(this is a secret function)"
@@ -569,3 +385,115 @@
dict inspect
]
! !
+
+!InspectorView methodsFor:'initialization'!
+
+mapped
+ "delayed setup of lists till map-time -
+ this makes startup of inspectors a bit faster"
+
+ |o|
+
+ super mapped.
+ "
+ kludge to trick inspect:, which ignores setting the
+ same object again ...
+ "
+ o := inspectedObject.
+ inspectedObject := nil.
+ self inspect:o
+!
+
+initialize
+ |v panel|
+
+ super initialize.
+
+ panel := VariableHorizontalPanel
+ origin:(0.0 @ 0.0)
+ corner:(1.0 @ 1.0)
+ in:self.
+
+ v := HVScrollableView
+ for:SelectionInListView
+ miniScrollerH:true
+ miniScrollerV:false
+ in:panel.
+ v origin:(0.0 @ 0.0) corner:(0.3 @ 1.0).
+
+ listView := v scrolledView.
+ listView action:[:lineNr | self showSelection:lineNr].
+ listView doubleClickAction:[:lineNr | self doInspect].
+ listView ignoreReselect:false.
+ listView model:self; menu:#fieldMenu.
+
+ v := HVScrollableView
+ for:CodeView
+ miniScrollerH:true
+ miniScrollerV:false
+ in:panel.
+ v origin:(0.3 @ 0.0) corner:(1.0 @ 1.0).
+ workspace := v scrolledView.
+
+ workspace acceptAction:[:theText | self doAccept:theText asString].
+
+ nShown := 100.
+ hasMore := false.
+!
+
+fieldMenu
+ |labels selectors|
+
+ hasMore ifTrue:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'show more'
+ ).
+
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ showMore
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+"/ '-'
+"/ 'owners'
+ ).
+
+ selectors := #(
+ doInspect
+ doBasicInspect
+"/ nil
+"/ inspectOwners
+ ).
+ ].
+
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
+! !
+
+!InspectorView methodsFor:'release'!
+
+release
+ "release inpected object. This is normally not needed,
+ since the garbage collector will find this memory alone.
+ However, if some applications keeps inspectors (for example,
+ the debugger does this), this would be freed very late."
+
+"
+ inspectedObject notNil ifTrue:[
+ inspectedObject removeDependent:self
+ ].
+"
+ inspectedObject := nil.
+ workspace doItAction:nil.
+ workspace contents:nil.
+ listView contents:nil
+! !
--- a/OCInspView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/OCInspView.st Tue Feb 28 22:57:00 1995 +0100
@@ -1,14 +1,4 @@
-"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
+'From Smalltalk/X, Version:2.10.4 on 28-feb-1995 at 2:12:01 am'!
InspectorView subclass:#OrderedCollectionInspectorView
instanceVariableNames:''
@@ -17,60 +7,55 @@
category:'Interface-Inspector'
!
-!OrderedCollectionInspectorView methodsFor:'user interaction'!
+!OrderedCollectionInspectorView methodsFor:'private'!
+
+fieldMenu
+ |labels selectors|
-showSelection:lineNr
- "user clicked on an instvar - show value in workspace"
-
- |val string|
+ hasMore ifTrue:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'remove'
+ '-'
+ 'show more'
+ ).
- workspace contents:nil.
- lineNr == 1 ifTrue:[
- "selecting self also does a re-set, this allows updating the list"
- self inspect:inspectedObject.
- val := inspectedObject
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ removeIndex
+ nil
+ showMore
+ ).
] ifFalse:[
- val := inspectedObject at:(lineNr - 1)
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'remove'
+"/ '-'
+"/ 'owners'
+ ).
+
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ removeIndex
+"/ nil
+"/ inspectOwners
+ ).
].
- string := val displayString.
- workspace paste:string.
- selectedLine := lineNr
+
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
!
-doAccept:theText
- |value|
-
- value := Compiler evaluate:theText
- receiver:inspectedObject
- notifying:workspace.
-
- inspectedValues isNil ifTrue:[
- selectedLine notNil ifTrue:[
- selectedLine == 1 ifFalse:[
- inspectedObject at:selectedLine - 1 put:value.
- inspectedObject changed
- ]
- ]
- ].
-!
-
-doInspect
- "user selected inspect-menu entry"
-
- selectedLine notNil ifTrue:[
- inspectedValues isNil ifTrue:[
- (selectedLine == 1) ifTrue:[
- inspectedObject inspect
- ] ifFalse:[
- (inspectedObject at:selectedLine - 1) inspect
- ]
- ].
- ]
-! !
-
-!OrderedCollectionInspectorView methodsFor:'private'!
-
-listOfNames
+fieldList
"return a list of names for the selectionlist. Leave hasMore as
true, if a '...' entry should be added."
@@ -80,9 +65,6 @@
(n > nShown) ifTrue:[
n := nShown.
hasMore := true.
- listView setMiddleButtonMenu:menu2.
- ] ifFalse:[
- listView setMiddleButtonMenu:menu1.
].
aList := OrderedCollection new:n+1.
aList add:'self'.
@@ -91,3 +73,57 @@
].
^ aList
! !
+
+!OrderedCollectionInspectorView methodsFor:'user interaction'!
+
+removeIndex
+ "remove selected item from the collection"
+
+ selectedLine == 1 ifFalse:[
+ inspectedObject removeIndex:selectedLine -1.
+ selectedLine := nil.
+ inspectedObject changed.
+ self inspect:inspectedObject. "force list update"
+ ]
+!
+
+valueAtLine:lineNr
+ "helper - return the value of the selected entry"
+
+ |index|
+
+ lineNr == 1 ifTrue:[
+ ^ inspectedObject
+ ].
+ index := lineNr - 1. "/ skip self
+ ^ inspectedObject at:index
+
+!
+
+doInspect
+ "user selected inspect-menu entry"
+
+ selectedLine notNil ifTrue:[
+ (selectedLine == 1) ifTrue:[
+ inspectedObject inspect
+ ] ifFalse:[
+ (inspectedObject at:selectedLine - 1) inspect
+ ].
+ ]
+!
+
+doAccept:theText
+ |value|
+
+ value := Compiler evaluate:theText
+ receiver:inspectedObject
+ notifying:workspace.
+
+ selectedLine notNil ifTrue:[
+ selectedLine == 1 ifFalse:[
+ inspectedObject at:selectedLine - 1 put:value.
+ inspectedObject changed
+ ]
+ ].
+! !
+
--- a/OldLauncher.st Fri Feb 24 18:00:43 1995 +0100
+++ b/OldLauncher.st Tue Feb 28 22:57:00 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.20 1995-02-06 01:00:03 claus Exp $
+$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.21 1995-02-28 21:56:59 claus Exp $
'!
!Launcher class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.20 1995-02-06 01:00:03 claus Exp $
+$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.21 1995-02-28 21:56:59 claus Exp $
"
!
@@ -584,15 +584,18 @@
"save an image into a file
- ask user for filename using a fileSelectionBox."
- |box|
+ |fileName|
- box := FileSelectionBox
- title:'save image in:'
- okText:'save'
- abortText:'cancel'
- action:[:fileName | anImage saveOn:fileName].
- box pattern:'*.tiff'.
- box showAtPointer
+ fileName := DialogView
+ requestFileName:'save image in:'
+ default:''
+ ok:'save'
+ abort:'abort'
+ pattern:'*.tiff'.
+
+ fileName notNil ifTrue:[
+ anImage saveOn:fileName
+ ].
!
closeDownViews
--- a/OrderedCollectionInspectorView.st Fri Feb 24 18:00:43 1995 +0100
+++ b/OrderedCollectionInspectorView.st Tue Feb 28 22:57:00 1995 +0100
@@ -1,14 +1,4 @@
-"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
+'From Smalltalk/X, Version:2.10.4 on 28-feb-1995 at 2:12:01 am'!
InspectorView subclass:#OrderedCollectionInspectorView
instanceVariableNames:''
@@ -17,60 +7,55 @@
category:'Interface-Inspector'
!
-!OrderedCollectionInspectorView methodsFor:'user interaction'!
+!OrderedCollectionInspectorView methodsFor:'private'!
+
+fieldMenu
+ |labels selectors|
-showSelection:lineNr
- "user clicked on an instvar - show value in workspace"
-
- |val string|
+ hasMore ifTrue:[
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'remove'
+ '-'
+ 'show more'
+ ).
- workspace contents:nil.
- lineNr == 1 ifTrue:[
- "selecting self also does a re-set, this allows updating the list"
- self inspect:inspectedObject.
- val := inspectedObject
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ removeIndex
+ nil
+ showMore
+ ).
] ifFalse:[
- val := inspectedObject at:(lineNr - 1)
+ labels := #(
+ 'inspect'
+ 'basicInspect'
+ '-'
+ 'remove'
+"/ '-'
+"/ 'owners'
+ ).
+
+ selectors := #(
+ doInspect
+ doBasicInspect
+ nil
+ removeIndex
+"/ nil
+"/ inspectOwners
+ ).
].
- string := val displayString.
- workspace paste:string.
- selectedLine := lineNr
+
+ ^ PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors
!
-doAccept:theText
- |value|
-
- value := Compiler evaluate:theText
- receiver:inspectedObject
- notifying:workspace.
-
- inspectedValues isNil ifTrue:[
- selectedLine notNil ifTrue:[
- selectedLine == 1 ifFalse:[
- inspectedObject at:selectedLine - 1 put:value.
- inspectedObject changed
- ]
- ]
- ].
-!
-
-doInspect
- "user selected inspect-menu entry"
-
- selectedLine notNil ifTrue:[
- inspectedValues isNil ifTrue:[
- (selectedLine == 1) ifTrue:[
- inspectedObject inspect
- ] ifFalse:[
- (inspectedObject at:selectedLine - 1) inspect
- ]
- ].
- ]
-! !
-
-!OrderedCollectionInspectorView methodsFor:'private'!
-
-listOfNames
+fieldList
"return a list of names for the selectionlist. Leave hasMore as
true, if a '...' entry should be added."
@@ -80,9 +65,6 @@
(n > nShown) ifTrue:[
n := nShown.
hasMore := true.
- listView setMiddleButtonMenu:menu2.
- ] ifFalse:[
- listView setMiddleButtonMenu:menu1.
].
aList := OrderedCollection new:n+1.
aList add:'self'.
@@ -91,3 +73,57 @@
].
^ aList
! !
+
+!OrderedCollectionInspectorView methodsFor:'user interaction'!
+
+removeIndex
+ "remove selected item from the collection"
+
+ selectedLine == 1 ifFalse:[
+ inspectedObject removeIndex:selectedLine -1.
+ selectedLine := nil.
+ inspectedObject changed.
+ self inspect:inspectedObject. "force list update"
+ ]
+!
+
+valueAtLine:lineNr
+ "helper - return the value of the selected entry"
+
+ |index|
+
+ lineNr == 1 ifTrue:[
+ ^ inspectedObject
+ ].
+ index := lineNr - 1. "/ skip self
+ ^ inspectedObject at:index
+
+!
+
+doInspect
+ "user selected inspect-menu entry"
+
+ selectedLine notNil ifTrue:[
+ (selectedLine == 1) ifTrue:[
+ inspectedObject inspect
+ ] ifFalse:[
+ (inspectedObject at:selectedLine - 1) inspect
+ ].
+ ]
+!
+
+doAccept:theText
+ |value|
+
+ value := Compiler evaluate:theText
+ receiver:inspectedObject
+ notifying:workspace.
+
+ selectedLine notNil ifTrue:[
+ selectedLine == 1 ifFalse:[
+ inspectedObject at:selectedLine - 1 put:value.
+ inspectedObject changed
+ ]
+ ].
+! !
+