# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 1253526073 -7200
# Node ID 646fdd59f4ef2f770a0c4af04a7b6626d7909b04
# Parent  b767db0f53a31a534c24bcbbf98f252a1c455095
*** empty log message ***

diff -r b767db0f53a3 -r 646fdd59f4ef Tools__StoreProjectBrowser.st
--- a/Tools__StoreProjectBrowser.st	Mon Sep 21 10:19:52 2009 +0200
+++ b/Tools__StoreProjectBrowser.st	Mon Sep 21 11:41:13 2009 +0200
@@ -35,7 +35,14 @@
 
 Object subclass:#PundleVersion
 	instanceVariableNames:'id pundle version user timestamp comment timestampInt commentId
-		isBundle'
+		isBundle blessingLevel'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:StoreProjectBrowser
+!
+
+Object subclass:#StoreProjectChangeSetReader
+	instanceVariableNames:'browser dbConnection bundleOrPackage version changeSet'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:StoreProjectBrowser
@@ -68,6 +75,32 @@
 "
 ! !
 
+!StoreProjectBrowser class methodsFor:'image specs'!
+
+bundleImage
+    "This resource specification was automatically generated
+     by the ImageEditor of ST/X."
+
+    "Do not manually edit this!! If it is corrupted,
+     the ImageEditor may not be able to read the specification."
+
+    "
+     self bundleImage inspect
+     ImageEditor openOnClass:self andSelector:#bundleImage
+     Icon flushCachedIcons
+    "
+
+    <resource: #image>
+
+    ^Icon
+        constantNamed:'Tools::StoreProjectBrowser class bundleImage'
+        ifAbsentPut:[(Depth8Image new) width: 17; height: 16; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BP$IBP$IBP$IBP$IBP@@@@@INS$9A!!\$BQ$YFRDI@@@@@@$9KSX?MP4IFP@*K0$@@@@@BS$C
+E@PIEP$YJ#0VBP@@@@@IA!!PDBQ$IBSL<LP8I@@@@@@$WI@4IFQ$3N \XI $@@@@@BS SGP$@J!!DGL!!@^BP@@@@@IAQ,%BRDIBTMDN3\I@@@@@@%AH2,ABQHI
+JS,(K $@@@@@BT@4OP(Z@ $*LB@''BP@@@@@IJ00\KC8KBRH_C4HI@@@@@@$IBP$IBP$IBP$IBP$@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+@@@b') ; colorMapFromArray:#[229 232 255 221 221 160 202 203 179 252 253 186 222 223 196 240 241 213 247 248 218 219 223 255 255 255 255 0 0 0 216 216 156 200 201 178 209 210 185 219 220 194 192 194 214 178 181 214 209 214 255 224 226 255 212 211 153 240 241 177 249 249 184 217 217 192 194 196 214 245 246 217 214 219 255 241 243 255 212 212 153 235 236 173 206 207 183 216 217 192 186 189 214 181 184 214 194 200 255 227 229 255 199 204 255 231 231 169 245 245 181 214 214 190 189 192 214 178 182 214 199 205 255 231 233 255 227 230 255 226 225 164 204 205 181 255 255 189 180 184 214 196 198 214 198 205 255 219 222 255 215 218 255 240 241 255 225 226 164 245 245 180 253 252 187 183 187 214 243 244 215 249 249 219 223 226 255 204 209 255 223 227 255 221 220 160 202 202 179 250 249 184 235 237 208 238 239 211 176 180 214 215 219 255 210 214 255]; mask:((Depth1Image new) width: 17; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@A?@@A?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?O?9?@@A?@@A?') ; yourself); yourself]
+! !
+
 !StoreProjectBrowser class methodsFor:'interface specs'!
 
 windowSpec
@@ -386,6 +419,11 @@
             translateLabel: true
           )
          (MenuItem
+            label: 'Browse'
+            itemValue: versionsListMenuBrowse
+            translateLabel: true
+          )
+         (MenuItem
             label: '-'
           )
          (MenuItem
@@ -428,15 +466,16 @@
 !
 
 versionSelectionChanged
-    |selIndex selectedItem|
+    |selIndex|
 
     selIndex := selectedVersionHolder value.
     selIndex isNil ifTrue:[
-        self commentTextHolder value:nil
+        self commentTextHolder value:nil.
+        selectedVersion := nil.
     ] ifFalse:[
-        selectedItem := versionsList value at:selIndex.
+        selectedVersion := versionsList value at:selIndex.
         self withReadCursorDo:[
-            self updateBlessingCommentFor:selectedItem
+            self updateBlessingCommentFor:selectedVersion
         ].
     ]
 ! !
@@ -674,27 +713,29 @@
 
     items := Set new.
     cursor := connection 
-                execute:'SELECT name,version,username,timestamp,commentid,primarykey 
+                execute:'SELECT name,version,username,timestamp,commentid,primarykey,blessinglevel 
                          FROM ',table,
                          "/ ' WHERE name = ''',aBundle name,''' ',
                          ';'
                 release:false.
 
     [cursor next notNil] whileTrue:[
-        |v name version username timestamp commentid primarykey|
+        |v name version username timestamp commentid primarykey blessinglevel|
 
         row := cursor rowAsArray.
-        Transcript showCR:row.
+Transcript showCR:row.
         name := row at:1.
         version := row at:2.
         username := row at:3.
         timestamp := row at:4.
         commentid := row at:5.
         primarykey := row at:6.
+        blessinglevel := row at:7.
         name = aBundle name ifTrue:[
             v := PundleVersion new.
             v pundle:aBundle version:version user:username.
             v timestampInt:timestamp commentId:commentid.
+            v blessingLevel:blessinglevel.
             v id:primarykey.
             v isBundle:isBundle.
             items add:v.
@@ -888,6 +929,31 @@
     "/ add application-specific help files under the 'doc/online/<language>/help/appName'
     "/ directory, and open a viewer with:
     "/ HTMLDocumentView openFullOnDocumentationFile:'help/<MyApplication>/TOP.html'.
+!
+
+versionsListMenuBrowse
+    |reader changeSet environment|
+
+    reader := StoreProjectChangeSetReader new.
+    reader 
+        browser:self dbConnection:connection 
+        bundleOrPackage:selectedBundleOrPackage version:selectedVersion.
+    changeSet :=reader changeSet.
+    ChangeSetBrowser openOn:changeSet.
+self halt.
+
+    environment := StoreProjectEnvironment for:selectedVersion connection:connection.
+        SystemBrowser
+            openOn:environment 
+            label:(resources string:'%1' with:selectedBundleOrPackage name , ' ' , selectedVersion version)
+!
+
+versionsListMenuLoad
+self halt.
+!
+
+versionsListMenuUpdate
+self halt.
 ! !
 
 !StoreProjectBrowser::Pundle methodsFor:'accessing'!
@@ -936,6 +1002,14 @@
 
 !StoreProjectBrowser::PundleVersion methodsFor:'accessing'!
 
+blessingLevel
+    ^ blessingLevel
+!
+
+blessingLevel:something
+    blessingLevel := something.
+!
+
 commentId
     ^ commentId
 !
@@ -1034,8 +1108,154 @@
     ^ version , ' (',user,') ' , self timestamp printString
 ! !
 
+!StoreProjectBrowser::StoreProjectChangeSetReader methodsFor:'accessing'!
+
+browser:browserArg dbConnection:dbConnectionArg bundleOrPackage:bundleOrPackageArg version:versionArg 
+    browser := browserArg.
+    dbConnection := dbConnectionArg.
+    bundleOrPackage := bundleOrPackageArg.
+    version := versionArg.
+! !
+
+!StoreProjectBrowser::StoreProjectChangeSetReader methodsFor:'reading'!
+
+allClassesDo:aBlock
+    |packageId cursor row entries classes|
+
+    packageId := bundleOrPackage id.
+
+    entries := OrderedCollection new.
+    cursor := dbConnection
+        execute:('SELECT classref,metaclassref,definitionorder FROM tw_pkgclasses WHERE packageref = %1'
+                bindWith:packageId)
+        release:false.
+
+    [cursor next notNil] whileTrue:[
+        row := cursor rowAsObject.
+        entries add:row.
+    ].
+    cursor release.
+
+    classes := entries collect:[:entry |
+                |records classRecord metaclassRecord|
+
+                "/ entry classref 
+                "/ entry metaclassref 
+                "/ entry definitionorder 
+                cursor := dbConnection
+                    execute:('SELECT name,definitionid,commentid,environmentstring,superclass
+                              FROM tw_classrecord WHERE primarykey = %1'
+                            bindWith:entry classref)
+                    release:false.
+                records := OrderedCollection new.
+                [cursor next notNil] whileTrue:[
+                    row := cursor rowAsObject.
+                    records add:row.
+                ].
+                cursor release.
+                self assert:(records size == 1).
+                classRecord := records first.
+
+                cursor := dbConnection
+                    execute:('SELECT name,definitionid,commentid,environmentstring,superclass
+                              FROM tw_classrecord WHERE primarykey = %1'
+                            bindWith:entry metaclassref)
+                    release:false.
+                records := OrderedCollection new.
+                [cursor next notNil] whileTrue:[
+                    row := cursor rowAsObject.
+                    records add:row.
+                ].
+                cursor release.
+                self assert:(records size == 1).
+                metaclassRecord := records first.
+
+                { classRecord. metaclassRecord. entry definitionorder }
+           ].
+!
+
+changeSet
+    "build a changeSet from the bundle or package
+     Return the changeSet."
+
+    changeSet := ChangeSet new.
+    self fetchClassDefinitions.
+"/        changesFromStream:aStream 
+"/        for:changeSet 
+"/        reader:(ChangeFileReader new)
+"/        do:[:aChange :lineNumberOrNil :posOrNil |
+"/            changeSet add:aChange.
+"/            (aConditionBlock value:aChange) ifFalse:[^ changeSet].
+"/        ].
+
+    ^ changeSet
+!
+
+fetchClassDefinitions
+    |packageId cursor row entries classes change|
+
+    packageId := version id.
+
+    entries := OrderedCollection new.
+    cursor := dbConnection
+        execute:('SELECT classref,metaclassref,definitionorder FROM tw_pkgclasses WHERE packageref = %1'
+                bindWith:packageId)
+        release:false.
+
+    [cursor next notNil] whileTrue:[
+        row := cursor rowAsObject.
+        entries add:row.
+    ].
+    cursor release.
+
+    classes := entries collect:[:entry |
+                |records classRecord metaclassRecord definitionString|
+
+                "/ entry classref 
+                "/ entry metaclassref 
+                "/ entry definitionorder 
+                cursor := dbConnection
+                    execute:('SELECT name,definitionid,commentid,environmentstring,superclass
+                              FROM tw_classrecord WHERE primarykey = %1'
+                            bindWith:entry classref)
+                    release:false.
+                records := OrderedCollection new.
+                [cursor next notNil] whileTrue:[
+                    row := cursor rowAsObject.
+                    records add:row.
+                ].
+                cursor release.
+                self assert:(records size == 1).
+                classRecord := records first.
+
+                cursor := dbConnection
+                    execute:('SELECT name,definitionid,commentid,environmentstring,superclass
+                              FROM tw_classrecord WHERE primarykey = %1'
+                            bindWith:entry metaclassref)
+                    release:false.
+                records := OrderedCollection new.
+                [cursor next notNil] whileTrue:[
+                    row := cursor rowAsObject.
+                    records add:row.
+                ].
+                cursor release.
+                self assert:(records size == 1).
+                metaclassRecord := records first.
+
+                change := ClassDefinitionChange new.
+                definitionString := browser getBlob:(classRecord definitionid).
+                change source:definitionString.
+                change className:classRecord name.
+                "/ change superClassName:metaclassRecord name.
+                change package:bundleOrPackage name.
+                changeSet add:change.
+
+                { classRecord. metaclassRecord. entry definitionorder }
+           ].
+! !
+
 !StoreProjectBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__StoreProjectBrowser.st,v 1.10 2009-09-21 08:04:06 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__StoreProjectBrowser.st,v 1.11 2009-09-21 09:41:13 cg Exp $'
 ! !