diff -r 10b4ca8b69aa -r 34760bcd61c4 AbstractLauncherApplication.st --- a/AbstractLauncherApplication.st Fri Dec 04 16:14:06 2009 +0100 +++ b/AbstractLauncherApplication.st Fri Dec 04 16:49:32 2009 +0100 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + 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 @@ -19,7 +19,7 @@ category:'Interface-Smalltalk' ! -AbstractLauncherApplication class instanceVariableNames:'SettingsList' +AbstractLauncherApplication class instanceVariableNames:'SettingsList UserSettingsList' " The following class instance variables are inherited by this class: @@ -43,7 +43,7 @@ copyright " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + 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 @@ -63,7 +63,7 @@ provided here. [author:] - Claus Gittinger, eXept Software AG + Claus Gittinger, eXept Software AG " @@ -75,7 +75,7 @@ "close all opened launchers" self openLaunchers copy do:[:eachLauncher | - eachLauncher closeRequest + eachLauncher closeRequest ]. " @@ -91,8 +91,8 @@ |currentScreen| OpenLaunchers size > 0 ifTrue:[ - currentScreen := Screen current. - ^ OpenLaunchers detect:[:eachLauncher | eachLauncher graphicsDevice == currentScreen] ifNone:nil + currentScreen := Screen current. + ^ OpenLaunchers detect:[:eachLauncher | eachLauncher graphicsDevice == currentScreen] ifNone:nil ]. ^ nil. @@ -108,7 +108,7 @@ "return all opened launchers" OpenLaunchers isNil ifTrue:[ - OpenLaunchers := IdentitySet new + OpenLaunchers := IdentitySet new ]. ^ OpenLaunchers ! ! @@ -124,7 +124,7 @@ handler is the notifying one." NotifyingEmergencyHandler isNil ifTrue:[ - NotifyingEmergencyHandler := NoHandlerError notifyingEmergencyHandler + NotifyingEmergencyHandler := NoHandlerError notifyingEmergencyHandler ]. ^ NotifyingEmergencyHandler @@ -150,8 +150,8 @@ ^Icon - constantNamed:#'AbstractLauncherApplication class communicationIcon' - ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#(8 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:' + 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 @@ -198,24 +198,41 @@ !AbstractLauncherApplication class methodsFor:'settings application list'! -addSettingsApplicationByClass:aClass withName:aName icon:aIcon - - | setList addItem| - - setList := self settingsList. - addItem := Array with:aName with:aClass with:aIcon. - "/ remove existing entries for that name - setList copy do:[:entry | +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:[ - setList remove:entry. + userSetList remove:entry. ] ]. - setList add:addItem. + 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. @@ -228,25 +245,25 @@ rawList := self defaultSettingsApplicationList. filteredList := rawList select:[:eachEntry| - |className| - - className := eachEntry at:2 ifAbsent:nil. - className isNil - or:[ (Smalltalk at:className) notNil ] - ]. + |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 - ]. - ]. + |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. @@ -260,12 +277,12 @@ removeSettingsApplicationByClass:aClass - | setList remItem| - - setList := self settingsList. - remItem := setList detect:[:item| (item at:2) = aClass] ifNone:[nil]. + | userSetList remItem| + + userSetList := self userSettingsList. + remItem := userSetList detect:[:item| (item at:2) = aClass] ifNone:[nil]. remItem notNil ifTrue:[ - setList remove:remItem. + userSetList remove:remItem. OpenSettingsDialog notNil ifTrue:[ self removeSettingsEntry:remItem forSettingsApp:OpenSettingsDialog. ]. @@ -278,16 +295,25 @@ applName := entry at:1. applClass := entry at:2. - aSettingsApp remApplClassByName:applName. + aSettingsApp remApplClassByName:applName. ! settingsList - "/ do NOT cache + "/ 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'! @@ -295,8 +321,8 @@ canDropObjects:aCollectionOfDropObjects "Any object can be dropped into workspace..." - ^ aCollectionOfDropObjects - contains:[:someObject| (someObject isTextObject or:[ someObject isFileObject ])]. + ^ aCollectionOfDropObjects + contains:[:someObject| (someObject isTextObject or:[ someObject isFileObject ])]. ! dropFileObject:aFilename @@ -304,8 +330,8 @@ suffix := aFilename asFilename suffix. suffix = 'st' ifTrue:[ - ChangesBrowser openOn:aFilename. - ^ self. + ChangesBrowser openOn:aFilename. + ^ self. ]. UserPreferences fileBrowserClass openOn:aFilename. @@ -313,24 +339,24 @@ dropObjects:aCollectionOfObjects "Any object can be dropped: - text: open a workspace - file: - .st - open a cange-browser - other - open a fileBrowser + 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:[ - ]. - ]. + |theObject| + + theObject := dropObject theObject. + dropObject isTextObject ifTrue:[ + self dropTextObject:theObject + ] ifFalse:[ + dropObject isFileObject ifTrue:[ + self dropFileObject:theObject + ] ifFalse:[ + ]. + ]. ]. ! @@ -387,7 +413,7 @@ "Modified: / 31.7.1998 / 22:46:13 / cg" ! -keyboardSetting +keyboardSetting "open a dialog on keyboard related settings" self settingsDialog:[:handler | handler keyboardSettings] @@ -395,7 +421,7 @@ "Modified: / 31.7.1998 / 22:45:56 / cg" ! -languageSetting +languageSetting "open a dialog on language related settings" self settingsDialog:[:handler | handler languageSettingsFor:self] @@ -411,22 +437,22 @@ |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 := 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 + "/ canceled + ^ self ]. self withWaitCursorDo:[ - Smalltalk fileIn:fileName. - self reOpen + Smalltalk fileIn:fileName. + self reOpen ]. ! @@ -470,19 +496,19 @@ "Modified: / 31.7.1998 / 22:48:38 / cg" ! -settingsDialog:symbolOrBlock +settingsDialog:symbolOrBlock |handler| RegisteredMenuHandlers notNil ifTrue:[ - handler := RegisteredMenuHandlers at:symbolOrBlock ifAbsent:nil. + handler := RegisteredMenuHandlers at:symbolOrBlock ifAbsent:nil. ]. handler isNil ifTrue:[ - handler := LauncherDialogs + handler := LauncherDialogs ]. symbolOrBlock isBlock ifTrue:[ - symbolOrBlock value:handler + symbolOrBlock value:handler ] ifFalse:[ - handler perform:symbolOrBlock with:self. + handler perform:symbolOrBlock with:self. ] "Modified: / 24-02-2007 / 09:40:48 / cg" @@ -505,7 +531,7 @@ "Created: / 13.10.1998 / 15:50:53 / cg" ! -viewStyleSetting +viewStyleSetting "open a dialog on viewStyle related settings" self settingsDialog:[:handler | handler viewStyleSettingsFor:self] @@ -522,21 +548,21 @@ |cls| classOrClassName isBehavior ifTrue:[ - cls := classOrClassName. + 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 := 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 ! @@ -557,68 +583,68 @@ 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 - ] - ] - ] + 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 ?)' - ] - ]. + 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 - ]. + 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 + |v| + + v := knownTopViews at:box selectionIndex. + box destroy. + ^ v ]. box extent:400@300. box open. @@ -646,15 +672,15 @@ cls := self findApplicationClass:classOrClassName nameSpace:aNameSpace. cls isNil ifTrue:[ - ^ self + ^ self ]. Autoload autoloadFailedSignal handle:[:ex | - self warn:(resources string:'Sorry, the %1 class seems to be not available (failed to load).' with:cls name) + 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 - ] + self withWaitCursorDo:[ + cls perform:aSelector + ] ] ! @@ -674,56 +700,56 @@ (Delay forSeconds:1) wait. v := Screen current viewFromUser. v isNil ifTrue:[ - self warn:'Sorry, this is not a smalltalk view'. - ^ nil + self warn:'Sorry, this is not a smalltalk view'. + ^ nil ]. ^ v ! saveScreenImage:anImage defaultName:defaultName - "save an image into a file + "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 , '.tiff') - ok:(resources string:'Save') - abort:(resources string:'Cancel') - pattern:'*.tiff' - fromDirectory:nil - 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. - ]. - "/ ] - ]. + requestFileName:(resources string:'Save hardcopy image in:') + default:(defaultName , '.tiff') + ok:(resources string:'Save') + abort:(resources string:'Cancel') + pattern:'*.tiff' + fromDirectory:nil + 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 + anImage saveOn:fileName ]. "Modified: / 21.2.1996 / 13:09:28 / cg" @@ -738,21 +764,21 @@ 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 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 @@ -771,12 +797,12 @@ changeViewStyleTo:newStyle newStyle notNil ifTrue:[ - self withWaitCursorDo:[ - (transcript ? Transcript) showCR:'change style to ' , newStyle , ' ...'. - View defaultStyle:newStyle asSymbol. - ]. - self reopenLauncher. - DebugView newDebugger. + self withWaitCursorDo:[ + (transcript ? Transcript) showCR:'change style to ' , newStyle , ' ...'. + View defaultStyle:newStyle asSymbol. + ]. + self reopenLauncher. + DebugView newDebugger. ] ! @@ -791,7 +817,7 @@ "/ models labels allOfThem filter| "/ "/ encodingMatch notNil ifTrue:[ -"/ filter := [:f | f encoding notNil +"/ filter := [:f | f encoding notNil "/ and:[encodingMatch match:f encoding]]. "/ ]. "/ @@ -827,7 +853,7 @@ "/ (lbl := box addTextLabel:'') "/ adjust:#left; "/ font:(model value); -"/ labelChannel:(BlockValue +"/ labelChannel:(BlockValue "/ with:[:v | |f| "/ f := v value. "/ f isNil ifTrue:[ @@ -848,8 +874,8 @@ "/ b action:[ "/ |f| "/ -"/ f := FontPanel -"/ fontFromUserInitial:(model value) +"/ f := FontPanel +"/ fontFromUserInitial:(model value) "/ title:(resources string:'font for %1' with:title) "/ filter:filter. "/ f notNil ifTrue:[ @@ -857,7 +883,7 @@ "/ models do:[:m | m value:f]. "/ labels do:[:l | l font:f] "/ ] ifFalse:[ -"/ model value:f. +"/ model value:f. "/ lbl font:f. "/ ]. "/ ] @@ -911,7 +937,7 @@ builder window waitUntilVisible; origin:oldOrigin. newLauncher := builder application. transcript notNil ifTrue:[ - newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor. + newLauncher transcript list:contents; hideCursor; scrollToBottom; cursorToEnd; showCursor. ]. ^ newLauncher @@ -944,9 +970,9 @@ "my transcript" transcript isNil ifTrue:[ - ^ Transcript current - ]. - ^ transcript + ^ Transcript current + ]. + ^ transcript ! ! !AbstractLauncherApplication methodsFor:'settings dialog'! @@ -967,7 +993,7 @@ ]. settingsApp := SettingsDialog new. settingsApp requestor:self. - settingsApp installSettingsEntries:(self class settingsList). + settingsApp installSettingsEntries:(self class allSettingsList). "/ settingsApp requestor:self. OpenSettingsDialog := settingsApp. settingsApp allButOpen. @@ -977,7 +1003,7 @@ settingsClosed - OpenSettingsDialog := nil. + OpenSettingsDialog := nil. ! ! !AbstractLauncherApplication methodsFor:'startup & release'! @@ -998,7 +1024,7 @@ super postBuildWith:aBuilder. OpenLaunchers isNil ifTrue:[ - OpenLaunchers := IdentitySet new. + OpenLaunchers := IdentitySet new. ]. OpenLaunchers add:self @@ -1021,17 +1047,17 @@ |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 := 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 + "/ cancel + ^ false ]. answer ifFalse:[ - ^ true + ^ true ]. self exit @@ -1041,7 +1067,7 @@ saveAndTerminateRequest "some windowManagers can send this, to shutDown an application - but let it save its state before, for later restart. + 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 ;-)" @@ -1056,20 +1082,20 @@ "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) + |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" @@ -1083,8 +1109,8 @@ (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' + browseMethods:(WrappedMethod allInstances) + title:'All breakPointed/traced methods' ! browseImplementors @@ -1092,15 +1118,15 @@ |selector| - selector := Dialog - requestSelector:(resources string:'Browse implementors of (Tab for completion):') - okLabel:(resources string:'Browse') - initialAnswer:''. + 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 - ] + self withWaitCursorDo:[ + UserPreferences systemBrowserClass browseImplementorsMatching:selector + ] ]. "Modified: / 17.11.2001 / 16:33:28 / cg" @@ -1139,29 +1165,29 @@ 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 - ] + 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 + ] ]. ! @@ -1170,15 +1196,15 @@ |selector| - selector := Dialog - requestSelector:(resources string:'Browse Senders of (Tab for Completion):') - okLabel:(resources string:'Browse') - initialAnswer:''. + 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 - ] + self withWaitCursorDo:[ + UserPreferences systemBrowserClass + browseAllCallsOn:selector + ] ]. "Modified: / 17.11.2001 / 16:33:42 / cg" @@ -1188,9 +1214,9 @@ "open a browser on methods refering to unbound global variables" self withWaitCursorDo:[ - UserPreferences systemBrowserClass - browseReferendsOfUnboundGlobalsWithTitle:(resources string:'References to unbound global variables') - warnIfNone:true + UserPreferences systemBrowserClass + browseReferendsOfUnboundGlobalsWithTitle:(resources string:'References to unbound global variables') + warnIfNone:true ] ! @@ -1198,10 +1224,10 @@ "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 + UserPreferences systemBrowserClass + browseReferendsOf:(Smalltalk undeclaredPrefix , '*') + title:(resources string:'References to undeclared variables') + warnIfNone:true ] ! @@ -1216,8 +1242,8 @@ newSystemBrowserClass := Tools::NewSystemBrowser ? NewSystemBrowser. newSystemBrowserClass isNil ifTrue:[ - self warn:'This needs the NewSystemBrowser to be loaded.'. - AbortOperationRequest raise. + self warn:'This needs the NewSystemBrowser to be loaded.'. + AbortOperationRequest raise. ]. ^ newSystemBrowserClass ! @@ -1225,9 +1251,9 @@ removeAllBreakAndTracePoints "remove all break- and trace points" - self - withCursor:Cursor execute - do:[ MessageTracer cleanup] + self + withCursor:Cursor execute + do:[ MessageTracer cleanup] ! startClassBrowser @@ -1304,40 +1330,40 @@ startRemoteLauncherWithSetup:aSetupBlock |host remoteDisplay remoteDisplayClass| - host := Dialog - request:(resources string:'Remote Launcher on which display:') - initialAnswer:'{hostName}:0' - initialSelection:(1 to:10). + 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. + (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 +"/ (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. - ] + [ + 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" @@ -1351,24 +1377,24 @@ |fileName saveAndExit box| box := EnterBox2 title:(resources string:'Save image before exiting?') - okText:(resources string:'Exit') - abortText:(resources string:'Cancel') - action:[:str | saveAndExit := false]. + 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. - ] + [ + 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" @@ -1387,9 +1413,9 @@ Sender has to handle SnapshotError" aFileName notNil ifTrue:[ - self withCursor:Cursor write do:[ - ObjectMemory snapShotOn:aFileName - ]. + self withCursor:Cursor write do:[ + ObjectMemory snapShotOn:aFileName + ]. ]. ! ! @@ -1413,7 +1439,7 @@ url := 'http://www.grc.com/port_' , portNr printString , '.htm'. self withWaitCursorDo:[ - HTMLDocumentView openFullOnURL:url. + HTMLDocumentView openFullOnURL:url. ] ! @@ -1424,12 +1450,12 @@ rfc isEmptyOrNil ifTrue:[^ self]. rfc = 'index' ifTrue:[ - url := 'http://www.faqs.org/rfcs/'. + url := 'http://www.faqs.org/rfcs/'. ] ifFalse:[ - url := 'http://www.faqs.org/rfcs/rfc' , rfc printString , '.html'. + url := 'http://www.faqs.org/rfcs/rfc' , rfc printString , '.html'. ]. self withWaitCursorDo:[ - HTMLDocumentView openFullOnURL:url. + HTMLDocumentView openFullOnURL:url. ] ! @@ -1523,8 +1549,8 @@ "opens a moduleInfo dialog" Tools::ObjectModuleInformation notNil ifTrue:[ - self openApplication:#'Tools::ObjectModuleInformation'. - ^ self. + self openApplication:#'Tools::ObjectModuleInformation'. + ^ self. ]. ^ LauncherDialogs objectModuleDialog @@ -1539,14 +1565,14 @@ 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) - ] + v := v topView. + wg := v windowGroup. + wg notNil ifTrue:[ + "/ + "/ toggle eventTrace in its windowGroup + "/ + wg traceEvents:(wg traceEvents not) + ] ] ! ! @@ -1556,9 +1582,9 @@ "inspect globals" WorkspaceApplication notNil ifTrue:[ - "/ looks nicer... - WorkspaceApplication openWithGlobalsInspector. - ^ self. + "/ looks nicer... + WorkspaceApplication openWithGlobalsInspector. + ^ self. ]. Smalltalk inspect ! @@ -1567,14 +1593,14 @@ "inspect workspace variables" WorkspaceApplication notNil ifTrue:[ - "/ looks nicer... - WorkspaceApplication openWithWorkspaceVariableInspector. - ^ self. + "/ looks nicer... + WorkspaceApplication openWithWorkspaceVariableInspector. + ^ self. ]. "/ Workspace workspaceVariables inspect ! -newProject +newProject "creates a new project & opens a projectView for it" Project notNil ifTrue: [(ProjectView for: Project new) open] @@ -1582,35 +1608,35 @@ openEvaluationWorkspace WorkspaceApplication notNil ifTrue:[ - ^ WorkspaceApplication openEvaluationWorkspace + ^ WorkspaceApplication openEvaluationWorkspace ]. ^ self openApplication:Workspace ! openMyWorkspace WorkspaceApplication notNil ifTrue:[ - ^ WorkspaceApplication openMyWorkspace + ^ WorkspaceApplication openMyWorkspace ]. ^ self openApplication:Workspace ! openSystemWorkspace WorkspaceApplication notNil ifTrue:[ - ^ WorkspaceApplication openSystemWorkspace + ^ WorkspaceApplication openSystemWorkspace ]. ^ self openApplication:Workspace ! openTerminal TerminalApplication notNil ifTrue:[ - ^ TerminalApplication open - ]. - self openApplication:#VT100TerminalView + ^ TerminalApplication open + ]. + self openApplication:#VT100TerminalView ! openWorkspace WorkspaceApplication notNil ifTrue:[ - ^ WorkspaceApplication open + ^ WorkspaceApplication open ]. ^ self openApplication:Workspace ! @@ -1627,25 +1653,25 @@ |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 + 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 ] ! @@ -1653,12 +1679,12 @@ "open the bug reporter" Expecco::ExpeccoNetAPI notNil ifTrue:[ - Expecco::ExpeccoNetAPI reportCodeReview. - ^ self + Expecco::ExpeccoNetAPI reportCodeReview. + ^ self ]. BugGUI notNil ifTrue:[ - self openApplication:#BugGUI + self openApplication:#BugGUI ]. "Modified: / 17.10.1998 / 14:38:18 / cg" @@ -1698,7 +1724,7 @@ "opens the new launcher" NewLauncher isNil ifTrue:[ - ^ self warn:'The NewLauncher is not available in this release.' + ^ self warn:'The NewLauncher is not available in this release.' ]. NewLauncher openAt:(self window origin) @@ -1716,7 +1742,7 @@ "opens the old launcher" Launcher isNil ifTrue:[ - ^ self warn:'The (Old)Launcher is not available in this release.' + ^ self warn:'The (Old)Launcher is not available in this release.' ]. Launcher openAt:(self window origin) @@ -1759,9 +1785,9 @@ currentScreen := Screen current. setOfViews do:[:aTopView | - aTopView device == currentScreen ifTrue:[ - aTopView expand - ]. + aTopView device == currentScreen ifTrue:[ + aTopView expand + ]. ]. " @@ -1784,17 +1810,17 @@ |possibleGroups v| possibleGroups := WindowGroup allInstances select:[:eachGroup | - eachGroup graphicsDevice == Screen current - and:[eachGroup isModal not - and:[eachGroup topViews size > 0]]]. + 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 + 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 + self migrateWindow:v topView ] ! @@ -1804,17 +1830,17 @@ |possibleGroups v| possibleGroups := WindowGroup allInstances select:[:eachGroup | - eachGroup graphicsDevice ~~ Screen current - and:[eachGroup isModal not - and:[eachGroup topViews size > 0]]]. + 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 - ]. - + 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) + v windowGroup migrateTo:(Screen current) ] ! @@ -1832,37 +1858,37 @@ 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) + ^ 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) + 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 @@ -1873,9 +1899,9 @@ currentScreen := Screen current. setOfViews do:[:aTopView | - aTopView device == currentScreen ifTrue:[ - aTopView collapse - ] + aTopView device == currentScreen ifTrue:[ + aTopView collapse + ] ] ! @@ -1886,21 +1912,21 @@ |anotherDisplay toMigrate| [ - anotherDisplay := self askForAnotherDisplay. - anotherDisplay isNil ifTrue:[ - ^ self. - ]. + 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]] - ]. + ^ 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 + eachGroup migrateTo:anotherDisplay ] ! @@ -1908,8 +1934,8 @@ "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 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 ?') @@ -1921,29 +1947,29 @@ |anotherDisplay wg here b| aWindow isTopView ifFalse:[ - self information:'Cannot migrate this window'. - ^ self + self information:'Cannot migrate this window'. + ^ self ]. [ - anotherDisplay := self askForAnotherDisplay. - anotherDisplay isNil ifTrue:[ - ^ self. - ]. + anotherDisplay := self askForAnotherDisplay. + anotherDisplay isNil ifTrue:[ + ^ self. + ]. ] on:Screen deviceOpenErrorSignal do:[:ex| - ^ self warn:'Cannot open display: ', ex parameter. + ^ 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. + 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. ]. ! @@ -1952,19 +1978,19 @@ 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) + 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" ! @@ -1980,21 +2006,21 @@ 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 + [ + 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" + "show infos about window under the mouse pointer" FlyByWindowInformation notNil ifTrue:[ - [ - FlyByWindowInformation shownInformationOfViewUnderMouseUntilButtonIsPressed - ] fork. + [ + FlyByWindowInformation shownInformationOfViewUnderMouseUntilButtonIsPressed + ] fork. ] ! @@ -2004,12 +2030,12 @@ |v| WindowTreeView isNil ifTrue:[ - ^ self warn:'The WindowTreeView is not available in this release.' + ^ self warn:'The WindowTreeView is not available in this release.' ]. v := self pickAView. v notNil ifTrue:[ - WindowTreeView openOn:v topView + WindowTreeView openOn:v topView ] ! @@ -2020,7 +2046,7 @@ |v| WindowTreeView isNil ifTrue:[ - ^ self warn:'The WindowTreeView is not available in this release.' + ^ self warn:'The WindowTreeView is not available in this release.' ]. WindowTreeView openOnAll @@ -2039,21 +2065,21 @@ device := Screen current. i := Image fromFile:'bitmaps/xpmBitmaps/cursors/cross2.xpm'. i isNil ifTrue:[ - c := Cursor crossHair + c := Cursor crossHair ] ifFalse:[ - c := Cursor fromImage:i + c := Cursor fromImage:i ]. id := device viewIdFromPoint:(device pointFromUserShowing:c). (v := device viewFromId:id) notNil ifTrue:[ - v topView destroy. - ^ self + v topView destroy. + ^ self ]. id = device rootView id ifTrue:[ - ^ self + ^ 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 + device destroyView:nil withId:id ]. @@ -2063,17 +2089,17 @@ "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) + 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 @@ -2082,7 +2108,7 @@ |v| (v := self pickAView) notNil ifTrue:[ - v inspect + v inspect ] ! @@ -2093,7 +2119,7 @@ |v| (v := self pickAView) notNil ifTrue:[ - self migrateWindow:v topView + self migrateWindow:v topView ] ! @@ -2101,14 +2127,14 @@ "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) + 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" ! ! @@ -2120,13 +2146,13 @@ |box check in resources y acceptChannel hasRDoitServer rDoitServerPort - rDoitsEnabled rDoitLogging rDoitErrorLogging rDoitErrorDebugging + rDoitsEnabled rDoitLogging rDoitErrorLogging rDoitErrorDebugging org_rDoitsEnabled org_rDoitLogging org_rDoitErrorLogging org_rDoitErrorDebugging org_rDoitServerPort hasRemoteBrowsingSupport remoteBrowsingEnabled org_remoteBrowsingEnabled hasWindowMigrationServer windowMigrationAuthenticate windowMigrationPassword - windowMigrationEnabled + windowMigrationEnabled org_windowMigrationEnabled org_windowMigrationAuthenticate org_windowMigrationPassword hasHTTPServer httpServerRunning httpServerFileRoot httpServerHomeURL @@ -2147,28 +2173,28 @@ resources := self owningClass classResources. defaultServer := HTTPServer defaultServer. - "/ + "/ "/ extract relevant remoteBrowsing settings ... "/ remoteBrowsingEnabled := false. (hasRemoteBrowsingSupport := SmalltalkShareServer notNil) ifTrue:[ - SmalltalkShareServer isLoaded ifTrue:[ - remoteBrowsingEnabled := SmalltalkShareServer serverRunning. - ]. + 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. + WindowMigrationServer isLoaded ifTrue:[ + windowMigrationEnabled := WindowMigrationServer serverRunning. + ]. + windowMigrationPassword := WindowMigrationServer password. + windowMigrationAuthenticate := windowMigrationPassword notNil. ]. org_windowMigrationEnabled := windowMigrationEnabled. windowMigrationEnabled := windowMigrationEnabled asValue. @@ -2177,18 +2203,18 @@ 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. - ] + 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. @@ -2207,13 +2233,13 @@ "/ 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. - ]. + HTTPServer isLoaded ifTrue:[ + httpServerRunning := HTTPServer isRunning. + "/ httpServerFileRoot := HTTPServer fileRoot. + httpServerHomeURL := HTTPServer homeURL. + httpServerPort := HTTPServer port. + httpServerLogFile := HTTPServer logFile. + ]. ]. org_httpServerRunning := httpServerRunning. httpServerRunning := httpServerRunning asValue. @@ -2226,32 +2252,32 @@ org_httpServerLogFile := httpServerLogFile. httpServerLogFile := httpServerLogFile asValue. - httpServerRunning - onChangeEvaluate:[ - "/ httpServerFileRoot value:(HTTPServer fileRoot). - httpServerHomeURL value:(HTTPServer homeURL). - httpServerPort value:(HTTPServer port). - httpServerLogFile value:(HTTPServer logFile) - ]. + 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. - ] - ]. + 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. - ] - ]. + SOAP::SoapHttpModule isLoaded ifTrue:[ + (HTTPServer notNil and:[HTTPServer isLoaded]) ifTrue:[ + soapEnabled := HTTPServer soapEnabled. + ] + ]. ]. org_swikiRoot := swikiRoot. @@ -2262,9 +2288,9 @@ soapEnabled := soapEnabled asValue. swikiEnabled - onChangeEvaluate:[ - swikiRoot value:(PWS::SwikiAction serverDirectory). - ]. + onChangeEvaluate:[ + swikiRoot value:(PWS::SwikiAction serverDirectory). + ]. allowEmbedded := defaultServer notNil and:[defaultServer hasServiceForServiceClass:HTTPEmbeddedApplicationService]. @@ -2279,18 +2305,18 @@ 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. + 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. + 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. + osiCMISEErrorLogging := OSI::CMISE errorLogging asValue. + osiCMISEMessageLogging := OSI::CMISE messageLogging asValue. ]. "/ @@ -2303,7 +2329,7 @@ check := box addCheckBox:(resources string:'Remote browsing enabled') on:remoteBrowsingEnabled. hasRemoteBrowsingSupport ifFalse:[ - check disable + check disable ]. box addHorizontalLine. @@ -2311,20 +2337,20 @@ check := box addCheckBox:(resources string:'Window migration enabled') on:windowMigrationEnabled. hasWindowMigrationServer ifFalse:[ - check disable + check disable ]. check := box addCheckBox:(resources string:'Password check') on:windowMigrationAuthenticate. check enableChannel:windowMigrationEnabled. hasWindowMigrationServer ifFalse:[ - check disable + check disable ]. box leftIndent:20. - in := box - addLabelledInputField:(resources string:'Password:') - adjust:#right - on:nil - tabable:true - separateAtX:0.3. + in := box + addLabelledInputField:(resources string:'Password:') + adjust:#right + on:nil + tabable:true + separateAtX:0.3. in bePassword. in model:windowMigrationPassword. in acceptChannel:acceptChannel. @@ -2337,22 +2363,22 @@ check := box addCheckBox:(resources string:'Remote doits enabled') on:rDoitsEnabled. hasRDoitServer ifFalse:[ - check disable + 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. + 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. @@ -2363,20 +2389,20 @@ check width:0.4. check enableChannel:rDoitsEnabled. hasRDoitServer ifFalse:[ - check disable + 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 disable ]. check := box addCheckBox:(resources string:'Debug errors') on:rDoitErrorDebugging. check width:0.4. check enableChannel:rDoitsEnabled. hasRDoitServer ifFalse:[ - check disable + check disable ]. box leftIndent:0. @@ -2386,73 +2412,73 @@ check := box addCheckBox:(resources string:'Serving HTTP Requests') on:httpServerRunning. hasHTTPServer ifFalse:[ - check disable + check disable ]. box leftIndent:20. - in := box - addLabelledInputField:(resources string:'Port:') - adjust:#right - on:nil - tabable:true - separateAtX:0.3. + 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 := box + addLabelledInputField:(resources string:'Log File:') + adjust:#right + on:httpServerLogFile + tabable:true + separateAtX:0.3. in acceptChannel:acceptChannel. in enableChannel:httpServerRunning. -"/ in := box +"/ in := box "/ addLabelledInputField:(resources string:'File Root:') "/ adjust:#right -"/ on:httpServerFileRoot +"/ 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 := 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 disable ]. check enableChannel:httpServerRunning. "/ box leftIndent:40. - in := box - addLabelledInputField:(resources string:'SwikiRoot:') - adjust:#right - on:swikiRoot - tabable:true - separateAtX:0.3. + 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 disable ]. check enableChannel:httpServerRunning. check := box addCheckBox:(resources string:'Soap enabled') on:soapEnabled. hasHTTPServer ifFalse:[ - check disable + check disable ]. check enableChannel:httpServerRunning. @@ -2465,20 +2491,20 @@ check := box addCheckBox:(resources string:'Log %1 Errors' with:'ACSE') on:osiACSEErrorLogging. check width:0.33. osiACSEPresent ifFalse:[ - check disable + check disable ]. box yPosition:y. check := box addCheckBox:(resources string:'Connections') on:osiACSEConnectionLogging. osiACSEPresent ifFalse:[ - check disable + 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 disable ]. check left:0.66; width:0.34. @@ -2488,21 +2514,21 @@ y := box yPosition. check := box addCheckBox:(resources string:'Log %1 Errors' with:'ROSE') on:osiROSEErrorLogging. osiROSEPresent ifFalse:[ - check disable + check disable ]. check width:0.33. box yPosition:y. check := box addCheckBox:(resources string:'Invoactions') on:osiROSEInvokationLogging. osiROSEPresent ifFalse:[ - check disable + 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 disable ]. check left:0.66; width:0.34. @@ -2511,22 +2537,22 @@ y := box yPosition. check := box addCheckBox:(resources string:'Log %1 Errors' with:'CMISE') on:osiCMISEErrorLogging. osiCMISEPresent ifFalse:[ - check disable + check disable ]. check width:0.33. box yPosition:y. check := box addCheckBox:(resources string:'Messages') on:osiCMISEMessageLogging. osiCMISEPresent ifFalse:[ - check disable + check disable ]. check left:0.33; width:0.33. box addHorizontalLine. - box - addHelpButtonFor:'Launcher/communicationsSettings.html'; - addAbortAndOkButtons. + box + addHelpButtonFor:'Launcher/communicationsSettings.html'; + addAbortAndOkButtons. "/ "/ show the box ... @@ -2537,175 +2563,175 @@ "/ 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:[ + 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:[ + ]. + + 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 - ]. + ]. + + 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:[ + 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. - ]. + ]. + + 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 @@ -2718,14 +2744,14 @@ |box warnings warnSTX warnUnderscore warnDollar warnOldStyle warnUnusedVars allowDollar allowUnderscore allowSqueakExtensions allowQualifiedNames - allowDolphinExtensions allowOldStyleAssignment allowReservedWordsAsSelectors + 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 + 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 @@ -2768,11 +2794,11 @@ (supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) ifTrue:[ - justInTimeCompilation := ObjectMemory justInTimeCompilation. - fullDebugSupport := ObjectMemory fullSingleStepSupport. + justInTimeCompilation := ObjectMemory justInTimeCompilation. + fullDebugSupport := ObjectMemory fullSingleStepSupport. ] ifFalse:[ - justInTimeCompilation := false. - fullDebugSupport := (Compiler lineNumberInfo == #full) asValue. + justInTimeCompilation := false. + fullDebugSupport := (Compiler lineNumberInfo == #full) asValue. ]. justInTimeCompilation := justInTimeCompilation asValue. fullDebugSupport := fullDebugSupport asValue. @@ -2781,43 +2807,43 @@ catchClassRedefs := Class catchClassRedefinitions asValue. historyLines := HistoryManager notNil and:[HistoryManager isLoaded and:[HistoryManager isActive]]. historyLines ifFalse:[ - fullHistoryUpdate := false asValue + fullHistoryUpdate := false asValue ] ifTrue:[ - fullHistoryUpdate := HistoryManager fullHistoryUpdate asValue. + 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 := 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 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. @@ -2853,34 +2879,34 @@ 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 + loadBinaries value:false. + check disable ]. supportsJustInTimeCompilation ifTrue:[ - component := box - addCheckBox:(resources string:'Just in Time Compilation to Machine Code') - on:justInTimeCompilation. + 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. - ]. + 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. @@ -2962,61 +2988,61 @@ box yPosition:(yMax max: box yPosition). box addHorizontalLine. - box - addHelpButtonFor:'Launcher/compilerSettings.html'; - addAbortAndOkButtons. + 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. + 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 @@ -3041,16 +3067,16 @@ 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) ) - ). + "/ 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. + sizeInfos := resources array:listOfSizes. ]. sizeNames := sizeInfos collect:[:entry | entry at:1]. sizes := sizeInfos collect:[:entry | entry at:2]. @@ -3076,43 +3102,43 @@ ditherList := SelectionInList new. (visual == #StaticGray or:[visual == #GrayScale]) ifTrue:[ - ditherStyles := #('threshold' 'ordered dither' 'error diffusion'). - ditherSyms := #(threshold ordered floydSteinberg). + 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). + 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. + adjust:#left. (box addPopUpList:(resources string:'Common Sizes:') on:sizeList) - label:'monitor size'. + label:'monitor size'. idx := sizes findFirst:[:entry | - ((entry at:1) = sizeX value) - and:[((entry at:2) = sizeY value)] - ]. + ((entry at:1) = sizeX value) + and:[((entry at:2) = sizeY value)] + ]. idx ~~ 0 ifTrue:[ - sizeList selectionIndex:idx + sizeList selectionIndex:idx ]. sizeList onChangeEvaluate:[ - |idx| - - idx := sizeList selectionIndex. - sizeX value:((sizes at:idx) at:1). - sizeY value:((sizes at:idx) at:2). - ]. + |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:'). @@ -3120,11 +3146,11 @@ 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. + 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 '). @@ -3132,11 +3158,11 @@ 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. + 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)'). @@ -3145,28 +3171,28 @@ 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. + 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. + 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. + component := box addPopUpList:(resources string:'Image Display:') on:ditherList. + component defaultLabel:'image display'. + component superView horizontalLayout:#leftSpace. ]. box addVerticalSpace. @@ -3178,49 +3204,49 @@ component superView horizontalLayout:#leftSpace. box addHorizontalLine. - box - addHelpButtonFor:'Launcher/screenSettings.html'; - addAbortAndOkButtons. + 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). + 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 @@ -3232,12 +3258,12 @@ "open a dialog on edit settings" "OBSOLETE - this functionality is no longer used - see AbstractSettingsApplication" - |box st80EditMode st80SelectMode resources + |box st80EditMode st80SelectMode resources tabsIs4 prevTabsIs4 searchDialogIsModal startTextDragWithControl| resources := self owningClass classResources. - "/ + "/ "/ extract relevant system settings ... "/ st80EditMode := UserPreferences current st80EditMode asValue. @@ -3261,9 +3287,9 @@ box addHorizontalLine. - box - addHelpButtonFor:'Launcher/editSettings.html'; - addAbortAndOkButtons. + box + addHelpButtonFor:'Launcher/editSettings.html'; + addAbortAndOkButtons. "/ "/ show the box ... @@ -3274,20 +3300,20 @@ "/ 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. + 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 @@ -3299,7 +3325,7 @@ "open a dialog on font related settings" (self fontBoxForEncoding:nil) ifTrue:[ - requestor reopenLauncher. + requestor reopenLauncher. ] " self fontSettingsFor:nil @@ -3313,7 +3339,7 @@ |box audio javaHome classPath oldJavaHome oldClassPath resources component extraFileSecurityChecks extraSocketSecurityChecks - supportsJustInTimeCompilation + supportsJustInTimeCompilation javaJustInTimeCompilation javaNativeCodeOptimization showJavaByteCode exceptionDebug nullPointerExceptionDebug pathSep| @@ -3323,10 +3349,10 @@ extraFileSecurityChecks := JavaVM fileOpenConfirmation asValue. extraSocketSecurityChecks := JavaVM socketConnectConfirmation asValue. (supportsJustInTimeCompilation := ObjectMemory supportsJustInTimeCompilation) ifTrue:[ - javaJustInTimeCompilation := ObjectMemory javaJustInTimeCompilation asValue. - javaNativeCodeOptimization := ObjectMemory javaNativeCodeOptimization asValue. + javaJustInTimeCompilation := ObjectMemory javaJustInTimeCompilation asValue. + javaNativeCodeOptimization := ObjectMemory javaNativeCodeOptimization asValue. ] ifFalse:[ - javaJustInTimeCompilation := javaNativeCodeOptimization := false + javaJustInTimeCompilation := javaNativeCodeOptimization := false ]. showJavaByteCode := JavaMethod forceByteCodeDisplay asValue. exceptionDebug := JavaVM exceptionDebug asValue. @@ -3334,9 +3360,9 @@ classPath := (Java classPath ? ''). OperatingSystem isUNIXlike ifTrue:[ - pathSep := $;. + pathSep := $;. ] ifFalse:[ - pathSep := $:. + pathSep := $:. ]. classPath := (classPath asStringWith:pathSep) asValue. oldClassPath := classPath copy. @@ -3356,54 +3382,54 @@ 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 + 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 := 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 := 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:[ + 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 + JavaVM initializeVM "/ ] - ] - ]). - - box addComponent:(Button - label:(resources string:'Remove all Java classes now') - action:[ - box windowGroup withWaitCursorDo:[ - Java flushAllJavaResources - ] - ]). + ] + ]). + + box addComponent:(Button + label:(resources string:'Remove all Java classes now') + action:[ + box windowGroup withWaitCursorDo:[ + Java flushAllJavaResources + ] + ]). "/ box addHorizontalLine. @@ -3412,32 +3438,32 @@ 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. - ]. + 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 " @@ -3447,12 +3473,12 @@ "Modified: / 27.1.1999 / 20:16:03 / cg" ! -keyboardSettings +keyboardSettings "open a dialog on keyboard related settings" |mappings listOfRawKeys listOfFunctions box l - list1 list2 listView1 listView2 + list1 list2 listView1 listView2 frame selectionForwarder macroForwarder macroTextView y resources| resources := self owningClass classResources. @@ -3464,63 +3490,63 @@ 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. - ]. + 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. - ]. + 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. - ]. + |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. @@ -3549,8 +3575,8 @@ frame topInset:box yPosition. box addComponent:frame withExtent:350@200. - box makeTabable:listView1. - box makeTabable:listView2. + box makeTabable:listView1. + box makeTabable:listView2. frame origin:0.0@0.0 corner:1.0@0.6. box addVerticalSpace. @@ -3567,9 +3593,9 @@ y := box yPosition. box - addHelpButtonFor:'Launcher/keyboardSetting.html'; - "addAbortButton;" - addOkButtonLabelled:(resources string:'Close' "'Dismiss'"). + addHelpButtonFor:'Launcher/keyboardSetting.html'; + "addAbortButton;" + addOkButtonLabelled:(resources string:'Close' "'Dismiss'"). macroTextView topInset:(l preferredHeight + 5). macroTextView bottomInset:(box preferredHeight - y). @@ -3577,7 +3603,7 @@ box open. box accepted ifTrue:[ - "no action yet ..." + "no action yet ..." ]. box destroy @@ -3585,11 +3611,11 @@ "Modified: / 4.5.1998 / 12:40:02 / cg" ! -languageSettings +languageSettings self languageSettingsFor:nil ! -languageSettingsFor:requestor +languageSettingsFor:requestor "open a dialog on language related settings" |listOfLanguages translatedLanguages switch box languageList flags resources| @@ -3604,31 +3630,31 @@ listOfLanguages := listOfLanguages asOrderedCollection. translatedLanguages := listOfLanguages collect:[:lang | |item| - item := resources string:lang. - item isString ifTrue:[ - item - ] ifFalse:[ - item at:1 - ] - ]. + 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 - ] - ]. + 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 - ] - ]. + 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.]. @@ -3637,88 +3663,88 @@ 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. - ] - ]. + 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'. + addHelpButtonFor:'Launcher/languageSetting.html'. box open. box destroy @@ -3780,36 +3806,36 @@ 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. + |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. + 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. + (fields at:9) disable. + (fields at:10) disable. ]. box addAbortAndOkButtons. box - addHelpButtonFor:'Launcher/memorySettings.html'. + addHelpButtonFor:'Launcher/memorySettings.html'. "/ "/ show the box ... @@ -3820,35 +3846,35 @@ "/ 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. + 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 @@ -3883,10 +3909,10 @@ box open. box accepted ifTrue:[ - ObjectMemory infoPrinting:vmInfo value. - ObjectMemory debugPrinting:vmErrors value. - Object infoPrinting:classInfos value. - DeviceWorkstation errorPrinting:displayErrors value. + ObjectMemory infoPrinting:vmInfo value. + ObjectMemory debugPrinting:vmErrors value. + Object infoPrinting:classInfos value. + DeviceWorkstation errorPrinting:displayErrors value. ]. box destroy @@ -3896,8 +3922,8 @@ miscSettings "open a dialog on misc other settings" - |box pos pos2 check butt shadows takeFocus focusFollowsMouse returnFocus - hostNameInLabel showAccelerators + |box pos pos2 check butt shadows takeFocus focusFollowsMouse returnFocus + hostNameInLabel showAccelerators preemptive dynamicPrios hostNameInLabelHolder resources activateOnClick opaqueVariablePanelResize opaqueTableColumnResize currentUserPrefs beepEnabled newWindowLabelFormat| @@ -3905,7 +3931,7 @@ resources := self owningClass classResources. currentUserPrefs := UserPreferences current. - "/ + "/ "/ extract relevant system settings ... "/ shadows := PopUpView shadows asValue. @@ -3939,18 +3965,18 @@ 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 - ]. - ]). + 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). @@ -3970,9 +3996,9 @@ box leftIndent:0. box addHorizontalLine. - box - addHelpButtonFor:'Launcher/miscSettings.html'; - addAbortAndOkButtons. + box + addHelpButtonFor:'Launcher/miscSettings.html'; + addAbortAndOkButtons. "/ "/ show the box ... @@ -3983,49 +4009,49 @@ "/ 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 - ]. + 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 @@ -4095,12 +4121,12 @@ commandList := resources string:'PRINT_COMMANDS' default:nil. commandList isNil ifTrue:[ - commandList := PrinterStream defaultCommands. - commandList isNil ifTrue:[ - commandList := #('lpr' - 'lp' - ). - ] + commandList := PrinterStream defaultCommands. + commandList isNil ifTrue:[ + commandList := #('lpr' + 'lp' + ). + ] ]. commandListPop list:commandList. @@ -4112,15 +4138,15 @@ 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 + onChangeEvaluate: + [ + printFile value size > 0 ifTrue:[ + commandListPop disable. + ] ifFalse:[ + commandListPop enable. + ] + ]. printFile changed. box addVerticalSpace; addHorizontalLine; addVerticalSpace. @@ -4137,24 +4163,24 @@ y := box yPosition. box - addRow:(1 to:2) - fromX:0 - toX:0.5 - collect:[:idx | row at:idx] - tabable:false - horizontalLayout:#leftSpace - verticalLayout:#center. + 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. + 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). @@ -4165,13 +4191,13 @@ 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 := 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. @@ -4182,38 +4208,38 @@ component := box addComponent:(PopUpList on:unitList). component - left:0.6; - width:0.3. + 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 := 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 := 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 := 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. @@ -4223,104 +4249,104 @@ 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). - ] - ]. + 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. + 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. - ]. + 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 @@ -4338,7 +4364,7 @@ |box check butt setupButt logDoits updChanges changeFileName useManager hasManager cvsIsSetup - repository repositoryHolder localSourceFirst + repository repositoryHolder localSourceFirst sourceCacheDir cacheEntry component localCheck oldIndent nm fn manager showErrorNotifier showVerboseStack @@ -4349,7 +4375,7 @@ resources := self owningClass classResources. - "/ + "/ "/ extract relevant system settings ... "/ logDoits := Smalltalk logDoits asValue. @@ -4357,30 +4383,30 @@ changeFileName := ObjectMemory nameForChanges asValue. AbstractSourceCodeManager notNil ifTrue:[ - AbstractSourceCodeManager autoload. + AbstractSourceCodeManager autoload. ]. hasManager := AbstractSourceCodeManager notNil - and:[AbstractSourceCodeManager isLoaded]. + 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. + 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. + useManager := false. + localSourceFirst := false. + cvsIsSetup := false. ]. cvsIsSetup := cvsIsSetup asValue. showErrorNotifier := (NoHandlerError emergencyHandler == AbstractLauncherApplication notifyingEmergencyHandler) asValue. @@ -4401,12 +4427,12 @@ 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 := box + addLabelledInputField:(resources string:'Changefile Name:') + adjust:#right + on:changeFileName + tabable:true + separateAtX:0.4. component immediateAccept:true; acceptOnLeave:false. "/ y := box yPosition. @@ -4419,82 +4445,82 @@ 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 + 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 +"/ on:repositoryHolder "/ tabable:true "/ separateAtX:0.5. "/ component immediateAccept:true; acceptOnLeave:false. "/ component enableChannel:useManager. -"/ component readOnly:true. +"/ 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. + 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. @@ -4524,9 +4550,9 @@ box addCheckBox:(resources string:'Verbose Backtrace by Default in Debugger') on:showVerboseStack. box addHorizontalLine. - box - addHelpButtonFor:'Launcher/sourceSettings.html'; - addAbortAndOkButtons. + box + addHelpButtonFor:'Launcher/sourceSettings.html'; + addAbortAndOkButtons. box maxExtent:1000@600. @@ -4539,63 +4565,63 @@ "/ 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:[ + 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.' - ] - ] + 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. + ]. + + 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 @@ -4609,11 +4635,11 @@ "open an extra dialog on stc-compiler related settings. Obsoleted by STCCompilerSettingsApp" - |box + |box stcIncludes stcDefines stcOptions - stcLibraries stcLibraryPath cc stc ccOptions + stcLibraries stcLibraryPath cc stc ccOptions linkCommand linkArgs - component + component canLoadBinaries resources| @@ -4632,160 +4658,160 @@ 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. - ] + | 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]. + 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]. + 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:[ + 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:[ + 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. + 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). - ] - ]. + 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 " @@ -4802,14 +4828,14 @@ |box resources currentUserPrefs in acceptChannel useNewInspector useNewChangesBrowser useNewSystemBrowser useNewVersionDiffBrowser - useNewFileBrowser showClockInLauncher showClock launcher + useNewFileBrowser showClockInLauncher showClock launcher transcriptBufferSize useNewFileDialog useNewSettingsApplication useProcessMonitorV2| currentUserPrefs := UserPreferences current. resources := self owningClass classResources. - "/ + "/ "/ extract relevant system settings ... "/ useNewInspector := currentUserPrefs useNewInspector asValue. @@ -4822,9 +4848,9 @@ useNewSettingsApplication := currentUserPrefs useNewSettingsApplication asValue. useProcessMonitorV2 := currentUserPrefs useProcessMonitorV2 asValue. Transcript current isExternalStream ifTrue:[ - transcriptBufferSize := TextCollector defaultLineLimit + transcriptBufferSize := TextCollector defaultLineLimit ] ifFalse:[ - transcriptBufferSize := Transcript current lineLimit printString asValue. + transcriptBufferSize := Transcript current lineLimit printString asValue. ]. acceptChannel := false asValue. @@ -4840,20 +4866,20 @@ 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. + 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. + 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. + 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 ProcessMonitor') on:useProcessMonitorV2. + box addHorizontalLine. ]. box addCheckBox:(resources string:'Use the New Changes Browser') on:useNewChangesBrowser. box addHorizontalLine. @@ -4861,18 +4887,18 @@ 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 := 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. + box + addHelpButtonFor:'Launcher/toolSettings.html'; + addAbortAndOkButtons. "/ "/ show the box ... @@ -4883,47 +4909,47 @@ "/ 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. + 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 @@ -4941,24 +4967,24 @@ self viewStyleSettingsFor:nil ! -viewStyleSettingsFor:requestor +viewStyleSettingsFor:requestor "open a dialog on viewStyle related settings" - |resourceDir dir box + |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' - ). + 'decWindows' + 'iris' + 'motif' + 'mswindows95' + 'next' + 'normal' + 'os2' + 'st80' + ). resources := self owningClass classResources. @@ -4967,62 +4993,62 @@ " 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 := 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 + resourceDir := someRsrcFile asFilename directoryName ] ifFalse:[ - resourceDir := Smalltalk getSystemFileName:'resources'. + resourceDir := Smalltalk getSystemFileName:'resources'. ]. resourceDir isNil ifTrue:[ - self warn:'no styles found (missing ''resources'' directory)'. - ^ self + 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. + |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 - ]. + |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. @@ -5045,7 +5071,7 @@ "/ b action:[didApply := true. requestor changeViewStyleTo:(list selection)]. (standardStyles includes:View defaultStyle) ifFalse:[ - showStandardStylesOnly value:false + showStandardStylesOnly value:false ]. list selection:(View defaultStyle). @@ -5056,10 +5082,10 @@ box destroy. box accepted ifTrue:[ - ((newStyle := list selection) ~= View defaultStyle - or:[didApply ~~ true]) ifTrue:[ - requestor notNil ifTrue:[requestor changeViewStyleTo:newStyle]. - ]. + ((newStyle := list selection) ~= View defaultStyle + or:[didApply ~~ true]) ifTrue:[ + requestor notNil ifTrue:[requestor changeViewStyleTo:newStyle]. + ]. ]. " @@ -5091,22 +5117,22 @@ "opens a moduleInfo dialog" |allModules moduleNames - allObjects methodObjects methodNames + allObjects methodObjects methodNames cObjects cObjectNames otherObjects otherObjectNames box l handles unloadButton unloadAndRemoveButton list1 list2 listView1 listView2 - y panel + y panel showBuiltIn showModules showMethods showCObjects showOthers moduleListUpdater check canDoIt menu resources middleLabel| resources := self owningClass classResources. - showBuiltIn := true asValue. + showBuiltIn := true asValue. canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]. - showModules := canDoIt asValue. + showModules := canDoIt asValue. showMethods := canDoIt asValue. showCObjects := canDoIt asValue. showOthers := canDoIt asValue. @@ -5115,77 +5141,77 @@ 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. - ] - ]. + |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. @@ -5200,182 +5226,182 @@ 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. - ]. - ]. - ]. - ] - ] + |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. + ]. + ]. + ]. + ] + ] ]. @@ -5387,27 +5413,27 @@ box makeTabable:check. panel add:(check := CheckBox label:'ClassLibs' model:showModules). canDoIt ifFalse:[ - check disable + check disable ] ifTrue:[ - box makeTabable:check. + box makeTabable:check. ]. panel add:(check := CheckBox label:'Methods' model:showMethods). canDoIt ifFalse:[ - check disable + check disable ] ifTrue:[ - box makeTabable:check. + box makeTabable:check. ]. panel add:(check := CheckBox label:'C-objects' model:showCObjects). canDoIt ifFalse:[ - check disable + check disable ] ifTrue:[ - box makeTabable:check. + box makeTabable:check. ]. panel add:(check := CheckBox label:'Others' model:showOthers). canDoIt ifFalse:[ - check disable + check disable ] ifTrue:[ - box makeTabable:check. + box makeTabable:check. ]. panel horizontalLayout:#fitSpace. @@ -5433,76 +5459,76 @@ 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) ]. + 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:[ - |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. - ]. - pathName isNil ifTrue:[ - ] ifFalse:[ - ObjectFileLoader unloadObjectFile:pathName. - ]. - 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. - ] - ]. + unloadButton := Button label:(resources string:'Unload'). + unloadButton 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. + ]. + pathName isNil ifTrue:[ + ] ifFalse:[ + ObjectFileLoader unloadObjectFile:pathName. + ]. + 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 addButton:unloadButton. + box addButton:unloadAndRemoveButton. ]. box addAbortButtonLabelled:(resources string:'Dismiss'). @@ -5510,13 +5536,13 @@ listView2 topInset:(l preferredHeight + 5). listView2 bottomInset:(box preferredHeight - y). - box width:(400 min:(box device width * 2 // 3)); - height:(450 min:(box device height - 50)). + box width:(400 min:(box device width * 2 // 3)); + height:(450 min:(box device height - 50)). "/ box sizeFixed:true. box extent:(600 min:(box device width * 2 // 3)) - @ - (500 min:(box device height - 50)) . + @ + (500 min:(box device height - 50)) . box openModeless. "/ box destroy. " @@ -5547,38 +5573,38 @@ allPackages addAll:(Smalltalk knownPackages). Project knownProjects do:[:package | - allPackages add:(package name) + allPackages add:(package name) ]. Project loadedProjects do:[:package | - allPackages add:(package name) + 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 - ]. + 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. @@ -5589,32 +5615,32 @@ 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. + selectedPackage := (allPackages at:selIndex) asSymbol. + + pkg := Project projectWithId:selectedPackage. + (pkg notNil and:[pkg isLoaded]) ifTrue:[ + menu disable:#load. "/ menu enable:#unload. - ] ifFalse:[ + ] ifFalse:[ "/ menu disable:#unload. - menu enable:#load. - ] - ]. - - menu := PopUpMenu - itemList:#( - ('load...' load ) + menu enable:#load. + ] + ]. + + menu := PopUpMenu + itemList:#( + ('load...' load ) "/ ('-' nil ) "/ ('unload...' unload) - ) - resources:resources. + ) + resources:resources. listView middleButtonMenu:menu. menu actionAt:#load put:[ - box withWaitCursorDo:[ - Smalltalk loadPackage:selectedPackage. - packageUpdater value. - ] - ]. + box withWaitCursorDo:[ + Smalltalk loadPackage:selectedPackage. + packageUpdater value. + ] + ]. "/ menu actionAt:#unload put:[ "/ box withWaitCursorDo:[ "/ Smalltalk unloadPackage:selectedPackage. @@ -5626,12 +5652,12 @@ box addAbortButtonLabelled:(resources string:'dismiss'). - box width:(400 min:(box device width * 2 // 3)); - height:(450 min:(box device height - 50)). + 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)) . + @ + (500 min:(box device height - 50)) . box destroy. " @@ -5642,38 +5668,38 @@ !AbstractLauncherApplication::LauncherDialogs class methodsFor:'dialogs-private'! cvsConfigurationDialog - |cvsRootHolder resources defaultsList bindings dialog + |cvsRootHolder resources defaultsList bindings dialog listOfModules selectedPerModuleRoot rootsPerModule acceptChannel removeEnabled cvsExecutableHolder| resources := self owningClass classResources. OperatingSystem getDomainName = 'exept' ifFalse:[ - defaultsList := #( - 'host:/cvs/stx' - ':pserver:user@host:/cvs/stx' - ). - defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@host:/cvs/stx') + defaultsList := #( + 'host:/cvs/stx' + ':pserver:user@host:/cvs/stx' + ). + defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@host:/cvs/stx') ] ifTrue:[ - defaultsList := #( - '/cvs/stx' - 'exept:/cvs/stx' - ). - defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@exept:/cvs/stx') + defaultsList := #( + '/cvs/stx' + 'exept:/cvs/stx' + ). + defaultsList := defaultsList copyWith:(':pserver:' , OperatingSystem getLoginName , '@exept:/cvs/stx') ]. OperatingSystem isUNIXlike ifTrue:[ - defaultsList := defaultsList , #( - '/cvs/stx' - ). + defaultsList := defaultsList , #( + '/cvs/stx' + ). ] ifFalse:[ - OperatingSystem isMSDOSlike ifTrue:[ - defaultsList := defaultsList , #( - ':local:c:\cvs\stx' - ). - ] ifFalse:[ - "there might be more here in the future" - ] + OperatingSystem isMSDOSlike ifTrue:[ + defaultsList := defaultsList , #( + ':local:c:\cvs\stx' + ). + ] ifFalse:[ + "there might be more here in the future" + ] ]. cvsRootHolder := CVSSourceCodeManager repositoryName ? '/cvs/stx'. @@ -5695,56 +5721,56 @@ 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. - ]. + 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' - ] - ]. + 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. - ]. - ]. + |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. - ]. + |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. + ^ self + ]. + + acceptChannel value. "/ "/ update system settings @@ -5760,7 +5786,7 @@ "Modified: / 21-09-2006 / 16:54:20 / cg" ! -fontBoxForEncoding:encodingMatch +fontBoxForEncoding:encodingMatch "open a fontBox, showing fonts which match some encoding (used when changing to japanese ...)" @@ -5771,8 +5797,8 @@ resources := self owningClass classResources. encodingMatch notNil ifTrue:[ - filter := [:f | f encoding notNil - and:[encodingMatch match:f encoding]]. + filter := [:f | f encoding notNil + and:[encodingMatch match:f encoding]]. ]. models := OrderedCollection new. @@ -5791,92 +5817,92 @@ 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 - ] + |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. + box addButton:defaultButton after:nil. ] ifFalse:[ - box addButton:defaultButton before:nil. + box addButton:defaultButton before:nil. ]. defaultButton - action:[ - "/ fetch defaults + 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. - ]. + 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. + 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 @@ -5887,31 +5913,31 @@ ! formattingConfigurationDialog - |dialog + |dialog resources exampleText formattedText reformatAction reformatLocked oldUserPreferences - currentUserPrefs - tabIndent - spaceAroundTemporaries emptyLineAfterTemporaries + currentUserPrefs + tabIndent + spaceAroundTemporaries emptyLineAfterTemporaries spaceAfterReturnToken spaceAfterKeywordSelector cStyleBlocks blockArgumentsOnNewLine maxLengthForSingleLineBlocks resetValue bindings| RBFormatter isNil ifTrue:[ - ^ self warn:'Sorry, no RBFormatter class'. + ^ self warn:'Sorry, no RBFormatter class'. ]. RBFormatter isLoaded ifFalse:[ - WindowGroup activeGroup withWaitCursorDo:[ - RBFormatter autoload - ] + WindowGroup activeGroup withWaitCursorDo:[ + RBFormatter autoload + ] ]. resources := self owningClass classResources. currentUserPrefs := UserPreferences current. - exampleText := + exampleText := 'methodSelector:methodArg "method comment: some stupid code to show the current settings" @@ -5923,32 +5949,32 @@ 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 + Transcript showCR:''hello''. "/ condition ]. methodArg ifTrue:[ - Transcript showCR:''hello''. "/ condition + Transcript showCR:''hello''. "/ condition ] ifFalse:[ - Transcript showCR:''world''. + Transcript showCR:''world''. ]. [methodArg] whileTrue:[ - Transcript showCR:''hello''. "/ looping + Transcript showCR:''hello''. "/ looping ]. [self aVeryLongConditionBlock and:[self toMakeBlockLonger]] whileTrue:[ - Transcript showCR:''hello''. "/ long blocks + Transcript showCR:''hello''. "/ long blocks ]. methodArg do:[:element | - Transcript showCR:''hello''. "/ looping + Transcript showCR:''hello''. "/ looping ]. 1 to:methodArg size do:[:index | - Transcript showCR:''hello''. "/ looping + Transcript showCR:''hello''. "/ looping ]. methodArg keysAndValuesDo:[:index | - Transcript showCR:''hello''. "/ looping - ]. - Object errorSignal handle:[:ex | - ex return + Transcript showCR:''hello''. "/ looping + ]. + Object errorSignal handle:[:ex | + ex return ] do:[ "/ exception handling - self someAction "/ blocks + self someAction "/ blocks ]. ^ self. '. @@ -5957,54 +5983,54 @@ 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. - ]. - ]. + 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. @@ -6012,71 +6038,71 @@ oldUserPreferences := currentUserPrefs copy. tabIndent := RBFormatter tabIndent asValue. - tabIndent onChangeEvaluate:reformatAction. + tabIndent onChangeEvaluate:reformatAction. bindings at:#tabIndent put:tabIndent. spaceAroundTemporaries := RBFormatter spaceAroundTemporaries asValue. - spaceAroundTemporaries onChangeEvaluate:reformatAction. + spaceAroundTemporaries onChangeEvaluate:reformatAction. bindings at:#spaceAroundTemporaries put:spaceAroundTemporaries. emptyLineAfterTemporaries := RBFormatter emptyLineAfterTemporaries asValue. - emptyLineAfterTemporaries onChangeEvaluate:reformatAction. + emptyLineAfterTemporaries onChangeEvaluate:reformatAction. bindings at:#emptyLineAfterTemporaries put:emptyLineAfterTemporaries. spaceAfterReturnToken := RBFormatter spaceAfterReturnToken asValue. - spaceAfterReturnToken onChangeEvaluate:reformatAction. + spaceAfterReturnToken onChangeEvaluate:reformatAction. bindings at:#spaceAfterReturnToken put:spaceAfterReturnToken. spaceAfterKeywordSelector := RBFormatter spaceAfterKeywordSelector asValue. - spaceAfterKeywordSelector onChangeEvaluate:reformatAction. + spaceAfterKeywordSelector onChangeEvaluate:reformatAction. bindings at:#spaceAfterKeywordSelector put:spaceAfterKeywordSelector. cStyleBlocks := RBFormatter cStyleBlocks asValue. - cStyleBlocks onChangeEvaluate:reformatAction. + cStyleBlocks onChangeEvaluate:reformatAction. bindings at:#cStyleBlocks put:cStyleBlocks. blockArgumentsOnNewLine := RBFormatter blockArgumentsOnNewLine asValue. - blockArgumentsOnNewLine onChangeEvaluate:reformatAction. + blockArgumentsOnNewLine onChangeEvaluate:reformatAction. bindings at:#blockArgumentsOnNewLine put:blockArgumentsOnNewLine. maxLengthForSingleLineBlocks := RBFormatter maxLengthForSingleLineBlocks asValue. - maxLengthForSingleLineBlocks onChangeEvaluate:reformatAction. + 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 - ]. + [ + 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. @@ -6085,34 +6111,34 @@ "/ dialog := SimpleDialog new. dialog postBuildBlock:[:builder | - (builder componentAt:#sampleTextView) - cursorMovementWhenUpdating:nil; - scrollWhenUpdating:nil. - ]. - (dialog openFor:nil - spec:(self formatterDialogSpec) - withBindings:bindings) + (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. + 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 - ]. + (UserPreferences reset; current) addAll: oldUserPreferences + ]. " self formattingConfigurationDialog " @@ -6129,7 +6155,7 @@ resources := self owningClass classResources. currentUserPrefs := UserPreferences current. - exampleText := + exampleText := 'methodSelector:methodArg "method comment: some stupid code to show the current settings" @@ -6168,7 +6194,7 @@ frame topInset:box yPosition. box addComponent:frame withExtent:1.0@200. - box makeTabable:exampleView. + box makeTabable:exampleView. frame width:1.0. box addVerticalSpace. @@ -6181,70 +6207,70 @@ 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. + 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 - ]. + 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. @@ -6252,34 +6278,34 @@ 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. + |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. + 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 + syntaxColoringBox enable. + colorMenu enable. + syntaxEmphasisesBox enable. + syntaxColoringResetButton enable. + + box "/ addHelpButtonFor:'Launcher/sourceSettings.html'; - addAbortAndOkButtons. + addAbortAndOkButtons. box stickAtBottomWithVariableHeight:frame. box stickAtBottomWithFixHeight:syntaxColoringBox. @@ -6298,7 +6324,7 @@ "/ update system settings "/ box accepted ifFalse: [ - (UserPreferences reset; current) addAll:oldUserPreferences + (UserPreferences reset; current) addAll:oldUserPreferences ]. box destroy @@ -6321,205 +6347,205 @@ - ^ + ^ #(FullSpec - name: cvsSetupSpec - window: + name: cvsSetupSpec + window: (WindowSpec - label: 'CVS Setup' - name: 'CVS Setup' - min: (Point 436 316) - bounds: (Rectangle 14 46 450 400) - ) - component: + 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) - ) - ) - - ) - ) - ) - - ) + 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) + ) + ) + + ) + ) + ) + + ) ) ! @@ -6536,197 +6562,197 @@ - ^ + ^ #(FullSpec - name: formatterDialogSpec - window: + name: formatterDialogSpec + window: (WindowSpec - label: 'Formatting parameters' - name: 'Formatting parameters' - min: (Point 10 10) - bounds: (Rectangle 14 46 610 629) - ) - component: + 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 - ) - ) - - ) - ) - ) - - ) + 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.387 2009-11-05 19:29:04 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.388 2009-12-04 15:49:32 fm Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.387 2009-11-05 19:29:04 cg Exp $' + ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.388 2009-12-04 15:49:32 fm Exp $' ! !