--- a/AbstractLauncherApplication.st Thu Feb 11 13:17:51 1999 +0100
+++ b/AbstractLauncherApplication.st Thu Feb 11 13:45:36 1999 +0100
@@ -1,5 +1,5 @@
ToolApplicationModel subclass:#AbstractLauncherApplication
- instanceVariableNames:''
+ instanceVariableNames:'transcript'
classVariableNames:'NotifyingEmergencyHandler OpenLaunchers'
poolDictionaries:''
category:'Interface-Smalltalk'
@@ -64,8 +64,159 @@
"Modified: 15.1.1997 / 21:15:38 / cg"
! !
+!AbstractLauncherApplication methodsFor:'actions - classes'!
+
+startChangesBrowser
+ "open a changebrowser"
+
+ self withWaitCursorDo:[
+ UserPreferences current changesBrowserClass open
+ ]
+
+ "Modified: / 17.10.1998 / 14:38:18 / cg"
+! !
+
!AbstractLauncherApplication methodsFor:'private'!
+findWindow:title
+ "a helper for find & destroy and find & raise operations;
+ let user choose a view and return it; return nil on cancel"
+
+ |knownTopViews nameList box|
+
+ knownTopViews := IdentitySet new.
+ Screen allScreens do:[:aScreen |
+ aScreen knownViews do:[:aView |
+ |top showIt wg|
+
+ aView notNil ifTrue:[
+ top := aView topView.
+ (top isKindOf:DebugView) ifTrue:[
+ "/ although modal, show it.
+ showIt := top realized
+ ] ifFalse:[
+ wg := top windowGroup.
+ showIt := (wg notNil and:[wg isModal not]).
+ ].
+ showIt ifTrue:[
+ knownTopViews add:top
+ ]
+ ]
+ ]
+ ].
+
+ knownTopViews := knownTopViews asOrderedCollection.
+ knownTopViews sort:[:v1 :v2 | |l1 l2|
+ l1 := v1 label ? 'aView'.
+ l2 := v2 label ? 'aView'.
+ l1 < l2
+ ].
+ nameList := knownTopViews collect:[:v |
+ |isDead wg p l|
+
+ l := v label ? 'aView'.
+ ((wg := v windowGroup) notNil
+ and:[(p := wg process) notNil
+ and:[p state ~~ #dead]]) ifTrue:[
+ l
+ ] ifFalse:[
+ l , ' (dead ?)'
+ ]
+ ].
+
+ box := ListSelectionBox new.
+ box noEnterField.
+ box list:nameList.
+ box label:(resources string:'view selection').
+ box title:(resources string:title) withCRs.
+ box action:[:selection |
+ |v|
+
+ v := knownTopViews at:box selectionIndex.
+ box destroy.
+ ^ v
+ ].
+ box extent:400@300.
+ box showAtPointer.
+ ^ nil
+
+!
+
+openApplication: className
+ "open an application, given by the classe name."
+
+ self openApplication:className nameSpace:nil
+!
+
+openApplication:className nameSpace:aNameSpace
+ "open some application, given the classes name.
+ Look for it in Smalltalk and the given nameSpace"
+
+ self openApplication:className nameSpace:aNameSpace with:#open
+!
+
+openApplication:className nameSpace:aNameSpace with:aSelector
+ "open some application, given the classes name.
+ Look for it in Smalltalk and the given nameSpace"
+
+ |cls|
+
+ cls := Smalltalk at:className asSymbol.
+ cls isNil ifTrue:[
+ "/ look if its in the nameSpace
+ aNameSpace notNil ifTrue:[
+ cls := aNameSpace at:className asSymbol
+ ]
+ ].
+
+ cls isNil ifTrue:[
+ self warn:(resources string:'Sorry, the %1 class is not available.' with:className).
+ ] ifFalse:[
+ Autoload autoloadFailedSignal handle:[:ex |
+ self warn:(resources string:'Sorry, the %1 class seems to be not available.' with:className)
+ ] do:[
+ self withWaitCursorDo:[cls perform:aSelector]
+ ]
+ ]
+
+!
+
+pickAView
+ "let user pick a view and return it"
+
+ |v|
+
+ (Delay forSeconds:1) wait.
+ v := Screen current viewFromUser.
+ v isNil ifTrue:[
+ self warn:'Sorry, this is not a smalltalk view'.
+ ^ nil
+ ].
+ ^ v
+
+!
+
+saveScreenImage:anImage defaultName:defaultName
+ "save an image into a file
+ - ask user for filename using a fileSelectionBox."
+
+ |fileName|
+
+ fileName := Dialog
+ requestFileName:(resources string:'save image in:')
+ default:(defaultName , '.tiff')
+ ok:(resources string:'save')
+ abort:(resources string:'cancel')
+ pattern:'*.tiff'.
+
+ fileName notNil ifTrue:[
+ anImage saveOn:fileName
+ ].
+
+ "Modified: / 21.2.1996 / 13:09:28 / cg"
+ "Created: / 29.1.1998 / 23:20:36 / cg"
+!
+
showDocumentation:aRelativeDocFilePath
"open an HTML browser on some document"
@@ -102,6 +253,215 @@
"Modified: / 25.2.1998 / 21:24:20 / cg"
! !
+!AbstractLauncherApplication methodsFor:'private - settings callBacks'!
+
+changeViewStyleTo:newStyle
+
+ newStyle notNil ifTrue:[
+ self withWaitCursorDo:[
+ transcript showCR:'change style to ' , newStyle , ' ...'.
+ View defaultStyle:newStyle asSymbol.
+ ].
+ self reopenLauncher.
+ DebugView newDebugger.
+ ]
+
+!
+
+fontBoxForEncoding:encodingMatch
+ "open a fontBox, showing fonts which match some encoding
+ (used when changing to japanese ...)"
+
+ |box y b
+ labelDef buttonDef listDef menuDef textDef
+ models labels allOfThem filter|
+
+ encodingMatch notNil ifTrue:[
+ filter := [:f | f encoding notNil
+ and:[encodingMatch match:f encoding]].
+ ].
+
+ models := OrderedCollection new.
+ labels := OrderedCollection new.
+
+ models add:(allOfThem := nil asValue).
+ models add:(labelDef := Label defaultFont asValue).
+ models add:(buttonDef := Button defaultFont asValue).
+ models add:(listDef := SelectionInListView defaultFont asValue).
+ models add:(menuDef := MenuView defaultFont asValue).
+ models add:(textDef := TextView defaultFont asValue).
+
+ box := Dialog new.
+ box label:(resources string:'Font settings').
+
+ models
+ with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text'))
+ do:[:model :title |
+ |y2 lbl f i|
+
+ f := model value.
+
+ (box addTextLabel:title) adjust:#left.
+
+ y := box yPosition.
+ b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.
+ b relativeExtent:nil; extent:(b preferredExtent).
+ y2 := box yPosition.
+ box yPosition:y.
+ i := box leftIndent.
+ box leftIndent:(b widthIncludingBorder + View viewSpacing).
+ (lbl := box addTextLabel:'')
+ adjust:#left;
+ font:(model value);
+ labelChannel:(BlockValue
+ with:[:v | |f|
+ f := v value.
+ f isNil ifTrue:[
+ ''
+ ] ifFalse:[
+ f userFriendlyName
+ ]
+ ]
+ argument:model).
+ labels add:lbl.
+
+ box leftIndent:i.
+ box yPosition:(box yPosition max:y2).
+ box addVerticalSpace.
+ box addHorizontalLine.
+ box addVerticalSpace.
+
+ b action:[
+ |f|
+
+ f := FontPanel
+ fontFromUserInitial:(model value)
+ title:(resources string:'font for %1' with:title)
+ filter:filter.
+ f notNil ifTrue:[
+ model == allOfThem ifTrue:[
+ models do:[:m | m value:f].
+ labels do:[:l | l font:f]
+ ] ifFalse:[
+ model value:f.
+ lbl font:f.
+ ].
+ ]
+ ].
+ model == allOfThem ifTrue:[
+ box addVerticalSpace
+ ]
+ ].
+
+ box addAbortButton; addOkButton.
+ (box addButton:(Button label:(resources string:'defaults')) before:nil)
+ action:[
+ "/ fetch defaults
+ View readStyleSheetAndUpdateAllStyleCaches.
+ labelDef value: Label defaultFont.
+ buttonDef value: Button defaultFont.
+ listDef value: SelectionInListView defaultFont.
+ menuDef value: MenuView defaultFont.
+ textDef value: TextView defaultFont.
+ ].
+
+ box open.
+ box accepted ifTrue:[
+ Label defaultFont:labelDef value.
+ Button defaultFont:buttonDef value.
+ Toggle defaultFont:buttonDef value.
+ SelectionInListView defaultFont:listDef value.
+ MenuView defaultFont:menuDef value.
+ PullDownMenu defaultFont:menuDef value.
+ TextView defaultFont:textDef value.
+ EditTextView defaultFont:textDef value.
+ CodeView defaultFont:textDef value.
+ ].
+ box destroy.
+ ^ box accepted
+
+ "Modified: / 15.9.1998 / 22:04:56 / cg"
+!
+
+reopenLauncher
+ "reopen a new launcher.
+ for now (since style & language settings currently do
+ not affect living views ...)
+ WARNING: bad design: Message known in LauncherDialogs"
+
+ |contents builder newLauncher|
+
+ contents := transcript endEntry; list.
+ builder := self class openAt:(self window origin).
+ builder window waitUntilVisible.
+ newLauncher := builder application.
+ newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor.
+ ^ newLauncher
+
+ "Modified: / 4.8.1998 / 17:08:33 / cg"
+
+! !
+
+!AbstractLauncherApplication methodsFor:'queries'!
+
+processName
+ "for monitors only - my name"
+
+ ^ 'ST/X Launcher'
+
+!
+
+transcript
+ "my transcript"
+
+ ^ transcript
+! !
+
+!AbstractLauncherApplication methodsFor:'startup / release'!
+
+addTopViewsToCurrentProject
+ "ignored here - the launcher is always global (i.e. not project private)."
+
+ ^ self
+
+!
+
+closeRequest
+ "close request from windowing system (window close);
+ confirm and ask if closing of launcher only or
+ a smalltalk-exit is wanted"
+
+ |answer|
+
+ answer := Dialog
+ confirmWithCancel:(resources string:'Close %1 only or exit Smalltalk (close all)?' with:self class name)
+ labels:(resources array:#('Cancel' 'Exit' 'Close'))
+ default:3.
+ answer isNil ifTrue:[
+ "/ cancel
+ ^self
+ ].
+
+ answer == true ifTrue:[
+ super closeRequest
+ ].
+
+ self exit
+
+ "Modified: / 5.9.1998 / 16:40:11 / cg"
+!
+
+saveAndTerminateRequest
+ "some windowManagers can send this, to shutDown an application
+ but let it save its state before, for later restart.
+ Although I have not yet encountered such a windowManager,
+ we are already prepared for this ;-)"
+
+ self snapshot.
+ super saveAndTerminateRequest
+
+! !
+
!AbstractLauncherApplication methodsFor:'user actions - about'!
openLicenseConditions
@@ -128,6 +488,155 @@
"Modified: / 23.4.1998 / 11:45:53 / cg"
! !
+!AbstractLauncherApplication methodsFor:'user actions - classes'!
+
+browseAllBreakAndTracePoints
+ "open a browser showing all breakPointed/traced methods
+ (but, to get rid of them, there is also a menu itme to remove them all)"
+
+ SystemBrowser
+ browseMethods: WrappedMethod allInstances
+ title:'all breakPointed/traced methods'
+
+!
+
+browseImplementors
+ "open an implementors- browser after asking for a selector"
+
+ |enterBox selector|
+
+ enterBox := EnterBox
+ title:(resources at:'Browse implementors of:') withCRs
+ okText:(resources at:'browse')
+ action:[:acceptedString | selector := acceptedString].
+ enterBox showAtPointer.
+
+ selector notNil ifTrue:[
+ self withWaitCursorDo:[
+ SystemBrowser browseImplementorsOf:selector
+ ]
+ ].
+
+!
+
+browseResources
+ "open a resource- browser after asking for a resource string"
+
+ |box resourceHolder valueHolder component rsrc value t anyString|
+
+ anyString := resources string:'* any *'.
+
+ resourceHolder := ValueHolder newString.
+ valueHolder := '*' asValue.
+
+ box := DialogBox new.
+ box label:(resources at:'Resource search:').
+ component := box addTextLabel:(resources at:'Search for methods which contain a\particular resource specification') withCRs.
+ component adjust:#left.
+ box addVerticalSpace:10.
+
+ component := box addTextLabel:(resources at:'Resource symbol (empty for any; no matchPattern allowed):') withCRs.
+ component adjust:#left.
+ component := box addComboBoxOn:resourceHolder tabable:true.
+ component list:((Array with:anyString) , #('canvas' 'menu' 'keyboard' 'style' 'image' 'programMenu' nil 'needsFix')).
+
+ component := box addTextLabel:(resources at:'Resource value (* for any; matchPattern is allowed):') withCRs.
+ component adjust:#left.
+ box addInputFieldOn:valueHolder tabable:true.
+
+ box addVerticalSpace:10.
+ box addHelpButtonFor:'programming/language.html#RESOURCEDEFS'.
+ box addAbortButton; addOkButton.
+
+ box showAtPointer.
+ box destroy.
+
+ box accepted ifTrue:[
+ rsrc := resourceHolder value.
+ value := valueHolder value.
+
+ (rsrc isNil or:[rsrc isEmpty or:[rsrc = '*' or:[rsrc = anyString]]]) ifTrue:[
+ t := 'methods with any resource'.
+ rsrc := nil
+ ] ifFalse:[
+ t := 'methods with #' , rsrc , '-resource'.
+ rsrc := rsrc withoutSeparators asSymbol
+ ].
+ (value isNil or:[value isEmpty or:[value = '*']]) ifTrue:[
+ t := t , ' and any value'.
+ value := nil
+ ] ifFalse:[
+ t := t , ' and value ' , value.
+ ].
+ self withWaitCursorDo:[
+ SystemBrowser browseForResource:rsrc
+ containing:value
+ in:(Smalltalk allClasses)
+ title:t
+ ]
+ ].
+
+!
+
+browseSenders
+ "open a senders- browser after asking for a selector"
+
+ |enterBox selector|
+
+ enterBox := EnterBox
+ title:(resources at:'Browse senders of:') withCRs
+ okText:(resources at:'browse')
+ action:[:acceptedString | selector := acceptedString].
+ enterBox showAtPointer.
+
+ selector notNil ifTrue:[
+ self withWaitCursorDo:[
+ SystemBrowser browseAllCallsOn:selector
+ ]
+ ].
+
+!
+
+browseUndeclared
+ "open a browser on methods refering to undeclared variables"
+
+ self withWaitCursorDo:[
+ SystemBrowser
+ browseReferendsOf:(Smalltalk underclaredPrefix , '*')
+ title:(resources string:'references to undeclared variables')
+ warnIfNone:true
+ ]
+
+!
+
+removeAllBreakAndTracePoints
+ "remove all break- and trace points"
+
+ self withCursor:Cursor execute do:[ MessageTracer cleanup]
+
+!
+
+startClassBrowser
+ "open a classBrowser; asks for class"
+
+ SystemBrowser askThenBrowseClass
+
+!
+
+startClassHierarchyBrowser
+ "open a classHierarchyBrowser; asks for class"
+
+ SystemBrowser askThenBrowseClassHierarchy
+
+!
+
+startFullClassBrowser
+ "open a fullClass systemBrowser; asks for class"
+
+ SystemBrowser askThenBrowseFullClassProtocol
+
+! !
+
!AbstractLauncherApplication methodsFor:'user actions - file'!
objectModuleDialog
@@ -344,6 +853,258 @@
"Modified: / 31.7.1998 / 22:47:33 / cg"
! !
+!AbstractLauncherApplication methodsFor:'user actions - system'!
+
+compressingGarbageCollect
+ "perform a compressing garbageCollect"
+
+ self withWaitCursorDo:[ObjectMemory verboseGarbageCollect]
+
+!
+
+garbageCollect
+ "perform a non-compressing garbageCollect"
+
+ self withWaitCursorDo:[ObjectMemory reclaimSymbols]
+
+!
+
+startStopEventTrace
+ "start/stop event tracing for a particular view"
+
+ |v wg|
+
+ v := Screen current viewFromUser.
+ v notNil ifTrue:[
+ v := v topView.
+ wg := v windowGroup.
+ wg notNil ifTrue:[
+ "/
+ "/ toggle eventTrace in its windowGroup
+ "/
+ wg traceEvents:(wg preEventHook isNil)
+ ]
+ ]
+
+! !
+
+!AbstractLauncherApplication methodsFor:'user actions - tools'!
+
+newProject
+ "creates a new project & opens a projectView for it"
+
+ Project notNil ifTrue: [(ProjectView for: Project new) open]
+!
+
+selectProject
+ "asks for and switch to another project"
+
+ |list box|
+
+ Project notNil ifTrue:[
+ list := Project allInstances.
+ box := ListSelectionBox new.
+ box list:(list collect:[:p | p name]).
+ box title:(resources string:'select a project').
+ box action:[:selection |
+ |project|
+
+ project := list detect:[:p | p name = selection] ifNone:[nil].
+ project isNil ifTrue:[
+ transcript showCR:'no such project.'
+ ] ifFalse:[
+ project showViews.
+ Project current:project
+ ]
+ ].
+ box showAtPointer.
+ box destroy
+ ]
+!
+
+startNewLauncher
+ "opens the new launcher"
+
+ NewLauncher isNil ifTrue:[
+ ^ self warn:'The NewLauncher is not available in this release.'
+ ].
+ NewLauncher openAt:(self window origin)
+
+!
+
+startOldLauncher
+ "opens the old launcher"
+
+ Launcher isNil ifTrue:[
+ ^ self warn:'The (Old)Launcher is not available in this release.'
+ ].
+ Launcher openAt:(self window origin)
+
+! !
+
+!AbstractLauncherApplication methodsFor:'user actions - windows'!
+
+deIconifyAllWindows
+ |setOfViews|
+
+ setOfViews := Project current views asIdentitySet.
+ setOfViews addAll:(Project defaultProject views).
+
+ setOfViews do:[:aTopView |
+ aTopView device == Screen current ifTrue:[
+ aTopView expand
+ ].
+ ].
+
+ "
+ Transcript topView application deIconifyAllWindows
+ "
+
+!
+
+findAndDestroyWindow
+ "find a window (by name) and destroy it"
+
+ |v|
+ v := self findWindow:'select view to close:'.
+ v notNil ifTrue:[v destroy]
+
+!
+
+findAndRaiseWindow
+ "find a window (by name) and raise it"
+
+ |v|
+
+ v := self findWindow:'select view to raise deiconified:'.
+ v notNil ifTrue:[v raiseDeiconified]
+
+!
+
+fullScreenHardcopy
+ "after a second (to allow redraw of views under menu ...),
+ save the contents of the whole screen."
+
+ Processor
+ addTimedBlock:[
+ self
+ saveScreenImage:(Image fromScreen)
+ defaultName:'screen'
+ ]
+ afterSeconds:1
+
+!
+
+iconifyAllWindows
+ |setOfViews currentScreen|
+
+ setOfViews := Project current views asIdentitySet.
+ setOfViews addAll:(Project defaultProject views).
+
+ currentScreen := Screen current.
+ setOfViews do:[:aTopView |
+ aTopView device == currentScreen ifTrue:[
+ aTopView collapse
+ ]
+ ]
+
+!
+
+screenHardcopy
+ "after a second (to allow redraw of views under menu ...),
+ let user specify a rectangular area on the screen
+ and save its contents."
+
+ |area|
+
+ Processor
+ addTimedBlock:[
+ [Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05].
+
+ area := Rectangle fromUser.
+ (area width > 0 and:[area height > 0]) ifTrue:[
+ self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
+ ]
+ ]
+ afterSeconds:1
+
+ "Modified: / 18.8.1998 / 15:00:42 / cg"
+!
+
+startWindowTreeView
+ "open a windowTree view (on a topView)"
+
+ |v|
+
+ WindowTreeView isNil ifTrue:[
+ ^ self warn:'The WindowTreeView is not available in this release.'
+ ].
+
+ v := self pickAView.
+ v notNil ifTrue:[
+ WindowTreeView openOn:v topView
+ ]
+
+!
+
+viewDestroy
+ "let user pick a view and destroy it.
+ Even allow destroying non-smalltalk views
+ (also for views which I forgot due to some error)"
+
+ |device v id i c|
+
+ (Delay forSeconds:1) wait.
+
+ device := Screen current.
+ i := Image fromFile:'bitmaps/xpmBitmaps/cursors/cross2.xpm'.
+ i isNil ifTrue:[
+ c := Cursor crossHair
+ ] ifFalse:[
+ c := Cursor fromImage:i
+ ].
+ id := device viewIdFromPoint:(device pointFromUserShowing:c).
+ (v := device viewFromId:id) notNil ifTrue:[
+ v topView destroy.
+ ^ self
+ ].
+ id = device rootView id ifTrue:[
+ ^ self
+ ].
+ (Dialog confirm:'mhmh, this may not a be smalltalk view\(Or I somehow forgot about it).\Destroy anyway ?' withCRs)
+ ifTrue:[
+ device destroyView:nil withId:id
+ ].
+
+
+!
+
+viewHardcopy
+ "after a second (to allow redraw of views under menu ...),
+ let user specify a view and save its contents."
+
+ Processor
+ addTimedBlock:[
+ |v|
+ (v := Screen current viewFromUser) notNil ifTrue:[
+ self saveScreenImage:(Image fromView:(v topView)) defaultName:'hardcopy'
+ ]
+ ]
+ afterSeconds:1
+
+!
+
+viewInspect
+ "let user pick a view and inspect it. Only smalltalk views are allowed"
+
+ |v|
+
+ (v := self pickAView) notNil ifTrue:[
+ v inspect
+ ]
+
+! !
+
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs'!
compilerSettingsFor:requestor
@@ -3482,5 +4243,5 @@
!AbstractLauncherApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.1 1999-02-11 11:14:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.2 1999-02-11 12:45:21 cg Exp $'
! !
--- a/Launcher.st Thu Feb 11 13:17:51 1999 +0100
+++ b/Launcher.st Thu Feb 11 13:45:36 1999 +0100
@@ -11,7 +11,7 @@
"
AbstractLauncherApplication subclass:#Launcher
- instanceVariableNames:'myMenu buttonPanel transcript infoView projectInfoHolder helpIsOn
+ instanceVariableNames:'myMenu buttonPanel infoView projectInfoHolder helpIsOn
isMainLauncher'
classVariableNames:'CachedAboutIcon'
poolDictionaries:''
@@ -252,167 +252,6 @@
!Launcher methodsFor:'actions - classes'!
-browseAllBreakAndTracePoints
- "open a browser showing all breakPointed/traced methods
- (but, to get rid of them, there is also a menu itme to remove them all)"
-
- |methods|
-
- methods := WrappedMethod allInstances.
- SystemBrowser browseMethods:methods title:'all breakPointed/traced methods'
-
- "Modified: 14.1.1997 / 12:51:17 / cg"
- "Created: 14.1.1997 / 12:55:23 / cg"
-!
-
-browseImplementors
- "open an implementors- browser after asking for a selector"
-
- |enterBox selector|
-
- enterBox := EnterBox
- title:(resources at:'Browse implementors of:') withCRs
- okText:(resources at:'browse')
- action:[:acceptedString | selector := acceptedString].
- enterBox showAtPointer.
-
- selector notNil ifTrue:[
- self withWaitCursorDo:[
- SystemBrowser browseImplementorsOf:selector
- ]
- ].
-
- "Modified: / 31.10.1997 / 15:43:45 / cg"
-!
-
-browseResources
- "open a resource- browser after asking for a resource string"
-
- |box resourceHolder valueHolder component rsrc value t anyString|
-
- anyString := resources string:'* any *'.
-
- resourceHolder := ValueHolder newString.
- valueHolder := (ValueHolder with:'*').
-
- box := DialogBox new.
- box label:(resources at:'Resource search:').
- component := box addTextLabel:(resources at:'Search for methods which contain a\particular resource specification') withCRs.
- component adjust:#left.
- box addVerticalSpace:10.
-
- component := box addTextLabel:(resources at:'Resource symbol (empty for any; no matchPattern allowed):') withCRs.
- component adjust:#left.
- component := box addComboBoxOn:resourceHolder tabable:true.
- component list:((Array with:anyString) , #('canvas' 'menu' 'keyboard' 'style' 'image' 'programMenu' nil 'needsFix')).
-
- component := box addTextLabel:(resources at:'Resource value (* for any; matchPattern is allowed):') withCRs.
- component adjust:#left.
- box addInputFieldOn:valueHolder tabable:true.
-
- box addVerticalSpace:10.
- box addHelpButtonFor:'programming/language.html#RESOURCEDEFS'.
- box addAbortButton; addOkButton.
-
- box showAtPointer.
- box destroy.
-
- box accepted ifTrue:[
- rsrc := resourceHolder value.
- value := valueHolder value.
-
- (rsrc isNil or:[rsrc isEmpty or:[rsrc = '*' or:[rsrc = anyString]]]) ifTrue:[
- t := 'methods with any resource'.
- rsrc := nil
- ] ifFalse:[
- t := 'methods with #' , rsrc , '-resource'.
- rsrc := rsrc withoutSeparators asSymbol
- ].
- (value isNil or:[value isEmpty or:[value = '*']]) ifTrue:[
- t := t , ' and any value'.
- value := nil
- ] ifFalse:[
- t := t , ' and value ' , value.
- ].
- self withWaitCursorDo:[
- SystemBrowser browseForResource:rsrc
- containing:value
- in:(Smalltalk allClasses)
- title:t
- ]
- ].
-
- "Created: / 28.5.1996 / 13:15:16 / cg"
- "Modified: / 21.5.1998 / 03:15:04 / cg"
-!
-
-browseSenders
- "open a senders- browser after asking for a selector"
-
- |enterBox selector|
-
- enterBox := EnterBox
- title:(resources at:'Browse senders of:') withCRs
- okText:(resources at:'browse')
- action:[:acceptedString | selector := acceptedString].
- enterBox showAtPointer.
-
- selector notNil ifTrue:[
- self withWaitCursorDo:[
- SystemBrowser browseAllCallsOn:selector
- ]
- ].
-
- "Modified: / 31.10.1997 / 15:44:11 / cg"
-!
-
-browseUndeclared
- "open a browser on methods refering to undeclared variables"
-
- self withWaitCursorDo:[
- SystemBrowser
- browseReferendsOf:(Smalltalk underclaredPrefix , '*')
- title:(resources string:'references to undeclared variables')
- warnIfNone:true
- ]
-
- "Modified: / 31.10.1997 / 15:43:18 / cg"
-!
-
-removeAllBreakAndTracePoints
- "remove all break- and trace points"
-
- MessageTracer cleanup
-
- "Modified: 8.1.1997 / 14:55:27 / cg"
-!
-
-startChangesBrowser
- "open a changebrowser"
-
- self withWaitCursorDo:[
- UserPreferences current changesBrowserClass open
- ]
-
- "Modified: / 17.10.1998 / 14:38:18 / cg"
-!
-
-startClassBrowser
- "open a classBrowser; asks for class"
-
- SystemBrowser askThenBrowseClass
-
- "Modified: 8.1.1997 / 14:48:16 / cg"
-!
-
-startClassHierarchyBrowser
- "open a classHierarchyBrowser; asks for class"
-
- SystemBrowser askThenBrowseClassHierarchy
-
- "Modified: 8.1.1997 / 14:48:28 / cg"
-!
-
startClassTreeView
"open a classHierarchyTree view"
@@ -429,14 +268,6 @@
"Modified: 8.1.1997 / 14:48:47 / cg"
!
-startFullClassBrowser
- "open a fullClass systemBrowser; asks for class"
-
- SystemBrowser askThenBrowseFullClassProtocol
-
- "Modified: 8.1.1997 / 14:48:06 / cg"
-!
-
startJavaBrowser
"open a javaBrowser (not included in the standard distribution)"
@@ -643,127 +474,8 @@
"Modified: 8.1.1997 / 14:51:48 / cg"
! !
-!Launcher methodsFor:'actions - projects'!
-
-newProject
- "creates a new project & opens a projectView for it"
-
- Project notNil ifTrue:[
- (ProjectView for:(Project new)) open
- ]
-
- "Modified: 8.1.1997 / 14:52:07 / cg"
-!
-
-selectProject
- "asks for and switch to another project"
-
- |list box|
-
- Project notNil ifTrue:[
- list := Project allInstances.
- box := ListSelectionBox new.
- box list:(list collect:[:p | p name]).
- box title:(resources string:'select a project').
- box action:[:selection |
- |project|
-
- project := list detect:[:p | p name = selection] ifNone:[nil].
- project isNil ifTrue:[
- transcript showCR:'no such project.'
- ] ifFalse:[
- project showViews.
- Project current:project
- ]
- ].
- box showAtPointer.
- box destroy
- ]
-
- "Modified: 8.1.1997 / 14:52:20 / cg"
-! !
-
!Launcher methodsFor:'actions - tools'!
-compressingGarbageCollect
- "perform a compressing garbageCollect"
-
- self withWaitCursorDo:[ObjectMemory verboseGarbageCollect]
-
- "Created: / 12.5.1996 / 15:30:15 / cg"
- "Modified: / 16.5.1998 / 02:44:00 / cg"
-!
-
-deIconifyAllWindows
- |setOfViews|
-
- setOfViews := Project current views asIdentitySet.
- setOfViews addAll:(Project defaultProject views).
-
- setOfViews do:[:aTopView |
- aTopView device == Screen current ifTrue:[
- aTopView expand
- ].
- ].
-
- "
- Transcript topView application deIconifyAllWindows
- "
-
- "Modified: 3.3.1997 / 14:13:24 / cg"
-!
-
-findAndDestroyWindow
- "find a window (by name) and destroy it"
-
- |v|
-
- v := self findWindow:'select view to close:'.
- v notNil ifTrue:[
- v destroy.
- ].
-
- "Created: 28.10.1996 / 14:39:23 / cg"
- "Modified: 14.10.1997 / 11:25:37 / cg"
-!
-
-findAndRaiseWindow
- "find a window (by name) and raise it"
-
- |v|
-
- v := self findWindow:'select view to raise deiconified:'.
- v notNil ifTrue:[
- v raiseDeiconified.
- ].
-
- "Modified: 14.10.1997 / 11:25:42 / cg"
-!
-
-fullScreenHardcopy
- "after a second (to allow redraw of views under menu ...),
- save the contents of the whole screen."
-
- Processor
- addTimedBlock:[
- self
- saveScreenImage:(Image fromScreen)
- defaultName:'screen'
- ]
- afterSeconds:1
-
- "Modified: 23.9.1996 / 14:36:14 / cg"
-!
-
-garbageCollect
- "perform a non-compressing garbageCollect"
-
- self withWaitCursorDo:[ObjectMemory reclaimSymbols]
-
- "Created: / 12.5.1996 / 15:28:03 / cg"
- "Modified: / 16.5.1998 / 02:43:37 / cg"
-!
-
globalGarbageCollect
"perform a non-compressing garbageCollect"
@@ -773,43 +485,6 @@
"Modified: / 16.5.1998 / 02:43:50 / cg"
!
-iconifyAllWindows
- |setOfViews|
-
- setOfViews := Project current views asIdentitySet.
- setOfViews addAll:(Project defaultProject views).
-
- setOfViews do:[:aTopView |
- aTopView device == Screen current ifTrue:[
- aTopView collapse
- ]
- ]
-
- "Created: 1.3.1997 / 20:10:58 / cg"
- "Modified: 3.3.1997 / 14:13:11 / cg"
-!
-
-screenHardcopy
- "after a second (to allow redraw of views under menu ...),
- let user specify a rectangular area on the screen
- and save its contents."
-
- |area|
-
- Processor
- addTimedBlock:[
- [Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05].
-
- area := Rectangle fromUser.
- (area width > 0 and:[area height > 0]) ifTrue:[
- self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
- ]
- ]
- afterSeconds:1
-
- "Modified: / 18.8.1998 / 14:59:45 / cg"
-!
-
startApplication:aSymbol
"start an application,
popup warnbox if application is not present or autoload failed"
@@ -855,122 +530,6 @@
"Created: / 25.7.1997 / 10:56:30 / cg"
"Modified: / 14.8.1998 / 13:05:42 / cg"
-!
-
-startNewLauncher
- "open a real new launcher"
-
- NewLauncher isNil ifTrue:[
- ^ self warn:'The NewLauncher is not available in this release.'
- ].
-
- NewLauncher openAt:(self window origin)
-
- "Modified: / 14.8.1998 / 13:05:33 / cg"
-!
-
-startStopEventTrace
- "start/stop event tracing for a particular view"
-
- |v wg|
-
- v := Screen current viewFromUser.
- v notNil ifTrue:[
- v := v topView.
- wg := v windowGroup.
- wg notNil ifTrue:[
- "/
- "/ toggle eventTrace in its windowGroup
- "/
- wg traceEvents:(wg preEventHook isNil)
- ]
- ]
-
- "Created: 7.3.1996 / 14:44:22 / cg"
- "Modified: 8.1.1997 / 14:56:44 / cg"
-!
-
-startWindowTreeView
- "open a windowTree view (on a topView)"
-
- |v|
-
- WindowTreeView isNil ifTrue:[
- ^ self warn:'The WindowTreeView is not available in this release.'
- ].
-
- v := self pickAView.
- v notNil ifTrue:[
- WindowTreeView openOn:v topView
- ]
-
- "Modified: / 14.8.1998 / 13:05:58 / cg"
-!
-
-viewDestroy
- "let user pick a view and destroy it.
- Even allow destroying non-smalltalk views
- (also for views which I forgot due to some error)"
-
- |device p v id i c|
-
- (Delay forSeconds:1) wait.
-
- device := Screen current.
- i := Image fromFile:'bitmaps/xpmBitmaps/cursors/cross2.xpm'.
- i isNil ifTrue:[
- c := Cursor crossHair
- ] ifFalse:[
- c := Cursor fromImage:i
- ].
- p := device pointFromUserShowing:c.
- id := device viewIdFromPoint:p.
- v := device viewFromId:id.
- v notNil ifTrue:[
- v topView destroy.
- ^ self
- ].
- id = device rootView id ifTrue:[
- ^ self
- ].
- (Dialog confirm:'mhmh, this may not a be smalltalk view\(Or I somehow forgot about it).\Destroy anyway ?' withCRs)
- ifTrue:[
- device destroyView:nil withId:id
- ].
-
- "Modified: 18.9.1995 / 23:13:32 / claus"
- "Modified: 19.10.1997 / 03:09:20 / cg"
-!
-
-viewHardcopy
- "after a second (to allow redraw of views under menu ...),
- let user specify a view and save its contents."
-
- Processor
- addTimedBlock:[
- |v|
-
- v := Screen current viewFromUser.
- v notNil ifTrue:[
- self saveScreenImage:(Image fromView:(v topView)) defaultName:'hardcopy'
- ]
- ]
- afterSeconds:1
-
- "Modified: 19.10.1997 / 03:09:34 / cg"
-!
-
-viewInspect
- "let user pick a view and inspect it. Only smalltalk views are allowed"
-
- |v|
-
- v := self pickAView.
- v notNil ifTrue:[
-"/ v topView inspect
- v inspect
- ]
-
! !
!Launcher methodsFor:'change & update'!
@@ -1779,12 +1338,6 @@
!Launcher methodsFor:'initialize / release'!
-addTopViewsToCurrentProject
- "ignored here - the launcher is always global (i.e. not project private)."
-
- ^ self
-!
-
buttonPanelSpec
"return a spec for the buttons in the panel;
entries consists of selector and bitmap-filename.
@@ -1813,12 +1366,6 @@
"Modified: 1.2.1997 / 12:07:53 / cg"
!
-closeRequest
- (self confirm:(resources string:'really close %1 ?' with:self class name)) ifTrue:[
- super closeRequest
- ]
-!
-
focusSequence
^ (Array with:myMenu)
,
@@ -1938,19 +1485,6 @@
"Modified: 1.6.1996 / 16:58:25 / cg"
!
-saveAndTerminateRequest
- "some windowManagers can send this, to shutDown an application
- but let it save its state before, for later restart.
- Although I have not yet encountered such a windowManager,
- we are already prepared for this ;-)"
-
- self snapshot.
- super saveAndTerminateRequest
-
- "Created: 5.7.1996 / 13:07:45 / cg"
- "Modified: 5.7.1996 / 13:08:55 / cg"
-!
-
setupButtonPanelIn:aTopView
"create the buttonPanel"
@@ -2176,328 +1710,8 @@
"Modified: 9.9.1996 / 22:44:31 / stefan"
! !
-!Launcher methodsFor:'private'!
-
-findWindow:title
- "a helper for find & destroy and find & raise operations;
- let user choose a view and return it; return nil on cancel"
-
- |knownTopViews nameList box|
-
- knownTopViews := IdentitySet new.
- Screen allScreens do:[:aScreen |
- aScreen knownViews do:[:aView |
- |top showIt wg|
-
- aView notNil ifTrue:[
- top := aView topView.
- (top isKindOf:DebugView) ifTrue:[
- "/ although modal, show it.
- showIt := top realized
- ] ifFalse:[
- wg := top windowGroup.
- showIt := (wg notNil and:[wg isModal not]).
- ].
- showIt ifTrue:[
- knownTopViews add:top
- ]
- ]
- ]
- ].
-
- knownTopViews := knownTopViews asOrderedCollection.
- knownTopViews sort:[:v1 :v2 | |l1 l2|
- l1 := v1 label ? 'aView'.
- l2 := v2 label ? 'aView'.
- l1 < l2
- ].
- nameList := knownTopViews collect:[:v |
- |isDead wg p l|
-
- l := v label ? 'aView'.
- ((wg := v windowGroup) notNil
- and:[(p := wg process) notNil
- and:[p state ~~ #dead]]) ifTrue:[
- l
- ] ifFalse:[
- l , ' (dead ?)'
- ]
- ].
-
- box := ListSelectionBox new.
- box noEnterField.
- box list:nameList.
- box label:(resources string:'view selection').
- box title:(resources string:title) withCRs.
- box action:[:selection |
- |v idx|
-
- (idx := box selectionIndex) notNil ifTrue:[
- v := knownTopViews at:idx.
- ].
- box destroy.
- ^ v
- ].
- box extent:400@300.
- box showAtPointer.
- ^ nil
-
- "Created: / 14.10.1997 / 11:24:42 / cg"
- "Modified: / 27.10.1997 / 04:41:08 / cg"
-!
-
-openApplication:className nameSpace:aNameSpace
- "open some application, given the classes name.
- Look for it in Smalltalk and the given nameSpace"
-
- self openApplication:className nameSpace:aNameSpace with:#open
-
- "Modified: 8.1.1997 / 14:59:42 / cg"
-!
-
-openApplication:className nameSpace:aNameSpace with:aSelector
- "open some application, given the classes name.
- Look for it in Smalltalk and the given nameSpace"
-
- |cls|
-
- cls := Smalltalk at:className asSymbol.
- cls isNil ifTrue:[
- "/ look if its in the nameSpace
- aNameSpace notNil ifTrue:[
- cls := aNameSpace at:className asSymbol
- ]
- ].
-
- cls isNil ifTrue:[
- self warn:(resources string:'Sorry, the %1 class is not available.' with:className).
- ] ifFalse:[
- Autoload autoloadFailedSignal handle:[:ex |
- self warn:(resources string:'Sorry, the %1 class seems to be not available.' with:className)
- ] do:[
- cls perform:aSelector
- ]
- ]
-
- "Created: 8.1.1997 / 12:52:13 / cg"
- "Modified: 8.1.1997 / 14:59:47 / cg"
-!
-
-pickAView
- "let user pick a view and return it"
-
- |v|
-
- (Delay forSeconds:1) wait.
- v := Screen current viewFromUser.
- v isNil ifTrue:[
- self warn:'Sorry, this is not a smalltalk view'.
- ^ nil
- ].
- ^ v
-
- "Created: 19.10.1997 / 03:04:53 / cg"
- "Modified: 19.10.1997 / 03:42:00 / cg"
-!
-
-saveScreenImage:anImage defaultName:defaultName
- "save an image into a file
- - ask user for filename using a fileSelectionBox."
-
- |fileName|
-
- fileName := Dialog
- requestFileName:(resources string:'save image in:')
- default:(defaultName , '.tiff')
- ok:(resources string:'save')
- abort:(resources string:'cancel')
- pattern:'*.tiff'.
-
- fileName notNil ifTrue:[
- anImage saveOn:fileName
- ].
-
- "Modified: 21.2.1996 / 13:09:28 / cg"
-! !
-
-!Launcher methodsFor:'private - settings callBacks'!
-
-changeViewStyleTo:newStyle
- newStyle notNil ifTrue:[
- self withWaitCursorDo:[
- transcript showCR:'change style to ' , newStyle , ' ...'.
- View defaultStyle:newStyle asSymbol.
- ].
- self reopenLauncher.
- DebugView newDebugger.
- ]
-
- "Created: 20.10.1997 / 15:28:10 / cg"
-!
-
-fontBoxForEncoding:encodingMatch
- "open a fontBox, showing fonts which match some encoding
- (used when changing to japanese ...)"
-
- |box y b
- labelDef buttonDef listDef menuDef textDef
- models labels allOfThem filter|
-
- encodingMatch notNil ifTrue:[
- filter := [:f | f encoding notNil
- and:[encodingMatch match:f encoding]].
- ].
-
- models := OrderedCollection new.
- labels := OrderedCollection new.
-
- models add:(allOfThem := nil asValue).
- models add:(labelDef := Label defaultFont asValue).
- models add:(buttonDef := Button defaultFont asValue).
- models add:(listDef := SelectionInListView defaultFont asValue).
- models add:(menuDef := MenuView defaultFont asValue).
- models add:(textDef := TextView defaultFont asValue).
-
- box := Dialog new.
- box label:(resources string:'Font settings').
-
- models
- with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text'))
- do:[:model :title |
- |y2 lbl f i|
-
- f := model value.
-
- (box addTextLabel:title) adjust:#left.
-
- y := box yPosition.
- b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.
- b relativeExtent:nil; extent:(b preferredExtent).
- y2 := box yPosition.
- box yPosition:y.
- i := box leftIndent.
- box leftIndent:(b widthIncludingBorder + View viewSpacing).
- (lbl := box addTextLabel:'')
- adjust:#left;
- font:(model value);
- labelChannel:(BlockValue
- with:[:v | |f|
- f := v value.
- f isNil ifTrue:[
- ''
- ] ifFalse:[
- f userFriendlyName
- ]
- ]
- argument:model).
- labels add:lbl.
-
- box leftIndent:i.
- box yPosition:(box yPosition max:y2).
-
- box addVerticalSpace; addHorizontalLine; addVerticalSpace.
-
- b action:[
- |f|
-
- f := FontPanel
- fontFromUserInitial:(model value)
- title:(resources string:'font for %1' with:title)
- filter:filter.
- f notNil ifTrue:[
- model == allOfThem ifTrue:[
- models do:[:m | m value:f].
- labels do:[:l | l font:f]
- ] ifFalse:[
- model value:f.
- lbl font:f.
- ].
- ]
- ].
- model == allOfThem ifTrue:[
- box addVerticalSpace
- ]
- ].
-
- box addAbortButton; addOkButton.
- (box addButton:(Button label:(resources string:'defaults')) before:nil)
- action:[
- "/ fetch defaults
- View readStyleSheetAndUpdateAllStyleCaches.
- labelDef value: Label defaultFont.
- buttonDef value: Button defaultFont.
- listDef value: SelectionInListView defaultFont.
- menuDef value: MenuView defaultFont.
- textDef value: TextView defaultFont.
- ].
-
- box open.
- box accepted ifTrue:[
- Label defaultFont:labelDef value.
- Button defaultFont:buttonDef value.
- Toggle defaultFont:buttonDef value.
- SelectionInListView defaultFont:listDef value.
- MenuView defaultFont:menuDef value.
- PullDownMenu defaultFont:menuDef value.
- TextView defaultFont:textDef value.
- EditTextView defaultFont:textDef value.
- CodeView defaultFont:textDef value.
- ].
- box destroy.
- ^ box accepted
-
- "Created: / 27.2.1996 / 01:44:16 / cg"
- "Modified: / 17.6.1996 / 13:38:48 / stefan"
- "Modified: / 15.9.1998 / 22:04:42 / cg"
-!
-
-reopenLauncher
- "reopen a new launcher.
- for now (since style & language settings currently do
- not affect living views ...)"
-
- |contents fontPref enc builder newLauncher|
-
-"/ moved the stuff below to the language-setting
-"/ dialog (ask before changing the language, to have
-"/ proper texts in the dialogs).
-"/
-"/ fontPref := self class classResources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
-"/ enc := MenuView defaultFont encoding.
-"/ (fontPref match:enc) ifFalse:[
-"/ (self confirm:'menu font is not ' , fontPref , '-encoded.\\Change it ?' withCRs)
-"/ ifTrue:[
-"/ self fontBoxForEncoding:fontPref
-"/ ]
-"/ ].
-
- contents := transcript endEntry; list.
- builder := self class openAt:(self window origin).
- builder window waitUntilVisible.
- newLauncher := builder application.
- newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor
-
- "Modified: / 6.2.1998 / 00:00:45 / cg"
-! !
-
-!Launcher methodsFor:'queries'!
-
-processName
- "for monitors only - my name"
-
- ^ 'ST/X Launcher'
-!
-
-transcript
- "my transcript"
-
- ^ transcript
-
- "Created: 5.7.1996 / 13:04:36 / cg"
-! !
-
!Launcher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.400 1999-02-11 11:14:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Launcher.st,v 1.401 1999-02-11 12:45:29 cg Exp $'
! !
--- a/NewLauncher.st Thu Feb 11 13:17:51 1999 +0100
+++ b/NewLauncher.st Thu Feb 11 13:45:36 1999 +0100
@@ -13,7 +13,7 @@
AbstractLauncherApplication subclass:#NewLauncher
- instanceVariableNames:'transcript isMainLauncher helpIsOn'
+ instanceVariableNames:'isMainLauncher helpIsOn'
classVariableNames:'UserAddedTools'
poolDictionaries:''
category:'Interface-Smalltalk'
@@ -2075,32 +2075,32 @@
|project projectName projectDir packageName defNameSpace msg args projectInfo|
(Project isNil or:[(project := Project current) isNil]) ifTrue:[
- projectName := '* none *'.
- projectDir := '.'.
- packageName := '* none *'.
+ projectName := '* none *'.
+ projectDir := '.'.
+ packageName := '* none *'.
] ifFalse:[
- projectName := project name.
- projectDir := project directory.
- packageName := project packageName.
- defNameSpace := project defaultNameSpace.
+ projectName := project name.
+ projectDir := project directory.
+ packageName := project packageName.
+ defNameSpace := project defaultNameSpace.
].
defNameSpace isNil ifTrue:[
- defNameSpace := Smalltalk.
+ defNameSpace := Smalltalk.
].
+ msg := 'Project: ''%1'' fileOut to: ''%3'' package: ''%2'''.
defNameSpace == Smalltalk ifTrue:[
- msg := 'Project: ''%1'' fileOut to: ''%3'' package: ''%2'''.
- args := Array
- with:projectName
- with:packageName
- with:(projectDir contractTo:30).
+ args := Array
+ with:projectName
+ with:packageName
+ with:(projectDir contractTo:30).
] ifFalse:[
- msg := 'Project: ''%1'' fileOut to: ''%3'' package: ''%2'' nameSpace: %4'.
- args := Array
- with:projectName
- with:packageName
- with:(projectDir contractTo:30)
- with:defNameSpace name.
+ msg := msg , ' nameSpace: %4'.
+ args := Array
+ with:projectName
+ with:packageName
+ with:(projectDir contractTo:30)
+ with:defNameSpace name.
].
self valueOfInfoLabel value:(projectInfo := resources string:msg withArgs:args).
@@ -2117,70 +2117,6 @@
!NewLauncher methodsFor:'private'!
-findWindow:title
- "a helper for find & destroy and find & raise operations;
- let user choose a view and return it; return nil on cancel"
-
- |knownTopViews nameList box|
-
- knownTopViews := IdentitySet new.
- Screen allScreens do:[:aScreen |
- aScreen knownViews do:[:aView |
- |top showIt wg|
-
- aView notNil ifTrue:[
- top := aView topView.
- (top isKindOf:DebugView) ifTrue:[
- "/ although modal, show it.
- showIt := top realized
- ] ifFalse:[
- wg := top windowGroup.
- showIt := (wg notNil and:[wg isModal not]).
- ].
- showIt ifTrue:[
- knownTopViews add:top
- ]
- ]
- ]
- ].
-
- knownTopViews := knownTopViews asOrderedCollection.
- knownTopViews sort:[:v1 :v2 | |l1 l2|
- l1 := v1 label ? 'aView'.
- l2 := v2 label ? 'aView'.
- l1 < l2
- ].
- nameList := knownTopViews collect:[:v |
- |isDead wg p l|
-
- l := v label ? 'aView'.
- ((wg := v windowGroup) notNil
- and:[(p := wg process) notNil
- and:[p state ~~ #dead]]) ifTrue:[
- l
- ] ifFalse:[
- l , ' (dead ?)'
- ]
- ].
-
- box := ListSelectionBox new.
- box noEnterField.
- box list:nameList.
- box label:(resources string:'view selection').
- box title:(resources string:title) withCRs.
- box action:[:selection |
- |v|
-
- v := knownTopViews at:box selectionIndex.
- box destroy.
- ^ v
- ].
- box extent:400@300.
- box showAtPointer.
- ^ nil
-
-!
-
menuClassHistory
"returns a sub menu on the history of the classes"
@@ -2211,216 +2147,22 @@
^menu
"Modified: / 8.7.1998 / 00:59:50 / cg"
-!
-
-openApplication: className
- "open an application, given by the classe name."
-
- self openApplication:className nameSpace:nil
-!
-
-openApplication:className nameSpace:aNameSpace
- "open some application, given the classes name.
- Look for it in Smalltalk and the given nameSpace"
-
- self openApplication:className nameSpace:aNameSpace with:#open
-!
-
-openApplication:className nameSpace:aNameSpace with:aSelector
- "open some application, given the classes name.
- Look for it in Smalltalk and the given nameSpace"
-
- |cls|
-
- cls := Smalltalk at:className asSymbol.
- cls isNil ifTrue:[
- "/ look if its in the nameSpace
- aNameSpace notNil ifTrue:[
- cls := aNameSpace at:className asSymbol
- ]
- ].
-
- cls isNil ifTrue:[
- self warn:(resources string:'Sorry, the %1 class is not available.' with:className).
- ] ifFalse:[
- Autoload autoloadFailedSignal handle:[:ex |
- self warn:(resources string:'Sorry, the %1 class seems to be not available.' with:className)
- ] do:[
- self withWaitCursorDo:[cls perform:aSelector]
- ]
- ]
-
-!
-
-saveScreenImage:anImage defaultName:defaultName
- "save an image into a file
- - ask user for filename using a fileSelectionBox."
-
- |fileName|
-
- fileName := Dialog
- requestFileName:(resources string:'save image in:')
- default:(defaultName , '.tiff')
- ok:(resources string:'save')
- abort:(resources string:'cancel')
- pattern:'*.tiff'.
-
- fileName notNil ifTrue:[
- anImage saveOn:fileName
- ].
-
- "Modified: / 21.2.1996 / 13:09:28 / cg"
- "Created: / 29.1.1998 / 23:20:36 / cg"
! !
!NewLauncher methodsFor:'private - settings callBacks'!
-changeViewStyleTo:newStyle
-
- newStyle notNil ifTrue:[
- self withWaitCursorDo:[
- transcript showCR:'change style to ' , newStyle , ' ...'.
- View defaultStyle:newStyle asSymbol.
- ].
- self reOpen
- ]
-
-!
-
-fontBoxForEncoding:encodingMatch
- "open a fontBox, showing fonts which match some encoding
- (used when changing to japanese ...)"
-
- |box y b
- labelDef buttonDef listDef menuDef textDef
- models labels allOfThem filter|
-
- encodingMatch notNil ifTrue:[
- filter := [:f | f encoding notNil
- and:[encodingMatch match:f encoding]].
- ].
-
- models := OrderedCollection new.
- labels := OrderedCollection new.
-
- models add:(allOfThem := nil asValue).
- models add:(labelDef := Label defaultFont asValue).
- models add:(buttonDef := Button defaultFont asValue).
- models add:(listDef := SelectionInListView defaultFont asValue).
- models add:(menuDef := MenuView defaultFont asValue).
- models add:(textDef := TextView defaultFont asValue).
-
- box := Dialog new.
- box label:(resources string:'Font settings').
-
- models
- with:(resources array:#('all' 'labels' 'buttons' 'lists' 'menus' 'edit text'))
- do:[:model :title |
- |y2 lbl f i|
-
- f := model value.
-
- (box addTextLabel:title) adjust:#left.
-
- y := box yPosition.
- b := box addComponent:(Button label:(resources string:'change ...')) tabable:true.
- b relativeExtent:nil; extent:(b preferredExtent).
- y2 := box yPosition.
- box yPosition:y.
- i := box leftIndent.
- box leftIndent:(b widthIncludingBorder + View viewSpacing).
- (lbl := box addTextLabel:'')
- adjust:#left;
- font:(model value);
- labelChannel:(BlockValue
- with:[:v | |f|
- f := v value.
- f isNil ifTrue:[
- ''
- ] ifFalse:[
- f userFriendlyName
- ]
- ]
- argument:model).
- labels add:lbl.
-
- box leftIndent:i.
- box yPosition:(box yPosition max:y2).
- box addVerticalSpace.
- box addHorizontalLine.
- box addVerticalSpace.
-
- b action:[
- |f|
-
- f := FontPanel
- fontFromUserInitial:(model value)
- title:(resources string:'font for %1' with:title)
- filter:filter.
- f notNil ifTrue:[
- model == allOfThem ifTrue:[
- models do:[:m | m value:f].
- labels do:[:l | l font:f]
- ] ifFalse:[
- model value:f.
- lbl font:f.
- ].
- ]
- ].
- model == allOfThem ifTrue:[
- box addVerticalSpace
- ]
- ].
-
- box addAbortButton; addOkButton.
- (box addButton:(Button label:(resources string:'defaults')) before:nil)
- action:[
- "/ fetch defaults
- View readStyleSheetAndUpdateAllStyleCaches.
- labelDef value: Label defaultFont.
- buttonDef value: Button defaultFont.
- listDef value: SelectionInListView defaultFont.
- menuDef value: MenuView defaultFont.
- textDef value: TextView defaultFont.
- ].
-
- box open.
- box accepted ifTrue:[
- Label defaultFont:labelDef value.
- Button defaultFont:buttonDef value.
- Toggle defaultFont:buttonDef value.
- SelectionInListView defaultFont:listDef value.
- MenuView defaultFont:menuDef value.
- PullDownMenu defaultFont:menuDef value.
- TextView defaultFont:textDef value.
- EditTextView defaultFont:textDef value.
- CodeView defaultFont:textDef value.
- ].
- box destroy.
- ^ box accepted
-
- "Modified: / 15.9.1998 / 22:04:56 / cg"
-!
-
reopenLauncher
"reopen a new launcher.
for now (since style & language settings currently do
not affect living views ...)
WARNING: bad design: Message known in LauncherDialogs"
- |contents builder newLauncher wasShowingHelp|
+ |newLauncher wasShowingHelp|
wasShowingHelp := self showingHelp.
-
- contents := transcript endEntry; list.
- builder := self class openAt:(self window origin).
- builder window waitUntilVisible.
- newLauncher := builder application.
- newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor.
+ newLauncher := super reopenLauncher.
newLauncher showingHelp:wasShowingHelp.
- DebugView newDebugger.
-
- "Modified: / 4.8.1998 / 17:08:33 / cg"
+ ^ newLauncher
! !
!NewLauncher methodsFor:'queries'!
@@ -2430,30 +2172,10 @@
^super preferredExtent max: Screen current extent//(2.5@3.5)
-!
-
-processName
- "for monitors only - my name"
-
- ^ 'ST/X Launcher'
-
-!
-
-transcript
- "my transcript"
-
- ^ transcript
! !
!NewLauncher methodsFor:'startup / release'!
-addTopViewsToCurrentProject
- "ignored here - the launcher is always global (i.e. not project private)."
-
- ^ self
-
-!
-
allButOpenInterface:anInterface
"sent by my superclass to open up my interface"
@@ -2482,31 +2204,6 @@
"Modified: / 20.6.1998 / 14:53:58 / cg"
!
-closeRequest
- "close request from windowing system (window close);
- confirm and ask if closing of launcher only or
- a smalltalk-exit is wanted"
-
- |answer|
-
- answer := Dialog
- confirmWithCancel:(resources string:'Close %1 only or exit Smalltalk (close all)?' with:self class name)
- labels:(resources array:#('Cancel' 'Exit' 'Close'))
- default:3.
- answer isNil ifTrue:[
- "/ cancel
- ^self
- ].
-
- answer == true ifTrue:[
- super closeRequest
- ].
-
- self exit
-
- "Modified: / 5.9.1998 / 16:40:11 / cg"
-!
-
postOpenWith:aBuilder
"increase my priority"
@@ -2571,17 +2268,6 @@
!
-saveAndTerminateRequest
- "some windowManagers can send this, to shutDown an application
- but let it save its state before, for later restart.
- Although I have not yet encountered such a windowManager,
- we are already prepared for this ;-)"
-
- self snapshot.
- super saveAndTerminateRequest
-
-!
-
setupTranscript
"create the transcript view"
@@ -2633,153 +2319,6 @@
Project notNil ifTrue:[Project removeDependent:self]
! !
-!NewLauncher methodsFor:'user actions - classes'!
-
-browseAllBreakAndTracePoints
- "open a browser showing all breakPointed/traced methods
- (but, to get rid of them, there is also a menu itme to remove them all)"
-
- SystemBrowser browseMethods: WrappedMethod allInstances title:'all breakPointed/traced methods'
-
-!
-
-browseImplementors
- "open an implementors- browser after asking for a selector"
-
- |enterBox selector|
-
- enterBox := EnterBox
- title:(resources at:'Browse implementors of:') withCRs
- okText:(resources at:'browse')
- action:[:acceptedString | selector := acceptedString].
- enterBox showAtPointer.
-
- selector notNil ifTrue:[
- self withWaitCursorDo:[
- SystemBrowser browseImplementorsOf:selector
- ]
- ].
-
-!
-
-browseResources
- "open a resource- browser after asking for a resource string"
-
- |box resourceHolder valueHolder component rsrc value t anyString|
-
- anyString := resources string:'* any *'.
-
- resourceHolder := ValueHolder newString.
- valueHolder := '*' asValue.
-
- box := DialogBox new.
- box label:(resources at:'Resource search:').
- component := box addTextLabel:(resources at:'Search for methods which contain a\particular resource specification') withCRs.
- component adjust:#left.
- box addVerticalSpace:10.
-
- component := box addTextLabel:(resources at:'Resource symbol (empty for any; no matchPattern allowed):') withCRs.
- component adjust:#left.
- component := box addComboBoxOn:resourceHolder tabable:true.
- component list:((Array with:anyString) , #('canvas' 'menu' 'keyboard' 'style' 'image' 'programMenu' nil 'needsFix')).
-
- component := box addTextLabel:(resources at:'Resource value (* for any; matchPattern is allowed):') withCRs.
- component adjust:#left.
- box addInputFieldOn:valueHolder tabable:true.
-
- box addVerticalSpace:10.
- box addHelpButtonFor:'programming/language.html#RESOURCEDEFS'.
- box addAbortButton; addOkButton.
-
- box showAtPointer.
- box destroy.
-
- box accepted ifTrue:[
- rsrc := resourceHolder value.
- value := valueHolder value.
-
- (rsrc isNil or:[rsrc isEmpty or:[rsrc = '*' or:[rsrc = anyString]]]) ifTrue:[
- t := 'methods with any resource'.
- rsrc := nil
- ] ifFalse:[
- t := 'methods with #' , rsrc , '-resource'.
- rsrc := rsrc withoutSeparators asSymbol
- ].
- (value isNil or:[value isEmpty or:[value = '*']]) ifTrue:[
- t := t , ' and any value'.
- value := nil
- ] ifFalse:[
- t := t , ' and value ' , value.
- ].
- self withWaitCursorDo:[
- SystemBrowser browseForResource:rsrc
- containing:value
- in:(Smalltalk allClasses)
- title:t
- ]
- ].
-
-!
-
-browseSenders
- "open a senders- browser after asking for a selector"
-
- |enterBox selector|
-
- enterBox := EnterBox
- title:(resources at:'Browse senders of:') withCRs
- okText:(resources at:'browse')
- action:[:acceptedString | selector := acceptedString].
- enterBox showAtPointer.
-
- selector notNil ifTrue:[
- self withWaitCursorDo:[
- SystemBrowser browseAllCallsOn:selector
- ]
- ].
-
-!
-
-browseUndeclared
- "open a browser on methods refering to undeclared variables"
-
- self withWaitCursorDo:[
- SystemBrowser
- browseReferendsOf:(Smalltalk underclaredPrefix , '*')
- title:(resources string:'references to undeclared variables')
- warnIfNone:true
- ]
-
-!
-
-removeAllBreakAndTracePoints
- "remove all break- and trace points"
-
- self withCursor:Cursor execute do:[ MessageTracer cleanup]
-
-!
-
-startClassBrowser
- "open a classBrowser; asks for class"
-
- SystemBrowser askThenBrowseClass
-
-!
-
-startClassHierarchyBrowser
- "open a classHierarchyBrowser; asks for class"
-
- SystemBrowser askThenBrowseClassHierarchy
-
-!
-
-startFullClassBrowser
- "open a fullClass systemBrowser; asks for class"
-
- SystemBrowser askThenBrowseFullClassProtocol
-
-! !
-
!NewLauncher methodsFor:'user actions - demos'!
openDemo:className
@@ -2898,20 +2437,6 @@
!NewLauncher methodsFor:'user actions - system'!
-compressingGarbageCollect
- "perform a compressing garbageCollect"
-
- self withWaitCursorDo:[ObjectMemory verboseGarbageCollect]
-
-!
-
-garbageCollect
- "perform a non-compressing garbageCollect"
-
- self withWaitCursorDo:[ObjectMemory reclaimSymbols]
-
-!
-
initJavaVM
JavaVM initializeVM
@@ -2933,25 +2458,6 @@
self warn:'Sorry - the irq latency monitor is only available
in the full commercial release'.
-!
-
-startStopEventTrace
- "start/stop event tracing for a particular view"
-
- |v wg|
-
- v := Screen current viewFromUser.
- v notNil ifTrue:[
- v := v topView.
- wg := v windowGroup.
- wg notNil ifTrue:[
- "/
- "/ toggle eventTrace in its windowGroup
- "/
- wg traceEvents:(wg preEventHook isNil)
- ]
- ]
-
! !
!NewLauncher methodsFor:'user actions - tools'!
@@ -3027,12 +2533,6 @@
UserAddedTools at: toolName put: (Array with: action with: what with: icon with: space)
!
-newProject
- "creates a new project & opens a projectView for it"
-
- Project notNil ifTrue: [(ProjectView for: Project new) open]
-!
-
openTerminal
VT100TerminalView open
@@ -3067,140 +2567,16 @@
!
-selectProject
- "asks for and switch to another project"
-
- |list box|
-
- Project notNil ifTrue:[
- list := Project allInstances.
- box := ListSelectionBox new.
- box list:(list collect:[:p | p name]).
- box title:(resources string:'select a project').
- box action:[:selection |
- |project|
-
- project := list detect:[:p | p name = selection] ifNone:[nil].
- project isNil ifTrue:[
- transcript showCR:'no such project.'
- ] ifFalse:[
- project showViews.
- Project current:project
- ]
- ].
- box showAtPointer.
- box destroy
- ]
-!
-
-startChangesBrowser
- "opens the new or old changeBrowser (dep. on userPrefs)"
-
- UserPreferences current changesBrowserClass open
-
- "Modified: / 17.10.1998 / 14:38:38 / cg"
-!
-
-startNewLauncher
- "opens the new launcher"
-
- NewLauncher openAt:(self window origin)
-
-!
-
startOldChangesBrowser
"opens the old changeBrowser"
ChangesBrowser open
"Created: / 6.6.1998 / 19:47:26 / cg"
-!
-
-startOldLauncher
- "opens the old launcher"
-
- Launcher openAt:(self window origin)
-
! !
!NewLauncher methodsFor:'user actions - windows'!
-deIconifyAllWindows
- |setOfViews|
-
- setOfViews := Project current views asIdentitySet.
- setOfViews addAll:(Project defaultProject views).
-
- setOfViews do:[:aTopView |
- aTopView device == Screen current ifTrue:[
- aTopView expand
- ].
- ].
-
-!
-
-findAndDestroyWindow
- "find a window (by name) and destroy it"
-
- |v|
- v := self findWindow:'select view to close:'.
- v notNil ifTrue:[v destroy]
-
-!
-
-findAndRaiseWindow
- "find a window (by name) and raise it"
-
- |v|
-
- v := self findWindow:'select view to raise deiconified:'.
- v notNil ifTrue:[v raiseDeiconified]
-
-!
-
-fullScreenHardcopy
- "after a second (to allow redraw of views under menu ...),
- save the contents of the whole screen."
-
- Processor
- addTimedBlock:[
- self
- saveScreenImage:(Image fromScreen)
- defaultName:'screen'
- ]
- afterSeconds:1
-
-!
-
-iconifyAllWindows
- |setOfViews|
-
- setOfViews := Project current views asIdentitySet.
- setOfViews addAll:(Project defaultProject views).
-
- setOfViews do:[:aTopView |
- aTopView device == Screen current ifTrue:[
- aTopView collapse
- ]
- ]
-
-!
-
-pickAView
- "let user pick a view and return it"
-
- |v|
-
- (Delay forSeconds:1) wait.
- v := Screen current viewFromUser.
- v isNil ifTrue:[
- self warn:'Sorry, this is not a smalltalk view'.
- ^ nil
- ].
- ^ v
-
-!
-
redrawAllWindows
|setOfViews|
@@ -3218,99 +2594,6 @@
"Modified: / 16.10.1998 / 01:08:15 / cg"
!
-screenHardcopy
- "after a second (to allow redraw of views under menu ...),
- let user specify a rectangular area on the screen
- and save its contents."
-
- |area|
-
- Processor
- addTimedBlock:[
- [Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05].
-
- area := Rectangle fromUser.
- (area width > 0 and:[area height > 0]) ifTrue:[
- self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
- ]
- ]
- afterSeconds:1
-
- "Modified: / 18.8.1998 / 15:00:42 / cg"
-!
-
-startWindowTreeView
- "open a windowTree view (on a topView)"
-
- |v|
-
- v := self pickAView.
- v notNil ifTrue:[
- WindowTreeView openOn:v topView
- ]
-
-!
-
-viewDestroy
- "let user pick a view and destroy it.
- Even allow destroying non-smalltalk views
- (also for views which I forgot due to some error)"
-
- |device v id i c|
-
- (Delay forSeconds:1) wait.
-
- device := Screen current.
- i := Image fromFile:'bitmaps/xpmBitmaps/cursors/cross2.xpm'.
- i isNil ifTrue:[
- c := Cursor crossHair
- ] ifFalse:[
- c := Cursor fromImage:i
- ].
- id := device viewIdFromPoint:(device pointFromUserShowing:c).
- (v := device viewFromId:id) notNil ifTrue:[
- v topView destroy.
- ^ self
- ].
- id = device rootView id ifTrue:[
- ^ self
- ].
- (Dialog confirm:'mhmh, this may not a be smalltalk view\(Or I somehow forgot about it).\Destroy anyway ?' withCRs)
- ifTrue:[
- device destroyView:nil withId:id
- ].
-
-
-!
-
-viewHardcopy
- "after a second (to allow redraw of views under menu ...),
- let user specify a view and save its contents."
-
- Processor
- addTimedBlock:[
- |v|
- (v := Screen current viewFromUser) notNil ifTrue:[
- self saveScreenImage:(Image fromView:(v topView)) defaultName:'hardcopy'
- ]
- ]
- afterSeconds:1
-
-!
-
-viewInspect
- "let user pick a view and inspect it. Only smalltalk views are allowed"
-
- |v|
-
- (v := self pickAView) notNil
- ifTrue:
- [
- v inspect
- ]
-
-!
-
widgetHardcopy
"after a second (to allow redraw of views under menu ...),
let user specify a widget and save its contents."
@@ -3330,5 +2613,5 @@
!NewLauncher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.121 1999-02-11 11:14:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.122 1999-02-11 12:45:36 cg Exp $'
! !