--- a/.hgtags Fri Sep 06 12:08:37 2013 +0100
+++ b/.hgtags Fri Sep 06 15:49:08 2013 +0100
@@ -19,6 +19,7 @@
3e7f1d7b7a3668a30eb14f320dc532ed0f2049ae expeccoNET_1_4_0rc1
3e7f1d7b7a3668a30eb14f320dc532ed0f2049ae expecco_1_7_0rc3
463dd6fa737f1911b40acf7874e7173cf8b3525c rel5_2_1_fixed
+47a292f5d9562ee11659cff4e619a00e352ab469 before_environment_support_in_browser
596696438e67fee735ba71f62177ccc091b9a0bb expecco_1_7_2rc1
5aa270837e0ab5e0fa19d2c02d46c864cc41c859 expeccoNET_1_5_1rc1
62451ecb3d3bbf1f6067c931eda2cdb57aa67ead expeccoNET_1_7_0_0
--- a/AbstractSettingsApplication.st Fri Sep 06 12:08:37 2013 +0100
+++ b/AbstractSettingsApplication.st Fri Sep 06 15:49:08 2013 +0100
@@ -101,7 +101,7 @@
enforceContentsDropForFiles selectAllWhenClickingBeyondEnd
showAcceptCancelBarInBrowser useCodeView2InTools
autoIndentInCodeView immediateCodeCompletion
- codeCompletionOnControlKey'
+ codeCompletionOnControlKey codeCompletionOnTabKey'
classVariableNames:''
poolDictionaries:''
privateIn:AbstractSettingsApplication
@@ -109,11 +109,12 @@
AbstractSettingsApplication subclass:#FontSettingsAppl
instanceVariableNames:'filter allOfThem labelDef buttonDef listDef menuDef textDef
- allFontLabelHolder buttonsFontLabelHolder textFontLabelHolder
- labelsFontLabelHolder listsFontLabelHolder menusFontLabelHolder
- allLabel buttonsLabel textLabel labelLabel listsLabel menuLabel
- inputFieldLabel inputFieldDef inputFieldFontLabelHolder
- linuxFontWorkaround'
+ othersDef allFontLabelHolder buttonsFontLabelHolder
+ textFontLabelHolder labelsFontLabelHolder listsFontLabelHolder
+ menusFontLabelHolder otherFontLabelHolder allLabel buttonsLabel
+ textLabel labelLabel listsLabel menuLabel inputFieldLabel
+ inputFieldDef inputFieldFontLabelHolder otherLabel
+ linuxFontWorkaround otherDef'
classVariableNames:''
poolDictionaries:''
privateIn:AbstractSettingsApplication
@@ -3676,7 +3677,10 @@
'Show code completion suggestions as you type.\This is an experimental feature, please disable it if you encounter problems.\(CTRL-Space still works as usual, even if this is disabled)'
#codeCompletionOnControlKey
-'Show code completion suggestions when you hit the CTRL key.\This is an experimental feature, please disable it if you encounter problems.\(CTRL-Space still works as usual, even if this is disabled)'
+'Show code completion suggestions when you hit the CTRL key, and the character before the cursor is non-blank.\This is an experimental feature, please disable it if you encounter problems.\(CTRL-Space still works as usual, even if this is disabled)'
+
+#codeCompletionOnTabKey
+'Show code completion suggestions when you hit the TAB key, and the character before the cursor is non-blank.\This is an experimental feature, please disable it if you encounter problems.\(CTRL-Space still works as usual, even if this is disabled)'
#alwaysPasteFileContents
'When pasting a file (from the Filebrowser or Explorer), always paste the file''s contents\without asking. If off, a dialog appears to ask the name or the contents of the file should be pasted'
@@ -3791,8 +3795,12 @@
translateLabel: true
extent: (Point 600 25)
)
+ (DividerSpec
+ name: 'Separator6'
+ extent: (Point 600 4)
+ )
(CheckBoxSpec
- label: 'Code Completion Suggestions as you Type (experimental)'
+ label: 'Code Completion as you Type (experimental)'
name: 'CheckBox5'
activeHelpKey: immediateCodeCompletion
model: immediateCodeCompletion
@@ -3800,13 +3808,21 @@
extent: (Point 600 25)
)
(CheckBoxSpec
- label: 'Code Completion Suggestions on CTRL Key (experimental)'
- name: 'CheckBox5'
+ label: 'Code Completion on CTRL Key (experimental)'
+ name: 'CheckBox6'
activeHelpKey: codeCompletionOnControlKey
model: codeCompletionOnControlKey
translateLabel: true
extent: (Point 600 25)
)
+ (CheckBoxSpec
+ label: 'Code Completion on TAB Key (experimental)'
+ name: 'CheckBox7'
+ activeHelpKey: codeCompletionOnControlKey
+ model: codeCompletionOnTabKey
+ translateLabel: true
+ extent: (Point 600 25)
+ )
(DividerSpec
name: 'Separator5'
extent: (Point 600 4)
@@ -3954,6 +3970,7 @@
#autoIndentInCodeView
#immediateCodeCompletion
#codeCompletionOnControlKey
+ #codeCompletionOnTabKey
)
"Modified: / 07-03-2012 / 14:33:40 / cg"
@@ -3977,6 +3994,14 @@
^ codeCompletionOnControlKey.
!
+codeCompletionOnTabKey
+ codeCompletionOnTabKey isNil ifTrue:[
+ codeCompletionOnTabKey := false asValue.
+ codeCompletionOnTabKey onChangeSend:#updateModifiedChannel to:self.
+ ].
+ ^ codeCompletionOnTabKey.
+!
+
enforceContentsDropForFiles
enforceContentsDropForFiles isNil ifTrue:[
enforceContentsDropForFiles := true asValue.
@@ -4107,12 +4132,13 @@
widgetList
^ #(
- 'All'
- 'Labels'
- 'Buttons'
- 'Lists'
- 'Menus'
- 'Edited Text'
+ 'All'
+ 'Labels'
+ 'Buttons'
+ 'Lists'
+ 'Menus'
+ 'Edited Text'
+ 'Others'
)
! !
@@ -4218,408 +4244,438 @@
<resource: #canvas>
- ^
- #(FullSpec
- name: windowSpec
- window:
- (WindowSpec
- label: 'Font Settings'
- name: 'Font Settings'
- min: (Point 10 10)
- bounds: (Rectangle 0 0 512 657)
- )
- component:
- (SpecCollection
- collection: (
- (VerticalPanelViewSpec
- name: 'VerticalPanel1'
- layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- horizontalLayout: fitSpace
- verticalLayout: topSpace
- horizontalSpace: 3
- verticalSpace: 3
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Label'
- name: 'Label3'
- style: labelFont
- translateLabel: true
- labelChannel: infoText
- resizeForLabel: false
- adjust: left
- extent: (Point 506 132)
- )
- (ViewSpec
- name: 'CodeBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Code'
- name: 'Label1'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'Text Font'
- name: 'Label2'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: textFontLabelHolder
- adjust: left
- postBuildCallback: postBuildTextFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'Button1'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeTextFont
- )
- (DividerSpec
- name: 'Separator11'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (ViewSpec
- name: 'InputFieldsBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Input Fields'
- name: 'Input Fields'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'InputFields Font'
- name: 'InputFieldsFont'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: inputFieldFontLabelHolder
- adjust: left
- postBuildCallback: postBuildInputFieldFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'ChangeText'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeInputFieldFont
- )
- (DividerSpec
- name: 'Separator10'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (ViewSpec
- name: 'ListsBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Lists'
- name: 'Lists'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'Lists Font'
- name: 'ListsFont'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: listsFontLabelHolder
- adjust: left
- postBuildCallback: postBuildListsFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'ChangeLists'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeListsFont
- )
- (DividerSpec
- name: 'Separator8'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (ViewSpec
- name: 'MenusBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Menus'
- name: 'Menus'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'Menus Font'
- name: 'MenusFont'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: menusFontLabelHolder
- adjust: left
- postBuildCallback: postBuildMenuesFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'ChangeMenus'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeMenusFont
- )
- (DividerSpec
- name: 'Separator9'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (ViewSpec
- name: 'LabelsBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Labels'
- name: 'Labels'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'Labels'
- name: 'LabelsFont'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: labelsFontLabelHolder
- adjust: left
- postBuildCallback: postBuildLabelsFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'ChangeLabels'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeLabelsFont
- )
- (DividerSpec
- name: 'Separator6'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (ViewSpec
- name: 'ButtonsBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Buttons'
- name: 'Buttons'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'Buttons Font'
- name: 'ButtonsFont'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: buttonsFontLabelHolder
- adjust: left
- postBuildCallback: postBuildButtonsFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'Change Buttons'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeButtonsFont
- )
- (DividerSpec
- name: 'Separator7'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (ViewSpec
- name: 'AllBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'All (Others)'
- name: 'All'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- (LabelSpec
- label: 'Label'
- name: 'AllFont'
- layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
- translateLabel: true
- labelChannel: allFontLabelHolder
- adjust: left
- postBuildCallback: postBuildAllFontLabel:
- )
- (ActionButtonSpec
- label: 'Change...'
- name: 'ChangeAll'
- layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
- translateLabel: true
- tabable: true
- model: changeAllFont
- )
- (DividerSpec
- name: 'Separator1'
- layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
- )
- )
-
- )
- extent: (Point 506 50)
- )
- (CheckBoxSpec
- label: 'Linux font workaround: do not reset fonts on snapshot restart'
- name: 'LinuxFontWorkaroundBox'
- visibilityChannel: linuxFontWorkaroundVisible
- model: linuxFontWorkaround
- translateLabel: true
- extent: (Point 506 22)
- )
- (DividerSpec
- name: 'Separator12'
- visibilityChannel: linuxFontWorkaroundVisible
- extent: (Point 506 3)
- )
- (ViewSpec
- name: 'SpecialsBox'
- component:
- (SpecCollection
- collection: (
- (LabelSpec
- label: 'Common Settings:'
- name: 'Label4'
- layout: (LayoutFrame 0 0.0 11 0 0 1.0 33 0)
- translateLabel: true
- adjust: left
- )
- (ActionButtonSpec
- label: 'Default'
- name: 'Button2'
- layout: (LayoutFrame 0 0.0 35 0 105 0 57 0)
- activeHelpKey: resetToDefault
- translateLabel: true
- tabable: true
- model: changeToDefault
- )
- (ActionButtonSpec
- label: 'High Contrast'
- name: 'Button3'
- layout: (LayoutFrame 148 0.0 35 0 255 0 57 0)
- translateLabel: true
- tabable: true
- model: changeToHighContrast
- activeHelpKey: changeToHighContrast
- )
- (ActionButtonSpec
- label: 'Big Fonts'
- name: 'Button4'
- layout: (LayoutFrame 260 0.0 35 0 365 0 57 0)
- translateLabel: true
- tabable: true
- model: changeToBigFonts
- activeHelpKey: changeToBigFonts
- )
- (ActionButtonSpec
- label: 'Huge Fonts'
- name: 'Button5'
- layout: (LayoutFrame 370 0.0 35 0 475 0 57 0)
- translateLabel: true
- tabable: true
- model: changeToHugeFonts
- activeHelpKey: changeToHugeFonts
- )
- (ActionButtonSpec
- label: 'ST/X Look'
- name: 'Button8'
- layout: (LayoutFrame 148 0.0 67 0 255 0 89 0)
- translateLabel: true
- tabable: true
- model: changeToSTXLook
- activeHelpKey: changeToSTXLook
- )
- (ActionButtonSpec
- label: 'Squeak Look'
- name: 'Button6'
- layout: (LayoutFrame 260 0.0 67 0 367 0 89 0)
- translateLabel: true
- tabable: true
- model: changeToSqueakLook
- activeHelpKey: changeToSqueakLook
- )
- (ActionButtonSpec
- label: 'V''Age Look'
- name: 'Button7'
- layout: (LayoutFrame 370 0.0 67 0 475 0 89 0)
- translateLabel: true
- tabable: true
- model: changeToVisualAgeLook
- activeHelpKey: changeToVisualAgeLook
- )
- )
-
- )
- extent: (Point 506 94)
- )
- )
-
- )
- )
- )
-
- )
- )
-
- "Modified: / 17-03-2012 / 11:44:29 / cg"
+ ^
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'Font Settings'
+ name: 'Font Settings'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 572 663)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (VerticalPanelViewSpec
+ name: 'VerticalPanel1'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ horizontalLayout: fitSpace
+ verticalLayout: topSpace
+ horizontalSpace: 3
+ verticalSpace: 3
+ component:
+ (SpecCollection
+ collection: (
+ (TextEditorSpec
+ name: 'TextEditor1'
+ style: labelFont
+ model: infoText
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ miniScrollerVertical: true
+ isReadOnly: true
+ hasKeyboardFocusInitially: false
+ extent: (Point 566 132)
+ viewClassName: 'ListView'
+ )
+ (ViewSpec
+ name: 'CodeBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Code'
+ name: 'Label1'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'Text Font'
+ name: 'Label2'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: textFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildTextFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'Button1'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeTextFont
+ )
+ (DividerSpec
+ name: 'Separator11'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (ViewSpec
+ name: 'InputFieldsBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Input Fields'
+ name: 'Input Fields'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'InputFields Font'
+ name: 'InputFieldsFont'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: inputFieldFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildInputFieldFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'ChangeText'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeInputFieldFont
+ )
+ (DividerSpec
+ name: 'Separator10'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (ViewSpec
+ name: 'ListsBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Lists'
+ name: 'Lists'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'Lists Font'
+ name: 'ListsFont'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: listsFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildListsFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'ChangeLists'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeListsFont
+ )
+ (DividerSpec
+ name: 'Separator8'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (ViewSpec
+ name: 'MenusBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Menus'
+ name: 'Menus'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'Menus Font'
+ name: 'MenusFont'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: menusFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildMenuesFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'ChangeMenus'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeMenusFont
+ )
+ (DividerSpec
+ name: 'Separator9'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (ViewSpec
+ name: 'LabelsBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Labels'
+ name: 'Labels'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'Labels'
+ name: 'LabelsFont'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: labelsFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildLabelsFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'ChangeLabels'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeLabelsFont
+ )
+ (DividerSpec
+ name: 'Separator6'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (ViewSpec
+ name: 'ButtonsBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Buttons'
+ name: 'Buttons'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'Buttons Font'
+ name: 'ButtonsFont'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: buttonsFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildButtonsFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'Change Buttons'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeButtonsFont
+ )
+ (DividerSpec
+ name: 'Separator7'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (ViewSpec
+ name: 'OtherBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'All Others'
+ name: 'Label5'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (LabelSpec
+ label: 'Label'
+ name: 'Label6'
+ layout: (LayoutFrame 110 0 22 0 -5 1 44 0)
+ translateLabel: true
+ labelChannel: otherFontLabelHolder
+ adjust: left
+ postBuildCallback: postBuildOtherFontLabel:
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'Button9'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeOtherFont
+ )
+ (DividerSpec
+ name: 'Separator13'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 49)
+ )
+ (ViewSpec
+ name: 'AllBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'All'
+ name: 'All'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ (ActionButtonSpec
+ label: 'Change...'
+ name: 'ChangeAll'
+ layout: (LayoutFrame 0 0.0 22 0 105 0 44 0)
+ translateLabel: true
+ tabable: true
+ model: changeAllFont
+ )
+ (DividerSpec
+ name: 'Separator1'
+ layout: (LayoutFrame 0 0.0 -3 1 0 1.0 0 1)
+ )
+ )
+
+ )
+ extent: (Point 566 50)
+ )
+ (CheckBoxSpec
+ label: 'Linux font workaround: do not reset fonts on snapshot restart'
+ name: 'LinuxFontWorkaroundBox'
+ visibilityChannel: linuxFontWorkaroundVisible
+ model: linuxFontWorkaround
+ translateLabel: true
+ extent: (Point 566 22)
+ )
+ (DividerSpec
+ name: 'Separator12'
+ visibilityChannel: linuxFontWorkaroundVisible
+ extent: (Point 566 3)
+ )
+ (ViewSpec
+ name: 'SpecialsBox'
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Common Settings:'
+ name: 'Label4'
+ layout: (LayoutFrame 0 0.0 11 0 0 1.0 33 0)
+ translateLabel: true
+ adjust: left
+ )
+ (ActionButtonSpec
+ label: 'Default'
+ name: 'Button2'
+ layout: (LayoutFrame 0 0.0 35 0 130 0 57 0)
+ activeHelpKey: resetToDefault
+ translateLabel: true
+ tabable: true
+ model: changeToDefault
+ )
+ (ActionButtonSpec
+ label: 'High Contrast'
+ name: 'Button3'
+ layout: (LayoutFrame 148 0.0 35 0 278 0 57 0)
+ activeHelpKey: changeToHighContrast
+ translateLabel: true
+ tabable: true
+ model: changeToHighContrast
+ )
+ (ActionButtonSpec
+ label: 'Big Fonts'
+ name: 'Button4'
+ layout: (LayoutFrame 283 0.0 35 0 413 0 57 0)
+ activeHelpKey: changeToBigFonts
+ translateLabel: true
+ tabable: true
+ model: changeToBigFonts
+ )
+ (ActionButtonSpec
+ label: 'Huge Fonts'
+ name: 'Button5'
+ layout: (LayoutFrame 418 0.0 35 0 548 0 57 0)
+ activeHelpKey: changeToHugeFonts
+ translateLabel: true
+ tabable: true
+ model: changeToHugeFonts
+ )
+ (ActionButtonSpec
+ label: 'ST/X Look'
+ name: 'Button8'
+ layout: (LayoutFrame 148 0.0 67 0 278 0 89 0)
+ activeHelpKey: changeToSTXLook
+ translateLabel: true
+ tabable: true
+ model: changeToSTXLook
+ )
+ (ActionButtonSpec
+ label: 'Squeak Look'
+ name: 'Button6'
+ layout: (LayoutFrame 283 0.0 67 0 413 0 89 0)
+ activeHelpKey: changeToSqueakLook
+ translateLabel: true
+ tabable: true
+ model: changeToSqueakLook
+ )
+ (ActionButtonSpec
+ label: 'V''Age Look'
+ name: 'Button7'
+ layout: (LayoutFrame 418 0.0 67 0 548 0 89 0)
+ activeHelpKey: changeToVisualAgeLook
+ translateLabel: true
+ tabable: true
+ model: changeToVisualAgeLook
+ )
+ )
+
+ )
+ extent: (Point 566 94)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
! !
!AbstractSettingsApplication::FontSettingsAppl methodsFor:'accessing'!
@@ -4637,6 +4693,7 @@
basicReadFontSettings
"/ View readStyleSheetAndUpdateAllStyleCaches.
self allOfThem value:View defaultFont.
+ self otherDef value:View defaultFont.
self labelDef value:Label defaultFont.
self buttonDef value:Button defaultFont.
self listDef value:SelectionInListView defaultFont.
@@ -4660,8 +4717,12 @@
basicSaveSettings
|fn|
- View defaultFont:self allOfThem value.
- Label defaultFont:self labelDef value.
+ fn := self otherDef value.
+ View withAllSubclasses do:[:cls | cls defaultFont:fn].
+
+ fn := self labelDef value.
+ Label defaultFont:fn.
+ CheckBox defaultFont:fn.
fn := self buttonDef value.
Button defaultFont:fn.
@@ -4691,18 +4752,19 @@
changeAllFont
|f|
- f := FontPanel
- fontFromUserInitial:(self allOfThem value)
- title:(resources string:'Font for %1' with:'All')
- filter:filter.
+ f := FontPanel
+ fontFromUserInitial:(self allOfThem value)
+ title:(resources string:'Font for %1' with:'All')
+ filter:filter.
f notNil ifTrue:[
- self allOfThem value:(f onDevice:allLabel device).
- self labelDef value:(f onDevice:labelLabel device).
- self buttonDef value:(f onDevice:buttonsLabel device).
- self listDef value:(f onDevice:listsLabel device).
- self menuDef value:(f onDevice:menuLabel device).
- self textDef value:(f onDevice:textLabel device).
- self inputFieldDef value:(f onDevice:inputFieldLabel device).
+ "/ self allOfThem value:(f onDevice:allLabel device).
+ self otherDef value:(f onDevice:otherLabel device).
+ self labelDef value:(f onDevice:labelLabel device).
+ self buttonDef value:(f onDevice:buttonsLabel device).
+ self listDef value:(f onDevice:listsLabel device).
+ self menuDef value:(f onDevice:menuLabel device).
+ self textDef value:(f onDevice:textLabel device).
+ self inputFieldDef value:(f onDevice:inputFieldLabel device).
]
!
@@ -4767,6 +4829,18 @@
]
!
+changeOtherFont
+ |f|
+
+ f := FontPanel
+ fontFromUserInitial:(self otherDef value)
+ title:(resources string:'Font for %1' with:'All Others')
+ filter:filter.
+ f notNil ifTrue:[
+ self otherDef value:(f onDevice:otherLabel device).
+ ]
+!
+
changeTextFont
|f|
@@ -4807,6 +4881,8 @@
self listDef value:variableFont.
self labelDef value:variableFont.
self buttonDef value:variableFont.
+ self otherDef value:variableFont.
+
self allOfThem value:variableFont.
"Created: / 06-02-2012 / 12:18:34 / cg"
@@ -4829,8 +4905,8 @@
"/ fixFont := (Font family:'Courier New' face:'bold' style:'roman' size:16).
"/ variableFont := (Font family:'Arial' face:'bold' style:'roman' size:16).
- fixFont := (TextView defaultFont asSize:16) asFace:'bold'.
- variableFont := (Label defaultFont asSize:16) asFace:'bold'.
+ fixFont := (TextView defaultFont asSize:18) asFace:'bold'.
+ variableFont := (Label defaultFont asSize:18) asFace:'bold'.
self changeToFix:fixFont variable:variableFont.
"Created: / 17-03-2012 / 09:06:18 / cg"
@@ -5008,6 +5084,22 @@
^ menusFontLabelHolder.
!
+otherDef
+ otherDef isNil ifTrue:[
+ otherDef := ValueHolder new.
+ otherDef addDependent:self.
+ ].
+ ^ otherDef
+!
+
+otherFontLabelHolder
+
+ otherFontLabelHolder isNil ifTrue:[
+ otherFontLabelHolder := '' asValue.
+ ].
+ ^ otherFontLabelHolder.
+!
+
textDef
"return/create the 'textDef' value holder (automatically generated)"
@@ -5029,41 +5121,52 @@
!AbstractSettingsApplication::FontSettingsAppl methodsFor:'change & update'!
update:something with:aParameter from:changedObject
+ |whichLabel whichFontLabelHolder|
+
builder notNil ifTrue:[
- changedObject == self allOfThem ifTrue:[
- self updateFontOfLabel:allLabel andFontNameHolder:(self allFontLabelHolder) from:changedObject.
- ^ self.
- ].
- changedObject == self labelDef ifTrue:[
- self updateFontOfLabel:labelLabel andFontNameHolder:(self labelsFontLabelHolder) from:changedObject.
- ^ self.
- ].
- changedObject == self buttonDef ifTrue:[
- self updateFontOfLabel:buttonsLabel andFontNameHolder:(self buttonsFontLabelHolder) from:changedObject.
- ^ self.
- ].
- changedObject == self listDef ifTrue:[
- self updateFontOfLabel:listsLabel andFontNameHolder:(self listsFontLabelHolder) from:changedObject.
- ^ self.
- ].
- changedObject == self menuDef ifTrue:[
- self updateFontOfLabel:menuLabel andFontNameHolder:(self menusFontLabelHolder) from:changedObject.
- ^ self.
- ].
- changedObject == self textDef ifTrue:[
- self updateFontOfLabel:textLabel andFontNameHolder:(self textFontLabelHolder) from:changedObject.
- ^ self.
- ].
- changedObject == self inputFieldDef ifTrue:[
- self updateFontOfLabel:inputFieldLabel andFontNameHolder:(self inputFieldFontLabelHolder) from:changedObject.
- ^ self.
- ].
+ changedObject == self allOfThem ifTrue:[
+ whichLabel := allLabel.
+ whichFontLabelHolder := self allFontLabelHolder.
+ ].
+ changedObject == self otherDef ifTrue:[
+ whichLabel := otherLabel.
+ whichFontLabelHolder := self otherFontLabelHolder.
+ ].
+ changedObject == self labelDef ifTrue:[
+ whichLabel := labelLabel.
+ whichFontLabelHolder := self labelsFontLabelHolder.
+ ].
+ changedObject == self buttonDef ifTrue:[
+ whichLabel := buttonsLabel.
+ whichFontLabelHolder := self buttonsFontLabelHolder.
+ ].
+ changedObject == self listDef ifTrue:[
+ whichLabel := listsLabel.
+ whichFontLabelHolder := self listsFontLabelHolder.
+ ].
+ changedObject == self menuDef ifTrue:[
+ whichLabel := menuLabel.
+ whichFontLabelHolder := self menusFontLabelHolder.
+ ].
+ changedObject == self textDef ifTrue:[
+ whichLabel := textLabel.
+ whichFontLabelHolder := self textFontLabelHolder.
+ ].
+ changedObject == self inputFieldDef ifTrue:[
+ whichLabel := inputFieldLabel.
+ whichFontLabelHolder := self inputFieldFontLabelHolder.
+ ].
+ whichLabel notNil ifTrue:[
+ self updateFontOfLabel:whichLabel andFontNameHolder:whichFontLabelHolder from:changedObject.
+ ^ self.
+ ]
].
super update:something with:aParameter from:changedObject
!
updateAllFontLabels
self update:#value with:nil from:self allOfThem.
+ self update:#value with:nil from:self otherDef.
self update:#value with:nil from:self labelDef.
self update:#value with:nil from:self buttonDef.
self update:#value with:nil from:self listDef.
@@ -5124,6 +5227,11 @@
menuLabel := aWidget.
!
+postBuildOtherFontLabel:aWidget
+
+ otherLabel := aWidget.
+!
+
postBuildTextFontLabel:aWidget
textLabel := aWidget.
@@ -5138,6 +5246,7 @@
!AbstractSettingsApplication::FontSettingsAppl methodsFor:'queries'!
hasUnsavedChanges
+ self otherDef value ~= View defaultFont ifTrue:[^ true].
self labelDef value ~= Label defaultFont ifTrue:[^ true].
self buttonDef value ~= Button defaultFont ifTrue:[^ true].
self listDef value ~= SelectionInListView defaultFont ifTrue:[^ true].
@@ -6137,93 +6246,98 @@
<resource: #canvas>
- ^
- #(FullSpec
- name: windowSpec
- window:
- (WindowSpec
- label: 'Keyboard Mapping Settings'
- name: 'Keyboard Mapping Settings'
- min: (Point 10 10)
- bounds: (Rectangle 0 0 491 653)
- )
- component:
- (SpecCollection
- collection: (
- (VariableVerticalPanelSpec
- name: 'VariableVerticalPanel1'
- layout: (LayoutFrame 0 0.0 80 0 0 1.0 0 1.0)
- component:
- (SpecCollection
- collection: (
- (VariableHorizontalPanelSpec
- name: 'VariableHorizontalPanel1'
- component:
- (SpecCollection
- collection: (
- (SequenceViewSpec
- name: 'RawKeyList'
- model: selectedRawKey
- hasHorizontalScrollBar: true
- hasVerticalScrollBar: true
- useIndex: false
- sequenceList: rawKeyList
- )
- (SequenceViewSpec
- name: 'FunctionKeyList'
- model: selectedFunctionKey
- hasHorizontalScrollBar: true
- hasVerticalScrollBar: true
- useIndex: false
- sequenceList: functionKeyList
- )
- )
-
- )
- handles: (Any 0.5 1.0)
- )
- (ViewSpec
- name: 'Box1'
- component:
- (SpecCollection
- collection: (
- (TextEditorSpec
- name: 'MacroText'
- layout: (LayoutFrame 0 0.0 20 0 0 1.0 0 1.0)
- model: macroTextHolder
- hasHorizontalScrollBar: true
- hasVerticalScrollBar: true
- isReadOnly: true
- )
- (LabelSpec
- label: 'Macro text (if any):'
- name: 'MacroTextLabel'
- layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
- translateLabel: true
- adjust: left
- )
- )
-
- )
- )
- )
-
- )
- handles: (Any 0.5 1.0)
- )
- (LabelSpec
- label: 'NoticeText'
- name: 'Text'
- layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 80 0)
- translateLabel: true
- labelChannel: labelTextHolder
- resizeForLabel: true
- adjust: left
- )
- )
-
- )
- )
+ ^
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'Keyboard Mapping Settings'
+ name: 'Keyboard Mapping Settings'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 491 653)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (TextEditorSpec
+ name: 'Text'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 100 0)
+ enableChannel: false
+ model: labelTextHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ miniScrollerVertical: true
+ isReadOnly: true
+ hasKeyboardFocusInitially: false
+ viewClassName: 'TextView'
+ )
+ (VariableVerticalPanelSpec
+ name: 'VariableVerticalPanel1'
+ layout: (LayoutFrame 0 0.0 100 0 0 1.0 0 1.0)
+ component:
+ (SpecCollection
+ collection: (
+ (VariableHorizontalPanelSpec
+ name: 'VariableHorizontalPanel1'
+ component:
+ (SpecCollection
+ collection: (
+ (SequenceViewSpec
+ name: 'RawKeyList'
+ model: selectedRawKey
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ useIndex: false
+ sequenceList: rawKeyList
+ )
+ (SequenceViewSpec
+ name: 'FunctionKeyList'
+ model: selectedFunctionKey
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ useIndex: false
+ sequenceList: functionKeyList
+ )
+ )
+
+ )
+ handles: (Any 0.5 1.0)
+ )
+ (ViewSpec
+ name: 'Box1'
+ component:
+ (SpecCollection
+ collection: (
+ (TextEditorSpec
+ name: 'MacroText'
+ layout: (LayoutFrame 0 0.0 20 0 0 1.0 0 1.0)
+ model: macroTextHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ isReadOnly: true
+ hasKeyboardFocusInitially: false
+ )
+ (LabelSpec
+ label: 'Macro text (if any):'
+ name: 'MacroTextLabel'
+ layout: (LayoutFrame 0 0.0 0 0 0 1.0 20 0)
+ translateLabel: true
+ adjust: left
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ handles: (Any 0.5 1.0)
+ )
+ )
+
+ )
+ )
! !
!AbstractSettingsApplication::KbdMappingSettingsAppl methodsFor:'actions'!
@@ -18872,11 +18986,11 @@
!AbstractSettingsApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.495 2013-09-03 13:14:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.498 2013-09-04 21:50:52 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.495 2013-09-03 13:14:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.498 2013-09-04 21:50:52 cg Exp $'
!
version_HG
--- a/Make.proto Fri Sep 06 12:08:37 2013 +0100
+++ b/Make.proto Fri Sep 06 15:49:08 2013 +0100
@@ -1,4 +1,4 @@
-# $Header$
+# $Header: /cvs/stx/stx/libtool/Make.proto,v 1.175 2013-09-05 21:35:26 vrany Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libtool.
--- a/Make.spec Fri Sep 06 12:08:37 2013 +0100
+++ b/Make.spec Fri Sep 06 15:49:08 2013 +0100
@@ -1,4 +1,4 @@
-# $Header$
+# $Header: /cvs/stx/stx/libtool/Make.spec,v 1.88 2013-09-05 21:35:16 vrany Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libtool.
--- a/Tools_BrowserList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_BrowserList.st Fri Sep 06 15:49:08 2013 +0100
@@ -185,6 +185,18 @@
!BrowserList methodsFor:'accessing'!
+environment:env
+ | prevenv |
+
+ prevenv := environment.
+ environment := env.
+ environment ~~ prevenv ifTrue:[
+ self enqueueMessage: #updateList for: self arguments: #()
+ ]
+
+ "Created: / 03-09-2013 / 18:32:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
nameFilter:something
nameFilter := something.
! !
@@ -607,7 +619,7 @@
delayedUpdate:something with:aParameter from:changedObject
"/ if any of my subclasses want those, they should look for them.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
(something == #Language or:[something == #LanguageTerritory]) ifTrue:[
^ self
].
@@ -868,7 +880,7 @@
dropClassFiles:files
files do:[:fn |
(Dialog confirm:(resources string:'FileIn %1 ?' with:fn baseName allBold)) ifTrue:[
- Smalltalk fileIn:fn logged:true.
+ environment fileIn:fn logged:true.
]
].
@@ -1878,10 +1890,10 @@
!BrowserList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.57 2013-03-22 11:36:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.58 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.57 2013-03-22 11:36:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.58 2013-09-05 10:46:11 vrany Exp $'
! !
--- a/Tools_ClassCategoryList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_ClassCategoryList.st Fri Sep 06 15:49:08 2013 +0100
@@ -275,7 +275,7 @@
selectedCategories := self selectedCategoriesStrings.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
((something == #classVariables)
or:[something == #classDefinition]) ifTrue:[
listValid == true ifTrue:[
@@ -452,7 +452,7 @@
update:something with:aParameter from:changedObject
|categoryOfClass|
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
(something == #methodInClass
or:[ something == #classComment
or:[ something == #methodDictionary
@@ -627,7 +627,7 @@
^ Iterator on:[:whatToDo |
showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
(cls isRealNameSpace) ifFalse:[
(inclusionTest value:cls) ifTrue:[
(nameSpaceFilter isNil
@@ -702,7 +702,7 @@
classes := IdentitySet new.
inGeneratorHolder isNil ifTrue:[
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|cat isLoaded|
(cls isRealNameSpace) ifFalse:[
@@ -764,7 +764,7 @@
setOfCategories := Set withAll:generator.
generator do:[:cat | categories add:cat string].
- Smalltalk allClassesDo:[:each |
+ environment allClassesDo:[:each |
|cat|
each isNameSpace ifFalse:[
@@ -852,14 +852,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
ChangeSet addDependent:self.
"Created: / 5.2.2000 / 13:42:13 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
ChangeSet removeDependent:self.
"Created: / 5.2.2000 / 13:42:13 / cg"
@@ -1009,10 +1009,10 @@
!ClassCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.49 2013-07-20 10:27:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.50 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.49 2013-07-20 10:27:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.50 2013-09-05 10:46:11 vrany Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_ClassGeneratorList.st Fri Sep 06 15:49:08 2013 +0100
@@ -0,0 +1,524 @@
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+BrowserList subclass:#ClassGeneratorList
+ instanceVariableNames:'organizerList categoryList namespaceList namespaceNameList
+ projectList selectedCategories selectedNamespaces
+ selectedProjects selectedClasses'
+ classVariableNames:'AdditionalEmptyCategories AdditionalEmptyProjects'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!ClassGeneratorList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ embeddable application displaying the class-categories.
+ Provides an outputGenerator, which enumerates the classes in
+ the selected categories.
+
+ [author:]
+ Claus Gittinger (cg@exept.de)
+"
+! !
+
+!ClassGeneratorList class methodsFor:'interface specs'!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassGeneratorList andSelector:#windowSpec
+ ClassGeneratorList new openInterface:#windowSpec
+ ClassGeneratorList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'OrganizerList'
+ #name: 'OrganizerList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #organizerSelection
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: true
+ #sequenceList: #organizerList
+ #doubleClickChannel: #doubleClickChannel
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 18.8.2000 / 20:12:20 / cg"
+! !
+
+!ClassGeneratorList methodsFor:'aspects'!
+
+categoryList
+ categoryList isNil ifTrue:[
+ categoryList := ValueHolder new.
+ ].
+ ^ categoryList
+
+
+!
+
+nameSpaceList
+ namespaceList isNil ifTrue:[
+ namespaceList := ValueHolder new
+ ].
+ ^ namespaceList
+
+ "Created: / 18.2.2000 / 00:59:01 / cg"
+!
+
+projectList
+ projectList isNil ifTrue:[
+ projectList := ValueHolder new
+ ].
+ ^ projectList
+
+ "Created: / 17.2.2000 / 23:39:32 / cg"
+
+!
+
+selectedCategories
+ selectedCategories isNil ifTrue:[
+ selectedCategories := ValueHolder new.
+ selectedCategories addDependent:self
+ ].
+ ^ selectedCategories.
+
+!
+
+selectedCategories:aValueHolder
+ |prevSelection|
+
+ prevSelection := selectedCategories value ? #().
+
+ selectedCategories notNil ifTrue:[
+ selectedCategories removeDependent:self
+ ].
+ selectedCategories := aValueHolder.
+ selectedCategories notNil ifTrue:[
+ selectedCategories addDependent:self
+ ].
+ (selectedCategories value ? #()) ~= prevSelection ifTrue:[
+ "/ update
+ self update:#value with:nil from:selectedCategories
+ ].
+
+
+
+!
+
+selectedClasses
+ "bad name- it's a holder, baby"
+
+ selectedClasses isNil ifTrue:[
+ selectedClasses := ValueHolder new.
+ ].
+ ^ selectedClasses.
+!
+
+selectedClasses:aValueHolder
+"/ selectedClasses notNil ifTrue:[
+"/ selectedClasses removeDependent:self
+"/ ].
+ selectedClasses := aValueHolder.
+"/ selectedClasses notNil ifTrue:[
+"/ selectedClasses addDependent:self
+"/ ].
+!
+
+selectedNamespaces
+ selectedNamespaces isNil ifTrue:[
+ selectedNamespaces := ValueHolder new.
+ selectedNamespaces addDependent:self
+ ].
+ ^ selectedNamespaces.
+
+!
+
+selectedNamespaces:aValueHolder
+ |prevSelection|
+
+ prevSelection := selectedNamespaces value ? #().
+
+ selectedNamespaces notNil ifTrue:[
+ selectedNamespaces removeDependent:self
+ ].
+ selectedNamespaces := aValueHolder.
+ selectedNamespaces notNil ifTrue:[
+ selectedNamespaces addDependent:self
+ ].
+ (selectedNamespaces value ? #()) ~= prevSelection ifTrue:[
+ "/ update
+ self update:#value with:nil from:selectedNamespaces
+ ].
+
+
+
+!
+
+selectedProjects
+ selectedProjects isNil ifTrue:[
+ selectedProjects := ValueHolder new.
+ selectedProjects addDependent:self
+ ].
+ ^ selectedProjects.
+
+!
+
+selectedProjects:aValueHolder
+ |prevSelection|
+
+ prevSelection := selectedProjects value ? #().
+
+ selectedProjects notNil ifTrue:[
+ selectedProjects removeDependent:self
+ ].
+ selectedProjects := aValueHolder.
+ selectedProjects notNil ifTrue:[
+ selectedProjects addDependent:self
+ ].
+ (selectedProjects value ? #()) ~= prevSelection ifTrue:[
+ "/ update
+ self update:#value with:nil from:selectedProjects
+ ].
+
+
+
+! !
+
+!ClassGeneratorList methodsFor:'aspects-private'!
+
+organizerList
+ organizerList isNil ifTrue:[
+ organizerList := ValueHolder new.
+ ].
+ ^ organizerList
+
+
+! !
+
+!ClassGeneratorList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |cls sel pkg mthd orgMode|
+
+ changedObject == environment ifTrue:[
+ orgMode := organizerMode value.
+
+ orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
+ (something == #organization
+ or:[something == #newClass]) ifTrue:[
+ self updateList.
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[ ^ self ].
+"/ self halt:'debug halt'.
+ ^ self.
+ ].
+ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
+ (something == #newClass
+ or:[something == #classRemove]) ifTrue:[
+ aParameter isNameSpace ifTrue:[
+ self updateList
+ ].
+ ^ self
+ ].
+"/ self halt:'debug halt'.
+ ^ self
+ ].
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ something == #projectOrganization ifTrue:[
+ self updateList.
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ mthd := cls compiledMethodAt:sel.
+ pkg := mthd package.
+ (projectList value includes:pkg) ifFalse:[
+ self halt:'debug-halt. remove when known to work'.
+ self updateList.
+ ^ self
+ ].
+ ^ self
+ ].
+ (something == #classDefinition
+ or:[something == #newClass]) ifTrue:[
+ cls := aParameter.
+ pkg := cls package.
+ (projectList value includes:pkg) ifFalse:[
+ self halt:'debug-halt. remove when known to work'.
+ self updateList.
+ ^ self
+ ].
+ ^ self
+ ].
+"/ self halt.
+ ^ self
+ ].
+ ^ self
+ ].
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 25.2.2000 / 21:32:03 / cg"
+ "Modified: / 25.2.2000 / 21:35:23 / cg"
+! !
+
+!ClassGeneratorList methodsFor:'private'!
+
+listFromInGenerator
+ |generator theList|
+
+ theList := Set new.
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:prj | theList add:prj].
+ theList := theList asOrderedCollection sort.
+ theList addFirst:(self class nameListEntryForALL allItalic).
+ ^ theList
+
+ "Created: / 25.2.2000 / 21:24:26 / cg"
+!
+
+listOfCategories
+ |categories hideUnloadedClasses|
+
+ inGeneratorHolder notNil ifTrue:[
+ ^ self listFromInGenerator
+ ].
+
+ hideUnloadedClasses := self hideUnloadedClasses value.
+
+ categories := Set new.
+ environment allClassesDo:[:cls |
+ (hideUnloadedClasses not or:[cls isLoaded])
+ ifTrue:[
+ categories add:cls category.
+ ]
+ ].
+
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyCategories size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyCategories := AdditionalEmptyCategories reject:[:cat | (categories includes:cat)].
+ categories addAll:AdditionalEmptyCategories.
+ ].
+ categories := categories asOrderedCollection.
+ categories sort.
+ categories addFirst:(self class nameListEntryForALL allItalic).
+ ^ categories
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 25.2.2000 / 21:26:04 / cg"
+!
+
+listOfNamespaces
+ |allNamespaces showAllNamespaces|
+
+ inGeneratorHolder notNil ifTrue:[
+ ^ self listFromInGenerator
+ ].
+
+showAllNamespaces := true.
+
+ allNamespaces := IdentitySet new.
+
+ (self hideUnloadedClasses value) ifTrue:[
+ environment allClassesDo:[:eachClass |
+ eachClass isLoaded ifTrue:[
+ allNamespaces add:(eachClass theNonMetaclass topNameSpace)
+ ].
+ ]
+ ] ifFalse:[
+ allNamespaces := NameSpace allNameSpaces.
+ ].
+
+ showAllNamespaces ifFalse:[
+ "/ only topLevel namespaces are shown
+ "/ i.e. ignore subspaces
+
+ allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
+ ].
+ allNamespaces := allNamespaces collect:[:ns | ns name].
+ allNamespaces := allNamespaces asOrderedCollection.
+ allNamespaces sort.
+ allNamespaces addFirst:(self class nameListEntryForALL allItalic).
+ ^ allNamespaces
+
+ "Created: / 25.2.2000 / 21:21:14 / cg"
+ "Modified: / 25.2.2000 / 21:26:41 / cg"
+!
+
+listOfProjects
+ |allProjects|
+
+ inGeneratorHolder notNil ifTrue:[
+ ^ self listFromInGenerator
+ ].
+
+ allProjects := IdentitySet new.
+
+ (self hideUnloadedClasses value) ifTrue:[
+ allProjects := environment allLoadedProjectIDs.
+ ] ifFalse:[
+ allProjects := environment allProjectIDs.
+ ].
+
+ "/ those are simulated - in ST/X, empty projects do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyProjects size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyProjects := AdditionalEmptyProjects reject:[:pkg | (allProjects includes:pkg)].
+ allProjects addAll:AdditionalEmptyProjects.
+ ].
+ allProjects sort.
+ allProjects addFirst:(self class nameListEntryForALL allItalic).
+ ^ allProjects
+
+ "Created: / 25.2.2000 / 21:22:06 / cg"
+ "Modified: / 25.2.2000 / 21:27:27 / cg"
+!
+
+makeDependent
+ environment addDependent:self
+
+!
+
+makeIndependent
+ environment removeDependent:self.
+
+!
+
+release
+ super release.
+
+ selectedCategories removeDependent:self.
+ selectedNamespaces removeDependent:self.
+ selectedProjects removeDependent:self.
+!
+
+updateCategoryList
+ |newList|
+
+ newList := self listOfCategories.
+ newList ~= self categoryList value ifTrue:[
+ categoryList value:newList.
+ self organizerList value:newList.
+ ].
+
+ "Created: / 25.2.2000 / 21:12:32 / cg"
+!
+
+updateList
+ |orgMode|
+
+ orgMode := self organizerMode value.
+ orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
+ self updateCategoryList.
+ ^ self
+ ].
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ self updateProjectList.
+ ^ self
+ ].
+ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
+ self updateNamespaceList.
+ ^ self
+ ].
+ self halt:'unexpected value'.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+ "Modified: / 25.2.2000 / 21:14:19 / cg"
+!
+
+updateNamespaceList
+ |newList|
+
+ newList := self listOfNamespaces.
+ newList ~= self nameSpaceList value ifTrue:[
+ namespaceList value:newList.
+ self organizerList value:newList.
+ ].
+
+ "Created: / 25.2.2000 / 21:13:16 / cg"
+!
+
+updateProjectList
+ |newList|
+
+ newList := self listOfProjects.
+ newList ~= self projectList value ifTrue:[
+ projectList value:newList.
+ self organizerList value:newList.
+ ].
+
+ "Created: / 25.2.2000 / 21:12:57 / cg"
+! !
+
+!ClassGeneratorList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.14 2013-09-05 10:46:11 vrany Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.14 2013-09-05 10:46:11 vrany Exp $'
+! !
+
--- a/Tools_ClassList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_ClassList.st Fri Sep 06 15:49:08 2013 +0100
@@ -513,7 +513,7 @@
^ self.
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #methodInClass ifTrue:[
^ self "no interest"
].
@@ -822,7 +822,7 @@
classListValue := classList value.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #classComment ifTrue:[
^ self.
].
@@ -1186,7 +1186,7 @@
inGeneratorHolder isNil ifTrue:[
"/ for standAlone testing
- generator := Smalltalk allClasses.
+ generator := environment allClasses.
(self hideUnloadedClasses value) ifTrue:[
generator := generator select:[:cls | cls isLoaded]
].
@@ -1315,7 +1315,7 @@
inGeneratorHolder isNil ifTrue:[
"/ for standAlone testing
- generator := Smalltalk allClasses.
+ generator := environment allClasses.
(self hideUnloadedClasses value) ifTrue:[
generator := generator select:[:cls | cls isLoaded]
].
@@ -1412,14 +1412,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
ChangeSet addDependent:self.
"Created: / 5.2.2000 / 13:42:17 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
ChangeSet removeDependent:self.
!
@@ -1628,7 +1628,7 @@
|newClass|
meta := cls isMeta.
- newClass := Smalltalk at:(cls theNonMetaclass name).
+ newClass := environment at:(cls theNonMetaclass name).
newClass isNil ifTrue:[
newClass := cls
] ifFalse:[
@@ -1645,7 +1645,7 @@
cls notNil ifTrue:[
meta := cls isMeta.
- newClass := Smalltalk at:(cls theNonMetaclass name).
+ newClass := environment at:(cls theNonMetaclass name).
newClass isNil ifTrue:[
newClass := cls
] ifFalse:[
@@ -1723,7 +1723,7 @@
newSelectionIndices := prevSelection
collect:[:item | |cls|
- cls := Smalltalk at:item theNonMetaclass name.
+ cls := environment at:item theNonMetaclass name.
newList identityIndexOf:cls]
thenSelect:[:index | index ~~ 0].
@@ -2028,10 +2028,10 @@
!ClassList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.75 2013-08-31 19:32:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.75 2013-08-31 19:32:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_FullMethodCategoryList.st Fri Sep 06 15:49:08 2013 +0100
@@ -0,0 +1,127 @@
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+MethodCategoryList subclass:#FullMethodCategoryList
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!FullMethodCategoryList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ embeddable application displaying the classes as listed by
+ the inputGenerator.
+ Provides an outputGenerator, which enumerates the classes and
+ their protocols (method-categories) in the selected classes.
+
+ [author:]
+ Claus Gittinger (cg@exept.de)
+"
+
+
+! !
+
+!FullMethodCategoryList methodsFor:'generators'!
+
+makeGenerator
+ "return a generator which enumerates the methods from the selected protocol;
+ that generator generates 4-element elements (includes the class and protocol),
+ in order to make the consumers only depend on one input
+ (i.e. to pass multiple-class and multiple-protocol info
+ without a need for another classHolder/protocolHolder in the methodList)."
+
+ ^ Iterator on:[:whatToDo |
+ |protocols all packages theProtocol|
+
+ protocols := self selectedProtocols value ? #().
+
+ all := protocols includes:(self class nameListEntryForALL).
+ packages := packageFilter value value.
+
+ protocols size > 0 ifTrue:[
+ protocols size == 1 ifTrue:[
+ theProtocol := protocols first.
+ environment allClassesDo:[:eachClass |
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
+ |cat|
+
+ cat := eachMethod category.
+ (all
+ or:[theProtocol = cat]) ifTrue:[
+ (packages isNil
+ or:[packages includes:eachMethod package])
+ ifTrue:[
+ whatToDo value:eachClass value:cat value:sel value:eachMethod.
+ ].
+ ].
+ ].
+ ]
+ ] ifFalse:[
+ environment allClassesDo:[:eachClass |
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
+ |cat|
+
+ cat := eachMethod category.
+ (all
+ or:[protocols includes:cat]) ifTrue:[
+ (packages isNil
+ or:[packages includes:eachMethod package])
+ ifTrue:[
+ whatToDo value:eachClass value:cat value:sel value:eachMethod.
+ ].
+ ].
+ ].
+ ]
+ ]
+ ]
+ ]
+! !
+
+!FullMethodCategoryList methodsFor:'private'!
+
+listOfMethodCategories
+ |categories|
+
+ categories := Set new.
+
+ categories addAll:MethodCategoryCache new allMethodCategories.
+
+ categories := categories asOrderedCollection sort.
+ categories addFirst:(self class nameListEntryForALL).
+ ^ categories
+! !
+
+!FullMethodCategoryList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_FullMethodCategoryList.st,v 1.6 2013-09-05 10:46:11 vrany Exp $'
+! !
--- a/Tools_HierarchicalClassList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_HierarchicalClassList.st Fri Sep 06 15:49:08 2013 +0100
@@ -160,7 +160,7 @@
self updateList.
selectedClassesHolder value ~= prevSelection ifTrue:[
- newSelection := prevSelection collect:[:eachOldClass | Smalltalk classNamed:(eachOldClass name)].
+ newSelection := prevSelection collect:[:eachOldClass | environment classNamed:(eachOldClass name)].
selectedClassesHolder value:newSelection.
]
@@ -175,7 +175,7 @@
prevTop notNil ifTrue:[
wasMeta := prevTop isMeta.
newTop := prevTop theNonMetaclass.
- [newTop notNil and:[(Smalltalk at:newTop name) ~= newTop]] whileTrue:[
+ [newTop notNil and:[(environment at:newTop name) ~= newTop]] whileTrue:[
newTop := newTop superclass.
].
wasMeta ifTrue:[
@@ -221,7 +221,7 @@
|theClasses|
aSuperclass isNil ifTrue:[
- theClasses := Smalltalk allClasses select:[:cls | cls superclass isNil]
+ theClasses := environment allClasses select:[:cls | cls superclass isNil]
] ifFalse:[
theClasses := aSuperclass subclasses.
].
@@ -316,7 +316,7 @@
!HierarchicalClassList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassList.st,v 1.12 2013-07-04 15:20:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassList.st,v 1.13 2013-09-05 10:46:11 vrany Exp $'
! !
--- a/Tools_HierarchicalProjectList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_HierarchicalProjectList.st Fri Sep 06 15:49:08 2013 +0100
@@ -248,7 +248,7 @@
].
].
-"/ Smalltalk allClassesDo:[:eachClass |
+"/ environment allClassesDo:[:eachClass |
"/ |package|
"/
"/ package := eachClass package asSymbol.
@@ -518,10 +518,10 @@
!HierarchicalProjectList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.12 2013-04-25 13:10:59 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.13 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.12 2013-04-25 13:10:59 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.13 2013-09-05 10:46:11 vrany Exp $'
! !
--- a/Tools_MethodCategoryList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_MethodCategoryList.st Fri Sep 06 15:49:08 2013 +0100
@@ -419,7 +419,7 @@
nm := oldClass theNonMetaclass name.
oldClass isMeta ifTrue:[
- newClass := Smalltalk at:nm.
+ newClass := environment at:nm.
newClass isNil ifTrue:[
"/ Transcript showCR:'oops - browser lost class ' , nm.
newClass := oldClass
@@ -427,7 +427,7 @@
newClass := newClass theMetaclass
]
] ifFalse:[
- newClass := Smalltalk at:nm
+ newClass := environment at:nm
].
newClass ~~ oldClass ifTrue:[
anyChange := true.
@@ -451,7 +451,7 @@
selectedProtocolsHolder := self selectedProtocols.
rawProtocolListHolder := self rawProtocolList.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
classes notNil ifTrue:[
something == #methodCategory ifTrue:[
cls := aParameter at:1.
@@ -715,9 +715,9 @@
|cls sel mthd oldMethod newMethod|
"/ some can be ignored immediately
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
+ "/ self halt "/ huh - environment changed - so what ?
^ self.
].
@@ -1586,14 +1586,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
"/ ChangeSet addDependent:self.
"Modified: / 10-11-2006 / 17:57:13 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
"/ ChangeSet removeDependent:self.
!
@@ -1690,7 +1690,7 @@
"/ TODO: start a background thread to compute the stuff below,
"/ notify me to update the list, when all the lazy info is avail...
] ifFalse:[
- true "aMethod mclass language isSmalltalk" ifTrue:[
+ true "aMethod mclass language isenvironment" ifTrue:[
methodsPackage := aMethod package.
isVersionMethod := aMethod isVersionMethod.
@@ -1799,7 +1799,7 @@
].
categories add:aProtocol.
aClass changed:#organization. "/ not really ... to force update
- Smalltalk changed:#methodCategoryAdded with:(Array with:aClass with:aProtocol). "/ not really ... to force update
+ environment changed:#methodCategoryAdded with:(Array with:aClass with:aProtocol). "/ not really ... to force update
"Modified (comment): / 01-08-2012 / 17:30:36 / cg"
!
@@ -1842,7 +1842,7 @@
].
aClass changed:#organization. "/ not really ... to force update
- Smalltalk changed:#methodCategoriesRemoved with:(Array with:aClass with:aListOfProtocols). "/ not really ... to force update
+ environment changed:#methodCategoriesRemoved with:(Array with:aClass with:aListOfProtocols). "/ not really ... to force update
"Modified (comment): / 01-08-2012 / 17:29:59 / cg"
!
@@ -1886,7 +1886,7 @@
categories add:newName.
aClass changed:#organization. "/ not really ... to force update
- Smalltalk changed:#methodCategoryRenamed with:(Array with:aClass with:oldName with:newName). "/ not really ... to force update
+ environment changed:#methodCategoryRenamed with:(Array with:aClass with:oldName with:newName). "/ not really ... to force update
"Modified (comment): / 01-08-2012 / 17:30:16 / cg"
! !
@@ -2089,11 +2089,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.95 2013-07-20 10:29:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.96 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.95 2013-07-20 10:29:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.96 2013-09-05 10:46:11 vrany Exp $'
! !
--- a/Tools_MethodList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_MethodList.st Fri Sep 06 15:49:08 2013 +0100
@@ -348,7 +348,7 @@
selectionHolder := self selectedMethods.
selection := selectionHolder value.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
classes notNil ifTrue:[
something == #classDefinition ifTrue:[
cls := aParameter.
@@ -356,7 +356,7 @@
(classes contains:[:aClass | aClass name = clsName]) ifFalse:[
^ self "/ I don't care for that class
].
- classes := classes collect:[:eachClass | (Smalltalk classNamed:eachClass name) ].
+ classes := classes collect:[:eachClass | (environment classNamed:eachClass name) ].
self invalidateList.
"/ self updateList.
^ self.
@@ -763,12 +763,12 @@
mustFlushInheritanceInfo := true.
"/ some can be ignored immediately
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
classes isNil ifTrue:[
^ self.
].
something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
+ "/ self halt "/ huh - environment changed - so what ?
^ self.
].
something == #classComment ifTrue:[
@@ -1246,14 +1246,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
"/ ChangeSet addDependent:self.
"Modified: / 10-11-2006 / 17:57:01 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
"/ ChangeSet removeDependent:self.
!
@@ -1818,10 +1818,10 @@
!MethodList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.91 2013-08-27 13:33:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.92 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.91 2013-08-27 13:33:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.92 2013-09-05 10:46:11 vrany Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_NamespaceList.st Fri Sep 06 15:49:08 2013 +0100
@@ -0,0 +1,565 @@
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+BrowserList subclass:#NamespaceList
+ instanceVariableNames:'namespaceNameList namespaceList'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!NamespaceList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ I implement the namespace list in the new system browser
+"
+! !
+
+!NamespaceList class methodsFor:'interface specs'!
+
+singleNameSpaceWindowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassCategoryList andSelector:#singleCategoryWindowSpec
+ ClassCategoryList new openInterface:#singleCategoryWindowSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #singleNameSpaceWindowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'NameSpaceList'
+ #name: 'NameSpaceList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 218 175 518 475)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#LabelSpec
+ #label: 'NameSpaceName'
+ #name: 'NameSpaceLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #nameSpaceLabelHolder
+ #menu: #menuHolder
+ )
+ )
+
+ )
+ )
+!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ProjectList andSelector:#windowSpec
+ ProjectList new openInterface:#windowSpec
+ ProjectList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'NamespaceList'
+ #name: 'NamespaceList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 13 23 313 323)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #selectedNamespaces
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: false
+ #sequenceList: #nameSpaceList
+ #doubleClickChannel: #doubleClickChannel
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
+
+ )
+ )
+
+ "Created: / 18.2.2000 / 01:06:05 / cg"
+ "Modified: / 18.2.2000 / 01:24:50 / cg"
+! !
+
+!NamespaceList class methodsFor:'queries-plugin'!
+
+aspectSelectors
+ ^ #(
+ #(#doubleClickChannel #action )
+ immediateUpdate
+ selectedNamespaces
+ menuHolder
+ inGeneratorHolder
+ outGeneratorHolder
+ selectionChangeCondition
+ updateTrigger
+ forceGeneratorTrigger
+ hideUnloadedClasses
+ showAllClassesInNameSpaceOrganisation
+ organizerMode
+ slaveMode
+ )
+
+ "Created: / 18-02-2000 / 01:06:27 / cg"
+ "Modified: / 05-03-2007 / 16:47:45 / cg"
+! !
+
+!NamespaceList methodsFor:'aspects'!
+
+itemList
+ ^ self nameSpaceList value
+!
+
+nameSpaceLabelHolder
+ ^ self pseudoListLabelHolder
+!
+
+nameSpaceList
+ namespaceList isNil ifTrue:[
+ namespaceList := ValueHolder new
+ ].
+ ^ namespaceList
+
+ "Created: / 18.2.2000 / 00:59:01 / cg"
+!
+
+selectedNamespaces
+ ^ self selectionHolder
+
+!
+
+selectedNamespaces:aValueHolder
+ ^ self selectionHolder:aValueHolder
+
+! !
+
+!NamespaceList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+
+ self inSlaveModeOrInvisible
+ ifTrue:[
+ changedObject == environment ifTrue:[
+ something == #classComment ifTrue:[^ self].
+ ].
+ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == slaveMode ifTrue:[
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ "/ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == environment ifTrue:[
+ something == #newClass ifTrue:[
+ listValid == true ifTrue:[
+ aParameter isNameSpace ifTrue:[
+ (namespaceList value includes:aParameter name) ifFalse:[
+ self invalidateList.
+ ]
+ ].
+ ].
+ ^ self
+ ].
+ something == #classRemove ifTrue:[
+ listValid == true ifTrue:[
+ aParameter isNameSpace ifTrue:[
+ self invalidateList.
+ ].
+ ].
+ ^ self
+ ].
+ ^ self
+ ].
+
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 18.2.2000 / 01:00:07 / cg"
+ "Modified: / 26.2.2000 / 01:10:46 / cg"
+!
+
+selectionChangedByClick
+ "we are not interested in that - get another notification
+ via the changed valueHolder"
+
+ "Created: / 18.2.2000 / 01:00:14 / cg"
+!
+
+update:something with:aParameter from:changedObject
+ changedObject == environment ifTrue:[
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
+ something == #methodCoverageInfo ifTrue:[
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[
+ ^ self
+ ].
+ something == #classVariables ifTrue:[
+ ^ self
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #methodInClassRemoved ifTrue:[
+ ^ self.
+ ].
+ ].
+ super update:something with:aParameter from:changedObject
+
+ "Modified: / 20-07-2011 / 18:55:12 / cg"
+! !
+
+!NamespaceList methodsFor:'drag & drop'!
+
+canDropContext:aDropContext
+ |objects nameSpace|
+
+ objects := aDropContext dropObjects collect:[:obj | obj theObject].
+ (objects conform:[:aMethodOrClass | aMethodOrClass isClass ]) ifFalse:[^ false].
+
+ nameSpace := self nameSpaceAtTargetPointOf:aDropContext.
+ nameSpace isNil ifTrue:[^ false].
+ nameSpace = self class nameListEntryForALL ifTrue:[^ false].
+
+ ^ (objects contains:[:aClass | aClass nameSpace name ~= nameSpace])
+!
+
+doDropContext:aDropContext
+ |nameSpaceName nameSpace objects|
+
+ objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+ (objects conform:[:something | something isClass]) ifTrue:[
+ nameSpaceName := self nameSpaceAtTargetPointOf:aDropContext.
+ (nameSpaceName notNil
+ and:[ nameSpaceName ~= self class nameListEntryForALL]) ifTrue:[
+ nameSpace := NameSpace name:nameSpaceName.
+ objects do:[:eachClassToMove |
+ |className|
+
+ className := eachClassToMove nameWithoutPrefix.
+ nameSpace == environment ifTrue:[
+ environment renameClass:eachClassToMove to:className asSymbol.
+ ] ifFalse:[
+ environment renameClass:eachClassToMove to:(nameSpace name , '::' , className) asSymbol.
+ nameSpace changed.
+ ].
+ ].
+ environment changed.
+ ].
+ ^ self
+ ].
+!
+
+nameSpaceAtTargetPointOf:aDropContext
+ |p targetView lineNr item|
+
+ p := aDropContext targetPoint.
+
+ targetView := aDropContext targetWidget.
+
+ lineNr := targetView yVisibleToLineNr:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ item := self itemList at:lineNr.
+ item isNil ifTrue:[^ nil].
+
+ ^ item
+! !
+
+!NamespaceList methodsFor:'generators'!
+
+makeGenerator
+ "return a generator which enumerates the classes from the selected namespace(s)."
+
+ |spaceNames hideUnloadedClasses showAllClasses showChangedClasses|
+
+ spaceNames := self selectedNamespaces value.
+ spaceNames size == 0 ifTrue:[
+ ^ #()
+ ].
+
+ hideUnloadedClasses := self hideUnloadedClasses value.
+ showAllClasses := self showAllClassesInNameSpaceOrganisation value.
+ showChangedClasses := spaceNames includes:(self class nameListEntryForChanged).
+
+ (showAllClasses or:[spaceNames includes:(self class nameListEntryForALL)]) ifTrue:[
+ hideUnloadedClasses ifTrue:[
+ ^ Iterator on:[:whatToDo |
+ environment allClassesDo:[:cls |
+ cls isLoaded ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ Iterator on:[:whatToDo |
+ environment allClassesDo:whatToDo
+ ]
+ ].
+
+ (spaceNames size == 1
+ and:[spaceNames first = 'environment']) ifTrue:[
+ "/ somewhat tuned - quick look if classes name includes colons ...
+ ^ Iterator on:[:whatToDo |
+ environment allClassesDo:[:cls |
+ |includeIt|
+
+ includeIt := (cls name includes:$:) not.
+ includeIt := includeIt
+ or:[(cls isPrivate not
+ and:[(cls nameSpace == environment)])].
+ includeIt := includeIt
+ or:[(cls isPrivate
+ and:[(cls topOwningClass nameSpace == environment)])].
+
+ includeIt := includeIt
+ and:[hideUnloadedClasses not or:[cls isLoaded]].
+
+ includeIt := includeIt
+ or:[ cls extensions
+ contains:[:mthd |
+ |sel parts|
+ sel := mthd selector.
+ (sel isNameSpaceSelector
+ and:[ parts := sel nameSpaceSelectorParts.
+ spaceNames includes:parts first])
+ ]
+ ].
+
+ includeIt ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ ^ Iterator on:[:whatToDo |
+ |changedClasses|
+
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses collect:[:cls | cls theNonMetaclass]].
+
+ environment allClassesDo:[:cls |
+ |spaceOfClass spaceNameOfClass includeIt|
+
+ spaceOfClass := cls isPrivate ifTrue:[cls topOwningClass nameSpace] ifFalse:[cls nameSpace].
+ spaceNameOfClass := spaceOfClass name.
+
+ includeIt := spaceNames contains:[:nm | nm = spaceNameOfClass
+ or:[spaceNameOfClass startsWith:(nm , '::')]].
+ includeIt ifFalse:[
+ (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass) ]) ifTrue:[
+ includeIt := true
+ ].
+ ].
+ hideUnloadedClasses ifTrue:[
+ includeIt := includeIt and:[cls isLoaded].
+ ].
+ includeIt ifTrue:[
+ cls isRealNameSpace ifFalse:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+
+ "Created: / 18-02-2000 / 01:01:58 / cg"
+ "Modified: / 05-03-2007 / 23:01:21 / cg"
+! !
+
+!NamespaceList methodsFor:'private'!
+
+defaultSlaveModeValue
+ |mode|
+
+ mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
+ mode == OrganizerCanvas organizerModeNamespace ifTrue:[^ false].
+"/ self organizerMode value == OrganizerCanvas organizerModeCategory ifTrue:[^ true].
+"/ ^ false
+ mode isNil ifTrue:[^ false].
+ ^ true
+!
+
+initialOrganizerMode
+ ^ OrganizerCanvas organizerModeNamespace
+!
+
+listOfNamespaces
+ |allNamespaces showAllNamespaces generator|
+
+ showAllNamespaces := false. "/ only topLevel namespaces are shown
+ showAllNamespaces := true.
+
+ allNamespaces := IdentitySet new.
+
+ inGeneratorHolder isNil ifTrue:[
+ (self hideUnloadedClasses value) ifTrue:[
+ environment allClassesDo:[:eachClass |
+ eachClass isLoaded ifTrue:[
+ allNamespaces add:(eachClass theNonMetaclass topNameSpace)
+ ].
+ ]
+ ] ifFalse:[
+ allNamespaces := NameSpace allNameSpaces.
+ ].
+
+ showAllNamespaces ifFalse:[
+ "/ only topLevel namespaces are shown
+ "/ i.e. ignore subspaces
+
+ allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
+ ].
+ "/JV@2011-12-04: Do not show java packages, they are all shown
+ "/when JAVA namespace is shown. Use #askFor: here, as eXept's libbasic
+ "/does not have #isJavaPackage
+ allNamespaces := allNamespaces reject:[:ns | ns askFor: #isJavaPackage ].
+
+ allNamespaces := allNamespaces collect:[:ns | ns name].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:ns | allNamespaces add:ns].
+ ].
+
+ allNamespaces := allNamespaces asOrderedCollection.
+ allNamespaces sort.
+ allNamespaces size == 1 ifTrue:[
+ self nameSpaceLabelHolder value:(LabelAndIcon icon:(self class nameSpaceIcon) string:allNamespaces first).
+ ].
+
+"/ for now: disabled, because it gets replicated into the nameSpace filter, which
+"/ does not (yet) handle it correctly
+"/ numClassesInChangeSet := ChangeSet current changedClasses size.
+"/ numClassesInChangeSet > 0 ifTrue:[
+"/ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+"/ allNamespaces addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic).
+"/ ].
+
+ allNamespaces addFirst:(self class nameListEntryForALL allItalic).
+ ^ allNamespaces
+
+ "Created: / 18-02-2000 / 01:04:27 / cg"
+ "Modified: / 25-02-2000 / 22:11:29 / cg"
+ "Modified: / 04-12-2011 / 12:30:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+makeDependent
+ environment addDependent:self
+
+ "Created: / 18.2.2000 / 01:04:36 / cg"
+!
+
+makeIndependent
+ environment removeDependent:self.
+
+ "Created: / 18.2.2000 / 01:04:42 / cg"
+!
+
+updateList
+ |newList oldSelection newSelection selectedNamespacesHolder|
+
+ selectedNamespacesHolder := self selectedNamespaces.
+ oldSelection := selectedNamespacesHolder value.
+ newList := self listOfNamespaces.
+ newList ~= namespaceList value ifTrue:[
+"/ oldSelection size > 0 ifTrue:[
+"/ selectedNamespacesHolder removeDependent:self.
+"/ selectedNamespacesHolder value:#().
+"/ selectedNamespacesHolder addDependent:self.
+"/ ].
+ self nameSpaceList value:newList.
+
+ oldSelection size > 0 ifTrue:[
+ newSelection := oldSelection select:[:nm |
+ (nm = self class nameListEntryForALL)
+ or:[ (environment at:nm asSymbol) isNameSpace]
+ ].
+ newSelection ~= oldSelection ifTrue:[
+ selectedNamespacesHolder value:newSelection.
+ ]
+ ]
+ ].
+ listValid := true.
+! !
+
+!NamespaceList class methodsFor:'documentation'!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NamespaceList.st,v 1.21 2013-09-05 10:46:11 vrany Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_NavigatorModel.st Fri Sep 06 15:49:08 2013 +0100
@@ -0,0 +1,445 @@
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+ApplicationModel subclass:#NavigatorModel
+ instanceVariableNames:'environment'
+ classVariableNames:'AllEntry SuperSendEntry UncommentedEntry'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!NavigatorModel class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ A base abstract superclass for all tools browsing the code.
+
+ The `environment` instvar should be used to access the code elements
+ (classes, packages, namespace). The tool should never access Smalltalk
+ directly, but the `environment`. By default, the `environment` is
+ initialized to Smalltalk. The `environment` could be whatever object
+ you like, but it MUST be polymorph with Smalltalk. Also, all classes-like
+ objects it returns MUST be polymorph with Class. Otherwise, expect
+ a lot of DNUs.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+ environment
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+!NavigatorModel class methodsFor:'initialization'!
+
+initialize
+ AllEntry := '* all *'.
+
+ "Created: / 24.2.2000 / 13:41:29 / cg"
+! !
+
+!NavigatorModel class methodsFor:'defaults'!
+
+isPseudoCategory:cat
+ ^ cat = self nameListEntryForChanged
+ or:[ cat = self nameListEntryForUndocumented
+ or:[ cat = self nameListEntryForUnloaded
+ or:[ cat = self nameListEntryForExtendedClasses
+ or:[ cat = self nameListEntryForALL ]]]]
+!
+
+isPseudoProtocol:protocol
+ ^ protocol = self nameListEntryForObsolete
+ or:[ protocol = self nameListEntryForSuperSend
+ or:[ protocol = self nameListEntryForUncommented ]]
+!
+
+markForBeingInChangeList
+ ^ ' *'
+
+ "Created: / 29-08-2006 / 10:26:05 / cg"
+!
+
+markForBeingManagedBySVN: package
+
+ | repo branch mark |
+
+ (ConfigurableFeatures includesFeature: #SubversionSupportEnabled) ifFalse:[^''].
+ package = PackageId noProjectID ifTrue:[^''].
+
+ "/ use Smalltalk-at to trick the dependency/prerequisite generator
+ repo := (Smalltalk at:#SVN::RepositoryManager) current
+ repositoryForPackage: package onlyFromCache: true.
+ repo ifNil:[^''].
+ mark := ' [SVN]'.
+ branch := repo workingCopy branchOrNil.
+ branch ifNotNil:[mark := ' [SVN: ', branch path,']'].
+ ^mark asText colorizeAllWith: Color gray
+
+ "Created: / 06-04-2010 / 11:23:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 07-09-2011 / 10:43:00 / cg"
+ "Modified: / 19-01-2012 / 10:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+markForBeingManagedBySVN: package branch: branch
+
+ | mark |
+ mark := branch
+ ifNil:
+ [' [SVN]']
+ ifNotNil:
+ [' [SVN: ',branch,']'].
+
+ ^mark asText colorizeAllWith: Color gray.
+
+ "Created: / 14-12-2010 / 15:56:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nameListEntryForALL
+ ^ AllEntry ? '* all *'
+
+ "Created: / 24.2.2000 / 13:39:10 / cg"
+ "Modified: / 25.2.2000 / 21:18:30 / cg"
+!
+
+nameListEntryForALLWithCount
+ ^ '* all (%1) *'
+!
+
+nameListEntryForAnnotated
+ ^ '* annotated (%1) *'
+
+ "Created: / 07-09-2011 / 10:11:40 / cg"
+!
+
+nameListEntryForBookmarked
+ ^ '* bookmarked (%1) *'
+!
+
+nameListEntryForChanged
+ ^ '* changed *'
+!
+
+nameListEntryForChangedWithCount
+ ^ '* changed (%1) *'
+!
+
+nameListEntryForDocumentation
+ ^ '* documentation (%1) *'
+!
+
+nameListEntryForExtendedClasses
+ ^ '* extended *'
+!
+
+nameListEntryForExtendedClassesWithCount
+ ^ '* extended (%1) *'
+!
+
+nameListEntryForExtensions
+ ^ '* extensions (%1) *'
+!
+
+nameListEntryForFailedTests
+ ^ '* failed tests (%1) *'
+
+ "Created: / 08-03-2010 / 18:26:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nameListEntryForFullyCovered
+ ^ '* covered (%1) *'
+
+ "Created: / 20-07-2011 / 18:20:53 / cg"
+!
+
+nameListEntryForLong
+ ^ '* long (%1) *'
+!
+
+nameListEntryForMustBeRedefinedInSubclass
+ ^ '* must be redefined (%1) *'
+!
+
+nameListEntryForNILCategory
+ ^ '* no category *'
+!
+
+nameListEntryForNonStatic
+ ^ '* instance *'
+!
+
+nameListEntryForNotInstrumented
+ ^ '* coverage unknown/not instrumented (%1) *'
+
+ "Created: / 20-07-2011 / 18:41:53 / cg"
+!
+
+nameListEntryForObsolete
+ ^ '* obsolete (%1) *'
+!
+
+nameListEntryForOverride
+ ^ '* override (%1) *'
+!
+
+nameListEntryForPartiallyCovered
+ ^ '* partially covered (%1) *'
+
+ "Created: / 20-07-2011 / 18:21:05 / cg"
+!
+
+nameListEntryForPassedTests
+ ^ '* passed tests (%1) *'
+
+ "Created: / 08-03-2010 / 18:26:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nameListEntryForRedefine
+ ^ '* redefine (%1) *'
+!
+
+nameListEntryForRedefined
+ ^ '* redefined (%1) *'
+!
+
+nameListEntryForRequired
+ ^ '* required (%1) *'
+!
+
+nameListEntryForStatic
+ ^ '* static *'
+!
+
+nameListEntryForSuperSend
+ ^ '* super (%1) *'
+!
+
+nameListEntryForUncommented
+ ^ '* uncommented (%1) *'
+!
+
+nameListEntryForUncovered
+ ^ '* not covered (%1) *'
+
+ "Created: / 20-07-2011 / 18:20:44 / cg"
+!
+
+nameListEntryForUndocumented
+ ^ '* undocumented *'
+!
+
+nameListEntryForUndocumentedWithCount
+ ^ '* undocumented (%1) *'
+!
+
+nameListEntryForUnloaded
+ ^ '* unloaded *'
+!
+
+nameListEntryForUnloadedWithCount
+ ^ '* unloaded (%1) *'
+!
+
+nameListEntryForVisited
+ ^ '* visited (%1) *'
+!
+
+pseudoEntryForegroundColor
+ ^ UserPreferences current colorForPseudoProtocolsInMethodListInBrowser.
+
+ "Modified: / 07-09-2011 / 09:59:55 / cg"
+! !
+
+!NavigatorModel class methodsFor:'interface specs'!
+
+metaSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:Tools::NavigatorModel andSelector:#metaSpec
+ Tools::NavigatorModel new openInterface:#metaSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: metaSpec
+ window:
+ (WindowSpec
+ label: 'MetaToggles'
+ name: 'MetaToggles'
+ min: (Point 0 0)
+ max: (Point 1024 721)
+ bounds: (Rectangle 0 0 300 28)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (RadioButtonSpec
+ label: 'Instance'
+ name: 'InstanceToggle'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 0.5 25 0)
+ translateLabel: true
+ tabable: true
+ model: notMetaToggle
+ isTriggerOnDown: true
+ select: true
+ isToggle: true
+ )
+ (RadioButtonSpec
+ label: 'Class'
+ name: 'ClassToggle'
+ layout: (LayoutFrame 0 0.5 0 0 0 1.0 25 0)
+ translateLabel: true
+ labelChannel: metaToggleLabelHolder
+ tabable: false
+ model: metaToggle
+ isTriggerOnDown: true
+ select: true
+ isToggle: true
+ )
+ )
+
+ )
+ )
+! !
+
+!NavigatorModel class methodsFor:'misc'!
+
+classResources
+ ^ NewSystemBrowser classResources
+! !
+
+!NavigatorModel class methodsFor:'queries'!
+
+hasSubversionSupport
+ ^ ConfigurableFeatures includesFeature: #SubversionSupportEnabled
+
+ "Created: / 06-04-2010 / 11:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-09-2011 / 10:45:45 / cg"
+ "Modified: / 19-01-2012 / 10:43:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isAbstract
+ ^ self == Tools::NavigatorModel
+
+ "Created: / 03-09-2013 / 15:36:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NavigatorModel methodsFor:'accessing'!
+
+environment
+ ^ environment
+
+ "Created: / 03-09-2013 / 19:19:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+environment:env
+ environment := env.
+! !
+
+!NavigatorModel methodsFor:'hooks'!
+
+commonPreBuild
+ | topApp |
+
+ super commonPreBuild.
+ topApp := self topApplication.
+ (topApp notNil and:[topApp ~~ self]) ifTrue:[
+ "Fetch the environment from the top application, fallback to previous environment"
+ self environment: (topApp perform:#environment ifNotUnderstood:[environment])
+ ]
+
+ "Created: / 03-09-2013 / 16:25:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 03-09-2013 / 18:31:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NavigatorModel methodsFor:'initialization'!
+
+initialize
+
+ super initialize.
+ environment := Smalltalk.
+
+ "Created: / 03-09-2013 / 15:35:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NavigatorModel methodsFor:'misc'!
+
+resources
+ "answer the resources of my masterApp, if there is one"
+
+ |m|
+
+ (m := self masterApplication) notNil ifTrue:[
+ ^ m resources
+ ].
+ ^ super resources
+! !
+
+!NavigatorModel methodsFor:'queries'!
+
+hasSubversionSupport
+ ^ ConfigurableFeatures includesFeature: #SubversionSupportEnabled
+
+ "Modified: / 07-09-2011 / 10:45:49 / cg"
+ "Modified: / 19-01-2012 / 10:43:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NavigatorModel class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigatorModel.st,v 1.24 2013-09-05 10:46:11 vrany Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigatorModel.st,v 1.24 2013-09-05 10:46:11 vrany Exp $'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
+version_SVN
+ ^ '§Id: Tools__NavigatorModel.st 7802 2011-07-05 18:33:36Z vranyj1 §'
+! !
+
+
+NavigatorModel initialize!
--- a/Tools_OrganizerCanvas.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_OrganizerCanvas.st Fri Sep 06 15:49:08 2013 +0100
@@ -4806,7 +4806,7 @@
categories := self selectedCategories value.
categories notEmptyOrNil ifTrue:[
includesAll := categories includes:BrowserList nameListEntryForALL.
- classes := Smalltalk allClassesForWhich:[:aClass |
+ classes := environment allClassesForWhich:[:aClass |
(includesAll or:[categories includes:aClass category]).
].
].
@@ -4943,7 +4943,7 @@
categories := self selectedCategories value.
categories notEmptyOrNil ifTrue:[
categories do:[:eachCategory |
- classes addAll:(Smalltalk allClassesInCategory:eachCategory)
+ classes addAll:(environment allClassesInCategory:eachCategory)
].
].
].
@@ -5044,10 +5044,10 @@
!OrganizerCanvas class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.54 2013-04-26 09:48:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.55 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.54 2013-04-26 09:48:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.55 2013-09-05 10:46:11 vrany Exp $'
! !
--- a/Tools_ProjectList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools_ProjectList.st Fri Sep 06 15:49:08 2013 +0100
@@ -232,7 +232,7 @@
self inSlaveModeOrInvisible
"/ (self slaveMode value == true)
ifTrue:[
- (changedObject == Smalltalk
+ (changedObject == environment
or:[ something == #projectOrganization ]) ifTrue:[
listValid ifFalse:[ ^ self].
listValid := false
@@ -284,7 +284,7 @@
^ self
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #projectOrganization ifTrue:[
self invalidateList.
slaveMode value == true ifFalse:[
@@ -375,7 +375,7 @@
^ self
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
@@ -547,7 +547,7 @@
(selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[
hideUnloadedClasses ifTrue:[
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
cls isLoaded ifTrue:[
cls isRealNameSpace ifFalse:[
whatToDo value:cls
@@ -557,7 +557,7 @@
]
].
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
cls isRealNameSpace ifFalse:[
whatToDo value:cls
]
@@ -574,7 +574,7 @@
showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|doInclude|
(hideUnloadedClasses not or:[cls isLoaded])
@@ -607,7 +607,7 @@
showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|doInclude|
(hideUnloadedClasses not or:[cls isLoaded])
@@ -707,7 +707,7 @@
].
].
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
|cls pkg p classPackage|
eachClass isRealNameSpace ifFalse:[
@@ -807,12 +807,12 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
ChangeSet addDependent:self.
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
ChangeSet removeDependent:self.
!
@@ -823,8 +823,8 @@
"/ workerQueue
"/ nextPut:[
"/ | repo newEntry branch mark|
-"/ "/ use Smalltalk-at to trick the dependency/prerequisite generator
-"/ repo := (Smalltalk at:#SVN::RepositoryManager) current
+"/ "/ use environment-at to trick the dependency/prerequisite generator
+"/ repo := (environment at:#SVN::RepositoryManager) current
"/ repositoryForPackage: package onlyFromCache: false.
"/ repo ifNotNil:[
"/ mark := ' [SVN]'.
@@ -990,7 +990,7 @@
].
AdditionalEmptyProjects add:aProject.
- Smalltalk changed:#projectOrganization "/ not really ... to force update
+ environment changed:#projectOrganization "/ not really ... to force update
"Created: / 17.2.2000 / 23:44:27 / cg"
!
@@ -1003,7 +1003,7 @@
AdditionalEmptyProjects remove:eachProject ifAbsent:nil.
].
].
- Smalltalk changed:#projectOrganization "/ not really ... to force update
+ environment changed:#projectOrganization "/ not really ... to force update
"Created: / 17.2.2000 / 23:45:24 / cg"
! !
@@ -1011,10 +1011,10 @@
!ProjectList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.65 2013-06-05 13:22:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.66 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.65 2013-06-05 13:22:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.66 2013-09-05 10:46:11 vrany Exp $'
! !
--- a/Tools__BrowserList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__BrowserList.st Fri Sep 06 15:49:08 2013 +0100
@@ -185,6 +185,18 @@
!BrowserList methodsFor:'accessing'!
+environment:env
+ | prevenv |
+
+ prevenv := environment.
+ environment := env.
+ environment ~~ prevenv ifTrue:[
+ self enqueueMessage: #updateList for: self arguments: #()
+ ]
+
+ "Created: / 03-09-2013 / 18:32:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
nameFilter:something
nameFilter := something.
! !
@@ -607,7 +619,7 @@
delayedUpdate:something with:aParameter from:changedObject
"/ if any of my subclasses want those, they should look for them.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
(something == #Language or:[something == #LanguageTerritory]) ifTrue:[
^ self
].
@@ -868,7 +880,7 @@
dropClassFiles:files
files do:[:fn |
(Dialog confirm:(resources string:'FileIn %1 ?' with:fn baseName allBold)) ifTrue:[
- Smalltalk fileIn:fn logged:true.
+ environment fileIn:fn logged:true.
]
].
@@ -1878,11 +1890,11 @@
!BrowserList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__BrowserList.st 8086 2013-01-15 12:03:21Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.58 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.57 2013/03/22 11:36:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.58 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__ChangeList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__ChangeList.st Fri Sep 06 15:49:08 2013 +0100
@@ -27,7 +27,7 @@
"{ NameSpace: Tools }"
-Tools::BrowserListWithFilter subclass:#ChangeList
+BrowserListWithFilter subclass:#ChangeList
instanceVariableNames:'listHolder showRemovedHolder showSameHolder showTimestampHolder
allowRemoveHolder allowAcceptHolder scrollToBottom applyAction showConflictsOnlyHolder'
classVariableNames:'LastSelectionConditionString'
@@ -72,7 +72,6 @@
"
! !
-
!ChangeList class methodsFor:'image specs'!
iconEqual
@@ -115,7 +114,6 @@
"Modified: / 31-08-2011 / 10:54:46 / cg"
! !
-
!ChangeList class methodsFor:'interface specs'!
windowSpec
@@ -187,7 +185,6 @@
)
! !
-
!ChangeList class methodsFor:'list specs'!
listColumnSpec
@@ -301,7 +298,6 @@
! !
-
!ChangeList class methodsFor:'menu specs'!
listMenu
@@ -429,7 +425,6 @@
)
! !
-
!ChangeList class methodsFor:'plugIn spec'!
aspectSelectors
@@ -459,7 +454,6 @@
! !
-
!ChangeList methodsFor:'accessing'!
acceptEnabled
@@ -541,7 +535,6 @@
"Created: / 05-12-2009 / 14:28:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'actions'!
selectionDoubleclicked
@@ -557,7 +550,6 @@
"Modified: / 24-01-2012 / 22:01:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'aspects'!
allowAcceptHolder
@@ -749,7 +741,6 @@
].
! !
-
!ChangeList methodsFor:'change & update'!
selectionChanged
@@ -791,7 +782,6 @@
"Modified: / 26-07-2012 / 18:44:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'drag & drop'!
canDrop: aDropContext
@@ -823,7 +813,6 @@
"Modified: / 01-08-2012 / 18:15:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'event processing'!
@@ -848,7 +837,6 @@
"Created: / 08-02-2012 / 14:42:18 / cg"
! !
-
!ChangeList methodsFor:'generators'!
makeGenerator
@@ -867,7 +855,6 @@
"Modified: / 24-10-2009 / 20:00:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'hooks'!
postBuildListView: aView
@@ -878,7 +865,6 @@
"Created: / 29-11-2011 / 14:56:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'initialization'!
initialize
@@ -893,7 +879,6 @@
"Created: / 29-10-2010 / 12:50:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'menu actions'!
listMenuApply
@@ -956,7 +941,7 @@
]
].
- browserClass := Smalltalk browserClass.
+ browserClass := environment browserClass.
methodsOnly
ifTrue:
[methods size = 1
@@ -1073,7 +1058,6 @@
self updateList
! !
-
!ChangeList methodsFor:'private'!
application
@@ -1229,7 +1213,6 @@
"Modified: / 01-08-2012 / 18:10:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList methodsFor:'queries'!
hasChangeSelected
@@ -1238,11 +1221,10 @@
!
hasChangeSelectedAndNotRemoved
+ | selection |
- | selection |
selection := self selectionHolder value ? #().
- ^selection size > 0 and:
- [selection allSatisfy:[:e|e removed not]].
+ ^selection size > 0 and: [selection conform:[:e|e removed not]].
!
hasSingleChangeSelected
@@ -1269,7 +1251,6 @@
"Created: / 03-04-2012 / 11:28:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList::ListEntry class methodsFor:'instance creation'!
change: aChange
@@ -1293,7 +1274,6 @@
"Created: / 25-07-2009 / 23:33:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
-
!ChangeList::ListEntry methodsFor:'accessing'!
application
@@ -1492,7 +1472,6 @@
^ x
! !
-
!ChangeList::ListEntry methodsFor:'displaying'!
displayLabel:aLabel h:lH on:aGC x:newX y:y h:h
@@ -1529,14 +1508,12 @@
"Modified: / 27-07-2012 / 17:13:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-
!ChangeList::ListEntry methodsFor:'private'!
iconSelector
^ application iconSelectorForChange:change
! !
-
!ChangeList::ListEntry methodsFor:'protocol-queries'!
hasChildren
@@ -1546,15 +1523,14 @@
"Modified (format): / 27-07-2012 / 21:25:34 / cg"
! !
-
!ChangeList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeList.st,v 1.24 2013-04-14 19:55:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeList.st,v 1.26 2013-09-05 23:18:30 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeList.st,v 1.24 2013-04-14 19:55:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__ChangeList.st,v 1.26 2013-09-05 23:18:30 cg Exp $'
!
version_HG
@@ -1563,6 +1539,6 @@
!
version_SVN
- ^ '§Id: Tools__ChangeList.st 7486 2009-10-26 22:06:24Z vranyj1 §'
+ ^ '$Id: Tools__ChangeList.st,v 1.26 2013-09-05 23:18:30 cg Exp $'
! !
--- a/Tools__ClassChecker.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__ClassChecker.st Fri Sep 06 15:49:08 2013 +0100
@@ -918,11 +918,11 @@
!ClassChecker class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassChecker.st,v 1.17 2012/11/06 17:49:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassChecker.st,v 1.18 2013-04-02 09:32:24 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_ClassChecker.st,v 1.17 2012/11/06 17:49:11 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassChecker.st,v 1.18 2013-04-02 09:32:24 stefan Exp $'
!
version_HG
--- a/Tools__ClassGeneratorList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__ClassGeneratorList.st Fri Sep 06 15:49:08 2013 +0100
@@ -257,7 +257,7 @@
delayedUpdate:something with:aParameter from:changedObject
|cls sel pkg mthd orgMode|
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
orgMode := organizerMode value.
orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
@@ -346,7 +346,7 @@
hideUnloadedClasses := self hideUnloadedClasses value.
categories := Set new.
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
(hideUnloadedClasses not or:[cls isLoaded])
ifTrue:[
categories add:cls category.
@@ -357,7 +357,7 @@
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategories size > 0 ifTrue:[
"/ remove those that are present ...
- AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
+ AdditionalEmptyCategories := AdditionalEmptyCategories reject:[:cat | (categories includes:cat)].
categories addAll:AdditionalEmptyCategories.
].
categories := categories asOrderedCollection.
@@ -381,7 +381,7 @@
allNamespaces := IdentitySet new.
(self hideUnloadedClasses value) ifTrue:[
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
allNamespaces add:(eachClass theNonMetaclass topNameSpace)
].
@@ -416,16 +416,16 @@
allProjects := IdentitySet new.
(self hideUnloadedClasses value) ifTrue:[
- allProjects := Smalltalk allLoadedProjectIDs.
+ allProjects := environment allLoadedProjectIDs.
] ifFalse:[
- allProjects := Smalltalk allProjectIDs.
+ allProjects := environment allProjectIDs.
].
"/ those are simulated - in ST/X, empty projects do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyProjects size > 0 ifTrue:[
"/ remove those that are present ...
- AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
+ AdditionalEmptyProjects := AdditionalEmptyProjects reject:[:pkg | (allProjects includes:pkg)].
allProjects addAll:AdditionalEmptyProjects.
].
allProjects sort.
@@ -437,12 +437,12 @@
!
makeDependent
- Smalltalk addDependent:self
+ environment addDependent:self
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
!
@@ -515,11 +515,11 @@
!ClassGeneratorList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.12 2012/11/03 11:29:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.14 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.12 2012/11/03 11:29:20 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.14 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__ClassList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__ClassList.st Fri Sep 06 15:49:08 2013 +0100
@@ -513,7 +513,7 @@
^ self.
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #methodInClass ifTrue:[
^ self "no interest"
].
@@ -822,7 +822,7 @@
classListValue := classList value.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #classComment ifTrue:[
^ self.
].
@@ -1211,7 +1211,7 @@
inGeneratorHolder isNil ifTrue:[
"/ for standAlone testing
- generator := Smalltalk allClasses.
+ generator := environment allClasses.
(self hideUnloadedClasses value) ifTrue:[
generator := generator select:[:cls | cls isLoaded]
].
@@ -1340,7 +1340,7 @@
inGeneratorHolder isNil ifTrue:[
"/ for standAlone testing
- generator := Smalltalk allClasses.
+ generator := environment allClasses.
(self hideUnloadedClasses value) ifTrue:[
generator := generator select:[:cls | cls isLoaded]
].
@@ -1437,14 +1437,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
ChangeSet addDependent:self.
"Created: / 5.2.2000 / 13:42:17 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
ChangeSet removeDependent:self.
!
@@ -1681,11 +1681,15 @@
meta := cls isMeta.
"/ Sigh, special care has to be taken for Java classes as
- "/ for them, !!!!!! (Smalltalk at: javaClass name) ~~ javaClass !!!!!!
+ "/ for them, !!!!!! (environment at: javaClass name) ~~ javaClass !!!!!!
cls theNonMetaclass isJavaClass ifTrue:[
- newClass := JavaVM classNamed:(cls theNonMetaclass name) definedBy: cls classLoader.
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == cls theNonMetaclass name and:[each classLoader == cls theNonMetaclass classLoader]]]
+ ifNone:[nil].
] ifFalse:[
- newClass := Smalltalk at:(cls theNonMetaclass name).
+ newClass := environment at:(cls theNonMetaclass name).
].
newClass isNil ifTrue:[
newClass := cls
@@ -1704,11 +1708,15 @@
cls notNil ifTrue:[
meta := cls isMeta.
"/ Sigh, special care has to be taken for Java classes as
- "/ for them, !!!!!! (Smalltalk at: javaClass name) ~~ javaClass !!!!!!
+ "/ for them, !!!!!! (environment at: javaClass name) ~~ javaClass !!!!!!
cls theNonMetaclass isJavaClass ifTrue:[
- newClass := JavaVM classNamed:(cls theNonMetaclass name) definedBy: cls classLoader.
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == cls theNonMetaclass name and:[each classLoader == cls theNonMetaclass classLoader]]]
+ ifNone:[nil].
] ifFalse:[
- newClass := Smalltalk at:(cls theNonMetaclass name).
+ newClass := environment at:(cls theNonMetaclass name).
].
newClass isNil ifTrue:[
newClass := cls
@@ -1789,7 +1797,7 @@
newSelectionIndices := prevSelection
collect:[:item | |cls|
- cls := Smalltalk at:item theNonMetaclass name.
+ cls := environment at:item theNonMetaclass name.
newList identityIndexOf:cls]
thenSelect:[:index | index ~~ 0].
@@ -2093,11 +2101,11 @@
!ClassList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__ClassList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.70 2012/11/07 14:21:22 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.76 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__CodeCompletionMenu.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__CodeCompletionMenu.st Fri Sep 06 15:49:08 2013 +0100
@@ -205,9 +205,10 @@
currentList := self list.
idx := typedString size + 1.
[
- (currentList allSatisfy:[:s|s size >= idx]) and:[
+ (currentList conform:[:s|s size >= idx])
+ and:[
char := currentList anyOne at:idx.
- currentList allSatisfy:[:s|(s at:idx) == char]
+ currentList conform:[:s|(s at:idx) == char]
]
] whileTrue:[
idx := idx + 1.
@@ -302,7 +303,7 @@
!CodeCompletionMenu class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeCompletionMenu.st,v 1.4 2013-01-17 10:39:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeCompletionMenu.st,v 1.5 2013-09-05 23:19:02 cg Exp $'
!
version_HG
@@ -311,6 +312,6 @@
!
version_SVN
- ^ '§Id: Tools__CodeCompletionMenu.st 7690 2011-03-19 02:23:25Z vranyj1 §'
+ ^ '$Id: Tools__CodeCompletionMenu.st,v 1.5 2013-09-05 23:19:02 cg Exp $'
! !
--- a/Tools__CodeViewService.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__CodeViewService.st Fri Sep 06 15:49:08 2013 +0100
@@ -143,10 +143,11 @@
| cls |
- ^self requiredServices allSatisfy:[:clsName|
- cls := Smalltalk at: clsName.
- cls notNil and:[cls allRequiredServicesAvailable and:[cls isAvailable]]
- ].
+ ^self requiredServices
+ allSatisfy:[:clsName|
+ cls := Smalltalk at: clsName.
+ cls notNil and:[cls allRequiredServicesAvailable and:[cls isAvailable]]
+ ].
"Created: / 27-07-2011 / 11:49:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -438,7 +439,7 @@
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeViewService.st,v 1.13 2013-07-22 12:02:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeViewService.st,v 1.14 2013-09-05 23:19:43 cg Exp $'
!
version_HG
@@ -447,6 +448,6 @@
!
version_SVN
- ^ '$Id: Tools__CodeViewService.st,v 1.13 2013-07-22 12:02:16 cg Exp $'
+ ^ '$Id: Tools__CodeViewService.st,v 1.14 2013-09-05 23:19:43 cg Exp $'
! !
--- a/Tools__FullMethodCategoryList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__FullMethodCategoryList.st Fri Sep 06 15:49:08 2013 +0100
@@ -70,7 +70,7 @@
protocols size > 0 ifTrue:[
protocols size == 1 ifTrue:[
theProtocol := protocols first.
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
|cat|
@@ -86,7 +86,7 @@
].
]
] ifFalse:[
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :eachMethod |
|cat|
@@ -123,7 +123,7 @@
!FullMethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__FullMethodCategoryList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_FullMethodCategoryList.st,v 1.6 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__HierarchicalClassCategoryList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__HierarchicalClassCategoryList.st Fri Sep 06 15:49:08 2013 +0100
@@ -402,11 +402,11 @@
!HierarchicalClassCategoryList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__HierarchicalClassCategoryList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassCategoryList.st,v 1.10 2013-04-25 13:10:14 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassCategoryList.st,v 1.9 2011/07/20 12:54:09 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassCategoryList.st,v 1.10 2013-04-25 13:10:14 stefan Exp $'
!
version_HG
--- a/Tools__HierarchicalClassList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__HierarchicalClassList.st Fri Sep 06 15:49:08 2013 +0100
@@ -160,7 +160,7 @@
self updateList.
selectedClassesHolder value ~= prevSelection ifTrue:[
- newSelection := prevSelection collect:[:eachOldClass | Smalltalk classNamed:(eachOldClass name)].
+ newSelection := prevSelection collect:[:eachOldClass | environment classNamed:(eachOldClass name)].
selectedClassesHolder value:newSelection.
]
@@ -175,7 +175,7 @@
prevTop notNil ifTrue:[
wasMeta := prevTop isMeta.
newTop := prevTop theNonMetaclass.
- [newTop notNil and:[(Smalltalk at:newTop name) ~= newTop]] whileTrue:[
+ [newTop notNil and:[(environment at:newTop name) ~= newTop]] whileTrue:[
newTop := newTop superclass.
].
wasMeta ifTrue:[
@@ -221,7 +221,7 @@
|theClasses|
aSuperclass isNil ifTrue:[
- theClasses := Smalltalk allClasses select:[:cls | cls superclass isNil]
+ theClasses := environment allClasses select:[:cls | cls superclass isNil]
] ifFalse:[
theClasses := aSuperclass subclasses.
].
@@ -315,7 +315,7 @@
!HierarchicalClassList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassList.st,v 1.10 2012/10/30 10:09:09 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassList.st,v 1.13 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__HierarchicalPackageFilterList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__HierarchicalPackageFilterList.st Fri Sep 06 15:49:08 2013 +0100
@@ -188,7 +188,7 @@
].
].
-"/ Smalltalk allClassesDo:[:eachClass |
+"/ environment allClassesDo:[:eachClass |
"/ |package|
"/
"/ package := eachClass package asSymbol.
@@ -300,7 +300,7 @@
!HierarchicalPackageFilterList::PackageItem class methodsFor:'documentation'!
version
- ^'$Header: /cvs/stx/stx/libtool/Tools__HierarchicalPackageFilterList.st,v 1.3 2013-04-25 13:11:37 stefan Exp $'
+ ^'$Header: /cvs/stx/stx/libtool/Tools__HierarchicalPackageFilterList.st,v 1.4 2013-09-05 10:46:11 vrany Exp $'
! !
!HierarchicalPackageFilterList::PackageItem class methodsFor:'image specs'!
@@ -460,7 +460,7 @@
!HierarchicalPackageFilterList class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__HierarchicalPackageFilterList.st,v 1.3 2013-04-25 13:11:37 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__HierarchicalPackageFilterList.st,v 1.4 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__HierarchicalProjectList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__HierarchicalProjectList.st Fri Sep 06 15:49:08 2013 +0100
@@ -248,7 +248,7 @@
].
].
-"/ Smalltalk allClassesDo:[:eachClass |
+"/ environment allClassesDo:[:eachClass |
"/ |package|
"/
"/ package := eachClass package asSymbol.
@@ -518,11 +518,11 @@
!HierarchicalProjectList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__HierarchicalProjectList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.13 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.10 2011/07/20 12:54:00 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.13 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__LintService.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__LintService.st Fri Sep 06 15:49:08 2013 +0100
@@ -194,13 +194,12 @@
(app respondsTo: #selectedLintRules) ifTrue:[
self ruleHolderFromApp: app selectedLintRules
] ifFalse:[
- "/self breakPoint:#jv.
+ "/ self breakPoint:#jv.
"/ Transcript showCR:'LintService [info]: app does not provide a lintRuleHolder'
]
].
"Created: / 08-03-2012 / 01:16:38 / cg"
- "Modified: / 22-03-2012 / 13:51:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
registerIn: aCodeView
@@ -215,11 +214,11 @@
!LintService class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__LintService.st,v 1.8 2013-07-22 12:01:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__LintService.st,v 1.9 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__LintService.st,v 1.8 2013-07-22 12:01:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__LintService.st,v 1.9 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__MethodCategoryList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__MethodCategoryList.st Fri Sep 06 15:49:08 2013 +0100
@@ -35,7 +35,7 @@
privateIn:MethodCategoryList
!
-Method variableSubclass:#MissingMethod
+Method subclass:#MissingMethod
instanceVariableNames:'selector'
classVariableNames:''
poolDictionaries:''
@@ -223,6 +223,10 @@
"Modified: / 27-04-2010 / 16:40:39 / cg"
! !
+!MethodCategoryList class methodsFor:'queries'!
+
+ !
+
!MethodCategoryList methodsFor:'aspects'!
browserNameList
@@ -411,11 +415,15 @@
"/ Sign, special care has to be taken for Java classes as
"/ for them, !!!!!! (Smalltalk at: javaClass name) ~~ javaClass !!!!!!
nm := oldClass theNonMetaclass name.
- newClass := oldClass theNonMetaclass isJavaClass
- ifTrue:[
- JavaVM classNamed: nm definedBy: oldClass theNonMetaclass classLoader
- ]
- ifFalse:[Smalltalk at:nm].
+ oldClass theNonMetaclass isJavaClass ifTrue:[
+ "/ Can't use JavaVM>>classNamed:definedBy: for Java classes because environment
+ "/ could not be Java class. Do a full search instead, sigh...
+ newClass := environment allClasses
+ detect:[:each|each isJavaClass and:[each name == oldClass theNonMetaclass name and:[each classLoader == oldClass theNonMetaclass classLoader]]]
+ ifNone:[nil].
+ ] ifFalse:[
+ newClass := Smalltalk at:nm
+ ].
oldClass isMeta ifTrue:[
newClass isNil ifTrue:[
@@ -450,7 +458,7 @@
selectedProtocolsHolder := self selectedProtocols.
rawProtocolListHolder := self rawProtocolList.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
classes notNil ifTrue:[
something == #methodCategory ifTrue:[
cls := aParameter at:1.
@@ -714,9 +722,9 @@
|cls sel mthd oldMethod newMethod|
"/ some can be ignored immediately
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
+ "/ self halt "/ huh - environment changed - so what ?
^ self.
].
@@ -1585,14 +1593,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
"/ ChangeSet addDependent:self.
"Modified: / 10-11-2006 / 17:57:13 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
"/ ChangeSet removeDependent:self.
!
@@ -1689,7 +1697,7 @@
"/ TODO: start a background thread to compute the stuff below,
"/ notify me to update the list, when all the lazy info is avail...
] ifFalse:[
- true "aMethod mclass language isSmalltalk" ifTrue:[
+ true "aMethod mclass language isenvironment" ifTrue:[
methodsPackage := aMethod package.
isVersionMethod := aMethod isVersionMethod.
@@ -1798,7 +1806,7 @@
].
categories add:aProtocol.
aClass changed:#organization. "/ not really ... to force update
- Smalltalk changed:#methodCategoryAdded with:(Array with:aClass with:aProtocol). "/ not really ... to force update
+ environment changed:#methodCategoryAdded with:(Array with:aClass with:aProtocol). "/ not really ... to force update
"Modified (comment): / 01-08-2012 / 17:30:36 / cg"
!
@@ -1841,7 +1849,7 @@
].
aClass changed:#organization. "/ not really ... to force update
- Smalltalk changed:#methodCategoriesRemoved with:(Array with:aClass with:aListOfProtocols). "/ not really ... to force update
+ environment changed:#methodCategoriesRemoved with:(Array with:aClass with:aListOfProtocols). "/ not really ... to force update
"Modified (comment): / 01-08-2012 / 17:29:59 / cg"
!
@@ -1885,7 +1893,7 @@
categories add:newName.
aClass changed:#organization. "/ not really ... to force update
- Smalltalk changed:#methodCategoryRenamed with:(Array with:aClass with:oldName with:newName). "/ not really ... to force update
+ environment changed:#methodCategoryRenamed with:(Array with:aClass with:oldName with:newName). "/ not really ... to force update
"Modified (comment): / 01-08-2012 / 17:30:16 / cg"
! !
@@ -2088,11 +2096,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__MethodCategoryList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.96 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.89 2012/11/07 16:34:06 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.96 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
@@ -2105,5 +2113,5 @@
! !
+MethodCategoryList::CachedMethodInfo initialize!
MethodCategoryList initialize!
-MethodCategoryList::CachedMethodInfo initialize!
--- a/Tools__MethodList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__MethodList.st Fri Sep 06 15:49:08 2013 +0100
@@ -372,7 +372,7 @@
selectionHolder := self selectedMethods.
selection := selectionHolder value.
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
classes notNil ifTrue:[
something == #classDefinition ifTrue:[
cls := aParameter.
@@ -380,7 +380,7 @@
(classes contains:[:aClass | aClass name = clsName]) ifFalse:[
^ self "/ I don't care for that class
].
- classes := classes collect:[:eachClass | (Smalltalk classNamed:eachClass name) ].
+ classes := classes collect:[:eachClass | (environment classNamed:eachClass name) ].
self invalidateList.
"/ self updateList.
^ self.
@@ -790,12 +790,12 @@
mustFlushInheritanceInfo := true.
"/ some can be ignored immediately
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
classes isNil ifTrue:[
^ self.
].
something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
+ "/ self halt "/ huh - environment changed - so what ?
^ self.
].
something == #classComment ifTrue:[
@@ -1272,14 +1272,14 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
"/ ChangeSet addDependent:self.
"Modified: / 10-11-2006 / 17:57:01 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
"/ ChangeSet removeDependent:self.
!
@@ -1864,11 +1864,11 @@
!MethodList class methodsFor:'documentation'!
version
- ^ '$Id: Tools__MethodList.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.92 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.74 2012/11/07 23:04:35 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.92 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__NamespaceList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__NamespaceList.st Fri Sep 06 15:49:08 2013 +0100
@@ -203,7 +203,7 @@
self inSlaveModeOrInvisible
ifTrue:[
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #classComment ifTrue:[^ self].
].
self invalidateList.
@@ -218,7 +218,7 @@
^ self
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #newClass ifTrue:[
listValid == true ifTrue:[
aParameter isNameSpace ifTrue:[
@@ -254,7 +254,7 @@
!
update:something with:aParameter from:changedObject
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
@@ -310,14 +310,14 @@
|className|
className := eachClassToMove nameWithoutPrefix.
- nameSpace == Smalltalk ifTrue:[
- Smalltalk renameClass:eachClassToMove to:className asSymbol.
+ nameSpace == environment ifTrue:[
+ environment renameClass:eachClassToMove to:className asSymbol.
] ifFalse:[
- Smalltalk renameClass:eachClassToMove to:(nameSpace name , '::' , className) asSymbol.
+ environment renameClass:eachClassToMove to:(nameSpace name , '::' , className) asSymbol.
nameSpace changed.
].
].
- Smalltalk changed.
+ environment changed.
].
^ self
].
@@ -358,7 +358,7 @@
(showAllClasses or:[spaceNames includes:(self class nameListEntryForALL)]) ifTrue:[
hideUnloadedClasses ifTrue:[
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
cls isLoaded ifTrue:[
cls isRealNameSpace ifFalse:[
whatToDo value:cls
@@ -368,24 +368,24 @@
]
].
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:whatToDo
+ environment allClassesDo:whatToDo
]
].
(spaceNames size == 1
- and:[spaceNames first = 'Smalltalk']) ifTrue:[
+ and:[spaceNames first = 'environment']) ifTrue:[
"/ somewhat tuned - quick look if classes name includes colons ...
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|includeIt|
includeIt := (cls name includes:$:) not.
includeIt := includeIt
or:[(cls isPrivate not
- and:[(cls nameSpace == Smalltalk)])].
+ and:[(cls nameSpace == environment)])].
includeIt := includeIt
or:[(cls isPrivate
- and:[(cls topOwningClass nameSpace == Smalltalk)])].
+ and:[(cls topOwningClass nameSpace == environment)])].
includeIt := includeIt
and:[hideUnloadedClasses not or:[cls isLoaded]].
@@ -415,7 +415,7 @@
showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses collect:[:cls | cls theNonMetaclass]].
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|spaceOfClass spaceNameOfClass includeIt|
spaceOfClass := cls isPrivate ifTrue:[cls topOwningClass nameSpace] ifFalse:[cls nameSpace].
@@ -470,7 +470,7 @@
inGeneratorHolder isNil ifTrue:[
(self hideUnloadedClasses value) ifTrue:[
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
allNamespaces add:(eachClass theNonMetaclass topNameSpace)
].
@@ -520,13 +520,13 @@
!
makeDependent
- Smalltalk addDependent:self
+ environment addDependent:self
"Created: / 18.2.2000 / 01:04:36 / cg"
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
"Created: / 18.2.2000 / 01:04:42 / cg"
!
@@ -548,7 +548,7 @@
oldSelection size > 0 ifTrue:[
newSelection := oldSelection select:[:nm |
(nm = self class nameListEntryForALL)
- or:[ (Smalltalk at:nm asSymbol) isNameSpace]
+ or:[ (environment at:nm asSymbol) isNameSpace]
].
newSelection ~= oldSelection ifTrue:[
selectedNamespacesHolder value:newSelection.
@@ -561,7 +561,7 @@
!NamespaceList class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_NamespaceList.st,v 1.20 2012/10/20 19:36:38 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NamespaceList.st,v 1.21 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__NavigationState.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__NavigationState.st Fri Sep 06 15:49:08 2013 +0100
@@ -15,29 +15,29 @@
Object subclass:#NavigationState
instanceVariableNames:'browserLabel codeModifiedHolder categoryList classList
- packageFilter nameSpaceFilter hidePrivateClasses canvasType
- notMetaToggle metaToggle metaToggleLabel organizerMode codeAspect
- codeHolder classDocumentationHolder canvas selectorListGenerator
- protocolListGenerator classListPerNameSpaceGenerator
- classListGenerator categoryListGenerator nameSpaceListGenerator
- projectListGenerator classHierarchyTopClass meta selectedMethods
- selectedProtocols selectedClasses selectedCategories
- selectedProjects selectedNamespaces selectedLintRules
- variableFilter filterClassVars sortBy noAllItem autoSearchPattern
- autoSearchIgnoreCase autoSearchAction realModifiedStateHolder
- methodInfo versionDiffApplication selectorListGeneratorArray
- selectedMethodsArray infoLabelHolder packageLabelHolder
- cursorLineLabelHolder cursorColLabelHolder modeLabelHolder
- sortVariablesBy editModeHolder scrollableCodeView specialEditors
- selectedEditorNoteBookTabIndexHolder editorNoteBookListHolder
- editorNoteBookCanvasHolder codeView stringSearchToolView
- noteBookView inheritanceView documentationView languageHolder
- messageSpecHolder messageHolder progressHolder tabContentView
- messagePaneView codePaneAndPluginView
- codePaneAndPluginViewRelativeCorners pluginVisibleHolder
- bookmarkHolder worker packageInfoBackgroundColorHolder
- packageInfoButton showMethodTemplate lastMethodShownInCodeView
- showingParseError'
+ packageFilter nameSpaceFilter hidePrivateClasses canvasType
+ notMetaToggle metaToggle metaToggleLabel organizerMode codeAspect
+ codeHolder classDocumentationHolder canvas selectorListGenerator
+ protocolListGenerator classListPerNameSpaceGenerator
+ classListGenerator categoryListGenerator nameSpaceListGenerator
+ projectListGenerator classHierarchyTopClass meta selectedMethods
+ selectedProtocols selectedClasses selectedCategories
+ selectedProjects selectedNamespaces selectedLintRules
+ variableFilter filterClassVars sortBy noAllItem autoSearchPattern
+ autoSearchIgnoreCase autoSearchAction realModifiedStateHolder
+ methodInfo versionDiffApplication selectorListGeneratorArray
+ selectedMethodsArray infoLabelHolder packageLabelHolder
+ cursorLineLabelHolder cursorColLabelHolder modeLabelHolder
+ sortVariablesBy editModeHolder scrollableCodeView specialEditors
+ selectedEditorNoteBookTabIndexHolder editorNoteBookListHolder
+ editorNoteBookCanvasHolder codeView stringSearchToolView
+ noteBookView inheritanceView documentationView languageHolder
+ messageSpecHolder messageHolder progressHolder tabContentView
+ messagePaneView codePaneAndPluginView
+ codePaneAndPluginViewRelativeCorners pluginVisibleHolder
+ bookmarkHolder worker packageInfoBackgroundColorHolder
+ packageInfoButton showMethodTemplate lastMethodShownInCodeView
+ showingParseError'
classVariableNames:'CodeAspectTranslations'
poolDictionaries:''
category:'Interface-Browsers-New'
@@ -1192,7 +1192,6 @@
"Created: / 24.2.2000 / 23:45:28 / cg"
! !
-
!NavigationState methodsFor:'aspects-kludges'!
metaToggle
@@ -1713,11 +1712,11 @@
!NavigationState class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.47 2012/11/03 14:22:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.50 2013-06-20 23:22:15 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.47 2012/11/03 14:22:14 cg Exp '
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigationState.st,v 1.50 2013-06-20 23:22:15 cg Exp $'
!
version_HG
@@ -1726,7 +1725,7 @@
!
version_SVN
- ^ '$Id: Tools__NavigationState.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Id: Tools_NavigationState.st,v 1.50 2013-06-20 23:22:15 cg Exp $'
! !
--- a/Tools__NavigatorModel.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__NavigatorModel.st Fri Sep 06 15:49:08 2013 +0100
@@ -14,7 +14,7 @@
"{ NameSpace: Tools }"
ApplicationModel subclass:#NavigatorModel
- instanceVariableNames:''
+ instanceVariableNames:'environment'
classVariableNames:'AllEntry SuperSendEntry UncommentedEntry'
poolDictionaries:''
category:'Interface-Browsers-New'
@@ -34,6 +34,31 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ A base abstract superclass for all tools browsing the code.
+
+ The `environment` instvar should be used to access the code elements
+ (classes, packages, namespace). The tool should never access Smalltalk
+ directly, but the `environment`. By default, the `environment` is
+ initialized to Smalltalk. The `environment` could be whatever object
+ you like, but it MUST be polymorph with Smalltalk. Also, all classes-like
+ objects it returns MUST be polymorph with Class. Otherwise, expect
+ a lot of DNUs.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+ environment
+
+ [class variables:]
+
+ [see also:]
+
+"
! !
!NavigatorModel class methodsFor:'initialization'!
@@ -329,6 +354,50 @@
"Created: / 06-04-2010 / 11:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-09-2011 / 10:45:45 / cg"
"Modified: / 19-01-2012 / 10:43:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isAbstract
+ ^ self == Tools::NavigatorModel
+
+ "Created: / 03-09-2013 / 15:36:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NavigatorModel methodsFor:'accessing'!
+
+environment
+ ^ environment
+
+ "Created: / 03-09-2013 / 19:19:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+environment:env
+ environment := env.
+! !
+
+!NavigatorModel methodsFor:'hooks'!
+
+commonPreBuild
+ | topApp |
+
+ super commonPreBuild.
+ topApp := self topApplication.
+ (topApp notNil and:[topApp ~~ self]) ifTrue:[
+ "Fetch the environment from the top application, fallback to previous environment"
+ self environment: (topApp perform:#environment ifNotUnderstood:[environment])
+ ]
+
+ "Created: / 03-09-2013 / 16:25:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 03-09-2013 / 18:31:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!NavigatorModel methodsFor:'initialization'!
+
+initialize
+
+ super initialize.
+ environment := Smalltalk.
+
+ "Created: / 03-09-2013 / 15:35:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!NavigatorModel methodsFor:'misc'!
@@ -356,11 +425,11 @@
!NavigatorModel class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigatorModel.st,v 1.23 2012/11/07 13:57:05 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigatorModel.st,v 1.24 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_NavigatorModel.st,v 1.23 2012/11/07 13:57:05 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_NavigatorModel.st,v 1.24 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
@@ -369,7 +438,7 @@
!
version_SVN
- ^ '$Id: Tools__NavigatorModel.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '§Id: Tools__NavigatorModel.st 7802 2011-07-05 18:33:36Z vranyj1 §'
! !
--- a/Tools__NewSystemBrowser.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__NewSystemBrowser.st Fri Sep 06 15:49:08 2013 +0100
@@ -14,7 +14,7 @@
"{ NameSpace: Tools }"
SystemBrowser subclass:#NewSystemBrowser
- instanceVariableNames:'navigationState bufferNameList selectedBuffer buffers
+ instanceVariableNames:'environment navigationState bufferNameList selectedBuffer buffers
bufferUsageOrder browserCanvas immediateUpdate showClassPackages
lastMethodCategory lastMethodMoveClass browserCanvasType
syntaxColoringProcessRunning syntaxColoringProcess
@@ -18112,6 +18112,7 @@
^ className
"Modified: / 29-08-2013 / 12:24:28 / cg"
+ "Modified: / 04-09-2013 / 17:48:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
enterBoxTitle:title okText:okText label:label
@@ -18136,6 +18137,16 @@
buffers notNil ifTrue:[ buffers do:aBlock ]
!
+environment
+ ^ environment
+
+ "Created: / 03-09-2013 / 19:18:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+environment:env
+ environment := env.
+!
+
isEmbeddedBrowser
"allows the inspector to disable certain menu items (+ buffer)"
@@ -20820,9 +20831,7 @@
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
- classes
- allSatisfy:
- [:cls | self hasGitRepositoryFor: cls theNonMetaclass package]
+ classes conform: [:cls | self hasGitRepositoryFor: cls theNonMetaclass package]
]
]
@@ -20837,9 +20846,7 @@
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
- classes
- allSatisfy:
- [:cls | self hasMercurialRepositoryFor: cls theNonMetaclass package]
+ classes conform:[:cls | self hasMercurialRepositoryFor: cls theNonMetaclass package]
]
]
@@ -20854,9 +20861,7 @@
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
- classes
- allSatisfy:
- [:cls | self hasPerforceRepositoryFor: cls theNonMetaclass package]
+ classes conform: [:cls | self hasPerforceRepositoryFor: cls theNonMetaclass package]
]
]
@@ -20868,9 +20873,7 @@
classes := self selectedClassesValue.
classes size = 0 ifTrue:[^false].
- ^ classes
- allSatisfy:
- [:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
+ ^ classes conform: [:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
"Modified: / 28-02-2012 / 16:55:03 / cg"
!
@@ -20883,9 +20886,7 @@
classes isEmptyOrNil ifTrue:[
false
] ifFalse:[
- classes
- allSatisfy:
- [:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
+ classes conform: [:cls | self hasSubversionRepositoryFor: cls theNonMetaclass package]
]
]
@@ -20958,7 +20959,7 @@
contains:[:nm |
|ns|
- ns := Smalltalk at:nm asSymbol ifAbsent:nil.
+ ns := environment at:nm asSymbol ifAbsent:nil.
ns notNil
and:[ns allClasses size ~~ 0]
]
@@ -22400,7 +22401,7 @@
^ (codeView := self codeView) hasSelection
and:[ (s := codeView selectionAsString) isValidSmalltalkIdentifier
and:[ s isUppercaseFirst
- and:[ (Smalltalk includesKey:s) not
+ and:[ (environment includesKey:s) not
and:[ (selClass := self theSingleSelectedClass) notNil
and:[ (selClass theNonMetaclass classVarNames includes:s) not ]]]]]
@@ -22672,7 +22673,7 @@
selection := self selectionInCodeView.
selection := selection withoutSeparators.
- cls := Smalltalk classNamed:selection.
+ cls := environment classNamed:selection.
^ cls
!
@@ -23482,7 +23483,7 @@
^ self.
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
codeAspect := self codeAspect.
isForAspect := (codeAspect == something)
and:[ something == #classDefinition
@@ -23504,6 +23505,7 @@
mthd := self theSingleSelectedMethod.
(mthd notNil and:[aParameter third == mthd])
ifTrue:[
+self enqueueDelayedMethodTrapChanged:nil.
mthd mclass notNil ifTrue:[
"/ mhmh - Smalltalk tells me that a method has changed,
"/ but my selectedMethod has not yet been updated
@@ -23520,7 +23522,7 @@
].
something == #methodTrap ifTrue:[
- self enqueueDelayedMethodTrapChanged.
+ self enqueueDelayedMethodTrapChanged:aParameter.
^ self
].
@@ -23930,6 +23932,15 @@
"Modified: / 02-07-2011 / 18:33:22 / cg"
! !
+!NewSystemBrowser methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ environment := Smalltalk
+
+ "Created: / 03-09-2013 / 19:13:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!NewSystemBrowser methodsFor:'menu actions-browse'!
browseClassesReferringToAnyPool:poolsArg in:doWhat
@@ -23946,7 +23957,7 @@
poolOrName isSharedPool ifTrue:[
poolOrName
] ifFalse:[
- p := Smalltalk classNamed:poolNameString.
+ p := environment classNamed:poolNameString.
(p notNil and:[p isSharedPool]) ifTrue:[
p
] ifFalse:[
@@ -23959,7 +23970,7 @@
^ self
].
- classes := Smalltalk allClasses
+ classes := environment allClasses
select:[:cls |
cls isMeta not and:[(cls sharedPools includesAny:pools)]
].
@@ -24060,7 +24071,7 @@
s := contents withoutSpaces.
box topView withWaitCursorDo:[
- what := Smalltalk selectorCompletion:s.
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment.
inputField contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self window beep
@@ -24095,6 +24106,8 @@
].
self rememberSearchPattern:sel.
].
+
+ "Modified: / 04-09-2013 / 17:40:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browseMenuAllSubclassesOf
@@ -24114,7 +24127,7 @@
className includesMatchCharacters ifTrue:[
className := self askForClassNameMatching:className.
].
- class := (Smalltalk classNamed:className) theNonMetaclass.
+ class := (environment classNamed:className) theNonMetaclass.
searchBlock := [ class allSubclasses ]
].
@@ -24143,7 +24156,7 @@
|searchBlock|
searchBlock := [
- (Smalltalk allClassesForWhich:[:someClass | someClass wasAutoloaded])
+ (environment allClassesForWhich:[:someClass | someClass wasAutoloaded])
asOrderedCollection
].
@@ -24205,7 +24218,7 @@
^ self
browseMenuClassExtensionsFor:nil
- in:Smalltalk allClasses
+ in:environment allClasses
label:'All Class Extensions'
openAs:openHow
!
@@ -24228,7 +24241,7 @@
allInstVariables := Set new.
allClassVariables := Set new.
allClassInstVariables := Set new.
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
cls isMeta ifFalse:[
allInstVariables addAll:(cls instVarNames).
allClassVariables addAll:(cls classVarNames).
@@ -24274,7 +24287,7 @@
|s what m|
s := contents withoutSpaces.
- what := Smalltalk classnameCompletion:s.
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment .
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
@@ -24297,7 +24310,7 @@
checkFilterBlock := [:v | varNamesToSearch includes:v]
].
- classes := Smalltalk allClasses select:[:cls |
+ classes := environment allClasses select:[:cls |
cls isMeta not
and:[(cls instVarNames contains:checkFilterBlock)
or:[(cls classVarNames contains:checkFilterBlock)
@@ -24323,6 +24336,7 @@
"Created: / 01-03-2000 / 11:12:38 / cg"
"Modified: / 29-08-2013 / 12:23:08 / cg"
+ "Modified: / 04-09-2013 / 17:40:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
browseMenuClassesForWhich: aFilter label: label
@@ -24335,7 +24349,7 @@
classes := OrderedCollection new.
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
(aFilter value: eachClass) ifTrue:[
classes add:eachClass
]
@@ -24442,7 +24456,7 @@
appHistory := ApplicationModel recentlyOpenedApplications.
appHistory
- collect:[:nm | Smalltalk classNamed:nm]
+ collect:[:nm | environment classNamed:nm]
as:OrderedCollection
].
@@ -24493,7 +24507,7 @@
|s what m|
s := contents withoutSpaces.
- what := DoWhatIMeanSupport poolnameCompletion:s inEnvironment:Smalltalk.
+ what := DoWhatIMeanSupport poolnameCompletion:s inEnvironment:environment.
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
@@ -24507,7 +24521,7 @@
poolNameString isEmptyOrNil ifTrue:[
^ self
].
- pool := Smalltalk classNamed:poolNameString.
+ pool := environment classNamed:poolNameString.
pool isNil ifTrue:[
Dialog warn:'No such pool: ', poolNameString.
^ self.
@@ -24524,7 +24538,7 @@
browseMenuClassesWithFilter:aFilterBlock label:aLabelString
|searchBlock|
- searchBlock := [ Smalltalk allClasses select:aFilterBlock ].
+ searchBlock := [ environment allClasses select:aFilterBlock ].
^ self
spawnClassBrowserForSearch:searchBlock
@@ -24570,7 +24584,7 @@
spawnClassExtensionBrowserForSearch:[
|classes|
- classes := Smalltalk allClassesForWhich:[:someClass |
+ classes := environment allClassesForWhich:[:someClass |
|include|
include := false.
@@ -24640,7 +24654,7 @@
].
self withWaitCursorDo:[
- classes := Smalltalk allClasses select:[:cls |
+ classes := environment allClasses select:[:cls |
|s m found|
(cls isLoaded and:[cls isMeta not]) ifTrue:[
@@ -25488,7 +25502,7 @@
self
spawnMethodBrowserForSearch:[
- Smalltalk allMethodsForWhich:[:m | m isWrapped or:[m isMethodWithBreakpoints]].
+ environment allMethodsForWhich:[:m | m isWrapped or:[m isMethodWithBreakpoints]].
]
sortBy:#class in:#newBuffer
label:'BreakPointed Methods'
@@ -25602,10 +25616,10 @@
] ifFalse:[
baseName := sym.
].
- (val := Smalltalk at:sym) isBehavior ifTrue:[
+ (val := environment at:sym) isBehavior ifTrue:[
otherKeysReferringToValue := OrderedCollection new.
- Smalltalk keysAndValuesDo:[:k :v | v == val ifTrue:[
- k ~~ sym ifTrue:[
+ environment keysAndValuesDo:[:k :v | v == val ifTrue:[
+ (k ~~ sym and:[k ~~ #'Parser:PrevClass']) ifTrue:[
otherKeysReferringToValue add:k
]
]
@@ -25664,7 +25678,7 @@
].
].
"/ recollect realClasses from names (in case of class-changes)
- realClasses := classes collect:[:eachClass | Smalltalk at:eachClass name].
+ realClasses := classes collect:[:eachClass | environment at:eachClass name].
self class
findMethodsIn:realClasses
where:matchBlock
@@ -25827,7 +25841,7 @@
"/ methods := OrderedCollection new.
"/ defaultId := PackageId noProjectID.
"/
-"/ Smalltalk allMethodsDo:[:mthd |
+"/ environment allMethodsDo:[:mthd |
"/ mthd package = defaultId ifTrue:[
"/ methods add:mthd.
"/ ].
@@ -25847,7 +25861,7 @@
browseMenuWritesToGlobal
"launch an enterBox for global to search for writers"
- |labelHolder alreadyAsked searchAllLabel|
+ |labelHolder|
labelHolder := 'Methods writing to global ''%1''' asValue.
self
@@ -25905,9 +25919,9 @@
"/ ] ifFalse:[
"/ baseName := sym.
"/ ].
-"/ (val := Smalltalk at:sym) isBehavior ifTrue:[
+"/ (val := environment at:sym) isBehavior ifTrue:[
"/ otherKeysReferringToValue := OrderedCollection new.
-"/ Smalltalk keysAndValuesDo:[:k :v | v == val ifTrue:[
+"/ environment keysAndValuesDo:[:k :v | v == val ifTrue:[
"/ k ~~ sym ifTrue:[
"/ otherKeysReferringToValue add:k
"/ ]
@@ -25921,7 +25935,7 @@
"/ ] ifFalse:[
"/ searchAllLabel := 'Methods referring to the value of ''%1'''.
"/ otherKeysReferringToValue size <= 3 ifTrue:[
-"/ msg := (otherKeysReferringToValue copyButLast:1) asStringWith:', '.
+"/ msg := (otherKeysReferringToValue copyWithoutLast:1) asStringWith:', '.
"/ msg := msg , ' and ' , otherKeysReferringToValue last.
"/ msg := msg , ' also refer to that value. Search those references too ?'.
"/ ] ifFalse:[
@@ -25976,7 +25990,7 @@
access:#write.
"/ recollect realClasses from names (in case of class-changes)
- realClasses := classes collect:[:eachClass | Smalltalk at:eachClass name].
+ realClasses := classes collect:[:eachClass | environment at:eachClass name].
self class
findMethodsIn:realClasses
where:matchBlock
@@ -25999,7 +26013,7 @@
browseMethodsForWhich:checkBlock in:openHow label:aString
|searchBlock|
- searchBlock := [ Smalltalk allMethodsForWhich:checkBlock ].
+ searchBlock := [ environment allMethodsForWhich:checkBlock ].
^ self
spawnMethodBrowserForSearch:searchBlock
@@ -26110,7 +26124,7 @@
|classes|
classes := IdentitySet new.
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
(eachClass isMeta not
and:[eachClass isLoaded
and:[eachClass isNameSpace not
@@ -26740,7 +26754,7 @@
categoryMenuNewCategory
|box newCategory allClassCategories|
- allClassCategories := Smalltalk allClassCategories.
+ allClassCategories := environment allClassCategories.
box := self
enterBoxTitle:'Name of new class category:'
@@ -26943,7 +26957,7 @@
guess := eachCategory string.
].
- allCategories := Smalltalk allClassCategories asArray sort.
+ allCategories := environment allClassCategories asArray sort.
combosList := LastCategoryRenames.
(combosList size > 0 and:[combosList includes:eachCategory]) ifFalse:[
combosList size == 0 ifTrue:[
@@ -27090,7 +27104,7 @@
pattern := pattern string.
matchingCategories := Set new.
- Smalltalk allClassesAndMetaclassesDo:[:eachClass |
+ environment allClassesAndMetaclassesDo:[:eachClass |
|cat|
cat := eachClass category.
@@ -27878,7 +27892,7 @@
answer == true ifTrue:[
self withWaitCursorDo:[
aClass unload.
- Smalltalk changed:#classDefinition with:aClass
+ environment changed:#classDefinition with:aClass
].
^ self
]
@@ -28096,7 +28110,7 @@
].
LastMethodMoveOrCopyTargetClass notNil ifTrue:[
- initial := Smalltalk classNamed:LastMethodMoveOrCopyTargetClass.
+ initial := environment classNamed:LastMethodMoveOrCopyTargetClass.
initial notNil ifTrue:[
(currentClass notNil and:[currentClass theNonMetaclass name = initial name]) ifTrue:[
initial := nil
@@ -28363,7 +28377,7 @@
className := self searchMenuFindClassToAdd.
className isNil ifTrue:[^ self].
- class := Smalltalk at:className asSymbol ifAbsent:nil.
+ class := environment at:className asSymbol ifAbsent:nil.
class isNil ifTrue:[
^ self warn:'No such class'
].
@@ -28553,7 +28567,7 @@
otherClassName isNil ifTrue:[^ self].
(otherClassName startsWith:'---- ') ifTrue:[^ self].
- otherClass := Smalltalk classNamed:otherClassName.
+ otherClass := environment classNamed:otherClassName.
otherClass isNil ifTrue:[
self warn:'no such class: ', otherClassName.
^ self
@@ -28591,7 +28605,7 @@
currentClassName := currentClass name.
newClassName := currentClassName.
-"/ (nameSpace := currentClass nameSpace) == Smalltalk ifTrue:[
+"/ (nameSpace := currentClass nameSpace) == environment ifTrue:[
"/ newClassName := 'CopyOf' , currentClassName.
"/ ] ifFalse:[
"/ newClassName := nameSpace name , '::' , 'CopyOf' , currentClass nameWithoutPrefix.
@@ -28603,13 +28617,13 @@
(newClassName isEmptyOrNil or:[newClassName withoutSeparators = currentClassName]) ifTrue:[
^ self
].
- (Smalltalk classNamed:newClassName) notNil ifTrue:[
+ (environment classNamed:newClassName) notNil ifTrue:[
(self confirm:(resources string:'A class named: ''%1'' already exists.\\Overwrite ?' with:newClassName) withCRs)
ifFalse:[^ self]
].
(owningClass := currentClass owningClass) notNil ifTrue:[
(newClassName startsWith:(owningClass name , '::')) ifTrue:[
- newClassName := newClassName copyFrom:(owningClass name , '::') size + 1.
+ newClassName := newClassName withoutPrefix:(owningClass name , '::').
newOwnerClass := owningClass.
] ifFalse:[
(newClassName includes:$:) ifTrue:[
@@ -28631,7 +28645,7 @@
].
ownerName notNil ifTrue:[
- (Smalltalk classNamed:ownerName) isNil ifTrue:[
+ (environment classNamed:ownerName) isNil ifTrue:[
(Dialog confirm:(resources
stringWithCRs:'No class or nameSpace named: "%1"\\Create as Namespace ?' with:ownerName))
ifFalse:[
@@ -28639,7 +28653,7 @@
].
newOwnerClass := NameSpace fullName:ownerName.
].
- newOwnerClass := Smalltalk at:ownerName asSymbol.
+ newOwnerClass := environment at:ownerName asSymbol.
(newOwnerClass == Smalltalk or:[newOwnerClass isNameSpace]) ifTrue:[
newOwnerClass == Smalltalk ifFalse:[
newClassName := ownerName , '::' , newClassName.
@@ -29391,7 +29405,7 @@
"/ refetch to get the present class (sigh)
theClass := Smalltalk at:(eachClass theNonMetaclass name).
- vars := theClass theMetaclass allInstanceVariableNames asSet.
+ vars := theClass theMetaclass allInstanceVariableNames asNewSet.
vars removeAll:(Class allInstanceVariableNames).
(singletonVarName notNil and:[vars includes:singletonVarName]) ifTrue:[
@@ -29408,7 +29422,7 @@
(theClass theMetaclass allInstanceVariableNames asSet includes:singletonVar) ifFalse:[
theClass theMetaclass addInstVarName:singletonVar.
- theClass := Smalltalk at:(eachClass theNonMetaclass name).
+ theClass := environment at:(eachClass theNonMetaclass name).
].
generator createSingletonPatternInstanceCreationMethodsIn:theClass usingVariable:singletonVar
].
@@ -29556,7 +29570,7 @@
string:'Enter name for new parent class of the selected class(es):').
name isEmpty ifTrue: [^self].
- existingClass := Smalltalk classNamed:name.
+ existingClass := environment classNamed:name.
existingClass notNil ifTrue:[
(Dialog confirm:(resources
string:'A Class named "%1" already exists - make the selected class(es) a subclass of it ?'))
@@ -29780,7 +29794,7 @@
newOwnerName isNil ifTrue:[^ self].
(newOwnerName startsWith:'---- ') ifTrue:[^ self].
- newOwner := Smalltalk classNamed:newOwnerName.
+ newOwner := environment classNamed:newOwnerName.
newOwner isNil ifTrue:[
(currentClass nameSpace notNil and:[currentClass nameSpace ~~ Smalltalk]) ifTrue:[
newOwner := currentClass nameSpace classNamed:newOwnerName
@@ -29795,8 +29809,8 @@
classes do:[:eachClass |
eachClass autoload.
newName := newOwner name , '::' , eachClass nameWithoutPrefix.
- (Smalltalk classNamed:newName) notNil ifTrue:[
- (Smalltalk classNamed:newName) ~~ eachClass ifTrue:[
+ (environment classNamed:newName) notNil ifTrue:[
+ (environment classNamed:newName) ~~ eachClass ifTrue:[
self warn:'A class named ' , newName , ' already exists.'.
^ self
].
@@ -29837,7 +29851,7 @@
nsName isNameSpace ifTrue:[
ns := nsName
] ifFalse:[
- ns := Smalltalk at:nsName.
+ ns := environment at:nsName.
].
].
@@ -29865,7 +29879,7 @@
title:(resources string:'Move to Namespace')
initialText:(LastNameSpaceMove ? '').
nsName isEmptyOrNil ifTrue:[^ self].
- ns := Smalltalk at:nsName asSymbol.
+ ns := environment at:nsName asSymbol.
LastNameSpaceMove := nsName.
self selectedNonMetaclassesDo:[:eachClass |
@@ -29887,7 +29901,7 @@
classMenuMoveToCategory
|allCategories box|
- allCategories := Smalltalk allClassCategories asArray sort.
+ allCategories := environment allClassCategories asArray sort.
box := ListSelectionBox new.
box title:(resources string:'Move class(es) to which category:').
@@ -29902,7 +29916,7 @@
|s what|
s := contents withoutLeadingSeparators.
- what := Smalltalk classCategoryCompletion:s.
+ what := environment classCategoryCompletion:s.
box contents:what first.
(what at:2) size ~~ 1 ifTrue:[
self builder window beep
@@ -29926,7 +29940,7 @@
initialText:(LastNameSpaceMove ? '').
newNameSpace size == 0 ifTrue:[^ self].
- ns := Smalltalk at:newNameSpace asSymbol.
+ ns := environment at:newNameSpace asSymbol.
ns isNil ifTrue:[
(self confirm:(resources string:'No such nameSpace exists.\\Create "%1" ?' with:newNameSpace) withCRs) ifFalse:[
^ self
@@ -30296,7 +30310,7 @@
language := dialog language.
newClassName := dialog classNameHolder value withoutSeparators.
superclassName := dialog superclassNameHolder value withoutSeparators.
- superclass := Smalltalk classNamed:superclassName.
+ superclass := environment classNamed:superclassName.
package := (dialog packageHolder value ? '') withoutSeparators.
namespaceName := (dialog nameSpaceHolder value ? 'Smalltalk') withoutSeparators.
category := (dialog categoryHolder value ? '* as yet unspecified *') withoutSeparators.
@@ -30629,7 +30643,7 @@
"/ extract owner or namespace, to see if this implies a change
newOwnerOrNameSpacePath := OrderedCollection new.
- nsOrOwner := Smalltalk.
+ nsOrOwner := environment.
s := newNameString readStream.
[s atEnd] whileFalse:[
nextWord := s nextAlphaNumericWord.
@@ -30681,7 +30695,7 @@
"/ check if the target already exists - confirm if so.
- (cls := Smalltalk classNamed:newNameString) notNil ifTrue:[
+ (cls := environment classNamed:newNameString) notNil ifTrue:[
(self confirm:(resources string:'Attention: a class named ''%1'' already present (in the ''%2'' category).\\Rename over it ?'
with:newNameString allBold
with:cls category allBold) withCRs)
@@ -30714,7 +30728,7 @@
self busyLabel:('Searching for references to ' , oldSym).
referingMethods := SystemBrowser
- allMethodsIn:(Smalltalk allClasses)
+ allMethodsIn:(environment allClasses)
where:(SystemBrowser searchBlockForReferendsOf:oldSym).
self normalLabel.
referingMethods isEmpty ifTrue:[
@@ -30772,7 +30786,7 @@
answer == #renameAndRewrite ifTrue:[
self performRefactoring:(RenameClassRefactoring renameClassNamed:oldSym to:newNameString).
referingMethods := SystemBrowser
- allMethodsIn:(Smalltalk allClasses)
+ allMethodsIn:(environment allClasses)
where:(SystemBrowser searchBlockForReferendsOf:newNameString).
UserInformation ignoreIn:[
browser := self
@@ -30790,7 +30804,7 @@
(self confirm:(resources string:'Create a new source container for ''%1'' ?' with:newNameString allBold))
ifTrue:[
currentClass setClassFilename:nil.
- SourceCodeManagerUtilities default createSourceContainerForClass:(Smalltalk at:newNameString asSymbol)
+ SourceCodeManagerUtilities default createSourceContainerForClass:(environment at:newNameString asSymbol)
]
].
@@ -31080,7 +31094,7 @@
(selectedNamespaces := self selectedNamespaces value) size > 0 ifTrue:[
selectedNamespaces size == 1 ifTrue:[
selectedNamespaces first ~= BrowserList nameListEntryForALL ifTrue:[
- currentNamespace := Smalltalk at:selectedNamespaces first asSymbol.
+ currentNamespace := environment at:selectedNamespaces first asSymbol.
]
]
]
@@ -31174,7 +31188,7 @@
]
] ifFalse:[
namePrefix := ''.
- existingNames := Smalltalk keys
+ existingNames := environment keys
].
name := nsTemplate , nameProto , i printString.
@@ -31324,7 +31338,7 @@
newMetaclass instanceVariableNames:(aClass class instanceVariableString).
"/ sigh - must refetch in case of changed instVars.
- newClass := Smalltalk at:realNewClassName.
+ newClass := environment at:realNewClassName.
newMetaclass := newClass class.
aClass methodDictionary
@@ -31388,11 +31402,11 @@
movedInstMethods notEmpty ifTrue:[
aClass theNonMetaclass changed:#projectOrganization.
- Smalltalk changed:#projectOrganization with:(Array with:aClass theNonMetaclass with:movedInstMethods).
+ environment changed:#projectOrganization with:(Array with:aClass theNonMetaclass with:movedInstMethods).
].
movedClassMethods notEmpty ifTrue:[
aClass theMetaclass changed:#projectOrganization.
- Smalltalk changed:#projectOrganization with:(Array with:aClass theMetaclass with:movedClassMethods).
+ environment changed:#projectOrganization with:(Array with:aClass theMetaclass with:movedClassMethods).
]
"Modified: / 09-03-2012 / 23:41:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -31719,7 +31733,7 @@
cls := eachClass theNonMetaclass.
cls isPrivate ifFalse:[
- Smalltalk changeCategoryOf:cls to:newCategory.
+ environment changeCategoryOf:cls to:newCategory.
]
].
@@ -31731,6 +31745,8 @@
LastCategoryRenames size > 10 ifTrue:[
LastCategoryRenames removeLast.
].
+
+ "Modified: / 04-09-2013 / 17:45:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
moveClasses:classes toProject:newProject
@@ -31788,11 +31804,11 @@
anyMethodMoved ifTrue:[
theClass changed:#projectOrganization.
theClass theMetaclass changed:#projectOrganization.
- Smalltalk changed:#projectOrganization with:(Array with:theClass with:oldProject).
+ environment changed:#projectOrganization with:(Array with:theClass with:oldProject).
].
].
anyClassMoved ifTrue:[
- Smalltalk changed:#projectOrganization.
+ environment changed:#projectOrganization.
].
self rememberLastProjectMoveTo:newProject
@@ -32360,7 +32376,7 @@
symOutsideNamespace := eachNonMetaClassInQuestion name.
- refsHere := findRefs value:(Smalltalk allClasses) value:symOutsideNamespace value:symOutsideNamespace.
+ refsHere := findRefs value:(environment allClasses) value:symOutsideNamespace value:symOutsideNamespace.
allRefs addAll:refsHere.
(eachNonMetaClassInQuestion nameSpace notNil
@@ -35580,7 +35596,7 @@
selector := currentMethod selector.
"/ how many senders are there ?
- senders := SystemBrowser findSendersOf:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
+ senders := SystemBrowser findSendersOf:selector in:(environment allClasses) ignoreCase:false match:false.
nSenders := senders size.
tree := cls parseTreeFor:selector.
@@ -35636,7 +35652,7 @@
newSelector:newSelector
initializer:initializer.
- (self findSendersOf:selector in:(Smalltalk allClasses) andConfirmRefactoring:refactoring) ifTrue:[
+ (self findSendersOf:selector in:(environment allClasses) andConfirmRefactoring:refactoring) ifTrue:[
self performRefactoring:refactoring.
self switchToSelector:newSelector
]
@@ -35681,7 +35697,7 @@
varName := self codeView selectionAsString.
(varName isValidSmalltalkIdentifier
and:[ varName isUppercaseFirst
- and:[ (Smalltalk includesKey:varName) not
+ and:[ (environment includesKey:varName) not
and:[ (cls := self theSingleSelectedClass) notNil
and:[ (cls theNonMetaclass classVarNames includes:varName) not
]]]]) ifFalse:[
@@ -36098,7 +36114,7 @@
rslt isNil ifTrue:[^ self ].
senders := self class findSendersOf:inlinedSelector
- in:Smalltalk allClasses
+ in:environment allClasses
ignoreCase:false
match:false.
@@ -36258,7 +36274,7 @@
immediateUpdate value:false.
"/ must reselect manually here
- newClass := Smalltalk classNamed:(mClass name).
+ newClass := environment classNamed:(mClass name).
newMethod := newClass compiledMethodAt:mSelector.
newClass ~~ self theSingleSelectedClass ifTrue:[
self selectClass:newClass.
@@ -37014,7 +37030,7 @@
!
findSendersOf:selector andConfirmRefactoring:refactoring
- ^ self findSendersOf:selector in:(Smalltalk allClasses) andConfirmRefactoring:refactoring
+ ^ self findSendersOf:selector in:(environment allClasses) andConfirmRefactoring:refactoring
"Modified: / 28-02-2007 / 21:20:23 / cg"
!
@@ -37381,7 +37397,7 @@
]
].
].
- Smalltalk changed:#coverageInfo.
+ environment changed:#coverageInfo.
self showCoverageInformation changed. "/ to force update
!
@@ -37714,7 +37730,7 @@
self withWaitCursorDo:[
InstrumentedMethod cleanAllInfoWithChange:false
].
- Smalltalk changed:#coverageInfo.
+ environment changed:#coverageInfo.
self showCoverageInformation changed. "/ to force update
"Created: / 27-04-2010 / 19:00:32 / cg"
@@ -38346,7 +38362,7 @@
|selectedNameSpaces selectedNameSpaceClasses|
selectedNameSpaces := self selectedNamespaces value.
- selectedNameSpaceClasses := Smalltalk allClasses select:[:eachClass |
+ selectedNameSpaceClasses := environment allClasses select:[:eachClass |
eachClass isPrivate not
and:[selectedNameSpaces includes:eachClass nameSpace name]
] .
@@ -38363,7 +38379,7 @@
(nm isNil or:[(nm := nm withoutSeparators) size == 0]) ifTrue:[
^ self
].
- existing := Smalltalk at:nm asSymbol ifAbsent:nil.
+ existing := environment at:nm asSymbol ifAbsent:nil.
existing notNil ifTrue:[
existing isNameSpace ifTrue:[
self warn:'A NameSpace named ''%1'' alread exists.' with:nm.
@@ -38384,6 +38400,8 @@
^ self
].
self selectedNamespaces value:(Array with:nm)
+
+ "Modified: / 04-09-2013 / 17:45:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nameSpaceMenuRemove
@@ -38393,8 +38411,8 @@
|ns|
nm ~= BrowserList nameListEntryForALL ifTrue:[
- ns := Smalltalk at:nm asSymbol.
- Smalltalk removeClass:ns.
+ ns := environment at:nm asSymbol.
+ environment removeClass:ns.
]
].
!
@@ -39012,7 +39030,7 @@
[:package |
|classesInPackage|
- classesInPackage := Smalltalk allClassesInPackage:package.
+ classesInPackage := environment allClassesInPackage:package.
classesInPackage isEmpty ifTrue:[
defaultProjectType := LastNewProjectType ? ProjectDefinition guiApplicationType
] ifFalse:[
@@ -39736,7 +39754,7 @@
mgr := SourceCodeManagerUtilities sourceCodeManagerFor:definitionClass
].
- classes := Smalltalk allClassesInPackage:eachPackageID.
+ classes := environment allClassesInPackage:eachPackageID.
classes := classes reject:[:cls | cls isPrivate ].
self checkOutClasses:classes askForRevision:false usingManager: mgr.
].
@@ -39760,7 +39778,7 @@
"/ perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
"/ perProjectInfo := Dictionary withAssociations:perProjectInfo.
"/
-"/ classesInImage := Smalltalk allClassesInPackage:eachProject.
+"/ classesInImage := environment allClassesInPackage:eachProject.
"/ filesInImage := (classesInImage collect:[:cls | cls classBaseFilename]) asSet.
"/ "/ any differences ?
"/ classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
@@ -40000,7 +40018,7 @@
classesInProject := IdentitySet new.
needExtensionsContainer := false.
- Smalltalk allClassesDo:[:aClass |
+ environment allClassesDo:[:aClass |
(packageToCheck = aClass package) ifTrue:[
aClass isPrivate ifFalse:[
classesInProject add:aClass .
@@ -40268,7 +40286,7 @@
!
projectMenuFileOutAsWithFormat:aFormatSymbolOrNil
- |currentProject selectedProjects suffix saveName fileName "methodsToFileOut fileNameForExtensions" mgr s classesToFileout|
+ |currentProject selectedProjects suffix saveName fileName mgr s classesToFileout|
selectedProjects := self selectedProjectsValue.
currentProject := self theSingleSelectedProject.
@@ -40277,12 +40295,9 @@
] ifFalse:[
fileName := 'someProjects'
].
- aFormatSymbolOrNil == #cypress ifTrue:[
- suffix := ''.
- ] ifFalse:[
- aFormatSymbolOrNil == #xml ifTrue:[
+ aFormatSymbolOrNil == #xml ifTrue:[
suffix := '.xml'
- ] ifFalse:[
+ ] ifFalse:[
aFormatSymbolOrNil == #sif ifTrue:[
suffix := '.sif'
] ifFalse:[
@@ -40292,7 +40307,6 @@
suffix := '.st'
]
]
- ].
].
fileName := fileName , suffix.
@@ -40301,16 +40315,10 @@
^ self
].
- aFormatSymbolOrNil == #cypress ifTrue:[
- saveName := Dialog
- requestDirectoryName: (resources string:'FileOut %1 in:' with:(currentProject ? 'selected projects'))
- "default: (FileSelectionBox lastFileSelectionDirectory)"
- ] ifFalse:[
saveName := Dialog
requestFileNameForSave:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
default:fileName
fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
- ].
"/ fileBox := FileSelectionBox
"/ title:(resources string:'FileOut %1 as:' with:(currentProject ? 'selected projects'))
@@ -40341,7 +40349,7 @@
self selectedProjectClasses do:[:eachClass |
mgr addClass:eachClass.
].
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
@@ -40369,7 +40377,7 @@
eachClass fileOutOn:s.
].
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
@@ -40388,20 +40396,9 @@
^ self.
].
- aFormatSymbolOrNil == #cypress ifTrue:[
- mgr := (Smalltalk at:#CypressWriter) new.
- self showMessage: (resources string:'Writing Cypress package...')
- while: [ mgr writePackage: currentProject asCypressPackage to: saveName asFilename ]
- inBackground: true.
- ^ self
- ].
-
-
-
self shouldImplement.
"Modified: / 27-10-2010 / 11:34:45 / cg"
- "Modified: / 02-10-2012 / 11:23:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuFileOutBuildSupportFiles
@@ -40517,7 +40514,7 @@
"/ extensions...
methodsToFileOut := OrderedCollection new.
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
@@ -40582,7 +40579,7 @@
perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
perProjectInfo := Dictionary withAssociations:perProjectInfo.
- classesInImage := Smalltalk allClassesInPackage:eachProject.
+ classesInImage := environment allClassesInPackage:eachProject.
autoloadedClassesInImage := classesInImage reject:[:cls | cls isLoaded].
classesInImage := classesInImage select:[:cls | cls isLoaded and:[cls isPrivate not]].
"/ filesInImage := classesInImage collect:[:cls | cls classBaseFilename] as:Set.
@@ -41145,7 +41142,7 @@
appClassName := Dialog
request:(resources stringWithCRs:'Create initial application class?\(Enter name or cancel)').
appClassName notEmptyOrNil ifTrue:[
- (appClass := Smalltalk classNamed:appClassName) notNil ifTrue:[
+ (appClass := environment classNamed:appClassName) notNil ifTrue:[
Dialog warn:(resources stringWithCRs:'Application class already exists\(in "%1")' with:appClass package).
] ifFalse:[
theCode := '
@@ -41165,7 +41162,7 @@
doAcceptClassDefinition:theCode
usingCompiler:Compiler.
].
- appClass := Smalltalk classNamed:appClassName.
+ appClass := environment classNamed:appClassName.
appClass package:package.
self classMenuGenerateApplicationCodeForClasses:{ appClass }.
appClass instAndClassMethodsDo:[:m | m package:package].
@@ -41174,7 +41171,7 @@
appClassName := nil "/ for xxx below
].
defaultStartupClassName := (appClassName ? 'xxx'),'Start'.
- (Smalltalk classNamed:defaultStartupClassName) notNil ifTrue:[
+ (environment classNamed:defaultStartupClassName) notNil ifTrue:[
defaultStartupClassName := nil
].
startupClassName := Dialog
@@ -41182,7 +41179,7 @@
stringWithCRs:'Create startup class (e.g. main)?\(Enter name or cancel)')
initialAnswer:defaultStartupClassName.
startupClassName notEmptyOrNil ifTrue:[
- (startupClass := Smalltalk classNamed:startupClassName) notNil ifTrue:[
+ (startupClass := environment classNamed:startupClassName) notNil ifTrue:[
Dialog warn:(resources stringWithCRs:'Startup class already exists\(in "%1")' with:startupClass package).
] ifFalse:[
theCode := '
@@ -41200,7 +41197,7 @@
] ifFalse:[
self doAcceptClassDefinition:theCode usingCompiler:Compiler.
].
- (startupClass := Smalltalk classNamed:startupClassName) notNil ifTrue:[
+ (startupClass := environment classNamed:startupClassName) notNil ifTrue:[
startupClass package:package.
]
].
@@ -41224,6 +41221,7 @@
].
"Modified: / 23-07-2012 / 13:44:04 / cg"
+ "Modified: / 04-09-2013 / 17:46:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
projectMenuProperties
@@ -41320,7 +41318,7 @@
"/ classes ...
"/ ... and individual methods (extensions)
- Smalltalk allClassesDo:[:aClass |
+ environment allClassesDo:[:aClass |
(aClass package = projectToRemove) ifTrue:[
classesToRemove add:aClass.
] ifFalse:[
@@ -41526,7 +41524,7 @@
detect:[:aName |
|cls|
- cls := Smalltalk at:aName asSymbol.
+ cls := environment at:aName asSymbol.
cls isNil
]
ifNone:nil)
@@ -41541,13 +41539,13 @@
contains:[:aName |
|cls|
- cls := Smalltalk at:aName asSymbol.
+ cls := environment at:aName asSymbol.
cls notNil and:[cls isLoaded not]
])
ifTrue:[
(Dialog confirm:'Autoload missing class(es) ?\\Notice: generated abbrev.stc file is wrong if autoloaded classes are unloaded' withCRs) ifTrue:[
defClass compiled_classNames do:[:aName |
- (Smalltalk at:aName asSymbol) autoload
+ (environment at:aName asSymbol) autoload
].
].
].
@@ -41621,7 +41619,7 @@
detect:[:aName |
|cls|
- cls := Smalltalk at:aName asSymbol.
+ cls := environment at:aName asSymbol.
cls isNil
]
ifNone:nil)
@@ -41636,13 +41634,13 @@
contains:[:aName |
|cls|
- cls := Smalltalk at:aName asSymbol.
+ cls := environment at:aName asSymbol.
cls notNil and:[cls isLoaded not]
])
ifTrue:[
(Dialog confirm:'Autoload missing class(es) ?\\Notice: generated abbrev.stc file is wrong if autoloaded classes are unloaded' withCRs) ifTrue:[
defClass compiled_classNames do:[:aName |
- (Smalltalk at:aName asSymbol) autoload
+ (environment at:aName asSymbol) autoload
].
].
].
@@ -41763,7 +41761,7 @@
"/ containers := containers select:[:each | (each startsWith:'.') not].
classesInProject := IdentitySet new.
- Smalltalk allClassesDo:[:aClass |
+ environment allClassesDo:[:aClass |
(packageToCheck = aClass package) ifTrue:[
aClass isPrivate ifFalse:[
aClass isObsolete ifTrue:[
@@ -41878,7 +41876,7 @@
projectList1 selectedProjects value:packagesToFindMissing.
projectList2 selectedProjects value:#('stx').
- packageHull := [:packageIDs | Smalltalk allProjectIDs select:[:p | packageIDs
+ packageHull := [:packageIDs | environment allProjectIDs select:[:p | packageIDs
contains:[:packageId |
p = packageId
or:[ (p startsWith:packageId,':')
@@ -41927,7 +41925,7 @@
packagesToFindMissing := projectList1 selectedProjects value.
packagesToFindCalled := projectList2 selectedProjects value.
- classesToFindMissing := Smalltalk allClasses select:[:cls |
+ classesToFindMissing := environment allClasses select:[:cls |
|p|
p := cls package.
@@ -41939,7 +41937,7 @@
].
classesToFindMissing := classesToFindMissing asOrderedCollection sort:[:a :b | a name < b name].
- classesToFindCalled := Smalltalk allClasses select:[:cls |
+ classesToFindCalled := environment allClasses select:[:cls |
|p|
p := cls package.
@@ -42074,7 +42072,7 @@
selectedProjects := self selectedProjects value ? #().
(selectedProjects includes:(BrowserList nameListEntryForALL)) ifTrue:[
- allProjects := Smalltalk allClasses collect:[:eachClass | eachClass package] as:Set.
+ allProjects := environment allClasses collect:[:eachClass | eachClass package] as:Set.
selectedProjects := allProjects select:[:each| each notNil].
].
selectedProjects := selectedProjects asOrderedCollection.
@@ -42127,8 +42125,8 @@
|classes title|
- classes := Smalltalk allClasses
- select:[:each | (projects includes:each package) not].
+ classes := environment allClasses
+ reject:[:each | (projects includes:each package) ].
projects size == 1 ifTrue:[
title := 'Extensions for Project ''' , projects first , ''''
@@ -42436,7 +42434,7 @@
newClassName isNil ifTrue:[^ self].
(newClassName startsWith:'---- ') ifTrue:[^ self].
- newClass := Smalltalk classNamed:newClassName.
+ newClass := environment classNamed:newClassName.
newClass isNil ifTrue:[
self warn:'no such class: ', newClassName.
^ self
@@ -42538,7 +42536,7 @@
].
"/ allMethodCategories := Set new.
-"/ Smalltalk allBehaviorsDo:[:eachClass |
+"/ environment allBehaviorsDo:[:eachClass |
"/ allMethodCategories addAll:eachClass categories
"/ ].
"/
@@ -42690,7 +42688,7 @@
someCategories notEmpty ifTrue:[
someCategories add:''.
].
- someCategories addAll:(Smalltalk allMethodCategories select:[:cat | (someCategories includes:cat) not]) asOrderedCollection sort.
+ someCategories addAll:(environment allMethodCategories reject:[:cat | (someCategories includes:cat) ]) asOrderedCollection sort.
newCategory := self
askForMethodCategory:msg
@@ -42807,7 +42805,7 @@
pattern := pattern string.
matchingProtocols := Set new.
- Smalltalk allClassesAndMetaclassesDo:[:eachClass |
+ environment allClassesAndMetaclassesDo:[:eachClass |
eachClass isLoaded ifTrue:[
eachClass categories do:[:cat |
(pattern match:cat) ifTrue:[
@@ -42868,7 +42866,7 @@
all := protocols includes:(BrowserList nameListEntryForALL).
self withWaitCursorDo:[
- Smalltalk allClassesAndMetaclassesDo:[:eachClass |
+ environment allClassesAndMetaclassesDo:[:eachClass |
eachClass categories do:[:cat |
(all or:[protocols includes:cat]) ifTrue:[
whatToDo value:eachClass value:cat.
@@ -43000,7 +42998,7 @@
className includesMatchCharacters ifFalse:[
currentNamespace := self currentNamespace.
- aliases := Smalltalk
+ aliases := environment
keysAndValuesSelect:[:nm :val | (nm sameAs:classNameArg) ]
thenCollect:[:nm :val | val isNil
ifTrue:[ nil ]
@@ -43088,12 +43086,12 @@
].
className includesMatchCharacters ifFalse:[
- class := Smalltalk at:className asSymbol.
+ class := environment at:className asSymbol.
class isBehavior ifTrue:[
classes := IdentitySet with:class
]
] ifTrue:[
- classes := Smalltalk allClasses select:[:each | className match:each name] as:IdentitySet.
+ classes := environment allClasses select:[:each | className match:each name] as:IdentitySet.
].
classes size == 0 ifTrue:[
^ self warn:'No className matches'.
@@ -43351,7 +43349,7 @@
searchPattern := box contents.
searchPattern includesMatchCharacters ifTrue:[
matchingSelectors := Set new.
- Smalltalk allMethodsWithSelectorDo:[:eachMethod :eachSelector |
+ environment allMethodsWithSelectorDo:[:eachMethod :eachSelector |
(searchPattern match:eachSelector) ifTrue:[
matchingSelectors add:eachSelector.
].
@@ -43372,7 +43370,7 @@
s includesMatchCharacters ifTrue:[
matchBlock value
] ifFalse:[
- what := Smalltalk selectorCompletion:s.
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment.
longest := what first.
matching := what last.
box list:matching.
@@ -43435,6 +43433,8 @@
].
box showAtPointer.
] valueWithRestart
+
+ "Modified: / 04-09-2013 / 17:41:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
searchMenuFindResponseTo
@@ -43496,7 +43496,7 @@
].
LastMethodMoveOrCopyTargetClass notNil ifTrue:[
- initial := Smalltalk classNamed:LastMethodMoveOrCopyTargetClass.
+ initial := environment classNamed:LastMethodMoveOrCopyTargetClass.
initial notNil ifTrue:[
(currentClass notNil and:[currentClass theNonMetaclass name = initial name]) ifTrue:[
initial := nil
@@ -44080,7 +44080,7 @@
classesChanged do:[:eachClass |
eachClass changed:#projectOrganization.
- Smalltalk changed:#projectOrganization with:(Array with:eachClass theNonMetaclass with:(methods select:[:m | m mclass == eachClass])).
+ environment changed:#projectOrganization with:(Array with:eachClass theNonMetaclass with:(methods select:[:m | m mclass == eachClass])).
].
"Created: / 17-02-2000 / 23:04:45 / cg"
@@ -44268,6 +44268,7 @@
renameMethod:oldSelector in:aClass
|newSelector tree dialog args newArgs map refactoring rslt
renameSelectedMethodsOnly renameOnly rewriteLocalSendersOnly
+ rewritePackageLocalSendersOnly
affectedClasses classesOfSelectedMethods suggestion|
RBParser isNil ifTrue:[
@@ -44319,6 +44320,7 @@
renameSelectedMethodsOnly := dialog isRenameSelectedMethodsOnly.
renameOnly := dialog isRenameOnly.
rewriteLocalSendersOnly := dialog isRewritingLocalSendersOnly.
+ rewritePackageLocalSendersOnly := dialog isRewritingPackageLocalSendersOnly.
refactoring := RenameMethodRefactoring
renameMethod: oldSelector
@@ -44329,13 +44331,13 @@
renameOnly ifFalse:[
affectedClasses := rewriteLocalSendersOnly
- ifTrue:[ Smalltalk allClasses ]
- ifFalse:[ aClass withAllSubclasses ].
+ ifTrue:[ environment allClasses ]
+ ifFalse:[
+ rewritePackageLocalSendersOnly
+ ifTrue:[ environment allClassesInPackage:aClass package ]
+ ifFalse:[ aClass withAllSubclasses ]].
"/ ask if so many methods should be rewritten; give chance to cancel
- "/ JV: but not if refactorings are confimed anyway in performRefactoring:...
- UserPreferences current confirmRefactorings ifFalse:[
(self findSendersOf:oldSelector in:affectedClasses andConfirmRefactoring:refactoring) ifFalse:[ ^ self ].
- ].
].
renameSelectedMethodsOnly ifTrue:[
@@ -44379,7 +44381,6 @@
].
"Modified: / 28-02-2012 / 16:28:12 / cg"
- "Modified: / 10-05-2012 / 13:06:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectVariableForMoveMethod
@@ -45814,7 +45815,7 @@
"/ majority is defined: more than 2/3 of the other impls are in a particular package:
projectsOfOtherImplementations := affectedMethods
collectAll:[:eachMethod |
- (Smalltalk allImplementorsOf:eachMethod selector)
+ (environment allImplementorsOf:eachMethod selector)
collect:[:cls | (cls compiledMethodAt:eachMethod selector) package]
] as: Bag.
@@ -45926,7 +45927,7 @@
].
"/ add actual categories of selected methods
- (SystemBrowser findImplementorsOfAny:selectors in:(Smalltalk allClasses) ignoreCase:false)
+ (SystemBrowser findImplementorsOfAny:selectors in:(environment allClasses) ignoreCase:false)
do:[:otherMethod |
|cat|
@@ -46345,7 +46346,7 @@
self withSearchCursorDo:[
"/ search through all of the system
- Smalltalk allMethodsDo:[:mthd |
+ environment allMethodsDo:[:mthd |
|sent resources newFound any|
any := false.
@@ -46711,7 +46712,7 @@
searchBlock := [:whichMethod |
| sentMessages |
sentMessages := whichMethod messagesSent.
- self class findImplementorsOfAny:sentMessages in:(Smalltalk allClasses) ignoreCase:false.
+ self class findImplementorsOfAny:sentMessages in:(environment allClasses) ignoreCase:false.
].
generator := Iterator on:[:whatToDo |
@@ -47134,7 +47135,7 @@
spawnMethodImplementorsBrowserFor:aSelectorCollection
match:doMatch
in:openHow
- classes:Smalltalk allClasses
+ classes:environment allClasses
label:'Implementors'
"Modified: / 05-09-2006 / 11:07:20 / cg"
@@ -47170,7 +47171,7 @@
] ifFalse:[
list addAll:(self class
findImplementorsOf:aSelector
- in:Smalltalk allClasses
+ in:environment allClasses
ignoreCase:false
)
].
@@ -47316,7 +47317,7 @@
self
spawnMethodSendersBrowserFor:aSelectorCollection
in:openHow
- classes:Smalltalk allClasses
+ classes:environment allClasses
label:'Senders'
"Modified: / 13-02-2012 / 13:17:20 / cg"
@@ -47416,7 +47417,7 @@
cachedList := nil
] ifFalse:[
l := OrderedCollection new.
- Smalltalk allClasses
+ environment allClasses
do:[:eachClass |
l addAll:(eachClass extensions
select:[:extensionMethod |
@@ -47493,7 +47494,7 @@
selector isNil ifTrue:[
#()
] ifFalse:[
- self class allCallsOn:selector in:(Smalltalk allClasses) ignoreCase:false match:false.
+ self class allCallsOn:selector in:(environment allClasses) ignoreCase:false match:false.
].
].
@@ -47626,7 +47627,7 @@
varType == #poolVarNames ifTrue:[
"/ also check classes which refer to that pool
copyOfClasses := IdentitySet withAll:classes.
- Smalltalk allClassesDo:[:someOtherClass |
+ environment allClassesDo:[:someOtherClass |
(someOtherClass sharedPools includesAny:copyOfClasses) ifTrue:[
classes add:someOtherClass.
]
@@ -48665,7 +48666,7 @@
subInstCount := subInstCount + 1
]
].
- classes := classes collect:[:eachName | Smalltalk classNamed:eachName].
+ classes := classes collect:[:eachName | environment classNamed:eachName].
(instCount == 0 and:[subInstCount == 0]) ifTrue:[
self warn:(resources
@@ -49576,7 +49577,7 @@
item := MenuItem label:itemLabel.
item itemValue:#'switchToFindHistoryEntry:' argument:entry.
m addItem:item.
- (Smalltalk classNamed:(entry className ? '?')) isBehavior ifFalse:[
+ (environment classNamed:(entry className ? '?')) isBehavior ifFalse:[
item enabled:false.
item label:(LabelAndIcon icon:(ToolbarIconLibrary erase16x16Icon2) string:itemLabel)
].
@@ -49618,7 +49619,7 @@
|cls ns|
lit isSymbol ifTrue:[
- (((cls := Smalltalk at:lit) notNil and:[ cls isBehavior ])
+ (((cls := environment at:lit) notNil and:[ cls isBehavior ])
"JV@2011-11-25: Added check if the nameSpace is really a namespace, it may be
a class if m mclass is a privateClass...
---------------------------------------------v"
@@ -49651,8 +49652,8 @@
^ m
"Created: / 26-10-2011 / 18:15:01 / cg"
- "Modified (comment): / 25-11-2011 / 21:57:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-09-2012 / 13:17:27 / cg"
+ "Modified: / 04-09-2013 / 17:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
goBackInGlobalHistoryMenu
@@ -51207,7 +51208,7 @@
classes := OrderedCollection new.
(sel := aSelectorString asSymbolIfInterned) notNil ifTrue:[
- Smalltalk allClassesDo:[:aClass |
+ environment allClassesDo:[:aClass |
(aClass includesSelector:sel) ifTrue:[
classes add:aClass.
].
@@ -51492,7 +51493,7 @@
switchToClassNameMatching:aMatchString
|className class|
- class := Smalltalk classNamed:aMatchString.
+ class := environment classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class
@@ -51514,21 +51515,21 @@
].
aMatchString knownAsSymbol ifTrue:[
- class := Smalltalk classNamed:aMatchString.
+ class := environment classNamed:aMatchString.
class notNil ifTrue:[
self switchToClass:class.
^ self.
].
- classesMatchingCaseless := Smalltalk keys select:[:nm | nm sameAs:aMatchString].
+ classesMatchingCaseless := environment keys select:[:nm | nm sameAs:aMatchString].
"/ matchStringLowercase := aMatchString asLowercase.
-"/ classesWithPrefixCaseless := Smalltalk keys select:[:nm | nm asLowercase startsWith:aMatchString].
-
-"/ impl := Smalltalk allImplementorsOf:aMatchString asSymbol.
+"/ classesWithPrefixCaseless := environment keys select:[:nm | nm asLowercase startsWith:aMatchString].
+
+"/ impl := environment allImplementorsOf:aMatchString asSymbol.
"/ impl notEmptyOrNil ifTrue:[
"/ ].
(aMatchString first isLetter not
or:[ aMatchString first isLowercase]) ifTrue:[
- implementors := SystemBrowser findImplementorsMatching:aMatchString in:(Smalltalk allClasses) ignoreCase:true.
+ implementors := SystemBrowser findImplementorsMatching:aMatchString in:(environment allClasses) ignoreCase:true.
implementors size > 0 ifTrue:[
(classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
answer := Dialog
@@ -51578,7 +51579,7 @@
spawnMethodBrowserForSearch:[
SystemBrowser
findImplementorsOf:aMatchString
- in:Smalltalk allClasses
+ in:environment allClasses
ignoreCase:false.
]
sortBy:#class
@@ -51588,7 +51589,7 @@
].
answer ~~ #searchClass ifTrue:[
answer isSymbol ifTrue:[
- self switchToClass:(Smalltalk classNamed:answer).
+ self switchToClass:(environment classNamed:answer).
] ifFalse:[
self switchToClass:(answer mclass) selector:(answer selector).
].
@@ -51598,17 +51599,6 @@
].
].
- "Look for Java class..."
- (JAVA notNil and:[aMatchString includes: $.]) ifTrue:[
- | javaClass |
-
- javaClass := Java at: aMatchString.
- javaClass notNil ifTrue:[
- self switchToClass: javaClass.
- ^self
- ].
- ].
-
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
self switchToClassNamed:className.
@@ -51616,7 +51606,6 @@
"Modified: / 04-07-2006 / 18:48:25 / fm"
"Modified (comment): / 07-03-2012 / 12:05:07 / cg"
- "Modified: / 20-04-2012 / 19:44:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
switchToClassNamed:aString
@@ -51657,7 +51646,7 @@
entry isNil ifTrue:[^ self].
- cls := Smalltalk at:entry className.
+ cls := environment at:entry className.
cls isNil ifTrue:[
self warn:'Oops - class is gone'.
^ self
@@ -53335,7 +53324,7 @@
searchWhat is a symbol such as #selector, #code etc.
"
- |restart dialog|
+ |dialog|
dialog := SearchDialog new
showMetaFilter:true;
@@ -53351,191 +53340,187 @@
allowBrowser:true
withTextEntry:withTextEntry.
- restart := Signal new.
- restart
- handle:[:ex |
- ex restart
- ]
- do:[
- dialog askThenDo:[
- |classes string ignoreCase openHow match methods isMethod searchAction|
-
- classes := dialog classesToSearch.
- string := dialog selectorToSearch.
- ignoreCase := dialog searchIgnoringCase.
- openHow := dialog openHow.
- match := dialog searchWithMatch.
- methods := dialog methodsToSearch.
- isMethod := dialog matchMethods.
-
- self withSearchCursorDo:[
- |initialList list newBrowser numFound label
- selector entities arguments numArgs answer
- alternativeSelector question altArguments t|
-
- aSelectorOrBlock isArray ifTrue:[
- classes notNil ifTrue:[
- selector := aSelectorOrBlock first.
- entities := classes.
- ] ifFalse:[
- selector := aSelectorOrBlock second.
- entities := methods.
- ].
- numArgs := selector numArgs.
+ [:restart|
+ dialog askThenDo:[
+ |classes string ignoreCase openHow match methods isMethod searchAction|
+
+ classes := dialog classesToSearch.
+ string := dialog selectorToSearch.
+ ignoreCase := dialog searchIgnoringCase.
+ openHow := dialog openHow.
+ match := dialog searchWithMatch.
+ methods := dialog methodsToSearch.
+ isMethod := dialog matchMethods.
+
+ self withSearchCursorDo:[
+ |initialList list newBrowser numFound label
+ selector entities arguments numArgs answer
+ alternativeSelector question altArguments t|
+
+ aSelectorOrBlock isArray ifTrue:[
+ classes notNil ifTrue:[
+ selector := aSelectorOrBlock first.
+ entities := classes.
] ifFalse:[
- entities := classes.
- aSelectorOrBlock isSymbol ifTrue:[
- selector := aSelectorOrBlock.
- ] ifFalse:[
- selector := nil
- ].
- numArgs := aSelectorOrBlock numArgs.
- ].
- (selector notNil
- and:[ (selector numArgs == 1)
- and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
- arguments := Array with:entities
+ selector := aSelectorOrBlock second.
+ entities := methods.
+ ].
+ numArgs := selector numArgs.
+ ] ifFalse:[
+ entities := classes.
+ aSelectorOrBlock isSymbol ifTrue:[
+ selector := aSelectorOrBlock.
] ifFalse:[
- arguments := (Array
- with:string
- with:entities
- with:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase])
- with:match
- ) copyTo:numArgs.
- ].
-
- searchAction :=
- [
- |result moreResults extensionMethods arguments2|
-
- selector notNil ifTrue:[
- result := self class perform:selector withArguments:arguments.
- ] ifFalse:[
- result := aSelectorOrBlock valueWithArguments:arguments
+ selector := nil
+ ].
+ numArgs := aSelectorOrBlock numArgs.
+ ].
+ (selector notNil
+ and:[ (selector numArgs == 1)
+ and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
+ arguments := Array with:entities
+ ] ifFalse:[
+ arguments := (Array
+ with:string
+ with:entities
+ with:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase])
+ with:match
+ ) copyTo:numArgs.
+ ].
+
+ searchAction :=
+ [
+ |result moreResults extensionMethods arguments2|
+
+ selector notNil ifTrue:[
+ result := self class perform:selector withArguments:arguments.
+ ] ifFalse:[
+ result := aSelectorOrBlock valueWithArguments:arguments
+ ].
+ "/ sorry for this special case: when searching in a package,
+ "/ also search extensionMethods
+ dialog searchAreaSelected == #currentPackage ifTrue:[
+ aSelectorOrBlock isArray ifTrue:[
+ "/ findSendersOf:inMethods:ignoreCase:match:
+ extensionMethods := environment allExtensionsForPackage:(dialog currentPackage).
+ arguments2 := arguments copy.
+ arguments2 at:2 put:extensionMethods.
+ moreResults := self class perform:(aSelectorOrBlock at:2) withArguments:arguments2.
+ result := result , moreResults.
+ ]
+ ].
+ dialog metaclassesOnly ifTrue:[
+ result := result select:[:m | m mclass isMeta]
+ ] ifFalse:[
+ dialog classesOnly ifTrue:[
+ result := result reject:[:m | m mclass isMeta]
].
- "/ sorry for this special case: when searching in a package,
- "/ also search extensionMethods
- dialog searchAreaSelected == #currentPackage ifTrue:[
- aSelectorOrBlock isArray ifTrue:[
- "/ findSendersOf:inMethods:ignoreCase:match:
- extensionMethods := Smalltalk allExtensionsForPackage:(dialog currentPackage).
- arguments2 := arguments copy.
- arguments2 at:2 put:extensionMethods.
- moreResults := self class perform:(aSelectorOrBlock at:2) withArguments:arguments2.
- result := result , moreResults.
+ ].
+ result
+ ].
+
+ t := TimeDuration toRun:
+ [
+ false "classes size > 1" ifTrue:[
+ self
+ showMessage:'Searching...'
+ while:[
+ initialList := searchAction value.
]
- ].
- dialog metaclassesOnly ifTrue:[
- result := result select:[:m | m mclass isMeta]
- ] ifFalse:[
- dialog classesOnly ifTrue:[
- result := result select:[:m | m mclass isMeta not]
- ].
- ].
- result
- ].
-
- t := TimeDuration toRun:
- [
- false "classes size > 1" ifTrue:[
- self
- showMessage:'Searching...'
- while:[
- initialList := searchAction value.
+ ] ifFalse:[
+ initialList := searchAction value.
+ ].
+ ].
+
+ label := labelHolderOrBlock value.
+
+ numFound := initialList size.
+ numFound == 0 ifTrue:[
+ question := resources stringWithCRs:label with:((string ? '') allBold colorizeAllWith:Color red darkened).
+ question := question , (resources string:' - none found.').
+
+ ((selector == #findImplementors:in:ignoreCase:match:)
+ and:[ (arguments first numArgs == 0)
+ and:[
+ string := ((arguments at:1),':') asSymbol.
+ altArguments := arguments copy.
+ altArguments at:1 put:string.
+ initialList := self class perform:selector withArguments:altArguments.
+ numFound := initialList size.
+ numFound ~~ 0
+ ]]) ifTrue:[
+ question := question,(resources stringWithCRs:'\\But there are %1 implementations of %2 (with colon).\Browse those ?' with:numFound with:(altArguments first)).
+ answer := Dialog
+ confirmWithCancel:question
+ labels:(resources array:#('Cancel' 'Search Again' 'Yes'))
+ default:2.
+
+ answer isNil ifTrue:[
+ ^ self
+ ].
+ answer ifFalse:[
+ restart value.
+ ].
+ arguments := altArguments.
+
+ ] ifFalse:[
+ answer := Dialog
+ confirm:question
+ yesLabel:(resources string:'Search Again')
+ noLabel:(resources string:'Cancel').
+ answer ifFalse:[
+ ^ self
+ ].
+ restart value.
+ ].
+ ].
+
+ (initialList asSet = self selectedMethodsValue asSet)
+ "/ (numFound == 1 and:[initialList first == self theSingleSelectedMethod])
+ ifTrue:[
+ answer := Dialog
+ confirmWithCancel:((resources stringWithCRs:label with:(string ? 'messages') allBold)
+ , '.\\' withCRs
+ , (resources stringWithCRs:'Only the selected method(s) found.\Browse anyway ?'))
+ labels:(resources array:#('Cancel' 'Search Again' 'Yes' ))
+ values:#(nil #again true)
+ default:2.
+
+ answer == nil ifTrue:[
+ ^ self
+ ].
+ answer == #again ifTrue:[
+ restart value.
+ ]
+ ].
+
+ newBrowser := self
+ spawnMethodBrowserForSearch:[
+ initialList notNil ifTrue:[
+ list := initialList.
+ initialList := nil
+ ] ifFalse:[
+ list := searchAction value
+ ].
+ list
]
- ] ifFalse:[
- initialList := searchAction value.
- ].
- ].
-
- label := labelHolderOrBlock value.
-
- numFound := initialList size.
- numFound == 0 ifTrue:[
- question := resources stringWithCRs:label with:((string ? '') allBold colorizeAllWith:Color red darkened).
- question := question , (resources string:' - none found.').
-
- ((selector == #findImplementors:in:ignoreCase:match:)
- and:[ (arguments first numArgs == 0)
- and:[
- string := ((arguments at:1),':') asSymbol.
- altArguments := arguments copy.
- altArguments at:1 put:string.
- initialList := self class perform:selector withArguments:altArguments.
- numFound := initialList size.
- numFound ~~ 0
- ]]) ifTrue:[
- question := question,(resources stringWithCRs:'\\But there are %1 implementations of %2 (with colon).\Browse those ?' with:numFound with:(altArguments first)).
- answer := Dialog
- confirmWithCancel:question
- labels:(resources array:#('Cancel' 'Search Again' 'Yes'))
- default:2.
-
- answer isNil ifTrue:[
- ^ self
- ].
- answer ifFalse:[
- restart raiseRequest
- ].
- arguments := altArguments.
-
- ] ifFalse:[
- answer := Dialog
- confirm:question
- yesLabel:(resources string:'Search Again')
- noLabel:(resources string:'Cancel').
- answer ifFalse:[
- ^ self
- ].
- restart raiseRequest
- ].
- ].
-
- (initialList asSet = self selectedMethodsValue asSet)
- "/ (numFound == 1 and:[initialList first == self theSingleSelectedMethod])
- ifTrue:[
- answer := Dialog
- confirmWithCancel:((resources stringWithCRs:label with:(string ? 'messages') allBold)
- , '.\\' withCRs
- , (resources stringWithCRs:'Only the selected method(s) found.\Browse anyway ?'))
- labels:(resources array:#('Cancel' 'Search Again' 'Yes' ))
- values:#(nil #again true)
- default:2.
-
- answer == nil ifTrue:[
- ^ self
- ].
- answer == #again ifTrue:[
- restart raiseRequest
- ]
- ].
-
- newBrowser := self
- spawnMethodBrowserForSearch:[
- initialList notNil ifTrue:[
- list := initialList.
- initialList := nil
- ] ifFalse:[
- list := searchAction value
- ].
- list
- ]
- sortBy:#class
- in:openHow
- label:(resources string:label string with:string).
-
- setSearchPatternAction notNil ifTrue:[
- setSearchPatternAction value:newBrowser value:string value:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase]) value:match.
- ].
- t > 5 seconds ifTrue:[
- newBrowser methodListApp autoUpdateOnChange: false.
- ].
- ^ newBrowser.
- ].
- ].
- ].
+ sortBy:#class
+ in:openHow
+ label:(resources string:label string with:string).
+
+ setSearchPatternAction notNil ifTrue:[
+ setSearchPatternAction value:newBrowser value:string value:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase]) value:match.
+ ].
+ t > 5 seconds ifTrue:[
+ newBrowser methodListApp autoUpdateOnChange: false.
+ ].
+ ^ newBrowser.
+ ].
+ ].
+ ] valueWithRestart.
"Modified: / 20-08-2012 / 13:26:06 / cg"
+ "Modified: / 04-09-2013 / 17:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askForMethodAndSpawnSearchTitle:title browserLabel:labelHolderOrBlock searchWith:aSelectorOrBlock searchWhat:searchWhat searchArea:whereDefault
@@ -53604,7 +53589,7 @@
idx := shownCategories findFirst:[:l | l startsWith:best].
idx == 0 ifTrue:[
allMethodCategories isNil ifTrue:[
- allMethodCategories := Smalltalk allMethodCategories asArray sort.
+ allMethodCategories := environment allMethodCategories asArray sort.
].
box list:allMethodCategories.
shownCategories := allMethodCategories.
@@ -53707,7 +53692,7 @@
|offered already allProjects classesProjects selectedClasses selectedMethods|
- allProjects := Smalltalk allProjectIDs.
+ allProjects := environment allProjectIDs.
selectedClasses := self selectedClassesValue.
selectedClasses notNil ifTrue:[
@@ -53805,7 +53790,7 @@
box topView withWaitCursorDo:[
s := contents withoutSpaces.
- what := Smalltalk selectorCompletion:s.
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:environment .
longest := what first.
matching := what last.
box list:matching.
@@ -53850,6 +53835,7 @@
^ selector
"Modified (comment): / 29-08-2013 / 12:16:12 / cg"
+ "Modified: / 04-09-2013 / 17:40:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askIfModified
@@ -54183,7 +54169,7 @@
|class selectedClass ns|
aClassName isNil ifTrue:[^ nil].
- class := Smalltalk classNamed:aClassName.
+ class := environment classNamed:aClassName.
class isNil ifTrue:[
selectedClass := self theSingleSelectedClass.
selectedClass notNil ifTrue:[
@@ -54330,7 +54316,7 @@
listOfNamespaces := self selectedNamespaces value.
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
- (cls := Smalltalk at:nameSym) notNil ifTrue:[
+ (cls := environment at:nameSym) notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
@@ -54344,34 +54330,23 @@
]
].
currentNamespace ~= (BrowserList nameListEntryForALL) ifTrue:[
- (cls := Smalltalk at:nameSym) notNil ifTrue:[
+ (cls := environment at:nameSym) notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
(nm startsWith:'Smalltalk::') ifTrue:[
- cls := Smalltalk classNamed:(nm copyFrom:'Smalltalk::' size + 1).
+ cls := environment classNamed:(nm withoutPrefix:'Smalltalk::').
cls notNil ifTrue:[
meta ifTrue:[^ cls class].
^ cls
]
].
-
- "JV@2012-07-30: Search for Java class as well"
- (JAVA notNil and:[nm includes: $/]) ifTrue:[
- "/Try primordial class loader...
- cls := JavaVM classNamed: aClassName definedBy: nil.
- cls notNil ifTrue:[ ^ cls ].
- "/Try system class loader...
- cls := JavaVM classNamed: aClassName definedBy: JavaVM systemClassLoader.
- cls notNil ifTrue:[ ^ cls ].
- ].
^ nil
- "Created: / 13-02-2000 / 21:15:29 / cg"
- "Modified: / 24-02-2000 / 13:49:44 / cg"
- "Modified: / 30-07-2012 / 16:45:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 13.2.2000 / 21:15:29 / cg"
+ "Modified: / 24.2.2000 / 13:49:44 / cg"
!
findClassNamedInNameSpace:aClassName
@@ -54397,7 +54372,7 @@
sel := self selectionInCodeView.
sel notNil ifTrue:[
- (sel knownAsSymbol and:[Smalltalk includesKey:sel asSymbol]) ifTrue:[
+ (sel knownAsSymbol and:[environment includesKey:sel asSymbol]) ifTrue:[
^ sel
].
@@ -54462,17 +54437,18 @@
|currentNamespace|
currentNamespace := self currentNamespace.
- currentNamespace isNil ifTrue:[
+ (currentNamespace isNil and:[environment == Smalltalk]) ifTrue:[
^ Array with:Smalltalk
].
currentNamespace = (BrowserList nameListEntryForALL) ifTrue:[
- ^ self listOfAllNamespaces
+ ^ environment listOfAllNamespaces
].
^ Array with:currentNamespace
- "Modified: / 24.2.2000 / 13:49:20 / cg"
+ "Modified: / 24-02-2000 / 13:49:20 / cg"
+ "Modified: / 04-09-2013 / 17:44:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newBrowserOrBufferDependingOn:openHowWanted label:labelOrNil forSpec:spec setupWith:aBlock
@@ -54729,7 +54705,7 @@
changedClasses := ChangeSet current changedClasses collect:[:cls | cls theNonMetaclass].
].
- ^ Smalltalk allClassesForWhich:[:aClass |
+ ^ environment allClassesForWhich:[:aClass |
(allCategories
or:[(aCollectionOfCategories includes:aClass category)
or:[includeChangedPseudoCategory and:[changedClasses includes:aClass]]])
@@ -54886,11 +54862,11 @@
selectedProjects := self selectedProjects value.
allIncluded := selectedProjects includes:(BrowserList nameListEntryForALL).
- allIncluded ifTrue:[ ^ Smalltalk allClasses ].
+ allIncluded ifTrue:[ ^ environment allClasses ].
setOfClasses := IdentitySet new.
- Smalltalk allClassesDo:[:aClass |
+ environment allClassesDo:[:aClass |
(selectedProjects includes:aClass package) ifTrue:[
setOfClasses add:aClass .
]
@@ -54918,7 +54894,7 @@
allIncluded := protocols includes:(BrowserList nameListEntryForALL).
navigationState isFullProtocolBrowser ifTrue:[
- targets := Smalltalk allClassesAndMetaclasses
+ targets := environment allClassesAndMetaclasses
] ifFalse:[
targets := self selectedClassesValue
].
@@ -54953,7 +54929,7 @@
protocols := self selectedProtocolsValue.
navigationState isFullProtocolBrowser ifTrue:[
- targets := Smalltalk allClassesAndMetaclasses
+ targets := environment allClassesAndMetaclasses
] ifFalse:[
targets := self selectedClassesValue
].
@@ -55573,7 +55549,7 @@
explanation :=
[ self explanationForCode:code short:short ]
valueWithWatchDog:[explainTookTooLong := true]
- afterMilliseconds:100.
+ afterMilliseconds:200.
] ifFalse:[
explanation := self explanationForCode:code short:short
].
@@ -55584,7 +55560,7 @@
^ self.
].
- explanation notNil ifTrue:[
+ explanation notEmptyOrNil ifTrue:[
short ifTrue:[
self showInfo:explanation
] ifFalse:[
@@ -55789,7 +55765,7 @@
implementors := SystemBrowser
findImplementorsOf:aMethod selector
- in:(Smalltalk allClasses)
+ in:(environment allClasses)
ignoreCase:false.
implementors notEmpty ifTrue:[
@@ -55808,7 +55784,7 @@
false ifTrue:[ "/ too slow
senders := SystemBrowser
findSendersOf:aMethod selector
- in:(Smalltalk allClasses)
+ in:(environment allClasses)
ignoreCase:false.
senders notEmpty ifTrue:[
msg2 := 'Sent from ' , senders size printString, ' methods.'.
@@ -56057,7 +56033,7 @@
env := self theSingleSelectedNamespace ? #Smalltalk.
env = NavigatorModel nameListEntryForALL
ifTrue:[env := #Smalltalk].
- env := Smalltalk at: env.
+ env := environment at: env.
partialName isEmptyOrNil
ifTrue:
[#('' #())]
@@ -56567,9 +56543,9 @@
cls := methodsClass.
(cls notNil and:[cls isObsolete]) ifTrue:[
cls isMeta ifTrue:[
- cls := (Smalltalk at:cls theNonMetaclass name) class
+ cls := (environment at:cls theNonMetaclass name) class
] ifFalse:[
- cls := Smalltalk at:cls name
+ cls := environment at:cls name
].
].
"check after every lengthy operation if modified by user in the meantime..."
@@ -57092,7 +57068,7 @@
super postBuildWith:aBuilder.
- Smalltalk addDependent:self.
+ environment addDependent:self.
self codeInfoVisible value ifTrue:[ self codeInfoVisibilityChanged ].
(self toolBarVisibleHolder value or:[self bookmarkBarVisibleHolder value])
@@ -57433,7 +57409,7 @@
].
].
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
super closeRequest.
"Created: / 11-02-2000 / 13:23:00 / cg"
@@ -58529,7 +58505,7 @@
do:[
("self canUseRefactoringSupport"
language isSmalltalk
- and:[(Smalltalk at:cls theNonMetaclass name)==cls
+ and:[(environment at:cls theNonMetaclass name)==cls
and:[cls programmingLanguage == language
and:[InteractiveAddMethodChange notNil]]]
) ifTrue:[
@@ -58593,10 +58569,7 @@
]
].
- "Must check also for protocol as we may be accepting
- a method in '* required *' pseudo-protocol and in this case,
- method category will change too!!"
- (oldSelector ~= rslt selector or:[oldMethod category ~= rslt category]) ifTrue:[
+ oldSelector ~= rslt selector ifTrue:[
self selectedMethods value:(Array with:rslt).
"/ self switchToSelector:rslt selector
] ifFalse:[
@@ -58630,7 +58603,7 @@
"Created: / 30-12-2009 / 20:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-08-2012 / 09:37:29 / cg"
- "Modified: / 07-08-2013 / 13:00:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-09-2013 / 17:38:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
askForInitialApplicationCodeFor:aClass
@@ -58730,7 +58703,7 @@
^ classes asArray.
].
- cls := Smalltalk at:className asSymbol.
+ cls := environment at:className asSymbol.
cls isNil ifTrue:[
self warn:'No such class - try again'.
^ nil
@@ -58762,7 +58735,7 @@
].
[
- Smalltalk removeDependent:self. "/ avoid update
+ environment removeDependent:self. "/ avoid update
ClassDescription updateHistoryLineQuerySignal answer:true do:[
(ClassDescription updateChangeFileQuerySignal
, ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
@@ -58774,7 +58747,7 @@
codeView modified:false.
navigationState realModifiedState:false.
] ensure:[
- Smalltalk addDependent:self.
+ environment addDependent:self.
].
self codeAspect:aspect.
@@ -59518,7 +59491,7 @@
classes := self selectedClassesValue.
names := classes collect:[:cls | cls name].
self unloadClasses:classes.
- self loadClasses:(names collect:[:nm | Smalltalk classNamed:nm]).
+ self loadClasses:(names collect:[:nm | environment classNamed:nm]).
"/ to force update.
"/ (I guess, this is not needed)
@@ -60739,11 +60712,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1972 2013-09-02 15:16:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1975 2013-09-05 22:48:24 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1972 2013-09-02 15:16:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1975 2013-09-05 22:48:24 cg Exp $'
!
version_HG
@@ -60752,7 +60725,7 @@
!
version_SVN
- ^ '$Id: Tools__NewSystemBrowser.st,v 1.1972 2013-09-02 15:16:51 cg Exp $'
+ ^ '$Id: Tools__NewSystemBrowser.st,v 1.1975 2013-09-05 22:48:24 cg Exp $'
! !
--- a/Tools__OrganizerCanvas.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__OrganizerCanvas.st Fri Sep 06 15:49:08 2013 +0100
@@ -4806,7 +4806,7 @@
categories := self selectedCategories value.
categories notEmptyOrNil ifTrue:[
includesAll := categories includes:BrowserList nameListEntryForALL.
- classes := Smalltalk allClassesForWhich:[:aClass |
+ classes := environment allClassesForWhich:[:aClass |
(includesAll or:[categories includes:aClass category]).
].
].
@@ -4943,7 +4943,7 @@
categories := self selectedCategories value.
categories notEmptyOrNil ifTrue:[
categories do:[:eachCategory |
- classes addAll:(Smalltalk allClassesInCategory:eachCategory)
+ classes addAll:(environment allClassesInCategory:eachCategory)
].
].
].
@@ -5044,11 +5044,11 @@
!OrganizerCanvas class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.50 2012/11/03 11:43:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.55 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.50 2012/11/03 11:43:46 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_OrganizerCanvas.st,v 1.55 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__ProjectList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__ProjectList.st Fri Sep 06 15:49:08 2013 +0100
@@ -232,7 +232,7 @@
self inSlaveModeOrInvisible
"/ (self slaveMode value == true)
ifTrue:[
- (changedObject == Smalltalk
+ (changedObject == environment
or:[ something == #projectOrganization ]) ifTrue:[
listValid ifFalse:[ ^ self].
listValid := false
@@ -284,7 +284,7 @@
^ self
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #projectOrganization ifTrue:[
self invalidateList.
slaveMode value == true ifFalse:[
@@ -375,7 +375,7 @@
^ self
].
- changedObject == Smalltalk ifTrue:[
+ changedObject == environment ifTrue:[
something == #methodDictionary ifTrue:[
^ self
].
@@ -547,7 +547,7 @@
(selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[
hideUnloadedClasses ifTrue:[
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
cls isLoaded ifTrue:[
cls isRealNameSpace ifFalse:[
whatToDo value:cls
@@ -557,7 +557,7 @@
]
].
^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
cls isRealNameSpace ifFalse:[
whatToDo value:cls
]
@@ -574,7 +574,7 @@
showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|doInclude|
(hideUnloadedClasses not or:[cls isLoaded])
@@ -607,7 +607,7 @@
showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
- Smalltalk allClassesDo:[:cls |
+ environment allClassesDo:[:cls |
|doInclude|
(hideUnloadedClasses not or:[cls isLoaded])
@@ -707,7 +707,7 @@
].
].
- Smalltalk allClassesDo:[:eachClass |
+ environment allClassesDo:[:eachClass |
|cls pkg p classPackage|
eachClass isRealNameSpace ifFalse:[
@@ -807,12 +807,12 @@
!
makeDependent
- Smalltalk addDependent:self.
+ environment addDependent:self.
ChangeSet addDependent:self.
!
makeIndependent
- Smalltalk removeDependent:self.
+ environment removeDependent:self.
ChangeSet removeDependent:self.
!
@@ -825,8 +825,8 @@
"/ workerQueue
"/ nextPut:[
"/ | repo newEntry branch mark|
-"/ "/ use Smalltalk-at to trick the dependency/prerequisite generator
-"/ repo := (Smalltalk at:#SVN::RepositoryManager) current
+"/ "/ use environment-at to trick the dependency/prerequisite generator
+"/ repo := (environment at:#SVN::RepositoryManager) current
"/ repositoryForPackage: package onlyFromCache: false.
"/ repo ifNotNil:[
"/ mark := ' [SVN]'.
@@ -992,7 +992,7 @@
].
AdditionalEmptyProjects add:aProject.
- Smalltalk changed:#projectOrganization "/ not really ... to force update
+ environment changed:#projectOrganization "/ not really ... to force update
"Created: / 17.2.2000 / 23:44:27 / cg"
!
@@ -1005,7 +1005,7 @@
AdditionalEmptyProjects remove:eachProject ifAbsent:nil.
].
].
- Smalltalk changed:#projectOrganization "/ not really ... to force update
+ environment changed:#projectOrganization "/ not really ... to force update
"Created: / 17.2.2000 / 23:45:24 / cg"
! !
@@ -1013,11 +1013,11 @@
!ProjectList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.63 2013/03/26 16:29:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.66 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.63 2013/03/26 16:29:25 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.66 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/Tools__SearchDialog.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__SearchDialog.st Fri Sep 06 15:49:08 2013 +0100
@@ -75,6 +75,8 @@
!SearchDialog methodsFor:'accessing'!
+
+
showMetaFilter:something
showMetaFilter := something.
! !
@@ -1391,7 +1393,7 @@
!SearchDialog class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_SearchDialog.st,v 1.73 2012/12/02 10:10:34 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_SearchDialog.st,v 1.76 2013-04-25 13:11:05 stefan Exp $'
!
version_HG
--- a/Tools__Toolbox.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__Toolbox.st Fri Sep 06 15:49:08 2013 +0100
@@ -100,3 +100,13 @@
"Created: / 31-08-2013 / 22:46:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!Toolbox class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__Toolbox.st,v 1.1 2013-09-05 21:33:32 vrany Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__Toolbox.st,v 1.1 2013-09-05 21:33:32 vrany Exp $'
+! !
+
--- a/Tools__VariableList.st Fri Sep 06 12:08:37 2013 +0100
+++ b/Tools__VariableList.st Fri Sep 06 15:49:08 2013 +0100
@@ -250,100 +250,100 @@
self inSlaveModeOrInvisible ifTrue:[self invalidateList. ^ self].
changedObject == slaveMode ifTrue:[
- listValid ~~ true ifTrue:[
- self enqueueDelayedUpdateList
- ].
- "/ self invalidateList.
- ^ self
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ "/ self invalidateList.
+ ^ self
].
changedObject == classHolder ifTrue:[
- self invalidateList.
- ^ self
+ self invalidateList.
+ ^ self
].
changedObject == showClassVars ifTrue:[
- self invalidateList.
- ^ self.
+ self invalidateList.
+ ^ self.
].
changedObject == sortVariablesByName ifTrue:[
- self invalidateList.
- ^ self.
+ self invalidateList.
+ ^ self.
].
- changedObject == Smalltalk ifTrue:[
- (something == #projectOrganization) ifTrue:[^ self].
- (something == #currentChangeSet) ifTrue:[^ self].
- (something == #aboutToAutoloadClass) ifTrue:[^ self].
+ changedObject == environment ifTrue:[
+ (something == #projectOrganization) ifTrue:[^ self].
+ (something == #currentChangeSet) ifTrue:[^ self].
+ (something == #aboutToAutoloadClass) ifTrue:[^ self].
- (something == #classDefinition
- or:[ (something == #newClass)
- or:[ something == #classVariables and:[showClassVars value == true]]])
- ifTrue:[
- changedClass := aParameter.
- selectedClasses := classHolder value.
- selectedClasses notNil ifTrue:[
- selectedClasses isSequenceable ifFalse:[
- selectedClasses := selectedClasses asOrderedCollection
- ].
- selectedClasses keysAndValuesDo:[:idx :cls | |nm|
- cls notNil ifTrue:[
- cls isObsolete ifTrue:[
- cls isMeta ifTrue:[
- nm := cls theNonMetaclass name.
- selectedClasses at:idx put:(Smalltalk at:nm) class.
- ] ifFalse:[
- nm := cls name.
- selectedClasses at:idx put:(Smalltalk at:nm).
- ].
- anyChange := true.
- ] ifFalse:[
- (cls == aParameter
- or:[something == #classVariables
- and:[showClassVars value == true
- and:[cls theNonMetaclass == aParameter theNonMetaclass]]]) ifTrue:[
- anyChange := true.
- ]
- ]
- ]
- ].
- (selectedClasses includes:nil) ifTrue:[
- "/ can happen, if a selected class is removed...
- "/ self halt:'should this happen ?'.
- "/ fix it ...
- selectedClasses := selectedClasses select:[:each | each notNil].
- classHolder value:selectedClasses.
- anyChange := true.
- ].
- anyChange == true ifTrue:[
- self invalidateList.
- ^ self
- ].
- ].
- ^ self
- ].
+ (something == #classDefinition
+ or:[ (something == #newClass)
+ or:[ something == #classVariables and:[showClassVars value == true]]])
+ ifTrue:[
+ changedClass := aParameter.
+ selectedClasses := classHolder value.
+ selectedClasses notNil ifTrue:[
+ selectedClasses isSequenceable ifFalse:[
+ selectedClasses := selectedClasses asOrderedCollection
+ ].
+ selectedClasses keysAndValuesDo:[:idx :cls | |nm|
+ cls notNil ifTrue:[
+ cls isObsolete ifTrue:[
+ cls isMeta ifTrue:[
+ nm := cls theNonMetaclass name.
+ selectedClasses at:idx put:(environment at:nm) class.
+ ] ifFalse:[
+ nm := cls name.
+ selectedClasses at:idx put:(environment at:nm).
+ ].
+ anyChange := true.
+ ] ifFalse:[
+ (cls == aParameter
+ or:[something == #classVariables
+ and:[showClassVars value == true
+ and:[cls theNonMetaclass == aParameter theNonMetaclass]]]) ifTrue:[
+ anyChange := true.
+ ]
+ ]
+ ]
+ ].
+ (selectedClasses includes:nil) ifTrue:[
+ "/ can happen, if a selected class is removed...
+ "/ self halt:'should this happen ?'.
+ "/ fix it ...
+ selectedClasses := selectedClasses select:[:each | each notNil].
+ classHolder value:selectedClasses.
+ anyChange := true.
+ ].
+ anyChange == true ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
+ ].
+ ^ self
+ ].
] ifFalse:[
- changedObject isBehavior ifTrue:[
- anyChange := false.
- selectedClasses := classHolder value.
- selectedClasses notNil ifTrue:[
- selectedClasses keysAndValuesDo:[:idx :cls | |nm|
- cls isObsolete ifTrue:[
- nm := cls name.
- selectedClasses at:idx put:(Smalltalk at:nm).
- anyChange := true.
- ]
- ].
- anyChange == true ifTrue:[
- self invalidateList.
- ^ self
- ].
+ changedObject isBehavior ifTrue:[
+ anyChange := false.
+ selectedClasses := classHolder value.
+ selectedClasses notNil ifTrue:[
+ selectedClasses keysAndValuesDo:[:idx :cls | |nm|
+ cls isObsolete ifTrue:[
+ nm := cls name.
+ selectedClasses at:idx put:(environment at:nm).
+ anyChange := true.
+ ]
+ ].
+ anyChange == true ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
- (selectedClasses includesIdentical:something) ifTrue:[
- self invalidateList.
- ^ self
- ].
- ].
- ^ self
- ].
+ (selectedClasses includesIdentical:something) ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
+ ].
+ ^ self
+ ].
].
super delayedUpdate:something with:aParameter from:changedObject
@@ -357,12 +357,12 @@
!
makeDependent
- Smalltalk addDependent:self
+ environment addDependent:self
!
makeIndependent
- Smalltalk removeDependent:self
+ environment removeDependent:self
!
@@ -376,25 +376,25 @@
update:something with:aParameter from:changedObject
"/ ^ self delayedUpdate:something with:aParameter from:changedObject.
- changedObject == Smalltalk ifTrue:[
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #methodTrap ifTrue:[
- ^ self
- ].
- something == #methodCoverageInfo ifTrue:[
- ^ self
- ].
- something == #methodInClass ifTrue:[
- ^ self
- ].
- something == #methodInClassRemoved ifTrue:[
- ^ self
- ].
- something == #classComment ifTrue:[
- ^ self.
- ].
+ changedObject == environment ifTrue:[
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
+ something == #methodCoverageInfo ifTrue:[
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[
+ ^ self
+ ].
+ something == #methodInClassRemoved ifTrue:[
+ ^ self
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
].
"/ self window sensor isNil ifTrue:[
"/ "/ I am not visible ...
@@ -402,10 +402,10 @@
"/ ^ self
"/ ].
changedObject == selectedVariableEntries ifTrue:[
- self selectedVariables value:
- ((selectedVariableEntries value ? #())
- collect:[:e|e name]).
- ^self.
+ self selectedVariables value:
+ ((selectedVariableEntries value ? #())
+ collect:[:e|e name]).
+ ^self.
].
@@ -864,7 +864,7 @@
!VariableList class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.24 2013-09-02 12:14:09 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__VariableList.st,v 1.25 2013-09-05 10:46:11 vrany Exp $'
!
version_HG
--- a/WorkspaceApplication.st Fri Sep 06 12:08:37 2013 +0100
+++ b/WorkspaceApplication.st Fri Sep 06 15:49:08 2013 +0100
@@ -170,120 +170,120 @@
<resource: #canvas>
- ^
+ ^
#(FullSpec
- name: manageSnipletsDialogSpec
- window:
+ name: manageSnipletsDialogSpec
+ window:
(WindowSpec
- label: 'Manage Sniplets'
- name: 'Manage Sniplets'
- min: (Point 10 10)
- bounds: (Rectangle 0 0 379 590)
- )
- component:
+ label: 'Manage Snippets'
+ name: 'Manage Snippets'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 379 590)
+ )
+ component:
(SpecCollection
- collection: (
- (LabelSpec
- label: 'Sniplet:'
- name: 'Label1'
- layout: (LayoutFrame 0 0 0 0 0 1 30 0)
- translateLabel: true
- adjust: left
- )
- (VariableVerticalPanelSpec
- name: 'VariableVerticalPanel1'
- layout: (LayoutFrame 0 0 30 0 0 1 -80 1)
- component:
- (SpecCollection
- collection: (
- (SequenceViewSpec
- name: 'List1'
- model: selectedSniplet
- hasHorizontalScrollBar: true
- hasVerticalScrollBar: true
- useIndex: true
- sequenceList: listOfSniplets
- )
- (TextEditorSpec
- name: 'TextEditor1'
- model: selectedSnipletsText
- hasHorizontalScrollBar: true
- hasVerticalScrollBar: true
- hasKeyboardFocusInitially: false
- viewClassName: ''
- )
- )
-
- )
- handles: (Any 0.5 1.0)
- )
- (HorizontalPanelViewSpec
- name: 'ButtonPanel'
- layout: (LayoutFrame 0 0 -70 1 0 1 -40 1)
- horizontalLayout: center
- verticalLayout: center
- horizontalSpace: 3
- verticalSpace: 3
- component:
- (SpecCollection
- collection: (
- (ActionButtonSpec
- label: 'Save Changes'
- name: 'Button4'
- translateLabel: true
- model: saveSelectedSniplet
- enableChannel: saveEnabled
- extent: (Point 125 22)
- )
- (ActionButtonSpec
- label: 'Remove'
- name: 'Button2'
- translateLabel: true
- model: removeSelectedSniplet
- enableChannel: removeEnabled
- extent: (Point 125 22)
- )
- (ActionButtonSpec
- label: 'Paste'
- name: 'Button3'
- translateLabel: true
- model: pasteSelectedSniplet
- enableChannel: pasteEnabled
- extent: (Point 125 22)
- )
- )
-
- )
- )
- (DividerSpec
- name: 'Separator1'
- layout: (LayoutFrame 0 0.0 557 0 0 1.0 561 0)
- )
- (HorizontalPanelViewSpec
- name: 'CloseButtonPanel'
- layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
- horizontalLayout: fitSpace
- verticalLayout: center
- horizontalSpace: 3
- verticalSpace: 3
- reverseOrderIfOKAtLeft: true
- component:
- (SpecCollection
- collection: (
- (ActionButtonSpec
- label: 'Close'
- name: 'Button1'
- translateLabel: true
- model: cancel
- extent: (Point 373 22)
- )
- )
-
- )
- )
- )
-
- )
+ collection: (
+ (LabelSpec
+ label: 'Snippet:'
+ name: 'Label1'
+ layout: (LayoutFrame 0 0 0 0 0 1 30 0)
+ translateLabel: true
+ adjust: left
+ )
+ (VariableVerticalPanelSpec
+ name: 'VariableVerticalPanel1'
+ layout: (LayoutFrame 0 0 30 0 0 1 -80 1)
+ component:
+ (SpecCollection
+ collection: (
+ (SequenceViewSpec
+ name: 'List1'
+ model: selectedSniplet
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ useIndex: true
+ sequenceList: listOfSniplets
+ )
+ (TextEditorSpec
+ name: 'TextEditor1'
+ model: selectedSnipletsText
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ hasKeyboardFocusInitially: false
+ viewClassName: ''
+ )
+ )
+
+ )
+ handles: (Any 0.5 1.0)
+ )
+ (HorizontalPanelViewSpec
+ name: 'ButtonPanel'
+ layout: (LayoutFrame 0 0 -70 1 0 1 -40 1)
+ horizontalLayout: center
+ verticalLayout: center
+ horizontalSpace: 3
+ verticalSpace: 3
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Save Changes'
+ name: 'Button4'
+ translateLabel: true
+ model: saveSelectedSniplet
+ enableChannel: saveEnabled
+ extent: (Point 125 22)
+ )
+ (ActionButtonSpec
+ label: 'Remove'
+ name: 'Button2'
+ translateLabel: true
+ model: removeSelectedSniplet
+ enableChannel: removeEnabled
+ extent: (Point 125 22)
+ )
+ (ActionButtonSpec
+ label: 'Paste'
+ name: 'Button3'
+ translateLabel: true
+ model: pasteSelectedSniplet
+ enableChannel: pasteEnabled
+ extent: (Point 125 22)
+ )
+ )
+
+ )
+ )
+ (DividerSpec
+ name: 'Separator1'
+ layout: (LayoutFrame 0 0.0 557 0 0 1.0 561 0)
+ )
+ (HorizontalPanelViewSpec
+ name: 'CloseButtonPanel'
+ layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
+ horizontalLayout: fitSpace
+ verticalLayout: center
+ horizontalSpace: 3
+ verticalSpace: 3
+ reverseOrderIfOKAtLeft: true
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Close'
+ name: 'Button1'
+ translateLabel: true
+ model: cancel
+ extent: (Point 373 22)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
)
!
@@ -703,207 +703,207 @@
<resource: #menu>
- ^
+ ^
#(Menu
- (
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'Cut'
- itemValue: cutSelection
- translateLabel: true
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'Copy'
- itemValue: copySelection
- translateLabel: true
- )
- (MenuItem
- label: 'Paste'
- itemValue: paste
- translateLabel: true
- )
- (MenuItem
- enabled: hasHistory
- label: 'Paste Last'
- itemValue: pasteLastDoIt
- translateLabel: true
- isVisible: thisIsASmalltalkWorkspace
- submenuChannel: pasteRecentDoItMenu
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
+ (
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'Cut'
+ itemValue: cutSelection
+ translateLabel: true
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'Copy'
+ itemValue: copySelection
+ translateLabel: true
+ )
+ (MenuItem
+ label: 'Paste'
+ itemValue: paste
+ translateLabel: true
+ )
+ (MenuItem
+ enabled: hasHistory
+ label: 'Paste Last'
+ itemValue: pasteLastDoIt
+ translateLabel: true
+ isVisible: thisIsASmalltalkWorkspace
+ submenuChannel: pasteRecentDoItMenu
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
enabled: hasSelectionInActiveWorkspace
- label: 'Copy as Sniplet...'
- itemValue: addSelectionToSniplets
- translateLabel: true
- )
- (MenuItem
+ label: 'Copy as Snippet...'
+ itemValue: addSelectionToSniplets
+ translateLabel: true
+ )
+ (MenuItem
enabled: selectedWorkspaceIsTextView
- label: 'Paste Sniplet...'
- itemValue: pasteSniplet
- translateLabel: true
- )
- (MenuItem
+ label: 'Paste Snippet...'
+ itemValue: pasteSniplet
+ translateLabel: true
+ )
+ (MenuItem
enabled: selectedWorkspaceIsTextView
- label: 'Manage Sniplets...'
- itemValue: manageSniplets
- translateLabel: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Select All'
- itemValue: selectAll
- translateLabel: true
- )
- (MenuItem
- label: '-'
- isVisible: thisIsASmalltalkWorkspace
- )
- (MenuItem
+ label: 'Manage Snippets...'
+ itemValue: manageSniplets
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Select All'
+ itemValue: selectAll
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ isVisible: thisIsASmalltalkWorkspace
+ )
+ (MenuItem
enabled: selectedWorkspaceIsTextView
- label: 'Filter Text...'
- itemValue: filterText
- translateLabel: true
- isVisible: thisIsASmalltalkWorkspace
- )
- (MenuItem
+ label: 'Filter Text...'
+ itemValue: filterText
+ translateLabel: true
+ isVisible: thisIsASmalltalkWorkspace
+ )
+ (MenuItem
enabled: selectedWorkspaceIsTextView
- label: 'Process Text...'
- itemValue: processText
- translateLabel: true
- isVisible: thisIsASmalltalkWorkspace
- )
- (MenuItem
+ label: 'Process Text...'
+ itemValue: processText
+ translateLabel: true
+ isVisible: thisIsASmalltalkWorkspace
+ )
+ (MenuItem
label: 'Compare Text Against...'
itemValue: compareTextAgainst
translateLabel: true
)
(MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Services'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Autofetch Selection'
- itemValue: autoFetchSelection:
- translateLabel: true
+ label: '-'
+ )
+ (MenuItem
+ label: 'Services'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Autofetch Selection'
+ itemValue: autoFetchSelection:
+ translateLabel: true
hideMenuOnActivated: false
- indication: autoFetchSelection
- )
- (MenuItem
+ indication: autoFetchSelection
+ )
+ (MenuItem
enabled: autoFetchSelection
label: 'Insert as Line (Append CR)'
- translateLabel: true
+ translateLabel: true
hideMenuOnActivated: false
- indication: autoFetchSelectionLines
- )
- (MenuItem
- label: '-'
- isVisible: thisIsASmalltalkWorkspace
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'Google Spell'
- itemValue: googleSpellingSuggestion
- translateLabel: true
- isVisible: thisIsASmalltalkWorkspace
- )
- (MenuItem
+ indication: autoFetchSelectionLines
+ )
+ (MenuItem
+ label: '-'
+ isVisible: thisIsASmalltalkWorkspace
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'Google Spell'
+ itemValue: googleSpellingSuggestion
+ translateLabel: true
+ isVisible: thisIsASmalltalkWorkspace
+ )
+ (MenuItem
enabled: hasSelectionInActiveWorkspace
- label: 'Translate (babelFish)'
- translateLabel: true
- isVisible: thisIsASmalltalkWorkspace
- submenu:
- (Menu
- (
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'English -> German'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'en_de'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'English -> French'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'en_fr'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'English -> Spanish'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'en_es'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'English -> Portuguese'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'en_pt'
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'German -> English'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'de_en'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'French -> English'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'fr_en'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'Spanish -> English'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'es_en'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'Portuguese -> English'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'pt_en'
- )
- (MenuItem
- enabled: hasSelectionInActiveWorkspace
- label: 'Russian -> English'
- itemValue: babelFishTranslate:
- translateLabel: true
- argument: 'ru_en'
- )
- )
- nil
- nil
- )
- )
- )
- nil
- nil
- )
- )
- )
- nil
- nil
+ label: 'Translate (babelFish)'
+ translateLabel: true
+ isVisible: thisIsASmalltalkWorkspace
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'English -> German'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'en_de'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'English -> French'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'en_fr'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'English -> Spanish'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'en_es'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'English -> Portuguese'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'en_pt'
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'German -> English'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'de_en'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'French -> English'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'fr_en'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'Spanish -> English'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'es_en'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'Portuguese -> English'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'pt_en'
+ )
+ (MenuItem
+ enabled: hasSelectionInActiveWorkspace
+ label: 'Russian -> English'
+ itemValue: babelFishTranslate:
+ translateLabel: true
+ argument: 'ru_en'
+ )
+ )
+ nil
+ nil
+ )
+ )
+ )
+ nil
+ nil
+ )
+ )
+ )
+ nil
+ nil
)
"Modified: / 20-07-2012 / 10:30:57 / cg"
@@ -2643,61 +2643,61 @@
manageSniplets
|bindings listOfSniplets removeAction pasteAction
hasSelectionHolder removeEnabledHolder pasteEnabledHolder
- selectedSnipletHolder selectedSnipletsTextHolder selectedSnipletsName
- snipletsDictionary saveEnabledHolder saveAction |
-
- snipletsDictionary := Workspace sniplets.
- snipletsDictionary isEmptyOrNil ifTrue:[
- Dialog information:(resources string:'No Sniplets to Manage').
- ^ self.
+ selectedSnippetHolder selectedSnippetsTextHolder selectedSnippetsName
+ snippetsDictionary saveEnabledHolder saveAction |
+
+ snippetsDictionary := Workspace sniplets.
+ snippetsDictionary isEmptyOrNil ifTrue:[
+ Dialog information:(resources string:'No Snippets to Manage').
+ ^ self.
].
- listOfSniplets := List withAll:(snipletsDictionary keysSorted).
- selectedSnipletsTextHolder := '' asValue.
-
- selectedSnipletHolder := nil asValue.
- selectedSnipletHolder onChangeEvaluate:[
- (selectedSnipletHolder value) isNil ifTrue:[
- selectedSnipletsName := nil.
- selectedSnipletsTextHolder value:''.
- ] ifFalse:[
- selectedSnipletsName := listOfSniplets at:(selectedSnipletHolder value).
- selectedSnipletsTextHolder value:(snipletsDictionary at:selectedSnipletsName).
- ].
+ listOfSniplets := List withAll:(snippetsDictionary keysSorted).
+ selectedSnippetsTextHolder := '' asValue.
+
+ selectedSnippetHolder := nil asValue.
+ selectedSnippetHolder onChangeEvaluate:[
+ (selectedSnippetHolder value) isNil ifTrue:[
+ selectedSnippetsName := nil.
+ selectedSnippetsTextHolder value:''.
+ ] ifFalse:[
+ selectedSnippetsName := listOfSniplets at:(selectedSnippetHolder value).
+ selectedSnippetsTextHolder value:(snippetsDictionary at:selectedSnippetsName).
+ ].
].
- hasSelectionHolder := BlockValue with:[:m | m value notNil] argument:selectedSnipletHolder.
+ hasSelectionHolder := BlockValue with:[:m | m value notNil] argument:selectedSnippetHolder.
removeEnabledHolder := hasSelectionHolder.
pasteEnabledHolder := hasSelectionHolder.
- saveEnabledHolder := BlockValue with:[:m :textHolder|
- m value notNil
- and:[(snipletsDictionary at:(listOfSniplets at:(selectedSnipletHolder value))) ~= textHolder value]
- ] argument: selectedSnipletHolder argument: selectedSnipletsTextHolder.
+ saveEnabledHolder := BlockValue with:[:m :textHolder|
+ m value notNil
+ and:[(snippetsDictionary at:(listOfSniplets at:(selectedSnippetHolder value))) ~= textHolder value]
+ ] argument: selectedSnippetHolder argument: selectedSnippetsTextHolder.
removeAction := [
- snipletsDictionary removeKey:selectedSnipletsName.
- listOfSniplets remove:selectedSnipletsName.
+ snippetsDictionary removeKey:selectedSnippetsName.
+ listOfSniplets remove:selectedSnippetsName.
].
pasteAction := [
- |text|
- text := snipletsDictionary at:selectedSnipletsName.
- self paste:text
+ |text|
+ text := snippetsDictionary at:selectedSnippetsName.
+ self paste:text
].
saveAction := [
- |originalText newText|
- originalText := snipletsDictionary at:selectedSnipletsName.
- newText := selectedSnipletsTextHolder value.
- originalText ~= newText ifTrue:[
- snipletsDictionary at: selectedSnipletsName put: newText.
- ].
- saveEnabledHolder recomputeValue.
+ |originalText newText|
+ originalText := snippetsDictionary at:selectedSnippetsName.
+ newText := selectedSnippetsTextHolder value.
+ originalText ~= newText ifTrue:[
+ snippetsDictionary at: selectedSnippetsName put: newText.
+ ].
+ saveEnabledHolder recomputeValue.
].
bindings := IdentityDictionary new.
bindings at:#listOfSniplets put:listOfSniplets.
- bindings at:#selectedSniplet put:selectedSnipletHolder asValue.
- bindings at:#selectedSnipletsText put:selectedSnipletsTextHolder.
+ bindings at:#selectedSniplet put:selectedSnippetHolder asValue.
+ bindings at:#selectedSnipletsText put:selectedSnippetsTextHolder.
bindings at:#removeSelectedSniplet put:removeAction.
bindings at:#pasteSelectedSniplet put:pasteAction.
bindings at:#saveSelectedSniplet put:saveAction.
@@ -2760,23 +2760,23 @@
!
pasteSniplet
- |allSniplets snipletToPaste snipletsDictionary|
-
- snipletsDictionary := Workspace sniplets.
- snipletsDictionary isEmptyOrNil ifTrue:[
- Dialog information:(resources string:'No Sniplets to Paste').
- ^ self.
+ |allSnippets snippetToPaste snippetsDictionary|
+
+ snippetsDictionary := Workspace sniplets.
+ snippetsDictionary isEmptyOrNil ifTrue:[
+ Dialog information:(resources string:'No Snippet to Paste').
+ ^ self.
].
- allSniplets := snipletsDictionary keysSorted.
-
- snipletToPaste := Dialog
- choose:(resources string:'Paste Sniplet:')
- fromList:allSniplets
- lines:10.
- snipletToPaste isNil ifTrue:[
- ^ self
+ allSnippets := snippetsDictionary keysSorted.
+
+ snippetToPaste := Dialog
+ choose:(resources string:'Paste Snippet:')
+ fromList:allSnippets
+ lines:10.
+ snippetToPaste isNil ifTrue:[
+ ^ self
].
- self paste:(snipletsDictionary at:snipletToPaste) withCRs.
+ self paste:(snippetsDictionary at:snippetToPaste) withCRs.
"Modified: / 29-10-2010 / 10:21:29 / cg"
!
@@ -3234,34 +3234,34 @@
!
addSelectionToSniplets
- |selection snipletsBaseName snipletsName nr snipletsDictionary|
+ |selection snippetsBaseName snippetsName nr snippetsDictionary|
selection := (self selectedWorkspacesTextView selection ? '') asString.
selection isEmpty ifTrue:[
- Dialog information:(resources string:'Nothing Selected').
- ^ self
+ Dialog information:(resources string:'Nothing Selected').
+ ^ self
].
- snipletsBaseName := Dialog request:(resources string:'Name of Sniplet:').
- snipletsBaseName isNil ifTrue:[
- ^ self
+ snippetsBaseName := Dialog request:(resources string:'Name of Snippet:').
+ snippetsBaseName isNil ifTrue:[
+ ^ self
].
- snipletsBaseName isEmpty ifTrue:[
- snipletsBaseName := Time now asString.
+ snippetsBaseName isEmpty ifTrue:[
+ snippetsBaseName := Time now asString.
].
- snipletsDictionary := Workspace sniplets.
-
- snipletsName := snipletsBaseName.
- (snipletsDictionary includesKey:snipletsName) ifTrue:[
- (Dialog confirm:(resources string:'Replace existing sniplet named "%1" ?' with:snipletsName))
- ifFalse:[
- [snipletsDictionary includesKey:snipletsName] whileTrue:[
- nr := (nr ? 1) + 1.
- snipletsName := (snipletsBaseName,'(%1)') bindWith:nr
- ].
- ]
+ snippetsDictionary := Workspace sniplets.
+
+ snippetsName := snippetsBaseName.
+ (snippetsDictionary includesKey:snippetsName) ifTrue:[
+ (Dialog confirm:(resources string:'Replace existing snippet named "%1" ?' with:snippetsName))
+ ifFalse:[
+ [snippetsDictionary includesKey:snippetsName] whileTrue:[
+ nr := (nr ? 1) + 1.
+ snippetsName := (snippetsBaseName,'(%1)') bindWith:nr
+ ].
+ ]
].
- snipletsDictionary at:snipletsName put:selection
+ snippetsDictionary at:snippetsName put:selection
"Modified: / 24-11-2006 / 12:44:16 / cg"
!
@@ -4096,11 +4096,11 @@
!WorkspaceApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.247 2013-08-31 17:19:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.248 2013-09-05 13:37:29 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.247 2013-08-31 17:19:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.248 2013-09-05 13:37:29 cg Exp $'
!
version_HG
@@ -4109,6 +4109,6 @@
!
version_SVN
- ^ '$Id: WorkspaceApplication.st,v 1.247 2013-08-31 17:19:15 cg Exp $'
+ ^ '$Id: WorkspaceApplication.st,v 1.248 2013-09-05 13:37:29 cg Exp $'
! !
--- a/abbrev.stc Fri Sep 06 12:08:37 2013 +0100
+++ b/abbrev.stc Fri Sep 06 15:49:08 2013 +0100
@@ -224,3 +224,4 @@
Tools::HierarchicalPackageFilterList Tools__HierarchicalPackageFilterList stx:libtool 'Interface-Browsers-New-Profiler' 1
Tools::InheritanceClassList Tools__InheritanceClassList stx:libtool 'Interface-Browsers-New' 1
CodeCompletionHelpMenuView CodeCompletionHelpMenuView stx:libtool 'Interface-Help' 2
+Tools::Toolbox Tools__Toolbox stx:libtool 'Interface-Tools' 0
--- a/bc.mak Fri Sep 06 12:08:37 2013 +0100
+++ b/bc.mak Fri Sep 06 15:49:08 2013 +0100
@@ -1,4 +1,4 @@
-# $Header$
+# $Header: /cvs/stx/stx/libtool/bc.mak,v 1.128 2013-09-05 21:35:40 vrany Exp $
#
# DO NOT EDIT
# automagically generated from the projectDefinition: stx_libtool.
--- a/extensions.st Fri Sep 06 12:08:37 2013 +0100
+++ b/extensions.st Fri Sep 06 15:49:08 2013 +0100
@@ -2175,7 +2175,7 @@
!stx_libtool class methodsFor:'documentation'!
extensionsVersion_CVS
- ^ '$Header: /cvs/stx/stx/libtool/extensions.st,v 1.116 2013-08-31 11:33:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/extensions.st,v 1.117 2013-09-05 21:34:32 vrany Exp $'
! !
!stx_libtool class methodsFor:'documentation'!
--- a/libtool.rc Fri Sep 06 12:08:37 2013 +0100
+++ b/libtool.rc Fri Sep 06 15:49:08 2013 +0100
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_libtool.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 6,2,1,96
+ FILEVERSION 6,2,1,97
PRODUCTVERSION 6,2,3,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
@@ -20,12 +20,12 @@
BEGIN
VALUE "CompanyName", "eXept Software AG\0"
VALUE "FileDescription", "Smalltalk/X Tools (LIB)\0"
- VALUE "FileVersion", "6.2.1.96\0"
+ VALUE "FileVersion", "6.2.1.97\0"
VALUE "InternalName", "stx:libtool\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Tue, 03 Sep 2013 12:34:57 GMT\0"
+ VALUE "ProductDate", "Thu, 05 Sep 2013 21:35:06 GMT\0"
END
END
--- a/resources/de.rs Fri Sep 06 12:08:37 2013 +0100
+++ b/resources/de.rs Fri Sep 06 15:49:08 2013 +0100
@@ -1,6 +1,6 @@
#encoding utf8
-; $Header: /cvs/stx/stx/libtool/resources/de.rs,v 1.237 2013-08-30 21:30:31 cg Exp $
+; $Header: /cvs/stx/stx/libtool/resources/de.rs,v 1.239 2013-09-05 13:47:52 cg Exp $
;
; German Workspace (and other tools) resources
;
@@ -95,9 +95,13 @@
'Remove SharedPool' 'SharedPool ignorieren'
'Copy as Sniplet' 'Zu Schnipsel kopieren'
+'Copy as Snippet' 'Zu Schnipsel kopieren'
'Paste Sniplet' 'Schnipsel einfgen'
+'Paste Snippet' 'Schnipsel einfgen'
'Manage Sniplets' 'Schnipsel verwalten'
+'Manage Snippets' 'Schnipsel verwalten'
'No Sniplets to Manage' 'Keine Schnipsel zum verwalten'
+'No Snippets to Manage' 'Keine Schnipsel zum verwalten'
'Nothing Selected' 'Kein Text markiert'
'ChangeList on Text' 'ChangeList auf Text'
@@ -2906,6 +2910,7 @@
'load' 'laden'
'all' 'alle'
+'All Others' 'Alle Anderen'
'Labels' 'Labels'
'Buttons' 'Schaltflchen'
'Lists' 'Listen'
@@ -2917,6 +2922,11 @@
'Defaults' 'Voreinstellung'
'Memory manager settings' 'Einstellung der Speicherverwaltung'
+'Common Settings' 'Standardeinstellungen'
+'Default' 'Voreinstellung'
+'High Contrast' 'Kontrast'
+'Big Fonts' 'Gro'
+'Huge Fonts' 'Riesig'
'unload' 'entfernen'
'close' 'schlieen'
--- a/resources/es.rs Fri Sep 06 12:08:37 2013 +0100
+++ b/resources/es.rs Fri Sep 06 15:49:08 2013 +0100
@@ -475,6 +475,7 @@
'Copy WalkBack Text' 'Copiar texto del Walkback'
'Copy as' 'Copiar como'
'Copy as Sniplet' 'Copiar como recorte'
+'Copy as Snippet' 'Copiar como recorte'
'Copy or Move' 'Copiar o mover'
'Copy or move\\ %1 objects\to:\ %2' 'Copiar o mover\\ %1 objetos\a:\ %2'
'Copy or move\\%1:\ %2\to:\ %3' 'Copiar o mover\\%1:\ %2\a:\ %3'
@@ -979,7 +980,8 @@
'Make Public' 'Convertir a pública'
'Make Public Class' 'Convertir a clase pública'
'Make Public in' 'Convertir a pública en'
-'Manage Sniplets' 'Administrar pedazos <Sniplets>'
+'Manage Sniplets' 'Administrar pedazos <Snippets>'
+'Manage Snippets' 'Administrar pedazos <Snippets>'
'Mark as Obsolete' 'Marcar como obsoleto'
'Match' 'Buscar patrón'
'Max Length for single line Blocks:' 'Largo máximo para bloques de de una sola lÃnea'
@@ -1057,6 +1059,7 @@
'Next for Selector' 'Cambio siguiente para el selector'
'Next with String' 'Cambio siguiente para el String'
'No Sniplets to Manage' 'No hay pedazos <Sniplets> para administrar'
+'No Snippets to Manage' 'No hay pedazos <Snippets> para administrar'
'No classes in nameSpace ''%''.' 'No hay clases en el Espacio de Nombre <Namespace> %1.'
'No classes or methods found in %1' 'No se encontraron clases o métodos en %1'
'No current package.' 'No se ha definido un paquete actual.'
@@ -1107,6 +1110,7 @@
'Paste Last' 'Pegar último'
'Paste Previous' 'Pegar anterior'
'Paste Sniplet' 'Pegar pedazo <Sniplet>'
+'Paste Snippet' 'Pegar pedazo <Snippet>'
'Path Entry && Filter' 'Entrada de ruta && de filtros'
'Pattern Help' 'Ayuda sobre patrones'
'Pen Demo' 'Demostración con lápiz (figuras varias)'
--- a/stx_libtool.st Fri Sep 06 12:08:37 2013 +0100
+++ b/stx_libtool.st Fri Sep 06 15:49:08 2013 +0100
@@ -420,6 +420,7 @@
#'Tools::HierarchicalPackageFilterList'
#'Tools::InheritanceClassList'
CodeCompletionHelpMenuView
+ #'Tools::Toolbox'
)
!
@@ -570,6 +571,8 @@
Boolean inspectorValueStringInListFor:
Point inspectorValueStringInListFor:
Rectangle inspectorValueStringInListFor:
+ ProgrammingLanguage toolbox
+ ProgrammingLanguage toolboxClass
)
! !
@@ -629,11 +632,11 @@
!stx_libtool class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.97 2013-09-03 12:35:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.98 2013-09-05 21:36:32 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.97 2013-09-03 12:35:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.98 2013-09-05 21:36:32 vrany Exp $'
!
version_HG