new fileDialog - partially used
authorClaus Gittinger <cg@exept.de>
Wed, 12 May 2004 10:15:54 +0200
changeset 5835 228d78813972
parent 5834 2a6457a7d2d7
child 5836 922c94b683a1
new fileDialog - partially used
NewSystemBrowser.st
Tools__NewSystemBrowser.st
--- a/NewSystemBrowser.st	Tue May 11 18:39:34 2004 +0200
+++ b/NewSystemBrowser.st	Wed May 12 10:15:54 2004 +0200
@@ -14644,8 +14644,7 @@
         #binary - ST/X binary format
     "
 
-    |currentClassCategory fileName suffix saveName fileBox 
-     dir aStream classesToInitialize classesToFileout mgr|
+    |currentClassCategory fileName suffix saveName aStream classesToInitialize classesToFileout mgr|
 
     currentClassCategory := self theSingleSelectedCategory.
     currentClassCategory notNil ifTrue:[
@@ -14674,29 +14673,9 @@
         ^ self
     ].
 
-    fileBox := FileSelectionBox
-                    title:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
-                    okText:(resources string:'FileOut')
-                    abortText:(resources string:'Cancel')
-                    action:[:fileName | saveName := fileName.].
-
-    fileBox initialText:fileName.
-    dir := FileSelectionBox lastFileSelectionDirectory.
-    dir isNil ifTrue:[
-        "
-         this test allows a smalltalk to be built without Projects/ChangeSets
-        "
-        Project notNil ifTrue:[
-            dir := Project currentProjectDirectory asFilename 
-        ]
-    ].
-    dir notNil ifTrue:[
-        fileBox directory:dir.
-    ].
-    fileBox showAtPointer.
-
-    fileBox destroy.
-    fileBox := nil.
+    saveName := self 
+                    fileNameDialogForFileOut:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories')) 
+                    default:fileName.
 
     saveName isNil ifTrue:[
         ^ self
@@ -14796,7 +14775,9 @@
 
     currentCategory := self theSingleSelectedCategory ? 'selected categories'.
 
-    dirName := self askForDirectoryToFileOut:(resources string:'fileOut %1 in:' with:currentCategory) default:nil.
+    dirName := self 
+                askForDirectoryToFileOut:(resources string:'FileOut %1 in:' with:currentCategory) 
+                default:nil.
     dirName isNil ifTrue:[^ self].
 
     self 
@@ -15246,6 +15227,62 @@
     self categoryListApp removeAllAdditionalCategories; forceUpdateList
 !
 
+fileNameDialogForFileOut:tite default:defaultFileName
+    ^ self fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:nil
+!
+
+fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:cancelAllActionOrNil
+    |currentClassCategory saveName fileBox 
+     defaultDir cancelAllButton|
+
+    defaultDir := FileSelectionBox lastFileSelectionDirectory.
+    defaultDir isNil ifTrue:[
+        "
+         this test allows a smalltalk to be built without Projects/ChangeSets
+        "
+        Project notNil ifTrue:[
+            defaultDir := Project currentProjectDirectory asFilename 
+        ].
+        defaultDir isNil ifTrue:[
+            defaultDir := Filename currentDirectory
+        ]
+    ].
+
+    UserPreferences current useNewFileDialog ifTrue:[
+        saveName := Dialog 
+                        requestFileName:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories')) 
+                        default:defaultFileName
+                        ok:(resources string:'FileOut') 
+                        abort:(resources string:'Cancel') 
+                        pattern:nil 
+                        fromDirectory:defaultDir.
+        saveName isEmptyOrNil ifTrue:[
+            saveName := nil
+        ].
+    ] ifFalse:[
+        fileBox := FileSelectionBox
+                        title:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
+                        okText:(resources string:'FileOut')
+                        abortText:(resources string:'Cancel')
+                        action:[:fileName | saveName := fileName.].
+
+        fileBox initialText:defaultFileName.
+        fileBox directory:defaultDir.
+
+        cancelAllActionOrNil notNil ifTrue:[
+            cancelAllButton := Button label:(resources string:'Cancel All').
+            fileBox addButton:cancelAllButton before:fileBox cancelButton.
+            cancelAllButton action:cancelAllActionOrNil.
+        ].
+
+        fileBox showAtPointer.
+        fileBox destroy.
+        fileBox := nil.
+    ].
+
+    ^ saveName
+!
+
 fileOutEachClassIn:aCollectionOfClasses in:aDirectory withFormat:aFormatSymbolOrNil
     "fileOut a bunch of classes as individual files into some directory"
 
@@ -16037,7 +16074,9 @@
         ^ self warn:'Only private classes selected'.
     ].
 
-    dirName := self askForDirectoryToFileOut:(resources string:'fileOut %1 classes in:' with:classes size) default:nil.
+    dirName := self 
+                askForDirectoryToFileOut:(resources string:'FileOut %1 classes in:' with:classes size) 
+                default:nil.
     dirName isNil ifTrue:[^ self].
 
     self 
@@ -17625,7 +17664,7 @@
 fileOutClass:aClass askForFile:doAsk withCancelAll:withCancelAll format:formatSymbolOrNil sourceMode:sourceMode
     "fileOut a class."
 
-    |fileBox saveName dir stillAsking cancelAll cancelAllButton suffix|
+    |fileBox saveName stillAsking cancelAll suffix|
 
     suffix := self fileSuffixForClass:aClass format:formatSymbolOrNil.
     formatSymbolOrNil notNil ifTrue:[
@@ -17635,33 +17674,16 @@
     stillAsking := doAsk.
 
     [stillAsking] whileTrue:[
-        fileBox := FileSelectionBox
-                        title:(resources string:'FileOut ''%1'' as:' with:aClass name allBold)
-                        okText:(resources string:'FileOut')
-                        abortText:(resources string:'Cancel')
-                        action:[:fileName | saveName := fileName].
-
-        withCancelAll ifTrue:[
-            cancelAllButton := Button label:(resources string:'Cancel All').
-            fileBox addButton:cancelAllButton before:fileBox cancelButton.
-            cancelAllButton action:[
-                                        cancelAll := true.
-                                        fileBox doAccept.
-                                        fileBox okPressed.
-                                   ].
-        ].
-
-        fileBox initialText:((Smalltalk fileNameForClass:aClass) , '.' , suffix).
-        dir := FileSelectionBox lastFileSelectionDirectory.
-        dir notNil ifTrue:[
-            fileBox directory:dir.
-        ].
-        fileBox showAtPointer.
-        fileBox destroy.
-
-        fileBox accepted ifFalse:[
-            ^ self
-        ].
+        saveName := self 
+                        fileNameDialogForFileOut:(resources string:'FileOut ''%1'' as:' with:aClass name allBold) 
+                        default:((Smalltalk fileNameForClass:aClass) , '.' , suffix)
+                        withCancelAll:(withCancelAll 
+                                        ifTrue:[
+                                                  cancelAll := true.
+                                                  fileBox doAccept.
+                                                  fileBox okPressed.
+                                               ]
+                                        ifFalse:nil).
 
         cancelAll == true ifTrue:[
             AbortSignal raise
@@ -17726,8 +17748,8 @@
     |dirName|
 
     dirName := self 
-                askForDirectoryToFileOut:(resources string:'fileOut %1 class(es) in:'
-                        with:aBunchOfClasses size)
+                askForDirectoryToFileOut:(resources string:'FileOut %1 class(es) in:'
+                                                    with:aBunchOfClasses size)
                 default:nil.
     dirName isNil ifTrue:[
         ^ self
@@ -22465,8 +22487,8 @@
 
     currentProject := self theSingleSelectedProject ? 'selected projects'.
     dirName := self 
-                askForDirectoryToFileOut:(resources string:'fileOut %1 in:'
-                        with:currentProject)
+                askForDirectoryToFileOut:(resources string:'FileOut %1 in:'
+                                                    with:currentProject)
                 default:nil.
     dirName isNil ifTrue:[
         ^ self
@@ -24968,7 +24990,7 @@
     "fileOut a bunch of methods; 
      used both from fileOutMethod-list and fileOut-selected methods."
 
-    |fileBox saveName dir stillAsking suffix defaultName|
+    |saveName stillAsking suffix defaultName|
 
     suffix := self fileSuffixForFormat:formatSymbolOrNil.
     defaultName := (nameOrNil ? 'some_methods') , '.' , suffix.
@@ -24976,19 +24998,9 @@
     stillAsking := true.
 
     [stillAsking] whileTrue:[
-        fileBox := FileSelectionBox
-                        title:(resources string:(boxTitleOrNil ? 'FileOut methods as:'))
-                        okText:(resources string:'FileOut')
-                        abortText:(resources string:'Cancel')
-                        action:[:fileName | saveName := fileName].
-
-        fileBox initialText:defaultName.
-        dir := FileSelectionBox lastFileSelectionDirectory.
-        dir notNil ifTrue:[
-            fileBox directory:dir.
-        ].
-        fileBox showAtPointer.
-        fileBox destroy.
+        saveName := self 
+                        fileNameDialogForFileOut:(resources string:(boxTitleOrNil ? 'FileOut methods as:')) 
+                        default:defaultName.
 
         saveName isNil ifTrue:[
             ^ self
@@ -30445,8 +30457,8 @@
 
     fileBox := FileSelectionBox
                     title:title
-                    okText:(resources string:'fileOut')
-                    abortText:(resources string:'cancel')
+                    okText:(resources string:'FileOut')
+                    abortText:(resources string:'Cancel')
                     action:[:fileName |dirName := fileName.].
 
     dir := defaultDirOrNil.
@@ -35455,7 +35467,7 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.737 2004-05-11 12:53:59 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.738 2004-05-12 08:15:54 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!
--- a/Tools__NewSystemBrowser.st	Tue May 11 18:39:34 2004 +0200
+++ b/Tools__NewSystemBrowser.st	Wed May 12 10:15:54 2004 +0200
@@ -14644,8 +14644,7 @@
         #binary - ST/X binary format
     "
 
-    |currentClassCategory fileName suffix saveName fileBox 
-     dir aStream classesToInitialize classesToFileout mgr|
+    |currentClassCategory fileName suffix saveName aStream classesToInitialize classesToFileout mgr|
 
     currentClassCategory := self theSingleSelectedCategory.
     currentClassCategory notNil ifTrue:[
@@ -14674,29 +14673,9 @@
         ^ self
     ].
 
-    fileBox := FileSelectionBox
-                    title:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
-                    okText:(resources string:'FileOut')
-                    abortText:(resources string:'Cancel')
-                    action:[:fileName | saveName := fileName.].
-
-    fileBox initialText:fileName.
-    dir := FileSelectionBox lastFileSelectionDirectory.
-    dir isNil ifTrue:[
-        "
-         this test allows a smalltalk to be built without Projects/ChangeSets
-        "
-        Project notNil ifTrue:[
-            dir := Project currentProjectDirectory asFilename 
-        ]
-    ].
-    dir notNil ifTrue:[
-        fileBox directory:dir.
-    ].
-    fileBox showAtPointer.
-
-    fileBox destroy.
-    fileBox := nil.
+    saveName := self 
+                    fileNameDialogForFileOut:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories')) 
+                    default:fileName.
 
     saveName isNil ifTrue:[
         ^ self
@@ -14796,7 +14775,9 @@
 
     currentCategory := self theSingleSelectedCategory ? 'selected categories'.
 
-    dirName := self askForDirectoryToFileOut:(resources string:'fileOut %1 in:' with:currentCategory) default:nil.
+    dirName := self 
+                askForDirectoryToFileOut:(resources string:'FileOut %1 in:' with:currentCategory) 
+                default:nil.
     dirName isNil ifTrue:[^ self].
 
     self 
@@ -15246,6 +15227,62 @@
     self categoryListApp removeAllAdditionalCategories; forceUpdateList
 !
 
+fileNameDialogForFileOut:tite default:defaultFileName
+    ^ self fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:nil
+!
+
+fileNameDialogForFileOut:tite default:defaultFileName withCancelAll:cancelAllActionOrNil
+    |currentClassCategory saveName fileBox 
+     defaultDir cancelAllButton|
+
+    defaultDir := FileSelectionBox lastFileSelectionDirectory.
+    defaultDir isNil ifTrue:[
+        "
+         this test allows a smalltalk to be built without Projects/ChangeSets
+        "
+        Project notNil ifTrue:[
+            defaultDir := Project currentProjectDirectory asFilename 
+        ].
+        defaultDir isNil ifTrue:[
+            defaultDir := Filename currentDirectory
+        ]
+    ].
+
+    UserPreferences current useNewFileDialog ifTrue:[
+        saveName := Dialog 
+                        requestFileName:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories')) 
+                        default:defaultFileName
+                        ok:(resources string:'FileOut') 
+                        abort:(resources string:'Cancel') 
+                        pattern:nil 
+                        fromDirectory:defaultDir.
+        saveName isEmptyOrNil ifTrue:[
+            saveName := nil
+        ].
+    ] ifFalse:[
+        fileBox := FileSelectionBox
+                        title:(resources string:'FileOut %1 as:' with:(currentClassCategory ? 'selected categories'))
+                        okText:(resources string:'FileOut')
+                        abortText:(resources string:'Cancel')
+                        action:[:fileName | saveName := fileName.].
+
+        fileBox initialText:defaultFileName.
+        fileBox directory:defaultDir.
+
+        cancelAllActionOrNil notNil ifTrue:[
+            cancelAllButton := Button label:(resources string:'Cancel All').
+            fileBox addButton:cancelAllButton before:fileBox cancelButton.
+            cancelAllButton action:cancelAllActionOrNil.
+        ].
+
+        fileBox showAtPointer.
+        fileBox destroy.
+        fileBox := nil.
+    ].
+
+    ^ saveName
+!
+
 fileOutEachClassIn:aCollectionOfClasses in:aDirectory withFormat:aFormatSymbolOrNil
     "fileOut a bunch of classes as individual files into some directory"
 
@@ -16037,7 +16074,9 @@
         ^ self warn:'Only private classes selected'.
     ].
 
-    dirName := self askForDirectoryToFileOut:(resources string:'fileOut %1 classes in:' with:classes size) default:nil.
+    dirName := self 
+                askForDirectoryToFileOut:(resources string:'FileOut %1 classes in:' with:classes size) 
+                default:nil.
     dirName isNil ifTrue:[^ self].
 
     self 
@@ -17625,7 +17664,7 @@
 fileOutClass:aClass askForFile:doAsk withCancelAll:withCancelAll format:formatSymbolOrNil sourceMode:sourceMode
     "fileOut a class."
 
-    |fileBox saveName dir stillAsking cancelAll cancelAllButton suffix|
+    |fileBox saveName stillAsking cancelAll suffix|
 
     suffix := self fileSuffixForClass:aClass format:formatSymbolOrNil.
     formatSymbolOrNil notNil ifTrue:[
@@ -17635,33 +17674,16 @@
     stillAsking := doAsk.
 
     [stillAsking] whileTrue:[
-        fileBox := FileSelectionBox
-                        title:(resources string:'FileOut ''%1'' as:' with:aClass name allBold)
-                        okText:(resources string:'FileOut')
-                        abortText:(resources string:'Cancel')
-                        action:[:fileName | saveName := fileName].
-
-        withCancelAll ifTrue:[
-            cancelAllButton := Button label:(resources string:'Cancel All').
-            fileBox addButton:cancelAllButton before:fileBox cancelButton.
-            cancelAllButton action:[
-                                        cancelAll := true.
-                                        fileBox doAccept.
-                                        fileBox okPressed.
-                                   ].
-        ].
-
-        fileBox initialText:((Smalltalk fileNameForClass:aClass) , '.' , suffix).
-        dir := FileSelectionBox lastFileSelectionDirectory.
-        dir notNil ifTrue:[
-            fileBox directory:dir.
-        ].
-        fileBox showAtPointer.
-        fileBox destroy.
-
-        fileBox accepted ifFalse:[
-            ^ self
-        ].
+        saveName := self 
+                        fileNameDialogForFileOut:(resources string:'FileOut ''%1'' as:' with:aClass name allBold) 
+                        default:((Smalltalk fileNameForClass:aClass) , '.' , suffix)
+                        withCancelAll:(withCancelAll 
+                                        ifTrue:[
+                                                  cancelAll := true.
+                                                  fileBox doAccept.
+                                                  fileBox okPressed.
+                                               ]
+                                        ifFalse:nil).
 
         cancelAll == true ifTrue:[
             AbortSignal raise
@@ -17726,8 +17748,8 @@
     |dirName|
 
     dirName := self 
-                askForDirectoryToFileOut:(resources string:'fileOut %1 class(es) in:'
-                        with:aBunchOfClasses size)
+                askForDirectoryToFileOut:(resources string:'FileOut %1 class(es) in:'
+                                                    with:aBunchOfClasses size)
                 default:nil.
     dirName isNil ifTrue:[
         ^ self
@@ -22465,8 +22487,8 @@
 
     currentProject := self theSingleSelectedProject ? 'selected projects'.
     dirName := self 
-                askForDirectoryToFileOut:(resources string:'fileOut %1 in:'
-                        with:currentProject)
+                askForDirectoryToFileOut:(resources string:'FileOut %1 in:'
+                                                    with:currentProject)
                 default:nil.
     dirName isNil ifTrue:[
         ^ self
@@ -24968,7 +24990,7 @@
     "fileOut a bunch of methods; 
      used both from fileOutMethod-list and fileOut-selected methods."
 
-    |fileBox saveName dir stillAsking suffix defaultName|
+    |saveName stillAsking suffix defaultName|
 
     suffix := self fileSuffixForFormat:formatSymbolOrNil.
     defaultName := (nameOrNil ? 'some_methods') , '.' , suffix.
@@ -24976,19 +24998,9 @@
     stillAsking := true.
 
     [stillAsking] whileTrue:[
-        fileBox := FileSelectionBox
-                        title:(resources string:(boxTitleOrNil ? 'FileOut methods as:'))
-                        okText:(resources string:'FileOut')
-                        abortText:(resources string:'Cancel')
-                        action:[:fileName | saveName := fileName].
-
-        fileBox initialText:defaultName.
-        dir := FileSelectionBox lastFileSelectionDirectory.
-        dir notNil ifTrue:[
-            fileBox directory:dir.
-        ].
-        fileBox showAtPointer.
-        fileBox destroy.
+        saveName := self 
+                        fileNameDialogForFileOut:(resources string:(boxTitleOrNil ? 'FileOut methods as:')) 
+                        default:defaultName.
 
         saveName isNil ifTrue:[
             ^ self
@@ -30445,8 +30457,8 @@
 
     fileBox := FileSelectionBox
                     title:title
-                    okText:(resources string:'fileOut')
-                    abortText:(resources string:'cancel')
+                    okText:(resources string:'FileOut')
+                    abortText:(resources string:'Cancel')
                     action:[:fileName |dirName := fileName.].
 
     dir := defaultDirOrNil.
@@ -35455,7 +35467,7 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.737 2004-05-11 12:53:59 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.738 2004-05-12 08:15:54 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!