"
COPYRIGHT (c) 1990 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.
"
"{ Package: 'stx:libtool' }"
StandardSystemView subclass:#ChangesBrowser
instanceVariableNames:'changeListView codeView changeFileName changeChunks
changePositions changeClassNames changeSelectors
changeHeaderLines changeIsFollowupMethodChange anyChanges
changeNrShown changeNrProcessed skipSignal autoCompare
changeFileSize changeFileTimestamp checkBlock changeTimeStamps
tabSpec autoUpdate editingClassSource lastSearchType
lastSearchString applyInOriginalNameSpace lastSaveFileName
readOnly enforcedPackage updateChangeSet'
classVariableNames:'CompressSnapshotInfo NoColoring ShowWarningDialogs DefaultIcon'
poolDictionaries:''
category:'Interface-Browsers'
!
!ChangesBrowser class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1990 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.
"
!
documentation
"
this implements a browser for the changes-file (actually, it can display
any sourceFiles contents).
See the extra document 'doc/misc/cbrowser.doc' for how to use this browser.
written jan 90 by claus
[Class variables:]
CompressSnapshotInfo if true (the default), snapshot entries
are also compressed in the compress function.
Some users prefer them to be not compressed.
Set it to false for this.
Notice:
this needs a total rewrite, to build up a changeSet from the file
(which did not exist when the ChangesBrowser was originally written)
and manipulate that changeSet.
This way, we get a browser for any upcoming incore changeSets for
free. Also, this will put the chunk analyzation code into Change and
subclasses (where it belongs) and give a better encapsulation and
overall structure. Do not take this as an example for good style ;-)
The Change hierarchy is currently been completed, and the changes browser
will be adapted soon.
[author:]
Claus Gittinger
[start with:]
ChangesBrowser open
[see also:]
( Using the ChangesBrowser :html: tools/cbrowser/TOP.html )
"
! !
!ChangesBrowser class methodsFor:'instance creation'!
new
"create a new changes browser"
^ super
label:(self defaultLabel)
icon:(self defaultIcon)
"Modified: / 6.2.1998 / 13:25:18 / cg"
!
openOn:aFileName
"create c changes browser on a change file"
^ ((self new label:(self defaultLabel , ': ', aFileName))
changeFileName:aFileName) open
"Modified: / 6.2.1998 / 13:27:19 / cg"
! !
!ChangesBrowser class methodsFor:'behavior'!
autoSelectNext
"returning true here, makes a Delete operation automatically
select the next change"
^ true
! !
!ChangesBrowser class methodsFor:'defaults'!
defaultIcon
"return the browsers default window icon"
<resource: #style (#ICON #ICON_FILE)>
|nm i|
(i := DefaultIcon) isNil ifTrue:[
i := self classResources at:'ICON' default:nil.
i isNil ifTrue:[
nm := ClassResources at:'ICON_FILE' default:'CBrowser.xbm'.
i := Smalltalk imageFromFileNamed:nm inPackage:#'stx:libtool'.
i isNil ifTrue:[
i := StandardSystemView defaultIcon
]
].
i notNil ifTrue:[
DefaultIcon := i := i onDevice:Display
]
].
^ i
"Modified: 19.3.1997 / 20:48:34 / ca"
"Modified: 18.4.1997 / 15:16:24 / cg"
!
defaultLabel
^ 'Changes Browser'
!
isVisualStartable
"return true, if this application can be started via #open.
(to allow start of a change browser via double-click in the browser)"
^ true
"Created: / 27.9.1999 / 12:28:27 / cg"
! !
!ChangesBrowser class methodsFor:'menu specs'!
menuSpec
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ChangesBrowser andSelector:#menuSpec
(Menu new fromLiteralArrayEncoding:(ChangesBrowser menuSpec)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Compress'
#translateLabel: true
#isVisible: #notEditingClassSource
#value: #doCompress
)
#(#MenuItem
#label: 'Compress for Class'
#translateLabel: true
#isVisible: #notEditingClassSource
#value: #doCompressClass
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Compare and Compress'
#translateLabel: true
#isVisible: #notEditingClassSource
#value: #doCompareAndCompress
)
#(#MenuItem
#label: '-'
#isVisible: #notEditingClassSource
)
#(#MenuItem
#label: 'Fileout && Delete All Changes for Class'
#translateLabel: true
#isVisible: #notEditingClassSource
#value: #doFileoutAndDeleteClassAll
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'CheckIn && Delete All Changes for Class'
#translateLabel: true
#isVisible: #notEditingClassSource
#value: #doCheckinAndDeleteClassAll
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: '-'
#isVisible: #notEditingClassSource
)
#(#MenuItem
#label: 'Save in...'
#translateLabel: true
#value: #doSave
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Save to End in...'
#translateLabel: true
#value: #doSaveRest
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Save for Class to End in...'
#translateLabel: true
#value: #doSaveClassRest
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Save All for Class in...'
#translateLabel: true
#value: #doSaveClassAll
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Writeback ClassFile'
#translateLabel: true
#isVisible: #editingClassSource
#value: #doWriteBack
)
#(#MenuItem
#label: 'Writeback ChangeFile'
#translateLabel: true
#isVisible: #notEditingClassSource
#value: #doWriteBack
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Update'
#translateLabel: true
#value: #doUpdate
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Exit'
#translateLabel: true
#value: #menuExit
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Change'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Apply'
#translateLabel: true
#value: #doApply
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Apply to End'
#translateLabel: true
#value: #doApplyRest
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Apply for Class to End'
#translateLabel: true
#value: #doApplyClassRest
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Apply All'
#translateLabel: true
#value: #doApplyAll
#enabled: #hasNoSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Delete'
#translateLabel: true
#value: #doDelete
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Delete to End'
#translateLabel: true
#value: #doDeleteRest
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Delete for Class to End'
#translateLabel: true
#value: #doDeleteClassRest
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Delete for Class from Begin'
#translateLabel: true
#value: #doDeleteClassFromBeginning
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: 'Delete All for Class'
#translateLabel: true
#isVisible: #hasNoMultiSelection
#value: #doDeleteClassAll
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Delete All for Class && its private Classes'
#translateLabel: true
#isVisible: #hasNoMultiSelection
#value: #doDeleteClassAndPrivateClassesAll
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Delete All for Classes'
#translateLabel: true
#isVisible: #hasMultiSelection
#value: #doDeleteClassAll
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Delete All for Classes && their private Classes'
#translateLabel: true
#isVisible: #hasMultiSelection
#value: #doDeleteClassAndPrivateClassesAll
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Compare with Current'
#translateLabel: true
#value: #doCompare
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Make Change a Patch'
#translateLabel: true
#value: #doMakePatch
#enabled: #hasSelection
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Search'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Class...'
#translateLabel: true
#value: #findClass
)
#(#MenuItem
#label: 'Previous for Class'
#translateLabel: true
#value: #findPreviousForClass
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Next for Class'
#translateLabel: true
#value: #findNextForClass
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Selector...'
#translateLabel: true
#value: #findSelector
)
#(#MenuItem
#label: 'Previous for Selector'
#translateLabel: true
#value: #findPreviousForSelector
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Next for Selector'
#translateLabel: true
#value: #findNextForSelector
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'String...'
#translateLabel: true
#value: #findString
)
#(#MenuItem
#label: 'Previous with String'
#translateLabel: true
#value: #findPreviousForString
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Next with String'
#translateLabel: true
#value: #findNextForString
#enabled: #hasSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Previous Snapshot'
#translateLabel: true
#value: #findPreviousSnapshot
#enabled: #hasSelection
)
#(#MenuItem
#label: 'Next Snapshot'
#translateLabel: true
#value: #findNextSnapshot
#enabled: #hasSelection
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Browse'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Class'
#translateLabel: true
#value: #doBrowse
#enabled: #hasSingleSelection
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Senders...'
#translateLabel: true
#value: #doBrowseSenders
)
#(#MenuItem
#label: 'Implementors...'
#translateLabel: true
#value: #doBrowseImplementors
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Settings'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Auto Compare'
#translateLabel: true
#indication: #autoCompare
)
#(#MenuItem
#label: 'Auto Update'
#translateLabel: true
#indication: #autoUpdate
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Add Applies to ChangeSet...'
#translateLabel: true
#indication: #updateChangeSet
)
#(#MenuItem
#label: 'Apply in Original NameSpace'
#translateLabel: true
#indication: #applyInOriginalNameSpace
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Apply into Package...'
#translateLabel: true
#value: #setEnforcedPackage
)
)
nil
nil
)
)
#(#MenuItem
#label: 'Help'
#translateLabel: true
#startGroup: #right
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'ChangesBrowser Documentation'
#translateLabel: true
#value: #openHTMLDocument:
#argument: 'tools/cbrowser/TOP.html'
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'About ChangesBrowser...'
#translateLabel: true
#value: #openAboutThisApplication
)
)
nil
nil
)
)
)
nil
nil
)
! !
!ChangesBrowser methodsFor:'aspects'!
applyInOriginalNameSpace
^ applyInOriginalNameSpace
!
autoCompare
^ autoCompare
!
autoUpdate
"enabled/disable automatic update from the change-file (for monitoring)"
^ autoUpdate
"Created: 3.12.1995 / 14:14:24 / cg"
"Modified: 3.12.1995 / 14:20:45 / cg"
!
editingClassSource
^ editingClassSource ? false
!
hasMultiSelection
^ self hasSelection and:[self hasSingleSelection not]
!
hasNoMultiSelection
^ self hasMultiSelection not
!
hasNoSelection
^ self hasSelection not
!
hasSelection
^ changeListView hasSelection
!
hasSingleSelection
changeListView multipleSelectOk ifTrue:[
^ changeListView selection size == 1
].
^ changeListView hasSelection
!
notEditingClassSource
^ self editingClassSource not
!
notEditingClassSourceAndNotReadOnly
^ (self editingClassSource or:[readOnly == true]) not
!
notReadOnly
^ (readOnly ~~ true)
!
readOnly:aBoolean
readOnly := aBoolean
!
theSingleSelection
|sel|
sel := changeListView selection.
changeListView multipleSelectOk ifTrue:[
sel size == 1 ifTrue:[
^ sel first
].
^ nil
].
^ sel.
!
updateChangeSet
^ updateChangeSet
! !
!ChangesBrowser methodsFor:'compiler interface'!
wantChangeLog
"sent by the compiler to ask if a changeLog entry should
be written when compiling. Return false here."
^ false
! !
!ChangesBrowser methodsFor:'compiler interface - error handling'!
correctableError:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of an error - this should really not happen since
changes ought to be correct (did someone edit the changes file ??).
Show the bad change in the codeView and let codeView hilight the error;
no corrections allowed here therefore return false"
ShowWarningDialogs == true ifTrue:[
self error:aString position:relPos to:relEndPos from:aCompiler.
] ifFalse:[
Transcript showCR:aString.
].
^ false
!
correctableSelectorWarning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of a warning"
^ false
"Modified: / 19.1.2000 / 16:25:31 / cg"
"Created: / 19.1.2000 / 16:27:23 / cg"
!
error:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of an error - this should really not happen since
changes ought to be correct (did someone edit the changes file ??).
Show the bad change in the codeView and let codeView hilight the error"
|action|
(changeNrProcessed ~~ changeNrShown) ifTrue:[
self changeSelection:changeNrProcessed
].
(skipSignal notNil) ifTrue:[
codeView highlightingErrorPosition:relPos to:relEndPos do:[
|box|
"
start dialog - make certain cleanup is done
"
action := OptionBox
request:aString
label:'Error'
form:(WarningBox iconBitmap)
buttonLabels:#('cancel' 'skip' " 'shut up' " 'continue')
values:#(#abort #skip " #shutUp " #continue)
default:#continue
onCancel:#abort.
].
"/ action == #shutUp ifTrue:[
"/ aCompiler ignoreWarnings.
"/ ^ false
"/ ].
(action == #abort) ifTrue:[
Object abortSignal raise.
^ false
].
action == #skip ifTrue:[
skipSignal raise.
^ false
].
^ false
].
^ codeView error:aString position:relPos to:relEndPos from:aCompiler
"Modified: 20.2.1996 / 20:47:59 / cg"
!
unusedVariableWarning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a (or some) unused variables;
hilight the error (relPos to relEndPos) and show a Box asking for continue/correct/abort;
this method should return true to the compiler if user wants the error
to be corrected; false otherwise"
^ false
!
warning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifys us of a warning - ignore it"
^ self
! !
!ChangesBrowser methodsFor:'event handling'!
handlesKeyPress:key inView:view
"this method is reached via delegation: are we prepared to handle
a keyPress in some other view ?"
<resource: #keyboard (#Delete #BackSpace #Accept #Find #FindPrev #FindNext)>
view == changeListView ifTrue:[
(key == #Delete
or:[key == #BackSpace
or:[key == #Accept
or:[key == #Find
or:[key == #FindPrev
or:[key == #FindNext]]]]]) ifTrue:[^ true].
].
^ false
"Modified: 8.4.1997 / 11:01:42 / cg"
!
keyPress:key x:x y:y view:view
"this method is reached via delegation from the changeListView"
<resource: #keyboard (#Delete #BackSpace #Accept #Find #FindPrev #FindNext)>
(key == #Delete) ifTrue:[
self doDelete.
^ self
].
(key == #BackSpace) ifTrue:[
self doDeleteAndSelectPrevious.
^ self
].
(key == #Accept) ifTrue:[
self doApply.
^ self
].
(key == #Find) ifTrue:[
self findClass.
^ self
].
(key == #FindPrev) ifTrue:[
self findPrevious.
^ self
].
(key == #FindNext) ifTrue:[
self findNext.
^ self
].
changeListView keyPress:key x:x y:y
"Modified: / 18.6.1998 / 22:15:36 / cg"
! !
!ChangesBrowser methodsFor:'help '!
showActivity:someMessage
"some activityNotification to be forwarded to the user;
show it in the windows title area here."
self label:someMessage
"Created: 24.2.1996 / 19:35:42 / cg"
"Modified: 23.4.1996 / 21:39:36 / cg"
! !
!ChangesBrowser methodsFor:'initialize / release'!
autoCompareChanged
"sent from the compare-toggle"
autoCompare value ifTrue:[
tabSpec positions:#(0 0.15 5 8.5 ).
self doUpdate
] ifFalse:[
"/
"/ set tabs to hide compare-column
"/
tabSpec positions:#(-1 0 5 8.5 ).
changeListView invalidate. "/ clear; redraw.
]
!
changeListMenu
"return the menu for the change (upper) list"
<resource: #keyboard ( #Accept #Delete ) >
<resource: #programMenu >
|items m replNext replPrev sel|
self sensor ctrlDown ifTrue:[
"/ notice - findNext/prev shortKeys will search for the same thing again.
items := #(
('Search Class...' findClass #Find )
('Previous for this Class' findPreviousForClass #FindPrevClass )
('Next for this Class' findNextForClass #FindNextClass )
('-' )
('Search Selector...' findSelector )
('Previous with this Selector' findPreviousForSelector #FindPrevSelector )
('Next with this Selector' findNextForSelector #FindNextSelector )
('-' )
('Search String...' findString )
('Previous with this String' findPreviousForString #FindPrevString )
('Next with this String' findNextForString #FindNextString )
('-' )
('Previous Snapshot' findPreviousSnapshot #FindPrevSnapshot )
('Next Snapshot' findNextSnapshot #FindNextSnapshot )
).
lastSearchType == #selector ifTrue:[
replNext := #FindNextSelector.
replPrev := #FindPrevSelector.
] ifFalse:[
lastSearchType == #snapshot ifTrue:[
replNext := #FindNextSnapshot.
replPrev := #FindPrevSnapshot.
] ifFalse:[
lastSearchType == #string ifTrue:[
replNext := #FindNextString.
replPrev := #FindPrevString.
] ifFalse:[
replNext := #FindNextClass.
replPrev := #FindPrevClass.
]
]
].
items := items deepCopy.
items do:[:each |
each replaceAll:replNext with:#FindNext.
each replaceAll:replPrev with:#FindPrev.
each replaceAny:#(FindNextClass FindPrevClass
FindNextSelector FindPrevSelector
FindNextSnapshot FindPrevSnapshot
FindNextString FindPrevString)
with:nil.
].
^ PopUpMenu itemList:items resources:resources.
].
items := #(
('Apply' doApply Accept)
('Apply to End' doApplyRest )
('Apply for Class to End' doApplyClassRest )
('Apply All' doApplyAll )
('-' )
('Delete' doDelete Delete)
('Delete to End' doDeleteRest )
('Delete for Class to End' doDeleteClassRest )
('Delete for Class from Begin' doDeleteClassFromBeginning )
).
(self hasSelection and:[self hasSingleSelection not]) ifTrue:[
items := items ,
#(
('Delete All for Classes' doDeleteClassAll )
('Delete All for Classes & their private Classes' doDeleteClassAndPrivateClassesAll )
).
] ifFalse:[
items := items ,
#(
('Delete All for Class' doDeleteClassAll )
('Delete All for Class & its private Classes' doDeleteClassAndPrivateClassesAll )
).
].
items := items ,
#(
('-' )
('Compress' doCompress )
('Compress for Class' doCompressClass )
('Compare and Compress' doCompareAndCompress )
('-' )
('Compare with current Version' doCompare )
('Browse Class' doBrowse )
('-' )
('Make Change a Patch' doMakePatch )
).
editingClassSource ifFalse:[
items := items , #(
('Fileout & Delete All for Class' doFileoutAndDeleteClassAll )
('CheckIn & Delete All for Class' doCheckinAndDeleteClassAll )
)
].
items := items , #(
('-' )
('Save in...' doSave )
('Save to End in...' doSaveRest )
('Save for Class to End in...' doSaveClassRest )
('Save All for Class in...' doSaveClassAll )
('-' )
).
editingClassSource ifTrue:[
items := items , #(
('Writeback ClassFile' doWriteBack )
)
] ifFalse:[
items := items , #(
('Writeback ChangeFile' doWriteBack )
)
].
items := items , #(
('-' )
('Update' doUpdate )
).
m := PopUpMenu itemList:items resources:resources.
"/
"/ disable those that require a selected entry
"/
self hasSelection ifFalse:[
m disableAll:#(doApply doApplyClassRest doApplyRest doDelete doDeleteRest doDeleteClassRest
doDeleteClassFromBeginning doDeleteClassAll doDeleteClassAndPrivateClassesAll
doCompare doCompressClass doMakePatch doSaveChangeInFile doMakePermanent
doSave doSaveRest doSaveClassAll doSaveClassRest doBrowse
doFileoutAndDeleteClassAll doCheckinAndDeleteClassAll)
] ifTrue:[
sel := self theSingleSelection.
sel isNil ifTrue:[
"/ multiple selections
m disableAll:#(doApplyClassRest doApplyRest doDeleteClassRest doDeleteRest
doDeleteClassFromBeginning
doCompressClass doCompare
doSaveClassAll doSaveClassRest doSaveRest doBrowse
doFileoutAndDeleteClassAll doCheckinAndDeleteClassAll)
] ifFalse:[
(self classNameOfChange:sel) isNil ifTrue:[
m disableAll:#(doApplyClassRest doDeleteClassRest
doDeleteClassFromBeginning doDeleteClassAll doDeleteClassAndPrivateClassesAll
doCompressClass doCompare doMakePatch
doSaveClassAll doSaveClassRest doBrowse
doFileoutAndDeleteClassAll doCheckinAndDeleteClassAll)
]
]
].
"/
"/ disable those that do not make sense with autoUpdate
"/ ('cause this would be overwritten by next update operation)
"/
autoUpdate value ifTrue:[
m disableAll:#(doDelete doDeleteRest doDeleteClassRest doDeleteClassAll
doDeleteClassAndPrivateClassesAll doCompress
doFileoutAndDeleteClassAll doCheckinAndDeleteClassAll
doWriteBack)
].
readOnly == true ifTrue:[
m disableAll:#(doDelete doDeleteRest doDeleteClassRest doDeleteClassAll
doDeleteClassAndPrivateClassesAll doCompress
doFileoutAndDeleteClassAll doCheckinAndDeleteClassAll
doWriteBack doSaveBack doUpdate
doApplyAll doApplyRest)
].
self hasSelection ifTrue:[
m disable:#doApplyAll
].
^ m
"Modified: / 6.9.1995 / 17:14:22 / claus"
"Modified: / 22.8.1998 / 15:50:17 / cg"
!
destroy
"destroy the receiver; make certain, that boxes are destroyed too"
Processor removeTimedBlock:checkBlock.
ObjectMemory removeDependent:self.
super destroy
!
focusSequence
^ Array with:changeListView with:codeView
!
initialize
|panel v upperFrame buttonPanel menuPanel mH
checkBox protectExistingMethods oldStyle|
"/ oldStyle := true.
oldStyle := false.
super initialize.
changeFileName := ObjectMemory nameForChanges. "/ 'changes'.
autoCompare := false asValue.
autoCompare onChangeSend:#autoCompareChanged to:self.
autoUpdate := false asValue.
applyInOriginalNameSpace := true asValue.
updateChangeSet := false asValue.
"
checkBlock is executed by the Processor.
We use #pushEvent: to perform the update
in our windowgroups process.
"
checkBlock := [self pushEvent:#checkIfFileHasChanged].
oldStyle ifFalse:[
menuPanel := MenuPanel in:self.
"/ menuPanel level:1.
menuPanel verticalLayout:false.
menuPanel receiver:self.
menuPanel menu:(self pullDownMenu).
mH := menuPanel preferredExtent y.
menuPanel origin:(0.0 @ 0.0) corner:(1.0 @ (mH)).
mH := mH + 1.
] ifTrue:[
mH := 0.0
].
panel := VariableVerticalPanel origin:(0.0 @ mH)
corner:(1.0 @ 1.0)
borderWidth:0
in:self.
upperFrame := panel.
oldStyle ifTrue:[
upperFrame := VariableHorizontalPanel origin:(0.0 @ 0.0) corner:(1.0 @ 0.3) in:panel.
].
v := HVScrollableView for:SelectionInListView miniScrollerH:true in:upperFrame.
oldStyle ifTrue:[
v origin:(0.0 @ 0.0) corner:(0.75 @ 1.0).
] ifFalse:[
v origin:(0.0 @ 0.0) corner:(1.0 @ 0.3).
].
changeListView := v scrolledView.
changeListView delegate:self.
changeListView menuHolder:self; menuPerformer:self; menuMessage:#changeListMenu.
changeListView doubleClickAction:[:line | self doubleClickOnChange:line].
oldStyle ifFalse:[
changeListView multipleSelectOk:true.
].
oldStyle ifTrue:[
buttonPanel := VerticalPanelView in:upperFrame.
buttonPanel origin:(0.75 @ 0.0) corner:(1.0 @ 1.0).
buttonPanel verticalLayout:#topSpace; horizontalLayout:#leftSpace.
checkBox := CheckBox new model:autoCompare.
checkBox label:(resources string:'Auto Compare').
checkBox action:[:val | autoCompare value:val].
buttonPanel addSubView:checkBox.
checkBox := CheckBox new model:autoUpdate.
checkBox label:(resources string:'Auto Update').
checkBox action:[:val | autoUpdate value:val].
buttonPanel addSubView:checkBox.
checkBox := CheckBox new.
checkBox label:(resources string:'Apply in original NameSpace' withCRs).
checkBox model:applyInOriginalNameSpace.
buttonPanel addSubView:checkBox.
].
"/ protectExistingMethods := CheckBox new.
"/ protectExistingMethods label:(resources string:'Protect existing code' withCRs).
"/ protectExistingMethods model:protectExistingMethods.
"/ buttonPanel addSubView:protectExistingMethods.
v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:panel.
v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
codeView := v scrolledView.
codeView readOnly:true.
anyChanges := false.
ObjectMemory addDependent:self. "to get shutdown-update"
tabSpec := TabulatorSpecification new.
tabSpec unit:#inch.
tabSpec positions:#(-1 0 5 8.5 ).
" +/- cls>>sel type info"
tabSpec align: #(#left #left #left #left).
"Modified: / 27.3.1997 / 11:07:07 / stefan"
"Modified: / 11.10.2001 / 21:20:48 / cg"
!
postRealize
self readChangesFileInBackground:true.
self setChangeList.
changeListView action:[:lineNr | self changeSelection:lineNr].
Processor addTimedBlock:checkBlock afterSeconds:5.
"Created: 24.7.1997 / 18:06:12 / cg"
!
pullDownMenu
"return the top (pullDown) menu"
<resource: #programMenu>
|m|
m := self class menuSpec.
m := m decodeAsLiteralArray.
m receiver:self.
m findGuiResourcesIn:self.
^ m.
!
update:what with:aParameter from:changedObject
|box|
(what == #aboutToExit) ifTrue:[
"
smalltalk is about to shut down -
- if change list was modified, ask user and save if requested.
"
anyChanges ifTrue:[
self raiseDeiconified.
box := YesNoBox new.
box title:('The modified changelist has not been written back to the change file.\\Write change file before exiting ?') withCRs.
box okText:(resources at:'write') noText:(resources at:'don''t write').
box yesAction:[self writeBackChanges]
noAction:[].
box showAtPointer.
box destroy
].
^ self
].
super update:what
"Created: / 15.6.1996 / 15:26:30 / cg"
"Modified: / 7.1.1997 / 23:03:47 / cg"
"Modified: / 24.8.1999 / 09:45:06 / stefan"
! !
!ChangesBrowser methodsFor:'menu actions'!
menuExit
self closeRequest
!
openAboutThisApplication
"opens an about box for this application."
|rev box myClass clsRev image msg|
rev := ''.
myClass := self class.
(clsRev := myClass revision) notNil ifTrue: [rev := ' (rev: ', clsRev printString, ')'].
msg := '\' withCRs , myClass name asBoldText, rev.
AboutBox isNil ifTrue:[
"/ this handles bad installations of ST/X,
"/ where the AboutBox is missing.
"/ (May vanish in the future)
^ self information:msg
].
box := AboutBox title:msg.
image := self class defaultIcon.
image notNil ifTrue:[
box image:image
].
box label:'About This Application'.
box autoHideAfter:10 with:[].
box showAtPointer.
"Modified: / 14.8.1998 / 13:20:24 / cg"
!
openHTMLDocument:relativeDocPath
HTMLDocumentView openFullOnDocumentationFile:relativeDocPath
!
showAboutSTX
ToolApplicationModel openAboutSTX
! !
!ChangesBrowser methodsFor:'private'!
autoSelect:changeNr
"select a change"
self class autoSelectNext ifTrue:[
(changeNr <= self numberOfChanges) ifTrue:[
changeListView setSelection:changeNr.
self changeSelection:changeNr.
^ self
]
].
self clearCodeView.
changeListView setSelection:nil.
"Modified: / 18.5.1998 / 14:26:43 / cg"
!
autoSelectLast
"select the last change"
self autoSelect:(self numberOfChanges)
!
autoSelectOrEnd:changeNr
"select the next change or the last"
|last|
last := self numberOfChanges.
changeNr < last ifTrue:[
self autoSelect:changeNr
] ifFalse:[
changeListView setSelection:last .
self changeSelection:last.
]
"Modified: 25.5.1996 / 12:26:17 / cg"
!
checkClassIsLoaded:aClass
"check for and warn if a class is unloaded (helper for compare-change)"
|cls answer|
aClass isMeta ifTrue:[
cls := aClass soleInstance
] ifFalse:[
cls := aClass
].
cls isLoaded ifFalse:[
(self confirm:(resources
string:'%1 is an autoloaded class.\I can only compare the methods source if its loaded first.\\Shall the class be loaded now ?'
with:cls name allBold) withCRs)
ifFalse:[
AbortSignal raise
].
cls autoload
].
^ cls isLoaded
"Created: 12.12.1995 / 14:04:39 / cg"
"Modified: 12.12.1995 / 14:11:05 / cg"
!
clearCodeView
"clear the (lower) code view."
self unselect "changeListView deselect".
codeView contents:nil.
changeNrShown := nil
!
contractClass:className selector:selector to:maxLen
"contract a class>>selector string (for display in the changeList)."
|s l|
s := className , ' ', selector.
s size > maxLen ifTrue:[
l := maxLen - 1 - selector size max:20.
s := (className contractTo:l) , ' ' , selector.
s size > maxLen ifTrue:[
l := maxLen - 1 - className size max:20.
s := className , ' ', (selector contractTo:l).
s size > maxLen ifTrue:[
s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2)
]
]
].
^ s
!
isChangeSetBrowser
^ false
!
newLabel:how
|l|
(changeFileName ~= 'changes') ifTrue:[
l := self class defaultLabel , ': ', changeFileName
] ifFalse:[
l := self class defaultLabel
].
l := l , ' ' , how.
self label:l
"Created: / 8.9.1995 / 19:32:04 / claus"
"Modified: / 8.9.1995 / 19:39:29 / claus"
"Modified: / 6.2.1998 / 13:27:01 / cg"
!
queryCloseText
"made this a method for easy redefinition in subclasses"
^ 'Quit without updating changeFile ?'
!
setChangeList
"extract type-information from changes and stuff into top selection
view"
changeListView setList:changeHeaderLines expandTabs:false redraw:false.
changeListView invalidate.
"/ changeListView deselect.
"Modified: / 18.5.1998 / 14:29:10 / cg"
!
setSingleSelection:changeNr
changeListView multipleSelectOk ifFalse:[
changeListView setSelection:changeNr.
] ifTrue:[
changeListView setSelection:(Array with:changeNr).
].
!
showNotFound
|savedCursor|
savedCursor := cursor.
[
self cursor:(Cursor cross).
self beep.
Delay waitForMilliseconds:300.
] valueNowOrOnUnwindDo:[
self cursor:savedCursor
]
"Modified: / 29.4.1999 / 22:36:54 / cg"
!
unselect
"common unselect"
changeListView setSelection:nil.
"Modified: 25.5.1996 / 13:02:49 / cg"
!
withSelectedChangesDo:aBlock
"just a helper, check for a selected change and evaluate aBlock
with busy cursor"
self withSelectedChangesInOrder:nil do:aBlock
!
withSelectedChangesInOrder:order do:aBlock
"just a helper, check for a selected change and evaluate aBlock
with busy cursor"
|changeNrSelection|
changeNrSelection := changeListView selection.
changeListView multipleSelectOk ifFalse:[
changeNrSelection notNil ifTrue:[
self withExecuteCursorDo:[
aBlock value:changeNrSelection
]
]
] ifTrue:[
changeNrSelection size > 0 ifTrue:[
self withExecuteCursorDo:[
|changeNumbers|
changeNumbers := changeNrSelection copy sort.
order == #reverse ifTrue:[
changeNumbers reverse
].
changeNumbers do:aBlock
]
]
].
!
withSelectedChangesReverseDo:aBlock
"just a helper, check for a selected change and evaluate aBlock
with busy cursor"
self withSelectedChangesInOrder:#reverse do:aBlock
! !
!ChangesBrowser methodsFor:'private-change access'!
changeIsFollowupMethodChange:changeNr
"return true, if a change is a followup change (i.e. a followup change
in a bunch of methodsFor-changes)"
^ changeIsFollowupMethodChange at:changeNr
"Created: / 6.2.1998 / 13:03:39 / cg"
!
changeIsSnapShotInfo:changeNr
"return true, if a change is a snapShot info chunk"
|words chunk|
(self classNameOfChange:changeNr) isNil ifTrue:[
"
get the chunk
"
chunk := changeChunks at:changeNr.
"mhmh - empty ??"
chunk notNil ifTrue:[
(chunk startsWith:'''---') ifTrue:[
words := chunk asCollectionOfWords.
words size > 2 ifTrue:[
(words at:2) = 'snapshot' ifTrue:[
^ true
].
].
].
].
].
^ false
!
classNameOfChange:changeNr
"return the classname of a change
(for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)"
|name|
name := changeClassNames at:changeNr.
name isNil ifTrue:[
name := self fullClassNameOfChange:changeNr.
].
name isNil ifTrue:[^ nil].
(name endsWith:' class') ifTrue:[
^ name copyWithoutLast:6
].
^ name
"Modified: 6.12.1995 / 17:06:31 / cg"
!
extractSelectorOfMethodChange:changeNr
"return a method-changes selector, or nil if its not a methodChange"
|source parser sel chunk aParseTree |
source := self sourceOfMethodChange:changeNr.
source isNil ifTrue:[
(self classNameOfChange:changeNr) notNil ifTrue:[
chunk := changeChunks at:changeNr.
chunk isNil ifTrue:[^ nil]. "mhmh - empty"
aParseTree := Parser parseExpression:chunk.
(aParseTree isNil
or:[aParseTree == #Error
or:[aParseTree isMessage not]]) ifTrue:[
^ nil "seems strange ... (could be a comment)"
].
sel := aParseTree selector.
(#(
#'removeSelector:'
) includes:sel) ifTrue:[
sel := aParseTree arguments at:1.
sel isConstant ifTrue:[
sel := sel evaluate.
sel isSymbol ifTrue:[
^ sel
]
]
]
].
^ nil
].
parser := Parser
parseMethodArgAndVarSpecification:source
in:nil
ignoreErrors:true
ignoreWarnings:true
parseBody:false.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
sel := parser selector.
].
^ sel
"Created: 24.11.1995 / 14:30:46 / cg"
"Modified: 5.9.1996 / 17:12:50 / cg"
!
fullClassNameOfChange:changeNr
"return the full classname of a change
(for classChanges (i.e. xxx class), a string ending in ' class' is returned.
- since parsing ascii methods is slow, keep result cached in
changeClassNames for the next query"
|chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr
words changeStream fullParseTree ownerTree ownerName oldDollarSetting|
changeNr isNil ifTrue:[^ nil].
"
first look, if not already known
"
"/ name := changeClassNames at:changeNr.
name notNil ifTrue:[^ name].
prevMethodDefNr := changeNr.
[changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[
prevMethodDefNr := prevMethodDefNr - 1.
].
"
get the chunk
"
chunk := changeChunks at:prevMethodDefNr.
chunk isNil ifTrue:[^ nil]. "mhmh - empty"
(chunk startsWith:'''---') ifTrue:[
words := chunk asCollectionOfWords.
words size > 2 ifTrue:[
(words at:2) = 'checkin' ifTrue:[
name := words at:3.
changeClassNames at:changeNr put:name.
^ name
]
].
].
"/ fix it - otherwise, it cannot be parsed
(chunk endsWith:'primitiveDefinitions:') ifTrue:[
chunk := chunk , ''''''
].
(chunk endsWith:'primitiveFunctions:') ifTrue:[
chunk := chunk , ''''''
].
(chunk endsWith:'primitiveVariables:') ifTrue:[
chunk := chunk , ''''''
].
"
use parser to construct a parseTree
"
oldDollarSetting := Parser allowDollarInIdentifier.
[
Parser allowDollarInIdentifier:true.
Class nameSpaceQuerySignal answer:Smalltalk
do:[
aParseTree := Parser parseExpression:chunk.
].
aParseTree == #Error ifTrue:[
(chunk includesString:'comment') ifTrue:[
"/ could be a comment ...
aParseTree := Parser parseExpression:chunk , ''''.
]
].
] valueNowOrOnUnwindDo:[
Parser allowDollarInIdentifier:oldDollarSetting
].
(aParseTree isNil or:[aParseTree == #Error]) ifTrue:[
^ nil "seems strange ... (could be a comment)"
].
aParseTree isMessage ifFalse:[
^ nil "very strange ... (whats that ?)"
].
"
ask parser for selector
"
sel := aParseTree selector.
recTree := aParseTree receiver.
"
is it a method-change, methodRemove or comment-change ?
"
(#(#'methodsFor:'
#'privateMethodsFor:'
#'protectedMethodsFor:'
#'ignoredMethodsFor:'
#'publicMethodsFor:'
#'removeSelector:'
#'comment:'
#'primitiveDefinitions:'
#'primitiveFunctions:'
#'primitiveVariables:'
#'renameCategory:to:'
#'instanceVariableNames:'
#'methodsFor:stamp:' "/ Squeak support
#'commentStamp:prior:' "/ Squeak support
#'addClassVarName:' "/ Squeak support
#methodsFor "/ Dolphin support
#methods "/ STV support
) includes:sel) ifTrue:[
"
yes, the className is the receiver
"
(recTree notNil and:[recTree ~~ #Error]) ifTrue:[
isMeta := false.
recTree isUnaryMessage ifTrue:[
(recTree selector ~~ #class) ifTrue:[^ nil].
"id class methodsFor:..."
recTree := recTree receiver.
isMeta := true.
].
recTree isPrimary ifTrue:[
name := recTree name.
isMeta ifTrue:[
name := name , ' class'.
].
changeClassNames at:changeNr put:name.
^ name
]
].
"more strange things"
^ nil
].
"
is it a change in a class-description ?
"
(('subclass:*' match:sel)
or:[('variable*ubclass:*' match:sel)]) ifTrue:[
"/ must parse the full changes text, to get
"/ privacy information.
changeStream := self streamForChange:changeNr.
changeStream notNil ifTrue:[
chunk := changeStream nextChunk.
changeStream close.
fullParseTree := Parser parseExpression:chunk.
(fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[
fullParseTree := nil
] ifFalse:[
fullParseTree isMessage ifFalse:[
fullParseTree := nil
]
].
"/ actually, the nil case cannot happen
fullParseTree notNil ifTrue:[
aParseTree := fullParseTree.
sel := aParseTree selector.
].
].
arg1Tree := aParseTree arg1.
(arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[
name := arg1Tree value asString.
"/ is it a private-class ?
('*privateIn:' match:sel) ifTrue:[
ownerTree := aParseTree args last.
ownerName := ownerTree name asString.
name := ownerName , '::' , name
].
changeClassNames at:changeNr put:name.
^ name
].
"very strange"
^ nil
].
"
is it a class remove ?
"
(sel == #removeClass:) ifTrue:[
(recTree notNil
and:[recTree ~~ #Error
and:[recTree isPrimary
and:[recTree name = 'Smalltalk']]]) ifTrue:[
arg1Tree := aParseTree arg1.
(arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[
name := arg1Tree name.
changeClassNames at:changeNr put:name.
^ name
].
]
].
"
is it a method category change ?
"
((sel == #category:)
or:[sel == #privacy:]) ifTrue:[
(recTree notNil
and:[recTree ~~ #Error
and:[recTree isMessage
and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[
isMeta := false.
recTree := recTree receiver.
recTree isUnaryMessage ifTrue:[
(recTree selector ~~ #class) ifTrue:[^ nil].
"id class "
recTree := recTree receiver
].
recTree isPrimary ifTrue:[
isMeta ifTrue:[
name := name , ' class'.
].
name := recTree name.
changeClassNames at:changeNr put:name.
^ name
]
]
].
^ nil
"Modified: / 13.2.2000 / 15:05:28 / cg"
!
numberOfChanges
^ changePositions size
"Created: 3.12.1995 / 18:15:39 / cg"
!
ownerClassNameOfChange:changeNr
"return the owner classname of a change
For a normal class, this is the className;
for a private class, this is the name of the owning class"
|name ns idx cls|
name := self classNameOfChange:changeNr.
name isNil ifTrue:[^ nil].
cls := Smalltalk at:name asSymbol.
(cls notNil and:[cls isBehavior]) ifTrue:[
cls owningClass notNil ifTrue:[
^ cls owningClass name
].
^ cls name
].
"/ (name includes:$:) ifTrue:[
"/ idx := name indexOf:$:.
"/ ns := name copyTo:idx-1.
"/ ns := Smalltalk at:ns asSymbol.
"/ ns notNil ifTrue:[
"/
"/ ].
"/
"/ name := name copyFrom:idx+2.
"/ (Smalltalk at:ns asSymbol) notNil ifTrue:[
"/ cls
"/ ].
"/ ^ name copyWithoutLast:6
"/ ].
^ name
"Modified: 6.12.1995 / 17:06:31 / cg"
!
selectorOfMethodChange:changeNr
"return a method-changes selector, or nil if its not a methodChange"
|sel |
changeSelectors size >= changeNr ifTrue:[
sel := changeSelectors at:changeNr.
sel notNil ifTrue:[ ^ sel ].
].
sel := self extractSelectorOfMethodChange:changeNr.
sel notNil ifTrue:[
changeSelectors isNil ifTrue:[
changeSelectors := OrderedCollection new
].
changeSelectors grow:changeNr.
changeSelectors at:changeNr put:sel.
].
^ sel
!
sourceOfMethodChange:changeNr
"return a method-changes source code, or nil if its not a methodChange."
|aStream chunk sawExcla parseTree sourceChunk sel|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ nil].
(self changeIsFollowupMethodChange:changeNr) ifFalse:[
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
] ifTrue:[
chunk := (changeChunks at:changeNr).
sawExcla := true.
].
sawExcla ifTrue:[
parseTree := Parser parseExpression:chunk.
(parseTree notNil
and:[parseTree ~~ #Error
and:[parseTree isMessage]]) ifTrue:[
sel := parseTree selector.
(#(
#methodsFor:
#privateMethodsFor:
#publicMethodsFor:
#ignoredMethodsFor:
#protectedMethodsFor:
#methodsFor:stamp: "/ Squeak support
#commentStamp:prior: "/ Squeak support
#methodsFor "/ Dolphin support
#methods "/ STV support
)
includes:sel) ifTrue:[
sourceChunk := aStream nextChunk.
]
].
].
aStream close.
^ sourceChunk
"Created: / 5.9.1996 / 17:11:32 / cg"
"Modified: / 13.2.2000 / 15:05:45 / cg"
!
streamForChange:changeNr
"answer a stream for change"
|aStream|
(changeNr between:1 and:changePositions size) ifFalse:[^ nil].
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ nil].
aStream position:(changePositions at:changeNr).
^ aStream
! !
!ChangesBrowser methodsFor:'private-changeFile access'!
changeFileName:aFileName
"set the name of the changeFile"
changeFileName := aFileName
!
checkIfFileHasChanged
"check if the changeFile has been modified since the last check;
install a timeout for rechecking after some time."
|f info |
Processor removeTimedBlock:checkBlock.
f := changeFileName asFilename.
(info := f info) isNil ifTrue:[
self newLabel:'(unaccessable)'
] ifFalse:[
(info modified) > changeFileTimestamp ifTrue:[
self newLabel:'(outdated)'.
autoUpdate value ifTrue:[
self doUpdate
]
] ifFalse:[
self newLabel:''
]
].
Processor addTimedBlock:checkBlock afterSeconds:5.
"Created: 8.9.1995 / 19:30:19 / claus"
"Modified: 8.9.1995 / 19:38:18 / claus"
"Modified: 1.11.1996 / 20:22:56 / cg"
!
readChangesFile
"read the changes file, create a list of header-lines (changeChunks)
and a list of chunk-positions (changePositions)"
^ self readChangesFileInBackground:false
!
readChangesFileInBackground:inBackground
"read the changes file, create a list of header-lines (changeChunks)
and a list of chunk-positions (changePositions).
Starting with 2.10.3, the entries are multi-col entries;
the cols are:
1 delta (only if comparing)
'+' -> new method (w.r.t. current state)
'-' -> removed method (w.r.t. current state)
'?' -> class does not exist currently
'=' -> change is same as current methods source
2 class/selector
3 type of change
doit
method
category change
4 timestamp
since comparing slows down startup time, it is now disabled by
default and can be enabled via a toggle."
|aStream maxLen i f chunkText fullChunkText askedForEditingClassSource
excla timeStampInfo entry changeDelta changeString changeType
s changeClass sawExcla category
chunkPos sel headerLine cls p rec clsName
myProcess myPriority myPrioRange
done first className text methodPos
singleJunkOnly methodChunks singleInfo
ownerTree ownerName
m currentText t1 t2|
editingClassSource := false.
askedForEditingClassSource := false.
maxLen := 60.
f := changeFileName asFilename.
aStream := f readStream.
aStream isNil ifTrue:[^ nil].
self newLabel:'updating ...'.
i := f info.
changeFileSize := i size.
changeFileTimestamp := i modified.
self withReadCursorDo:[
"
this is a time consuming operation (especially, if reading an
NFS-mounted directory; therefore lower my priority ...
"
inBackground ifTrue:[
myProcess := Processor activeProcess.
myPriority := myProcess priority.
myPrioRange := myProcess priorityRange.
myProcess priorityRange:(Processor userBackgroundPriority to:Processor activePriority).
"/ myProcess priority:(Processor userBackgroundPriority).
].
[
changeChunks := OrderedCollection new.
changeClassNames := OrderedCollection new.
changeHeaderLines := OrderedCollection new.
changePositions := OrderedCollection new.
changeTimeStamps := OrderedCollection new.
changeIsFollowupMethodChange := OrderedCollection new.
excla := aStream class chunkSeparator.
[aStream atEnd] whileFalse:[
"
get a chunk (separated by excla)
"
aStream skipSeparators.
chunkPos := aStream position.
sawExcla := aStream peekFor:excla.
chunkText := fullChunkText := aStream nextChunk.
chunkText notNil ifTrue:[
(chunkText startsWith:'''---- timestamp ') ifTrue:[
timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces.
] ifFalse:[
"
only first line is saved in changeChunks ...
"
"/ index := chunkText indexOf:(Character cr).
"/ (index ~~ 0) ifTrue:[
"/ chunkText := chunkText copyTo:(index - 1).
"/
"/ "take care for comment changes - must still be a
"/ valid expression for classNameOfChange: to work"
"/
"/ (chunkText endsWith:'comment:''') ifTrue:[
"/ chunkText := chunkText , '...'''
"/ ].
"/ (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[
"/ sel := 'primitiveDefinitions:'.
"/ chunkText := chunkText copyWithoutLast:1
"/ ].
"/ (chunkText endsWith:'primitiveVariables:''') ifTrue:[
"/ sel := 'primitiveVariables:'.
"/ chunkText := chunkText copyWithoutLast:1
"/ ].
"/ (chunkText endsWith:'primitiveFunctions:''') ifTrue:[
"/ sel := 'primitiveFunctions:'.
"/ chunkText := chunkText copyWithoutLast:1
"/ ].
"/ ].
changeChunks add:chunkText.
changeClassNames add:nil.
changePositions add:chunkPos.
changeTimeStamps add:timeStampInfo.
changeIsFollowupMethodChange add:false.
headerLine := nil.
changeDelta := ' '.
sawExcla ifFalse:[
(chunkText startsWith:'''---- snap') ifTrue:[
changeType := ''.
headerLine := chunkText.
changeString := (chunkText contractTo:maxLen).
timeStampInfo := nil.
] ifFalse:[
headerLine := chunkText , ' (doIt)'.
"
first, assume doIt - then lets have a more detailed look ...
"
((chunkText startsWith:'''---- file')
or:[(chunkText startsWith:'''---- check')]) ifTrue:[
changeType := ''.
timeStampInfo := nil.
] ifFalse:[
changeType := '(doIt)'.
].
changeString := (chunkText contractTo:maxLen).
p := Parser parseExpression:fullChunkText inNameSpace:Smalltalk.
(p notNil and:[p ~~ #Error]) ifTrue:[
p isMessage ifTrue:[
sel := p selector.
rec := p receiver.
]
] ifFalse:[
sel := nil.
(Scanner new scanTokens:fullChunkText) size == 0 ifTrue:[
"/ a comment only
changeType := '(comment)'.
NoColoring ~~ true ifTrue:[
changeType := changeType allItalic.
"/ changeString := changeString allItalic.
changeType emphasisAllAdd:(#color -> UserPreferences current commentColor).
]
] ifFalse:[
changeType := '(???)'.
]
].
(sel == #comment:) ifTrue:[
changeType := '(comment)'.
clsName := rec name.
changeClass := (Smalltalk classNamed:clsName).
changeClassNames at:changeClassNames size put:clsName.
NoColoring ~~ true ifTrue:[
changeType := changeType allItalic.
changeType emphasisAllAdd:(#color -> UserPreferences current commentColor).
"/ changeString := clsName allItalic.
].
autoCompare value ifTrue:[
(changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
changeDelta := '?'
] ifFalse:[
(changeClass comment = (p args at:1) evaluate) ifTrue:[
changeDelta := '='.
]
]
].
sel := nil.
].
(sel == #removeSelector:) ifTrue:[
rec isUnaryMessage ifTrue:[
cls := rec receiver name.
changeClass := (Smalltalk classNamed:cls) class.
cls := cls , ' class'.
] ifFalse:[
cls := rec name.
changeClass := (Smalltalk classNamed:cls)
].
sel := (p args at:1) evaluate.
changeClassNames at:changeClassNames size put:cls.
autoCompare value ifTrue:[
(changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
changeDelta := '?'
] ifFalse:[
(changeClass implements:sel asSymbol) ifTrue:[
changeDelta := '-'.
] ifFalse:[
changeDelta := '='.
]
]
].
changeType := '(remove)'.
changeString := self contractClass:cls selector:sel to:maxLen.
sel := nil.
].
(p ~~ #Error
and:[p isMessage
and:[rec isMessage
and:[rec selector == #compiledMethodAt:]]]) ifTrue:[
rec receiver isUnaryMessage ifTrue:[
cls := rec receiver receiver name.
changeClass := (Smalltalk classNamed:cls) class.
cls := cls , ' class'.
] ifFalse:[
cls := rec receiver name.
changeClass := (Smalltalk classNamed:cls)
].
(sel == #category:) ifTrue:[
sel := (rec args at:1) evaluate.
changeType := '(category change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
changeClassNames at:changeClassNames size put:cls.
changeClass notNil ifTrue:[
m := changeClass compiledMethodAt:sel asSymbol.
m notNil ifTrue:[
m category = (p args at:1) evaluate ifTrue:[
changeDelta := '='.
]
]
].
].
(sel == #privacy:) ifTrue:[
sel := (rec args at:1) evaluate.
changeType := '(privacy change)'.
changeString := self contractClass:cls selector:sel to:maxLen.
changeClassNames at:changeClassNames size put:cls.
].
sel := nil.
].
(Class definitionSelectors includes:sel) ifTrue:[
changeType := '(class definition)'.
clsName := (p args at:1) evaluate.
changeClassNames at:changeClassNames size put:clsName.
"/ is it a private-class ?
('*privateIn:' match:sel) ifTrue:[
ownerTree := p args last.
ownerName := ownerTree name asString.
clsName := ownerName , '::' , clsName
].
changeString := clsName.
NoColoring ~~ true ifTrue:[
changeType := changeType allBold.
changeString := changeString allBold.
].
autoCompare value ifTrue:[
cls := Smalltalk at:clsName ifAbsent:nil.
cls isNil ifTrue:[
changeDelta := '+'.
] ifFalse:[
cls definitionSelector = sel ifTrue:[
((cls superclass isNil
and:[p receiver isConstant
and:[p receiver evaluate isNil]])
or:[
cls superclass notNil
and:[p receiver isConstant not
and:[cls superclass name = p receiver name]]
]) ifTrue:[
cls instanceVariableString asCollectionOfWords = (p args at:2) evaluate asCollectionOfWords ifTrue:[
cls classVariableString asCollectionOfWords = (p args at:3) evaluate asCollectionOfWords ifTrue:[
(p args at:4) evaluate isEmpty ifTrue:[
cls category = (p args at:5) evaluate ifTrue:[
changeDelta := '='.
] ifFalse:[
changeType := '(class category change)'.
]
]
]
]
]
].
]
].
sel := nil.
] ifFalse:[
(#(
#'primitiveDefinitions:'
#'primitiveFunctions:'
#'primitiveVariables:'
) includes:sel) ifTrue:[
changeType := '(class definition)'.
clsName := rec evaluate.
] ifFalse:[
((sel == #instanceVariableNames:)
and:[rec isMessage
and:[rec selector == #class]]) ifTrue:[
clsName := rec receiver name.
changeClass := (Smalltalk classNamed:clsName).
changeType := '(class definition)'.
changeClassNames at:changeClassNames size put:clsName.
autoCompare value ifTrue:[
changeClass isNil ifTrue:[
changeDelta := '?'.
] ifFalse:[
s := (p args at:1) evaluate.
s = changeClass class instanceVariableString ifTrue:[
changeDelta := '='.
]
]
].
]
]
].
]
] ifTrue:[ "sawExcla"
singleJunkOnly := false.
methodChunks := false.
singleInfo := false.
"
method definitions actually consist of
two (or more) chunks; skip next chunk(s)
up to an empty one.
The system only writes one chunk,
and we cannot handle more in this ChangesBrowser ....
"
className := nil.
p := Parser parseExpression:chunkText inNameSpace:Smalltalk.
(p notNil and:[p ~~ #Error]) ifTrue:[
sel := p selector.
(#(
#methodsFor:
#privateMethodsFor:
#publicMethodsFor:
#ignoredMethodsFor:
#protectedMethodsFor:
#methodsFor:stamp: "/ Squeak support
#'commentStamp:prior:' "/ Squeak support
#methodsFor "/ Dolphin support
#methods "/ STV support
)
includes:sel) ifTrue:[
methodChunks := true.
p receiver isUnaryMessage ifTrue:[
className := p receiver receiver name.
changeClass := (Smalltalk classNamed:className) class.
className := className , ' class'.
] ifFalse:[
className := p receiver name.
changeClass := Smalltalk classNamed:className
].
(sel == #'methodsFor') ifTrue:[
category := 'Dolphin methods'.
] ifFalse:[
(sel == #methods) ifTrue:[
category := 'STV methods'.
] ifFalse:[
category := (p args at:1) evaluate.
]
].
sel == #'methodsFor:stamp:' ifTrue:[
"/ Squeak timeStamp
timeStampInfo := (p args at:2) evaluate.
singleInfo := true
] ifFalse:[
sel == #'commentStamp:prior:' ifTrue:[
singleJunkOnly := true.
methodChunks := false.
]
]
] ifFalse:[
sel == #reorganize ifTrue:[
singleJunkOnly := true.
methodChunks := false.
]
].
].
done := false.
first := true.
[done] whileFalse:[
changeDelta := ' '.
methodPos := aStream position.
text := aStream nextChunk.
text isNil ifTrue:[
done := true
] ifFalse:[
done := text isEmpty
].
done ifFalse:[
first ifFalse:[
changeChunks add:chunkText.
changeClassNames add:className.
changePositions add:methodPos.
changeTimeStamps add:timeStampInfo.
changeIsFollowupMethodChange add:true.
askedForEditingClassSource ifFalse:[
(changeFileName asFilename hasSuffix:'st') ifFalse:[
editingClassSource := (self confirm:'Multiple method chunks without individual ''methodsFor:'' encountered.
Is this a class-file being browsed ?')
] ifTrue:[
editingClassSource := true.
].
askedForEditingClassSource := true.
]
] ifTrue:[
changeClassNames at:changeClassNames size put:className.
].
first := false.
"
try to find the selector
"
sel := nil.
className notNil ifTrue:[
methodChunks ifTrue:[
p := Parser
parseMethodSpecification:text
in:nil
ignoreErrors:true
ignoreWarnings:true.
(p notNil and:[p ~~ #Error]) ifTrue:[
sel := p selector.
]
]
].
sel isNil ifTrue:[
changeString := (chunkText contractTo:maxLen).
changeType := '(change)'.
headerLine := chunkText , ' (change)'.
] ifFalse:[
changeString := self contractClass:className selector:sel to:maxLen.
changeType := '{ ' , category , ' }'.
headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'.
].
autoCompare value ifTrue:[
changeClass isNil ifFalse:[
changeClass isMeta ifTrue:[
cls := changeClass soleInstance
] ifFalse:[
cls := changeClass
].
].
(changeClass isNil or:[sel isNil or:[cls isLoaded not]]) ifTrue:[
changeDelta := '?'
] ifFalse:[
(changeClass implements:sel asSymbol) ifFalse:[
changeDelta := '+'.
] ifTrue:[
m := changeClass compiledMethodAt:sel asSymbol.
currentText := m source.
currentText notNil ifTrue:[
text asString string withoutTrailingSeparators = currentText asString string withoutTrailingSeparators ifTrue:[
changeDelta := '='
] ifFalse:[
t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded].
t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded].
t1 = t2 ifTrue:[
changeDelta := '='
]
]
]
]
]
].
entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:changeDelta.
entry colAt:2 put:changeString.
entry colAt:3 put:changeType.
timeStampInfo notNil ifTrue:[
entry colAt:4 put:timeStampInfo.
].
changeHeaderLines add:entry
].
changeString := nil.
headerLine := nil.
singleJunkOnly ifTrue:[done := true]
].
singleInfo ifTrue:[
timeStampInfo := nil
].
].
changeString notNil ifTrue:[
entry := MultiColListEntry new.
entry tabulatorSpecification:tabSpec.
entry colAt:1 put:changeDelta.
entry colAt:2 put:changeString.
entry colAt:3 put:changeType.
timeStampInfo notNil ifTrue:[
entry colAt:4 put:timeStampInfo.
].
changeHeaderLines add:entry
] ifFalse:[
headerLine notNil ifTrue:[
changeHeaderLines add:headerLine
]
]
]
]
].
anyChanges := false
] valueNowOrOnUnwindDo:[
aStream close.
inBackground ifTrue:[
myProcess priority:myPriority.
myProcess priorityRange:myPrioRange.
].
].
].
self checkIfFileHasChanged
"Modified: / 27.8.1995 / 23:06:55 / claus"
"Modified: / 13.2.2000 / 15:02:11 / cg"
!
writeBackChanges
"write back the changes file. To avoid problems when the disk is full
or a crash occurs while writing (well, or someone kills us),
first write the stuff to a new temporary file. If this works ok,
rename the old change-file to a .bak file and finally rename the
tempfile back to the change-file.
That way, if anything happens, either the original file is left unchanged,
or we have at least a backup of the previous change file."
|inStream outStream tempfile stamp f|
editingClassSource ifTrue:[
(self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs)
ifFalse:[
^ false
]
].
tempfile := Filename newTemporaryIn:nil.
tempfile exists ifTrue:[tempfile remove].
outStream := tempfile writeStream.
outStream isNil ifTrue:[
self warn:'cannot create temporary file in current directory.'.
^ false
].
inStream := FileStream readonlyFileNamed:changeFileName.
inStream isNil ifTrue:[^ false].
self withCursor:(Cursor write) do:[
|excla sawExcla done first chunk
nChanges "{Class:SmallInteger}" |
Stream writeErrorSignal handle:[:ex |
self warn:('could not update the changes file.\\' , ex description) withCRs.
tempfile exists ifTrue:[tempfile remove].
^ false
] do:[
excla := inStream class chunkSeparator.
nChanges := self numberOfChanges.
1 to:nChanges do:[:index |
inStream position:(changePositions at:index).
sawExcla := inStream peekFor:excla.
chunk := inStream nextChunk.
(chunk notNil
and:[(chunk startsWith:'''---- snap') not]) ifTrue:[
(stamp := changeTimeStamps at:index) notNil ifTrue:[
outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''.
outStream nextPut:excla; cr.
].
].
sawExcla ifTrue:[
outStream nextPut:excla.
outStream nextChunkPut:chunk.
outStream cr; cr.
"
a method-definition chunk - output followups
"
done := false.
first := true.
[done] whileFalse:[
chunk := inStream nextChunk.
chunk isNil ifTrue:[
outStream cr; cr.
done := true
] ifFalse:[
chunk isEmpty ifTrue:[
outStream space; nextChunkPut:chunk; cr; cr.
done := true.
] ifFalse:[
first ifFalse:[
outStream cr; cr.
].
outStream nextChunkPut:chunk.
].
].
first := false.
].
] ifFalse:[
outStream nextChunkPut:chunk.
outStream cr
]
].
outStream close.
inStream close.
].
f := changeFileName asFilename.
f renameTo:(f withSuffix:'bak').
tempfile renameOrCopyTo:changeFileName.
anyChanges := false
].
^ true
"Modified: / 2.12.1996 / 22:29:15 / stefan"
"Modified: / 21.4.1998 / 17:50:11 / cg"
! !
!ChangesBrowser methodsFor:'private-user interaction ops'!
appendChange:changeNr toFile:fileName
"append change to a file. return true if ok."
|aStream outStream chunk chunk2 sawExcla separator|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[
self warn:'oops - cannot read change'.
^ false
].
aStream skipSeparators.
separator := aStream class chunkSeparator.
(self changeIsFollowupMethodChange:changeNr) ifTrue:[
sawExcla := true.
chunk := changeChunks at:changeNr.
chunk withoutSeparators isEmpty ifTrue:[
self halt:'oops - should not happen'.
]
] ifFalse:[
sawExcla := aStream peekFor:separator.
chunk := aStream nextChunk.
chunk withoutSeparators isEmpty ifTrue:[
self halt:'oops - should not happen'.
]
].
outStream := FileStream oldFileNamed:fileName.
outStream isNil ifTrue:[
outStream isNil ifTrue:[
outStream := FileStream newFileNamed:fileName.
outStream isNil ifTrue:[
self warn:'cannot update file ''%1''' with:fileName.
^ false
]
]
].
outStream setToEnd.
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream nextChunkPut:chunk; cr.
sawExcla ifTrue:[
chunk2 := aStream nextChunk.
chunk2 withoutSeparators isEmpty ifTrue:[
self halt:'oops - should not happen'.
].
outStream nextChunkPut:chunk2; space
].
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream cr.
aStream close.
outStream close.
^ true
"Modified: / 6.2.1998 / 13:03:54 / cg"
!
applyChange:changeNr
"fileIn a change"
|aStream applyAction nameSpace className changeClass ownerName ownerClass
sig reader doItChunk methodsForChunk pkg|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
changeClass := Smalltalk at:(className asSymbol) ifAbsent:[].
changeClass notNil ifTrue:[
changeClass isLoaded ifFalse:[
changeClass autoload
]
]
].
changeNrProcessed := changeNr.
applyAction := [
(skipSignal notNil) ifTrue:[
sig := skipSignal
] ifFalse:[
sig := Object abortSignal
].
sig catch:[
applyInOriginalNameSpace value ifFalse:[
nameSpace := Class nameSpaceQuerySignal query.
] ifTrue:[
nameSpace := Smalltalk.
].
pkg := enforcedPackage ? Class packageQuerySignal query.
Class packageQuerySignal answer:pkg
do:[
Class nameSpaceQuerySignal answer:nameSpace
do:[
"/ a followup methodsFor: chunk ...
(self changeIsFollowupMethodChange:changeNr) ifTrue:[
methodsForChunk := (changeChunks at:changeNr).
] ifFalse:[
doItChunk := aStream nextChunk. "/ an empty chunk sometimes ...
doItChunk notEmpty ifTrue:[
Compiler evaluate:doItChunk notifying:self.
] ifFalse:[
methodsForChunk := aStream nextChunk. "/ the real one
]
].
methodsForChunk notNil ifTrue:[
changeClass isNil ifTrue:[
(className includes:$:) ifTrue:[
ownerName := className copyTo:(className lastIndexOf:$:) - 1.
(ownerName endsWith:$:) ifTrue:[
ownerName := ownerName copyWithoutLast:1.
].
ownerClass := Smalltalk at:(ownerName asSymbol) ifAbsent:[].
ownerClass notNil ifTrue:[
ownerClass isLoaded ifFalse:[
ownerClass autoload
]
].
].
(nameSpace notNil and:[nameSpace ~~ Smalltalk]) ifTrue:[
changeClass := nameSpace at:(className asSymbol) ifAbsent:[].
].
changeClass isNil ifTrue:[
changeClass := Smalltalk at:(className asSymbol) ifAbsent:[].
].
changeClass isNil ifTrue:[
self warn:'no class ''' , className , ''' for change'.
^ self
].
].
reader := Compiler evaluate:methodsForChunk notifying:self.
reader fileInFrom:aStream notifying:self passChunk:false single:true.
]
]
]
].
changeNrProcessed := nil.
].
"/
"/ if I am showing the changes file, dont update it
"/
changeFileName = ObjectMemory nameForChanges ifTrue:[
Class withoutUpdatingChangesDo:[
Class updateChangeListQuerySignal answer:updateChangeSet do:applyAction
]
] ifFalse:[
applyAction value
].
aStream close
"Modified: / 7.2.1998 / 19:56:34 / cg"
!
compareChange:changeNr
"compare a change with the current (in-image) version; show the result of the compare (as dialog)"
^ self compareChange:changeNr showResult:true
!
compareChange:changeNr showResult:doShowResult
"compare a change with current version.
Return the result of the compare (same -> true, different -> false, uncomparable -> nil).
If doShowResult is true, the outcome is shown in a dialog/diffViewer."
|aStream chunk sawExcla parseTree thisClass cat oldSource newSource
parser sel oldMethod outcome showDiff d t1 t2 selector isLoaded
method beep superClass thisClassSym varsHere varsInChange addedVars removedVars
isSame|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ nil].
showDiff := false.
(self changeIsFollowupMethodChange:changeNr) ifFalse:[
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
] ifTrue:[
chunk := (changeChunks at:changeNr).
sawExcla := true.
].
isSame := nil.
beep := false.
sawExcla ifFalse:[
outcome := 'cannot compare this change\\(i.e. this is not a method change).'.
Class nameSpaceQuerySignal answer:Smalltalk
do:[
parseTree := Parser parseExpression:chunk.
].
(parseTree notNil and:[parseTree ~~ #Error and:[ parseTree isMessage ]]) ifTrue:[
selector := parseTree selector.
selector == #'removeSelector:' ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(self checkClassIsLoaded:thisClass) ifTrue:[
selector := (parseTree arg1 evaluate).
(thisClass includesSelector:selector) ifTrue:[
outcome := 'change removes the #' , selector , ' method from ' , thisClass name.
isSame := false.
] ifFalse:[
outcome := 'change has no effect\\(there is no method for #' , selector , ' in ' , thisClass name , ')'.
isSame := true.
]
] ifFalse:[
beep := true.
outcome := 'cannot compare this change (compare requires class to be loaded).'.
isSame := nil.
]
] ifFalse:[
outcome := 'cannot compare this change (class not present)'.
isSame := nil.
].
].
selector == #'category:' ifTrue:[
parseTree receiver isMessage ifTrue:[
parseTree receiver selector == #compiledMethodAt: ifTrue:[
(method := parseTree receiver evaluate) isMethod ifTrue:[
method category = parseTree arg1 evaluate ifTrue:[
outcome := 'change has no effect\\(same category)'.
isSame := true.
] ifFalse:[
outcome := 'category is different (''' , method category , ''' vs. ''' , parseTree arg1 evaluate , ''')'.
isSame := false.
]
] ifFalse:[
beep := true.
outcome := 'there is no such method'.
isSame := nil.
]
]
]
].
selector == #'comment:' ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(self checkClassIsLoaded:thisClass) ifTrue:[
(thisClass comment = parseTree arg1 evaluate) ifTrue:[
outcome := 'change has no effect\\(same comment)'.
isSame := true.
] ifFalse:[
outcome := 'comment is different'.
isSame := false.
]
] ifFalse:[
beep := true.
outcome := 'cannot compare this change (compare requires class to be loaded).'.
isSame := nil.
]
] ifFalse:[
outcome := 'cannot compare this change (class not present)'.
isSame := nil.
].
].
selector == #'instanceVariableNames:' ifTrue:[
parseTree receiver isMessage ifTrue:[
parseTree receiver selector == #class ifTrue:[
thisClass := (parseTree receiver evaluate).
varsHere := thisClass instanceVariableString asCollectionOfWords.
varsInChange := (parseTree arguments at:1) evaluate asCollectionOfWords.
varsHere = varsInChange ifTrue:[
outcome := 'change has no effect\\(same definition)'.
isSame := true.
] ifFalse:[
outcome := 'class-instanceVariable definition is different'.
isSame := false.
].
].
]
].
selector == #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:' ifTrue:[
superClass := (parseTree receiver evaluate).
superClass isBehavior ifTrue:[
(self checkClassIsLoaded:superClass) ifTrue:[
thisClassSym := (parseTree arguments at:1) evaluate.
thisClass := Smalltalk at:thisClassSym ifAbsent:nil.
thisClass notNil ifTrue:[
(isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
outcome := 'cannot compare this change\\(compare requires class to be loaded).'.
isSame := nil.
] ifTrue:[
varsHere := thisClass instanceVariableString asCollectionOfWords.
varsInChange := (parseTree arguments at:2) evaluate asCollectionOfWords.
varsHere = varsInChange ifTrue:[
thisClass classVariableString asCollectionOfWords = (parseTree arguments at:3) evaluate asCollectionOfWords ifTrue:[
((thisClass sharedPools size == 0) and:[(parseTree arguments at:4) evaluate = '']) ifTrue:[
thisClass category = (parseTree arguments at:5) evaluate ifTrue:[
outcome := 'change has no effect\\(same definition)'.
isSame := true.
] ifFalse:[
outcome := 'category is different'.
isSame := false.
]
] ifFalse:[
outcome := 'sharedPool definition is different'.
isSame := false.
].
] ifFalse:[
outcome := 'classVariable definition is different'.
isSame := false.
]
] ifFalse:[
outcome := 'instanceVariable definition is different'.
isSame := false.
addedVars := varsInChange select:[:eachVar | (varsHere includes:eachVar) not].
removedVars := varsHere select:[:eachVar | (varsInChange includes:eachVar) not].
addedVars isEmpty ifTrue:[
removedVars := removedVars collect:[:eachVar | '''' , eachVar , ''''].
outcome := 'change removes instanceVariable(s): ' , (removedVars asStringWith:Character space).
] ifFalse:[
removedVars isEmpty ifTrue:[
addedVars := addedVars collect:[:eachVar | '''' , eachVar , ''''].
outcome := 'change adds instanceVariable(s): ' , (addedVars asStringWith:Character space).
].
].
]
]
]
]
]
]
]
] ifTrue:[
Class nameSpaceQuerySignal answer:Smalltalk
do:[
parseTree := Parser parseExpression:chunk.
].
(parseTree notNil
and:[parseTree ~~ #Error
and:[parseTree isMessage]]) ifTrue:[
"/ Squeak support (#methodsFor:***)
(#(
#methodsFor:
#privateMethodsFor:
#publicMethodsFor:
#ignoredMethodsFor:
#protectedMethodsFor:
#methodsFor:stamp: "/ Squeak support
#methodsFor "/ Dolphin support
#methods "/ STV support
)
includes:parseTree selector) ifTrue:[
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
outcome := 'cannot compare this change\\(compare requires class to be loaded).'.
isSame := nil.
].
parseTree selector == #methodsFor ifTrue:[
cat := 'Dolphin methods'.
] ifFalse:[
parseTree selector == #methods ifTrue:[
cat := 'STV methods'.
] ifFalse:[
cat := parseTree arg1 evaluate.
].
].
newSource := aStream nextChunk.
Class nameSpaceQuerySignal answer:Smalltalk
do:[
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'.
isSame := true.
] ifFalse:[
oldSource isNil ifTrue:[
beep := true.
outcome := 'no source for compare.'.
isSame := true.
] ifFalse:[
"/
"/ compare for tabulator <-> space changes
"/ before showing diff ...
"/
t1 := oldSource asCollectionOfLines collect:[:s | s withTabsExpanded].
t2 := newSource asCollectionOfLines collect:[:s | s withTabsExpanded].
t1 = t2 ifTrue:[
outcome := 'same source'.
isSame := true.
] ifFalse:[
outcome := 'source changed.'.
showDiff := true.
isSame := false.
"/
"/ check if only historyLine diffs
"/
(HistoryManager notNil
and:[HistoryManager isActive]) ifTrue:[
(HistoryManager withoutHistoryLines:newSource)
=
(HistoryManager withoutHistoryLines:oldSource)
ifTrue:[
outcome := 'same source (history only)'.
isSame := true.
showDiff := false.
]
].
]
]
]
] ifFalse:[
isLoaded ifTrue:[
beep := true.
outcome := 'method does not exist.'.
isSame := nil.
]
]
] ifFalse:[
outcome := 'change unparsable (parse error).'.
isSame := nil.
].
doShowResult ifTrue:[
(showDiff and:[oldSource notNil and:[newSource notNil]]) ifTrue:[
d := DiffTextView
openOn:oldSource label:(resources string:'current version (in image)')
and:newSource label:(resources string:'change version').
d label:'method differences'.
]
]
] ifFalse:[
beep := true.
outcome := 'class does not exist.'.
isSame := nil.
]
] ifFalse:[
beep := true.
outcome := 'not comparable.'.
isSame := nil.
]
] ifFalse:[
beep := true.
outcome := 'not comparable.'.
isSame := nil.
]
].
aStream close.
doShowResult ifTrue:[
showDiff ifFalse:[
outcome := (resources string:outcome) withCRs.
beep ifTrue:[
self warn:outcome.
] ifFalse:[
self information:outcome.
]
"/ Transcript showCR:outcome.
].
].
^ isSame.
"Created: / 24.11.1995 / 14:30:46 / cg"
"Modified: / 13.2.2000 / 15:04:39 / cg"
!
compressForClass:aClassNameOrNil
"compress the change-set;
this replaces multiple method-changes by the last (i.e. the most recent) change.
If the class argument is nil, compress for all classes.
otherwise, only changes for that class are compressed."
|aStream searchIndex anyMore deleteSet index
str snapshotProto snapshotPrefix snapshotNameIndex fileName|
aStream := FileStream readonlyFileNamed:changeFileName.
aStream isNil ifTrue:[^ self].
aClassNameOrNil isNil ifTrue:[
self newLabel:'compressing ...'.
] ifFalse:[
self newLabel:'compressing for ' , aClassNameOrNil.
].
CompressSnapshotInfo == true ifTrue:[
"
get a prototype snapshot record (to be independent of
the actual format ..
"
str := WriteStream on:String new.
Class addChangeRecordForSnapshot:'foo' to:str.
snapshotProto := str contents.
snapshotPrefix := snapshotProto copyTo:10.
snapshotNameIndex := snapshotProto findString:'foo'.
].
self withExecuteCursorDo:[
|numChanges classes selectors types excla sawExcla
changeNr chunk aParseTree parseTreeChunk
thisClass thisSelector codeChunk codeParser
compressThis|
numChanges := self numberOfChanges.
classes := Array new:numChanges.
selectors := Array new:numChanges.
types := Array new:numChanges.
"starting at the end, get the change class and change selector;
collect all in classes / selectors"
changeNr := numChanges.
excla := aStream class chunkSeparator.
[changeNr >= 1] whileTrue:[
aStream position:(changePositions at:changeNr).
sawExcla := aStream peekFor:excla.
chunk := aStream nextChunk.
sawExcla ifTrue:[
"optimize a bit if multiple methods for same category arrive"
(chunk = parseTreeChunk) ifFalse:[
aParseTree := Parser parseExpression:chunk.
parseTreeChunk := chunk
].
(aParseTree notNil
and:[(aParseTree ~~ #Error)
and:[aParseTree isMessage]]) ifTrue:[
(#(
#methodsFor:
#privateMethodsFor:
#publicMethodsFor:
#ignoredMethodsFor:
#protectedMethodsFor:
#methodsFor:stamp: "/ Squeak support
#methodsFor "/ Dolphin support
#methods "/ STV support
)
includes:aParseTree selector) ifTrue:[
thisClass := (aParseTree receiver evaluate).
codeChunk := aStream nextChunk.
codeParser := Parser
parseMethodSpecification:codeChunk
in:thisClass
ignoreErrors:true
ignoreWarnings:true.
(codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[
selectors at:changeNr put:(codeParser selector).
classes at:changeNr put:thisClass.
types at:changeNr put:#methodsFor
]
]
]
] ifFalse:[
aParseTree := Parser parseExpression:chunk.
parseTreeChunk := chunk.
(aParseTree notNil
and:[(aParseTree ~~ #Error)
and:[aParseTree isMessage]]) ifTrue:[
(aParseTree selector == #removeSelector:) ifTrue:[
selectors at:changeNr put:(aParseTree arg1 value ).
classes at:changeNr put:(aParseTree receiver evaluate).
types at:changeNr put:#removeSelector
]
] ifFalse:[
CompressSnapshotInfo == true ifTrue:[
(chunk startsWith:snapshotPrefix) ifTrue:[
str := chunk readStream position:snapshotNameIndex.
fileName := str upTo:(Character space).
"
kludge to allow use of match-check below
"
selectors at:changeNr put:snapshotPrefix.
classes at:changeNr put:fileName.
]
]
]
].
changeNr := changeNr - 1
].
aStream close.
"for all changes, look for another class/selector occurence later
in the list and, if there is one, add change number to the delete set"
deleteSet := OrderedCollection new.
changeNr := 1.
[changeNr < self numberOfChanges] whileTrue:[
thisClass := classes at:changeNr.
compressThis := false.
aClassNameOrNil isNil ifTrue:[
compressThis := true
] ifFalse:[
"/ skipping unloaded/unknown classes
thisClass isBehavior ifTrue:[
thisClass isMeta ifTrue:[
compressThis := aClassNameOrNil = thisClass soleInstance name.
] ifFalse:[
compressThis := aClassNameOrNil = thisClass name
]
]
].
compressThis ifTrue:[
thisSelector := selectors at:changeNr.
searchIndex := changeNr.
anyMore := true.
[anyMore] whileTrue:[
searchIndex := classes indexOf:thisClass
startingAt:(searchIndex + 1).
(searchIndex ~~ 0) ifTrue:[
((selectors at:searchIndex) == thisSelector) ifTrue:[
thisClass notNil ifTrue:[
deleteSet add:changeNr.
anyMore := false
]
]
] ifFalse:[
anyMore := false
]
].
].
changeNr := changeNr + 1
].
"finally delete what has been found"
(deleteSet size > 0) ifTrue:[
changeListView setSelection:nil.
index := deleteSet size.
[index > 0] whileTrue:[
self silentDeleteChange:(deleteSet at:index).
index := index - 1
].
self setChangeList.
"
scroll back a bit, if we are left way behind the list
"
changeListView firstLineShown > self numberOfChanges ifTrue:[
changeListView makeLineVisible:self numberOfChanges
].
self clearCodeView
]
].
self newLabel:''.
"Created: / 29.10.1997 / 01:02:44 / cg"
"Modified: / 13.2.2000 / 15:05:07 / cg"
!
deleteChange:changeNr
"delete a change"
self deleteChangesFrom:changeNr to:changeNr
!
deleteChangesFrom:start to:stop
"delete a range of changes"
changeListView setSelection:nil.
stop to:start by:-1 do:[:changeNr |
self silentDeleteInternalChange:changeNr.
changeListView removeIndex:changeNr.
].
"/ changeListView contentsChanged.
"/ changeListView redrawFromLine:start.
"/ self setChangeList
"Modified: / 18.5.1998 / 14:22:27 / cg"
!
makeChangeAPatch:changeNr
"append change to patchfile"
self appendChange:changeNr toFile:'patches'
!
makeChangePermanent:changeNr
"rewrite the source file where change changeNr lies"
self notify:'this is not yet implemented'
!
silentDeleteChange:changeNr
"delete a change do not update changeListView"
anyChanges := true.
changeChunks removeIndex:changeNr.
changePositions size >= changeNr ifTrue:[ changePositions removeIndex:changeNr ].
changeClassNames size >= changeNr ifTrue:[ changeClassNames removeIndex:changeNr ].
changeSelectors size >= changeNr ifTrue:[ changeSelectors removeIndex:changeNr ].
changeHeaderLines size >= changeNr ifTrue:[ changeHeaderLines removeIndex:changeNr ].
changeTimeStamps size >= changeNr ifTrue:[ changeTimeStamps removeIndex:changeNr ].
changeIsFollowupMethodChange size >= changeNr ifTrue:[ changeIsFollowupMethodChange removeIndex:changeNr ].
"Modified: 18.11.1995 / 17:08:44 / cg"
!
silentDeleteChangesFor:aClassName from:start to:stop
"delete changes for a given class in a range.
Return the number of deleted changes."
|thisClassName index numDeleted|
numDeleted := 0.
index := stop.
[index >= start] whileTrue:[
thisClassName := self classNameOfChange:index.
thisClassName = aClassName ifTrue:[
self silentDeleteChange:index.
numDeleted := numDeleted + 1.
].
index := index - 1
].
^ numDeleted
!
silentDeleteChangesForClassAndPrivateClasses:aClassName from:start to:stop
"delete changes for a given class and its private classes in a range.
Return the number of deleted changes."
|thisClassName index numDeleted|
numDeleted := 0.
index := stop.
[index >= start] whileTrue:[
thisClassName := self ownerClassNameOfChange:index.
thisClassName = aClassName ifTrue:[
self silentDeleteChange:index.
numDeleted := numDeleted + 1.
].
index := index - 1
].
^ numDeleted
!
silentDeleteInternalChange:changeNr
"delete a change do not update changeListView"
anyChanges := true.
changeChunks removeIndex:changeNr.
changePositions size >= changeNr ifTrue:[changePositions removeIndex:changeNr].
changeClassNames size >= changeNr ifTrue:[changeClassNames removeIndex:changeNr].
changeSelectors size >= changeNr ifTrue:[ changeSelectors removeIndex:changeNr ].
changeTimeStamps size >= changeNr ifTrue:[changeTimeStamps removeIndex:changeNr].
changeIsFollowupMethodChange size >= changeNr ifTrue:[changeIsFollowupMethodChange removeIndex:changeNr].
"Created: / 7.3.1997 / 16:28:32 / cg"
"Modified: / 7.2.1998 / 19:59:11 / cg"
"Modified: / 26.2.1998 / 18:20:48 / stefan"
! !
!ChangesBrowser methodsFor:'termination'!
closeRequest
"window manager wants us to go away"
|action again|
anyChanges ifTrue:[
again := true.
[again] whileTrue:[
action := OptionBox
request:(resources at:'The modified changelist has not been written back to the change file.\\Write change file before closing ?') withCRs
label:'ChangesBrowser'
form:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Don''t Write' 'Write'))
values:#(#abort #ignore #save)
default:#save
onCancel:#abort.
again := false.
action == #abort ifTrue:[^ self].
action == #save ifTrue:[
again := self writeBackChanges not
].
]
].
super closeRequest
"Modified: / 31.7.1997 / 18:29:06 / cg"
"Created: / 3.8.1998 / 19:54:13 / cg"
"Modified: / 24.8.1999 / 09:45:04 / stefan"
!
saveAndTerminate
"update the changes file and quit.
Dont depend on this being sent, not all window managers
send it; instead, they simply destroy the view."
anyChanges ifTrue:[
self writeBackChanges.
].
super saveAndTerminate
"Modified: / 3.8.1998 / 19:54:00 / cg"
! !
!ChangesBrowser methodsFor:'user interaction'!
askForSearch:msg initialAnswer:initial thenSearchUsing:searchBlock2 onCancel:cancelBlock
|searchString directionHolder searchBlock|
searchString := self
askForSearchString:msg
initialAnswer:initial
directionInto:(directionHolder := ValueHolder new).
searchString isNil ifTrue:[
^ cancelBlock value
].
searchBlock := [:changeNr | searchBlock2 value:searchString value:changeNr].
directionHolder value == #backward ifTrue:[
changeNrShown isNil ifTrue:[
changeNrShown := self numberOfChanges.
].
self findPreviousForWhich:searchBlock
] ifFalse:[
changeNrShown isNil ifTrue:[
changeNrShown := 0.
].
self findNextForWhich:searchBlock
].
!
askForSearchString:msg initialAnswer:initial directionInto:aValueHolder
"common code to open a search box"
|searchString direction|
direction := #forward.
Dialog aboutToOpenBoxNotificationSignal handle:[:ex |
|box nextButton prevButton|
box := ex parameter.
nextButton := box okButton.
prevButton := Button label:(resources string:'Previous').
prevButton action:[direction := #backward. box okPressed.].
box addButton:prevButton after:nextButton.
nextButton label:(resources string:'Next').
ex proceed.
] do:[
searchString := Dialog
request:msg
initialAnswer:initial
onCancel:nil.
].
searchString isNil ifTrue:[
^ nil
].
aValueHolder value:direction.
^ searchString
!
autoUpdate:aBoolean
"enabled/disable automatic update from the change-file (for monitoring)"
autoUpdate := aBoolean
"Created: 3.12.1995 / 14:14:24 / cg"
"Modified: 3.12.1995 / 14:20:45 / cg"
!
changeSelection:lineNrCollection
"show a change in the codeView"
|aStream sawExcla chunk lineNr|
lineNrCollection isInteger ifTrue:[
lineNr := lineNrCollection
] ifFalse:[
changeListView multipleSelectOk ifTrue:[
lineNrCollection size == 1 ifTrue:[
lineNr := lineNrCollection first.
]
] ifFalse:[
lineNr := lineNrCollection
].
].
lineNr isNil ifTrue:[
codeView contents:nil.
codeView initializeDoITAction.
changeNrShown := nil.
^ self
].
"/ display the changes code
aStream := self streamForChange:lineNr.
aStream isNil ifTrue:[
codeView initializeDoITAction.
^ self
].
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
sawExcla ifTrue:[
chunk := aStream nextChunk
].
aStream close.
codeView contents:chunk.
codeView acceptAction:[:theCode | self doApply "noChangesAllowed"].
codeView doItAction:[:theCode |
|clsName cls|
clsName := self classNameOfChange:lineNr.
clsName := clsName asSymbolIfInterned.
clsName notNil ifTrue:[
cls := Smalltalk at:clsName ifAbsent:nil.
].
Compiler
evaluate:theCode
in:nil
receiver:cls
notifying:self
logged:true
ifFail:nil
].
changeNrShown := lineNr.
"Modified: / 28.2.1999 / 15:26:46 / cg"
!
classOfChange:changeNr
|className cls isMeta|
className := self fullClassNameOfChange:changeNr.
className isNil ifTrue:[
self warn:'Could not extract classname from change'.
^ nil
].
isMeta := false.
(className endsWith:' class') ifTrue:[
className := className copyWithoutLast:6.
isMeta := true.
].
(cls := Smalltalk classNamed:className) isNil ifTrue:[
self warn:('Class not found: ''' , className , '''').
^ nil
].
isMeta ifTrue:[
cls := cls class
].
^ cls
!
doApply
"user wants a change to be applied"
self withSelectedChangesDo:[:changeNr |
skipSignal := nil.
self applyChange:changeNr.
self autoSelect:(changeNr + 1)
]
!
doApplyAll
"user wants all changes to be applied"
self withExecuteCursorDo:[
|lastNr "{ Class: SmallInteger }" |
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
1 to:lastNr do:[:changeNr |
changeListView setSelection:changeNr.
self applyChange:changeNr
].
self autoSelectLast
]
"Modified: 21.1.1997 / 22:26:30 / cg"
!
doApplyClassRest
"user wants all changes for this class from changeNr to be applied"
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
|thisClassName classNameToApply lastChange
lastNr "{ Class: SmallInteger }" |
classNameToApply := self classNameOfChange:changeNr.
classNameToApply notNil ifTrue:[
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
changeNr to:lastNr do:[:changeNr |
thisClassName := self classNameOfChange:changeNr.
thisClassName = classNameToApply ifTrue:[
changeListView setSelection:changeNr.
self applyChange:changeNr.
lastChange := changeNr
].
].
self autoSelect:lastChange.
]
]
"Modified: 21.1.1997 / 22:26:04 / cg"
!
doApplyRest
"user wants all changes from changeNr to be applied"
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
|lastNr "{ Class: SmallInteger }" |
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
changeNr to:lastNr do:[:changeNr |
changeListView setSelection:changeNr.
self applyChange:changeNr
].
self autoSelect:self numberOfChanges.
]
"Modified: 21.1.1997 / 22:25:29 / cg"
!
doBrowse
"user wants a browser on the class of a change"
|changeNr cls|
(changeNr := self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
cls := self classOfChange:changeNr.
cls notNil ifTrue:[
UserPreferences systemBrowserClass
openInClass:cls
selector:(self selectorOfMethodChange:changeNr)
]
!
doBrowseImplementors
"open an implementors-browser"
|changeNr initial selector|
(changeNr := self theSingleSelection) notNil ifTrue:[
initial := self selectorOfMethodChange:changeNr.
].
selector := Dialog
request:'Selector to browse implementors of:'
initialAnswer:(initial ? '').
selector size ~~ 0 ifTrue:[
UserPreferences systemBrowserClass
browseImplementorsOf:selector asSymbol.
]
!
doBrowseSenders
"user wants a browser on the class of a change"
|changeNr initial selector|
(changeNr := self theSingleSelection) notNil ifTrue:[
initial := self selectorOfMethodChange:changeNr.
].
selector := Dialog
request:'Selector to browse senders of:'
initialAnswer:(initial ? '').
selector size ~~ 0 ifTrue:[
UserPreferences systemBrowserClass
browseAllCallsOn:selector asSymbol.
]
!
doCheckinAndDeleteClassAll
"first checkin the selected changes class then delete all changes
for it."
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
| className class |
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
class := Smalltalk classNamed:className.
class isNil ifTrue:[
self halt:'oops - no such class'.
].
class notNil ifTrue:[
class isPrivate ifTrue:[
(self confirm:('This is a private class.\\CheckIn the owner ''%1'' and all of its private classes ?' bindWith:class owningClass name allBold) withCRs)
ifFalse:[^ self].
(SourceCodeManagerUtilities checkinClass:class owningClass withLog:nil)
ifTrue:[
self doDeleteClassAndPrivateClassesAll
]
] ifFalse:[
(SourceCodeManagerUtilities checkinClass:class withLog:nil)
ifTrue:[
self doDeleteClassAll
]
]
].
].
]
"Modified: 6.9.1995 / 17:11:16 / claus"
!
doCompare
"compare change with current system version
- give a note in transcript"
|changeNr|
(changeNr := self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withExecuteCursorDo:[
self compareChange:changeNr
].
self newLabel:''
"Modified: 24.2.1996 / 19:37:19 / cg"
!
doCompareAndCompress
"remove all changes, which are equivalent to the current image version"
|toDelete|
toDelete := OrderedCollection new.
self withExecuteCursorDo:[
1 to:self numberOfChanges do:[:changeNr |
(self compareChange:changeNr showResult:false) == true ifTrue:[
toDelete add:changeNr
]
].
].
toDelete reverseDo:[:changeNr |
self silentDeleteChange:changeNr.
].
self setChangeList.
"
scroll back a bit, if we are left way behind the list
"
changeListView firstLineShown > self numberOfChanges ifTrue:[
changeListView makeLineVisible:self numberOfChanges
].
self clearCodeView.
self newLabel:''
!
doCompress
"compress the change-set; this replaces multiple method-changes by the last
(i.e. the most recent) change"
self compressForClass:nil
"Modified: / 29.10.1997 / 01:03:26 / cg"
!
doCompressClass
"compress changes for the selected class.
this replaces multiple method-changes by the last (i.e. the most recent) change."
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
| classNameToCompress |
classNameToCompress := self classNameOfChange:changeNr.
classNameToCompress notNil ifTrue:[
self compressForClass:classNameToCompress.
]
]
"Created: / 29.10.1997 / 01:05:16 / cg"
"Modified: / 29.10.1997 / 01:06:22 / cg"
!
doDelete
"delete currently selected change(s)"
self withSelectedChangesReverseDo:[:changeNr |
self deleteChange:changeNr.
self autoSelectOrEnd:changeNr
]
!
doDeleteAndSelectPrevious
"delete currently selected change(s)"
self withSelectedChangesReverseDo:[:changeNr |
self deleteChange:changeNr.
self autoSelectOrEnd:changeNr-1
]
!
doDeleteClassAll
"delete all changes with same class as currently selected change"
|classNamesToDelete lastChangeNr overAllNumDeletedBefore|
lastChangeNr := -1.
classNamesToDelete := Set new.
self withSelectedChangesDo:[:changeNr |
|classNameToDelete|
classNameToDelete := self classNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
classNamesToDelete add:classNameToDelete.
].
lastChangeNr := lastChangeNr max:changeNr.
].
overAllNumDeletedBefore := 0.
changeListView setSelection:nil.
self withExecuteCursorDo:[
classNamesToDelete do:[:classNameToDelete |
|numDeletedBefore|
self silentDeleteChangesFor:classNameToDelete
from:lastChangeNr
to:(self numberOfChanges).
numDeletedBefore := self
silentDeleteChangesFor:classNameToDelete
from:1
to:(lastChangeNr-1).
lastChangeNr := lastChangeNr - numDeletedBefore.
overAllNumDeletedBefore := overAllNumDeletedBefore + numDeletedBefore.
].
].
self setChangeList.
self autoSelectOrEnd:lastChangeNr
"Created: / 13.12.1995 / 16:07:14 / cg"
"Modified: / 28.1.1998 / 20:42:14 / cg"
!
doDeleteClassAndPrivateClassesAll
"delete all changes with same class and private classes
as currently selected change"
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
|classNameToDelete numDeletedBefore|
classNameToDelete := self ownerClassNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
changeListView setSelection:nil.
self silentDeleteChangesForClassAndPrivateClasses:classNameToDelete
from:changeNr
to:(self numberOfChanges).
numDeletedBefore := self
silentDeleteChangesForClassAndPrivateClasses:classNameToDelete
from:1
to:(changeNr-1).
self setChangeList.
self autoSelectOrEnd:(changeNr - numDeletedBefore)
]
]
"Created: / 13.12.1995 / 16:07:14 / cg"
"Modified: / 28.1.1998 / 20:42:14 / cg"
!
doDeleteClassFromBeginning
"delete changes with same class as currently selected change from the beginning
up to the selected change.
Useful to get rid of obsolete changes before a fileout or checkin entry."
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
|classNameToDelete prevSelection numDeleted|
classNameToDelete := self classNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
prevSelection := changeNr.
changeListView setSelection:nil.
numDeleted := self
silentDeleteChangesFor:classNameToDelete
from:1
to:changeNr.
self setChangeList.
self autoSelectOrEnd:(changeNr + 1 - numDeleted)
]
].
"Created: 13.12.1995 / 15:41:58 / cg"
"Modified: 25.5.1996 / 12:26:34 / cg"
!
doDeleteClassRest
"delete rest of changes with same class as currently selected change"
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
| classNameToDelete |
classNameToDelete := self classNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
changeListView setSelection:nil.
self silentDeleteChangesFor:classNameToDelete
from:changeNr
to:(self numberOfChanges).
self setChangeList.
self autoSelectOrEnd:changeNr
]
]
"Modified: / 18.5.1998 / 14:25:07 / cg"
!
doDeleteRest
"delete all changes from current to the end"
|changeNr|
(changeNr := self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self deleteChangesFrom:changeNr to:(self numberOfChanges).
self clearCodeView.
self autoSelectOrEnd:changeNr-1
!
doFileoutAndDeleteClassAll
"first fileOut the selected changes class then delete all changes
for it."
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesDo:[:changeNr |
| className class |
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
class := Smalltalk classNamed:className.
class notNil ifTrue:[
Class fileOutErrorSignal handle:[:ex |
self warn:('fileout failed: ' , ex description).
] do:[
class fileOut.
self doDeleteClassAll
].
].
].
]
"Modified: 6.9.1995 / 17:11:16 / claus"
!
doMakePatch
"user wants a change to be made a patch
- copy it over to the patches file"
self withSelectedChangesDo:[:changeNr |
self makeChangeAPatch:changeNr.
self autoSelect:(changeNr + 1)
]
!
doMakePermanent
"user wants a change to be made permanent
- rewrite the source file where this change has to go"
|yesNoBox|
(self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
yesNoBox := YesNoBox new.
yesNoBox title:(resources at:'Warning: this operation cannot be undone').
yesNoBox okText:(resources at:'continue') noText:(resources at:'abort').
yesNoBox okAction:[ |changeNr|
changeNr := self theSingleSelection.
changeNr notNil ifTrue:[
self makeChangePermanent:changeNr.
self autoSelect:(changeNr + 1)
]
].
yesNoBox showAtPointer.
yesNoBox destroy
"Modified: 7.1.1997 / 23:03:33 / cg"
!
doSave
"user wants a change to be appended to a file"
|fileName|
self withSelectedChangesDo:[:changeNr |
fileName := Dialog
requestFileName:'append change to:'
default:(lastSaveFileName ? '')
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
lastSaveFileName := fileName.
self withCursor:(Cursor write) do:[
self appendChange:changeNr toFile:fileName.
].
self autoSelect:(changeNr + 1)
].
]
!
doSaveClass
"user wants changes for some class from current to end to be appended to a file"
(self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self doSaveClassFrom:1
!
doSaveClassAll
"user wants changes for some class from current to end to be appended to a file"
(self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self doSaveClassFrom:1
!
doSaveClassFrom:startNr
"user wants changes from current to end to be appended to a file"
|changeNr classNameToSave|
(changeNr := self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
classNameToSave := self classNameOfChange:changeNr.
classNameToSave notNil ifTrue:[
self saveClass:classNameToSave from:startNr
]
!
doSaveClassRest
"user wants changes for some class from current to end to be appended to a file"
|changeNr|
(changeNr := self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self doSaveClassFrom:changeNr
!
doSaveRest
"user wants changes from current to end to be appended to a file"
|changeNr fileName|
(changeNr := self theSingleSelection) isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
fileName := Dialog
requestFileName:'append changes to:'
default:(lastSaveFileName ? '')
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
lastSaveFileName := fileName.
self withCursor:(Cursor write) do:[
changeNr to:(self numberOfChanges) do:[:changeNr |
changeListView setSelection:changeNr.
(self appendChange:changeNr toFile:fileName) ifFalse:[
^ self
]
]
]
]
"Modified: 25.5.1996 / 12:26:41 / cg"
!
doUpdate
"reread the changes-file"
self readChangesFileInBackground:true.
realized ifTrue:[
self setChangeList.
]
!
doWriteBack
"write back the list onto the changes file"
anyChanges ifTrue:[
(self writeBackChanges) ifTrue:[
realized ifTrue:[
self readChangesFileInBackground:false.
realized ifTrue:[
self setChangeList
]
]
]
]
"Modified: 5.9.1996 / 17:19:46 / cg"
!
doubleClickOnChange:lineNr
"action performed when a change-list entry is doubleClicked"
self doBrowse
"Created: / 6.2.1998 / 13:08:49 / cg"
!
findClass
"findClass menu action: let user enter a classes name, and select the next change for that class"
|current|
changeNrShown notNil ifTrue:[
current := self classNameOfChange:changeNrShown.
].
self
askForSearch:'Class to search for:'
initialAnswer:current
thenSearchUsing:[:searchString :changeNr |
|thisClass|
thisClass := self classNameOfChange:changeNr.
(thisClass = searchString
or:[searchString includesMatchCharacters and:[searchString match:thisClass]])
]
onCancel:[^ self].
lastSearchType := #class.
changeNrShown == 0 ifTrue:[changeNrShown := nil].
!
findNext
"findNext menu action: select the next change.
Searches for what the last search was for; i.e. either same class or same selector"
lastSearchType == #selector ifTrue:[
^ self findNextForSelector
].
lastSearchType == #snapshot ifTrue:[
^ self findNextSnapshot
].
lastSearchType == #string ifTrue:[
^ self findNextForString
].
^ self findNextForClass
"Created: / 18.6.1998 / 22:15:00 / cg"
"Modified: / 18.6.1998 / 22:15:25 / cg"
!
findNextForClass
"findNextForClass menu action: select the next change for the selected changes class"
|cls|
lastSearchType := #class.
changeNrShown isNil ifTrue:[^ self].
cls := self classNameOfChange:changeNrShown.
cls isNil ifTrue:[^ self].
self findNextForWhich:
[:changeNr | |thisClass|
thisClass := self classNameOfChange:changeNr.
(thisClass = cls or:[cls includesMatchCharacters and:[cls match:thisClass]])
]
!
findNextForSelector
"findNextForSelector menu action: select the next change for the selected changes selector"
|sel|
lastSearchType := #selector.
changeNrShown isNil ifTrue:[^ self].
sel := self selectorOfMethodChange:changeNrShown.
sel isNil ifTrue:[^ self].
self findNextForWhich:
[:changeNr | |thisSelector|
thisSelector := self selectorOfMethodChange:changeNr.
(thisSelector = sel or:[sel includesMatchCharacters and:[sel match:thisSelector]])
]
!
findNextForString
self findNextWithString:lastSearchString
!
findNextForWhich:aBlock
"helper: select the next change for which aBlock evaluates to true"
self withCursor:Cursor questionMark do:[
Object userInterruptSignal handle:[:ex |
self beep.
^ 0
] do:[
|lastNr nr|
lastNr := self numberOfChanges.
nr := changeNrShown + 1.
[nr <= lastNr] whileTrue:[
(aBlock value:nr) ifTrue:[
changeListView setSelection:nr .
self changeSelection:nr.
^ nr
].
nr := nr + 1.
].
].
].
self showNotFound.
self windowGroup sensor flushKeyboard. "/ avoid multiple beeps, in case of type ahead
^ 0
!
findNextSnapshot
"findNextSnapshot menu action: select the next change which is for a snapShot-image save action"
lastSearchType := #snapshot.
changeNrShown isNil ifTrue:[^ self].
self findNextForWhich: [:changeNr | self changeIsSnapShotInfo:changeNr ]
!
findNextWithString:searchString
lastSearchType := #string.
lastSearchString := searchString.
changeNrShown isNil ifTrue:[
changeNrShown := 0.
].
self findNextForWhich:
[:changeNr |
|s|
s := self sourceOfMethodChange:changeNr.
s notNil and:[
(searchString includesMatchCharacters not
and:[(s findString:searchString) ~~ 0])
or:[ searchString includesMatchCharacters
and:[s match:('*' , searchString , '*')]]]
].
changeNrShown == 0 ifTrue:[changeNrShown := nil].
codeView setSearchPattern:searchString.
codeView
searchFwd:searchString
ignoreCase:false
startingAtLine:1 col:0
ifAbsent:nil.
!
findPrevious
"findPrevious menu action: select the previous change.
Searches for what the last search was for; i.e. either same class or same selector"
lastSearchType == #selector ifTrue:[
^ self findPreviousForSelector
].
lastSearchType == #snapshot ifTrue:[
^ self findPreviousSnapshot
].
lastSearchType == #string ifTrue:[
^ self findPreviousForString
].
^ self findPreviousForClass
"Created: / 18.6.1998 / 22:15:15 / cg"
!
findPreviousForClass
"findPreviousForClass menu action: select the previous change for the selected changes class"
|cls|
lastSearchType := #class.
changeNrShown isNil ifTrue:[^ self].
cls := self classNameOfChange:changeNrShown.
cls isNil ifTrue:[^ self].
self findPreviousForWhich:
[:changeNr | |thisClass|
thisClass := self classNameOfChange:changeNr.
(thisClass = cls or:[cls includesMatchCharacters and:[cls match:thisClass]])
]
!
findPreviousForSelector
"findPreviousForSelector menu action: select the previous change for the selected changes selector"
|sel|
lastSearchType := #selector.
changeNrShown isNil ifTrue:[^ self].
sel := self selectorOfMethodChange:changeNrShown.
sel isNil ifTrue:[^ self].
self findPreviousForWhich:
[:changeNr | |thisSelector|
thisSelector := self selectorOfMethodChange:changeNr.
(thisSelector = sel or:[sel includesMatchCharacters and:[sel match:thisSelector]])
]
!
findPreviousForString
self findPreviousWithString:lastSearchString
!
findPreviousForWhich:aBlock
"helper: select the previous change for which aBlock evaluates to true"
self withCursor:Cursor questionMark do:[
Object userInterruptSignal handle:[:ex |
self beep.
^ 0
] do:[
|nr|
nr := changeNrShown - 1.
[nr >= 1] whileTrue:[
(aBlock value:nr) ifTrue:[
changeListView setSelection:nr .
self changeSelection:nr.
^ nr
].
nr := nr - 1.
].
]
].
self showNotFound.
self windowGroup sensor flushKeyboard. "/ avoid multiple beeps, in case of type ahead
^ 0
!
findPreviousSnapshot
"findPreviousSnapshot menu action: select the previous change which is for a snapShot-image save action"
lastSearchType := #snapshot.
changeNrShown isNil ifTrue:[^ self].
self findPreviousForWhich: [:changeNr | self changeIsSnapShotInfo:changeNr ]
!
findPreviousWithString:searchString
lastSearchType := #string.
lastSearchString := searchString.
changeNrShown isNil ifTrue:[
changeNrShown := 0.
].
self findPreviousForWhich:
[:changeNr |
|s includesMatchCharacters|
includesMatchCharacters := searchString includesMatchCharacters.
s := self sourceOfMethodChange:changeNr.
s notNil and:[
(includesMatchCharacters not and:[(s findString:searchString) ~~ 0])
or:[includesMatchCharacters and:[s match:('*' , searchString , '*')]]]
].
changeNrShown == 0 ifTrue:[changeNrShown := nil].
codeView setSearchPattern:searchString.
codeView
searchFwd:searchString
ignoreCase:false
startingAtLine:1 col:0
ifAbsent:nil.
!
findSelector
"findSelector menu action: let user enter a selector, and select the next change for that selector"
|current|
changeNrShown notNil ifTrue:[
current := self selectorOfMethodChange:changeNrShown.
].
self
askForSearch:'Selector to search for:'
initialAnswer:current
thenSearchUsing:[:searchString :changeNr |
|thisSelector|
thisSelector := self selectorOfMethodChange:changeNr.
(thisSelector = searchString
or:[searchString includesMatchCharacters and:[searchString match:thisSelector]])
]
onCancel:[^ self].
lastSearchType := #selector.
changeNrShown == 0 ifTrue:[changeNrShown := nil].
!
findString
|searchString directionHolder|
lastSearchType := #string.
searchString := codeView selection.
searchString size == 0 ifTrue:[searchString := lastSearchString].
searchString := self
askForSearchString:'String to search for:'
initialAnswer:searchString
directionInto:(directionHolder := ValueHolder new).
searchString isNil ifTrue:[
^ self
].
directionHolder value == #backward ifTrue:[
self findPreviousWithString:searchString.
] ifFalse:[
self findNextWithString:searchString.
]
!
noChangesAllowed
"show a warning that changes cannot be changed"
self warn:'Changes are not allowed to be changed.'
!
saveClass:aClassName from:startNr
"user wants changes from current to end to be appended to a file"
|changeNr fileName|
changeNr := changeListView selection.
changeNr notNil ifTrue:[
fileName := Dialog
requestFileName:'append changes for class to:'
default:(lastSaveFileName ? '')
ok:'append'
abort:'abort'
pattern:'*.chg'.
fileName notNil ifTrue:[
lastSaveFileName := fileName.
self withCursor:(Cursor write) do:[
startNr to:(self numberOfChanges) do:[:changeNr |
|thisClassName|
thisClassName := self classNameOfChange:changeNr.
thisClassName = aClassName ifTrue:[
self setSingleSelection:changeNr.
(self appendChange:changeNr toFile:fileName) ifFalse:[
^ self
]
]
]
]
].
]
"Modified: 25.5.1996 / 12:26:44 / cg"
!
setEnforcedPackage
|pkg listOfKnownPackages|
listOfKnownPackages := Set new.
Smalltalk allClassesDo:[:eachClass |
|package|
package := eachClass package.
package size > 0 ifTrue:[
listOfKnownPackages add:package
]
].
listOfKnownPackages := listOfKnownPackages asOrderedCollection sort.
pkg := Dialog
request:'When Applying, changes go into package:'
initialAnswer:(enforcedPackage ? Class packageQuerySignal query)
list:listOfKnownPackages.
pkg size ~~ 0 ifTrue:[
enforcedPackage := pkg
]
! !
!ChangesBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/ChangesBrowser.st,v 1.235 2001-10-18 13:00:12 cg Exp $'
! !