AbstractLauncherApplication.st
changeset 2490 924e607d11d8
parent 2462 acd79b47c41f
child 2493 e25c257bda20
--- a/AbstractLauncherApplication.st	Wed Dec 15 20:39:56 1999 +0100
+++ b/AbstractLauncherApplication.st	Wed Dec 15 20:42:50 1999 +0100
@@ -746,6 +746,14 @@
     "Modified: / 31.7.1998 / 17:33:24 / cg"
 !
 
+packageDialog
+    "opens a package dialog"
+
+    ^ LauncherDialogs packageDialogFor:self
+
+    "Modified: / 31.7.1998 / 17:33:24 / cg"
+!
+
 saveImageAs: aFileName
     "save image in aFilename"
 
@@ -4465,6 +4473,112 @@
     "Modified: / 17.9.1995 / 16:47:50 / claus"
     "Created: / 31.7.1998 / 15:49:45 / cg"
     "Modified: / 10.8.1998 / 11:33:22 / cg"
+!
+
+packageDialogFor:requestor
+    "opens a package dialog"
+
+    |allPackages packageList packageUpdater
+     box l listView tabs
+     y menu resources selectedPackage|
+
+    resources := requestor class classResources.
+
+    box := Dialog new.
+    box label:(resources string:'Packages').
+
+    allPackages := IdentitySet new.
+    allPackages addAll:(Smalltalk knownPackages).
+
+    Project knownProjects do:[:package |
+        allPackages add:(package name)    
+    ].
+    Project loadedProjects do:[:package |
+        allPackages add:(package name)    
+    ].
+    allPackages := allPackages asOrderedCollection sort.
+
+    packageUpdater := [
+        tabs := TabulatorSpecification unit:#inch positions:#(0 4).
+        packageList := allPackages collect:[:pName | |pkg entry|
+                            entry := MultiColListEntry new:2 tabulatorSpecification:tabs.
+                            pkg := Project projectWithId:pName asSymbol.
+                            (pkg notNil and:[pkg isLoaded]) ifTrue:[
+                                entry colAt:1 put:pName asText allBold.
+                                entry colAt:2 put:'loaded'.
+                            ] ifFalse:[
+                                entry colAt:1 put:pName.
+
+                                (Smalltalk allClasses
+                                     contains:[:cls | cls package = pName and:[cls isLoaded not]])
+                                ifTrue:[
+                                    (Smalltalk allClasses
+                                         contains:[:cls | cls package = pName and:[cls isLoaded]])
+                                    ifTrue:[
+                                        entry colAt:2 put:'loaded/autoloaded'.
+                                    ] ifFalse:[
+                                        entry colAt:2 put:'autoloaded'.
+                                    ]
+                                ]
+                            ].
+                            entry
+                       ].
+    ].
+    packageUpdater value.
+
+    listView := HVScrollableView for:SelectionInListView miniScrollerH:true.
+    listView list:packageList.
+
+    box addComponent:listView tabable:true.
+    listView origin:0.0@0.0 corner:1.0@1.0.
+    listView bottomInset:40.
+    listView action:[:selIndex | |pkg|
+                        selectedPackage := (allPackages at:selIndex) asSymbol.
+
+                        pkg := Project projectWithId:selectedPackage.
+                        (pkg notNil and:[pkg isLoaded]) ifTrue:[
+                            menu disable:#load.
+"/                            menu enable:#unload.
+                        ] ifFalse:[
+"/                            menu disable:#unload.
+                            menu enable:#load.
+                        ]
+                    ].
+
+    menu := PopUpMenu 
+                itemList:#(
+                    ('load...'    load  )
+"/                    ('-'          nil   )
+"/                    ('unload...'  unload)
+                )
+                resources:resources.
+    listView middleButtonMenu:menu.
+    menu actionAt:#load   put:[
+                                box withWaitCursorDo:[
+                                    Smalltalk loadPackage:selectedPackage.
+                                    packageUpdater value.
+                                ]
+                              ].
+"/    menu actionAt:#unload put:[
+"/                                box withWaitCursorDo:[
+"/                                    Smalltalk unloadPackage:selectedPackage.
+"/                                    packageUpdater value.
+"/                                ].
+"/                              ].
+    menu disable:#load.
+"/    menu disable:#unload.
+
+    box addAbortButtonLabelled:(resources string:'dismiss').
+
+    box width:(400 min:(box device width * 2 // 3)); 
+        height:(450 min:(box device height - 50)).
+
+    box openWithExtent:(600 min:(box device width * 2 // 3))
+                       @
+                       (500 min:(box device height - 50)) .
+
+    box destroy.
+
 ! !
 
 !AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs-private'!
@@ -4838,5 +4952,5 @@
 !AbstractLauncherApplication class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.88 1999-12-03 19:25:38 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.89 1999-12-15 19:42:33 cg Exp $'
 ! !