--- 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 $'
! !