class: NewLauncher
authorClaus Gittinger <cg@exept.de>
Sat, 31 Jan 2015 16:04:01 +0100
changeset 15147 4b7360d48459
parent 15146 a2ac3d6dd2dd
child 15148 803c504c561d
class: NewLauncher changed: #openLoadPackageDialog show package info - nice for ST/X beginners.
NewLauncher.st
--- a/NewLauncher.st	Sat Jan 31 15:19:28 2015 +0100
+++ b/NewLauncher.st	Sat Jan 31 16:04:01 2015 +0100
@@ -3403,8 +3403,10 @@
     |l root dialog filter filterHolder v itemsByPath getItemByPath packageIdByItem packageID
      packageIcon greyPackageIcon applicationIcon greyApplicationIcon 
      folderIcon greyFolderIcon
-     browse packageDirPath loadAction updateAction filterChangedAction hierarchicalListView
-     resources selectedPackageHolder lbl|
+     browse packageDirPath 
+     loadAction updateAction filterChangedAction selectionChangeAction showPackageInfoAction
+     hierarchicalListView
+     resources selectedPackageLabel selectedPackageHolder infoView infoTextHolder|
 
     resources := self resources.
 
@@ -3416,6 +3418,7 @@
     greyApplicationIcon := applicationIcon asGrayImageDepth:(applicationIcon depth min:8).
 
     selectedPackageHolder := nil asValue.
+    infoTextHolder := nil asValue.
     filterHolder := nil asValue.
     itemsByPath := Dictionary new.
     packageIdByItem := IdentityDictionary new.
@@ -3567,6 +3570,10 @@
                     ]
                 ].
                 matchingItems isEmpty ifTrue:[
+                    "/ nothing found
+                    root recursiveDo:[:item |
+                        item label:(item label copy asText allNonBold withoutAnyColorEmphasis).
+                    ].
                     Screen current beep.
                 ] ifFalse:[
                     "/ collapse all and fully expand all matching items
@@ -3616,6 +3623,92 @@
             ].
         ].
 
+    showPackageInfoAction :=
+        [:package |
+            |projectDef comment info dir className fileName docChange|
+
+            info := resources string:'Sorry, could not find any package documentation'.
+            projectDef := package asPackageId projectDefinitionClass.
+            projectDef notNil ifTrue:[
+                comment := projectDef commentOrDocumentationString.
+                comment isNil ifTrue:[
+                    info := info, 
+                            (resources stringWithCRs:'\\The project''s definition class (%1)\has no documentation method.' with:projectDef class name).
+                ].
+            ] ifFalse:[
+                "/ try to find the package's source
+                dir := Smalltalk packageDirectoryForPackageId:package.
+                dir notNil ifTrue:[
+                    "/ is there a project definition class's source?
+                    className := ProjectDefinition projectDefinitionClassNameForDefinitionOf:package.
+                    fileName := dir / ((Smalltalk fileNameForClass:className),'.st').
+                    fileName exists ifTrue:[
+                        fileName readingFileDo:[:s |
+                            ChangeSet 
+                                fromStream:s 
+                                while:[:change |
+                                    (change isMethodCodeChange
+                                    and:[ change selector == #documentation
+                                    and:[ change isForMeta ]]) ifTrue:[
+                                        docChange := change.
+                                        false "/ stop reading
+                                    ] ifFalse:[
+                                        true
+                                    ].
+                                ].
+                        ].
+                        docChange notNil ifTrue:[
+                            comment := Parser methodCommentFromSource:docChange source.
+                        ] ifFalse:[
+                            info := info ,
+                                    (resources stringWithCRs:'\\The project''s definition class (%1)\has no documentation method.\In file: %2'
+                                            with:className
+                                            with:fileName pathName).
+                        ].
+                    ] ifFalse:[
+                        info := info , 
+                                (resources stringWithCRs:'\\No definition class was found in the project.\In folder: %1'
+                                        with:dir pathName).
+                    ].
+                ].
+            ].
+            comment notEmptyOrNil ifTrue:[
+                comment := comment asStringCollection.
+                [ comment size > 0 and:[comment first isEmpty]] whileTrue:[ comment removeFirst ].
+                (comment conform:[:line | line isEmpty or:[line startsWith:'    ']]) ifTrue:[
+                    comment := comment collect:[:line | 
+                                (line startsWith:'    ') ifTrue:[
+                                    line copyFrom:5
+                                ] ifFalse:[
+                                    line
+                                ]].
+                ].
+                info := comment asString.
+            ] ifFalse:[ 
+                info := info colorizeAllWith:Color red.
+            ].
+            infoTextHolder value:info.
+        ].
+
+    selectionChangeAction :=
+        [:selectionIndices |
+            |p|
+
+            selectionIndices size == 1 ifTrue:[
+                p := packageIdByItem at:(hierarchicalListView selectionValue) first ifAbsent:nil.
+                p notNil ifTrue:[
+                    selectedPackageHolder value:(resources string:'Selected package: "%1"' with:p).
+                    showPackageInfoAction value:p.
+                ] ifFalse:[
+                    (hierarchicalListView selectionValue first) == root ifTrue:[
+                        infoTextHolder value:'Local packages as found in the "packages" folder.'
+                    ].
+                ].
+            ] ifFalse:[
+                selectedPackageHolder value:(resources string:'Selected %1 packages.' with:selectionIndices size).
+            ].
+         ].
+
     dialog := Dialog new.
     dialog label:(resources string:'Load Package').
     dialog addAbortButtonLabelled:(resources string:'Close').
@@ -3640,22 +3733,15 @@
     hierarchicalListView preferredExtent:(400 @ 300).
     hierarchicalListView doubleClickAction:[:index | loadAction value:false. dialog okPressed].
     hierarchicalListView list:l.
-    hierarchicalListView action:[:selectionIndices |
-                            |p|
-
-                            selectionIndices size == 1 ifTrue:[
-                                p := packageIdByItem at:(v scrolledView selectionValue) first.
-                                selectedPackageHolder value:(resources string:'Selected package: "%1"' with:p).
-                            ] ifFalse:[
-                                selectedPackageHolder value:(resources string:'Selected %1 packages.' with:selectionIndices size).
-                            ].
-                         ].
+    hierarchicalListView action:selectionChangeAction.
 
     dialog addComponent:v.
-    lbl := dialog addTextLabelOn:(selectedPackageHolder) adjust:#left.
+    selectedPackageLabel := dialog addTextLabelOn:(selectedPackageHolder) adjust:#left.
+    infoView := dialog addTextBoxOn:infoTextHolder class:TextView withNumberOfLines:5 hScrollable:true vScrollable:true.
 
     dialog stickAtBottomWithVariableHeight:v.
-    dialog stickAtBottomWithFixHeight:lbl.
+    dialog stickAtBottomWithFixHeight:selectedPackageLabel.
+    dialog stickAtBottomWithFixHeight:infoView.
 
     PreviousPackageDialogExtent notNil ifTrue:[
         dialog extent:PreviousPackageDialogExtent
@@ -5460,14 +5546,14 @@
 !NewLauncher class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.519 2015-01-31 13:50:24 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.520 2015-01-31 15:04:01 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.519 2015-01-31 13:50:24 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.520 2015-01-31 15:04:01 cg Exp $'
 !
 
 version_SVN
-    ^ '$Id: NewLauncher.st,v 1.519 2015-01-31 13:50:24 cg Exp $'
+    ^ '$Id: NewLauncher.st,v 1.520 2015-01-31 15:04:01 cg Exp $'
 ! !