"
COPYRIGHT (c) 1997 by eXept Software AG
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.
"
"{ Package: 'stx:libtool' }"
ToolApplicationModel subclass:#AbstractLauncherApplication
instanceVariableNames:'transcript'
classVariableNames:'NotifyingEmergencyHandler OpenLaunchers RegisteredMenuHandlers
OpenSettingsDialog'
poolDictionaries:''
category:'Interface-Smalltalk'
!
AbstractLauncherApplication class instanceVariableNames:'SettingsList UserSettingsList'
"
The following class instance variables are inherited by this class:
ToolApplicationModel - history fileHistory clipboard settings showingHelp instances
ApplicationModel - ClassResources
Model -
Object -
"
!
Object subclass:#LauncherDialogs
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:AbstractLauncherApplication
!
!AbstractLauncherApplication class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1997 by eXept Software AG
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.
"
!
documentation
"
This is an abstract class, providing mechanisms and common functionality
for launcher-type applications. Subclasses may implement their GUI either
with or without the UIPainter framework, and still use the common functions
provided here.
[author:]
Claus Gittinger, eXept Software AG
"
! !
!AbstractLauncherApplication class methodsFor:'accessing'!
closeAllLaunchers
"close all opened launchers"
self openLaunchers copy do:[:eachLauncher |
eachLauncher closeRequest
].
"
self closeAllLaunchers.
NewLauncher open
"
!
current
"return the launcher running on the current screen.
(for access via addMenu/ removeMenu)"
|currentScreen|
OpenLaunchers size > 0 ifTrue:[
currentScreen := Screen current.
^ OpenLaunchers detect:[:eachLauncher | eachLauncher graphicsDevice == currentScreen] ifNone:nil
].
^ nil.
"
NewLauncher current
"
"Modified: / 9.9.1996 / 22:41:36 / stefan"
"Modified: / 13.10.1998 / 16:09:50 / cg"
!
openLaunchers
"return all opened launchers"
OpenLaunchers isNil ifTrue:[
OpenLaunchers := IdentitySet new
].
^ OpenLaunchers
! !
!AbstractLauncherApplication class methodsFor:'defaults'!
notifyingEmergencyHandler
"return a block (used as an emergency handler
for exceptions), which does errorNotification before going
into the debugger."
"Remember the handlerBlock, to be able to determine if the current
handler is the notifying one."
NotifyingEmergencyHandler isNil ifTrue:[
NotifyingEmergencyHandler := NoHandlerError notifyingEmergencyHandler
].
^ NotifyingEmergencyHandler
"Created: 7.1.1997 / 22:18:19 / cg"
"Modified: 15.1.1997 / 21:15:38 / cg"
! !
!AbstractLauncherApplication class methodsFor:'image specs'!
communicationIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self communicationIcon inspect
ImageEditor openOnClass:self andSelector:#communicationIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'AbstractLauncherApplication class communicationIcon'
ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#(8 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
@@@@_$RA@@@@@@@@@@@@@HED_ @@@@@@ U2+UX\@@@@@@@@@@H]U*52A@@@@ U*9^S-A @@@@@@@HIT.HD4O8D@_%29^#6JZE"B@@@@@HIX-(@9!!&-\_"Z+
.+QKZ(0@J @@@@@*@K*5SV2B*2XDQ+":,XR5WP8@@@@@BDJ5.+V@.E4KEA46-+*5U9TVHRD!!HP<+JKV:-%*SG1@Y@R8@WYV)I@A/@@@SH D$@E>K*BP-$PUH
QH60)2U0[$:]KYPJN$RK,JX''[TFW]BB*)*4Z\K)[Q''L6''GD *JZ.HF4UV;H_**U6\+)%T7,WDUB3G:^%_E<@WB%RG*)8\+*BL(=Q#@(!!R!!2-_P5-@@AUNA!!4
BGV:.(IQ)I<LQS@R^VE([P@@(E9OZQT/[[*:-9=YO8M''S6B ZF4@@@@@[0@[M0I5.)!!!!(4NE@F<@&$&C@@@@@@@@G&PCBGYV&;@<!!P@@#$^P@@@@@@@@@FN@
[R<#+J2,PHT@%$2E@@@@@@@@@@BEA7>"I;B/''$*H%$"I@@@@@@@@@@@@$#D]^RF''*F]5$D2I@@@@@@@@@@@@@@BIKB<F(VHIHSNE@@@@@@@@@@@@@@@@@I$>
MVY7@@@@@@@@@@@@@@@@@@@@@@@@!!3Y9@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 0 0 0 7 7 7 12 12 12 20 20 20 23 23 23 24 24 24 28 28 28 30 30 30 32 32 32 35 35 35 40 40 40 41 41 41 43 43 43 45 45 45 48 47 48 50 49 50 51 50 51 52 52 52 54 53 54 55 54 55 56 56 56 58 57 58 58 58 58 59 59 59 60 59 60 60 60 60 61 61 61 62 62 62 66 65 66 66 66 66 67 66 67 68 67 68 69 69 69 70 69 70 70 70 70 71 71 71 72 71 72 73 73 73 74 73 74 75 75 75 76 75 76 76 76 76 77 76 77 78 78 78 79 79 79 80 80 80 85 84 85 86 84 86 86 85 86 87 86 87 87 87 87 88 87 88 89 88 89 89 89 89 90 88 90 90 89 90 93 91 93 93 93 93 94 92 94 94 93 94 96 94 96 97 96 97 98 97 98 99 98 99 99 99 99 100 99 100 100 100 100 102 102 102 103 103 103 104 103 104 104 104 104 105 105 105 106 106 106 108 107 108 109 109 109 110 110 110 111 110 111 113 113 113 114 113 114 114 114 114 115 115 115 116 116 116 117 115 117 118 118 118 120 120 120 121 121 121 122 121 122 122 122 122 123 122 123 123 123 123 124 124 124 125 125 125 127 127 127 128 128 128 129 129 129 130 130 130 131 131 131 132 131 132 132 132 132 133 132 133 134 134 134 135 135 135 136 136 136 137 137 137 138 138 138 140 139 140 142 142 142 147 147 147 151 151 151 153 153 153 154 154 154 155 155 155 156 155 156 156 156 156 159 159 159 164 163 164 165 165 165 167 167 167 168 168 168 170 170 170 172 172 172 174 174 174 175 174 175 177 177 177 178 178 178 181 181 181 182 182 182 183 183 183 185 185 185 189 189 189 190 190 190 191 191 191 192 192 192 194 192 194 194 194 194 195 195 195 196 196 196 198 196 198 199 198 199 200 200 200 201 200 201 201 201 201 202 201 202 202 202 202 203 203 203 204 204 204 205 204 205 205 205 205 206 205 206 206 206 206 209 209 209 210 210 210 211 211 211 212 212 212 213 212 213 213 213 213 214 214 214 215 213 215 215 215 215 216 216 216 217 216 217 217 217 217 218 217 218 219 219 219 221 219 221 222 221 222 224 222 224 224 223 224 225 223 225 225 224 225 225 225 225 226 224 226 226 225 226 227 226 227 228 226 228 229 228 229 231 231 231 232 231 232 235 234 235 237 237 237 239 239 239 241 241 241 244 244 244 247 247 247 248 248 248 255 255 255]; mask:((ImageMask new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'G@C O G0_0O8?8_<?(W<?8_<???<=:^<???<???<???<_??<O??<O??<B?=\@?<8@?=0@?? @??@@_>@@O @@G@@') ; yourself); yourself]
!
httpServerIcon
<resource: #programImage>
^ AbstractSettingsApplication::HTTPStartServerSettingsApplication defaultIcon
!
systemBrowser24x24Icon
<resource: #programImage>
^ ToolbarIconLibrary systemBrowser24x24Icon
! !
!AbstractLauncherApplication class methodsFor:'queries'!
isVisualStartable
"return true, if this application can be started via #open.
(to allow start of a change browser via double-click in the browser)"
"/ assume all my subclasses can
^ self ~~ AbstractLauncherApplication
"
AbstractLauncherApplication isVisualStartable
NewLauncher isVisualStartable
"
! !
!AbstractLauncherApplication class methodsFor:'resources'!
resourcePackName
"return the name which is used as the fileNameBase of my resource file.
Here, use the same resources as the (old)Launcher"
^ 'Launcher'
! !
!AbstractLauncherApplication class methodsFor:'settings application list'!
addSettingsApplicationByClass:aClass withName:aName icon:anIcon
| userSetList addItem|
userSetList := self userSettingsList.
addItem := Array with:aName with:aClass with:anIcon.
"Ignore existing entries found in SettingsList for that name"
(SettingsList ? #()) do:[:entry |
entry first = aName ifTrue: [
('Settings named "%1" already exists in "%2" with settings app class "%3"'
bindWith:aName
with:self name printString
with:entry second
) infoPrintCR.
^ self
].
].
"/ remove existing entries in UserSettingsList for that name
userSetList copy do:[:entry |
entry first = aName ifTrue:[
userSetList remove:entry.
]
].
userSetList add:addItem.
OpenSettingsDialog notNil ifTrue:[
OpenSettingsDialog installSettingsEntry:addItem
].
!
allSettingsList
^ self settingsList, self userSettingsList
!
defaultSettingsApplicationList
"/ cg: moved it to SettingsDialog - everyone is expecting it there and had to search it...
"/ left here for backw. compatibility.
^ SettingsDialog defaultSettingsApplicationList
!
initializeSettingsList
|rawList filteredList settingsList|
rawList := self defaultSettingsApplicationList.
filteredList := rawList select:[:eachEntry|
|className|
className := eachEntry at:2 ifAbsent:nil.
className isNil
or:[ (Smalltalk at:className) notNil ]
].
settingsList := filteredList collect:[:eachEntry|
|iconSelector newEntry|
iconSelector := eachEntry at:3 ifAbsent:nil.
iconSelector isNil ifTrue:[
eachEntry
] ifFalse:[
newEntry := eachEntry copy.
newEntry at:3 put:(self perform:iconSelector).
newEntry
].
].
SettingsList := settingsList.
^ settingsList.
"
self withAllSubclassesDo:[:cls | cls initializeSettingsList ]
"
"Modified: / 16-12-2002 / 18:12:50 / penk"
"Modified: / 01-12-2006 / 14:01:12 / cg"
!
removeSettingsApplicationByClass:aClass
| userSetList remItem|
userSetList := self userSettingsList.
remItem := userSetList detect:[:item| (item at:2) = aClass] ifNone:[nil].
remItem notNil ifTrue:[
userSetList remove:remItem.
OpenSettingsDialog notNil ifTrue:[
self removeSettingsEntry:remItem forSettingsApp:OpenSettingsDialog.
].
].
!
removeSettingsEntry:entry forSettingsApp:aSettingsApp
|applName applClass|
applName := entry at:1.
applClass := entry at:2.
aSettingsApp remApplClassByName:applName.
!
settingsList
"/ do NOT cache SettingsList
"/ use UserSettingsList to add settings from loaded libraries
SettingsList := nil.
SettingsList isNil ifTrue: [
SettingsList := self initializeSettingsList
].
^ SettingsList
!
userSettingsList
UserSettingsList isNil ifTrue: [
UserSettingsList := OrderedCollection new.
].
^ UserSettingsList
! !
!AbstractLauncherApplication methodsFor:'drag & drop'!
canDropObjects:aCollectionOfDropObjects
"Any object can be dropped into workspace..."
^ aCollectionOfDropObjects
contains:[:someObject| (someObject isTextObject or:[ someObject isFileObject ])].
!
dropFileObject:aFilename
|suffix|
suffix := aFilename asFilename suffix.
suffix = 'st' ifTrue:[
ChangesBrowser openOn:aFilename.
^ self.
].
UserPreferences fileBrowserClass openOn:aFilename.
!
dropObjects:aCollectionOfObjects
"Any object can be dropped:
text: open a workspace
file:
.st - open a cange-browser
other - open a fileBrowser
"
aCollectionOfObjects do:[:dropObject|
|theObject|
theObject := dropObject theObject.
dropObject isTextObject ifTrue:[
self dropTextObject:theObject
] ifFalse:[
dropObject isFileObject ifTrue:[
self dropFileObject:theObject
] ifFalse:[
].
].
].
!
dropTextObject:aDropContext
WorkspaceApplication openWith:aDropContext.
! !
!AbstractLauncherApplication methodsFor:'oldStyle-user actions-settings'!
communicationsSettings
"open a dialog on misc other settings"
self settingsDialog:[:handler | handler communicationsSettings]
"Modified: / 31.7.1998 / 22:46:56 / cg"
!
compilerSettings
"open a dialog on compiler related settings"
self settingsDialog:[:handler | handler compilerSettings]
!
displaySettings
"open a dialog on display related settings"
self settingsDialog:[:handler | handler displaySettings]
"Modified: / 31.7.1998 / 22:45:38 / cg"
!
editSettings
"open a dialog on edit settings"
self settingsDialog:[:handler | handler editSettings]
"Modified: / 31.7.1998 / 22:46:56 / cg"
"Created: / 6.1.1999 / 14:14:48 / cg"
!
fontSettings
"open a dialog on font related settings"
self settingsDialog:[:handler | handler fontSettingsFor:self]
"Modified: / 31.7.1998 / 22:45:44 / cg"
!
javaSettings
"open a dialog on java-subsystem related settings"
self settingsDialog:[:handler | handler javaSettings]
"Modified: / 31.7.1998 / 22:46:13 / cg"
!
keyboardSetting
"open a dialog on keyboard related settings"
self settingsDialog:[:handler | handler keyboardSettings]
"Modified: / 31.7.1998 / 22:45:56 / cg"
!
languageSetting
"open a dialog on language related settings"
self settingsDialog:[:handler | handler languageSettingsFor:self]
"Modified: / 31.7.1998 / 22:46:13 / cg"
!
loadSettings
"restore settings from a settings-file."
"a temporary kludge - we need a central systemSettings object for this,
which can be saved/restored with a single store/read."
|fileName|
fileName := Dialog
requestFileName:(resources string:'Load Settings From:')
default:'settings.stx'
ok:(resources string:'Load')
abort:(resources string:'Cancel')
pattern:'*.stx'
fromDirectory:nil.
fileName isEmptyOrNil ifTrue:[
"/ canceled
^ self
].
self withWaitCursorDo:[
Smalltalk fileIn:fileName.
self reOpen
].
!
memorySettings
"open a dialog on objectMemory related settings"
self settingsDialog:[:handler | handler memorySettings]
"Modified: / 31.7.1998 / 22:46:33 / cg"
!
messageSettings
"open a dialog on infoMessage related settings"
self settingsDialog:[:handler | handler messageSettings]
"Modified: / 31.7.1998 / 22:46:45 / cg"
!
miscSettings
"open a dialog on misc other settings"
self settingsDialog:[:handler | handler miscSettings]
"Modified: / 31.7.1998 / 22:46:56 / cg"
!
printerSettings
"open a dialog on printer related settings"
self settingsDialog:[:handler | handler printerSettings]
"Modified: / 31.7.1998 / 22:47:05 / cg"
!
saveSettings
"save settings to a settings-file."
self settingsDialog:[:handler | handler saveSettings]
"Modified: / 31.7.1998 / 22:48:38 / cg"
!
settingsDialog:symbolOrBlock
|handler|
RegisteredMenuHandlers notNil ifTrue:[
handler := RegisteredMenuHandlers at:symbolOrBlock ifAbsent:nil.
].
handler isNil ifTrue:[
handler := LauncherDialogs
].
symbolOrBlock isBlock ifTrue:[
symbolOrBlock value:handler
] ifFalse:[
handler perform:symbolOrBlock with:self.
]
"Modified: / 24-02-2007 / 09:40:48 / cg"
!
sourceAndDebuggerSettings
"open a dialog on misc other settings"
self settingsDialog:[:handler | handler sourceAndDebuggerSettings]
"Modified: / 31.7.1998 / 22:47:21 / cg"
!
toolSettings
"open a dialog on tool settings"
self settingsDialog:[:handler | handler toolSettings]
"Modified: / 31.7.1998 / 22:46:56 / cg"
"Created: / 13.10.1998 / 15:50:53 / cg"
!
viewStyleSetting
"open a dialog on viewStyle related settings"
self settingsDialog:[:handler | handler viewStyleSettingsFor:self]
"Modified: / 31.7.1998 / 22:47:33 / cg"
! !
!AbstractLauncherApplication methodsFor:'private'!
findApplicationClass:classOrClassName nameSpace:aNameSpace
"find some application, given the classes name.
Look for it in Smalltalk and the given nameSpace"
|cls|
classOrClassName isBehavior ifTrue:[
cls := classOrClassName.
] ifFalse:[
cls := Smalltalk at:classOrClassName asSymbol.
cls isNil ifTrue:[
"/ look if its in the nameSpace
aNameSpace notNil ifTrue:[
cls := aNameSpace at:classOrClassName asSymbol
]
].
cls isNil ifTrue:[
self warn:(resources
string:'Sorry, the ''%1''-class is not available.'
with:classOrClassName allBold).
^ nil
].
].
^ cls
!
findWindow:title
"a helper for find & destroy and find & raise operations;
let user choose a view and return it; return nil on cancel"
^ self findWindow:title windowGroupFilter:nil
!
findWindow:title windowGroupFilter:windowGroupFilterOrNil
"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:[
windowGroupFilterOrNil notNil ifTrue:[
showIt := windowGroupFilterOrNil includes:wg
]
]
].
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'.
v device == Display ifFalse:[
l := l , ' [' , (v device displayName ? '?') , ']'
].
((wg := v windowGroup) notNil
and:[(p := wg process) notNil
and:[p state ~~ #dead]]) ifTrue:[
l
] ifFalse:[
l , ' (dead ?)'
]
].
box := ListSelectionBox new.
box selectionChangeCallback:[:selectionIndex | |v|
v := knownTopViews at:box selectionIndex.
v raise. box raise
].
box noEnterField.
box list:nameList.
box label:(resources string:'View Selection').
box title:(resources stringWithCRs:title).
box action:[:selection |
|v|
v := knownTopViews at:box selectionIndex.
box destroy.
^ v
].
box extent:400@300.
box open.
^ nil
!
openApplication: classOrClassName
"open an application, given by the classe name."
self openApplication:classOrClassName nameSpace:nil
!
openApplication:classOrClassName nameSpace:aNameSpace
"open some application, given the classes name.
Look for it in Smalltalk and the given nameSpace"
self openApplication:classOrClassName nameSpace:aNameSpace with:#open
!
openApplication:classOrClassName nameSpace:aNameSpace with:aSelector
"open some application, given the classes name.
Look for it in Smalltalk and the given nameSpace"
|cls|
cls := self findApplicationClass:classOrClassName nameSpace:aNameSpace.
cls isNil ifTrue:[
^ self
].
Autoload autoloadFailedSignal handle:[:ex |
self warn:(resources string:'Sorry, the %1 class seems to be not available (failed to load).' with:cls name)
] do:[
self withWaitCursorDo:[
cls perform:aSelector
]
]
!
openFileBrowser
"open a fileBrowser"
self openApplication:(FileBrowserV2 ? FileBrowser) nameSpace:nil
"Created: / 05-11-2007 / 11:16:17 / cg"
!
pickAView
"let user pick a view and return it"
|v|
(Delay forSeconds:1) wait.
v := Screen current viewFromUser.
v isNil ifTrue:[
self warn:'Sorry, this is not a smalltalk view'.
^ nil
].
^ v
!
saveScreenImage:anImage defaultName:defaultName
"save an image into a file
- ask user for filename using a fileSelectionBox."
|fileName|
fileName := Dialog
requestFileName:(resources string:'Save hardcopy image in:')
default:(defaultName , '.png')
ok:(resources string:'Save')
abort:(resources string:'Cancel')
pattern:'*.png;*.tiff;*.bmp'
fromDirectory:nil
forSave:true
whenBoxCreatedEvaluate:[:box |
|editButton msPaintButton|
"/ UserPreferences current useNewFileDialog ifFalse:[
editButton := Button label:(resources string:'Edit').
editButton
action:[
box hide; destroy.
ImageEditor openOnImage:anImage.
].
box addButton:editButton.
"/ ]
(OperatingSystem isMSWINDOWSlike
and:[ true "OperatingSystem canExecuteCommand:'C:\Windows\system32\mspaint.exe'" ]) ifTrue:[
msPaintButton := Button label:(resources string:'MS-Paint').
msPaintButton
action:[
|tempFile|
tempFile := Filename newTemporary withSuffix:'bmp'.
box hide; destroy.
anImage saveOn:tempFile.
OperatingSystem
openApplicationForDocument:tempFile operation:#edit.
].
box addButton:msPaintButton.
].
"/ ]
].
fileName notNil ifTrue:[
anImage saveOn:fileName.
ImageEditView lastSaveDirectory:fileName asFilename directory pathName.
].
"Created: / 29-01-1998 / 23:20:36 / cg"
"Modified: / 08-02-2011 / 21:51:11 / cg"
!
showDocumentation:aRelativeDocFilePath
"open an HTML browser on some document"
"
although that one is not yet finished,
its better than nothing ...
"
HTMLDocumentView notNil ifTrue:[
self withWaitCursorDo:[
"
temporary kludge;
not all machines can autoload binaries;
however, on my SGI (which can) we want it
to load automatically.
"
HTMLDocumentView isLoaded ifFalse:[
Error catch:[HTMLDocumentView autoload]
].
HTMLDocumentView isLoaded ifTrue:[
HTMLDocumentView openFullOnDocumentationFile:aRelativeDocFilePath.
^ self
].
]
].
self warn:'Sorry, the ST/X HTML reader is not
included in this release.
Please use firefox, konqueror, internet explorer or any
other HTML viewer to see the documentation.
The documentation is found in the ''doc/online'' directory.'.
"Modified: / 25.2.1998 / 21:24:20 / cg"
! !
!AbstractLauncherApplication methodsFor:'private-settings callBacks'!
changeViewStyleTo:newStyle
newStyle notNil ifTrue:[
self withWaitCursorDo:[
(transcript ? 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 ...)"
^ LauncherDialogs 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 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"
|oldOrigin contents builder newLauncher|
oldOrigin := self window origin.
transcript notNil ifTrue:[contents := transcript endEntry; list].
builder := self class openAt:oldOrigin.
builder window waitUntilVisible; origin:oldOrigin.
newLauncher := builder application.
transcript notNil ifTrue:[
newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor.
].
^ newLauncher
"Modified: / 4.8.1998 / 17:08:33 / cg"
! !
!AbstractLauncherApplication methodsFor:'queries'!
bugReporterAvailable
^ BugGUI notNil
or:[ Expecco::ExpeccoNetAPI notNil ]
!
hasPDALauncher
^ PDALauncher notNil
!
processName
"for monitors only - my name"
^ 'ST/X Launcher'
!
remoteImageBrowserAvailable
^ SmalltalkShareClient notNil and:[RemoteImage notNil]
!
transcript
"my transcript"
transcript isNil ifTrue:[
^ Transcript current
].
^ transcript
!
windowTreeViewAvailable
^ false "/ WindowTreeView notNil
! !
!AbstractLauncherApplication methodsFor:'settings dialog'!
openSettings
|settingsApp wg proc|
OpenSettingsDialog notNil ifTrue:[
(wg := OpenSettingsDialog windowGroup) notNil ifTrue:[
(proc := wg process) notNil ifTrue:[
proc isDead ifFalse:[
OpenSettingsDialog window raiseDeiconified.
^ self.
]
]
].
OpenSettingsDialog := nil.
].
settingsApp := SettingsDialog new.
settingsApp requestor:self.
settingsApp installSettingsEntries:(self class allSettingsList).
"/ settingsApp requestor:self.
OpenSettingsDialog := settingsApp.
settingsApp allButOpen.
settingsApp window label:(resources string:'ST/X Settings').
settingsApp openWindow.
!
settingsClosed
OpenSettingsDialog := nil.
! !
!AbstractLauncherApplication methodsFor:'startup & release'!
addTopViewsToCurrentProject
"ignored here - the launcher is always global (i.e. not project private)."
^ self
!
closeDownViews
OpenLaunchers remove:self ifAbsent:nil.
super closeDownViews
!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
OpenLaunchers isNil ifTrue:[
OpenLaunchers := IdentitySet new.
].
OpenLaunchers add:self
!
reOpen
"reopen a new launcher.
for now (since style & language settings currently do
not affect living views ...)"
self reopenLauncher "/ WARNING: bad design: Message known in LauncherDialogs
"Modified: / 31.7.1998 / 22:48:12 / cg"
!
requestForWindowClose
"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' 'Close' 'Exit'))
default:3.
answer isNil ifTrue:[
"/ cancel
^ false
].
answer ifFalse:[
^ true
].
self exit
"Modified: / 20.5.1999 / 17:24:47 / 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
"open an HTML browser on the 'LICENCE' document"
self withWaitCursorDo:[
|lang doc|
Smalltalk releaseIdentification = 'ST/X_free_demo_vsn' ifTrue:[
doc := 'english/LICENCE_DEMO_STX.html'
] ifFalse:[
((lang := UserPreferences current language) = 'de'
or:[lang = 'german']) ifTrue:[
doc := 'german/LICENCE_STX.html'
] ifFalse:[
doc := 'english/LICENCE_STX.html'
].
].
doc := resources at:'LICENCEFILE' default:doc.
self showDocumentation:('../' , doc)
]
"Created: / 5.2.1998 / 21:43:19 / cg"
"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)"
UserPreferences systemBrowserClass
browseMethods:(WrappedMethod allInstances)
title:'All breakPointed/traced methods'
!
browseImplementors
"open an implementors- browser after asking for a selector"
|selector|
selector := Dialog
requestSelector:(resources string:'Browse implementors of (Tab for completion):')
okLabel:(resources string:'Browse')
initialAnswer:''.
selector size > 0 ifTrue:[
self withWaitCursorDo:[
UserPreferences systemBrowserClass browseImplementorsMatching:selector
]
].
"Modified: / 17.11.2001 / 16:33:28 / cg"
!
browseResources
"open a resource- browser after asking for a resource string"
|box resourceHolder valueHolder component rsrc value t anyString|
anyString := resources string:'* any *'.
resourceHolder := ValueHolder newString.
valueHolder := '*' asValue.
box := DialogBox new.
box label:(resources string:'Resource search:').
component := box addTextLabel:(resources stringWithCRs:'Search for methods which contain a\particular resource specification').
component adjust:#left.
box addVerticalSpace:10.
component := box addTextLabel:(resources stringWithCRs:'Resource symbol (empty for any; no matchPattern allowed):').
component adjust:#left.
component := box addComboBoxOn:resourceHolder tabable:true.
component list:((Array with:anyString) , #('canvas' 'menu' 'keyboard' 'style' 'image' 'programMenu' '-' 'obsolete' 'needsFix')).
component := box addTextLabel:(resources stringWithCRs:'Resource value (* for any; matchPattern is allowed):').
component adjust:#left.
box addInputFieldOn:valueHolder tabable:true.
box addVerticalSpace:10.
box addHelpButtonFor:'programming/language.html#RESOURCEDEFS'.
box addAbortAndOkButtons.
box open.
box destroy.
box accepted ifTrue:[
rsrc := resourceHolder value.
value := valueHolder value.
(rsrc size == 0 or:[rsrc = '*' or:[rsrc = anyString]]) ifTrue:[
t := 'methods with any resource'.
rsrc := nil
] ifFalse:[
t := 'methods with #' , rsrc , '-resource'.
rsrc := rsrc withoutSeparators asSymbol
].
(value size == 0 or:[value = '*']) ifTrue:[
t := t , ' and any value'.
value := nil
] ifFalse:[
t := t , ' and value ' , value.
].
self withWaitCursorDo:[
UserPreferences systemBrowserClass
browseForResource:rsrc
containing:value
in:(Smalltalk allClasses)
title:t
]
].
!
browseSenders
"open a senders- browser after asking for a selector"
|selector|
selector := Dialog
requestSelector:(resources string:'Browse Senders of (Tab for Completion):')
okLabel:(resources string:'Browse')
initialAnswer:''.
selector size > 0 ifTrue:[
self withWaitCursorDo:[
UserPreferences systemBrowserClass
browseAllCallsOn:selector
]
].
"Modified: / 17.11.2001 / 16:33:42 / cg"
!
browseUnboundGlobals
"open a browser on methods refering to unbound global variables"
self withWaitCursorDo:[
UserPreferences systemBrowserClass
browseReferendsOfUnboundGlobalsWithTitle:(resources string:'References to unbound global variables')
warnIfNone:true
]
!
browseUndeclared
"open a browser on methods refering to undeclared variables"
self withWaitCursorDo:[
UserPreferences systemBrowserClass
browseReferendsOf:(Smalltalk undeclaredPrefix , '*')
title:(resources string:'References to undeclared variables')
warnIfNone:true
]
!
clearUndeclaredVariables
"remove all undeclared variables"
Smalltalk clearUndeclaredVariables
!
newSystemBrowserClass
|newSystemBrowserClass|
newSystemBrowserClass := Tools::NewSystemBrowser ? NewSystemBrowser.
newSystemBrowserClass isNil ifTrue:[
self warn:'This needs the NewSystemBrowser to be loaded.'.
AbortOperationRequest raise.
].
^ newSystemBrowserClass
!
removeAllBreakAndTracePoints
"remove all break- and trace points"
self
withCursor:Cursor execute
do:[ MessageTracer cleanup]
!
startClassBrowser
"open a classBrowser; asks for class"
UserPreferences systemBrowserClass askThenBrowseClass
!
startClassBrowserOnChangedClasses
"open a classBrowser on the changeSet"
self newSystemBrowserClass openOnClassesInChangeSet
!
startClassBrowserOnChangedMethods
"open a classBrowser on the changeSet"
self newSystemBrowserClass openOnMethodsInChangeSet
!
startClassBrowserOnChanges
"open a classBrowser on the changeSet"
^ self startClassBrowserOnChangedClasses
!
startClassHierarchyBrowser
"open a classHierarchyBrowser; asks for class"
UserPreferences systemBrowserClass askThenBrowseClassHierarchy
!
startFullClassBrowser
"open a fullClass systemBrowser; asks for class"
UserPreferences systemBrowserClass askThenBrowseFullClassProtocol
!
startRemoteImageBrowser
"open a remoteImage browser; asks for hostname.
The remote host must have an st/x running with remote browsing enabled.
Sorry, for now, only the old browser supports remote browsing."
|hostName|
hostName := Dialog request:'Remote Host:'.
hostName isEmptyOrNil ifTrue:[^ self].
SystemBrowser openOnRemoteImageOnHost:hostName port:nil.
!
startSnapshotImageBrowser
"open a snapshotImage browser; asks for filename.
Sorry, for now, only the old browser supports remote browsing."
|imageFileName|
imageFileName := Dialog requestFileName:'Name of Snapshot Image File:' default:'st.img' pattern:'*.img;*.sav'.
imageFileName isEmptyOrNil ifTrue: [^ self ].
SystemBrowser openOnSnapShotImage:imageFileName
! !
!AbstractLauncherApplication methodsFor:'user actions-demos'!
startPDALauncher
self startRemoteLauncherWithSetup:[:newDisplay | newDisplay bePDA].
!
startRemoteLauncher
self startRemoteLauncherWithSetup:[:newDisplay | ].
!
startRemoteLauncherWithSetup:aSetupBlock
|host remoteDisplay remoteDisplayClass|
host := Dialog
request:(resources string:'Remote Launcher on which display:')
initialAnswer:'{hostName}:0'
initialSelection:(1 to:10).
host size > 0 ifTrue:[
(host includes:$:) ifFalse:[
host := (host , ':0')
].
remoteDisplayClass := XWorkstation.
"/ "/ Q: should we allow GL graphics on the remote display
"/ "/ (Problem: the GL library is not threadsafe, when multiple-display connections
"/ "/ are open - leading to mixing output between views ...)
"/
"/ "/ only simulated GL can be done remote (i.e. not on SGI)
"/ (Screen current supportsGLDrawing
"/ and:[Screen current isTrueGL not])
"/ ifTrue:[
"/ remoteDisplayClass := GLXWorkstation.
"/ ].
[
remoteDisplay := remoteDisplayClass newDispatchingFor:host.
] on:Screen deviceOpenErrorSignal do:[:ex|
self warn:'Could not connect to display: ''' , host , '''.'.
^ self
].
aSetupBlock value:remoteDisplay.
Screen currentScreenQuerySignal
answer:remoteDisplay
do:[
self class open.
]
].
"Created: / 10.9.1998 / 11:48:42 / cg"
! !
!AbstractLauncherApplication methodsFor:'user actions-file'!
exit
"saves a snapshot image and exits, after asking for a fileName"
|fileName saveAndExit box|
box := EnterBox2 title:(resources string:'Save image before exiting?')
okText:(resources string:'Exit')
abortText:(resources string:'Cancel')
action:[:str | saveAndExit := false].
box label: (resources string:'Exiting ST/X').
box initialText: ObjectMemory nameForSnapshot.
box okText2:(resources string:'Save & Exit') action2:[:str|fileName := str. saveAndExit := true].
box showAtPointer.
saveAndExit notNil ifTrue:[
[
saveAndExit ifTrue:[
self saveImageAs:fileName
].
Smalltalk exit.
] on:SnapshotError do:[:ex|
"do not exit when snapshot writing fails"
self warn:ex description.
]
]
"Modified: / 23.4.1998 / 18:37:46 / cg"
!
packageDialog
"opens a package dialog"
^ LauncherDialogs packageDialog
"Modified: / 31.7.1998 / 17:33:24 / cg"
!
saveImageAs: aFileName
"save image in aFilename.
Sender has to handle SnapshotError"
aFileName notNil ifTrue:[
self withCursor:Cursor write do:[
ObjectMemory snapShotOn:aFileName
].
].
! !
!AbstractLauncherApplication methodsFor:'user actions-help'!
showBookPrintDocument
"open an HTML browser on the 'book'-printing document"
self showDocumentation:'BOOK.html'
!
showCredits
self showDocumentation:'Credits.html'
!
showPortInfo
|portNr url|
portNr := Dialog request:'Port Number:'.
portNr isEmptyOrNil ifTrue:[^ self].
url := 'http://www.grc.com/port_' , portNr printString , '.htm'.
self withWaitCursorDo:[
HTMLDocumentView openFullOnURL:url.
]
!
showRFC
|rfc url|
rfc := Dialog request:'RFC Number ("index" for list):'.
rfc isEmptyOrNil ifTrue:[^ self].
rfc = 'index' ifTrue:[
url := 'http://www.faqs.org/rfcs/'.
] ifFalse:[
url := 'http://www.faqs.org/rfcs/rfc' , rfc printString , '.html'.
].
self withWaitCursorDo:[
HTMLDocumentView openFullOnURL:url.
]
!
showTipOfTheDay
"open a tip-of-the-day window"
DidYouKnowTipViewer open
!
startClassDocumentation
"open an HTML browser on the 'classDoc/TOP' document"
self showDocumentation:'classDoc/TOP.html'
!
startDocumentationIndex
"open an HTML browser on the 'index' document"
self showDocumentation:'index.html'
!
startDocumentationTool
"open an HTML browser on the 'TOP' document"
self showDocumentation:'TOP.html'
!
startProgrammersGuide
"open an HTML browser on the 'programers guide' document"
self showDocumentation:'programming/TOP.html'
!
startSmalltalkTutorial
"open an HTML browser on 'doc\books\JoyOfST\IntroToST.html' document"
self showDocumentation:'books/JoyOfST/IntroToST.html'
!
startToolsDocumentation
"open an HTML browser on the 'tools/TOP' document"
self showDocumentation:'tools/TOP.html'
!
startTutorial
"open an HTML browser on the 'getstart/tutorial.html' document"
self showDocumentation:'getstart/tutorial.html'
!
startWhatsNewDocumentation
"open an HTML browser on the 'whatsNew.html' document"
self showDocumentation:'whatsNew.html'
!
startWhatsNewSTX
"open an HTML browser on the 'relNotes.html' document"
self showDocumentation:'newFeatures.html'
! !
!AbstractLauncherApplication methodsFor:'user actions-system'!
compressingGarbageCollect
"perform a compressing garbageCollect"
self withWaitCursorDo:[ObjectMemory verboseGarbageCollect]
!
flushCachedResources
"flush all cached resources (e.g. translations)."
Smalltalk changed:#Language. "this flushes everything"
!
garbageCollect
"perform a non-compressing garbageCollect"
self withWaitCursorDo:[ObjectMemory reclaimSymbols]
!
objectModuleDialog
"opens a moduleInfo dialog"
Tools::ObjectModuleInformation notNil ifTrue:[
self openApplication:#'Tools::ObjectModuleInformation'.
^ self.
].
^ LauncherDialogs objectModuleDialog
"Modified: / 31.7.1998 / 17:33:24 / cg"
!
startStopEventTrace
"start/stop event tracing for a particular view"
|v wg|
v := Screen current viewFromUser.
v notNil ifTrue:[
v := v topView.
wg := v windowGroup.
wg notNil ifTrue:[
"/
"/ toggle eventTrace in its windowGroup
"/
wg traceEvents:(wg traceEvents not)
]
]
! !
!AbstractLauncherApplication methodsFor:'user actions-tools'!
inspectGlobalVariables
"inspect globals"
WorkspaceApplication notNil ifTrue:[
"/ looks nicer...
WorkspaceApplication openWithGlobalsInspector.
^ self.
].
Smalltalk inspect
!
inspectWorkspaceVariables
"inspect workspace variables"
WorkspaceApplication notNil ifTrue:[
"/ looks nicer...
WorkspaceApplication openWithWorkspaceVariableInspector.
^ self.
].
"/ Workspace workspaceVariables inspect
!
newProject
"creates a new project & opens a projectView for it"
Project notNil ifTrue: [(ProjectView for: Project new) open]
!
openEvaluationWorkspace
WorkspaceApplication notNil ifTrue:[
^ WorkspaceApplication openEvaluationWorkspace
].
^ self openApplication:Workspace
!
openMyWorkspace
WorkspaceApplication notNil ifTrue:[
^ WorkspaceApplication openMyWorkspace
].
^ self openApplication:Workspace
!
openSystemWorkspace
WorkspaceApplication notNil ifTrue:[
^ WorkspaceApplication openSystemWorkspace
].
^ self openApplication:Workspace
!
openTerminal
TerminalApplication notNil ifTrue:[
^ TerminalApplication open
].
self openApplication:#VT100TerminalView
!
openWorkspace
WorkspaceApplication notNil ifTrue:[
^ WorkspaceApplication open
].
^ self openApplication:Workspace
!
removeAllWorkspaceVariables
"remove workspace variables"
Workspace removeAllWorkspaceVariables
!
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 notNil ifTrue:[
transcript showCR:'No such project.'
]
] ifFalse:[
project showViews.
Project current:project
]
].
box open.
box destroy
]
!
startBugMessages
"open the bug reporter"
Expecco::ExpeccoNetAPI notNil ifTrue:[
Expecco::ExpeccoNetAPI reportCodeReview.
^ self
].
BugGUI notNil ifTrue:[
self openApplication:#BugGUI
].
"Modified: / 17.10.1998 / 14:38:18 / cg"
!
startChangeSetBrowser
"open a change Set Browser"
ChangeSetBrowser open
"Created: / 5.11.2001 / 18:04:05 / cg"
!
startChangesBrowser
"open a changebrowser - either new or old GUI, depending on userPrefs"
self openApplication:(UserPreferences current changesBrowserClass)
"Modified: / 17.10.1998 / 14:38:18 / cg"
!
startInternationalLanguageTranslationEditor
"open the language-string editor (english/german/spanish etc.)"
self openApplication:#'Tools::InternationalLanguageTranslationEditor'
!
startNewChangesBrowser
"opens the new changeBrowser"
self openApplication:#NewChangesBrowser
"Created: / 6.6.1998 / 19:47:26 / cg"
!
startNewLauncher
"opens the new launcher"
NewLauncher isNil ifTrue:[
^ self warn:'The NewLauncher is not available in this release.'
].
NewLauncher openAt:(self window origin)
!
startOldChangesBrowser
"opens the old changeBrowser"
self openApplication:#ChangesBrowser
"Created: / 6.6.1998 / 19:47:26 / cg"
!
startOldLauncher
"opens the old launcher"
Launcher isNil ifTrue:[
^ self warn:'The (Old)Launcher is not available in this release.'
].
Launcher openAt:(self window origin)
!
startSUnitTestRunner
"open the SUnit test runner"
self openApplication:#TestRunner
"Modified: / 17.10.1998 / 14:38:18 / cg"
!
startSmaCCParserGenerator
"open the SmaCC-ParserGenerator UI"
self openApplication:#'SmaCC::SmaCCParserGenerator'
"Modified: / 17.10.1998 / 14:38:18 / cg"
! !
!AbstractLauncherApplication methodsFor:'user actions-windows'!
askForAnotherDisplay
"ask for some other display"
|displayName|
displayName := Dialog request:'Display:' initialAnswer:(Screen default displayName).
displayName isEmptyOrNil ifTrue:[^ nil].
^ XWorkstation newDispatchingFor:displayName.
!
deIconifyAllWindows
|setOfViews currentScreen|
setOfViews := Project current views asIdentitySet.
setOfViews addAll:(Project defaultProject views).
currentScreen := Screen current.
setOfViews do:[:aTopView |
aTopView device == currentScreen ifTrue:[
aTopView expand
].
].
"
Transcript topView application deIconifyAllWindows
"
!
findAndDestroyWindow
"find a window (by name) and destroy it"
|v|
v := self findWindow:'Select window to close:'.
v notNil ifTrue:[v destroy]
!
findAndMigrateWindow
"find a window (by name) and migrate it to some other display"
|possibleGroups v|
possibleGroups := WindowGroup allInstances select:[:eachGroup |
eachGroup graphicsDevice == Screen current
and:[eachGroup isModal not
and:[eachGroup topViews size > 0]]].
possibleGroups isEmpty ifTrue:[
self information:'No windows found which could be migrated to some other display.'.
^ self
].
v := self findWindow:'Select window to migrate:' windowGroupFilter:possibleGroups.
v notNil ifTrue:[
self migrateWindow:v topView
]
!
findAndMigrateWindowBack
"find a window (by name) and migrate it back to this display"
|possibleGroups v|
possibleGroups := WindowGroup allInstances select:[:eachGroup |
eachGroup graphicsDevice ~~ Screen current
and:[eachGroup isModal not
and:[eachGroup topViews size > 0]]].
possibleGroups isEmpty ifTrue:[
self information:'No windows are open on any other display.'.
^ self
].
v := self findWindow:'Select window to migrate back:' windowGroupFilter:possibleGroups.
v notNil ifTrue:[
v windowGroup migrateTo:(Screen current)
]
!
findAndRaiseWindow
"find a window (by name) and raise it"
|v|
v := self findWindow:'Select window 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."
self window sensor ctrlDown ifTrue:[
^ self fullScreenHardcopyUngrabbed
].
Processor
addTimedBlock:[
self
saveScreenImage:(Image fromScreen)
defaultName:'screen'
]
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1)
!
fullScreenHardcopyUngrabbed
"after a second (to allow redraw of views under menu ...),
save the contents of the whole screen."
Processor
addTimedBlock:[
|display image|
display := Screen current.
image := Image
fromScreen:(0@0 corner:(display extent))
on:display
grab:false.
self
saveScreenImage:image
defaultName:'screen'
]
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse: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
]
]
!
migrateAllWindows
"migrate all views to some other display"
|anotherDisplay toMigrate|
[
anotherDisplay := self askForAnotherDisplay.
anotherDisplay isNil ifTrue:[
^ self.
].
] on:Screen deviceOpenErrorSignal do:[:ex|
^ self warn:'Cannot open display: ', ex parameter.
].
toMigrate := WindowGroup allInstances
select:[:each | each graphicsDevice == Screen current
and:[each topViews size > 0
and:[each isModal not]]
].
toMigrate do:[:eachGroup |
eachGroup migrateTo:anotherDisplay
]
!
migrateWindow:aWindow
"migrate a view to some other display"
aWindow windowGroup isModal ifTrue:[
self warn:'Sorry - I cannot migrate a modalBox; please migrate the owning View.'.
^ self
].
self migrateWindow:aWindow withBackOption:(self confirm:'Show ''Return Back'' Button on the other display ?')
!
migrateWindow:aWindow withBackOption:withBackOption
"migrate a view to some other display"
|anotherDisplay wg here b|
aWindow isTopView ifFalse:[
self information:'Cannot migrate this window'.
^ self
].
[
anotherDisplay := self askForAnotherDisplay.
anotherDisplay isNil ifTrue:[
^ self.
].
] on:Screen deviceOpenErrorSignal do:[:ex|
^ self warn:'Cannot open display: ', ex parameter.
].
wg := aWindow windowGroup.
wg migrateTo:anotherDisplay.
withBackOption ifTrue:[
here := Screen current.
b := Button onDevice:anotherDisplay.
b label:'Return window back to ' , here displayName.
b action:[ wg migrateTo:here. b destroy. ].
b origin:0@0.
b open.
].
!
openWindowTreeInspector
Tools::ViewTreeInspectorApplication openInPickMode
!
screenHardcopy
"after a second (to allow redraw of views under menu ...),
let user specify a rectangular area on the screen
and save its contents."
Processor
addTimedBlock:[
|area|
[Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05].
area := Rectangle fromUser.
(area width > 0 and:[area height > 0]) ifTrue:[
Delay waitForSeconds:2.
self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
]
]
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1)
"Modified: / 18.8.1998 / 15:00:42 / cg"
!
screenHardcopyWithDelay
"after some time (to allow user to pull menu or similar...),
let user specify a rectangular area on the screen
and save its contents."
|area|
[Screen current leftButtonPressed] whileTrue:[Delay waitForSeconds:0.05].
area := Rectangle fromUser.
(area width > 0 and:[area height > 0]) ifTrue:[
[
10 timesRepeat:[ Screen current beep. Delay waitForSeconds:1. ].
self saveScreenImage:(Image fromScreen:area) defaultName:'hardcopy'
] fork
]
!
showFlyByWindowInformation
"show infos about window under the mouse pointer"
FlyByWindowInformation notNil ifTrue:[
[
FlyByWindowInformation shownInformationOfViewUnderMouseUntilButtonIsPressed
] fork.
]
!
startWindowTreeView
"open a windowTree (on a picked 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
]
!
startWindowTreeViewForAll
"open a windowTree on all views in the system"
|v|
WindowTreeView isNil ifTrue:[
^ self warn:'The WindowTreeView is not available in this release.'
].
WindowTreeView openOnAll
!
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:[
v topView raise.
v topView makeFullyVisible.
Delay waitForSeconds:0.5. "/ give view a chance to redraw itself.
self saveScreenImage:(Image fromView:(v topView)) defaultName:'hardcopy'
]
]
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1)
!
viewInspect
"let user pick a view and inspect it. Only smalltalk views are allowed"
|v|
(v := self pickAView) notNil ifTrue:[
v inspect
]
!
viewMigrate
"let user pick a view and migrate it to some other display"
|v|
(v := self pickAView) notNil ifTrue:[
self migrateWindow:v topView
]
!
widgetHardcopy
"after a second (to allow redraw of views under menu ...),
let user specify a widget and save its contents."
Processor
addTimedBlock:[
|v|
(v := Screen current viewFromUser) notNil ifTrue:[
self saveScreenImage:(Image fromView:v) defaultName:'hardcopy'
]
]
afterSeconds:(self window sensor shiftDown ifTrue:5 ifFalse:1)
"Created: / 21.8.1998 / 20:44:12 / cg"
! !
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs'!
communicationsSettings
"open a dialog on communications settings"
|box check in resources y acceptChannel
hasRDoitServer rDoitServerPort
rDoitsEnabled rDoitLogging rDoitErrorLogging rDoitErrorDebugging
org_rDoitsEnabled org_rDoitLogging org_rDoitErrorLogging org_rDoitErrorDebugging org_rDoitServerPort
hasRemoteBrowsingSupport remoteBrowsingEnabled org_remoteBrowsingEnabled
hasWindowMigrationServer windowMigrationAuthenticate windowMigrationPassword
windowMigrationEnabled
org_windowMigrationEnabled org_windowMigrationAuthenticate org_windowMigrationPassword
hasHTTPServer httpServerRunning httpServerFileRoot httpServerHomeURL
httpServerPort httpServerLogFile hasSwiki swikiEnabled swikiRoot
allowEmbedded hasSoap soapEnabled
org_httpServerRunning org_httpServerFileRoot org_httpServerHomeURL
org_httpServerPort org_swikiRoot org_swikiEnabled org_httpServerLogFile
org_allowEmbedded org_soapEnabled
osiACSEPresent osiROSEPresent osiCMISEPresent
osiACSEErrorLogging osiACSEConnectionLogging osiACSEDataLogging
osiROSEErrorLogging osiROSEResponseLogging osiROSEInvokationLogging
osiCMISEErrorLogging osiCMISEMessageLogging defaultServer
|
self warn:'Please use HTTPServer Settings in the new SettingsDialog'.
acceptChannel := false asValue.
resources := self owningClass classResources.
defaultServer := HTTPServer defaultServer.
"/
"/ extract relevant remoteBrowsing settings ...
"/
remoteBrowsingEnabled := false.
(hasRemoteBrowsingSupport := SmalltalkShareServer notNil) ifTrue:[
SmalltalkShareServer isLoaded ifTrue:[
remoteBrowsingEnabled := SmalltalkShareServer serverRunning.
].
].
org_remoteBrowsingEnabled := remoteBrowsingEnabled.
remoteBrowsingEnabled := remoteBrowsingEnabled asValue.
"/
"/ extract relevant windowMigration settings ...
"/
windowMigrationEnabled := windowMigrationAuthenticate := false.
(hasWindowMigrationServer := WindowMigrationServer notNil) ifTrue:[
WindowMigrationServer isLoaded ifTrue:[
windowMigrationEnabled := WindowMigrationServer serverRunning.
].
windowMigrationPassword := WindowMigrationServer password.
windowMigrationAuthenticate := windowMigrationPassword notNil.
].
org_windowMigrationEnabled := windowMigrationEnabled.
windowMigrationEnabled := windowMigrationEnabled asValue.
org_windowMigrationAuthenticate := windowMigrationAuthenticate.
windowMigrationAuthenticate := windowMigrationAuthenticate asValue.
org_windowMigrationPassword := windowMigrationPassword.
windowMigrationPassword := windowMigrationPassword asValue.
"/
"/ extract relevant rdoit settings ...
"/
rDoitsEnabled := rDoitLogging := rDoitErrorLogging := false.
(hasRDoitServer := RDoItServer notNil) ifTrue:[
RDoItServer isLoaded ifTrue:[
rDoitsEnabled := RDoItServer serverRunning.
rDoitLogging := RDoItServer isLogging.
rDoitErrorLogging := RDoItServer isErrorLogging.
rDoitErrorDebugging := RDoItServer isErrorCatching not.
rDoitServerPort := RDoItServer defaultPortNumberOrPath.
]
].
org_rDoitsEnabled := rDoitsEnabled.
org_rDoitLogging := rDoitLogging.
org_rDoitErrorLogging := rDoitErrorLogging.
org_rDoitErrorDebugging := rDoitErrorDebugging.
org_rDoitServerPort := rDoitServerPort.
rDoitServerPort := rDoitServerPort asValue.
rDoitsEnabled := rDoitsEnabled asValue.
rDoitLogging := rDoitLogging asValue.
rDoitErrorLogging := rDoitErrorLogging asValue.
rDoitErrorDebugging := rDoitErrorDebugging asValue.
"/
"/ extract http-server settings
"/
hasHTTPServer := httpServerRunning := false.
(hasHTTPServer := HTTPServer notNil) ifTrue:[
HTTPServer isLoaded ifTrue:[
httpServerRunning := HTTPServer isRunning.
"/ httpServerFileRoot := HTTPServer fileRoot.
httpServerHomeURL := HTTPServer homeURL.
httpServerPort := HTTPServer port.
httpServerLogFile := HTTPServer logFile.
].
].
org_httpServerRunning := httpServerRunning.
httpServerRunning := httpServerRunning asValue.
org_httpServerFileRoot := httpServerFileRoot.
httpServerFileRoot := httpServerFileRoot asValue.
org_httpServerHomeURL := httpServerHomeURL.
httpServerHomeURL := httpServerHomeURL asValue.
org_httpServerPort := httpServerPort.
httpServerPort := httpServerPort asValue.
org_httpServerLogFile := httpServerLogFile.
httpServerLogFile := httpServerLogFile asValue.
httpServerRunning
onChangeEvaluate:[
"/ httpServerFileRoot value:(HTTPServer fileRoot).
httpServerHomeURL value:(HTTPServer homeURL).
httpServerPort value:(HTTPServer port).
httpServerLogFile value:(HTTPServer logFile)
].
hasSwiki := false.
swikiEnabled := false.
soapEnabled := false.
(hasSwiki := PWS::SwikiAction notNil) ifTrue:[
PWS::SwikiAction isLoaded ifTrue:[
(HTTPServer notNil and:[HTTPServer isLoaded]) ifTrue:[
swikiEnabled := (defaultServer notNil and:[defaultServer hasServiceForServiceClass:SwikiAction]).
swikiRoot := PWS::SwikiAction serverDirectory.
]
].
].
(hasSoap := SOAP::SoapHttpModule notNil) ifTrue:[
SOAP::SoapHttpModule isLoaded ifTrue:[
(HTTPServer notNil and:[HTTPServer isLoaded]) ifTrue:[
soapEnabled := HTTPServer soapEnabled.
]
].
].
org_swikiRoot := swikiRoot.
org_swikiEnabled := swikiEnabled.
org_soapEnabled := soapEnabled.
swikiRoot := swikiRoot asValue.
swikiEnabled := swikiEnabled asValue.
soapEnabled := soapEnabled asValue.
swikiEnabled
onChangeEvaluate:[
swikiRoot value:(PWS::SwikiAction serverDirectory).
].
allowEmbedded := defaultServer notNil and:[defaultServer hasServiceForServiceClass:HTTPEmbeddedApplicationService].
org_allowEmbedded := allowEmbedded.
allowEmbedded := allowEmbedded asValue.
"/
"/ osi settings ...
"/
osiACSEPresent := OSI::ACSE notNil and:[OSI::ACSE isLoaded].
osiROSEPresent := OSI::ROSE notNil and:[OSI::ROSE isLoaded].
osiCMISEPresent := OSI::CMISE notNil and:[OSI::CMISE isLoaded].
osiACSEPresent ifTrue:[
osiACSEErrorLogging := OSI::ACSE errorLogging asValue.
osiACSEConnectionLogging := OSI::ACSE connectionLogging asValue.
osiACSEDataLogging := OSI::ACSE dataLogging asValue.
].
osiROSEPresent ifTrue:[
osiROSEErrorLogging := OSI::ROSE errorLogging asValue.
osiROSEInvokationLogging := OSI::ROSE invocationLogging asValue.
osiROSEResponseLogging := OSI::ROSE responseLogging asValue.
].
osiCMISEPresent ifTrue:[
osiCMISEErrorLogging := OSI::CMISE errorLogging asValue.
osiCMISEMessageLogging := OSI::CMISE messageLogging asValue.
].
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Communication settings').
box addTextLabel:(resources string:'Remote browsing').
check := box addCheckBox:(resources string:'Remote browsing enabled') on:remoteBrowsingEnabled.
hasRemoteBrowsingSupport ifFalse:[
check disable
].
box addHorizontalLine.
box addTextLabel:(resources string:'Window migration').
check := box addCheckBox:(resources string:'Window migration enabled') on:windowMigrationEnabled.
hasWindowMigrationServer ifFalse:[
check disable
].
check := box addCheckBox:(resources string:'Password check') on:windowMigrationAuthenticate.
check enableChannel:windowMigrationEnabled.
hasWindowMigrationServer ifFalse:[
check disable
].
box leftIndent:20.
in := box
addLabelledInputField:(resources string:'Password:')
adjust:#right
on:nil
tabable:true
separateAtX:0.3.
in bePassword.
in model:windowMigrationPassword.
in acceptChannel:acceptChannel.
in enableChannel:windowMigrationAuthenticate.
box leftIndent:0.
box addHorizontalLine.
box addTextLabel:'RDoIt Server'.
check := box addCheckBox:(resources string:'Remote doits enabled') on:rDoitsEnabled.
hasRDoitServer ifFalse:[
check disable
].
box leftIndent:20.
rDoitsEnabled onChangeEvaluate:[ rDoitsEnabled value ifTrue:[
rDoitServerPort value isNil ifTrue:[
rDoitServerPort value:(RDoItServer defaultPortNumberOrPath printString).
]
]
].
in := box
addLabelledInputField:(resources string:'Port:')
adjust:#right
on:nil
tabable:true
separateAtX:0.3.
"/ in converter:(PrintConverter new initForNumber).
in model:rDoitServerPort.
in acceptChannel:acceptChannel.
in enableChannel:rDoitsEnabled.
y := box yPosition.
check := box addCheckBox:(resources string:'Log errors') on:rDoitErrorLogging.
check width:0.4.
check enableChannel:rDoitsEnabled.
hasRDoitServer ifFalse:[
check disable
].
box yPosition:y.
check := box addCheckBox:(resources string:'Log requests') on:rDoitLogging.
check left:0.4; width:0.4.
check enableChannel:rDoitsEnabled.
hasRDoitServer ifFalse:[
check disable
].
check := box addCheckBox:(resources string:'Debug errors') on:rDoitErrorDebugging.
check width:0.4.
check enableChannel:rDoitsEnabled.
hasRDoitServer ifFalse:[
check disable
].
box leftIndent:0.
box addHorizontalLine.
box addTextLabel:'HTTP Server'.
check := box addCheckBox:(resources string:'Serving HTTP Requests') on:httpServerRunning.
hasHTTPServer ifFalse:[
check disable
].
box leftIndent:20.
in := box
addLabelledInputField:(resources string:'Port:')
adjust:#right
on:nil
tabable:true
separateAtX:0.3.
in converter:(PrintConverter new initForNumber).
in model:httpServerPort.
in acceptChannel:acceptChannel.
in enableChannel:httpServerRunning.
in := box
addLabelledInputField:(resources string:'Log File:')
adjust:#right
on:httpServerLogFile
tabable:true
separateAtX:0.3.
in acceptChannel:acceptChannel.
in enableChannel:httpServerRunning.
"/ in := box
"/ addLabelledInputField:(resources string:'File Root:')
"/ adjust:#right
"/ on:httpServerFileRoot
"/ tabable:true
"/ separateAtX:0.3.
"/ in acceptChannel:acceptChannel.
"/ in enableChannel:httpServerRunning.
in := box
addLabelledInputField:(resources string:'Home URL:')
adjust:#right
on:httpServerHomeURL
tabable:true
separateAtX:0.3.
in acceptChannel:acceptChannel.
in enableChannel:httpServerRunning.
check := box addCheckBox:(resources string:'Swiki enabled') on:swikiEnabled.
hasHTTPServer ifFalse:[
check disable
].
check enableChannel:httpServerRunning.
"/ box leftIndent:40.
in := box
addLabelledInputField:(resources string:'SwikiRoot:')
adjust:#right
on:swikiRoot
tabable:true
separateAtX:0.3.
in acceptChannel:acceptChannel.
in enableChannel:(BlockValue forLogical:httpServerRunning and:swikiEnabled).
check := box addCheckBox:(resources string:'Allow embedded ST applications') on:allowEmbedded.
hasHTTPServer ifFalse:[
check disable
].
check enableChannel:httpServerRunning.
check := box addCheckBox:(resources string:'Soap enabled') on:soapEnabled.
hasHTTPServer ifFalse:[
check disable
].
check enableChannel:httpServerRunning.
box leftIndent:0.
box addHorizontalLine.
box addTextLabel:(resources string:'OSI Protocols (addOn package)').
y := box yPosition.
check := box addCheckBox:(resources string:'Log %1 Errors' with:'ACSE') on:osiACSEErrorLogging.
check width:0.33.
osiACSEPresent ifFalse:[
check disable
].
box yPosition:y.
check := box addCheckBox:(resources string:'Connections') on:osiACSEConnectionLogging.
osiACSEPresent ifFalse:[
check disable
].
check left:0.33; width:0.33.
box yPosition:y.
check := box addCheckBox:(resources string:'Data Xfer') on:osiACSEDataLogging.
osiACSEPresent ifFalse:[
check disable
].
check left:0.66; width:0.34.
box addVerticalSpace.
y := box yPosition.
check := box addCheckBox:(resources string:'Log %1 Errors' with:'ROSE') on:osiROSEErrorLogging.
osiROSEPresent ifFalse:[
check disable
].
check width:0.33.
box yPosition:y.
check := box addCheckBox:(resources string:'Invoactions') on:osiROSEInvokationLogging.
osiROSEPresent ifFalse:[
check disable
].
check left:0.33; width:0.33.
box yPosition:y.
check := box addCheckBox:(resources string:'Responses') on:osiROSEResponseLogging.
osiROSEPresent ifFalse:[
check disable
].
check left:0.66; width:0.34.
box addVerticalSpace.
y := box yPosition.
check := box addCheckBox:(resources string:'Log %1 Errors' with:'CMISE') on:osiCMISEErrorLogging.
osiCMISEPresent ifFalse:[
check disable
].
check width:0.33.
box yPosition:y.
check := box addCheckBox:(resources string:'Messages') on:osiCMISEMessageLogging.
osiCMISEPresent ifFalse:[
check disable
].
check left:0.33; width:0.33.
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/communicationsSettings.html';
addAbortAndOkButtons.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
acceptChannel value:false; value:true.
hasRemoteBrowsingSupport ifTrue:[
remoteBrowsingEnabled := remoteBrowsingEnabled value.
(remoteBrowsingEnabled ~~ org_remoteBrowsingEnabled) ifTrue:[
remoteBrowsingEnabled ~~ SmalltalkShareServer serverRunning ifTrue:[
remoteBrowsingEnabled ifFalse:[
SmalltalkShareServer killAll
] ifTrue:[
SmalltalkShareServer start.
"/ must wait a bit; give it a chance to
"/ really start (before checking)
Delay waitForSeconds:0.5.
SmalltalkShareServer serverRunning ifFalse:[
self warn:'SmalltalkShareServer startup failed (see stderr).'
]
]
].
]
].
hasWindowMigrationServer ifTrue:[
windowMigrationEnabled := windowMigrationEnabled value.
windowMigrationAuthenticate := windowMigrationAuthenticate value.
windowMigrationPassword := windowMigrationPassword value.
(windowMigrationEnabled ~~ org_windowMigrationEnabled
or:[windowMigrationAuthenticate ~~ org_windowMigrationAuthenticate
or:[windowMigrationPassword ~~ org_windowMigrationPassword]]) ifTrue:[
windowMigrationAuthenticate ~~ org_windowMigrationAuthenticate ifTrue:[
windowMigrationAuthenticate ifFalse:[
WindowMigrationServer password:nil
] ifTrue:[
WindowMigrationServer password:windowMigrationPassword
].
].
windowMigrationEnabled ~~ WindowMigrationServer serverRunning ifTrue:[
windowMigrationEnabled ifFalse:[
WindowMigrationServer stop
] ifTrue:[
WindowMigrationServer start.
"/ must wait a bit; give it a chance to
"/ really start (before checking)
Delay waitForSeconds:0.5.
WindowMigrationServer serverRunning ifFalse:[
self warn:'WindowMigrationServer startup failed (see stderr).'
]
]
].
]
].
hasRDoitServer ifTrue:[
(rDoitLogging value ~~ org_rDoitLogging
or:[rDoitErrorDebugging value ~~ org_rDoitErrorDebugging
or:[rDoitErrorLogging value ~~ org_rDoitErrorLogging
or:[rDoitsEnabled value ~~ org_rDoitsEnabled
or:[rDoitServerPort value ~~ org_rDoitServerPort]]]]) ifTrue:[
(Integer readFrom:rDoitServerPort value onError:nil) isNil ifTrue:[
RDoItServer defaultPortNumberOrPath:rDoitServerPort value.
] ifFalse:[
RDoItServer defaultPortNumberOrPath:(Integer readFrom:rDoitServerPort value onError:nil).
].
RDoItServer logging:(rDoitLogging value).
RDoItServer errorLogging:(rDoitErrorLogging value).
RDoItServer errorCatching:(rDoitErrorDebugging value not).
rDoitsEnabled := rDoitsEnabled value.
rDoitsEnabled ~~ RDoItServer serverRunning ifTrue:[
rDoitsEnabled ifFalse:[
RDoItServer stop
] ifTrue:[
RDoItServer start.
"/ must wait a bit; give it a chance to
"/ really start (before checking)
Delay waitForSeconds:0.5.
RDoItServer serverRunning ifFalse:[
self warn:'RDoit startup failed (see stderr).'
]
]
].
].
].
(hasHTTPServer and:[HTTPServer isLoaded]) ifTrue:[
httpServerPort := httpServerPort value.
org_httpServerPort ~= httpServerPort ifTrue:[
"/ HTTPServer port:httpServerPort.
].
httpServerFileRoot := httpServerFileRoot value.
httpServerFileRoot size == 0 ifTrue:[
httpServerFileRoot := nil
].
org_httpServerFileRoot ~= httpServerFileRoot ifTrue:[
"/ HTTPServer fileRoot:httpServerFileRoot.
].
httpServerLogFile := httpServerLogFile value.
httpServerLogFile size == 0 ifTrue:[
httpServerLogFile := nil
].
"/ org_httpServerLogFile ~= httpServerLogFile ifTrue:[
"/ HTTPServer logFile:httpServerLogFile.
"/ ].
httpServerHomeURL := httpServerHomeURL value.
httpServerHomeURL size == 0 ifTrue:[
httpServerHomeURL := nil
].
org_httpServerHomeURL ~= httpServerHomeURL ifTrue:[
"/ HTTPServer defaultHomeURL:httpServerHomeURL.
].
httpServerRunning value ~~ org_httpServerRunning ifTrue:[
httpServerRunning value ifTrue:[
HTTPServer startServer
] ifFalse:[
HTTPServer stopServer
]
].
].
hasSwiki ifTrue:[
swikiRoot := swikiRoot value.
swikiRoot size == 0 ifTrue:[
swikiRoot := nil
].
org_swikiRoot ~= swikiRoot ifTrue:[
PWS::ServerAction serverDirectory:swikiRoot.
].
swikiEnabled value ~~ org_swikiEnabled ifTrue:[
swikiEnabled value ifTrue:[
HTTPServer setupMySwiki
] ifFalse:[
HTTPServer disableMySwiki
]
].
allowEmbedded value ~~ org_allowEmbedded ifTrue:[
defaultServer notNil ifTrue:[
HTTPEmbeddedApplicationService registerServiceOn:defaultServer.
].
].
].
hasSoap ifTrue:[
soapEnabled value ~~ org_soapEnabled ifTrue:[
defaultServer notNil ifTrue:[
soapEnabled value ifTrue:[
defaultServer setupSoap
] ifFalse:[
defaultServer disableSoap
]
]
].
].
osiACSEPresent ifTrue:[
OSI::ACSE errorLogging:osiACSEErrorLogging value.
OSI::ACSE connectionLogging:osiACSEConnectionLogging value.
OSI::ACSE dataLogging:osiACSEDataLogging value.
].
osiROSEPresent ifTrue:[
OSI::ROSE errorLogging:osiROSEErrorLogging value.
OSI::ROSE invocationLogging:osiROSEInvokationLogging value.
OSI::ROSE responseLogging:osiROSEResponseLogging value.
].
osiCMISEPresent ifTrue:[
OSI::CMISE errorLogging:osiCMISEErrorLogging value.
OSI::CMISE messageLogging:osiCMISEMessageLogging value.
].
].
box destroy
"Modified: / 28.6.1999 / 15:44:35 / stefan"
"Modified: / 20.1.2000 / 19:14:18 / cg"
!
compilerSettings
"open a dialog on compiler related settings"
|box warnings warnSTX warnUnderscore warnDollar warnOldStyle warnUnusedVars
allowDollar allowUnderscore allowSqueakExtensions allowQualifiedNames
allowDolphinExtensions allowOldStyleAssignment allowReservedWordsAsSelectors
immutableArrays
warnSTXBox warnUnderscoreBox warnOldStyleBox warnCommonMistakes warnCommonMistakesBox
warnCompatibility warnCompatibilityBox warnDollarBox warnUnusedVarsBox
stcCompilation compilationList stcCompilationOptions
historyLines fullHistoryUpdate
catchMethodRedefs catchClassRedefs keepSourceOptions keepSource
constantFoldingOptions constantFolding justInTimeCompilation
warnEnabler check component oldIndent supportsJustInTimeCompilation y
y2 fullDebugSupport yMax
compileLazy loadBinaries canLoadBinaries strings idx
resources stcSetupButt|
resources := self owningClass classResources.
canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
loadBinaries := Smalltalk loadBinaries asValue.
compileLazy := Autoload compileLazy asValue.
warnings := ParserFlags warnings asValue.
warnSTX := ParserFlags warnSTXSpecials asValue.
warnUnderscore := ParserFlags warnUnderscoreInIdentifier asValue.
warnDollar := ParserFlags warnDollarInIdentifier asValue.
warnOldStyle := ParserFlags warnOldStyleAssignment asValue.
warnCommonMistakes := ParserFlags warnCommonMistakes asValue.
warnCompatibility := ParserFlags warnPossibleIncompatibilities asValue.
warnUnusedVars := ParserFlags warnUnusedVars asValue.
allowUnderscore := ParserFlags allowUnderscoreInIdentifier asValue.
allowDollar := ParserFlags allowDollarInIdentifier asValue.
allowSqueakExtensions := ParserFlags allowSqueakExtensions asValue.
allowDolphinExtensions := ParserFlags allowDolphinExtensions asValue.
allowQualifiedNames := ParserFlags allowQualifiedNames asValue.
allowOldStyleAssignment := ParserFlags allowOldStyleAssignment asValue.
allowReservedWordsAsSelectors := ParserFlags allowReservedWordsAsSelectors asValue.
immutableArrays := ParserFlags 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 := #(default never).
strings := #('primitive code only' 'never').
idx := (stcCompilationOptions indexOf:(ParserFlags stcCompilation) ifAbsent:1).
stcCompilation := SelectionInList new list:(resources array:strings).
stcCompilation selectionIndex:idx.
(supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation)
ifTrue:[
justInTimeCompilation := ObjectMemory justInTimeCompilation.
fullDebugSupport := ObjectMemory fullSingleStepSupport.
] ifFalse:[
justInTimeCompilation := false.
fullDebugSupport := (Compiler lineNumberInfo == #full) asValue.
].
justInTimeCompilation := justInTimeCompilation asValue.
fullDebugSupport := fullDebugSupport asValue.
catchMethodRedefs := Class catchMethodRedefinitions asValue.
catchClassRedefs := Class catchClassRedefinitions asValue.
historyLines := HistoryManager notNil and:[HistoryManager isLoaded and:[HistoryManager isActive]].
historyLines ifFalse:[
fullHistoryUpdate := false asValue
] ifTrue:[
fullHistoryUpdate := HistoryManager fullHistoryUpdate asValue.
].
historyLines := historyLines 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.
warnCompatibilityBox enable.
warnUnusedVarsBox enable.
allowUnderscore value ifTrue:[
warnUnderscoreBox enable.
] ifFalse:[
warnUnderscoreBox disable.
].
allowDollar value ifTrue:[
warnDollarBox enable.
] ifFalse:[
warnDollarBox disable.
].
] ifFalse:[
warnSTXBox disable.
warnUnderscoreBox disable.
warnDollarBox disable.
warnOldStyleBox disable.
warnCommonMistakesBox disable.
warnCompatibilityBox disable.
warnUnusedVarsBox disable.
]].
warnings onChangeEvaluate:warnEnabler.
allowUnderscore onChangeEvaluate:warnEnabler.
allowDollar onChangeEvaluate:warnEnabler.
"/ allowSqueakExtensions onChangeEvaluate:warnEnabler.
"/ allowQualifiedNames onChangeEvaluate:warnEnabler.
box := DialogBox new.
box label:(resources string:'Compiler Settings').
y := box yPosition.
check := box addCheckBox:(resources string:'Catch Method Redefinitions') on:catchMethodRedefs.
check width:0.5.
box yPosition:y.
check := box addCheckBox:(resources string:'Catch Class Redefinitions') on:catchClassRedefs.
check left:0.5; width:0.5.
y := box yPosition.
check := box addCheckBox:(resources string:'Keep History Line in Methods') on:historyLines.
check width:0.5.
HistoryManager isNil ifTrue:[check disable].
box yPosition:y.
check := box addCheckBox:(resources string:'Keep Full Class History') on:fullHistoryUpdate.
check left:0.5; width:0.5.
HistoryManager isNil ifTrue:[check disable] ifFalse:[check enableChannel:historyLines].
box addPopUpList:(resources string:'FileIn Source Mode:') on:keepSource.
keepSource selectionIndex:( keepSourceOptions indexOf:(ClassCategoryReader sourceMode) ifAbsent:1).
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.
canLoadBinaries ifFalse:[
loadBinaries value:false.
check disable
].
supportsJustInTimeCompilation ifTrue:[
component := box
addCheckBox:(resources string:'Just in Time Compilation to Machine Code')
on:justInTimeCompilation.
].
box addHorizontalLine.
ObjectFileLoader notNil ifTrue:[
compilationList := box addPopUpList:(resources string:'Stc Compilation to Machine Code') on:stcCompilation.
stcCompilation selectionIndex:( stcCompilationOptions indexOf:(Compiler stcCompilation) ifAbsent:1).
stcSetupButt := box addComponent:(Button label:(resources string:'Stc Compilation Parameters...')
action:[|manager|
self stcCompilerSettings.
]).
box addHorizontalLine.
"/ if there is no compiler around,
"/ change to compile nothing, and disable the checkBoxes
Compiler canCreateMachineCode ifFalse:[
stcCompilation selectionIndex:(3 min:stcCompilationOptions size).
compilationList disable.
].
].
y := box yPosition.
component := box addCheckBox:(resources string:'Allow Underscore in Identifiers') on:allowUnderscore.
component width:0.4.
component := box addCheckBox:(resources string:'Allow Dollar in Identifiers') on:allowDollar.
component width:0.4.
component := box addCheckBox:(resources string:'Allow VW3 QualifiedNames') on:allowQualifiedNames.
component width:0.4.
component := box addCheckBox:(resources string:'Allow Squeak Extensions') on:allowSqueakExtensions.
component width:0.4.
component := box addCheckBox:(resources string:'Allow Dolphin Extensions') on:allowDolphinExtensions.
component width:0.4.
y2 := box yPosition.
box yPosition:y.
box leftIndent:0.
component :=box addPopUpList:(resources string:'Constant Folding:') on:constantFolding.
component superView left:0.5; width:0.5.
constantFolding selectionIndex:( constantFoldingOptions indexOf:(Compiler foldConstants) ifAbsent:1).
component := box addCheckBox:(resources string:'Allow OldStyle Assignment (_)') on:allowOldStyleAssignment.
component left:0.5; width:0.4.
component := box addCheckBox:(resources string:'Allow Reserved Words as Selector (self)') on:allowReservedWordsAsSelectors.
component left:0.5; width:0.4.
component := box addCheckBox:(resources string:'Full Debug Info') on:fullDebugSupport.
component left:0.5; width:0.4.
component := box addCheckBox:(resources string:'Literal Arrays are Immutable') on:immutableArrays.
component left:0.5; width:0.4.
box yPosition:(box yPosition max:y2).
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.
warnUnderscoreBox := box addCheckBox:(resources string:'Underscores in Identifiers') on:warnUnderscore.
warnUnderscoreBox width:0.4.
warnDollarBox := box addCheckBox:(resources string:'Dollars in Identifiers') on:warnDollar.
warnDollarBox width:0.4.
warnUnusedVarsBox := box addCheckBox:(resources string:'Unused Method Variables') on:warnUnusedVars.
warnUnusedVarsBox width:0.4.
yMax := box yPosition.
box yPosition:y.
box leftIndent:0.
warnOldStyleBox := box addCheckBox:(resources string:'OldStyle Assignment') on:warnOldStyle.
warnOldStyleBox left:0.5; width:0.4.
warnCommonMistakesBox := box addCheckBox:(resources string:'Common Mistakes') on:warnCommonMistakes.
warnCommonMistakesBox left:0.5; width:0.4.
warnCompatibilityBox := box addCheckBox:(resources string:'Possible Incompatibilities') on:warnCompatibility.
warnCompatibilityBox left:0.5; width:0.4.
box leftIndent:oldIndent.
box yPosition:(yMax max: box yPosition).
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/compilerSettings.html';
addAbortAndOkButtons.
warnEnabler value.
box open.
box accepted ifTrue:[
HistoryManager notNil ifTrue:[
HistoryManager fullHistoryUpdate:fullHistoryUpdate value.
historyLines value ifTrue:[
HistoryManager activate
] ifFalse:[
HistoryManager deactivate
].
].
Class catchMethodRedefinitions:catchMethodRedefs value.
Class catchClassRedefinitions:catchClassRedefs value.
ClassCategoryReader sourceMode:(keepSourceOptions at:keepSource selectionIndex).
Compiler warnings:warnings value.
Compiler warnSTXSpecials:warnSTX value.
Compiler warnOldStyleAssignment:warnOldStyle value.
Compiler warnUnderscoreInIdentifier:warnUnderscore value.
Compiler warnDollarInIdentifier:warnDollar value.
Compiler warnCommonMistakes:warnCommonMistakes value.
Compiler warnPossibleIncompatibilities:warnCompatibility value.
Compiler warnUnusedVars:warnUnusedVars value.
Compiler allowUnderscoreInIdentifier:allowUnderscore value.
Compiler allowDollarInIdentifier:allowDollar value.
Compiler allowSqueakExtensions:allowSqueakExtensions value.
Compiler allowDolphinExtensions:allowDolphinExtensions value.
Compiler allowQualifiedNames:allowQualifiedNames value.
Compiler allowOldStyleAssignment:allowOldStyleAssignment value.
Compiler allowReservedWordsAsSelectors:allowReservedWordsAsSelectors value.
Compiler arraysAreImmutable:immutableArrays value.
fullDebugSupport value ifTrue:[
Compiler lineNumberInfo:#full.
] ifFalse:[
Compiler lineNumberInfo:true
].
ParserFlags stcCompilation:(stcCompilationOptions at:stcCompilation selectionIndex).
Compiler foldConstants:(constantFoldingOptions at:constantFolding selectionIndex).
supportsJustInTimeCompilation ifTrue:[
justInTimeCompilation := justInTimeCompilation value.
justInTimeCompilation ifTrue:[
Smalltalk allMethodsDo:[:m | m checked:false].
].
ObjectMemory justInTimeCompilation:justInTimeCompilation.
ObjectMemory fullSingleStepSupport:fullDebugSupport value.
].
Autoload compileLazy:compileLazy value.
Smalltalk loadBinaries:loadBinaries value.
].
box destroy
"
self compilerSettings
"
"Modified: / 10.9.1995 / 19:19:18 / claus"
"Modified: / 9.9.1996 / 22:42:47 / stefan"
"Modified: / 5.11.1998 / 14:25:59 / cg"
!
displaySettings
"open a dialog on display related settings"
|box listOfSizes sizeInfos
sizes sizeNames sizeList sizeX sizeY deepIcons
isColorMonitor useFixPalette useFixGrayPalette idx ditherStyles ditherSyms ditherList
y component screen visual clipEncodings clipEncodingSyms clipEncodingList resources
|
resources := self owningClass classResources.
listOfSizes := resources at:'LIST_OF_OFFERED_SCREEN_SIZES' default:#default.
listOfSizes == #default ifTrue:[
"/ nothing in resource file; offer at least some.
sizeInfos := #(
( '11.3'' (235mm x 175mm) LCD' (235 175) )
( '17'' (325mm x 245mm)' (325 245) )
( '19'' (340mm x 270mm)' (340 270) )
( '20'' (350mm x 280mm)' (350 280) )
( '21'' (365mm x 285mm)' (365 285) )
).
] ifFalse:[
sizeInfos := resources array:listOfSizes.
].
sizeNames := sizeInfos collect:[:entry | entry at:1].
sizes := sizeInfos collect:[:entry | entry at:2].
screen := Screen current.
visual := screen visualType.
isColorMonitor := screen hasColors asValue.
deepIcons := screen supportsDeepIcons asValue.
useFixPalette := screen fixColors notNil asValue.
useFixGrayPalette := screen fixGrayColors notNil asValue.
sizeList := SelectionInList with:sizeNames.
sizeX := screen widthInMillimeter asValue.
sizeY := screen heightInMillimeter asValue.
clipEncodingSyms := #(nil #iso8859 #jis #jis7 #sjis #euc #big5).
clipEncodings := resources array:#('untranslated' 'iso8859' 'jis' 'jis7' 'shift-JIS' 'EUC' 'big5').
clipEncodingList := SelectionInList new.
clipEncodingList list:clipEncodings.
clipEncodingList selectionIndex:(clipEncodingSyms indexOf:screen clipboardEncoding ifAbsent:1).
ditherList := SelectionInList new.
(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 onChangeEvaluate:[
|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:nil 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:nil 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; addHorizontalLine; addVerticalSpace.
(box addTextLabel:(resources string:'Screen: Depth: %1 Visual: %2 (%3)'
with:screen depth printString
with:screen visualType
with:screen serverVendor))
adjust:#left.
box addVerticalSpace; addHorizontalLine; addVerticalSpace.
box addCheckBox:(resources string:'Color Monitor') on:isColorMonitor.
visual == #PseudoColor ifTrue:[
box addVerticalSpace.
component := box addCheckBox:(resources string:'Use Fix Color Palette %1' with:'(4x8x4)') on:useFixPalette.
box addVerticalSpace.
component := box addCheckBox:(resources string:'Use Fix Gray Color Palette %1' with:'(32)') on:useFixGrayPalette.
].
ditherSyms notNil ifTrue:[
box addVerticalSpace.
component := box addPopUpList:(resources string:'Image Display:') on:ditherList.
component defaultLabel:'image display'.
component superView horizontalLayout:#leftSpace.
].
box addVerticalSpace.
box addCheckBox:(resources string:'Allow Colored/Grayscale Icons') on:deepIcons.
box addVerticalSpace; addHorizontalLine; addVerticalSpace.
component := box addPopUpList:(resources string:'ClipBoard Encoding:') on:clipEncodingList.
component superView horizontalLayout:#leftSpace.
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/screenSettings.html';
addAbortAndOkButtons.
box open.
box accepted ifTrue:[
Image flushDeviceImages.
screen visualType == #PseudoColor ifTrue:[
useFixPalette value ifTrue:[
Color colorAllocationFailSignal handle:[:ex |
self warn:'Could not allocate colors.'.
] do:[
Color getColorsRed:4 green:8 blue:4 on:screen
]
] ifFalse:[
screen releaseFixColors
].
useFixGrayPalette value ifTrue:[
Color colorAllocationFailSignal handle:[:ex |
self warn:'Could not allocate colors.'.
] do:[
Color getGrayColors:32 on:screen
]
] ifFalse:[
screen releaseFixGrayColors
]
].
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).
].
WindowGroup activeGroup withWaitCursorDo:[
View defaultStyle:(View defaultStyle).
].
screen clipboardEncoding:(clipEncodingSyms at:clipEncodingList selectionIndex).
].
box destroy
"Modified: / 9.9.1996 / 22:43:04 / stefan"
"Modified: / 20.5.1999 / 18:35:21 / cg"
!
editSettings
"open a dialog on edit settings"
"OBSOLETE - this functionality is no longer used - see AbstractSettingsApplication"
|box st80EditMode st80SelectMode resources
tabsIs4 prevTabsIs4 searchDialogIsModal startTextDragWithControl|
resources := self owningClass classResources.
"/
"/ extract relevant system settings ...
"/
st80EditMode := UserPreferences current st80EditMode asValue.
st80SelectMode := UserPreferences current st80SelectMode asValue.
prevTabsIs4 := (ListView userDefaultTabPositions = ListView tab4Positions).
tabsIs4 := prevTabsIs4 asValue.
searchDialogIsModal := UserPreferences current searchDialogIsModal asValue.
startTextDragWithControl := UserPreferences current startTextDragWithControl asValue.
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Edit settings').
box addCheckBox:(resources string:'Cursor has ST80 Line-end Behavior') on:st80EditMode.
box addCheckBox:(resources string:'Double Click Select Behavior as in ST80') on:st80SelectMode.
box addCheckBox:(resources string:'Tab Stops in Multiples of 4') on:tabsIs4.
box addCheckBox:(resources string:'SearchBox is Modal') on:searchDialogIsModal.
box addCheckBox:(resources string:'CTRL-Key to Start TextDrag') on:startTextDragWithControl.
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/editSettings.html';
addAbortAndOkButtons.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
UserPreferences current st80EditMode:(st80EditMode value).
UserPreferences current st80SelectMode:(st80SelectMode value).
tabsIs4 value ~~ prevTabsIs4 ifTrue:[
ListView userDefaultTabPositions:(tabsIs4 value
ifTrue:[ListView tab4Positions]
ifFalse:[ListView tab8Positions]).
ListView allSubInstancesDo:[:eachKindOfListView |
tabsIs4 value
ifTrue:[eachKindOfListView setTab4]
ifFalse:[eachKindOfListView setTab8]
].
].
UserPreferences current searchDialogIsModal:searchDialogIsModal value.
UserPreferences current startTextDragWithControl:startTextDragWithControl value.
].
box destroy
"Created: / 06-01-1999 / 14:12:09 / cg"
"Modified: / 03-07-2006 / 16:35:03 / cg"
!
fontSettingsFor:requestor
"open a dialog on font related settings"
(self fontBoxForEncoding:nil) ifTrue:[
requestor reopenLauncher.
]
"
self fontSettingsFor:nil
"
"Created: 26.2.1996 / 22:52:51 / cg"
"Modified: 8.1.1997 / 14:52:49 / cg"
!
javaSettings
"open a dialog on settings related to the java subsystem"
|box audio javaHome classPath oldJavaHome oldClassPath resources component
extraFileSecurityChecks extraSocketSecurityChecks
supportsJustInTimeCompilation
javaJustInTimeCompilation javaNativeCodeOptimization
showJavaByteCode exceptionDebug nullPointerExceptionDebug pathSep|
resources := self owningClass classResources.
audio := JavaVM audioEnabled asValue.
extraFileSecurityChecks := JavaVM fileOpenConfirmation asValue.
extraSocketSecurityChecks := JavaVM socketConnectConfirmation asValue.
(supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) ifTrue:[
javaJustInTimeCompilation := ObjectMemory javaJustInTimeCompilation asValue.
javaNativeCodeOptimization := ObjectMemory javaNativeCodeOptimization asValue.
] ifFalse:[
javaJustInTimeCompilation := javaNativeCodeOptimization := false
].
showJavaByteCode := JavaMethod forceByteCodeDisplay asValue.
exceptionDebug := JavaVM exceptionDebug asValue.
nullPointerExceptionDebug := JavaVM nullPointerExceptionDebug asValue.
classPath := (Java classPath ? '').
OperatingSystem isUNIXlike ifTrue:[
pathSep := $;.
] ifFalse:[
pathSep := $:.
].
classPath := (classPath asStringWith:pathSep) asValue.
oldClassPath := classPath copy.
classPath := classPath asValue.
javaHome := (Java javaHome ? '').
oldJavaHome := javaHome copy.
javaHome := javaHome asValue.
box := DialogBox new.
box label:(resources string:'Java').
box addCheckBox:(resources string:'Audio Enabled') on:audio.
box addCheckBox:(resources string:'Confirm file open for write') on:extraFileSecurityChecks.
box addCheckBox:(resources string:'Confirm socket connect') on:extraSocketSecurityChecks.
box addCheckBox:(resources string:'Debug Exceptions') on:exceptionDebug.
box addCheckBox:(resources string:'Debug Null Pointer Exceptions') on:nullPointerExceptionDebug.
box addHorizontalLine.
supportsJustInTimeCompilation ifTrue:[
box
addCheckBox:(resources string:'java just in time compilation to machine code')
on:javaJustInTimeCompilation.
box
addCheckBox:(resources string:'optimize native code')
on:javaNativeCodeOptimization.
].
box addHorizontalLine.
box addCheckBox:(resources string:'Display java byteCode (i.e. not source)') on:showJavaByteCode.
box addHorizontalLine.
component := box
addLabelledInputField:(resources string:'classPath:')
adjust:#right
on:classPath
tabable:true
separateAtX:0.3.
component acceptOnLeave:false.
component := box
addLabelledInputField:(resources string:'java home:')
adjust:#right
on:javaHome
tabable:true
separateAtX:0.3.
component acceptOnLeave:false.
box addVerticalSpace.
box addComponent:(Button
label:(resources string:'Reinit VM now')
action:[
box windowGroup withWaitCursorDo:[
"/ Java classPath size == 0 ifTrue:[
"/ Java initialize.
"/ ].
"/ Java classPath size == 0 ifTrue:[
"/ self warn:'No JDK found'.
"/ ] ifFalse:[
JavaVM initializeVM
"/ ]
]
]).
box addComponent:(Button
label:(resources string:'Remove all Java classes now')
action:[
box windowGroup withWaitCursorDo:[
Java flushAllJavaResources
]
]).
"/ box addHorizontalLine.
"/ box addHelpButtonFor:'Launcher/javaSettings.html'.
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
classPath value ~= oldClassPath ifTrue:[
OperatingSystem isUNIXlike ifTrue:[
classPath := (classPath value asCollectionOfSubstringsSeparatedBy:$:)
] ifFalse:[
classPath := (classPath value asCollectionOfSubstringsSeparatedBy:$;)
].
Java classPath:classPath
].
Java javaHome:javaHome value.
JavaMethod forceByteCodeDisplay:showJavaByteCode value.
JavaVM audioEnabled:audio value.
JavaVM exceptionDebug:exceptionDebug value.
JavaVM nullPointerExceptionDebug:nullPointerExceptionDebug value.
JavaVM fileOpenConfirmation: extraFileSecurityChecks value.
JavaVM socketConnectConfirmation: extraSocketSecurityChecks value.
javaJustInTimeCompilation value ~~ ObjectMemory javaJustInTimeCompilation ifTrue:[
ObjectMemory javaJustInTimeCompilation:javaJustInTimeCompilation value.
javaJustInTimeCompilation value ifTrue:[
JavaMethod allSubInstancesDo:[:m | m checked:false].
].
].
javaNativeCodeOptimization value ~~ ObjectMemory javaNativeCodeOptimization ifTrue:[
ObjectMemory javaNativeCodeOptimization:javaNativeCodeOptimization value.
].
].
box destroy
"
self javaSettings
"
"Created: / 18.7.1998 / 22:32:58 / cg"
"Modified: / 27.1.1999 / 20:16:03 / cg"
!
keyboardSettings
"open a dialog on keyboard related settings"
|mappings listOfRawKeys listOfFunctions
box l
list1 list2 listView1 listView2
frame selectionForwarder macroForwarder macroTextView y resources|
resources := self owningClass classResources.
mappings := Screen current keyboardMap.
listOfRawKeys := (mappings keys collect:[:key | key asString] as:Array) sort.
listOfFunctions := (mappings values asSet collect:[:key | key asString] as:Array) 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 := UserPreferences current functionKeySequences
at:(f asSymbol) ifAbsent:nil.
macro notNil ifTrue:[
macro := macro asStringCollection.
indent := macro
inject:99999 into:[:min :element |
|stripped|
stripped := element withoutLeadingSeparators.
stripped isEmpty 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 onChangeEvaluate:macroForwarder.
box := Dialog new.
box label:(resources string:'Keyboard Mappings').
l := box addTextLabel:(resources at:'KEY_MSG' default:'keyboard mapping:') 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 preferredHeight 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;"
addOkButtonLabelled:(resources string:'Close' "'Dismiss'").
macroTextView topInset:(l preferredHeight + 5).
macroTextView bottomInset:(box preferredHeight - y).
box open.
box accepted ifTrue:[
"no action yet ..."
].
box destroy
"Modified: / 9.9.1996 / 22:43:17 / stefan"
"Modified: / 4.5.1998 / 12:40:02 / cg"
!
languageSettings
self languageSettingsFor:nil
!
languageSettingsFor:requestor
"open a dialog on language related settings"
|listOfLanguages translatedLanguages switch box languageList flags resources|
resources := self owningClass classResources.
"
get list of supported languages from the launchers resources ...
"
listOfLanguages := resources at:'LIST_OF_OFFERED_LANGUAGES' default:#('default').
listOfLanguages := listOfLanguages asOrderedCollection.
translatedLanguages := listOfLanguages collect:[:lang | |item|
item := resources string:lang.
item isString ifTrue:[
item
] ifFalse:[
item at:1
]
].
flags := listOfLanguages collect:[:lang | |item|
item := resources string:lang.
item isArray ifTrue:[
item at:2
] ifFalse:[
nil
]
].
flags := flags collect:[:nm | |img d| nm notNil ifTrue:[
img := Image fromFile:nm.
img isNil ifTrue:[
d := Smalltalk getPackageDirectoryForPackage:'stx:goodies'.
img := Image fromFile:(d construct:nm).
].
] ifFalse:[
nil
]
].
listOfLanguages := listOfLanguages collect:[:nm | nm copyFrom:'LANG_' size + 1].
languageList := translatedLanguages with:flags collect:[:lang :flag | LabelAndIcon icon:flag string:lang.].
box := ListSelectionBox title:(resources at:'LANG_MSG' default:'Select a Language') withCRs.
box label:(resources string:'Language Selection').
box list:languageList.
box initialText:(Language , '-' , LanguageTerritory).
box action:[:newLanguage |
WindowGroup activeGroup withWaitCursorDo:[
|fontPref idx language oldLanguage territory enc
answer matchingFonts l screen|
idx := translatedLanguages indexOf:newLanguage withoutSeparators.
idx ~~ 0 ifTrue:[
language := listOfLanguages at:idx
] ifFalse:[
language := newLanguage
].
(language includes:$-) ifTrue:[
l := language asCollectionOfSubstringsSeparatedBy:$-.
language := l at:1.
territory := l at:2.
].
territory isNil ifTrue:[
territory := language copyTo:2
].
"/ check if the new language needs a differently encoded font;
"/ ask user to switch font and allow cancellation.
"/ Otherwise, you are left with unreadable menu & button items ...
oldLanguage := UserPreferences current language.
Smalltalk setLanguage:language asSymbol.
ResourcePack flushCachedResourcePacks.
"/ refetch resources ...
resources := self owningClass classResources.
fontPref := resources at:'PREFERRED_FONT_ENCODING' default:'iso8859*'.
fontPref := fontPref asLowercase.
Smalltalk setLanguage:oldLanguage.
switch := true.
enc := MenuView defaultFont encoding.
(fontPref match:enc asLowercase) ifFalse:[
"/ look if there is one at all.
screen := Screen current.
matchingFonts := screen listOfAvailableFonts select:[:f | fontPref match:f encoding asLowercase].
matchingFonts isEmpty ifTrue:[
"/ flush and try again - just in case, the font path has changed.
screen flushListOfAvailableFonts.
matchingFonts := screen listOfAvailableFonts select:[:f | fontPref match:f encoding asLowercase].
].
matchingFonts isEmpty ifTrue:[
(Dialog
confirm:(resources
string:'Your display does not offer any %1-encoded font.\\Change the language anyway ?\ (texts will probably be unreadable then)'
with:fontPref) withCRs)
ifFalse:[
switch := false
]
] ifFalse:[
answer := Dialog
confirmWithCancel:(resources
string:'menu font is not %1-encoded.\\Change it ?'
with:fontPref) withCRs
labels:(resources
array:#('Cancel' 'No' 'Yes'))
default:3.
answer isNil ifTrue:[
switch := false
] ifFalse:[
answer ifTrue:[
switch := (requestor fontBoxForEncoding:fontPref)
]
].
].
].
switch ifTrue:[
Transcript showCR:'change language to ' , newLanguage , ' ...'.
Smalltalk language:language asSymbol territory:territory asSymbol.
"/ ResourcePack flushCachedResourcePacks - already done by language-change
].
].
switch ifTrue:[
requestor reopenLauncher.
DebugView newDebugger.
]
].
box
addHelpButtonFor:'Launcher/languageSetting.html'.
box open.
box destroy
"Modified: / 09-09-1996 / 22:43:27 / stefan"
"Modified: / 19-10-2006 / 22:17:01 / cg"
!
memorySettings
"open a dialog on objectMemory related settings"
|box igcLimit igcFreeLimit igcFreeAmount newSpaceSize
compressLimit
oldIncr component fields codeLimit codeTrigger stackLimit resources
fastMoreLimit maxOldSpace models info acceptChannel|
acceptChannel := false asValue.
resources := self owningClass classResources.
"/
"/ 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.
codeLimit := ObjectMemory dynamicCodeLimit asValue.
codeTrigger := ObjectMemory dynamicCodeGCTrigger asValue.
stackLimit := Process defaultMaximumStackSize asValue.
fastMoreLimit := (ObjectMemory fastMoreOldSpaceLimit:-1) asValue.
maxOldSpace := ObjectMemory maxOldSpace asValue.
models := OrderedCollection new.
info := OrderedCollection new.
models add:newSpaceSize. info add:#(number 'Size of newSpace where objects are created' 'Size of NewSpace:' ).
models add:fastMoreLimit. info add:#(number 'Quickly allocate more memory (suppress GC) up to this limit' 'Quick Allocation Limit:').
models add:maxOldSpace. info add:#(number 'Never allocate more than this amount of memory' 'Maximum Memory Limit:').
models add:igcLimit. info add:#(number 'Start IGC whenever this amount has been allocated' 'Incremental GC Allocation Trigger:').
models add:igcFreeLimit. info add:#(number 'Start IGC whenever freespace drops below this' 'Incremental GC Freespace Trigger:').
models add:igcFreeAmount. info add:#(number 'Try to keep this amount for peak requests' 'Incremental GC Amount:').
models add:oldIncr. info add:#(number 'Increase oldSpace in chunks of this size' 'Oldspace Increment:').
models add:compressLimit. info add:#(number 'Use 2-pass compressing GC if > 0 and more memory is in use' 'Oldspace Compress Limit:').
models add:stackLimit. info add:#(number 'Trigger recursionInterrupt if more stack is used by a process' 'Stack Limit:').
models add:codeLimit. info add:#(numberOrNil 'Flush dynamic compiled code to stay within this limit' 'Dynamic code Limit:').
models add:codeTrigger. info add:#(numberOrNil 'Start incremental GC whenever this amount of code has been allocated' 'Dynamic Code GC Trigger:').
"/
"/ 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 failures or poor performance
' , 'You have been warned' allBold , '.') adjust:#left.
box addHorizontalLine.
models with:info do:[:m :i |
|lbl descr conv|
conv := i at:1.
lbl := i at:3.
descr := i at:2.
component := box
addLabelledInputField:(resources string:lbl)
adjust:#right
on:nil "/ newSpaceSize
tabable:true
separateAtX:0.7.
component acceptOnLeave:false.
"/ component converter:(PrintConverter new perform:conv).
component model:((TypeConverter on:m) perform:conv).
component acceptChannel:acceptChannel.
fields add:component.
(box addTextLabel:descr) adjust:#left.
box addHorizontalLine.
].
ObjectMemory supportsJustInTimeCompilation ifFalse:[
(fields at:9) disable.
(fields at:10) disable.
].
box addAbortAndOkButtons.
box
addHelpButtonFor:'Launcher/memorySettings.html'.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
acceptChannel value:true.
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.
].
stackLimit value ~~ Process defaultMaximumStackSize ifTrue:[
Process defaultMaximumStackSize:stackLimit value.
].
fastMoreLimit value ~~ (ObjectMemory fastMoreOldSpaceLimit:-1) ifTrue:[
ObjectMemory fastMoreOldSpaceLimit:fastMoreLimit value.
].
maxOldSpace value ~~ ObjectMemory maxOldSpace ifTrue:[
ObjectMemory maxOldSpace:maxOldSpace value.
].
ObjectMemory oldSpaceCompressLimit:compressLimit value.
ObjectMemory dynamicCodeLimit:codeLimit value.
ObjectMemory dynamicCodeGCTrigger:codeTrigger value.
].
box destroy
"Modified: 27.2.1997 / 16:50:12 / cg"
!
messageSettings
"open a dialog on infoMessage related settings"
|box vmInfo vmErrors displayErrors classInfos resources|
resources := self owningClass classResources.
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 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, WinAPI ...)') on:displayErrors.
box addCheckBox:(resources string:'Other Info Messages') on:classInfos.
box addHorizontalLine.
box addHelpButtonFor:'Launcher/messageSettings.html'.
box addAbortAndOkButtons.
box open.
box accepted ifTrue:[
ObjectMemory infoPrinting:vmInfo value.
ObjectMemory debugPrinting:vmErrors value.
Object infoPrinting:classInfos value.
DeviceWorkstation errorPrinting:displayErrors value.
].
box destroy
"Modified: 27.1.1997 / 17:46:01 / cg"
!
miscSettings
"open a dialog on misc other settings"
|box pos pos2 check butt shadows takeFocus focusFollowsMouse returnFocus
hostNameInLabel showAccelerators
preemptive dynamicPrios hostNameInLabelHolder resources
activateOnClick opaqueVariablePanelResize opaqueTableColumnResize currentUserPrefs
beepEnabled newWindowLabelFormat|
resources := self owningClass classResources.
currentUserPrefs := UserPreferences current.
"/
"/ extract relevant system settings ...
"/
shadows := PopUpView shadows asValue.
beepEnabled := currentUserPrefs beepEnabled asValue.
hostNameInLabel := StandardSystemView includeHostNameInLabel.
hostNameInLabelHolder := hostNameInLabel asValue.
returnFocus := StandardSystemView returnFocusWhenClosingModalBoxes asValue.
takeFocus := StandardSystemView takeFocusWhenMapped asValue.
focusFollowsMouse := (currentUserPrefs focusFollowsMouse ? true) asValue.
activateOnClick := (Display activateOnClick:nil) asValue.
opaqueVariablePanelResize := currentUserPrefs opaqueVariablePanelResizing asValue.
opaqueTableColumnResize := currentUserPrefs opaqueTableColumnResizing asValue.
showAccelerators := MenuView showAcceleratorKeys asValue.
preemptive := Processor isTimeSlicing asValue.
dynamicPrios := Processor supportDynamicPriorities asValue.
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Other settings').
box addCheckBox:(resources string:'Shadows under PopUp Views') on:shadows.
box addCheckBox:(resources string:'Beeper enabled') on:beepEnabled.
box addCheckBox:(resources string:'Boxes Return Focus to Previously Active View') on:returnFocus.
box addCheckBox:(resources string:'Views Catch Focus when Mapped') on:takeFocus.
pos := box yPosition.
check := box addCheckBox:(resources string:'Hostname in Window Labels') on:hostNameInLabelHolder.
check width:0.6.
pos2 := box yPosition.
box yPosition:pos.
butt := box addComponent:(Button label:(resources string:'Format...')
action:[
|newFormat|
newFormat := Dialog request:
'Define the Format of Window Labels:\\ %1 - Label\ %2 - Hostname\ %3 - Username\ %4 - ProcessId\'
withCRs initialAnswer:StandardSystemView windowLabelFormat.
newFormat size > 0 ifTrue:[
newWindowLabelFormat := newFormat
].
]).
box makeTabable:butt.
butt left:0.6; width:0.4.
box yPosition:(box yPosition max:pos2).
box addCheckBox:(resources string:'Show Accelerator Keys in Menus') on:showAccelerators.
box addCheckBox:(resources string:'Raise & Activate Windows on Click') on:activateOnClick.
box addCheckBox:(resources string:'Focus Follows Mouse') on:focusFollowsMouse.
box addCheckBox:(resources string:'Opaque Variable Panel Resizing') on:opaqueVariablePanelResize.
box addCheckBox:(resources string:'Opaque Table Column Resizing') on:opaqueTableColumnResize.
box addHorizontalLine.
box addCheckBox:(resources string:'Preemptive Scheduling') on:preemptive.
box leftIndent:20.
check := box addCheckBox:(resources string:'Dynamic Priorities') on:dynamicPrios.
check enableChannel:preemptive.
box leftIndent:0.
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/miscSettings.html';
addAbortAndOkButtons.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
PopUpView shadows:shadows value.
(hostNameInLabelHolder value ~= hostNameInLabel
or:[newWindowLabelFormat ~= StandardSystemView windowLabelFormat]) ifTrue:[
StandardSystemView includeHostNameInLabel:hostNameInLabelHolder value.
newWindowLabelFormat notNil ifTrue:[
StandardSystemView windowLabelFormat:newWindowLabelFormat
].
Screen allScreens do:[:aDisplay |
aDisplay allViewsDo:[:aView |
|l|
aView isTopView ifTrue:[
l := aView label.
l notNil ifTrue:[
aView label:(l , ' '); label:l. "/ force a change
]
]
]
]
].
currentUserPrefs opaqueVariablePanelResizing:opaqueVariablePanelResize value.
currentUserPrefs opaqueTableColumnResizing:opaqueTableColumnResize value.
currentUserPrefs beepEnabled:beepEnabled value.
StandardSystemView returnFocusWhenClosingModalBoxes:returnFocus value.
StandardSystemView takeFocusWhenMapped:takeFocus value.
currentUserPrefs focusFollowsMouse:focusFollowsMouse value.
Screen current activateOnClick:(activateOnClick value).
MenuView showAcceleratorKeys:showAccelerators value.
Processor isTimeSlicing ~~ preemptive value ifTrue:[
preemptive value ifTrue:[
Processor startTimeSlicing
] ifFalse:[
Processor stopTimeSlicing
]
].
Processor supportDynamicPriorities ~~ dynamicPrios value ifTrue:[
Processor supportDynamicPriorities:dynamicPrios value
].
].
box destroy
"Modified: / 9.9.1996 / 22:43:36 / stefan"
"Modified: / 20.5.1999 / 18:33:55 / cg"
"Modified: / 3.12.1999 / 17:11:38 / ps"
!
printerSettings
"open a dialog on printer related settings; returns true if accepted"
|box accepted
possiblePrinters possibleTypes printerType printCommand printFile
pageFormat landscape updater
formatLabel formatComponent landscapeLabel landscapeComponent
topMargin leftMargin rightMargin bottomMargin unitList unit
topMarginComponent leftMarginComponent
rightMarginComponent
bottomMarginComponent supportsColor supportsColorComponent
y y1 commandListPop printOutField component commandList row resources|
resources := self owningClass classResources.
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.
printFile := (Printer printFilename ? '') 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.25; adjust:#right; borderWidth:0.
box yPosition:y.
component := box addComboListOn:printerType tabable:true.
component aspect:#selectionIndex; changeMessage:#selectionIndex:; useIndex:true.
component width:0.75; left:0.25.
"/ end of question
y := box yPosition.
component := box addTextLabel:(resources string:'Print Command:').
component width:0.25; adjust:#right; borderWidth:0.
box yPosition:y.
commandListPop := box addComboBoxOn:printCommand tabable:true.
"/ commandListPop := box addInputFieldOn:printCommand tabable:true.
commandListPop width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
"/ some common print commands ...
commandList := resources string:'PRINT_COMMANDS' default:nil.
commandList isNil ifTrue:[
commandList := PrinterStream defaultCommands.
commandList isNil ifTrue:[
commandList := #('lpr'
'lp'
).
]
].
commandListPop list:commandList.
y := box yPosition.
component := box addTextLabel:(resources string:'Print to File:').
component width:0.25; adjust:#right; borderWidth:0.
box yPosition:y.
printOutField := box addInputFieldOn:printFile tabable:true.
printOutField width:0.75; left:0.25; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
printFile
onChangeEvaluate:
[
printFile value size > 0 ifTrue:[
commandListPop disable.
] ifFalse:[
commandListPop enable.
]
].
printFile changed.
box addVerticalSpace; addHorizontalLine; 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; addHorizontalLine; 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 onChangeEvaluate:updater.
printerType onChangeEvaluate:updater.
updater value.
box addHorizontalLine.
box addVerticalSpace;
addHelpButtonFor:'Launcher/printerSettings.html';
addAbortAndOkButtons.
box open.
(accepted := box accepted) ifTrue:[
Printer := possiblePrinters at:(printerType selectionIndex).
Printer printCommand:printCommand value.
Printer printFilename:(printFile value isEmptyOrNil ifTrue:[nil] ifFalse:[printFile 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.
^ accepted
"Modified: 9.9.1996 / 22:43:51 / stefan"
"Modified: 28.2.1997 / 14:00:13 / cg"
!
saveSettings
SettingsDialog saveSettingsWithoutAskingForFile.
!
sourceAndDebuggerSettings
"open a dialog on source&debugger other settings"
|box check butt setupButt logDoits updChanges changeFileName
useManager hasManager cvsIsSetup
repository repositoryHolder localSourceFirst
sourceCacheDir cacheEntry
component localCheck oldIndent nm fn manager
showErrorNotifier showVerboseStack
syntaxColoring fullSelectorCheck autoFormat
resources pos currentUserPrefs checkClassesWhenCheckingIn checkClassesBox|
currentUserPrefs := UserPreferences current.
resources := self owningClass classResources.
"/
"/ extract relevant system settings ...
"/
logDoits := Smalltalk logDoits asValue.
updChanges := Class updatingChanges asValue.
changeFileName := ObjectMemory nameForChanges asValue.
AbstractSourceCodeManager notNil ifTrue:[
AbstractSourceCodeManager autoload.
].
hasManager := AbstractSourceCodeManager notNil
and:[AbstractSourceCodeManager isLoaded].
repositoryHolder := '' asValue.
hasManager ifTrue:[
useManager := (manager := Smalltalk at:#SourceCodeManager) notNil asValue.
localSourceFirst := Class tryLocalSourceFirst asValue.
manager notNil ifTrue:[
manager forgetDisabledModules.
repository := manager repositoryName.
repository notNil ifTrue:[
repositoryHolder := repository asValue.
] ifFalse:[
repositoryHolder := '' asValue.
].
].
cvsIsSetup := true.
] ifFalse:[
useManager := false.
localSourceFirst := false.
cvsIsSetup := false.
].
cvsIsSetup := cvsIsSetup asValue.
showErrorNotifier := (NoHandlerError emergencyHandler == AbstractLauncherApplication notifyingEmergencyHandler) asValue.
showVerboseStack := (currentUserPrefs verboseBacktraceInDebugger) asValue.
syntaxColoring := currentUserPrefs syntaxColoring asValue.
fullSelectorCheck := currentUserPrefs fullSelectorCheck asValue.
autoFormat := currentUserPrefs autoFormatting asValue.
sourceCacheDir := nil asValue.
checkClassesWhenCheckingIn := (currentUserPrefs at:#checkClassesWhenCheckingIn ifAbsent:true) asValue.
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Source & Debugger Settings').
box addCheckBox:(resources string:'Log compiles in Changefile') on:updChanges.
box addCheckBox:(resources string:'Log doIts in Changefile') on:logDoits.
component := box
addLabelledInputField:(resources string:'Changefile 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.
hasManager ifTrue:[
pos := box yPosition.
check := box addCheckBox:(resources string:'Sourcecode Management') on:useManager.
check enableChannel:cvsIsSetup.
box makeTabable:check.
CVSSourceCodeManager notNil ifTrue:[
check width:0.6.
box yPosition:pos.
setupButt := box addComponent:(Button label:(resources string:'Setup...')
action:[|manager|
self cvsConfigurationDialog.
manager := (Smalltalk at:#SourceCodeManager).
cvsIsSetup value:manager notNil.
manager notNil ifTrue:[
repositoryHolder value: manager repositoryName.
sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName).
].
]).
setupButt enableChannel:useManager.
box makeTabable:setupButt.
setupButt left:0.6; width:0.4.
].
oldIndent := box leftIndent.
box leftIndent:30.
box addVerticalSpace:10.
"/ component := box
"/ addLabelledInputField:(resources string:'CVS repository:')
"/ adjust:#right
"/ on:repositoryHolder
"/ tabable:true
"/ separateAtX:0.5.
"/ component immediateAccept:true; acceptOnLeave:false.
"/ component enableChannel:useManager.
"/ component readOnly:true.
"/
cacheEntry := box
addLabelledInputField:(resources string:'Source Cache Dir:')
adjust:#right
on:sourceCacheDir
tabable:true
separateAtX:0.5.
cacheEntry immediateAccept:true; acceptOnLeave:false.
cacheEntry enableChannel:useManager.
pos := box yPosition.
butt := Button label:(resources string:'Flush Cache now').
butt action:[ box withWaitCursorDo:[ AbstractSourceCodeManager flushSourceCache ] ].
box addComponent:butt tabable:true.
butt left:0.6; width:0.4; leftInset:0.
butt enableChannel:useManager.
butt := Button label:(resources string:'Condense Cache now').
butt action:[ box withWaitCursorDo:[ AbstractSourceCodeManager condenseSourceCache ] ].
box addComponent:butt tabable:true.
butt left:0.6; width:0.4; leftInset:0.
butt enableChannel:useManager.
localCheck := box addCheckBox:(resources string:'If Present, Use Local Source (Suppress Checkout)') on:localSourceFirst.
localCheck enableChannel:useManager.
checkClassesBox := box addCheckBox:(resources string:'Check for halt/error-Sends when Checking in') on:checkClassesWhenCheckingIn.
checkClassesBox enableChannel:useManager.
box leftIndent:oldIndent.
(AbstractSourceCodeManager isNil
or:[AbstractSourceCodeManager defaultManager isNil]) ifTrue:[
useManager value:false.
"/ cacheEntry disable.
"/ localCheck enable.
] ifFalse:[
sourceCacheDir value:(AbstractSourceCodeManager cacheDirectoryName).
].
box addHorizontalLine.
].
pos := box yPosition.
check := box addCheckBox:(resources string:'Syntax Coloring') on:syntaxColoring.
check width:0.6.
box yPosition:pos.
butt := box addComponent:(Button label:(resources string:'Configure...') action:[self syntaxColorConfigurationDialog]).
box makeTabable:butt.
butt enableChannel:syntaxColoring.
butt left:0.6; width:0.4.
check := box addCheckBox:(resources string:'Immediate Selector Check') on:fullSelectorCheck.
check enableChannel:syntaxColoring.
pos := box yPosition.
check := box addCheckBox:(resources string:'Auto Format') on:autoFormat.
check width:0.6.
box yPosition:pos.
butt := box addComponent:(Button label:(resources string:'Configure...') action:[self formattingConfigurationDialog]).
box makeTabable:butt.
butt left:0.6; width:0.4.
box addHorizontalLine.
box addCheckBox:(resources string:'Show Error Notifier before Opening Debugger') on:showErrorNotifier.
box addCheckBox:(resources string:'Verbose Backtrace by Default in Debugger') on:showVerboseStack.
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/sourceSettings.html';
addAbortAndOkButtons.
box maxExtent:1000@600.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
Smalltalk logDoits:logDoits value.
Class updateChanges:updChanges value.
ObjectMemory nameForChanges:(changeFileName value).
(hasManager and:[useManager value]) ifTrue:[
manager isNil ifTrue:[
Smalltalk at:#SourceCodeManager put:(AbstractSourceCodeManager defaultManager).
manager := Smalltalk at:#SourceCodeManager.
].
Class tryLocalSourceFirst:(localSourceFirst value).
manager notNil ifTrue:[
"/ localSourceFirst value ifFalse:[
nm := sourceCacheDir value.
nm size > 0 ifTrue:[
(fn := nm asFilename) exists ifFalse:[
(self confirm:('CVS cache directory ''' , nm , ''' does not exist\create ?' withCRs)) ifTrue:[
fn makeDirectory;
makeReadableForAll;
makeWritableForAll;
makeExecutableForAll.
]
].
(fn isDirectory
and:[fn isReadable
and:[fn isWritable]]) ifTrue:[
AbstractSourceCodeManager cacheDirectoryName:(sourceCacheDir value).
] ifFalse:[
self warn:'Invalid sourceCache directory.'
]
]
"/ ]
].
repositoryHolder notNil ifTrue:[
repositoryHolder value size > 0 ifTrue:[
manager notNil ifTrue:[
manager initializeForRepository:repositoryHolder value.
]
].
].
] ifFalse:[
Smalltalk at:#SourceCodeManager put:nil
].
showErrorNotifier value ifFalse:[
NoHandlerError emergencyHandler:nil
] ifTrue:[
NoHandlerError emergencyHandler:(AbstractLauncherApplication notifyingEmergencyHandler)
].
currentUserPrefs verboseBacktraceInDebugger:(showVerboseStack value).
currentUserPrefs syntaxColoring:syntaxColoring value.
currentUserPrefs at:#fullSelectorCheck put:fullSelectorCheck value.
currentUserPrefs autoFormatting:autoFormat value.
UserPreferences current at:#checkClassesWhenCheckingIn put:checkClassesWhenCheckingIn value.
].
box destroy
"Modified: / 09-09-1996 / 22:43:36 / stefan"
"Created: / 17-01-1997 / 17:39:33 / cg"
"Modified: / 16-04-1998 / 17:18:47 / ca"
"Modified: / 09-02-2011 / 20:32:56 / cg"
!
stcCompilerSettings
"open an extra dialog on stc-compiler related settings.
Obsoleted by STCCompilerSettingsApp"
|box
stcIncludes stcDefines stcOptions
stcLibraries stcLibraryPath cc stc ccOptions
linkCommand linkArgs
component
canLoadBinaries
resources|
resources := self owningClass classResources.
canLoadBinaries := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
stcIncludes := ParserFlags stcCompilationIncludes asValue.
stcDefines := ParserFlags stcCompilationDefines asValue.
stcOptions := ParserFlags stcCompilationOptions asValue.
ccOptions := ParserFlags ccCompilationOptions asValue.
cc := ParserFlags ccPath asValue.
stc := ParserFlags stcPath asValue.
linkCommand := ParserFlags linkCommand asValue.
linkArgs := ParserFlags linkArgs asValue.
ObjectFileLoader notNil ifTrue:[
| t |
(t := ParserFlags searchedLibraries) notNil ifTrue:[
stcLibraries := (String fromStringCollection:t separatedBy:' ') asValue.
].
(t := ParserFlags libPath) notNil ifTrue:[
stcLibraryPath := t asValue.
]
].
box := DialogBox new.
box label:(resources string:'STC Compilation Settings').
ObjectFileLoader notNil ifTrue:[
component := box
addLabelledInputField:(resources string:'stc Command:')
adjust:#right
on:stc
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(100 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
component := box
addLabelledInputField:(resources string:'stc Options:')
adjust:#right
on:stcOptions
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
component := box
addLabelledInputField:(resources string:'cc Command:')
adjust:#right
on:cc
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(150 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
component := box
addLabelledInputField:(resources string:'cc Options:')
adjust:#right
on:ccOptions
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
component := box
addLabelledInputField:(resources string:'Include Directories:')
adjust:#right
on:stcIncludes
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'Defines:')
adjust:#right
on:stcDefines
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
"/ box addVerticalSpace.
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'Link Command:')
adjust:#right
on:linkCommand
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
component := box
addLabelledInputField:(resources string:'Link Args:')
adjust:#right
on:linkArgs
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
stcLibraries notNil ifTrue:[
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'C-libraries:')
adjust:#right
on:stcLibraries
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
].
stcLibraryPath notNil ifTrue:[
"/ box addVerticalSpace.
component := box
addLabelledInputField:(resources string:'stc LibPath:')
adjust:#right
on:stcLibraryPath
tabable:true
separateAtX:0.3.
component immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
component preferredExtent:(250 @ component preferredHeight).
canLoadBinaries ifFalse:[component disable].
].
].
box
addHelpButtonFor:'Launcher/compilerSettings.html';
addAbortAndOkButtons.
box open.
box accepted ifTrue:[
ParserFlags stcCompilationIncludes:stcIncludes value.
ParserFlags stcCompilationDefines:stcDefines value.
ParserFlags stcCompilationOptions:stcOptions value.
ParserFlags ccCompilationOptions:ccOptions value.
ParserFlags ccPath:cc value.
stc value ~= ParserFlags stcPath ifTrue:[
ParserFlags stcPath:stc value
].
ParserFlags linkCommand:linkCommand value.
ParserFlags linkArgs:linkArgs value.
ObjectFileLoader notNil ifTrue:[
stcLibraries notNil ifTrue:[
ParserFlags searchedLibraries:(stcLibraries value asCollectionOfWords).
].
stcLibraryPath notNil ifTrue:[
ParserFlags libPath:(stcLibraryPath value).
]
].
].
box destroy
"
self stcCompilerSettings
"
"Modified: / 10.9.1995 / 19:19:18 / claus"
"Modified: / 9.9.1996 / 22:42:47 / stefan"
"Created: / 2.10.1998 / 16:27:49 / cg"
"Modified: / 21.10.1998 / 19:15:10 / cg"
!
toolSettings
"open a dialog on tool settings"
|box resources currentUserPrefs in acceptChannel
useNewInspector useNewChangesBrowser useNewSystemBrowser useNewVersionDiffBrowser
useNewFileBrowser showClockInLauncher showClock launcher
transcriptBufferSize useNewFileDialog useNewSettingsApplication useProcessMonitorV2|
currentUserPrefs := UserPreferences current.
resources := self owningClass classResources.
"/
"/ extract relevant system settings ...
"/
useNewInspector := currentUserPrefs useNewInspector asValue.
useNewChangesBrowser := currentUserPrefs useNewChangesBrowser asValue.
useNewSystemBrowser := currentUserPrefs useNewSystemBrowser asValue.
showClockInLauncher := currentUserPrefs showClockInLauncher asValue.
useNewVersionDiffBrowser := currentUserPrefs useNewVersionDiffBrowser asValue.
useNewFileBrowser := currentUserPrefs useNewFileBrowser asValue.
useNewFileDialog := currentUserPrefs useNewFileDialog asValue.
useNewSettingsApplication := currentUserPrefs useNewSettingsApplication asValue.
useProcessMonitorV2 := currentUserPrefs useProcessMonitorV2 asValue.
Transcript current isExternalStream ifTrue:[
transcriptBufferSize := TextCollector defaultLineLimit
] ifFalse:[
transcriptBufferSize := Transcript current lineLimit printString asValue.
].
acceptChannel := false asValue.
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Tool Settings').
box addCheckBox:(resources string:'Use the New System Browser') on:useNewSystemBrowser.
box addHorizontalLine.
box addCheckBox:(resources string:'Use the New VersionDiff Browser') on:useNewVersionDiffBrowser.
box addHorizontalLine.
(Smalltalk at:#FileBrowserV2) isBehavior ifTrue:[
box addCheckBox:(resources string:'Use the New File Browser') on:useNewFileBrowser.
box addHorizontalLine.
].
(Smalltalk at:#FileDialog) isBehavior ifTrue:[
box addCheckBox:(resources string:'Use the New File Dialog') on:useNewFileDialog.
box addHorizontalLine.
].
(Smalltalk at:#SettingsDialog) isBehavior ifTrue:[
box addCheckBox:(resources string:'Use the New Settings Dialog') on:useNewSettingsApplication.
box addHorizontalLine.
].
(Smalltalk at:#ProcessMonitorV2) isBehavior ifTrue:[
box addCheckBox:(resources string:'Use the New ProcessMonitor') on:useProcessMonitorV2.
box addHorizontalLine.
].
box addCheckBox:(resources string:'Use the New Changes Browser') on:useNewChangesBrowser.
box addHorizontalLine.
box addCheckBox:(resources string:'Use Hierarchical Inspector') on:useNewInspector.
box addHorizontalLine.
box addCheckBox:(resources string:'Show Clock in Launcher') on:showClockInLauncher.
box addHorizontalLine.
in := box
addLabelledInputField:(resources string:'Transcripts Buffer Size:')
adjust:#right
on:transcriptBufferSize
tabable:true
separateAtX:0.6.
in acceptChannel:acceptChannel.
box addHorizontalLine.
box
addHelpButtonFor:'Launcher/toolSettings.html';
addAbortAndOkButtons.
"/
"/ show the box ...
"/
box open.
"/
"/ update system settings
"/
box accepted ifTrue:[
acceptChannel value:false; value:true.
currentUserPrefs useNewInspector:useNewInspector value.
currentUserPrefs useNewChangesBrowser:useNewChangesBrowser value.
currentUserPrefs useNewSystemBrowser:useNewSystemBrowser value.
currentUserPrefs useNewVersionDiffBrowser:useNewVersionDiffBrowser value.
currentUserPrefs useNewFileBrowser:useNewFileBrowser value.
currentUserPrefs useNewFileDialog:useNewFileDialog value.
currentUserPrefs useProcessMonitorV2:useProcessMonitorV2 value.
currentUserPrefs useNewSettingsApplication ~= useNewSettingsApplication value ifTrue:[
currentUserPrefs useNewSettingsApplication:useNewSettingsApplication value.
NewLauncher open.
].
(Smalltalk at:#FileBrowserV2) isBehavior ifTrue:[
useNewFileBrowser value ifTrue:[
FileBrowserV2 installInLauncher.
] ifFalse:[
FileBrowserV2 isLoaded ifTrue:[
FileBrowserV2 removeFromLauncher.
]
].
].
showClock := showClockInLauncher value.
currentUserPrefs showClockInLauncher ~= showClock ifTrue:[
currentUserPrefs showClockInLauncher:showClock.
Transcript current isExternalStream ifFalse:[
launcher := Transcript application.
(launcher isKindOf:ToolApplicationModel) ifTrue:[
showClock ifTrue:[
launcher startClock
] ifFalse:[
launcher stopClock
]
]
]
].
Inspector := currentUserPrefs inspectorClassSetting.
transcriptBufferSize := Integer readFrom:transcriptBufferSize value onError:Transcript current lineLimit.
Transcript current lineLimit:transcriptBufferSize.
].
box destroy
"
self toolSettings
"
"Modified: / 9.9.1996 / 22:43:36 / stefan"
"Modified: / 16.4.1998 / 17:18:47 / ca"
"Created: / 13.10.1998 / 15:44:36 / cg"
"Modified: / 12.11.2001 / 15:48:54 / cg"
!
viewStyleSettings
self viewStyleSettingsFor:nil
!
viewStyleSettingsFor:requestor
"open a dialog on viewStyle related settings"
|resourceDir dir box
list listView scrView infoLabel infoForwarder newStyle
someRsrcFile didApply resources listUpdater showStandardStylesOnly standardStyles|
showStandardStylesOnly := true asValue.
standardStyles := #(
'decWindows'
'iris'
'motif'
'mswindows95'
'next'
'normal'
'os2'
'st80'
).
resources := self owningClass classResources.
"
search resources directory for a list of .style files ...
"
someRsrcFile := Smalltalk getSystemFileName:('resources' asFilename constructString:'normal.style').
someRsrcFile isNil ifTrue:[
someRsrcFile := Smalltalk getResourceFileName:'normal.style' forPackage:'stx:libview'.
someRsrcFile isNil ifTrue:[
someRsrcFile := Smalltalk getResourceFileName:'styles/normal.style' forPackage:'stx:libview'.
].
].
someRsrcFile notNil ifTrue:[
resourceDir := someRsrcFile asFilename directoryName
] ifFalse:[
resourceDir := Smalltalk getSystemFileName:'resources'.
].
resourceDir isNil ifTrue:[
self warn:'no styles found (missing ''resources'' directory)'.
^ self
].
dir := resourceDir asFilename directoryContents.
list := SelectionInList new.
listUpdater := [
|listOfStyles lastSelection|
lastSelection := list selection.
listOfStyles := dir select:[:aFileName | aFileName asFilename hasSuffix:'style'].
listOfStyles := listOfStyles collect:[:aFileName | aFileName asFilename nameWithoutSuffix].
Filename isCaseSensitive ifFalse:[
listOfStyles := listOfStyles collect:[:aStyleName | aStyleName asLowercase].
].
listOfStyles remove:'generic' ifAbsent:nil; remove:'mswindows3' ifAbsent:nil.
showStandardStylesOnly value ifTrue:[
listOfStyles := listOfStyles select:[:aStyleName | standardStyles includes:aStyleName].
].
listOfStyles sort.
list list:listOfStyles.
list selection:lastSelection.
].
listUpdater value.
showStandardStylesOnly onChangeEvaluate:listUpdater.
infoForwarder := [
|nm sheet comment|
comment := ''.
nm := list selection.
nm notNil ifTrue:[
sheet := ViewStyle fromFile:(nm , '.style').
comment := (sheet at:#comment ifAbsent:'') withoutSeparators.
].
comment := comment withCRs asStringCollection.
comment size == 1 ifTrue:[
comment := comment first
].
infoLabel label:comment
].
list onChangeEvaluate:infoForwarder.
box := Dialog new.
box label:(resources string:'Style Selection').
(box addTextLabel:(resources at:'STYLE_MSG' default:'Select a Style') withCRs) adjust:#left.
listView := SelectionInListView on:list.
listView doubleClickAction:[:sel | box acceptChannel value:true. box hide].
box addCheckBox:(resources string:'standard styles only') on:showStandardStylesOnly.
scrView := box addComponent:(ScrollableView forView:listView) tabable:true.
box addVerticalSpace.
(infoLabel := box addTextLabel:'\\' withCRs) adjust:#centerLeft.
box addAbortAndOkButtons.
"/ mhmh - the newLauncher does not yet handle apply (without close) correctly
"/ b := box addButton:(Button label:(resources string:'apply')).
"/ b action:[didApply := true. requestor changeViewStyleTo:(list selection)].
(standardStyles includes:View defaultStyle) ifFalse:[
showStandardStylesOnly value:false
].
list selection:(View defaultStyle).
box stickAtBottomWithVariableHeight:scrView.
box stickAtBottomWithFixHeight:infoLabel.
didApply := false.
box open.
box destroy.
box accepted ifTrue:[
((newStyle := list selection) ~= View defaultStyle
or:[didApply ~~ true]) ifTrue:[
requestor notNil ifTrue:[requestor changeViewStyleTo:newStyle].
].
].
"
self viewStyleSettingsFor:nil
"
"Modified: / 07-11-2006 / 13:58:06 / cg"
! !
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs-file'!
objectModuleDialog
"opens a moduleInfo dialog"
self objectModuleDialogReadOnly:false
"Modified: / 19-09-2006 / 19:14:20 / cg"
!
objectModuleDialogReadOnly
"opens a moduleInfo dialog"
self objectModuleDialogReadOnly:true
"Created: / 19-09-2006 / 19:14:27 / cg"
!
objectModuleDialogReadOnly:readOnly
"opens a moduleInfo dialog"
|allModules moduleNames
allObjects methodObjects methodNames
cObjects cObjectNames
otherObjects otherObjectNames
box l handles unloadButton unloadAndRemoveButton
list1 list2 listView1 listView2
y panel
showBuiltIn showModules showMethods showCObjects showOthers
moduleListUpdater check canDoIt menu
resources middleLabel device screenW screenH|
resources := self owningClass classResources.
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 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 id) > (b id)].
moduleNames := allModules collect:[:entry | entry 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.
].
showBuiltIn value ifTrue:[
l := #('VM') , l.
handles := #(VM) , handles.
allModules := #(VM) , allModules.
].
list1 list:l.
readOnly ifFalse:[
unloadButton disable.
unloadAndRemoveButton disable.
]
].
showBuiltIn onChangeEvaluate:moduleListUpdater.
showModules onChangeEvaluate:moduleListUpdater.
showMethods onChangeEvaluate:moduleListUpdater.
showCObjects onChangeEvaluate:moduleListUpdater.
showOthers onChangeEvaluate:moduleListUpdater.
box := Dialog new.
box label:(resources string:'ST/X & Module Version Information').
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 l|
tabs := TabulatorSpecification unit:#inch positions:#(0 2.6 3.5).
(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:[
middleLabel label:'contains method:'.
(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:[ |who|
who := method who.
UserPreferences systemBrowserClass
openInClass:(who methodClass)
selector:(who methodSelector)
].
listView1 middleButtonMenu:menu.
nm := (method whoString) colorizeAllWith:(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 address hexPrintString leftPaddedTo:8 with:$0)).
list2 list:(Array with:entry1 with:entry2 with:entry3).
] ifFalse:[
(module isFunctionObjectHandle
and:[module functions notEmpty]) ifTrue:[
middleLabel label:'contains function:'.
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 colorizeAllWith:Color blue).
entry colAt:2 put:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)).
entry
]).
] ifFalse:[
list2 list:#('nothing known about contents (no functions have been extracted)').
]
].
readOnly ifFalse:[
unloadButton enable.
unloadAndRemoveButton disable.
]
] ifFalse:[
info == #VM ifTrue:[
"/ dummy entry for VM;
"/ show file versions in lower view.
middleLabel label:'contains modules:'.
l := (ObjectMemory getVMIdentificationStrings).
l := l select:[:entry | entry includesString:'$Header'].
l := l select:[:entry | entry includesString:',v'].
l := l collect:[:entry |
|i1 i2 file revision date listEntry|
listEntry := MultiColListEntry new:3 tabulatorSpecification:tabs.
i1 := entry indexOfSubCollection:'librun'.
i1 ~~ 0 ifTrue:[
i2 := entry indexOfSubCollection:',v' startingAt:i1.
i2 ~~ 0 ifTrue:[
file := entry copyFrom:i1+7 to:(i2-1).
listEntry colAt:1 put:file.
i1 := i2+3.
i2 := entry indexOfSeparatorStartingAt:i1.
revision := entry copyFrom:i1 to:(i2-1).
listEntry colAt:2 put:revision.
i1 := i2+1.
i2 := entry indexOfSeparatorStartingAt:i1.
date := entry copyFrom:i1 to:(i2-1).
listEntry colAt:3 put:date.
].
].
listEntry.
"/ entry
].
list2 list:l.
readOnly ifFalse:[
unloadButton disable.
unloadAndRemoveButton disable.
]
] ifFalse:[
"/ selected a package
"/ fill bottom list with class-info
middleLabel label:'contains classes:'.
classNames := info classNames asSortedCollection.
classNames := classNames select:[:cName |
|cls|
cls := Smalltalk classNamed:cName.
cls isNil ifTrue:[
true "a removed class"
] ifFalse:[
cls isPrivate not
].
].
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 printString)
].
listEntry colAt:2 put:entry , ')'
] ifFalse:[
cls revision notNil ifTrue:[
listEntry colAt:2 put:'(overloaded by: ' , cls revision , ')'
]
]
].
listEntry
].
list2 list:classNames.
readOnly ifFalse:[
info dynamic ifTrue:[
unloadButton enable.
unloadAndRemoveButton enable.
] ifFalse:[
unloadButton disable.
unloadAndRemoveButton 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 preferredHeight).
listView1 origin:0.0@0.0 corner:1.0@0.4. "/ ; inset:2.
l := box addTextLabel:(resources string:'Contains:').
l adjust:#left; borderWidth:0.
l origin:0.0@0.4 corner:1.0@0.4.
l topInset:(View viewSpacing).
l bottomInset:((l preferredHeight) negated - View viewSpacing).
middleLabel := l.
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.
menu := PopUpMenu
itemList:#(
('Copy List' copyList )
)
resources:resources.
menu
actionAt:#copyList
put:[ listView2 setClipboardText:((listView2 list collect:[:l | l string]) asStringCollection asString) ].
listView2 middleButtonMenu:menu.
readOnly ifFalse:[
unloadButton := Button label:(resources string:'Unload').
unloadButton action:[
box withWaitCursorDo:[
|handle idx|
idx := list1 selectionIndex.
list1 selectionIndex:nil.
handle := handles at:idx.
handle notNil ifTrue:[
handle unload.
].
moduleListUpdater value.
unloadButton disable.
]
].
unloadAndRemoveButton := Button label:(resources string:'Remove Classes & Unload').
unloadAndRemoveButton action:[
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 pathName.
].
ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName.
moduleListUpdater value.
unloadAndRemoveButton disable.
]
].
].
moduleListUpdater value.
readOnly ifFalse:[
box addButton:unloadButton.
box addButton:unloadAndRemoveButton.
].
box addAbortButtonLabelled:(resources string:'Dismiss').
y := box yPosition.
listView2 topInset:(l preferredHeight + 5).
listView2 bottomInset:(box preferredHeight - y).
device := box device.
screenW := device width.
screenH := device height.
box width:(400 min:(screenW * 2 // 3));
height:(450 min:(screenH - 50)).
"/ box sizeFixed:true.
box extent:(600 min:(screenW * 2 // 3))
@
(500 min:(screenH - 50)) .
box openModeless.
"/ box destroy.
"
self objectModuleDialog
"
"Modified: / 17-09-1995 / 16:47:50 / claus"
"Created: / 19-09-2006 / 19:14:06 / cg"
!
packageDialog
<resource: #obsolete>
"opens a package dialog. Obsolete"
|allPackages packageList packageUpdater
box listView tabs
menu resources selectedPackage|
self obsoleteMethodWarning.
resources := self owningClass classResources.
box := Dialog new.
box label:(resources string:'Packages').
allPackages := Set new.
allPackages addAll:(Smalltalk knownPackages).
Project knownProjects do:[:package |
allPackages add:(package name)
].
Project loadedProjects do:[:package |
allPackages add:(package name)
].
allPackages := allPackages asOrderedCollection sort.
packageUpdater := [
tabs := TabulatorSpecification unit:#inch positions:#(0 4).
packageList := allPackages collect:[:pName | |pkg entry|
entry := MultiColListEntry new:2 tabulatorSpecification:tabs.
pkg := Project projectWithId:pName asSymbol.
(pkg notNil and:[pkg isLoaded]) ifTrue:[
entry colAt:1 put:pName allBold.
entry colAt:2 put:'loaded'.
] ifFalse:[
entry colAt:1 put:pName.
(Smalltalk allClasses
contains:[:cls | cls package = pName and:[cls isLoaded not]])
ifTrue:[
(Smalltalk allClasses
contains:[:cls | cls package = pName and:[cls isLoaded]])
ifTrue:[
entry colAt:2 put:'loaded/autoloaded'.
] ifFalse:[
entry colAt:2 put:'autoloaded'.
]
]
].
entry
].
].
packageUpdater value.
listView := HVScrollableView for:SelectionInListView miniScrollerH:true.
listView list:packageList.
box addComponent:listView tabable:true.
listView origin:0.0@0.0 corner:1.0@1.0.
listView bottomInset:40.
listView action:[:selIndex | |pkg|
selectedPackage := (allPackages at:selIndex) asSymbol.
pkg := Project projectWithId:selectedPackage.
(pkg notNil and:[pkg isLoaded]) ifTrue:[
menu disable:#load.
"/ menu enable:#unload.
] ifFalse:[
"/ menu disable:#unload.
menu enable:#load.
]
].
menu := PopUpMenu
itemList:#(
('load...' load )
"/ ('-' nil )
"/ ('unload...' unload)
)
resources:resources.
listView middleButtonMenu:menu.
menu actionAt:#load put:[
box withWaitCursorDo:[
Smalltalk loadPackage:selectedPackage.
packageUpdater value.
]
].
"/ menu actionAt:#unload put:[
"/ box withWaitCursorDo:[
"/ Smalltalk unloadPackage:selectedPackage.
"/ packageUpdater value.
"/ ].
"/ ].
menu disable:#load.
"/ menu disable:#unload.
box addAbortButtonLabelled:(resources string:'dismiss').
box width:(400 min:(box device width * 2 // 3));
height:(450 min:(box device height - 50)).
box openWithExtent:(600 min:(box device width * 2 // 3))
@
(500 min:(box device height - 50)) .
box destroy.
"
self packageDialog
"
! !
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs-private'!
cvsConfigurationDialog
|cvsRootHolder resources defaultsList bindings dialog
listOfModules selectedPerModuleRoot rootsPerModule acceptChannel
removeEnabled cvsExecutableHolder|
resources := self owningClass classResources.
OperatingSystem getDomainName = 'bh.exept.de' ifTrue:[
defaultsList := #(
'cvs.bh.exept.de:/cvs/stx'
).
defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@cvs.bh.exept.de:/cvs/stx')
] ifFalse:[
defaultsList := #(
':pserver:user@CVSHOST:/cvs/stx'
).
defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@CVSHOST:/cvs/stx')
].
OperatingSystem isUNIXlike ifTrue:[
defaultsList := defaultsList , #(
'/cvs/stx'
).
] ifFalse:[
OperatingSystem isMSDOSlike ifTrue:[
defaultsList := defaultsList , #(
':local:c:\cvs\stx'
).
] ifFalse:[
"there might be more here in the future"
]
].
cvsRootHolder := CVSSourceCodeManager repositoryName ? '/cvs/stx'.
cvsRootHolder := cvsRootHolder asValue.
rootsPerModule := Dictionary new.
rootsPerModule addAll:(CVSSourceCodeManager repositoryInfoPerModule).
cvsExecutableHolder := CVSSourceCodeManager cvsExecutable asValue.
bindings := IdentityDictionary new.
bindings at:#acceptChannel put:(acceptChannel := TriggerValue new).
bindings at:#cvsRootPrototypeList put:defaultsList.
bindings at:#cvsRootHolder put:cvsRootHolder.
bindings at:#perModuleRootModule put:nil asValue.
bindings at:#perModuleRoot put:nil asValue.
bindings at:#removeEnabled put:(removeEnabled := false asValue).
bindings at:#listOfModules put:(listOfModules := rootsPerModule keys asList).
bindings at:#cvsExecutableHolder put:cvsExecutableHolder.
listOfModules sort.
bindings at:#selectedPerModuleRoot put:(selectedPerModuleRoot := nil asValue).
selectedPerModuleRoot
onChangeEvaluate:[
|module cvsRoot|
acceptChannel value:true.
module := selectedPerModuleRoot value.
removeEnabled value:true.
cvsRoot := rootsPerModule at:module ifAbsent:''.
(bindings at:#perModuleRootModule) value:module.
(bindings at:#perModuleRoot) value:cvsRoot.
].
bindings at:#help put:[
WindowGroup activeGroup withWaitCursorDo:[
HTMLDocumentView openFullOnHelpFile:'Launcher/cvsSetup.html'
]
].
bindings at:#addPerModuleRoot put:[
|module cvsRoot|
acceptChannel value:true.
module := (bindings at:#perModuleRootModule) value.
cvsRoot := (bindings at:#perModuleRoot) value.
(listOfModules includes:module) ifFalse:[
listOfModules add:module.
listOfModules sort.
].
cvsRoot size > 0 ifTrue:[
rootsPerModule at:module put:cvsRoot.
].
].
bindings at:#removePerModuleRoot put:[
|module|
acceptChannel value:true.
module := (bindings at:#perModuleRootModule) value.
listOfModules remove:module ifAbsent:nil.
rootsPerModule removeKey:module ifAbsent:nil.
(bindings at:#perModuleRootModule) value:nil.
(bindings at:#perModuleRoot) value:nil.
].
dialog := SimpleDialog new.
dialog resources:resources.
(dialog openSpec:(self cvsSetupSpec) withBindings:bindings) ifFalse:[
^ self
].
acceptChannel value.
"/
"/ update system settings
"/
CVSSourceCodeManager cvsExecutable:cvsExecutableHolder value.
CVSSourceCodeManager initializeForRepository:cvsRootHolder value.
CVSSourceCodeManager repositoryInfoPerModule:rootsPerModule.
"
self cvsConfigurationDialog
"
"Modified: / 21-09-2006 / 16:54:20 / cg"
!
fontBoxForEncoding:encodingMatch
"open a fontBox, showing fonts which match some encoding
(used when changing to japanese ...)"
|box y b
labelDef buttonDef listDef menuDef textDef
models labels allOfThem filter resources defaultButton|
resources := self owningClass classResources.
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' 'Edited 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.
f isNil ifTrue:[
''
] ifFalse:[
f userFriendlyName
]
]
argument:model).
labels add:lbl.
box leftIndent:i.
box yPosition:(box yPosition max:y2).
box addVerticalSpace; addHorizontalLine; addVerticalSpace.
b action:[
|f|
f := FontPanel
fontFromUserInitial:(model value)
title:(resources string:'Font for %1' with:title)
filter:filter
encoding:encodingMatch.
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 addAbortAndOkButtons.
defaultButton := Button label:(resources string:'Defaults').
(Dialog defaultOKButtonAtLeft) ifTrue:[
box addButton:defaultButton after:nil.
] ifFalse:[
box addButton:defaultButton before:nil.
].
defaultButton
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.
TextView withAllSubclasses do:[:cls | cls defaultFont:textDef value].
SelectionInListView withAllSubclasses do:[:cls | cls defaultFont:listDef value].
MenuView defaultFont:menuDef value.
MenuPanel defaultFont:menuDef value.
NoteBookView defaultFont:menuDef value.
PullDownMenu defaultFont:menuDef value.
].
box destroy.
^ box accepted
"Created: / 27-02-1996 / 01:44:16 / cg"
"Modified: / 17-06-1996 / 13:38:48 / stefan"
"Modified: / 08-03-2007 / 23:02:32 / cg"
!
formattingConfigurationDialog
|dialog
resources exampleText formattedText reformatAction
reformatLocked
oldUserPreferences
currentUserPrefs
tabIndent
spaceAroundTemporaries emptyLineAfterTemporaries
spaceAfterReturnToken spaceAfterKeywordSelector cStyleBlocks
blockArgumentsOnNewLine
maxLengthForSingleLineBlocks resetValue bindings|
RBFormatter isNil ifTrue:[
^ self warn:'Sorry, no RBFormatter class'.
].
RBFormatter isLoaded ifFalse:[
WindowGroup activeGroup withWaitCursorDo:[
RBFormatter autoload
]
].
resources := self owningClass classResources.
currentUserPrefs := UserPreferences current.
exampleText :=
'methodSelector:methodArg
"method comment:
some stupid code to show the current settings"
|index|
"/ another comment ...
self at:index. "/ a message
self at:index put:methodArg. "/ a two arg message
self from:1 to:index put:methodArg. "/ a three arg message
methodArg ifTrue:[
Transcript showCR:''hello''. "/ condition
].
methodArg ifTrue:[
Transcript showCR:''hello''. "/ condition
] ifFalse:[
Transcript showCR:''world''.
].
[methodArg] whileTrue:[
Transcript showCR:''hello''. "/ looping
].
[self aVeryLongConditionBlock and:[self toMakeBlockLonger]] whileTrue:[
Transcript showCR:''hello''. "/ long blocks
].
methodArg do:[:element |
Transcript showCR:''hello''. "/ looping
].
1 to:methodArg size do:[:index |
Transcript showCR:''hello''. "/ looping
].
methodArg keysAndValuesDo:[:index |
Transcript showCR:''hello''. "/ looping
].
Object errorSignal handle:[:ex |
ex return
] do:[ "/ exception handling
self someAction "/ blocks
].
^ self.
'.
formattedText := '' asValue.
reformatLocked := false.
reformatAction := [ |tree
s_tabIndent s_spaceAroundTemporaries s_emptyLineAfterTemporaries
s_spaceAfterReturnToken s_spaceAfterKeywordSelector s_cStyleBlocks
s_maxLengthForSingleLineBlocks s_blockArgumentsOnNewLine|
reformatLocked ifFalse:[
"/
"/ temporary change the RBFormatters settings ...
"/
s_tabIndent := RBFormatter tabIndent.
s_spaceAroundTemporaries := RBFormatter spaceAroundTemporaries.
s_emptyLineAfterTemporaries := RBFormatter emptyLineAfterTemporaries.
s_spaceAfterReturnToken := RBFormatter spaceAfterReturnToken.
s_spaceAfterKeywordSelector := RBFormatter spaceAfterKeywordSelector.
s_cStyleBlocks := RBFormatter cStyleBlocks.
s_blockArgumentsOnNewLine := RBFormatter blockArgumentsOnNewLine.
s_maxLengthForSingleLineBlocks := RBFormatter maxLengthForSingleLineBlocks.
RBFormatter
tabIndent:tabIndent value;
spaceAroundTemporaries:spaceAroundTemporaries value;
emptyLineAfterTemporaries:emptyLineAfterTemporaries value;
spaceAfterReturnToken:spaceAfterReturnToken value;
spaceAfterKeywordSelector:spaceAfterKeywordSelector value;
cStyleBlocks:cStyleBlocks value;
blockArgumentsOnNewLine:blockArgumentsOnNewLine value;
maxLengthForSingleLineBlocks:maxLengthForSingleLineBlocks value.
tree := RBParser
parseMethod:exampleText
onError: [:aString :position | nil].
tree do:[:node |
(node ~~ tree and:[node parent isNil]) ifTrue:[
self error:'No parent for node'.
]
].
formattedText value:tree printString.
RBFormatter
tabIndent:s_tabIndent;
spaceAroundTemporaries:s_spaceAroundTemporaries;
emptyLineAfterTemporaries:s_emptyLineAfterTemporaries;
spaceAfterReturnToken:s_spaceAfterReturnToken;
spaceAfterKeywordSelector:s_spaceAfterKeywordSelector;
cStyleBlocks:s_cStyleBlocks;
blockArgumentsOnNewLine:s_blockArgumentsOnNewLine;
maxLengthForSingleLineBlocks:s_maxLengthForSingleLineBlocks.
].
].
bindings := IdentityDictionary new.
bindings at:#formattedText put:formattedText.
oldUserPreferences := currentUserPrefs copy.
tabIndent := RBFormatter tabIndent asValue.
tabIndent onChangeEvaluate:reformatAction.
bindings at:#tabIndent put:tabIndent.
spaceAroundTemporaries := RBFormatter spaceAroundTemporaries asValue.
spaceAroundTemporaries onChangeEvaluate:reformatAction.
bindings at:#spaceAroundTemporaries put:spaceAroundTemporaries.
emptyLineAfterTemporaries := RBFormatter emptyLineAfterTemporaries asValue.
emptyLineAfterTemporaries onChangeEvaluate:reformatAction.
bindings at:#emptyLineAfterTemporaries put:emptyLineAfterTemporaries.
spaceAfterReturnToken := RBFormatter spaceAfterReturnToken asValue.
spaceAfterReturnToken onChangeEvaluate:reformatAction.
bindings at:#spaceAfterReturnToken put:spaceAfterReturnToken.
spaceAfterKeywordSelector := RBFormatter spaceAfterKeywordSelector asValue.
spaceAfterKeywordSelector onChangeEvaluate:reformatAction.
bindings at:#spaceAfterKeywordSelector put:spaceAfterKeywordSelector.
cStyleBlocks := RBFormatter cStyleBlocks asValue.
cStyleBlocks onChangeEvaluate:reformatAction.
bindings at:#cStyleBlocks put:cStyleBlocks.
blockArgumentsOnNewLine := RBFormatter blockArgumentsOnNewLine asValue.
blockArgumentsOnNewLine onChangeEvaluate:reformatAction.
bindings at:#blockArgumentsOnNewLine put:blockArgumentsOnNewLine.
maxLengthForSingleLineBlocks := RBFormatter maxLengthForSingleLineBlocks asValue.
maxLengthForSingleLineBlocks onChangeEvaluate:reformatAction.
bindings at:#maxLengthForSingleLineBlocks put:maxLengthForSingleLineBlocks.
bindings at:#resetList put:#( 'ST/X default' 'RB default' ).
bindings at:#resetValue put:(resetValue := nil asValue).
resetValue onChangeEvaluate:
[
resetValue value == 1 ifTrue:[
"/ ST/X defaults
reformatLocked := true.
tabIndent value: 4.
spaceAfterReturnToken value: true.
spaceAfterKeywordSelector value: false.
spaceAroundTemporaries value: false.
emptyLineAfterTemporaries value: true.
cStyleBlocks value: true.
blockArgumentsOnNewLine value:false.
maxLengthForSingleLineBlocks value: 20.
reformatLocked := false.
reformatAction value.
].
resetValue value == 2 ifTrue:[
"/ RBParser defaults
reformatLocked := true.
tabIndent value: 8.
spaceAfterReturnToken value: false.
spaceAfterKeywordSelector value: true.
spaceAroundTemporaries value: true.
emptyLineAfterTemporaries value: false.
cStyleBlocks value: false.
blockArgumentsOnNewLine value:false.
maxLengthForSingleLineBlocks value: 20.
reformatLocked := false.
reformatAction value.
].
resetValue value:nil. "/ to force default label
].
reformatAction value.
"/
"/ create a box on those ...
"/
dialog := SimpleDialog new.
dialog postBuildBlock:[:builder |
(builder componentAt:#sampleTextView)
cursorMovementWhenUpdating:nil;
scrollWhenUpdating:nil.
].
(dialog openFor:nil
spec:(self formatterDialogSpec)
withBindings:bindings)
ifTrue:[
currentUserPrefs at:#'formatter.tabIndent' put:tabIndent value.
currentUserPrefs at:#'formatter.spaceAroundTemporaries' put:spaceAroundTemporaries value.
currentUserPrefs at:#'formatter.emptyLineAfterTemporaries' put:emptyLineAfterTemporaries value.
currentUserPrefs at:#'formatter.spaceAfterReturnToken' put:spaceAfterReturnToken value.
currentUserPrefs at:#'formatter.spaceAfterKeywordSelector' put:spaceAfterKeywordSelector value.
currentUserPrefs at:#'formatter.cStyleBlocks' put:cStyleBlocks value.
currentUserPrefs at:#'formatter.blockArgumentsOnNewLine' put:blockArgumentsOnNewLine value.
currentUserPrefs at:#'formatter.maxLengthForSingleLineBlocks' put:maxLengthForSingleLineBlocks value.
RBFormatter
tabIndent:tabIndent value;
spaceAroundTemporaries:spaceAroundTemporaries value;
emptyLineAfterTemporaries:emptyLineAfterTemporaries value;
spaceAfterReturnToken:spaceAfterReturnToken value;
spaceAfterKeywordSelector:spaceAfterKeywordSelector value;
cStyleBlocks:cStyleBlocks value;
blockArgumentsOnNewLine:blockArgumentsOnNewLine value;
maxLengthForSingleLineBlocks:maxLengthForSingleLineBlocks value.
] ifFalse: [
(UserPreferences reset; current) addAll: oldUserPreferences
].
"
self formattingConfigurationDialog
"
!
syntaxColorConfigurationDialog
|box frame exampleView y
resources exampleText coloredText recolorAction
syntaxColor syntaxColors colorMenu oldUserPreferences
syntaxEmphasises syntaxColorSelector syntaxEmphasisSelector syntaxColoringBox
syntaxEmphasisesBox syntaxColoringResetButton b resetList
resetListBox currentUserPrefs|
resources := self owningClass classResources.
currentUserPrefs := UserPreferences current.
exampleText :=
'methodSelector:methodArg
"method comment:
some stupid code to show the current settings"
|methodVar|
"/ another comment ...
self at:methodArg. "/ a message
self fooBarBaz:methodVar. "/ a bad message
methodVar := Array new:1.
unknonVar := 1. "/ a bad variable
UnknonVar := 1. "/ another bad variable
"self bar:methodVar. detect commented code easily"
1 to:5 do:[:i | self at:i + 1].
Transcript showCR:''some string'' , #someSymbol.
^ self.
'.
coloredText := '' asValue.
recolorAction := [ coloredText value:(SyntaxHighlighter formatMethod:exampleText in:nil) ].
recolorAction value.
"/
"/ create a box on those values ...
"/
box := DialogBox new.
box label:(resources string:'Syntax Colors').
frame := View new.
frame extent:1.0 @ 200.
frame borderWidth:0.
exampleView := HVScrollableView for:TextView in:frame.
exampleView model:coloredText.
exampleView origin:0.0@0.0 corner:1.0@1.0; inset:2.
frame topInset:box yPosition.
box addComponent:frame withExtent:1.0@200.
box makeTabable:exampleView.
frame width:1.0.
box addVerticalSpace.
oldUserPreferences := currentUserPrefs copy.
syntaxColoringBox := box addComboListOn: (syntaxColors := SelectionInList with:UserPreferences syntaxColorNames initialSelection:1).
syntaxColorSelector := [(syntaxColors selection replChar:$ withString: '') asLowercaseFirst asSymbol].
syntaxEmphasisSelector := [((syntaxColorSelector value readStream upToAll: 'Color'), 'Emphasis') asLowercaseFirst asSymbol].
syntaxColor := (currentUserPrefs perform: syntaxColorSelector value) asValue.
colorMenu := ColorMenu new.
colorMenu model: syntaxColor.
syntaxColor onChangeEvaluate:
[currentUserPrefs at: syntaxColorSelector value put: syntaxColor value.
recolorAction value.].
syntaxColors onChangeEvaluate:
[|eVal|
syntaxColor value: (currentUserPrefs perform:syntaxColorSelector value).
eVal := currentUserPrefs perform: syntaxEmphasisSelector value.
eVal isArray ifTrue:[
eVal = (Array with:#underwave with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[
eVal := #'red underwave'
].
eVal = (Array with:#bold with:#underwave with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[
eVal := #'bold+red underwave'
].
eVal = (Array with:#bold with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[
eVal := #'bold+red underline'
].
eVal = (Array with:#italic with:#underwave with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[
eVal := #'italic+red underwave'
].
eVal = (Array with:#italic with:#underlineColor->(Color red:100.0 green:0.0 blue:0.0)) ifTrue:[
eVal := #'italic+red underline'
].
].
syntaxEmphasises selection: eVal.
recolorAction value.].
syntaxEmphasises := SelectionInList
with:#(
normal
underline
#'red underline'
underwave
#'red underwave'
bold
boldUnderline
#'bold+red underline'
boldUnderwave
#'bold+red underwave'
italic
italicUnderline
#'italic+red underline'
italicUnderwave
#'italic+red underwave'
reverse
)
initialSelection:1.
syntaxEmphasisesBox := box addComboListOn:syntaxEmphasises.
syntaxEmphasises
onChangeEvaluate:[ |em|
em := syntaxEmphasises selection.
em notNil ifTrue:[
em := em asSymbol.
em == #'red underline' ifTrue:[ em := Array with:#underline with:(#underlineColor->Color red)].
em == #'red underwave' ifTrue:[ em := Array with:#underwave with:(#underlineColor->Color red)].
em == #'bold+red underline' ifTrue:[ em := Array with:#bold with:#underline with:(#underlineColor->Color red)].
em == #'bold+red underwave' ifTrue:[ em := Array with:#bold with:#underwave with:(#underlineColor->Color red)].
em == #'italic+red underline' ifTrue:[ em := Array with:#italic with:#underline with:(#underlineColor->Color red)].
em == #'italic+red underwave' ifTrue:[ em := Array with:#italic with:#underwave with:(#underlineColor->Color red)].
currentUserPrefs at: syntaxEmphasisSelector value put:em.
].
recolorAction value
].
syntaxColors changed:#value. "/ to force initial update of emphasis
box addComponent:colorMenu tabable:true.
y := box yPosition.
b := Button new label: (resources string:'reset to:').
b action:[
|resetSelector|
resetSelector := (currentUserPrefs listOfPredefinedSyntaxColoringSchemes
collect:[:eachEntry | eachEntry first])
at:resetList selectionIndex.
currentUserPrefs perform:resetSelector.
recolorAction value.
].
syntaxColoringResetButton := box addComponent:b.
box makeTabable:syntaxColoringResetButton.
box yPosition:y.
resetList := SelectionInList
with:(currentUserPrefs listOfPredefinedSyntaxColoringSchemes
collect:[:eachEntry | eachEntry second])
initialSelection:1.
resetListBox := box addComboListOn:resetList.
box makeTabable:resetListBox.
syntaxColoringBox enable.
colorMenu enable.
syntaxEmphasisesBox enable.
syntaxColoringResetButton enable.
box
"/ addHelpButtonFor:'Launcher/sourceSettings.html';
addAbortAndOkButtons.
box stickAtBottomWithVariableHeight:frame.
box stickAtBottomWithFixHeight:syntaxColoringBox.
box stickAtBottomWithFixHeight:syntaxEmphasisesBox.
box stickAtBottomWithFixHeight:colorMenu.
box stickAtBottomWithFixHeight:syntaxColoringResetButton left:0.0 right:0.5.
box stickAtBottomWithFixHeight:resetListBox left:0.5 right:1.0.
"/
"/ show the box ...
"/
box extent:600@400.
box openModal.
"/
"/ update system settings
"/
box accepted ifFalse: [
(UserPreferences reset; current) addAll:oldUserPreferences
].
box destroy
"Modified: / 16.4.1998 / 17:18:16 / ca"
"Modified: / 7.7.1999 / 00:27:02 / cg"
! !
!AbstractLauncherApplication::LauncherDialogs class methodsFor:'interface specs'!
cvsSetupSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:AbstractLauncherApplication::LauncherDialogs andSelector:#cvsSetupSpec
"
<resource: #canvas>
^
#(FullSpec
name: cvsSetupSpec
window:
(WindowSpec
label: 'CVS Setup'
name: 'CVS Setup'
min: (Point 436 316)
bounds: (Rectangle 14 46 450 400)
)
component:
(SpecCollection
collection: (
(LabelSpec
label: 'CVS BinDirectory:'
name: 'Label1'
layout: (LayoutFrame 0 0.0 36 0 40 0.25 53 0)
level: 0
translateLabel: true
adjust: right
)
(InputFieldSpec
name: 'BinDirectoryField'
layout: (LayoutFrame 44 0.25 34 0 -1 1 56 0)
tabable: true
model: cvsBinDirectoryHolder
acceptChannel: acceptChannel
acceptOnPointerLeave: false
)
(DividerSpec
name: 'Separator3'
layout: (LayoutFrame 0 0.0 60 0 0 1.0 64 0)
)
(LabelSpec
label: 'CVS SourceCodeManager setup'
name: 'label'
layout: (LayoutFrame 1 0.0 3 0 -1 1.0 20 0)
translateLabel: true
adjust: left
)
(LabelSpec
label: 'CVSRoot default:'
name: 'defaultCvsRootLabel'
layout: (LayoutFrame 0 0.0 71 0 40 0.25 88 0)
level: 0
translateLabel: true
adjust: right
)
(ComboBoxSpec
name: 'cvsRootComboBox'
layout: (LayoutFrame 44 0.25 71 0 -1 1.0 93 0)
tabable: true
model: cvsRootHolder
immediateAccept: true
acceptOnLeave: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptChannel: acceptChannel
acceptOnPointerLeave: false
comboList: cvsRootPrototypeList
)
(DividerSpec
name: 'Separator1'
layout: (LayoutFrame 0 0.0 96 0 0 1.0 100 0)
)
(LabelSpec
label: 'CVSRoot per Module:'
name: 'knownModulesLabel'
layout: (LayoutFrame 0 0.0 109 0 40 0.25 126 0)
translateLabel: true
adjust: right
)
(SequenceViewSpec
name: 'List1'
layout: (LayoutFrame 44 0.25 104 0 -1 1 202 0)
tabable: true
model: selectedPerModuleRoot
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
miniScrollerHorizontal: true
useIndex: false
sequenceList: listOfModules
)
(LabelSpec
label: 'Module:'
name: 'moduleLabel'
layout: (LayoutFrame 0 0.0 209 0 40 0.25 226 0)
translateLabel: true
adjust: right
)
(InputFieldSpec
name: 'perModuleRootModuleEntryField'
layout: (LayoutFrame 44 0.25 205 0 -1 1 227 0)
tabable: true
model: perModuleRootModule
acceptChannel: acceptChannel
acceptOnPointerLeave: false
)
(LabelSpec
label: 'CVSRoot:'
name: 'cvsRootLabel'
layout: (LayoutFrame 0 0.0 236 0 40 0.25 253 0)
translateLabel: true
adjust: right
)
(ComboBoxSpec
name: 'perModuleRootComboBox'
layout: (LayoutFrame 44 0.25 232 0 -1 1.0 254 0)
tabable: true
model: perModuleRoot
immediateAccept: true
acceptOnLeave: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptChannel: acceptChannel
acceptOnPointerLeave: false
comboList: cvsRootPrototypeList
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 44 0.25 258 0 -1 1 289 0)
horizontalLayout: fitSpace
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Add/Apply'
name: 'addButton'
translateLabel: true
tabable: true
model: addPerModuleRoot
extent: (Point 136 22)
)
(ActionButtonSpec
label: 'Remove'
name: 'removeButton'
translateLabel: true
tabable: true
model: removePerModuleRoot
enableChannel: removeEnabled
extent: (Point 137 22)
)
)
)
)
(DividerSpec
name: 'Separator2'
layout: (LayoutFrame 0 0.0 -45 1 0 1.0 -34 1)
)
(HorizontalPanelViewSpec
name: 'buttonPanel'
layout: (LayoutFrame 0 0.0 -29 1.0 0 1.0 -3 1.0)
horizontalLayout: fitSpace
verticalLayout: center
horizontalSpace: 3
verticalSpace: 3
ignoreInvisibleComponents: true
reverseOrderIfOKAtLeft: true
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Cancel'
name: 'cancelButton'
translateLabel: true
tabable: true
model: cancel
extent: (Point 141 21)
)
(ActionButtonSpec
label: 'Help'
name: 'helpButton'
translateLabel: true
tabable: true
model: help
extent: (Point 141 21)
)
(ActionButtonSpec
label: 'OK'
name: 'okButton'
translateLabel: true
tabable: true
model: accept
isDefault: true
extent: (Point 142 21)
)
)
)
)
)
)
)
!
formatterDialogSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:AbstractLauncherApplication::LauncherDialogs andSelector:#formatterDialogSpec
"
<resource: #canvas>
^
#(FullSpec
name: formatterDialogSpec
window:
(WindowSpec
label: 'Formatting parameters'
name: 'Formatting parameters'
min: (Point 10 10)
bounds: (Rectangle 14 46 610 629)
)
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Sample output:'
name: 'Label2'
layout: (LayoutFrame 0 0.0 4 0 0 1.0 26 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'sampleTextView'
layout: (LayoutFrame 0 0.0 30 0.0 0 1.0 -234 1.0)
level: -1
model: formattedText
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
)
(FramedBoxSpec
label: 'Parameters'
name: 'FramedBox1'
layout: (LayoutFrame 0 0.0 -225 1 0 1.0 -30 1)
labelPosition: topLeft
translateLabel: true
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Max length for single line blocks:'
name: 'Label1'
layout: (LayoutFrame 185 0.0 127 0 66 0.7 153 0)
level: 0
adjust: right
)
(CheckBoxSpec
label: 'Space around temporaries '
name: 'checkBox'
layout: (LayoutFrame 2 0 3 0 260 0 32 0)
level: 0
tabable: true
model: spaceAroundTemporaries
translateLabel: true
)
(CheckBoxSpec
label: 'Blank line after local var declaration'
name: 'CheckBox1'
layout: (LayoutFrame 267 0 3 0 567 0 32 0)
level: 0
tabable: true
model: emptyLineAfterTemporaries
translateLabel: true
)
(CheckBoxSpec
label: 'Space after ''^'''
name: 'CheckBox2'
layout: (LayoutFrame 2 0 31 0 260 0 60 0)
level: 0
tabable: true
model: spaceAfterReturnToken
translateLabel: true
)
(CheckBoxSpec
label: 'Space after '':'' in keywords'
name: 'CheckBox3'
layout: (LayoutFrame 267 0 31 0 567 0 60 0)
level: 0
tabable: true
model: spaceAfterKeywordSelector
translateLabel: true
)
(CheckBoxSpec
label: 'C-Style blocks'
name: 'CheckBox4'
layout: (LayoutFrame 2 0 59 0 260 0 88 0)
level: 0
tabable: true
model: cStyleBlocks
translateLabel: true
)
(InputFieldSpec
name: 'editField'
layout: (LayoutFrame 74 0.7 93 0 -38 1.0 119 0)
level: -1
tabable: true
model: tabIndent
type: number
immediateAccept: false
acceptOnLeave: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptOnPointerLeave: true
)
(LabelSpec
label: 'Indent:'
name: 'label'
layout: (LayoutFrame 242 0.0 93 0 66 0.7 119 0)
level: 0
adjust: right
)
(InputFieldSpec
name: 'EntryField1'
layout: (LayoutFrame 74 0.7 127 0 -38 1.0 153 0)
level: -1
tabable: true
model: maxLengthForSingleLineBlocks
type: number
immediateAccept: false
acceptOnLeave: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptOnPointerLeave: true
)
(PopUpListSpec
label: 'Reset to...'
name: 'PopUpList1'
layout: (LayoutFrame 2 0 129 0 127 0 151 0)
tabable: true
model: resetValue
menu: resetList
useIndex: true
)
(CheckBoxSpec
label: 'Block args on new line'
name: 'CheckBox5'
layout: (LayoutFrame 267 0 59 0 567 0 88 0)
level: 0
tabable: true
model: blockArgumentsOnNewLine
translateLabel: true
)
)
)
)
(HorizontalPanelViewSpec
name: 'horizontalPanelView'
layout: (LayoutFrame 0 0.0 -35 1.0 0 1.0 0 1.0)
level: 0
horizontalLayout: fitSpace
verticalLayout: center
horizontalSpace: 4
verticalSpace: 4
ignoreInvisibleComponents: true
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Cancel'
name: 'button'
translateLabel: true
tabable: true
model: cancel
useDefaultExtent: true
)
(ActionButtonSpec
label: 'OK'
name: 'Button1'
translateLabel: true
tabable: true
model: accept
isDefault: true
useDefaultExtent: true
)
)
)
)
)
)
)
! !
!AbstractLauncherApplication class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.399 2011-02-09 19:40:39 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.399 2011-02-09 19:40:39 cg Exp $'
! !