snapshotImage and remoteImage browser
authorClaus Gittinger <cg@exept.de>
Fri, 15 Feb 2002 14:26:07 +0100
changeset 3575 c35b9ba0092c
parent 3574 846aa047abea
child 3576 569fc1084563
snapshotImage and remoteImage browser
AbstractLauncherApplication.st
NewLauncher.st
--- a/AbstractLauncherApplication.st	Fri Feb 15 14:13:57 2002 +0100
+++ b/AbstractLauncherApplication.st	Fri Feb 15 14:26:07 2002 +0100
@@ -538,6 +538,10 @@
 
 !
 
+remoteImageBrowserAvailable
+    ^ SmalltalkShareClient notNil and:[RemoteImage notNil]
+!
+
 transcript
     "my transcript"
 
@@ -800,6 +804,27 @@
     "open a fullClass systemBrowser; asks for class"
 
     UserPreferences systemBrowserClass askThenBrowseFullClassProtocol
+!
+
+startRemoteImageBrowser
+    "open a remoteImage browser; asks for hostname.
+     The remote host must have an st/x running with remote browsing enabled.
+     Sorry, for now, only the old browser can be used this way."
+
+    |hostName|
+
+    hostName := Dialog request:'Remote Host:'.
+    SystemBrowser openOnRemoteImageOnHost:hostName port:nil.
+!
+
+startSnapshotImageBrowser
+    "open a snapshotImage browser; asks for filename.
+     Sorry, for now, only the old browser can be used this way."
+
+    |imageFileName|
+
+    imageFileName := Dialog requestFileName:'Name of Snapshot Image File:' default:'st.img' pattern:'*.img;*.sav'.
+    SystemBrowser openOnSnapShotImage:imageFileName
 ! !
 
 !AbstractLauncherApplication methodsFor:'user actions - demos'!
@@ -6398,5 +6423,5 @@
 !AbstractLauncherApplication class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.188 2002-02-15 13:03:03 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.189 2002-02-15 13:25:50 cg Exp $'
 ! !
--- a/NewLauncher.st	Fri Feb 15 14:13:57 2002 +0100
+++ b/NewLauncher.st	Fri Feb 15 14:26:07 2002 +0100
@@ -1053,6 +1053,7 @@
             #nameKey: #systemBrowser
             #value: #openApplication:
             #activeHelpKey: #classesSystemBrowser
+            #showBusyCursorWhilePerforming: true
             #argument: 'SystemBrowser'
             #labelImage: #(#ResourceRetriever nil #startSystemBrowserIcon 'System Browser')
           )
@@ -1073,6 +1074,7 @@
             #nameKey: #startChangeSetBrowser
             #value: #startChangeSetBrowser
             #activeHelpKey: #startChangeSetBrowser
+            #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
             #label: 'Changed Classes'
@@ -1080,6 +1082,7 @@
             #nameKey: #classBrowserOnChanges
             #value: #startClassBrowserOnChanges
             #activeHelpKey: #classesClassBrowserOnChanges
+            #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
             #label: 'Changed Methods'
@@ -1087,34 +1090,66 @@
             #nameKey: #classBrowserOnChangedMethods
             #value: #startClassBrowserOnChangedMethods
             #activeHelpKey: #classBrowserOnChangedMethods
+            #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
             #label: '-'
           )
          #(#MenuItem
-            #label: 'Class Browser on...'
-            #translateLabel: true
-            #nameKey: #classBrowserOn
-            #value: #startClassBrowser
-            #activeHelpKey: #classesClassBrowser
-          )
-         #(#MenuItem
-            #label: 'Full Class Browser on...'
+            #label: 'Special Browsers'
             #translateLabel: true
-            #value: #startFullClassBrowser
-            #activeHelpKey: #classesFullClassBrowser
-          )
-         #(#MenuItem
-            #label: 'Class Hierarchy Browser on...'
-            #translateLabel: true
-            #value: #startClassHierarchyBrowser
-            #activeHelpKey: #classesClassHierarchyBrowser
+            #submenu: 
+           #(#Menu
+              #(
+               #(#MenuItem
+                  #label: 'Class Browser on...'
+                  #translateLabel: true
+                  #nameKey: #classBrowserOn
+                  #value: #startClassBrowser
+                  #activeHelpKey: #classesClassBrowser
+                  #showBusyCursorWhilePerforming: true
+                )
+               #(#MenuItem
+                  #label: 'Full Class Browser on...'
+                  #translateLabel: true
+                  #value: #startFullClassBrowser
+                  #activeHelpKey: #classesFullClassBrowser
+                  #showBusyCursorWhilePerforming: true
+                )
+               #(#MenuItem
+                  #label: 'Class Hierarchy Browser on...'
+                  #translateLabel: true
+                  #value: #startClassHierarchyBrowser
+                  #activeHelpKey: #classesClassHierarchyBrowser
+                  #showBusyCursorWhilePerforming: true
+                )
+               #(#MenuItem
+                  #label: '-'
+                )
+               #(#MenuItem
+                  #label: 'Snapshot Image Browser...'
+                  #translateLabel: true
+                  #value: #startSnapshotImageBrowser
+                  #showBusyCursorWhilePerforming: true
+                )
+               #(#MenuItem
+                  #label: 'Remote Image Browser...'
+                  #translateLabel: true
+                  #value: #startRemoteImageBrowser
+                  #enabled: #remoteImageBrowserAvailable
+                  #showBusyCursorWhilePerforming: true
+                )
+               )
+              nil
+              nil
+            )
           )
          #(#MenuItem
             #label: 'Class Tree'
             #translateLabel: true
             #value: #openApplication:
             #activeHelpKey: #classesClassTreeBrowser
+            #showBusyCursorWhilePerforming: true
             #argument: 'ClassTreeGraphView'
           )
          #(#MenuItem
@@ -1125,12 +1160,14 @@
             #translateLabel: true
             #value: #browseImplementors
             #activeHelpKey: #classesImplementors
+            #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
             #label: 'Senders of...'
             #translateLabel: true
             #value: #browseSenders
             #activeHelpKey: #classesSenders
+            #showBusyCursorWhilePerforming: true
           )
          #(#MenuItem
             #label: '-'
@@ -4115,5 +4152,5 @@
 !NewLauncher class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.245 2001-12-14 09:29:06 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.246 2002-02-15 13:26:07 cg Exp $'
 ! !