"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
ApplicationModel subclass:#Launcher
instanceVariableNames:'myMenu buttonPanel transcript infoView infoProcess helpIsOn
isMainLauncher'
classVariableNames:'CachedAboutIcon OpenLaunchers'
poolDictionaries:''
category:'Interface-Smalltalk'
!
!Launcher class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
customization
"
Of course, it is possible to change the Launcher class itself
as appropriate, however, we suggest you create a subclass (say MyLauncher),
define it as autoloaded in the patches file, and redefine some methods
in that class.
That way, your changes are easier to reintroduce in case of an ST/X upgrade.
adding more buttons to the button-panel:
see the method #buttonPanelSpec;
it defines a list of selectors and icons, which is used by
#setupButtonPanelIn:.
There, for each entry, a button with that icon is created,
which sends a selector-message to the launcher.
Add entries to that list, and define appropriate methods.
For example, to add a button which opens a drawTool,
change #buttonPanelSpec to:
buttonPanelSpec
^ #(
#(startSystemBrowser 'SBrowser32x32.xbm')
#(startFileBrowser 'FBrowser32x32.xbm')
#(nil nil)
#(startChangesBrowser 'CBrowser32x32.xbm')
#(nil nil)
#(nil nil)
#(startDrawTool 'DrawTool.xbm')
)
the panel adjusts its height as appropriate - you may want to
create new (small) icons for a good look.
adding an entry to a menu:
see the #setupMenu method; either add another top-menu, or
add entries to an existing menu.
"
!
documentation
"
a new launcher, combining old Launchers menu and transcript into
one view. (you no longer have to move two views around all the time ...).
Also, this app makes first use of the new compatibility framework;
you will notice, that this is a subclass of ApplicationModel.
New applications will no longer be built as subclasses of standardSystemView.
[author:]
Claus Gittinger
"
! !
!Launcher class methodsFor:'accessing'!
current
"return the launcher running on the current screen.
(for access via addMenu/ removeMenu)"
OpenLaunchers do:[:aLauncher |
aLauncher window graphicsDevice == Screen current ifTrue:[
^ aLauncher
]
].
^ nil.
"
Launcher current
"
"Modified: 5.7.1996 / 17:55:28 / cg"
"Modified: 9.9.1996 / 22:41:36 / stefan"
! !
!Launcher class methodsFor:'defaults'!
aboutIcon
|image|
CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].
image := Image fromFile:'SmalltalkX.xbm'.
image notNil ifTrue:[
|green dark|
Screen current hasColors ifTrue:[
green := (Color red:0 green:80 blue:20) "darkened".
dark := Color gray:10.
image photometric:#palette.
] ifFalse:[
dark := Color black.
green := Color white.
image photometric:#blackIs0.
].
image colorMap:(Array with:dark with:green).
"/ Screen current depth > 2 ifTrue:[
"/ image := (Image implementorForDepth:Screen current depth) fromImage:image.
"/ ]
].
CachedAboutIcon := image.
^ image
"
CachedAboutIcon := nil.
Launcher aboutIcon
"
"Modified: 28.5.1996 / 20:55:15 / cg"
"Modified: 9.9.1996 / 22:41:23 / stefan"
!
buttonImageSize
"images in buttonPanel are sized to this.
Can be redefined in subclasses to return nil (no scaling)
or any other useful size"
^ 32@32
"Modified: 19.4.1996 / 16:36:17 / cg"
!
smallAboutIcon
|image|
image := self aboutIcon.
image notNil ifTrue:[
image := image magnifiedBy:0.4.
].
^ image
"
CachedAboutIcon := nil.
Launcher aboutIcon.
Launcher smallAboutIcon.
"
"Modified: 9.9.1996 / 22:42:12 / stefan"
! !
!Launcher methodsFor:'actions - about & help'!
about
|box|
box := AboutBox new.
box autoHideAfter:10 with:[].
box showAtCenter
!
showBookPrintDocument
self showDocumentation:'BOOK.html'
"Modified: 31.8.1995 / 13:11:28 / claus"
"Created: 12.9.1996 / 01:53:30 / cg"
!
showDocumentation:aRelativeDocFilePath
"
although that one is not yet finished,
its better than nothing ...
"
HTMLDocumentView notNil ifTrue:[
"
temporary kludge;
not all machines can autoload binaries;
however, on my SGI (which can) we want it
to load automatically.
"
HTMLDocumentView isLoaded ifFalse:[
ErrorSignal catch:[HTMLDocumentView autoload]
].
HTMLDocumentView isLoaded ifTrue:[
HTMLDocumentView openFullOnDocumentationFile:aRelativeDocFilePath.
^ self
].
].
self warn:'Sorry, the ST/X HTML reader is not (yet)
included in this architectures release.
Please use Mosaic, netscape, chimera or any
other HTML viewer to see the documentation.
The documentation is found in the ''doc/online'' directory.'.
"Modified: 31.8.1995 / 13:11:08 / claus"
"Modified: 21.5.1996 / 14:15:57 / cg"
!
showLicenceConditions
self showDocumentation:'../german/LICENCE.STX.html'
"Created: 14.9.1996 / 12:35:00 / cg"
"Modified: 14.9.1996 / 13:28:51 / cg"
"Modified: 23.9.1996 / 17:03:15 / stefan"
!
startClassDocumentation
self showDocumentation:'classDoc/TOP.html'
"Modified: 31.8.1995 / 13:11:28 / claus"
"Created: 22.4.1996 / 21:03:56 / cg"
!
startDocumentationIndex
self showDocumentation:'index.html'
"Modified: 31.8.1995 / 13:11:28 / claus"
"Created: 17.4.1996 / 22:08:55 / cg"
!
startDocumentationTool
self showDocumentation:'TOP.html'
"Modified: 31.8.1995 / 13:11:28 / claus"
!
toggleActiveHelp:aBoolean
ActiveHelp notNil ifTrue:[
helpIsOn := aBoolean.
helpIsOn ifTrue:[
ActiveHelp start
] ifFalse:[
ActiveHelp stop
]
].
! !
!Launcher methodsFor:'actions - classes'!
browseImplementors
|enterBox|
enterBox := EnterBox title:(resources at:'Browse implementors of:') withCRs.
enterBox okText:(resources at:'browse').
enterBox action:[:selectorName |
|cls|
self withWaitCursorDo:[SystemBrowser browseImplementorsOf:selectorName]
].
enterBox showAtPointer
!
browseResources
|enterBox t|
enterBox := EnterBox title:(resources at:'Resource symbol (nil for any):') withCRs.
enterBox okText:(resources at:'browse').
enterBox action:[:resourceName |
|rsc|
(resourceName isNil or:[resourceName isEmpty]) ifTrue:[
t := 'methods with any resource'.
rsc := nil
] ifFalse:[
t := 'methods with ' , resourceName , '-resource'.
rsc := resourceName asSymbolIfInterned.
].
self withWaitCursorDo:[
SystemBrowser browseForResource:rsc
in:(Smalltalk allClasses)
title:t
]
].
enterBox showAtPointer
"Created: 28.5.1996 / 13:15:16 / cg"
"Modified: 29.5.1996 / 17:30:38 / cg"
!
browseSenders
|enterBox|
enterBox := EnterBox title:(resources at:'Browse senders of:') withCRs.
enterBox okText:(resources at:'browse').
enterBox action:[:selectorName |
|cls|
self withWaitCursorDo:[SystemBrowser browseAllCallsOn:selectorName]
].
enterBox showAtPointer
!
startChangesBrowser
self withWaitCursorDo:[ChangesBrowser open]
!
startClassBrowser
SystemBrowser askThenBrowseClass
!
startClassHierarchyBrowser
SystemBrowser askThenBrowseClassHierarchy
!
startClassTreeView
self withWaitCursorDo:[ClassTreeGraphView open]
!
startFileBrowser
self withWaitCursorDo:[FileBrowser open]
!
startFullClassBrowser
SystemBrowser askThenBrowseFullClassProtocol
!
startJavaBrowser
JavaBrowser notNil ifTrue:[
self withWaitCursorDo:[JavaBrowser open]
]
"Created: 18.4.1996 / 15:55:44 / cg"
"Modified: 19.4.1996 / 16:39:08 / cg"
!
startSystemBrowser
self withWaitCursorDo:[SystemBrowser open]
!
startWorkspace
Workspace open
! !
!Launcher methodsFor:'actions - demos'!
openDemo:className
|cls|
cls := Smalltalk at:className.
cls isNil ifTrue:[
self warn:'sorry, the ' , className , ' class is not available.'.
] ifFalse:[
Autoload autoloadFailedSignal handle:[:ex |
self warn:'sorry, the ' , className , ' class seems to be not available.'
] do:[
(Smalltalk at:className) open
]
]
"Modified: 10.5.1996 / 15:56:47 / cg"
!
startTetris
Tetris open
!
startTicTacToe
TicTacToeGame open
!
startTicTacToe2
TicTacToeGame open2UserGame
! !
!Launcher methodsFor:'actions - file'!
exit
(self confirm:(resources string:'Are you certain you want to exit without saving ?'))
ifTrue:[
self saveAllViews.
Smalltalk exit
]
!
objectModuleDialog
|allModules moduleNames
allObjects methodObjects methodNames
cObjects cObjectNames
otherObjects otherObjectNames
box l handles unloadButton
list1 list2 listView1 listView2
y panel
showBuiltIn showModules showMethods showCObjects showOthers
moduleListUpdater check canDoIt menu|
showBuiltIn := true asValue.
canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
showModules := canDoIt asValue.
showMethods := canDoIt asValue.
showCObjects := canDoIt asValue.
showOthers := canDoIt asValue.
list1 := SelectionInList new.
list2 := SelectionInList new.
moduleListUpdater := [
|l|
list2 list:nil.
l := Array new.
handles := Array new.
(showModules value or:[showBuiltIn value]) ifTrue:[
allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
(showBuiltIn value and:[showModules value]) ifFalse:[
allModules := allModules select:[:i |
|wantToSee|
wantToSee := (i at:#dynamic).
showBuiltIn value ifTrue:[
wantToSee := wantToSee not
].
wantToSee
]
].
"/ sorting by reverse id brings newest ones to the top (a side effect)
allModules sort:[:a :b | (a at:#id) > (b at:#id)].
moduleNames := allModules collect:[:entry | (entry at:#name)].
l := l , moduleNames.
handles := handles , allModules.
].
showMethods value ifTrue:[
allObjects := ObjectFileLoader loadedObjectHandles.
methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.
methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[
'compiled method - removed' , ' (in ' , mH pathName , ')'
] ifFalse:[
'compiled method ' , mH method whoString , ' (in ' , mH pathName , ')'
].
].
l := l , methodNames.
handles := handles , methodObjects.
].
showCObjects value ifTrue:[
allObjects := ObjectFileLoader loadedObjectHandles.
cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.
cObjectNames := cObjects collect:[:entry | entry pathName].
l := l , cObjectNames.
handles := handles , cObjects.
].
showOthers value ifTrue:[
allObjects := ObjectFileLoader loadedObjectHandles.
otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle
or:[h isMethodHandle
or:[h isClassLibHandle]]) not]) asArray.
otherObjectNames := otherObjects collect:[:entry | entry pathName].
l := l , otherObjectNames.
handles := handles , otherObjects.
].
list1 list:l.
unloadButton disable.
].
showBuiltIn onChangeSend:#value to:moduleListUpdater.
showModules onChangeSend:#value to:moduleListUpdater.
showMethods onChangeSend:#value to:moduleListUpdater.
showCObjects onChangeSend:#value to:moduleListUpdater.
showOthers onChangeSend:#value to:moduleListUpdater.
box := Dialog new.
box label:(resources string:'Module dialog').
listView1 := HVScrollableView for:SelectionInListView miniScrollerH:true.
listView1 model:list1.
listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
listView1 action:[:sel |
|info classNames tabs module|
listView1 middleButtonMenu:nil.
box withWaitCursorDo:[
|nm fileName addr entry1 entry2 entry3 method|
tabs := TabulatorSpecification unit:#inch positions:#(0 2.6).
(showModules value or:[showBuiltIn value]) ifTrue:[
info := allModules at:sel ifAbsent:nil.
].
info isNil ifTrue:[
"/ selected a method, cObject or unknown
module := handles at:sel.
fileName := module pathName.
module isMethodHandle ifTrue:[
(method := module method) isNil ifTrue:[
nm := '** removed **'.
] ifFalse:[
menu := PopUpMenu
labels:#('inspect' 'browse')
selectors:#(inspect browse).
menu actionAt:#inspect put:[ method inspect ].
menu actionAt:#browse put:[ SystemBrowser openInClass:(method who at:1) selector:(method who at:2) ].
listView1 middleButtonMenu:menu.
nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).
].
entry1 := MultiColListEntry new:2 tabulatorSpecification:tabs.
entry1 colAt:1 put:'compiled method'; colAt:2 put:nm.
entry2 := MultiColListEntry new:2 tabulatorSpecification:tabs.
entry2 colAt:1 put:'path'; colAt:2 put:fileName.
entry3 := MultiColListEntry new:2 tabulatorSpecification:tabs.
entry3 colAt:1 put:'address'; colAt:2 put:('(16r) ' , (method code hexPrintString leftPaddedTo:8 with:$0)).
list2 list:(Array with:entry1 with:entry2 with:entry3).
] ifFalse:[
(module isFunctionObjectHandle
and:[module functions notEmpty]) ifTrue:[
menu := PopUpMenu
labels:#('inspect')
selectors:#(inspect).
menu actionAt:#inspect put:[ module functions inspect ].
listView1 middleButtonMenu:menu.
list2 list:((module functions select:[:f | f notNil])
collect:[:f | |entry|
entry := MultiColListEntry new:2 tabulatorSpecification:tabs.
entry colAt:1 put:(f name asText emphasizeAllWith:(#color->Color blue)).
entry colAt:2 put:('address: (16r) ' , (f code hexPrintString leftPaddedTo:8 with:$0)).
entry
]).
] ifFalse:[
list2 list:#('nothing known about contents (no functions have been extracted)').
]
].
unloadButton enable.
] ifFalse:[
"/ selected a package
"/ fill bottom list with class-info
classNames := (info at:#classNames) asSortedCollection.
classNames := classNames collect:[:cName |
|cls entry rev listEntry|
listEntry := MultiColListEntry new:2 tabulatorSpecification:tabs.
listEntry colAt:1 put:cName.
cls := Smalltalk classNamed:cName.
cls isNil ifTrue:[
listEntry colAt:2 put:'(class removed)'.
] ifFalse:[
rev := cls binaryRevision.
rev notNil ifTrue:[
cls isLoaded ifFalse:[
entry := '(stub for: ' , rev.
] ifTrue:[
entry :='(bin: ' , rev.
].
cls revision ~= rev ifTrue:[
entry := entry , ' / src: ' , cls revision
].
listEntry colAt:2 put:entry , ')'
] ifFalse:[
cls revision notNil ifTrue:[
listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')'
]
]
].
listEntry
].
list2 list:classNames.
(info at:#dynamic) ifTrue:[
unloadButton enable.
] ifFalse:[
unloadButton disable.
].
]
]
].
panel := HorizontalPanelView new.
panel add:(l := Label label:'show:').
l adjust:#left; borderWidth:0.
panel add:(check := CheckBox label:'builtin' model:showBuiltIn).
box makeTabable:check.
panel add:(check := CheckBox label:'classLibs' model:showModules).
canDoIt ifFalse:[
check disable
] ifTrue:[
box makeTabable:check.
].
panel add:(check := CheckBox label:'methods' model:showMethods).
canDoIt ifFalse:[
check disable
] ifTrue:[
box makeTabable:check.
].
panel add:(check := CheckBox label:'c-objects' model:showCObjects).
canDoIt ifFalse:[
check disable
] ifTrue:[
box makeTabable:check.
].
panel add:(check := CheckBox label:'others' model:showOthers).
canDoIt ifFalse:[
check disable
] ifTrue:[
box makeTabable:check.
].
panel horizontalLayout:#fitSpace.
"/ panel horizontalLayout:#leftSpace.
box addComponent:panel tabable:false.
box addVerticalSpace.
box addComponent:listView1 tabable:true.
listView1 topInset:(View viewSpacing + panel preferredExtent y).
listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
l := box addTextLabel:(resources string:'contained classes/subsets:').
l adjust:#left; borderWidth:0.
l origin:0.0@0.4 corner:1.0@0.4.
l topInset:(View viewSpacing).
l bottomInset:((l preferredExtent y) negated - View viewSpacing).
listView2 := HVScrollableView for:SelectionInListView miniScrollerH:true.
listView2 model:list2; printItems:false.
box addComponent:listView2 tabable:true.
listView2 origin:0.0@0.4 corner:1.0@1.0. "/ ; inset:2.
listView2 disable.
unloadButton := Button label:(resources string:'unload').
unloadButton action:[
self withWaitCursorDo:[
box withWaitCursorDo:[
|info idx pathName|
idx := list1 selectionIndex.
info := allModules at:idx ifAbsent:nil.
list1 selectionIndex:nil.
info isNil ifTrue:[
"/ selected a method
"/ idx := idx - allModules size.
pathName := (handles at:idx) pathName.
] ifFalse:[
"/ selected a package
pathName := (info at:#pathName).
].
ObjectFileLoader unloadObjectFile:pathName.
moduleListUpdater value.
unloadButton disable.
]
]
].
moduleListUpdater value.
box addButton:unloadButton.
box addAbortButtonLabelled:(resources string:'close').
y := box yPosition.
listView2 topInset:(l preferredExtent y + 5).
listView2 bottomInset:(box preferredExtent y - y).
"/ box width:(400 min:(box device width * 2 // 3));
"/ height:(450 min:(box device height - 50));
"/ sizeFixed:true.
box open.
box destroy.
"Modified: 17.9.1995 / 16:47:50 / claus"
"Modified: 30.9.1996 / 21:39:17 / cg"
!
snapshot
|fileName|
fileName := DialogBox
request:(resources at:'filename for image:') withCRs
initialAnswer:(ObjectMemory nameForSnapshot)
okLabel:(resources at:'save')
title:(resources string:'save image')
onCancel:nil.
fileName notNil ifTrue:[
self showCursor:Cursor write.
[
(ObjectMemory snapShotOn:fileName) ifFalse:[
"
snapshot failed for some reason (disk full, no permission etc.)
"
self warn:(resources string:'failed to save snapshot image (disk full or not writable)').
]
] valueNowOrOnUnwindDo:[
self restoreCursors.
].
].
"Modified: 1.6.1996 / 17:02:45 / cg"
!
snapshotAndExit
|fileName ok|
fileName := DialogBox
request:(resources at:'filename for image:') withCRs
initialAnswer:(ObjectMemory nameForSnapshot)
okLabel:(resources at:'save & exit')
title:(resources string:'save image & exit')
onCancel:nil.
fileName notNil ifTrue:[
self showCursor:Cursor write.
[
ok := ObjectMemory snapShotOn:fileName.
] valueNowOrOnUnwindDo:[
self restoreCursors.
].
ok ifFalse:[
"
snapshot failed for some reason (disk full, no permission etc.)
Do NOT exit in this case.
"
self warn:(resources string:'failed to save snapshot image (disk full or not writable)').
] ifTrue:[
"
saveAllViews tells all views to shutdown neatly
(i.e. offer a chance to save the contents to a file).
This is NOT required - all data should be in the snapshot ...
... however, if remote disks/mountable filesystems are involved,
which may not be present the next time, it may make sense to
uncomment it and query for saving - time will show which is better.
"
"
self saveAllViews.
"
Smalltalk exit
]
].
"Modified: 1.6.1996 / 17:02:07 / cg"
! !
!Launcher methodsFor:'actions - goodies'!
startCalendar
Calendar open
!
startClock
RoundClock open
!
startMailTool
MailView open
!
startNewsTool
NewsView open
! !
!Launcher methodsFor:'actions - projects'!
newProject
Project notNil ifTrue:[
(ProjectView for:(Project new)) open
]
!
selectProject
|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: 5.7.1996 / 13:12:53 / cg"
! !
!Launcher methodsFor:'actions - settings'!
compilerSettings
|box warnings warnSTX warnUnderscore warnOldStyle allowUnderscore immutableArrays
warnSTXBox warnUnderscoreBox warnOldStyleBox warnCommonMistakes warnCommonMistakesBox
stcCompilation compilationList stcCompilationOptions stcIncludes stcDefines stcOptions
stcLibraries stcLibraryPath historyLines catchRedefs keepSourceOptions keepSource
constantFoldingOptions constantFolding justInTimeCompilation
warnEnabler check component oldIndent t supportsJustInTimeCompilation y|
warnings := Compiler warnings asValue.
warnSTX := Compiler warnSTXSpecials asValue.
warnUnderscore := Compiler warnUnderscoreInIdentifier asValue.
warnOldStyle := Compiler warnOldStyleAssignment asValue.
warnCommonMistakes := Compiler warnCommonMistakes asValue.
allowUnderscore := Compiler allowUnderscoreInIdentifier asValue.
immutableArrays := Compiler arraysAreImmutable asValue.
constantFoldingOptions := #( nil #level1 #level2 #full ).
constantFolding := SelectionInList new list:(resources array:#('disabled' 'level1 (always safe)' 'level2 (usually safe)' 'full')).
constantFolding selectionIndex:3.
stcCompilationOptions := #( always default never).
stcCompilation := SelectionInList new
list:(resources array:#('always'
'primitive code only'
'never'
)).
stcCompilation selectionIndex:2.
(supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation)
ifTrue:[
justInTimeCompilation := ObjectMemory justInTimeCompilation:true.
ObjectMemory justInTimeCompilation:justInTimeCompilation.
] ifFalse:[
justInTimeCompilation := false
].
justInTimeCompilation := justInTimeCompilation asValue.
stcIncludes := Compiler stcCompilationIncludes asValue.
stcDefines := Compiler stcCompilationDefines asValue.
stcOptions := Compiler stcCompilationOptions asValue.
ObjectFileLoader notNil ifTrue:[
(t := ObjectFileLoader searchedLibraries) notNil ifTrue:[
stcLibraries := (String fromStringCollection:t separatedBy:' ') asValue.
].
(t := ObjectFileLoader libPath) notNil ifTrue:[
stcLibraryPath := t asValue.
]
].
catchRedefs := Class catchMethodRedefinitions asValue.
historyLines := (HistoryManager notNil and:[HistoryManager isActive]) asValue.
keepSourceOptions := #( keep reference absReference sourceReference discard ).
keepSource := SelectionInList new list:(resources array:#('keep as string' 'reference to filename' 'reference to full path' 'append and ref in `st.src''' 'discard' )).
keepSource selectionIndex:1.
warnEnabler := [
warnings value ifTrue:[
warnSTXBox enable.
warnOldStyleBox enable.
warnCommonMistakesBox enable.
allowUnderscore value ifTrue:[
warnUnderscoreBox enable.
] ifFalse:[
warnUnderscoreBox disable.
].
] ifFalse:[
warnSTXBox disable.
warnUnderscoreBox disable.
warnOldStyleBox disable.
warnCommonMistakesBox disable.
]].
warnings onChangeSend:#value to:warnEnabler.
allowUnderscore onChangeSend:#value to:warnEnabler.
box := DialogBox new.
box label:(resources string:'Compiler settings').
box addCheckBox:(resources string:'catch method redefinitions') on:catchRedefs.
check := box addCheckBox:(resources string:'keep history line in methods') on:historyLines.
HistoryManager isNil ifTrue:[check disable].
box addPopUpList:(resources string:'fileIn source mode:') on:keepSource.
keepSource selectionIndex:( keepSourceOptions indexOf:(ClassCategoryReader sourceMode) ifAbsent:1).
box addHorizontalLine.
supportsJustInTimeCompilation ifTrue:[
component := box
addCheckBox:(resources string:'just in time compilation to machine code')
on:justInTimeCompilation.
supportsJustInTimeCompilation ifFalse:[
component disable
].
box addHorizontalLine.
].
ObjectFileLoader notNil ifTrue:[
compilationList := box addPopUpList:(resources string:'stc compilation to machine code') on:stcCompilation.
stcCompilation selectionIndex:( stcCompilationOptions indexOf:(Compiler stcCompilation) ifAbsent:2).
component := box
addLabelledInputField:(resources string:'stc include directories:')
adjust:#right
on:stcIncludes
tabable:true
separateAtX:0.5.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredExtent y).
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'stc defines:')
adjust:#right
on:stcDefines
tabable:true
separateAtX:0.5.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredExtent y).
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'stc options:')
adjust:#right
on:stcOptions
tabable:true
separateAtX:0.5.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredExtent y).
stcLibraries notNil ifTrue:[
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'stc C-libraries:')
adjust:#right
on:stcLibraries
tabable:true
separateAtX:0.5.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredExtent y).
].
stcLibraryPath notNil ifTrue:[
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'stc libPath:')
adjust:#right
on:stcLibraryPath
tabable:true
separateAtX:0.5.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredExtent y).
].
"/ box addVerticalSpace.
box addHorizontalLine.
"/ if there is no compiler around,
"/ change to compile nothing, and disable the checkBoxes
Compiler canCreateMachineCode ifFalse:[
stcCompilation selectionIndex:3.
compilationList disable.
].
].
box addPopUpList:(resources string:'constant folding:') on:constantFolding.
constantFolding selectionIndex:( constantFoldingOptions indexOf:(Compiler foldConstants) ifAbsent:1).
"/ box addVerticalSpace.
box addCheckBox:(resources string:'allow underscore in identifiers') on:allowUnderscore.
"/ box addVerticalSpace.
box addCheckBox:(resources string:'literal arrays are immutable') on:immutableArrays.
box addHorizontalLine.
box addCheckBox:(resources string:'warnings') on:warnings.
"/ box addVerticalSpace.
oldIndent := box leftIndent.
box leftIndent:30.
y := box yPosition.
warnSTXBox := box addCheckBox:(resources string:'ST/X extensions') on:warnSTX.
warnSTXBox width:0.4.
"/ box addVerticalSpace.
warnUnderscoreBox := box addCheckBox:(resources string:'underscores in identifiers') on:warnUnderscore.
warnUnderscoreBox width:0.4.
"/ box addVerticalSpace.
box yPosition:y.
box leftIndent:0.
warnOldStyleBox := box addCheckBox:(resources string:'oldStyle assignment') on:warnOldStyle.
warnOldStyleBox left:0.5; width:0.4.
"/ box addVerticalSpace.
warnCommonMistakesBox := box addCheckBox:(resources string:'common mistakes') on:warnCommonMistakes.
warnCommonMistakesBox left:0.5; width:0.4.
"/ box addVerticalSpace.
box leftIndent:oldIndent.
box
addHelpButtonFor:'Launcher/compilerSettings.html';
addAbortButton;
addOkButton.
warnEnabler value.
box open.
box accepted ifTrue:[
HistoryManager notNil ifTrue:[
historyLines value ifTrue:[
HistoryManager activate
] ifFalse:[
HistoryManager deactivate
].
].
Class catchMethodRedefinitions:catchRedefs value.
ClassCategoryReader sourceMode:(keepSourceOptions at:keepSource selectionIndex).
Compiler warnings:warnings value.
Compiler warnSTXSpecials:warnSTX value.
Compiler warnOldStyleAssignment:warnOldStyle value.
Compiler warnUnderscoreInIdentifier:warnUnderscore value.
Compiler warnCommonMistakes:warnCommonMistakes value.
Compiler allowUnderscoreInIdentifier:allowUnderscore value.
Compiler arraysAreImmutable:immutableArrays value.
Compiler stcCompilation:(stcCompilationOptions at:stcCompilation selectionIndex).
Compiler stcCompilationIncludes:stcIncludes value.
Compiler stcCompilationDefines:stcDefines value.
Compiler stcCompilationOptions:stcOptions value.
Compiler foldConstants:(constantFoldingOptions at:constantFolding selectionIndex).
supportsJustInTimeCompilation ifTrue:[
justInTimeCompilation value ifTrue:[
Method allInstancesDo:[:m | m checked:false].
].
ObjectMemory justInTimeCompilation:justInTimeCompilation value.
].
ObjectFileLoader notNil ifTrue:[
stcLibraries notNil ifTrue:[
ObjectFileLoader searchedLibraries:(stcLibraries value asCollectionOfWords).
].
stcLibraryPath notNil ifTrue:[
ObjectFileLoader libPath:(stcLibraryPath value).
]
]
].
box destroy
"Modified: 10.9.1995 / 19:19:18 / claus"
"Modified: 9.9.1996 / 22:42:47 / stefan"
"Modified: 14.10.1996 / 19:29:23 / cg"
!
displaySettings
|box
sizes sizeNames sizeList sizeX sizeY deepIcons
isColorMonitor useFixPalette idx ditherStyles ditherSyms ditherList
y component screen visual|
sizeNames := #(
'9'' (212mm x 160mm) GAS plasma/LCD'
'11.3'' (235mm x 175mm) LCD'
'16'' (275mm x 208mm)'
'17'' (315mm x 245mm) SUN ELC'
'17'' (325mm x 245mm)'
'19'' (340mm x 270mm) (NCD)'
'20'' (350mm x 280mm) (SGI)'
'21'' (365mm x 285mm) (Eizo / Nanao)'
).
sizes := #( (212 160)
(235 175)
(275 208)
(315 245)
(325 245)
(340 270)
(350 280)
(365 285)
).
screen := Screen current.
visual := screen visualType.
isColorMonitor := screen hasColors asValue.
deepIcons := screen supportsDeepIcons asValue.
useFixPalette := screen fixColors notNil asValue.
sizeList := SelectionInList with:sizeNames.
sizeX := screen widthInMillimeter asValue.
sizeY := screen heightInMillimeter asValue.
ditherList := SelectionInList with:sizeNames.
(visual == #StaticGray or:[visual == #GrayScale]) ifTrue:[
ditherStyles := #('threshold' 'ordered dither' 'error diffusion').
ditherSyms := #(threshold ordered floydSteinberg).
] ifFalse:[
visual ~~ #TrueColor ifTrue:[
ditherStyles := #('nearest color' 'error diffusion').
ditherSyms := #(ordered floydSteinberg).
]
].
ditherSyms notNil ifTrue:[
ditherList list:ditherStyles.
ditherList selectionIndex:(ditherSyms indexOf:(Image ditherAlgorithm) ifAbsent:#threshold).
].
box := DialogBox new.
box label:(resources string:'Display screen settings').
(box addTextLabel:(resources string:'Actual visible screen area:'))
adjust:#left.
(box addPopUpList:(resources string:'common sizes:') on:sizeList)
label:'monitor size'.
idx := sizes findFirst:[:entry |
((entry at:1) = sizeX value)
and:[((entry at:2) = sizeY value)]
].
idx ~~ 0 ifTrue:[
sizeList selectionIndex:idx
].
sizeList onChangeSend:#value to:[
|idx|
idx := sizeList selectionIndex.
sizeX value:((sizes at:idx) at:1).
sizeY value:((sizes at:idx) at:2).
].
y := box yPosition.
component := box addTextLabel:(resources string:'screen size:').
component width:0.3; adjust:#right; borderWidth:0.
box yPosition:y.
component := box addInputFieldOn:sizeX tabable:true.
component width:0.25; left:0.3;
immediateAccept:false; acceptOnLeave:false;
cursorMovementWhenUpdating:#beginOfLine;
converter:(PrintConverter new initForInteger);
model:sizeX.
box yPosition:y.
component := box addTextLabel:(' x ').
component width:0.1; left:0.55; adjust:#center; borderWidth:0.
box yPosition:y.
component := box addInputFieldOn:sizeY tabable:true.
component width:0.25; left:0.65;
immediateAccept:false; acceptOnLeave:false;
cursorMovementWhenUpdating:#beginOfLine;
converter:(PrintConverter new initForInteger);
model:sizeY.
box yPosition:y.
component := box addTextLabel:('(mm)').
component width:0.1; left:0.9; adjust:#center; borderWidth:0.
box addVerticalSpace.
box addHorizontalLine.
box addVerticalSpace.
box addCheckBox:(resources string:'color monitor') on:isColorMonitor.
visual == #PseudoColor ifTrue:[
box addVerticalSpace.
component := box addCheckBox:(resources string:'use fix color palette (6x6x4)') on:useFixPalette.
].
ditherSyms notNil ifTrue:[
box addVerticalSpace.
component := box addPopUpList:(resources string:'image display:') on:ditherList.
component label:'image display'.
component superView horizontalLayout:#leftSpace.
].
box addVerticalSpace.
box addCheckBox:(resources string:'allow colored/grayscale icons') on:deepIcons.
box
addHelpButtonFor:'Launcher/screenSettings.html';
addAbortButton; addOkButton.
box open.
box accepted ifTrue:[
Image flushDeviceImages.
screen visualType == #PseudoColor ifTrue:[
useFixPalette value ifTrue:[
Color colorAllocationFailSignal handle:[:ex |
self warn:(resources string:'Could not allocate colors.').
] do:[
Color getColorsRed:6 green:6 blue:4 on:screen
]
] ifFalse:[
screen releaseFixColors
]
].
screen hasColors:isColorMonitor value.
screen widthInMillimeter:sizeX value.
screen heightInMillimeter:sizeY value.
screen supportsDeepIcons:deepIcons value.
ditherSyms notNil ifTrue:[
Image ditherAlgorithm:(ditherSyms at:ditherList selectionIndex).
].
self withWaitCursorDo:[
View defaultStyle:(View defaultStyle).
].
].
box destroy
"Modified: 9.9.1996 / 22:43:04 / stefan"
"Modified: 30.9.1996 / 23:25:22 / cg"
!
fontSettings
(self fontBoxForEncoding:nil) ifTrue:[
self reopenLauncher.
]
"Created: 26.2.1996 / 22:52:51 / cg"
"Modified: 27.2.1996 / 02:05:05 / cg"
!
keyboardSetting
|mappings listOfRawKeys listOfFunctions
box l
list1 list2 listView1 listView2
frame selectionForwarder macroForwarder macroTextView y|
mappings := Screen current keyboardMap.
listOfRawKeys := (mappings keys asArray collect:[:key | key asString]) sort.
listOfFunctions := (mappings values asSet asArray collect:[:key | key asString]) sort.
selectionForwarder := Plug new.
selectionForwarder respondTo:#showFunction
with:[
|raw|
raw := list1 selection.
list2 retractInterestsFor:selectionForwarder.
list2 selection:(mappings at:raw asSymbol) asString.
list2 onChangeSend:#showRawKey to:selectionForwarder.
].
selectionForwarder respondTo:#showRawKey
with:[
|f raw|
f := list2 selection.
list1 retractInterestsFor:selectionForwarder.
raw := mappings keyAtValue:f asString.
raw isNil ifTrue:[
raw := mappings keyAtValue:f first.
raw isNil ifTrue:[
raw := mappings keyAtValue:f asSymbol.
]
].
list1 selection:raw.
list1 onChangeSend:#showFunction to:selectionForwarder.
].
macroForwarder := [
|f macro indent|
f := list2 selection.
(f startsWith:'Cmd') ifTrue:[
f := f copyFrom:4
].
macro := FunctionKeySequences at:(f asSymbol) ifAbsent:nil.
macro notNil ifTrue:[
macro := macro asStringCollection.
indent := macro
inject:99999 into:[:min :element |
|stripped|
stripped := element withoutLeadingSeparators.
stripped size == 0 ifTrue:[
min
] ifFalse:[
min min:(element size - stripped size)
]
].
indent ~~ 0 ifTrue:[
macro := macro collect:[:line |
line size > indent ifTrue:[
line copyFrom:indent+1
] ifFalse:[
line
].
]
].
].
macroTextView contents:macro.
].
list1 := SelectionInList with:listOfRawKeys.
list1 onChangeSend:#showFunction to:selectionForwarder.
list2 := SelectionInList with:listOfFunctions.
list2 onChangeSend:#showRawKey to:selectionForwarder.
list2 onChangeSend:#value to:macroForwarder.
box := Dialog new.
box label:(resources string:'Keyboard mappings').
l := box addTextLabel:(resources string:'KEY_MSG') withCRs.
l adjust:#left; borderWidth:0.
frame := View new.
frame extent:300 @ 300.
frame borderWidth:0.
listView1 := ScrollableView for:SelectionInListView in:frame.
listView1 model:list1.
listView1 origin:0.0@0.0 corner:0.5@1.0; inset:2.
listView2 := ScrollableView for:SelectionInListView in:frame.
listView2 model:list2.
listView2 origin:0.5@0.0 corner:1.0@1.0; inset:2.
frame topInset:box yPosition.
box addComponent:frame withExtent:350@200.
box makeTabable:listView1.
box makeTabable:listView2.
frame origin:0.0@0.0 corner:1.0@0.6.
box addVerticalSpace.
l := box addTextLabel:(resources string:'Macro text (if any):') withCRs.
l adjust:#left; borderWidth:0.
l origin:0.0@0.6 corner:1.0@0.6.
l topInset:(View viewSpacing).
l bottomInset:(l preferredExtent y negated - View viewSpacing).
macroTextView := HVScrollableView for:TextView miniScroller:true.
box addComponent:macroTextView tabable:true.
macroTextView origin:0.0@0.6 corner:1.0@1.0.
y := box yPosition.
box
addHelpButtonFor:'Launcher/keyboardSetting.html';
"addAbortButton;"
addOkButton.
macroTextView topInset:(l preferredExtent y + 5).
macroTextView bottomInset:(box preferredExtent y - y).
box open.
box accepted ifTrue:[
"no action yet ..."
].
box destroy
"Modified: 31.5.1996 / 22:55:51 / cg"
"Modified: 9.9.1996 / 22:43:17 / stefan"
!
languageSetting
|listOfLanguages translatedLanguages idx language box|
"
get list of supported languages from the launchers resources ...
"
listOfLanguages := resources at:'LIST_OF_OFFERED_LANGUAGES' default:#('default').
translatedLanguages := resources array:listOfLanguages.
box := ListSelectionBox title:(resources string:'LANG_MSG') withCRs.
box label:(resources string:'Language selection').
box list:translatedLanguages.
box initialText:(Language).
box action:[:newLanguage |
self withWaitCursorDo:[
transcript showCR:'change language to ' , newLanguage , ' ...'.
idx := translatedLanguages indexOf:newLanguage withoutSeparators.
idx ~~ 0 ifTrue:[
language := listOfLanguages at:idx
] ifFalse:[
language := newLanguage
].
Smalltalk language:language asSymbol.
ResourcePack flushCachedResourcePacks
].
self reopenLauncher.
].
box
addHelpButtonFor:'Launcher/languageSetting.html'.
box open.
box destroy
"Modified: 5.7.1996 / 13:12:39 / cg"
"Modified: 9.9.1996 / 22:43:27 / stefan"
!
memorySettings
|box igcLimit igcFreeLimit igcFreeAmount newSpaceSize
compressLimit
oldIncr component fields|
"/
"/ extract relevant system settings ...
"/
igcLimit := ObjectMemory incrementalGCLimit asValue.
igcFreeLimit := ObjectMemory freeSpaceGCLimit asValue.
igcFreeAmount := ObjectMemory freeSpaceGCAmount asValue.
newSpaceSize := ObjectMemory newSpaceSize asValue.
oldIncr := ObjectMemory oldSpaceIncrement asValue.
compressLimit := ObjectMemory oldSpaceCompressLimit asValue.
"/
"/ create a box on those values ...
"/
fields := OrderedCollection new.
box := DialogBox new.
box label:(resources string:'Memory manager settings').
box addTextLabel:'Warning - invalid settings may result in poor performance.
You have been warned.'.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'size of newSpace:')
adjust:#right
on:nil "/ newSpaceSize
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:newSpaceSize.
fields add:component.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'incremental GC allocation trigger:')
adjust:#right
on:nil "/ igcLimit
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:igcLimit.
fields add:component.
box addTextLabel:'(start IGC whenever this amount has been allocated)'.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'incremental GC freespace trigger:')
adjust:#right
on:nil "/ igcFreeLimit
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:igcFreeLimit.
fields add:component.
box addTextLabel:'(start IGC whenever freespace drops below this)'.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'incremental GC amount:')
adjust:#right
on:nil "/ igcFreeAmount
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:igcFreeAmount.
fields add:component.
box addTextLabel:'(try to keep this amount for peak requests)'.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'oldspace increment:')
adjust:#right
on:nil "/ oldIncr
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:oldIncr.
fields add:component.
box addTextLabel:'(increase oldSpace in chunks of this size)'.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'oldspace compress limit:')
adjust:#right
on:nil "/ compressLimit
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
component converter:(PrintConverter new initForNumber).
component model:compressLimit.
fields add:component.
box addTextLabel:'(suppress compressing GC if more memory is in use)'.
box addHorizontalLine.
box addAbortButton; addOkButton.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
fields do:[:comp | comp accept].
igcFreeAmount value ~~ ObjectMemory freeSpaceGCAmount ifTrue:[
ObjectMemory freeSpaceGCAmount:igcFreeAmount value.
].
igcFreeLimit value ~~ ObjectMemory freeSpaceGCLimit ifTrue:[
ObjectMemory freeSpaceGCLimit:igcFreeLimit value.
].
igcLimit value ~~ ObjectMemory incrementalGCLimit ifTrue:[
ObjectMemory incrementalGCLimit:igcLimit value.
].
newSpaceSize value ~~ ObjectMemory newSpaceSize ifTrue:[
ObjectMemory newSpaceSize:newSpaceSize value.
].
oldIncr value ~~ ObjectMemory oldSpaceIncrement ifTrue:[
ObjectMemory oldSpaceIncrement:oldIncr value.
].
ObjectMemory oldSpaceCompressLimit:compressLimit value.
].
box destroy
"Modified: 30.9.1996 / 23:24:17 / cg"
!
messageSettings
|box vmInfo vmErrors displayErrors classInfos|
vmInfo := ObjectMemory infoPrinting asValue.
vmErrors := ObjectMemory debugPrinting asValue.
classInfos := Object infoPrinting asValue.
displayErrors := DeviceWorkstation errorPrinting asValue.
box := DialogBox new.
box label:(resources string:'Messages').
"/ box extent:200@300.
box addCheckBox:(resources string:'VM info messages') on:vmInfo.
box addCheckBox:(resources string:'VM error messages') on:vmErrors.
box addHorizontalLine.
box addCheckBox:(resources string:'Display error messages (Xlib, Xtlib ...)') on:displayErrors.
box addCheckBox:(resources string:'Other info messages') on:classInfos.
box addAbortButton; addOkButton.
box open.
box accepted ifTrue:[
ObjectMemory infoPrinting:vmInfo value.
ObjectMemory debugPrinting:vmErrors value.
Object infoPrinting:classInfos value.
DeviceWorkstation errorPrinting:displayErrors value.
].
box destroy
"Modified: 29.5.1996 / 14:16:19 / cg"
!
miscSettings
|box check logDoits shadows updChanges changeFileName returnFocus
loadBinaries compileLazy hostNameInLabel useManager hasManager
repository repositoryHolder localSourceFirst
showAccelerators sourceCacheDir cacheEntry
component localCheck oldIndent nm fn manager|
"/
"/ extract relevant system settings ...
"/
logDoits := Smalltalk logDoits asValue.
shadows := PopUpView shadows asValue.
hostNameInLabel := StandardSystemView includeHostNameInLabel asValue.
returnFocus := Dialog returnFocusWhenClosingModalBoxes asValue.
updChanges := Class updatingChanges asValue.
changeFileName := ObjectMemory nameForChanges asValue.
hasManager := AbstractSourceCodeManager notNil
and:[AbstractSourceCodeManager isLoaded].
hasManager ifTrue:[
useManager := (manager := Smalltalk at:#SourceCodeManager) notNil asValue.
localSourceFirst := Class tryLocalSourceFirst asValue.
manager notNil ifTrue:[
repository := manager repositoryName.
repository notNil ifTrue:[
repositoryHolder := repository asValue
]
].
] ifFalse:[
useManager := false.
localSourceFirst := false
].
showAccelerators := MenuView showAcceleratorKeys asValue.
sourceCacheDir := nil asValue.
loadBinaries := Smalltalk loadBinaries asValue.
compileLazy := Autoload compileLazy asValue.
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Other settings').
box addCheckBox:(resources string:'log compiles in changes file') on:updChanges.
box addCheckBox:(resources string:'log doIts in changes file') on:logDoits.
component := box
addLabelledInputField:(resources string:'change file name:')
adjust:#right
on:changeFileName
tabable:true
separateAtX:0.4.
component immediateAccept:true; acceptOnLeave:false.
"/ y := box yPosition.
"/ component := box addTextLabel:(resources string:'change file name:').
"/ component width:0.5; adjust:#right; borderWidth:0.
"/ box yPosition:y.
"/ component := box addInputFieldOn:changeFileName tabable:true.
"/ component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false.
box addHorizontalLine.
box addCheckBox:(resources string:'lazy compilation when autoloading') on:compileLazy.
check := box addCheckBox:(resources string:'if present, load binary objects when autoloading') on:loadBinaries.
ObjectFileLoader isNil ifTrue:[
loadBinaries value:false.
check disable
].
hasManager ifTrue:[
check := box addCheckBox:(resources string:'sourcecode from sourcecode management') on:useManager.
oldIndent := box leftIndent.
box leftIndent:30.
repositoryHolder notNil ifTrue:[
component := box
addLabelledInputField:(resources string:'repository:')
adjust:#right
on:repositoryHolder
tabable:true
separateAtX:0.4.
component immediateAccept:true; acceptOnLeave:false.
].
localCheck := box addCheckBox:(resources string:'if present, use local source (suppress checkout)') on:localSourceFirst.
localCheck enableChannel:useManager.
cacheEntry := box
addLabelledInputField:(resources string:'source cache dir:')
adjust:#right
on:sourceCacheDir
tabable:true
separateAtX:0.4.
cacheEntry immediateAccept:true; acceptOnLeave:false.
box leftIndent:oldIndent.
cacheEntry enableChannel:useManager.
(AbstractSourceCodeManager isNil
or:[AbstractSourceCodeManager defaultManager isNil]) ifTrue:[
useManager value:false.
cacheEntry disable.
check disable.
localCheck enable.
] ifFalse:[
sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName).
].
].
box addHorizontalLine.
box addCheckBox:(resources string:'shadows under popup views') on:shadows.
box addCheckBox:(resources string:'boxes return focus to previously active view') on:returnFocus.
box addCheckBox:(resources string:'hostname in window labels') on:hostNameInLabel.
box addCheckBox:(resources string:'show accelerator keys in menus') on:showAccelerators.
box
addHelpButtonFor:'Launcher/miscSettings.html';
addAbortButton;
addOkButton.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
Smalltalk logDoits:logDoits value.
PopUpView shadows:shadows value.
Class updateChanges:updChanges value.
Autoload compileLazy:compileLazy value.
Smalltalk loadBinaries:loadBinaries value.
StandardSystemView includeHostNameInLabel:hostNameInLabel value.
ObjectMemory nameForChanges:changeFileName value.
Dialog returnFocusWhenClosingModalBoxes:returnFocus value.
MenuView showAcceleratorKeys:showAccelerators value.
(hasManager and:[useManager value]) ifTrue:[
manager isNil ifTrue:[
Smalltalk at:#SourceCodeManager put:(AbstractSourceCodeManager defaultManager).
manager := Smalltalk at:#SourceCodeManager.
].
Class tryLocalSourceFirst:(localSourceFirst value).
nm := sourceCacheDir value.
(fn := nm asFilename) exists ifFalse:[
(self confirm:(nm , ' does not exists\create ?' withCRs)) ifTrue:[
fn makeDirectory;
makeReadableForAll;
makeWritableForAll;
makeExecutableForAll.
]
].
(fn exists
and:[fn isDirectory
and:[fn isReadable
and:[fn isWritable]]]) ifTrue:[
AbstractSourceCodeManager cacheDirectoryName:(sourceCacheDir value).
].
repositoryHolder notNil ifTrue:[
manager repositoryName:repositoryHolder value.
manager initialize
].
] ifFalse:[
Smalltalk at:#SourceCodeManager put:nil
]
].
box destroy
"Modified: 9.9.1996 / 22:43:36 / stefan"
"Modified: 14.9.1996 / 13:26:50 / cg"
!
printerSettings
|box
possiblePrinters possibleTypes printerType printCommand
pageFormat landscape updater
formatLabel formatComponent landscapeLabel landscapeComponent
topMargin leftMargin rightMargin bottomMargin unitList unit
topMarginComponent leftMarginComponent
rightMarginComponent
bottomMarginComponent supportsColor supportsColorComponent
y y1 commandListPop component commandList row|
possiblePrinters := PrinterStream withAllSubclasses asArray.
possibleTypes := possiblePrinters collect:[:cls | cls printerTypeName].
printerType := SelectionInList new list:(resources array:possibleTypes).
printerType selectionIndex:(possiblePrinters identityIndexOf:Printer).
printCommand := Printer printCommand asValue.
pageFormat := SelectionInList new list:(Printer defaultPageFormats).
pageFormat selection:(Printer pageFormat).
landscape := Printer landscape asValue.
topMargin := Printer topMargin asValue.
leftMargin := Printer leftMargin asValue.
rightMargin := Printer rightMargin asValue.
bottomMargin := Printer bottomMargin asValue.
supportsColor := Printer supportsColor asValue.
box := DialogBox new.
box label:(resources string:'Printer settings').
"/ either use a popUpList ...
"/ box addPopUpList:(resources string:'printer type:') on:printerType.
"/ or a comboList;
"/ which one looks better ?
y := box yPosition.
component := box addTextLabel:(resources string:'printer type:').
component width:0.3; adjust:#right; borderWidth:0.
box yPosition:y.
component := box addComboListOn:printerType tabable:true.
component changeMessage:#selectionIndex:; useIndex:true.
component width:0.7; left:0.3.
"/ end of question
y := box yPosition.
component := box addTextLabel:(resources string:'print command:').
component width:0.3; adjust:#right; borderWidth:0.
box yPosition:y.
commandListPop := box addComboBoxOn:printCommand tabable:true.
"/ commandListPop := box addInputFieldOn:printCommand tabable:true.
commandListPop width:0.7; left:0.3; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
"/ some common print commands ...
commandList := resources at:'PRINT_COMMANDS' ifAbsent:nil.
commandList isNil ifTrue:[
commandList := PrinterStream defaultCommands.
commandList isNil ifTrue:[
commandList := #('lpr'
'lp'
).
]
].
commandListPop list:commandList.
box addVerticalSpace.
box addHorizontalLine.
box addVerticalSpace.
row := OrderedCollection new.
row add:(formatLabel := Label label:(resources string:'page format:')).
formatLabel borderWidth:0.
row add:(formatComponent := PopUpList on:pageFormat).
formatComponent label:'unknown'.
row add:(landscapeLabel := Label label:(resources string:'landscape:')).
landscapeLabel borderWidth:0.
row add:(landscapeComponent := CheckToggle on:landscape).
y := box yPosition.
box
addRow:(1 to:2)
fromX:0
toX:0.5
collect:[:idx | row at:idx]
tabable:false
horizontalLayout:#leftSpace
verticalLayout:#center.
y1 := box yPosition.
box yPosition:y.
box
addRow:(3 to:4)
fromX:0.5
toX:1.0
collect:[:idx | row at:idx]
tabable:false
horizontalLayout:#leftSpace
verticalLayout:#center.
box yPosition:(box yPosition max:y1).
box makeTabable:(formatComponent).
box makeTabable:(landscapeComponent).
box addVerticalSpace.
box addHorizontalLine.
box addVerticalSpace.
y := box yPosition.
topMarginComponent := box
addLabelledInputField:(resources string:'top margin:')
adjust:#right
on:nil "/ topMargin
tabable:true
from:0.0 to:0.5
separateAtX:0.6.
topMarginComponent converter:(PrintConverter new initForNumber).
topMarginComponent model:topMargin.
y1 := box yPosition.
box yPosition:y.
unitList := SelectionInList with:#('inch' 'mm').
unitList selectionIndex:1.
component := box addComponent:(PopUpList on:unitList).
component
left:0.6;
width:0.3.
box yPosition:y1.
leftMarginComponent := box
addLabelledInputField:(resources string:'left margin:')
adjust:#right
on:nil "/ leftMargin
tabable:true
from:0.0 to:0.5
separateAtX:0.6.
leftMarginComponent converter:(PrintConverter new initForNumber).
leftMarginComponent model:leftMargin.
rightMarginComponent := box
addLabelledInputField:(resources string:'right margin:')
adjust:#right
on:nil "/ rightMargin
tabable:true
from:0.0 to:0.5
separateAtX:0.6.
rightMarginComponent converter:(PrintConverter new initForNumber).
rightMarginComponent model:rightMargin.
bottomMarginComponent := box
addLabelledInputField:(resources string:'bottom margin:')
adjust:#right
on:nil "/ bottomMargin
tabable:true
from:0.0 to:0.5
separateAtX:0.6.
bottomMarginComponent converter:(PrintConverter new initForNumber).
bottomMarginComponent model:bottomMargin.
box addHorizontalLine.
supportsColorComponent := box addCheckBox:(resources string:'Color printer') on:supportsColor.
box addVerticalSpace.
updater := [ |p fg hasPageSize hasMargins|
printerType selectionIndex ~~ 0 ifTrue:[
p := possiblePrinters at:(printerType selectionIndex).
hasPageSize := p supportsPageSizes.
hasMargins := p supportsMargins.
] ifFalse:[
hasPageSize := false.
hasMargins := false.
].
hasPageSize ifTrue:[
fg := Button new foregroundColor.
formatComponent enable.
landscapeComponent enable.
formatComponent label:p pageFormat.
pageFormat value:(p pageFormat).
landscape value:(p landscape).
] ifFalse:[
fg := Button new disabledForegroundColor.
formatComponent disable.
landscapeComponent disable.
formatComponent label:'unknown'.
landscape value:nil.
].
hasMargins ifTrue:[
unitList selectionIndex == 2 ifTrue:[
unit := #mm
] ifFalse:[
unit := #inch
].
topMargin value:(UnitConverter convert:p topMargin from:#inch to:unit).
leftMargin value:(UnitConverter convert:p leftMargin from:#inch to:unit).
rightMargin value:(UnitConverter convert:p rightMargin from:#inch to:unit).
bottomMargin value:(UnitConverter convert:p bottomMargin from:#inch to:unit).
topMarginComponent enable.
leftMarginComponent enable.
rightMarginComponent enable.
bottomMarginComponent enable.
] ifFalse:[
topMarginComponent disable.
leftMarginComponent disable.
rightMarginComponent disable.
bottomMarginComponent disable.
].
formatLabel foregroundColor:fg.
landscapeLabel foregroundColor:fg.
p notNil ifTrue:[
commandList := p defaultCommands.
commandList notNil ifTrue:[
commandListPop list:commandList
].
printCommand value:(p printCommand).
].
p supportsPostscript ifFalse:[
supportsColorComponent disable.
supportsColor value:false
] ifTrue:[
supportsColorComponent enable.
supportsColor value:(Printer supportsColor).
]
].
unitList onChangeSend:#value to:updater.
printerType onChangeSend:#value to:updater.
updater value.
box addVerticalSpace;
addHelpButtonFor:'Launcher/printerSettings.html';
addAbortButton; addOkButton.
box open.
box accepted ifTrue:[
Printer := possiblePrinters at:(printerType selectionIndex).
Printer printCommand:printCommand value.
Printer supportsPageSizes ifTrue:[
Printer pageFormat:(pageFormat selection).
Printer landscape:(landscape value).
].
Printer supportsMargins ifTrue:[
unitList selectionIndex == 2 ifTrue:[
unit := #mm
] ifFalse:[
unit := #inch
].
Printer topMargin:(UnitConverter convert:topMargin value from:unit to:#inch).
Printer leftMargin:(UnitConverter convert:leftMargin value from:unit to:#inch).
Printer rightMargin:(UnitConverter convert:rightMargin value from:unit to:#inch).
Printer bottomMargin:(UnitConverter convert:bottomMargin value from:unit to:#inch).
].
Printer supportsPostscript ifTrue:[
Printer supportsColor:supportsColor value.
].
].
box destroy
"Modified: 5.9.1996 / 21:45:19 / cg"
"Modified: 9.9.1996 / 22:43:51 / stefan"
!
viewStyleSetting
|listOfStyles resourceDir dir box
list listView scrView infoLabel infoForwarder newStyle|
"
search resources directory for a list of .style files ...
"
resourceDir := Smalltalk getSystemFileName:'resources'.
resourceDir isNil ifTrue:[
self warn:'no styles found (missing ''resources'' directory)'.
^ self
].
dir := FileDirectory directoryNamed:resourceDir.
listOfStyles := dir select:[:aFileName | aFileName endsWith:'.style'].
listOfStyles := listOfStyles collect:[:aFileName | aFileName copyWithoutLast:6].
listOfStyles sort.
"/ old code: used a standard ListSelectionBox
"/ changed to intercept selection and add info-output.
"/ box := ListSelectionBox title:(resources string:'STYLE_MSG') withCRs.
"/ box label:(resources string:'Style selection').
"/ box list:listOfStyles.
"/ box initialText:View defaultStyle.
"/ box selectAction:[:newStyle |
"/ ].
"/ box action:[:newStyle |
"/ transcript topView withCursor:Cursor wait do:[
"/ transcript showCR:'change style to ' , newStyle , ' ...'.
"/ View defaultStyle:newStyle asSymbol.
"/ ]
"/ ].
"/ box showAtPointer
"/ new code: build box 'by 'hand'
"/
infoForwarder := [
|nm sheet comment|
nm := list selection.
sheet := ViewStyle fromFile:(nm , '.style').
comment := sheet at:#comment ifAbsent:''.
infoLabel label:comment withCRs asStringCollection
].
list := SelectionInList with:listOfStyles.
list onChangeSend:#value to:infoForwarder.
box := Dialog new.
box label:(resources string:'Style selection').
(box addTextLabel:(resources string:'STYLE_MSG') withCRs) adjust:#left.
listView := SelectionInListView on:list.
listView doubleClickAction:[:sel | box accept value:true. box hide].
scrView := box addComponent:(ScrollableView forView:listView) tabable:true.
box addVerticalSpace.
(infoLabel := box addTextLabel:'\\' withCRs) adjust:#centerLeft.
box addAbortButton; addOkButton.
list selection:(View defaultStyle).
box stickAtBottomWithVariableHeight:scrView.
box stickAtBottomWithFixHeight:infoLabel.
box open.
box accepted ifTrue:[
newStyle := list selection.
newStyle notNil ifTrue:[
self withWaitCursorDo:[
transcript showCR:'change style to ' , newStyle , ' ...'.
View defaultStyle:newStyle asSymbol.
].
self reopenLauncher.
]
].
box destroy
"Modified: 5.7.1996 / 13:13:22 / cg"
! !
!Launcher methodsFor:'actions - tools'!
compressingGarbageCollect
ObjectMemory verboseGarbageCollect
"Created: 12.5.1996 / 15:30:15 / 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
ObjectMemory reclaimSymbols
"Created: 12.5.1996 / 15:28:03 / cg"
!
globalGarbageCollect
ObjectMemory reclaimSymbols
"Created: 12.5.1996 / 15:28:13 / cg"
!
removeAllBreakAndTracePoints
MessageTracer cleanup
!
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:[
area := Rectangle fromUser.
(area width > 0 and:[area height > 0]) ifTrue:[
self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
]
]
afterSeconds:1
"Modified: 23.9.1996 / 14:36:28 / cg"
!
startEventMonitor
EventMonitor open
!
startFullWindowTreeView
WindowTreeView open
!
startMemoryMonitor
MemoryMonitor open
!
startMemoryUsageView
MemoryUsageView open
!
startProcessMonitor
ProcessMonitor open
!
startStopEventTrace
|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: 24.4.1996 / 10:27:11 / cg"
!
startWindowTreeView
|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 p v id|
(Delay forSeconds:1) wait.
device := Screen current.
p := device pointFromUser.
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: 14.12.1995 / 22:02:26 / 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: 23.9.1996 / 14:36:48 / 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'!
update:something with:aParameter from:changedObject
((something == #currentProject)
or:[changedObject == Project]) ifTrue:[
self changed:#info.
^ self
].
! !
!Launcher methodsFor:'dynamic menus'!
addMenu:name withItems:items actions:actions
"dynamically add a new (user-)menu to the menu panel.
This allows applications to install items for themself
dynamically in the launcher."
|subMenu|
myMenu add:name selector:(name asSymbol) before:#help.
subMenu := MenuView forMenu:myMenu.
subMenu labels:items.
subMenu actions:actions.
myMenu at:name putMenu:subMenu
"
|launcher actionBlocks|
actionBlocks := Array new:3.
actionBlocks at:1 put:[Transcript showCR:'foo'].
actionBlocks at:2 put:[Transcript showCR:'bar'].
launcher := Transcript topView application.
launcher
addMenu:'misc'
withItems:#('foo' 'bar')
actions:actionBlocks
"
"
|launcher actionBlocks|
actionBlocks := Array new:3.
actionBlocks at:1 put:[RDoItServer startServer].
actionBlocks at:2 put:[RDoItServer killServer].
launcher := Transcript topView application.
launcher
addMenu:'misc'
withItems:#('start rdoit server' 'stop rdoit server')
actions:actionBlocks
"
"Modified: 5.7.1996 / 11:45:19 / cg"
!
menuAt:nameSymbol
"return a menu by name"
^ myMenu subMenuAt:nameSymbol
"
|launcher demoMenu|
launcher := Transcript topView application.
demoMenu := launcher menuAt:#demos.
demoMenu
addLabels:#('-' 'fooBar')
selectors:#(nil fooBar).
demoMenu actionAt:#fooBar put:[Transcript showCR:'fooBar']
"
"Created: 11.7.1996 / 15:35:13 / cg"
"Modified: 11.7.1996 / 15:42:25 / cg"
!
removeMenu:name
"dynamically remove a (user-)menu from the menu panel.
This allows applications to de-install items for themself
dynamically in the launcher."
myMenu remove:name
"
|launcher actionBlocks|
actionBlocks := Array new:3.
actionBlocks at:1 put:[Transcript showCR:'foo'].
actionBlocks at:2 put:[Transcript showCR:'bar'].
launcher := Transcript topView application.
launcher
addMenu:'misc'
withItems:#('foo' 'bar')
actions:actionBlocks.
Delay waitForSeconds:10.
launcher removeMenu:'misc'
"
"Created: 5.7.1996 / 11:44:54 / cg"
"Modified: 5.7.1996 / 11:54:36 / cg"
! !
!Launcher methodsFor:'help'!
helpTextFor:aComponent
|sel s buttons|
aComponent == transcript ifTrue:[
s := 'TRANSCRIPT_HELP'
].
aComponent == infoView ifTrue:[
s := 'INFOVIEW_HELP'
].
buttons := buttonPanel subViews.
(buttons notNil and:[buttons includes:aComponent]) ifTrue:[
"kludge: look for its change selector"
sel := aComponent changeMessage.
sel == #startSystemBrowser ifTrue:[
s := 'SBROWSER_BUTTON_HELP'
].
sel == #startFileBrowser ifTrue:[
s := 'FBROWSER_BUTTON_HELP'
].
sel == #startChangesBrowser ifTrue:[
s := 'CBROWSER_BUTTON_HELP'
].
].
s notNil ifTrue:[
^ resources string:s
].
^ nil
"Modified: 26.2.1996 / 23:08:19 / cg"
! !
!Launcher methodsFor:'infoview update'!
info
|project projectName projectDir packageName|
(Project isNil or:[(project := Project current) isNil]) ifTrue:[
projectName := '* none *'.
projectDir := '.'.
packageName := '* none *'.
] ifFalse:[
projectName := project name.
projectDir := project directory.
packageName := project packageName.
].
^ resources
string:'project: ''%1'' fileOut to: ''%3'' package: ''%2'''
withArgs:(Array
with:projectName
with:packageName
with:(projectDir contractTo:30))
!
showActivity:someMessage
"some activityNotification to be forwarded to the user;
show it in the transcript here."
transcript showCR:someMessage; endEntry
"Created: 23.12.1995 / 12:38:29 / cg"
"Modified: 5.7.1996 / 13:13:15 / cg"
! !
!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.
nil selectors are taken as separators (see setupButtonPanel)"
^ #(
#(startSystemBrowser 'SBrowser32x32.xbm')
#(startFileBrowser 'FBrowser32x32.xbm')
"/ #(startWorkspace 'Workspace32x32.xbm')
#(nil nil)
#(startChangesBrowser 'CBrowser32x32.xbm')
"/ #(nil nil)
"/ #(nil nil)
"/ #(startDocumentationTool 'book11.ico')
)
"Created: 4.12.1995 / 20:16:18 / cg"
"Modified: 19.4.1996 / 16:37:46 / cg"
!
closeDownViews
OpenLaunchers remove:self ifAbsent:nil.
super closeDownViews.
"Created: 5.7.1996 / 13:33:36 / cg"
!
closeRequest
(self confirm:(resources string:'really close %1 ?' with:self class name)) ifTrue:[
super closeRequest
]
!
disableDangerousMenuItemsInRemoteLauncher
"if I am a remote launcher (multidisplay operation),
disable menus which are dangerous or affect common state.
These operations have to
be performed on the main screen."
isMainLauncher ifFalse:[
(myMenu menuAt:#file) disableAll:#(snapshot snapshotAndExit objectModuleDialog exit).
(myMenu menuAt:#projects) disableAll.
(myMenu menuAt:#settings) disableAll.
].
"Created: 5.7.1996 / 17:00:50 / cg"
"Modified: 5.7.1996 / 17:01:30 / cg"
!
focusSequence
^ (Array with:myMenu)
,
(buttonPanel subViews select:[:element | element isKindOf:Button])
"/ , (Array with:Transcript)
!
openInterface
"sent by my superclass to open up my interface"
|top icn w scrn sz|
"/ if there is already a transcript on my device,
"/ I am a slave launcher with limited functionality.
Transcript notNil ifTrue:[
Transcript ~~ Stderr ifTrue:[
isMainLauncher := (Transcript graphicsDevice == device).
] ifFalse:[
isMainLauncher := true
]
] ifFalse:[
isMainLauncher := true
].
top := StandardSystemView onDevice:device.
top label:'Smalltalk/X'; iconLabel:'ST/X Launcher'.
top extent:(400@300 ).
icn := self class aboutIcon.
icn notNil ifTrue:[
icn := icn magnifiedTo:(sz := Screen current preferredIconSize).
].
((scrn := Screen current) supportsDeepIcons not
and:[scrn supportsIconViews
and:[scrn depth > 1]]) ifTrue:[
w := View extent:sz.
w viewBackground:icn.
top iconView:w
] ifFalse:[
top icon:icn.
].
"/ (scrn := Screen current) supportsDeepIcons ifTrue:[
"/ icn := self class aboutIcon.
"/ icn notNil ifTrue:[
"/ icn := icn magnifiedTo:(sz := scrn preferredIconSize).
"/ icn := Depth8Image fromImage:icn.
"/ top icon:icn
"/ ].
"/ ] ifFalse:[
"/ scrn supportsIconViews ifTrue:[
"/ icn := self class aboutIcon.
"/ icn notNil ifTrue:[
"/ icn := icn magnifiedTo:(sz := scrn preferredIconSize).
"/ w := View extent:sz.
"/ w viewBackground:icn.
"/ top iconView:w
"/ ].
"/ ]
"/ ].
self setupViewsIn:top.
top application:self.
"
open with higher prio to allow interaction even while things
are running ...
"
top openWithPriority:(Processor userSchedulingPriority + 1).
OpenLaunchers isNil ifTrue:[
OpenLaunchers := OrderedCollection new.
].
OpenLaunchers add:self.
"Modified: 25.7.1996 / 21:12:09 / cg"
!
release
infoProcess notNil ifTrue:[
infoProcess terminate.
infoProcess := nil.
].
OpenLaunchers remove:self ifAbsent:nil.
super release
"Modified: 5.7.1996 / 11:48:56 / cg"
!
restarted
"image restart - since WindowGroup recreates the process with
the default priority, we have to raise the prio again.
Mhmh - this looks like a bug to me ...
Also, the cursor (which was stored as a write or waitCursor) must
be reset to normal."
Processor activeProcess priority:(Processor userSchedulingPriority + 1).
super restarted
"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"
|spc mh buttonSize|
spc := View viewSpacing // 2.
buttonPanel := HorizontalPanelView in:aTopView.
buttonPanel level:-1; borderWidth:0.
buttonPanel horizontalLayout:#leftSpace.
buttonSize := self class buttonImageSize.
"/
"/ the buttonSpec is a collection of:
"/ #( selector iconFileName )
"/ or:
"/ #( selector (className iconQuerySelector) )
"/ or"
"/ #( nil )
"/
self buttonPanelSpec do:[:entry |
|sel b sep img iconSpec|
sel := entry at:1.
sel isNil ifTrue:[
sep := View in:buttonPanel.
sep extent:32@1; borderWidth:0.
] ifFalse:[
b := Button in:buttonPanel.
iconSpec := entry at:2.
iconSpec isArray ifTrue:[
img := (Smalltalk classNamed:(iconSpec at:1)) perform:(iconSpec at:2).
] ifFalse:[
img := Image fromFile:iconSpec.
].
(img notNil and:[buttonSize notNil]) ifTrue:[
img extent ~= buttonSize ifTrue:[
img := img magnifiedTo:buttonSize
]
].
b form:img.
b model:self; changeMessage:sel
]
].
mh := myMenu height.
buttonPanel origin:0.0 @ (mh + spc)
corner:(1.0 @ (mh + spc + buttonPanel preferredExtent y)).
buttonPanel leftInset:spc; rightInset:spc.
"Modified: 29.5.1996 / 19:23:04 / cg"
!
setupDemoMenu
"setup the demo pulldown menu"
|m|
myMenu at:#demos
putLabels:(resources array:#(
'goodies'
'games'
'geometric designs'
'simple animations'
'3D graphics'
'graphic editors'
))
selectors:#(
goodies
games
geometricDesigns
simpleAnimations
#'3Dgraphics'
#graphicEditors
)
receiver:self.
"
only to show two different ways of defining a popUpMenu,
we use labels:selectors:receiver: here:
"
m := myMenu menuAt:#demos.
m subMenuAt:#games
put:(PopUpMenu
labels:(resources array:#(
'Tetris'
'Tic Tac Toe'
'Tic Tac Toe (2 players)'
))
selectors:#(
startTetris
startTicTacToe
startTicTacToe2
)
receiver:self).
"
and labels:selector:args:receiver: here:
"
m subMenuAt:#geometricDesigns
put:(PopUpMenu
labels:(resources array:#(
'Pen demo'
'Commander demo'
'-'
'Fractal plants demo'
'Fractal patterns demo'
))
selector:#openDemo:
args:#(
PenDemo
CommanderDemo
nil
FractalPlantsDemo
FractalPatternsDemo
)
receiver:self).
m subMenuAt:#simpleAnimations
put:(PopUpMenu
labels:(resources array:#(
'Animation'
'Globe demo'
))
selector:#openDemo:
args:#(
Animation
GlobeDemo
)
receiver:self).
m subMenuAt:#'3Dgraphics'
put:(PopUpMenu
labels:(resources
array:#(
'plane'
'tetra'
'cube (wireframe)'
'cube (solid)'
'sphere (wireframe)'
'doughnut (wireframe)'
'planet'
'teapot'
'logo'
'rubics cube'
'x/y graph'
'-'
'cube (light)'
'cube (light & texture)'
'sphere (light)'
'colored octahedron'
))
selector:#openDemo:
args:#(
GLPlaneDemoView2
GLTetraDemoView
GLWireCubeDemoView
GLCubeDemoView
GLWireSphereDemoView
GLDoughnutDemoView
GLPlanetDemoView
GLTeapotDemo
Logo3DView1
RubicsCubeView
GLXYGraph
nil
GLCubeDemoView2
GLBrickCubeDemoView
GLSphereDemoView2
GLOctaHedronDemoView
)
receiver:self).
m subMenuAt:#graphicEditors
put:(PopUpMenu
labels:(resources array:#(
'DrawTool'
'LogicTool'
'Paint Demo'
))
selector:#openDemo:
args:#(
DrawTool
LogicTool
ColorDrawDemo3
)
receiver:self).
m subMenuAt:#goodies
put:(PopUpMenu
labels:(resources array:#(
'clock'
'calendar'
'calculator'
'-'
'mail tool'
'news tool'
))
selector:#openDemo:
args:#(
Clock
Calendar
CalculatorView
nil
MailView
NewsView
)
receiver:self).
"Modified: 11.4.1996 / 00:21:46 / cg"
!
setupInfoViewIn:topView
|spc halfSpc|
spc := View viewSpacing.
infoView := Label label:'' in:topView.
infoView adjust:#left; borderWidth:0.
infoView level:-1.
transcript superView bottomInset:(infoView height + spc).
infoView is3D ifTrue:[
halfSpc := spc // 2.
] ifFalse:[
halfSpc := 0
].
infoView topInset:(infoView height negated - spc + transcript borderWidth);
bottomInset:halfSpc;
leftInset:halfSpc;
rightInset:halfSpc.
infoView origin:0.0 @ 1.0 corner:1.0 @ 1.0.
infoView model:self; aspect:#info; labelMessage:#info.
Project notNil ifTrue:[
Project addDependent:self.
]
"
Launcher open
"
"Modified: 9.9.1996 / 22:44:15 / stefan"
!
setupMenu
"setup the pulldown menu"
|l s icon|
myMenu labels:(resources array:#(
about
file
classes
tools
projects
settings
demos
help)).
"
if there is a bitmap, change 'about' to the ST/X icon
"
icon := self class smallAboutIcon.
icon notNil ifTrue:[
myMenu labels at:1 put:icon.
myMenu height:(myMenu height max:(icon height + (View viewSpacing * 2)))
].
myMenu selectors:#(
#about
#file
#classes
#tools
#projects
#settings
#demos
#help).
myMenu at:#about
putLabels:(resources array:#(
'about Smalltalk/X ...'
'-'
'licence conditions'
))
selectors:#(
#about
nil
#showLicenceConditions
)
receiver:self.
l := #(
'file browser'
'-'
'modules ...'
'-'
'snapshot ...'
'snapshot & exit ...'
'exit smalltalk ...'
).
s := #(
#startFileBrowser
nil
#objectModuleDialog
nil
#snapshot
#snapshotAndExit
#exit
).
myMenu at:#file
putLabels:(resources array:l)
selectors:s
receiver:self.
myMenu at:#classes
putLabels:(resources array:#(
'system browser'
'class browser ...'
'full class browser ...'
'class hierarchy browser ...'
'class tree'
'-'
'implementors ...'
'senders ...'
'resource ...'
'-'
'change browser'
))
selectors:#(
#startSystemBrowser
#startClassBrowser
#startFullClassBrowser
#startClassHierarchyBrowser
#startClassTreeView
nil
#browseImplementors
#browseSenders
#browseResources
nil
#startChangesBrowser
)
receiver:self.
JavaBrowser notNil ifTrue:[
(myMenu subMenuAt:#classes)
addLabels:(resources array:#('-' 'java browser'))
selectors:#(nil startJavaBrowser)
after:#startClassTreeView
].
myMenu at:#projects
putLabels:(resources array:#(
'new project'
'-'
'select project ...'
))
selectors:#(
#newProject
nil
#selectProject
)
receiver:self.
myMenu at:#settings
putLabels:(resources array:#(
'language ...'
'show keyboard mappings ...'
'view style ...'
'fonts ...'
'printer ...'
'messages ...'
'compilation ...'
'object memory ...'
'screen ...'
'misc ...'
))
selectors:#(
#languageSetting
#keyboardSetting
#viewStyleSetting
#fontSettings
#printerSettings
#messageSettings
#compilerSettings
#memorySettings
#displaySettings
#miscSettings
)
receiver:self.
self setupToolsMenu.
self setupDemoMenu.
ActiveHelp notNil ifTrue:[
l := #(
'ST/X documentation'
'class documentation'
'index'
'-'
'print documentation ...'
'-'
'active help \c'
).
s := #(
#startDocumentationTool
#startClassDocumentation
#startDocumentationIndex
nil
#showBookPrintDocument
nil
#toggleActiveHelp:
)
] ifFalse:[
l := #(
'ST/X documentation'
'class documentation'
'index'
'print documentation ...'
'-'
).
s := #(
#startDocumentationTool
#startClassDocumentation
#startDocumentationIndex
#showBookPrintDocument
nil
)
].
myMenu at:#help
putLabels:(resources array:l)
selectors:s
receiver:self.
(ActiveHelp notNil
and:[ActiveHelp isActive]) ifTrue:[
(myMenu menuAt:#help) checkToggleAt:#toggleActiveHelp: put:true
].
self disableDangerousMenuItemsInRemoteLauncher
"Modified: 14.9.1996 / 13:27:44 / cg"
!
setupOtherViewsIn:aTopView
"a hook - allows redefinition in your personal subclass.
For example, add a clock:"
"
|sz clock space halfSpace|
sz := buttonPanel innerHeight - (buttonPanel level abs*2).
space := View viewSpacing.
halfSpace := space // 2.
buttonPanel rightInset:sz+(space * 2).
clock := ClockView in:buttonPanel topView.
clock borderWidth:1.
clock showSeconds:false.
clock extent:(sz @ sz).
clock origin:(1.0 @ (buttonPanel origin y + halfSpace)).
clock leftInset:sz negated - 2 - halfSpace.
clock rightInset:halfSpace.
clock level:1.
"
!
setupToolsMenu
"setup the tools pulldown menu"
|m|
myMenu at:#tools
putLabels:(resources array:#(
'workspace'
'-'
'monitors'
'-'
'view tree (all views)'
'view tree'
'inspect view'
'destroy view'
'-'
'hardcopy'
'-'
'misc'
))
selectors:#(
#startWorkspace
nil
#monitors
nil
#startFullWindowTreeView
#startWindowTreeView
#viewInspect
#viewDestroy
nil
#hardcopy
nil
#misc
)
receiver:self.
m := myMenu menuAt:#tools.
m subMenuAt:#monitors
put:(PopUpMenu
labels:(resources array:#(
'process'
'memory'
'event view'
'event trace'
'-'
'memory usage'
))
selectors:#(
#startProcessMonitor
#startMemoryMonitor
#startEventMonitor
#startStopEventTrace
nil
#startMemoryUsageView
)
receiver:self).
m subMenuAt:#misc
put:(PopUpMenu
labels:(resources array:#(
'garbage collect'
'garbage collect & compress'
'-'
'remove all break/trace points'
))
selectors:#(
#garbageCollect
#compressingGarbageCollect
nil
#removeAllBreakAndTracePoints
)
receiver:self).
m subMenuAt:#hardcopy
put:(PopUpMenu
labels:(resources array:#(
'screen'
'area'
'view'
))
selectors:#(
#fullScreenHardcopy
#screenHardcopy
#viewHardcopy
)
receiver:self).
"Modified: 12.5.1996 / 15:29:46 / cg"
!
setupTranscriptIn:aView
|v launcher|
"/ check if this is an additional launcher on a remote display.
"/ if so, do not close the real launcher.
(Transcript notNil and:[Transcript ~~ Stderr]) ifTrue:[
isMainLauncher ifTrue:[
launcher := Transcript topView application
] ifFalse:[
launcher := self class current.
].
launcher notNil ifTrue:[
launcher window graphicsDevice == device ifTrue:[
OpenLaunchers remove:launcher ifAbsent:nil.
launcher window destroy.
]
]
].
v := HVScrollableView
for:TextCollector
miniScrollerH:true
miniScrollerV:false
in:aView.
v origin:(0.0 @ (buttonPanel corner y + View viewSpacing))
corner:(1.0 @ 1.0).
transcript := v scrolledView.
isMainLauncher ifTrue:[
transcript beTranscript.
] ifFalse:[
transcript showCR:'**************** Notice ***********************'.
transcript showCR:'** this is NOT the Transcript **'.
transcript showCR:'** The real Transcript is on the main screen **'.
transcript showCR:'** **'.
transcript showCR:'** Menus affecting common state are disabled **'.
transcript showCR:'***********************************************'.
]
"Modified: 5.7.1996 / 17:55:15 / cg"
!
setupViewsIn:topView
"create the pulldown menu, buttonPanel and transcript view"
|tFont|
topView model:self.
myMenu := PullDownMenu in:topView.
myMenu origin:0.0 @ 0.0 corner:(1.0 @ myMenu height).
self setupMenu.
self setupButtonPanelIn:topView.
self setupTranscriptIn:topView.
self setupInfoViewIn:topView.
self setupOtherViewsIn:topView.
tFont := transcript font.
topView extent:(((tFont widthOf:'3')*60) max:myMenu preferredExtent x)
@
((tFont height) * 20).
"
Launcher open
"
"Modified: 9.9.1996 / 22:44:31 / stefan"
! !
!Launcher methodsFor:'private'!
fontBoxForEncoding:encodingMatch
|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 updateAllStyleCaches.
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: 30.5.1996 / 09:18:57 / cg"
"Modified: 17.6.1996 / 13:38:48 / stefan"
!
pickAView
|v|
(Delay forSeconds:1) wait.
v := Screen current viewFromUser.
v isNil ifTrue:[
self warn:'sorry, this is not a smalltalk view'.
^ nil
].
^ v
!
reopenLauncher
"for now (since style & language settings currently do
not affect living views ...)"
|contents fontPref enc newLauncher|
fontPref := self class classResources at:'PREFERRED_FONT_ENCODING'.
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.
newLauncher := self class open.
newLauncher window waitUntilVisible.
newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor
"Modified: 5.7.1996 / 14:00:40 / cg"
!
saveAllViews
"tell each topview that we are going to terminate and give it chance
to save its contents."
ObjectMemory changed:#aboutToExit
!
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:'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.196 1996-10-14 18:44:45 cg Exp $'
! !