"
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 diffView 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 enforcedNameSpace updateChangeSet
showingDiffs diffViewBox autoloadAsRequired'
classVariableNames:'CompressSnapshotInfo NoColoring ShowWarningDialogs DefaultIcon
DefaultAutoCompare DefaultShowingDiffs'
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
This is a very old leftover class (The Merovingian has not yet detected this one ;-)
It will be completely replaced by the ChangeSetBrowser class in the near future.
[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 a changes browser on a change file"
|browser|
(self isXMLFile:aFileName) ifTrue:[
browser := ChangeSetBrowser new
] ifFalse:[
browser := self new
].
browser label:(self defaultLabel , ': ', aFileName).
browser changeFileName:aFileName.
browser open.
^ browser
! !
!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
^ self classResources string:'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'
itemValue: doCompress
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
enabled: hasSingleSelection
label: 'Compress for Class'
itemValue: doCompressClass
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
enabled: hasSingleSelection
label: 'Compress for Class && Selector'
itemValue: doCompressSelector
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
label: 'Compare and Compress'
itemValue: doCompareAndCompress
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
label: '-'
isVisible: notEditingClassSource
)
(MenuItem
enabled: hasSingleSelection
label: 'Fileout && Delete all Changes for Class'
itemValue: doFileoutAndDeleteClassAll
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
enabled: hasSelection
label: 'CheckIn && Delete all Changes for Class'
itemValue: doCheckinAndDeleteClassAll
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
label: '-'
isVisible: notEditingClassSource
)
(MenuItem
enabled: hasSelection
label: 'Save In...'
itemValue: doSave
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Save to End In...'
itemValue: doSaveRest
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Save for Class to End In...'
itemValue: doSaveClassRest
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Save all for Class In...'
itemValue: doSaveClassAll
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Writeback ClassFile'
itemValue: doWriteBack
translateLabel: true
isVisible: editingClassSource
)
(MenuItem
label: 'Writeback ChangeFile'
itemValue: doWriteBack
translateLabel: true
isVisible: notEditingClassSource
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: doUpdate
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Exit'
itemValue: menuExit
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Change'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSelection
label: 'Apply'
itemValue: doApply
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Apply to End'
itemValue: doApplyRest
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Apply from Begin'
itemValue: doApplyFromBeginning
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Apply for Class to End'
itemValue: doApplyClassRest
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Apply for Class from Begin'
itemValue: doApplyClassFromBeginning
translateLabel: true
)
(MenuItem
enabled: hasNoSelection
label: 'Apply All'
itemValue: doApplyAll
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Apply to Conflict or End'
itemValue: doApplyToConflictOrEnd
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelection
label: 'Delete'
itemValue: doDelete
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Delete to End'
itemValue: doDeleteRest
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Delete from Begin'
itemValue: doDeleteFromBeginning
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Delete for Class to End'
itemValue: doDeleteClassRest
translateLabel: true
)
(MenuItem
enabled: hasSingleSelection
label: 'Delete for Class from Begin'
itemValue: doDeleteClassFromBeginning
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Delete all for Class'
itemValue: doDeleteClassAll
translateLabel: true
isVisible: hasNoMultiSelection
)
(MenuItem
enabled: hasSelection
label: 'Delete all for Class && its Private Classes'
itemValue: doDeleteClassAndPrivateClassesAll
translateLabel: true
isVisible: hasNoMultiSelection
)
(MenuItem
enabled: hasSelection
label: 'Delete all for Classes'
itemValue: doDeleteClassAll
translateLabel: true
isVisible: hasMultiSelection
)
(MenuItem
enabled: hasSelection
label: 'Delete all for Classes && their Private Classes'
itemValue: doDeleteClassAndPrivateClassesAll
translateLabel: true
isVisible: hasMultiSelection
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelection
label: 'Delete all Versions of Selected Method'
itemValue: doDeleteClassSelectorAll
translateLabel: true
isVisible: hasNoMultiSelection
)
(MenuItem
enabled: hasSelection
label: 'Delete all Versions of all Selected Methods'
itemValue: doDeleteClassSelectorAll
translateLabel: true
isVisible: hasMultiSelection
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSingleSelection
label: 'Compare with Current'
itemValue: doCompare
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelection
label: 'Make Change a Patch'
itemValue: doMakePatch
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Search'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Class...'
itemValue: findClass
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Previous for Class'
itemValue: findPreviousForClass
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Next for Class'
itemValue: findNextForClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Selector...'
itemValue: findSelector
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Previous for Selector'
itemValue: findPreviousForSelector
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Next for Selector'
itemValue: findNextForSelector
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'String...'
itemValue: findString
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Previous with String'
itemValue: findPreviousForString
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Next with String'
itemValue: findNextForString
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelection
label: 'Previous Difference'
itemValue: findPreviousDifference
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Next Difference'
itemValue: findNextDifference
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelection
label: 'Previous Snapshot'
itemValue: findPreviousSnapshot
translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Next Snapshot'
itemValue: findNextSnapshot
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Browse'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSingleSelection
label: 'Class'
itemValue: doBrowse
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Senders...'
itemValue: doBrowseSenders
translateLabel: true
)
(MenuItem
label: 'Implementors...'
itemValue: doBrowseImplementors
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Settings'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Auto Compare'
translateLabel: true
indication: autoCompare
)
(MenuItem
label: 'Autoload As Required'
translateLabel: true
indication: autoloadAsRequired
)
(MenuItem
label: 'Show Diffs'
translateLabel: true
indication: showingDiffs
)
(MenuItem
label: 'Auto Update'
translateLabel: true
indication: autoUpdate
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Add to ChangeSet when Applying'
translateLabel: true
indication: updateChangeSet
)
(MenuItem
label: 'Apply in Original NameSpace'
translateLabel: true
indication: applyInOriginalNameSpace
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Apply into Package...'
itemValue: setEnforcedPackage
translateLabel: true
)
(MenuItem
enabled: applyNotInOriginalNameSpace
label: 'Apply into NameSpace...'
itemValue: setEnforcedNameSpace
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Help'
translateLabel: true
startGroup: right
submenu:
(Menu
(
(MenuItem
label: 'ChangesBrowser Documentation'
itemValue: openHTMLDocument:
translateLabel: true
argument: 'tools/cbrowser/TOP.html'
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About ChangesBrowser...'
itemValue: openAboutThisApplication
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
! !
!ChangesBrowser class methodsFor:'private-changeFile access'!
readXMLChangesFrom:aStream inBackground:inBackground
"read an XML source file (format as in campSmalltalk DTD)"
|changeSet|
(XML isNil or:[XML::SourceNodeBuilder isNil or:[XML::XMLParser isNil]]) ifTrue:[
Smalltalk loadPackage:'stx:goodies/xml/vw'.
(XML isNil or:[XML::SourceNodeBuilder isNil or:[XML::XMLParser isNil]]) ifTrue:[
self error:'Could not load XML package(s) from ''stx:goodies/xml/vw'''.
]
].
changeSet := ChangeSet new.
XML::SourceScannerNodeBuilder new
scanFile:aStream
do:[:eachChange |
changeSet addChange:eachChange.
].
^ changeSet
"/ builder := XML::SourceScannerNodeBuilder new.
"/ parser := XML::XMLParser on:aStream.
"/ parser builder:builder.
"/ parser validate:false.
"/ parser scanDocument.
!
readXMLChangesFromFile:changeFileName inBackground:inBackground
|s set|
s := changeFileName asFilename readStream.
set := self readXMLChangesFrom:s inBackground:inBackground.
s close.
^ set.
! !
!ChangesBrowser class methodsFor:'utilities'!
isXMLFile:aFilename
|stream first|
stream := aFilename asFilename readStreamOrNil.
stream isNil ifTrue:[^ false].
stream skipSeparators.
first := stream peek.
stream close.
^ first == $<
! !
!ChangesBrowser methodsFor:'aspects'!
applyInOriginalNameSpace
^ applyInOriginalNameSpace
!
applyNotInOriginalNameSpace
^ BlockValue forLogicalNot:self 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"
!
autoloadAsRequired
^ autoloadAsRequired
!
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
!
showingDiffs
showingDiffs isNil ifTrue:[
showingDiffs := self showingDiffsDefault asValue.
showingDiffs
onChangeEvaluate:[
showingDiffs value ifTrue:[
self updateDiffView.
self makeDiffViewVisible
] ifFalse:[
self makeDiffViewInvisible
].
DefaultShowingDiffs := showingDiffs value.
]
].
^ showingDiffs
!
showingDiffsDefault
^ (DefaultShowingDiffs ? true)
!
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'
image:(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:[
AbortOperationRequest raise.
^ false
].
action == #skip ifTrue:[
skipSignal raise.
^ false
].
^ false
].
^ codeView error:aString position:relPos to:relEndPos from:aCompiler
"Modified: / 16.11.2001 / 17:38:10 / 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 sensor shiftDown ifTrue:[
self doDeleteAndSelectPrevious.
] ifFalse:[
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:'initialization & release'!
autoCompareChanged
"sent from the compare-toggle"
|doCompare|
doCompare := autoCompare value.
DefaultAutoCompare := doCompare.
self setupTabSpec.
doCompare ifTrue:[
self doUpdate
] ifFalse:[
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 from Begin' doApplyFromBeginning )
('Apply for Class to End' doApplyClassRest )
('Apply for Class from Begin' doApplyClassFromBeginning )
('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)
] 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: / 17.11.2001 / 14:16:14 / 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 oldStyle codeViewBox lbl|
"/ oldStyle := true.
oldStyle := false.
super initialize.
changeFileName := ObjectMemory nameForChanges.
autoCompare := (DefaultAutoCompare ? false) asValue.
autoCompare onChangeSend:#autoCompareChanged to:self.
autoUpdate := false asValue.
autoloadAsRequired := false asValue.
applyInOriginalNameSpace := true asValue.
applyInOriginalNameSpace
onChangeEvaluate:[
autoCompare value ifTrue:[
self doUpdate
].
].
updateChangeSet := true "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.
codeViewBox := View in:panel.
codeViewBox origin:(0.0 @ 0.3) corner:(1.0 @ 1.0).
v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:codeViewBox.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
codeView := v scrolledView.
codeView readOnly:true.
diffViewBox := View in:codeViewBox.
diffViewBox origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
lbl := Label label:'Current' in:diffViewBox.
lbl layout:(LayoutFrame
leftFraction:0.0 offset:0
rightFraction:0.5 offset:0
topFraction:0.0 offset:0
bottomFraction:0.0 offset:20).
lbl := Label label:'Change' in:diffViewBox.
lbl layout:(LayoutFrame
leftFraction:0.5 offset:0
rightFraction:1.0 offset:0
topFraction:0.0 offset:0
bottomFraction:0.0 offset:20).
"/ diffView := DiffTextView in:diffViewBox.
"/ diffView layout:(LayoutFrame
"/ leftFraction:0.0 offset:0
"/ rightFraction:1.0 offset:0
"/ topFraction:0.0 offset:20
"/ bottomFraction:1.0 offset:0).
v := HVScrollableView for:DiffTextView miniScrollerH:true miniScrollerV:false in:diffViewBox.
v layout:(LayoutFrame
leftFraction:0.0 offset:0
rightFraction:1.0 offset:0
topFraction:0.0 offset:20
bottomFraction:1.0 offset:0).
diffView := v scrolledView.
self showingDiffs value ifFalse:[
self makeDiffViewInvisible
].
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 setupTabSpec.
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>
^ self menuFromSpec:self class menuSpec.
"/ |m|
"/
"/ m := self class menuSpec.
"/ m := m decodeAsLiteralArray.
"/ m receiver:self.
"/ m findGuiResourcesIn:self.
"/ ^ m.
!
setupTabSpec
autoCompare value ifTrue:[
tabSpec positions:#(0 0.15 5 8.5 ).
] ifFalse:[
"/
"/ set tabs to hide compare-column
"/
tabSpec positions:#(-1 0 5 8.5 ).
]
!
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."
DialogBox aboutClass:self class.
"/ |rev myClass clsRev msg|
"/
"/ rev := ''.
"/ myClass := self class.
"/
"/ (clsRev := myClass revision) notNil ifTrue: [rev := ' (rev: ', clsRev printString, ')'].
"/
"/ msg := '\' withCRs , myClass name asBoldText, rev.
"/
"/ Dialog
"/ about:(resources string:msg)
"/ label:(resources string:'About ChangesBrowser')
"/ icon:self class defaultIcon
"/
"/ "Modified: / 17.11.2001 / 23:07:33 / 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:[
last == 0 ifTrue:[
last := nil
].
changeListView setSelection:last .
self changeSelection:last.
]
"Modified: / 13.11.2001 / 13:00:45 / cg"
!
checkClassIsLoaded:aClass
"check for and warn if a class is unloaded (helper for compare-change)"
|cls answer|
cls := aClass theNonMetaclass.
cls isLoaded ifTrue:[
^ true.
].
autoloadAsRequired value == true ifTrue:[
answer := true
] ifFalse:[
answer := (self confirmWithCancel:(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).
].
answer == true ifTrue:[
^ cls autoload isLoaded
].
answer isNil ifTrue:[
"cancel the operation"
AbortAllOperationRequest raiseRequest.
^ false.
].
"cancel operation for this change, (but possibly continue with others)"
AbortOperationRequest raiseRequest.
^ false.
!
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
!
extractClassAndClassNameFromParseTree:rec
|isUnaryMessage className changeClass|
isUnaryMessage := rec isUnaryMessage.
isUnaryMessage ifTrue:[
className := rec receiver name.
] ifFalse:[
className := rec name.
].
enforcedNameSpace notNil ifTrue:[
changeClass := enforcedNameSpace classNamed:className.
].
changeClass isNil ifTrue:[
changeClass := Smalltalk classNamed:className.
].
isUnaryMessage ifTrue:[
changeClass notNil ifTrue:[
changeClass := changeClass class.
].
className := className , ' class'.
].
^ className -> changeClass
!
isChangeSetBrowser
^ false
!
makeDiffViewInvisible
diffViewBox lower
!
makeDiffViewVisible
diffViewBox raise
!
nameSpaceForApply
applyInOriginalNameSpace value ifFalse:[
^ enforcedNameSpace ? Class nameSpaceQuerySignal query.
].
^ Smalltalk.
!
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"
!
oldSourceForParseTree:parseTree
|selector thisClass method superClass thisClassSym ownerClass receiver classGlobalNode|
(parseTree isNil
or:[parseTree == #Error
or:[ parseTree isMessage not ]]) ifTrue:[
^ nil
].
selector := parseTree selector.
receiver := parseTree receiver.
selector == #'removeSelector:' ifTrue:[
thisClass := receiver evaluate.
thisClass isBehavior ifTrue:[
thisClass isLoaded ifTrue:[
selector := (parseTree arg1 evaluate).
(thisClass includesSelector:selector) ifTrue:[
^ (thisClass compiledMethodAt:selector) source.
]
] ifFalse:[
^ 'Cannot compare this change\\(compare requires class to be loaded).' withCRs.
]
] ifFalse:[
^ 'Cannot compare this change (class not present)'.
].
].
selector == #'comment:' ifTrue:[
thisClass := receiver evaluate.
thisClass isBehavior ifTrue:[
thisClass isLoaded ifTrue:[
^ thisClass name , ' comment: ' , thisClass comment storeString.
] ifFalse:[
^ 'Cannot compare this change\\(compare requires class to be loaded).' withCRs.
]
] ifFalse:[
^ 'Cannot compare this change (class not present)'.
].
].
selector == #'category:' ifTrue:[
receiver isMessage ifTrue:[
receiver selector == #compiledMethodAt: ifTrue:[
classGlobalNode := receiver receiver.
(classGlobalNode isMessage and:[classGlobalNode selector == #class]) ifTrue:[
classGlobalNode := classGlobalNode receiver
].
classGlobalNode isUndeclared ifTrue:[
^ 'Class does not exist.'.
].
Error handle:[method := nil] do:[method := receiver evaluate].
method isMethod ifTrue:[
method category = parseTree arg1 evaluate ifFalse:[
^ '(' , method class name , ' compiledMethodAt: ' , method selector storeString , ') category: ' , method category storeString.
]
] ifFalse:[
^ 'There is no such method'.
]
]
]
].
selector == #'instanceVariableNames:' ifTrue:[
receiver isMessage ifTrue:[
receiver selector == #class ifTrue:[
thisClass := receiver evaluate.
thisClass isBehavior ifTrue:[
thisClass isLoaded ifTrue:[
"/ varsHere := thisClass instanceVariableString asCollectionOfWords.
"/ varsInChange := (parseTree arguments at:1) evaluate asCollectionOfWords.
^ thisClass definition.
] ifFalse:[
^ 'Cannot compare this change\\(compare requires class to be loaded).' withCRs.
].
] ifFalse:[
^ 'Cannot compare this change (class not present)'.
]
].
]
].
(Class definitionSelectors includes:selector)
"/ selector == #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
ifTrue:[
superClass := receiver evaluate.
superClass isBehavior ifFalse:[
^ 'Cannot compare this change\\(no such superclass).' withCRs.
] ifTrue:[
superClass isLoaded ifFalse:[
^ 'Cannot compare this change\\(superclass not loaded).' withCRs.
] ifTrue:[
thisClassSym := (parseTree arguments at:1) evaluate.
(selector endsWith:':privateIn:') ifTrue:[
ownerClass := (parseTree arguments at:5).
ownerClass isUndeclared ifFalse:[
ownerClass := ownerClass evaluate.
] ifTrue:[
ownerClass := nil.
].
ownerClass isNil ifTrue:[
^ 'Cannot compare this change\\(owning class is not loaded).' withCRs.
].
thisClass := ownerClass privateClassesAt:thisClassSym.
] ifFalse:[
thisClass := (self nameSpaceForApply) at:thisClassSym ifAbsent:nil.
].
thisClass notNil ifTrue:[
thisClass isLoaded ifFalse:[
^ 'Cannot compare this change\\(compare requires class to be loaded).' withCRs.
] ifTrue:[
^ thisClass definition.
]
]
]
]
].
^ nil.
!
queryCloseText
"made this a method for easy redefinition in subclasses"
^ 'Quit without updating changeFile ?'
!
selectedClassNames
|classes|
classes := Set new.
self withSelectedChangesDo:[:changeNr |
| classNameToCompress |
classNameToCompress := self classNameOfChange:changeNr.
classNameToCompress notNil ifTrue:[
classes add:classNameToCompress.
]
].
^ classes
"Created: / 19.11.2001 / 21:54:59 / cg"
!
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.
] ensure:[
self cursor:savedCursor
]
"Modified: / 29.4.1999 / 22:36:54 / cg"
!
sourceOfChange:changeNr
|aStream sawExcla chunk|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[
^ nil
].
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
sawExcla ifTrue:[
chunk := aStream nextChunk
].
aStream close.
^ chunk
!
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
!
withSingleSelectedChangeDo:aBlock
"just a helper, check for a single selection, and evaluate aBlock
with busy cursor"
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
self withSelectedChangesInOrder:nil 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 := self realClassNameOfChange:changeNr.
name isNil ifTrue:[^ nil].
(name endsWith:' class') ifTrue:[
name := name copyWithoutLast:6
].
^ name
"Modified: / 5.11.2001 / 18:10:25 / 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."
|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 == #nil ifTrue:[^ nil].
^ 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.
^ 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:(self nameSpaceForApply)
"/ do:[
aParseTree := Parser parseExpression:chunk.
"/ ].
aParseTree == #Error ifTrue:[
(chunk includesString:'comment') ifTrue:[
"/ could be a comment ...
aParseTree := Parser parseExpression:chunk , ''''.
]
].
] ensure:[
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
#categoriesForClass "/ Dolphin support
#categoriesFor: "/ 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'.
].
^ 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
].
^ 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.
^ 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.
^ 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"
!
realClassNameOfChange:changeNr
"return the classname of a change.
- since parsing ascii methods is slow, keep result cached in
changeClassNames for the next query"
|name|
name := changeClassNames at:changeNr.
name isNil ifTrue:[
name := self fullClassNameOfChange:changeNr.
name isNil ifTrue:[
changeClassNames at:changeNr put:#nil.
].
].
name == #nil ifTrue:[^ nil].
^ name
"Modified: / 6.12.1995 / 17:06:31 / cg"
"Created: / 5.11.2001 / 18:09:46 / 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 encoding decoder|
(changeNr between:1 and:changePositions size) ifFalse:[^ nil].
aStream := changeFileName asFilename readStreamOrNil.
aStream isNil ifTrue:[^ nil].
encoding := CharacterEncoder guessEncodingOfStream:aStream.
encoding notNil ifTrue:[
decoder := CharacterEncoder encoderFor:encoding.
aStream := EncodedStream stream:aStream encoder:decoder.
].
aStream position1Based:(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 modificationTime) > 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.
self newLabel:''.
!
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."
|inStream 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 text methodPos
singleJunkOnly methodChunks classCategoryChunks methodCategoryChunks singleInfo
ownerTree ownerName
m currentText t1 t2 methodSelector nameAndClass encoding decoder|
editingClassSource := false.
askedForEditingClassSource := false.
maxLen := 60.
self newLabel:'updating ...'.
(self class isXMLFile:changeFileName) ifTrue:[
^ self class readXMLChangesFromFile:changeFileName inBackground:inBackground
].
f := changeFileName asFilename.
inStream := f readStreamOrNil.
inStream isNil ifTrue:[^ nil].
encoding := CharacterEncoder guessEncodingOfStream:inStream.
encoding notNil ifTrue:[
decoder := CharacterEncoder encoderFor:encoding.
inStream := EncodedStream stream:inStream encoder:decoder.
inStream skipEncodingChunk.
].
i := f info.
changeFileSize := i fileSize.
changeFileTimestamp := i modificationTime.
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 := inStream class chunkSeparator.
[inStream atEnd] whileFalse:[
"
get a chunk (separated by excla)
"
inStream skipSeparators.
chunkPos := inStream position1Based.
sawExcla := inStream peekFor:excla.
chunkText := fullChunkText := inStream 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) withoutSeparators.
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) withoutSeparators.
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 := (self nameSpaceForApply) 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:[
nameAndClass := self extractClassAndClassNameFromParseTree:rec.
clsName := nameAndClass key. changeClass := nameAndClass value.
sel := (p args at:1) evaluate.
changeClassNames at:changeClassNames size put:clsName.
autoCompare value ifTrue:[
(changeClass isNil or:[changeClass isLoaded not]) ifTrue:[
changeDelta := '?'
] ifFalse:[
(changeClass includesSelector:sel asSymbol) ifTrue:[
changeDelta := '-'.
] ifFalse:[
changeDelta := '='.
]
]
].
changeType := '(remove)'.
changeString := self contractClass:clsName selector:sel to:maxLen.
sel := nil.
].
(p notNil
and:[p ~~ #Error
and:[p isMessage
and:[rec isMessage
and:[rec selector == #compiledMethodAt:]]]]) ifTrue:[
nameAndClass := self extractClassAndClassNameFromParseTree:rec receiver.
clsName := nameAndClass key. changeClass := nameAndClass value.
(sel == #category:) ifTrue:[
sel := (rec args at:1) evaluate.
changeType := '(category change)'.
changeString := self contractClass:clsName selector:sel to:maxLen.
changeClassNames at:changeClassNames size put:clsName.
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:clsName selector:sel to:maxLen.
changeClassNames at:changeClassNames size put:clsName.
].
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 := (self nameSpaceForApply) at:clsName asSymbol ifAbsent:nil.
cls isNil ifTrue:[
changeDelta := '+'.
] ifFalse:[
(cls definitionSelector = sel
or:[
"/ could be an ST/V, VAge or Dolphin definition
cls definitionSelector = (sel , 'category:')
])
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 definitionSelector = (sel , 'category:')
ifTrue:[
"/ ST/V, VAge or Dolphin definition
changeDelta := '='.
] ifFalse:[
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 := (self nameSpaceForApply) 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.
classCategoryChunks := methodCategoryChunks := 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 ....
"
clsName := nil.
p := Parser parseExpression:chunkText inNameSpace:(self nameSpaceForApply).
(p notNil and:[p ~~ #Error]) ifTrue:[
rec := p receiver.
sel := p selector.
(#(
#methodsFor:
#privateMethodsFor:
#publicMethodsFor:
#ignoredMethodsFor:
#protectedMethodsFor:
#methodsFor:stamp: "/ Squeak support
#'commentStamp:prior:' "/ Squeak support
#methodsFor "/ Dolphin support
#categoriesForClass "/ Dolphin support
#categoriesFor: "/ Dolphin support
#methods "/ STV support
#publicMethods "/ STV support
#methodsForUndefined:
)
includes:sel) ifTrue:[
methodChunks := true.
nameAndClass := self extractClassAndClassNameFromParseTree:rec.
clsName := nameAndClass key. changeClass := nameAndClass value.
sel == #categoriesForClass ifTrue:[
methodChunks := false.
classCategoryChunks := true.
changeType := '(class category change)'.
] ifFalse:[
sel == #categoriesFor: ifTrue:[
methodChunks := false.
methodCategoryChunks := true.
changeType := '(category change)'.
methodSelector := (p args at:1) evaluate.
] ifFalse:[
(sel == #'methodsFor') ifTrue:[
category := 'Dolphin methods'.
] ifFalse:[
((sel == #methods) or:[sel == #publicMethods]) 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 := inStream position1Based.
text := inStream nextChunk.
done := text isNil or:[text isEmpty].
done ifFalse:[
first ifFalse:[
changeChunks add:chunkText.
changeClassNames add:clsName.
changePositions add:methodPos.
changeTimeStamps add:timeStampInfo.
changeIsFollowupMethodChange add:true.
askedForEditingClassSource ifFalse:[
(changeFileName asFilename hasSuffix:'st') ifFalse:[
editingClassSource := false.
"
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:clsName.
].
first := false.
(classCategoryChunks or:[methodCategoryChunks]) ifTrue:[
text := text asCollectionOfLines first asString.
classCategoryChunks ifTrue:[
changeClass isNil ifTrue:[
changeDelta := '?'.
] ifFalse:[
changeClass category = text ifTrue:[
changeDelta := '='.
]
].
changeString := clsName , ' category: ' , text storeString.
]ifFalse:[
changeString := '(' , clsName , ' compiledMethodAt:' , methodSelector storeString , ') category: ' , text storeString.
].
] ifFalse:[
"
try to find the selector
"
methodSelector := nil.
clsName notNil ifTrue:[
methodChunks ifTrue:[
p := Parser
parseMethodSpecification:text
in:nil
ignoreErrors:true
ignoreWarnings:true.
(p notNil and:[p ~~ #Error]) ifTrue:[
methodSelector := p selector.
]
]
].
methodSelector isNil ifTrue:[
changeString := (chunkText contractTo:maxLen).
changeType := '(change)'.
headerLine := chunkText , ' (change)'.
] ifFalse:[
changeString := self contractClass:clsName selector:methodSelector to:maxLen.
changeType := '{ ' , category , ' }'.
headerLine := clsName , ' ' , methodSelector , ' ' , '(change category: ''' , category , ''')'.
].
autoCompare value ifTrue:[
changeClass isNil ifFalse:[
cls := changeClass theNonMetaclass
].
(changeClass isNil or:[methodSelector isNil or:[cls isLoaded not]]) ifTrue:[
changeClass isNil ifTrue:[
changeDelta := '+'
] ifFalse:[
changeDelta := '?'
]
] ifFalse:[
(changeClass includesSelector:methodSelector asSymbol) ifFalse:[
changeDelta := '+'.
] ifTrue:[
m := changeClass compiledMethodAt:methodSelector 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
] ensure:[
inStream close.
inBackground ifTrue:[
myProcess priority:myPriority.
myProcess priorityRange:myPrioRange.
].
].
].
self checkIfFileHasChanged
"Modified: / 27.8.1995 / 23:06:55 / claus"
"Modified: / 9.11.2001 / 02:24:46 / 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.
inStream := changeFileName asFilename readStreamOrNil.
] on:FileStream openErrorSignal do:[:ex|
self warn:'Cannot create temp file in current directory.'.
^ false
].
outStream nextPutLine:'"{ Encoding: utf8 }" !!'.
outStream := EncodedStream stream:outStream encoder:(CharacterEncoder encoderForUTF8).
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 position1Based:(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:aFileNameOrFileNameString
"append change to a file. return true if ok."
|fileName changeInStream outStream chunk chunk2 sawExcla separator encoding|
changeInStream := self streamForChange:changeNr.
changeInStream isNil ifTrue:[
self warn:'Cannot read change'.
^ false
].
changeInStream skipSeparators.
separator := changeInStream class chunkSeparator.
(self changeIsFollowupMethodChange:changeNr) ifTrue:[
sawExcla := true.
chunk := changeChunks at:changeNr.
] ifFalse:[
sawExcla := changeInStream peekFor:separator.
chunk := changeInStream nextChunk.
].
chunk withoutSeparators isEmpty ifTrue:[
self error:'Empty chunk - should not happen'.
].
fileName := aFileNameOrFileNameString asFilename.
fileName exists ifTrue:[
encoding := CharacterEncoder guessEncodingOfFile:fileName.
] ifFalse:[
encoding := #utf8.
].
[
outStream := fileName readWriteStream.
] on:FileStream openErrorSignal do:[:ex|
self warn:'Cannot update file: ''%1''' with:fileName.
^ false
].
encoding notNil ifTrue:[
outStream := EncodedStream stream:outStream encoder:(CharacterEncoder encoderFor:encoding).
outStream nextPutLine:'"{ Encoding: utf8 }" !!'.
].
outStream setToEnd.
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream nextChunkPut:chunk; cr.
sawExcla ifTrue:[
chunk2 := changeInStream nextChunk.
chunk2 withoutSeparators isEmpty ifTrue:[
self error:'Empty chunk - should not happen'.
].
outStream nextChunkPut:chunk2; space
].
sawExcla ifTrue:[
outStream nextPut:separator
].
outStream cr.
changeInStream 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
alternativeClass shortName orgClassName nsClass aborted|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[^ self].
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
className := className asSymbol.
changeClass := Smalltalk at:className ifAbsent:[].
changeClass notNil ifTrue:[
changeClass autoload
]
].
changeNrProcessed := changeNr.
aborted := false.
applyAction :=
[
(skipSignal notNil) ifTrue:[
sig := skipSignal
] ifFalse:[
sig := AbortOperationRequest
].
sig handle:[:ex |
aborted := true.
ex return.
] do:[
nameSpace := self nameSpaceForApply.
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:[
orgClassName := className.
(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 autoload
].
].
(nameSpace notNil and:[nameSpace ~~ Smalltalk]) ifTrue:[
changeClass := nameSpace at:className ifAbsent:[].
].
changeClass isNil ifTrue:[
changeClass := Smalltalk at:className ifAbsent:[].
].
[changeClass isNil] whileTrue:[
(NameSpace allNamespaces
detect:[:ns | (nsClass := (ns at:className)) notNil] ifNone:nil)
notNil ifTrue:[
shortName := nsClass name.
] ifFalse:[
shortName := className copyFrom:(className lastIndexOf:$:) + 1.
shortName = className ifTrue:[
shortName := ''
].
].
className := Dialog
request:'No class ''' , className , ''' for change. Add to which class ?'
initialAnswer:shortName.
className size == 0 ifTrue:[
^ self
].
alternativeClass := Smalltalk classNamed:className.
alternativeClass notNil ifTrue:[
changeClass := alternativeClass
]
].
methodsForChunk := methodsForChunk copyFrom:(methodsForChunk indexOfSeparator).
methodsForChunk := changeClass name , methodsForChunk.
].
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 value do:applyAction
]
] ifFalse:[
applyAction value
].
aStream close.
^ aborted not
"Modified: / 16.11.2001 / 17:38:06 / 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 ownerClass superClassHere superClassInChange|
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:(self nameSpaceForApply)
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:[
|receiver|
receiver := parseTree receiver.
(receiver receiver evaluate isBehavior
and:[(method := 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.
].
].
]
].
(Class definitionSelectors includes:selector)
"/ selector == #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
ifTrue:[
superClass := (parseTree receiver evaluate).
superClass isBehavior ifFalse:[
outcome := 'Cannot compare this change\\(superclass not loaded).'.
isSame := nil.
] ifTrue:[
(self checkClassIsLoaded:superClass) ifTrue:[
thisClassSym := (parseTree arguments at:1) evaluate.
(selector endsWith:':privateIn:') ifTrue:[
ownerClass := (parseTree arguments at:5) evaluate.
ownerClass isBehavior ifTrue:[
thisClass := ownerClass privateClassesAt:thisClassSym.
].
] ifFalse:[
thisClass := (self nameSpaceForApply) at:thisClassSym ifAbsent:nil.
].
thisClass isNil ifTrue:[
outcome := 'Change defines the class: ' , thisClassSym allBold.
isSame := false.
] ifFalse:[
(isLoaded := self checkClassIsLoaded:thisClass) ifFalse:[
outcome := 'Cannot compare this change\\(compare requires class to be loaded).'.
isSame := nil.
] ifTrue:[
superClassHere := thisClass superclass name.
superClassInChange := parseTree receiver name.
superClassHere ~~ superClassInChange ifTrue:[
outcome := 'Superclass is different.'.
isSame := false.
] ifFalse:[
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:[
((selector endsWith:':category:')
and:[thisClass category ~= (parseTree arguments at:5) evaluate]) ifTrue:[
outcome := 'Category is different'.
isSame := false.
] ifFalse:[
outcome := 'Change has no effect\\(same definition)'.
isSame := true.
]
"/ 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 isEmpty ifTrue:[
outcome := 'Change reorders instanceVariable(s)'.
] ifFalse:[
removedVars := removedVars collect:[:eachVar | '''' , eachVar , ''''].
outcome := 'Change removes instanceVariable(s): ' , (removedVars asStringWith:Character space) allBold.
]
] ifFalse:[
removedVars isEmpty ifTrue:[
addedVars := addedVars collect:[:eachVar | '''' , eachVar , ''''].
outcome := 'Change adds instanceVariable(s): ' , (addedVars asStringWith:Character space) allBold.
].
].
]
]
]
]
]
]
]
]
] ifTrue:[
Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
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 notNil and:[thisClass isKindOf:UndefinedVariable]) ifTrue:[
|thisName path|
thisName := thisClass name.
path := thisName asCollectionOfSubstringsSeparatedByAll:'::'.
1 to:path size do:[:length |
|ownerName owner|
ownerName := (path copyTo:length) asStringCollection asStringWith:'::'.
owner := Smalltalk classNamed:ownerName.
(owner notNil and:[owner isBehavior and:[owner isLoaded not]]) ifTrue:[
self checkClassIsLoaded:owner.
].
].
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:(self nameSpaceForApply)
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 is 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."
self
compressForClass:aClassNameOrNil selector:nil
"Modified: / 19.11.2001 / 22:04:12 / cg"
!
compressForClass:aClassNameOrNil selector:selectorToCompressOrNil
"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."
|lbl aStream searchIndex anyMore deleteSet index
str snapshotProto snapshotPrefix snapshotNameIndex fileName|
aStream := changeFileName asFilename readStreamOrNil.
aStream isNil ifTrue:[^ self].
lbl := 'compressing'.
aClassNameOrNil isNil ifTrue:[
selectorToCompressOrNil notNil ifTrue:[
lbl := lbl , ' for ' , selectorToCompressOrNil.
]
] ifFalse:[
selectorToCompressOrNil isNil ifTrue:[
lbl := lbl , ' for ' , aClassNameOrNil.
] ifFalse:[
lbl := lbl , ' for ' , aClassNameOrNil , '>>' , selectorToCompressOrNil.
]
].
lbl := lbl , '...'.
self newLabel:lbl.
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 position1Based:(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 position1Based: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:[
compressThis := aClassNameOrNil = thisClass theNonMetaclass name.
]
].
compressThis ifTrue:[
thisSelector := selectors at:changeNr.
compressThis := (selectorToCompressOrNil isNil or:[thisSelector == selectorToCompressOrNil]).
compressThis ifTrue:[
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:''.
"Modified: / 5.11.2001 / 16:34:53 / cg"
"Created: / 19.11.2001 / 22:03:42 / 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 removeFromIndex:start toIndex:stop.
"/ 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
!
silentDeleteChangesFor:aClassName selector:selector from:start to:stop
"delete changes for given class/selector 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 selectorOfMethodChange:index) == selector 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"
!
updateDiffView
self withSelectedChangesDo:[:changeNr |
self updateDiffViewFor:changeNr.
^ self.
].
diffView text1:'' text2:''
!
updateDiffViewFor:changeNr
|aStream chunk sawExcla parseTree thisClass cat oldSource newSource
parser sel showDiff selector oldMethod|
aStream := self streamForChange:changeNr.
aStream isNil ifTrue:[
^ self
].
showDiff := false.
(self changeIsFollowupMethodChange:changeNr) ifFalse:[
sawExcla := aStream peekFor:(aStream class chunkSeparator).
chunk := aStream nextChunk.
] ifTrue:[
chunk := (changeChunks at:changeNr).
sawExcla := true.
].
Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
do:[
parseTree := Parser parseExpression:chunk.
(parseTree notNil and:[parseTree ~~ #Error and:[ parseTree isMessage ]]) ifTrue:[
selector := parseTree selector.
]
].
selector isNil ifTrue:[
newSource := chunk.
oldSource := 'Not comparable.'.
] ifFalse:[
sawExcla ifFalse:[
"/ not a method-change
newSource := chunk.
oldSource := self oldSourceForParseTree:parseTree.
] ifTrue:[
"/ a method-change
(#(
#methodsFor:
#privateMethodsFor:
#publicMethodsFor:
#ignoredMethodsFor:
#protectedMethodsFor:
#methodsFor:stamp: "/ Squeak support
#methodsFor "/ Dolphin support
#methods "/ STV support
)
includes:selector) ifTrue:[
newSource := aStream nextChunk.
thisClass := (parseTree receiver evaluate).
thisClass isBehavior ifTrue:[
(thisClass isLoaded
or:[ autoloadAsRequired value
and:[self checkClassIsLoaded:thisClass]]) ifFalse:[
oldSource := 'Cannot compare this change\\(compare requires class to be loaded).' withCRs.
] ifTrue:[
selector == #methodsFor ifTrue:[
cat := 'Dolphin methods'.
] ifFalse:[
selector == #methods ifTrue:[
cat := 'STV methods'.
] ifFalse:[
cat := parseTree arg1 evaluate.
].
].
Class nameSpaceQuerySignal answer:(self nameSpaceForApply)
do:[
Error handle:[:ex |
] 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) ifFalse:[
oldSource isNil ifTrue:[
oldSource := 'No source for compare.'.
] ifFalse:[
"/
"/ compare for tabulator <-> space changes
"/ before showing diff ...
"/
oldSource := oldSource asCollectionOfLines collect:[:s | s withTabsExpanded].
newSource := newSource asCollectionOfLines collect:[:s | s withTabsExpanded].
oldSource = newSource ifFalse:[
"/
"/ check if only historyLine diffs
"/
(HistoryManager notNil
and:[HistoryManager isActive]) ifTrue:[
oldSource := oldSource asStringCollection asString.
newSource := newSource asStringCollection asString.
(HistoryManager withoutHistoryLines:oldSource)
=
(HistoryManager withoutHistoryLines:newSource)
ifTrue:[
oldSource := (HistoryManager withoutHistoryLines:oldSource).
newSource := (HistoryManager withoutHistoryLines:newSource).
]
].
]
]
]
] ifFalse:[
oldSource := 'Method does not exist.'.
]
] ifFalse:[
oldSource := 'Change is unparsable (parse error).'.
].
].
] ifFalse:[
oldSource := 'Class does not exist.'.
]
] ifFalse:[
newSource := aStream contents.
oldSource := 'Not comparable.'.
]
]
].
aStream close.
oldSource := oldSource ? ''.
newSource := newSource ? ''.
(oldSource = newSource
or:[ oldSource asStringCollection withTabsExpanded = newSource asStringCollection withTabsExpanded]) ifTrue:[
self makeDiffViewInvisible
] ifFalse:[
self makeDiffViewVisible.
diffView text1:oldSource text2:newSource.
].
"Created: / 24.11.1995 / 14:30:46 / cg"
"Modified: / 21.3.2003 / 14:26:58 / cg"
! !
!ChangesBrowser methodsFor:'termination'!
askIfChangesAreToBeWrittenBack
|action again|
anyChanges ifFalse:[^ self].
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'
image:(WarningBox iconBitmap)
buttonLabels:(resources array:#('Cancel' 'Don''t Write' 'Write'))
values:#(#abort #ignore #save)
default:#save
onCancel:#abort.
again := false.
action == #abort ifTrue:[AbortSignal raise. ^ self].
action == #save ifTrue:[
again := self writeBackChanges not
].
].
!
closeRequest
"window manager wants us to go away"
self askIfChangesAreToBeWrittenBack.
super closeRequest
!
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 value:aBoolean
"Created: 3.12.1995 / 14:14:24 / cg"
"Modified: 3.12.1995 / 14:20:45 / cg"
!
autoloadAsRequired:aBoolean
"enabled/disable automatic load of unloaded classes"
autoloadAsRequired value:aBoolean
!
changeSelection:lineNrCollection
"show a change in the codeView"
|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
chunk := self sourceOfChange:lineNr.
chunk isNil ifTrue:[
codeView initializeDoITAction.
^ self
].
codeView contents:chunk.
codeView acceptAction:[:theCode | self doApply "noChangesAllowed"].
codeView doItAction:[:theCode |
|clsName cls|
clsName := self classNameOfChange:lineNr.
clsName notNil ifTrue:[
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.
self showingDiffs value ifTrue:[
AbortOperationRequest catch:[
self updateDiffViewFor:changeNrShown.
]
].
"Modified: / 28.2.1999 / 15:26:46 / cg"
!
classOfChange:changeNr
^ self
classOfChange:changeNr
ifAbsent:[:className |
|msg|
className isNil ifTrue:[
msg := 'Could not extract classname from change'.
] ifFalse:[
msg := 'Class not found: ''' , className , ''''.
].
self warn:msg.
nil
]
!
classOfChange:changeNr ifAbsent:exceptionBlock
|className cls isMeta ownerClassName ownerClass|
className := self realClassNameOfChange:changeNr.
className isNil ifTrue:[
^ exceptionBlock value:nil
].
isMeta := false.
(className endsWith:' class') ifTrue:[
className := className copyWithoutLast:6.
isMeta := true.
].
(cls := (self nameSpaceForApply) classNamed:className) isNil ifTrue:[
cls := Smalltalk classNamed:className
].
cls isNil ifTrue:[
(className includes:$:) ifTrue:[
ownerClassName := className copyTo:(className lastIndexOf:$:)-1.
(ownerClassName endsWith:$:) ifTrue:[ ownerClassName := ownerClassName copyWithoutLast:1 ].
ownerClass := Smalltalk classNamed:ownerClassName.
ownerClass isBehavior ifTrue:[
ownerClass isLoaded ifFalse:[
"/ self halt.
].
].
].
^ exceptionBlock value:className
].
isMeta ifTrue:[
cls := cls class
].
^ cls
!
doApply
"user wants a change to be applied"
self withSelectedChangesDo:[:changeNr |
skipSignal := nil.
(self applyChange:changeNr) ifFalse:[
^ self "/ cancel
].
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"
!
doApplyClassFromBeginning
"user wants all changes for this class from 1 to changeNr to be applied"
self withSingleSelectedChangeDo:[: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.
1 to:changeNr do:[:changeNr |
thisClassName := self classNameOfChange:changeNr.
thisClassName = classNameToApply ifTrue:[
changeListView setSelection:changeNr.
self applyChange:changeNr.
lastChange := changeNr
].
].
self autoSelect:changeNr+1.
]
]
"Modified: 21.1.1997 / 22:26:04 / cg"
!
doApplyClassRest
"user wants all changes for this class from changeNr to be applied"
self withSingleSelectedChangeDo:[: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"
!
doApplyFromBeginning
"user wants all changes from 1 to changeNr to be applied"
self withSingleSelectedChangeDo:[:changeNr |
|lastNr "{ Class: SmallInteger }" |
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
1 to:changeNr do:[:changeNr |
changeListView setSelection:changeNr.
self applyChange:changeNr
].
self autoSelect:changeNr+1.
]
!
doApplyRest
"apply all changes from changeNr to the end"
self withSingleSelectedChangeDo:[: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"
!
doApplyToConflictOrEnd
"apply all changes from changeNr to either a conflict (i.e. method exists)
or the end."
self withSingleSelectedChangeDo:[:changeNr |
|lastNr "{ Class: SmallInteger }"|
self clearCodeView.
skipSignal isNil ifTrue:[skipSignal := Signal new].
lastNr := self numberOfChanges.
changeNr to:lastNr do:[:changeNr |
| cls sel |
changeListView setSelection:changeNr.
((cls := self classOfChange:changeNr ifAbsent:[:className| nil]) notNil
and:[(sel := self selectorOfMethodChange:changeNr) notNil])
ifTrue:[
(cls implements:sel) ifTrue:[
self autoSelect:changeNr.
^ self
].
].
self applyChange:changeNr
].
self autoSelect:self numberOfChanges.
]
!
doBrowse
"user wants a browser on the class of a change"
self withSingleSelectedChangeDo:[:changeNr |
|cls|
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
browseImplementorsMatching:selector.
]
!
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."
|classes answer logTitle logMessage|
"/ self theSingleSelection isNil ifTrue:[
"/ ^ self information:'Only possible if a single change is selected.'.
"/ ].
self withExecuteCursorDo:[
classes := IdentitySet new.
self withSelectedChangesDo:[:changeNr |
| className class |
className := self classNameOfChange:changeNr.
className notNil ifTrue:[
class := Smalltalk classNamed:className.
class isNil ifTrue:[
self error:'oops - no class: ', className mayProceed:true.
].
class notNil ifTrue:[
class := class theNonMetaclass.
(classes includes:class) ifFalse:[
class isPrivate ifTrue:[
(classes includes:class owningClass) ifFalse:[
answer := self confirmWithCancel:('This is a private class.\\CheckIn the owner ''%1'' and all of its private classes ?'
bindWith:class owningClass name allBold) withCRs.
answer isNil ifTrue:[^ self].
answer ifTrue:[
classes add:class owningClass
]
]
] ifFalse:[
classes add:class
].
]
]
]
].
classes size == 1 ifTrue:[
logTitle := classes first name.
] ifFalse:[
logTitle := '%1 classes' bindWith:classes size.
].
logMessage := SourceCodeManagerUtilities
getLogMessageFor:logTitle
initialAnswer:nil.
changeListView setSelection:nil.
classes do:[:eachClass |
(SourceCodeManagerUtilities checkinClass:eachClass withLog:logMessage)
ifTrue:[
self silentDeleteChangesForClassAndPrivateClasses:eachClass name
from:1 to:(self numberOfChanges).
]
].
self setChangeList.
]
"Modified: / 6.9.1995 / 17:11:16 / claus"
"Modified: / 17.11.2001 / 14:21:13 / cg"
!
doCompare
"compare change with current system version
- give a note in transcript"
self withSingleSelectedChangeDo:[:changeNr |
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
]
] on:AbortOperationRequest do:[:ex| "ignore unloaded clases" ]
].
].
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 selectedClassNames do:[:classNameToCompress |
self compressForClass:classNameToCompress.
]
"Created: / 29.10.1997 / 01:05:16 / cg"
"Modified: / 19.11.2001 / 21:55:17 / cg"
!
doCompressSelector
"compress changes for the selected class & selector.
this replaces multiple method-changes by the last (i.e. the most recent) change."
|classSelectorPairs|
self theSingleSelection isNil ifTrue:[
^ self information:'Only possible if a single change is selected.'.
].
classSelectorPairs := Set new.
self withSelectedChangesDo:[:changeNr |
| classNameToCompress selector |
classNameToCompress := self classNameOfChange:changeNr.
classNameToCompress notNil ifTrue:[
selector := self selectorOfMethodChange:changeNr.
selector notNil ifTrue:[
classSelectorPairs add:(classNameToCompress -> selector).
]
]
].
classSelectorPairs do:[:pair |
self compressForClass:pair key selector:pair value.
]
"Created: / 19.11.2001 / 21:50:59 / cg"
"Modified: / 19.11.2001 / 22:10:08 / cg"
!
doDelete
"delete currently selected change(s)"
|rangeEnd rangeStart firstDeleted|
changeListView selection size <= 5 ifTrue:[
self withSelectedChangesReverseDo:[:changeNr |
self deleteChange:changeNr.
self autoSelectOrEnd:changeNr
].
^ self
].
self withSelectedChangesReverseDo:[:changeNr |
rangeEnd isNil ifTrue:[
rangeEnd := rangeStart := changeNr
] ifFalse:[
(changeNr = (rangeEnd + 1)) ifTrue:[
rangeEnd := changeNr
] ifFalse:[
(changeNr = (rangeStart - 1)) ifTrue:[
rangeStart := changeNr
] ifFalse:[
self deleteChangesFrom:rangeStart to:rangeEnd.
firstDeleted := (firstDeleted ? rangeStart) min:rangeStart.
rangeStart := rangeEnd := nil.
].
].
].
].
rangeStart notNil ifTrue:[
self deleteChangesFrom:rangeStart to:rangeEnd.
firstDeleted := (firstDeleted ? rangeStart) min:rangeStart.
].
self autoSelectOrEnd:firstDeleted
!
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"
|lastChangeNr classNamesToDelete overAllNumDeletedBefore|
lastChangeNr := -1.
classNamesToDelete := Set new.
self withSelectedChangesDo:[:changeNr |
|classNameToDelete|
classNameToDelete := self ownerClassNameOfChange:changeNr.
classNameToDelete notNil ifTrue:[
classNamesToDelete add:classNameToDelete.
].
lastChangeNr := lastChangeNr max:changeNr.
].
overAllNumDeletedBefore := 0.
changeListView setSelection:nil.
self withExecuteCursorDo:[
classNamesToDelete do:[:classNameToDelete |
| changeNr numDeletedBefore|
classNameToDelete notNil ifTrue:[
changeListView setSelection:nil.
self silentDeleteChangesForClassAndPrivateClasses:classNameToDelete
from:lastChangeNr
to:(self numberOfChanges).
numDeletedBefore := self
silentDeleteChangesForClassAndPrivateClasses: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"
!
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 withSingleSelectedChangeDo:[: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 withSingleSelectedChangeDo:[: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"
!
doDeleteClassSelectorAll
"delete all changes with same class and selector as currently selected change"
|classNameSelectorPairsToDelete lastChangeNr overAllNumDeletedBefore|
lastChangeNr := -1.
classNameSelectorPairsToDelete := Set new.
self withSelectedChangesDo:[:changeNr |
|className selector|
className := self classNameOfChange:changeNr.
selector := self selectorOfMethodChange:changeNr.
selector notNil ifTrue:[
(className notNil and:[selector notNil]) ifTrue:[
classNameSelectorPairsToDelete add:(className -> selector).
]
].
lastChangeNr := lastChangeNr max:changeNr.
].
overAllNumDeletedBefore := 0.
changeListView setSelection:nil.
self withExecuteCursorDo:[
classNameSelectorPairsToDelete do:[:pair |
|numDeletedBefore className selector|
className := pair key.
selector := pair value.
self silentDeleteChangesFor:className selector:selector
from:lastChangeNr
to:(self numberOfChanges).
numDeletedBefore := self
silentDeleteChangesFor:className selector:selector
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"
!
doDeleteFromBeginning
"delete all changes from 1 to the current"
self withSingleSelectedChangeDo:[:changeNr |
self deleteChangesFrom:1 to:changeNr.
self clearCodeView.
self autoSelectOrEnd:changeNr
]
!
doDeleteRest
"delete all changes from current to the end"
self withSingleSelectedChangeDo:[:changeNr |
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 withSingleSelectedChangeDo:[: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.
self newLabel:''.
realized ifTrue:[
self setChangeList.
]
!
doWriteBack
"write back the list onto the changes file"
anyChanges ifTrue:[
(self writeBackChanges) ifTrue:[
realized ifTrue:[
self readChangesFileInBackground:false.
self newLabel:''.
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
].
lastSearchType == #difference ifTrue:[
^ self findNextDifference
].
^ self findNextForClass
"Created: / 18.6.1998 / 22:15:00 / cg"
"Modified: / 18.6.1998 / 22:15:25 / cg"
!
findNextDifference
lastSearchType := #difference.
changeNrShown isNil ifTrue:[^ self].
self findNextForWhich:[:changeNr |
(self compareChange:changeNr showResult:false) == true ifTrue:[
"/ same
false
] ifFalse:[
"/ different
true
]
]
!
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
lastSearchString isNil ifTrue:[
^ self findString
].
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:[('*' , searchString , '*') match:s ]]]
].
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
].
lastSearchType == #difference ifTrue:[
^ self findPreviousDifference
].
^ self findPreviousForClass
"Created: / 18.6.1998 / 22:15:15 / cg"
!
findPreviousDifference
lastSearchType := #difference.
changeNrShown isNil ifTrue:[^ self].
self findPreviousForWhich:[:changeNr |
(self compareChange:changeNr showResult:false) == true ifTrue:[
"/ same
false
] ifFalse:[
"/ different
true
]
]
!
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
lastSearchString isNil ifTrue:[
^ self findString
].
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:[('*' , searchString , '*') match:s ]]]
].
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 size == 0 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"
!
setEnforcedNameSpace
|nsName listOfKnownNameSpaces|
listOfKnownNameSpaces := Set new.
NameSpace
allNamespaces
do:[:eachNameSpace |
listOfKnownNameSpaces add:eachNameSpace name
].
listOfKnownNameSpaces := listOfKnownNameSpaces asOrderedCollection sort.
nsName := Dialog
request:'When applying, new classes are created in nameSpace:'
initialAnswer:(enforcedNameSpace ? Class nameSpaceQuerySignal query name)
list:listOfKnownNameSpaces.
nsName size ~~ 0 ifTrue:[
enforcedNameSpace := NameSpace name:nsName.
autoCompare value ifTrue:[
self doUpdate
].
]
!
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.329 2005-04-18 11:41:56 cg Exp $'
! !