"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
ApplicationModel subclass:#StoreProjectBrowser
instanceVariableNames:'connection commentTextHolder packagesList selectedVersionHolder
versionsList selectedPackageHolder packagesFilterHolder
infoLabelHolder'
classVariableNames:''
poolDictionaries:''
category:'System-SourceCodeManagement'
!
Object subclass:#Pundle
instanceVariableNames:'name'
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
StoreProjectBrowser::Pundle subclass:#Package
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
StoreProjectBrowser::Pundle subclass:#Bundle
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
Object subclass:#PundleVersion
instanceVariableNames:'id pundle version user timestamp comment timestampInt commentId'
classVariableNames:''
poolDictionaries:''
privateIn:StoreProjectBrowser
!
!StoreProjectBrowser class methodsFor:'documentation'!
documentation
"
documentation to be added.
[author:]
cg (cg@FUSI)
[instance variables:]
[class variables:]
[see also:]
"
!
examples
"
Starting the application:
[exBegin]
Tools::StoreProjectBrowser open
[exEnd]
more examples to be added:
[exBegin]
... add code fragment for
... executable example here ...
[exEnd]
"
!
history
"Created: / 26-08-2006 / 12:45:08 / cg"
! !
!StoreProjectBrowser class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::StoreProjectBrowser andSelector:#windowSpec
Tools::StoreProjectBrowser new openInterface:#windowSpec
Tools::StoreProjectBrowser open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'Tools::StoreProjectBrowser'
name: 'Tools::StoreProjectBrowser'
min: (Point 10 10)
max: (Point 1024 768)
bounds: (Rectangle 0 0 527 369)
menu: mainMenu
)
component:
(SpecCollection
collection: (
(VariableHorizontalPanelSpec
name: 'VariableHorizontalPanel1'
layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
snapMode: both
handlePosition: right
component:
(SpecCollection
collection: (
(ViewSpec
name: 'Box1'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Bundles and Packages:'
name: 'Label1'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(InputFieldSpec
name: 'PackageFilterEntryField'
layout: (LayoutFrame 2 0 30 0 -2 1 58 0)
model: packagesFilterHolder
immediateAccept: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptOnPointerLeave: false
)
(SequenceViewSpec
name: 'PackageList'
layout: (LayoutFrame 0 0 60 0 0 1 0 1)
model: selectedPackageHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
valueChangeSelector: packageSelectionChanged
useIndex: true
sequenceList: packagesList
)
)
)
)
(ViewSpec
name: 'Box3'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Versions:'
name: 'Label2'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0 30 0 0 1 0 1)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'VersionsList'
model: selectedVersionHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
useIndex: true
sequenceList: versionsList
valueChangeSelector: versionSelectionChanged
)
(ViewSpec
name: 'Box2'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Comment:'
name: 'Label3'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'CommentTextEditor'
layout: (LayoutFrame 0 0 30 0 0 1 -1 1)
model: commentTextHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
)
)
)
)
)
)
handles: (Any 0.5 1.0)
)
)
)
)
)
)
handles: (Any 0.5 1.0)
)
(LabelSpec
name: 'InfoLabel'
layout: (LayoutFrame 2 0 -28 1 -1 1 -1 1)
level: -1
translateLabel: true
labelChannel: infoLabelHolder
adjust: left
)
)
)
)
! !
!StoreProjectBrowser class methodsFor:'internationalization'!
resourcePackName
^ 'StoreProjectBrowser'
! !
!StoreProjectBrowser class methodsFor:'menu specs'!
mainMenu
"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:Tools::StoreProjectBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(Tools::StoreProjectBrowser mainMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'File'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Fileout As...'
itemValue: menuFileoutAs
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Update'
itemValue: menuUpdate
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Exit'
itemValue: closeRequest
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Help'
translateLabel: true
startGroup: right
submenu:
(Menu
(
(MenuItem
label: 'Documentation'
itemValue: openDocumentation
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About this Application...'
itemValue: openAboutThisApplication
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
! !
!StoreProjectBrowser class methodsFor:'startup'!
openOn:aDBInfo
|newApp|
newApp := self new.
newApp allButOpen.
newApp dbInfo:aDBInfo.
newApp open.
^ newApp
! !
!StoreProjectBrowser methodsFor:'actions'!
packageSelectionChanged
|newest selectedItem|
selectedItem := packagesList value at:(selectedPackageHolder value).
self updateVersionsListFor:selectedItem.
versionsList notEmptyOrNil ifTrue:[
newest := versionsList value first.
self updateCommentFor:selectedItem
].
!
versionSelectionChanged
|selectedItem|
selectedItem := versionsList value at:(selectedVersionHolder value).
self updateCommentFor:selectedItem
! !
!StoreProjectBrowser methodsFor:'aspects'!
commentTextHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
commentTextHolder isNil ifTrue:[
commentTextHolder := '' asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ commentTextHolder addDependent:self.
"/ commentTextHolder onChangeSend:#commentTextHolderChanged to:self.
].
^ commentTextHolder.
!
infoLabelHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
infoLabelHolder isNil ifTrue:[
infoLabelHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ infoLabelHolder addDependent:self.
"/ infoLabelHolder onChangeSend:#infoLabelHolderChanged to:self.
].
^ infoLabelHolder.
!
packagesFilterHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
packagesFilterHolder isNil ifTrue:[
packagesFilterHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ packagesFilterHolder addDependent:self.
"/ packagesFilterHolder onChangeSend:#packagesFilterHolderChanged to:self.
].
^ packagesFilterHolder.
!
packagesList
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
packagesList isNil ifTrue:[
packagesList := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ packagesList addDependent:self.
"/ packagesList onChangeSend:#packagesListChanged to:self.
].
^ packagesList.
!
selectedPackageHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedPackageHolder isNil ifTrue:[
selectedPackageHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedPackageHolder addDependent:self.
"/ selectedPackageHolder onChangeSend:#selectedPackageHolderChanged to:self.
].
^ selectedPackageHolder.
!
selectedVersionHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedVersionHolder isNil ifTrue:[
selectedVersionHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedVersionHolder addDependent:self.
"/ selectedVersionHolder onChangeSend:#selectedVersionHolderChanged to:self.
].
^ selectedVersionHolder.
!
versionsList
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
versionsList isNil ifTrue:[
versionsList := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ versionsList addDependent:self.
"/ versionsList onChangeSend:#versionsListChanged to:self.
].
^ versionsList.
! !
!StoreProjectBrowser methodsFor:'db access'!
getBlob:id
|item cursor row blobType blobData|
item := Set new.
cursor := connection
execute:'SELECT blobtype,blobdata FROM tw_blob where primarykey = ',id printString,';'
release:false.
cursor next notNil ifTrue:[
row := cursor rowAsArray.
blobType := (row at:1).
blobData := Base64Coder decode:(row at:2).
].
cursor release.
blobType == 1 ifTrue:[
"binary"
^ blobData
].
blobType == 2 ifTrue:[
"string"
^ blobData asString
].
blobType == 3 ifTrue:[
"2-byte string"
self halt.
^ nil
].
self halt.
^ nil
!
getBundles
|items cursor row|
items := Set new.
cursor := connection
execute:'SELECT DISTINCT name FROM tw_bundle;'
release:false.
[cursor next notNil] whileTrue:[
row := cursor rowAsArray.
Transcript showCR:row.
items add:(Bundle new name:(row at:1)).
].
cursor release.
^ items asOrderedCollection sort:[:a :b| a name < b name]
!
getPackages
|items cursor row|
items := Set new.
cursor := connection
execute:'SELECT DISTINCT name FROM tw_package;'
release:false.
[cursor next notNil] whileTrue:[
row := cursor rowAsArray.
Transcript showCR:row.
items add:(Package new name:(row at:1)).
].
cursor release.
^ items asOrderedCollection sort:[:a :b| a name < b name]
!
getVersionsForBundle:aBundle
|items cursor row|
connection isNil ifTrue:[^ self ].
items := Set new.
cursor := connection
execute:'SELECT version,username,timestamp,commentid FROM tw_bundle WHERE name = ''',aBundle name,''';'
release:false.
[cursor next notNil] whileTrue:[
|v|
row := cursor rowAsArray.
Transcript showCR:row.
v := PundleVersion new.
v pundle:aBundle version:(row at:1) user:(row at:2).
v timestampInt:(row at:3) commentId:(row at:4).
items add:v.
].
cursor release.
^ items asOrderedCollection sort:[:a :b| a isVersionAfter: b]
!
getVersionsForPackage:aPackage
connection isNil ifTrue:[^ self ].
self halt.
!
updateCommentFor:aPundleVersion
|comment|
comment := self getBlob:(aPundleVersion commentId).
self commentTextHolder value:comment.
!
updatePackagesList
|bundles packages|
connection isNil ifTrue:[^ self ].
self withReadCursorDo:[
bundles := self getBundles.
packages := self getPackages.
].
packagesList value:(bundles , packages).
!
updateVersionsListFor:aBundleOrPackage
|items|
self withReadCursorDo:[
aBundleOrPackage isBundle ifTrue:[
items := self getVersionsForBundle:aBundleOrPackage
] ifFalse:[
items := self getVersionsForPackage:aBundleOrPackage
].
].
versionsList value:items.
! !
!StoreProjectBrowser methodsFor:'help'!
aboutThisApplicationText
^ super aboutThisApplicationText ,
'\\Written by Claus Gittinger, eXept Software AG.' withCRs
! !
!StoreProjectBrowser methodsFor:'initialization & release'!
dbInfo:aDBInfo
|session|
session := SQL::ODBCSession new.
session
connectWithUsername:(aDBInfo userName)
password:(aDBInfo password)
dbname:(aDBInfo dbName).
(session isConnected) ifFalse:[
^ self.
].
connection := session.
self window label:(aDBInfo dbName).
self infoLabelHolder value:('Connected to ',aDBInfo dbName).
^ self
!
postOpenWith:aBuilder
self updatePackagesList.
!
release
connection notNil ifTrue:[
connection disconnect.
connection := nil.
]
! !
!StoreProjectBrowser methodsFor:'menu actions'!
menuFileoutAs
"automatically generated by UIPainter ..."
"*** the code below performs no action"
"*** (except for some feedback on the Transcript)"
"*** Please change as required and accept in the browser."
"action to be added ..."
Transcript showCR:self class name, ': menu action for menuFileoutAs ...'.
!
menuOpen
"This method was generated by the Browser.
It will be invoked when the menu-item 'open' is selected."
"/ change below and add any actions as required here ...
self warn:'no action for ''open'' available.'.
!
menuUpdate
self updatePackagesList
!
openDocumentation
"This method was generated by the Browser.
It will be invoked when the menu-item 'help-documentation' is selected."
"/ change below as required ...
"/ to open an HTML viewer on some document (under 'doc/online/<language>/' ):
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'.
"/ add application-specific help files under the 'doc/online/<language>/help/appName'
"/ directory, and open a viewer with:
"/ HTMLDocumentView openFullOnDocumentationFile:'help/<MyApplication>/TOP.html'.
! !
!StoreProjectBrowser::Pundle methodsFor:'accessing'!
name
^ name
!
name:something
name := something.
! !
!StoreProjectBrowser::Pundle methodsFor:'printing'!
displayString
^ name
! !
!StoreProjectBrowser::Pundle methodsFor:'testing'!
isBundle
^ false
!
isPackage
^ false
! !
!StoreProjectBrowser::Package methodsFor:'testing'!
isPackage
^ true
! !
!StoreProjectBrowser::Bundle methodsFor:'printing'!
displayString
^ name ,' (Bundle)'
! !
!StoreProjectBrowser::Bundle methodsFor:'testing'!
isBundle
^ true
! !
!StoreProjectBrowser::PundleVersion methodsFor:'accessing'!
commentId
^ commentId
!
id
^ id
!
id:something
id := something.
!
pundle
^ pundle
!
pundle:pundleArg version:versionArg user:userArg
pundle := pundleArg.
version := versionArg.
user := userArg.
!
timestamp
|deltaSeconds|
timestamp isNil ifTrue:[
"/ to compute the timestamp, we have to do this:
"/ the timestampInt are seconds since 1993 + 10d + 19min + 47sec"
"/ can anyone explain this ????
deltaSeconds := 23*365 * 24*60*60. "/ 23 years
deltaSeconds := deltaSeconds + (233*24*60*60). "/ 10 days
deltaSeconds := deltaSeconds + (19*60). "/ 19 minutes
deltaSeconds := deltaSeconds + (47). "/ 47 seconds
timestamp := Timestamp secondsSince1970:(timestampInt + deltaSeconds).
].
^ timestamp
!
timestampInt:timestampIntArg commentId:commentIdArg
timestampInt := timestampIntArg.
commentId := commentIdArg.
!
user
^ user
!
version
^ version
! !
!StoreProjectBrowser::PundleVersion methodsFor:'comparing'!
isVersionAfter:anotherVersion
|myMajor othersMajor myMinor othersMinor|
myMajor := self majorVersion.
othersMajor := anotherVersion majorVersion.
myMajor > othersMajor ifTrue:[^ true].
myMajor < othersMajor ifTrue:[^ false].
myMinor := self minorVersion.
othersMinor := anotherVersion minorVersion.
myMinor > othersMinor ifTrue:[^ true].
myMinor < othersMinor ifTrue:[^ false].
^ version > anotherVersion version
!
majorVersion
^ Integer readFrom:(version upTo:$:)
!
minorVersion
^ Integer readFrom:((version restAfter:$.) upTo:$.)
! !
!StoreProjectBrowser::PundleVersion methodsFor:'printing'!
displayString
^ version , ' (',user,') ' , self timestamp printString
! !
!StoreProjectBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__StoreProjectBrowser.st,v 1.2 2006-08-26 17:39:52 cg Exp $'
! !