#OTHER by mawalch
For the sake of love. This is not what I intended to check in.
--- a/Tools__NewSystemBrowser.st Wed Sep 14 11:50:56 2016 +0200
+++ b/Tools__NewSystemBrowser.st Wed Sep 14 12:15:42 2016 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
@@ -14845,45 +14843,6 @@
"Created: / 23-07-2012 / 13:27:23 / cg"
!
-classMenuSCMExtra_HG
- "This resource specification was automatically generated
- by the MenuEditor of ST/X."
-
- "Do not manually edit this!! If it is corrupted,
- the MenuEditor may not be able to read the specification."
-
-
- "
- MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#classMenuSCMExtra_HG
- (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMExtra_HG)) startUp
- "
-
- <resource: #menu>
-
- ^
- #(Menu
- (
- (MenuItem
- label: 'Push Slice'
- submenuChannel: commonMenuHGPushSlice
- isMenuSlice: true
- )
- (MenuItem
- label: 'Browse package working copy'
- itemValue: commonMenuHGBrowseWorkingCopy
- )
- (MenuItem
- label: 'Browse temporary working copy (for commits & merges)'
- itemValue: commonMenuHGBrowseTemporaryWorkingCopy
- )
- )
- nil
- nil
- )
-
- "Modified: / 14-12-2012 / 18:05:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
classMenuSCMExtra_Mercurial
"This resource specification was automatically generated
by the MenuEditor of ST/X."
@@ -16544,49 +16503,6 @@
"Modified: / 29-07-2013 / 09:49:26 / cg"
!
-projectMenuSCMExtra_HG
- "This resource specification was automatically generated
- by the MenuEditor of ST/X."
-
- "Do not manually edit this!! If it is corrupted,
- the MenuEditor may not be able to read the specification."
-
-
- "
- MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMenuSCMExtra_HG
- (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMExtra_HG)) startUp
- "
-
- <resource: #menu>
-
- ^
- #(Menu
- (
- (MenuItem
- label: 'Push Slice'
- submenuChannel: commonMenuHGPushSlice
- isMenuSlice: true
- )
- (MenuItem
- label: 'Browse Revision History'
- itemValue: projectMenuHGBrowseRevisionHistory
- )
- (MenuItem
- label: 'Browse package working copy'
- itemValue: commonMenuHGBrowseWorkingCopy
- )
- (MenuItem
- label: 'Browse temporary working copy (for commits & merges)'
- itemValue: commonMenuHGBrowseTemporaryWorkingCopy
- )
- )
- nil
- nil
- )
-
- "Modified: / 17-04-2014 / 09:41:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
projectMenuSCMExtra_SVN
"This resource specification was automatically generated
by the MenuEditor of ST/X."
@@ -19954,21 +19870,6 @@
"Created: / 24.2.2000 / 23:28:06 / cg"
! !
-!NewSystemBrowser methodsFor:'aspects-navigation-hg'!
-
-selectedProjectsForHG
- |sel|
-
- (sel := self selectedProjects value) notNil
- ifTrue:[^sel].
-
- (sel := self selectedClasses value) notNil
- ifTrue:[^(sel collect:[:cls|cls package]) asSet].
-
- ^nil
-
- "Created: / 10-12-2012 / 03:58:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
!NewSystemBrowser methodsFor:'aspects-organization'!
@@ -31632,39 +31533,6 @@
self codeAspect:#newError.
!
-classMenuNewGroovyClass
-
- | currentClass superClass code category |
- currentClass := self theSingleSelectedClass.
- currentClass notNil ifTrue:[
- superClass := currentClass theNonMetaclass superclass.
- superClass notNil ifTrue:[
- superClass isJavaClass ifFalse:[
- superClass := Java classForName:'java.lang.Object'.
- ]
- ]
- ] ifFalse:[
- superClass := Java classForName:'java.lang.Object'.
- ].
-
- category := self hasCategorySelected
- ifTrue:[self selectedCategoriesValue first]
- ifFalse:[Compiler defaultMethodCategory]. "/ '* As yet uncategorized *'
-
-
- code := GroovyLanguage instance
- classTemplateFor: superClass
- in: category
- asNamespace: false
- private: false.
-
- self showCode: code.
- self setAcceptAction: [:theCode | self doAcceptGroovyClassDefinition: theCode asString ].
- self codeAspect:#newClassDefinition.
-
- "Created: / 18-02-2012 / 17:16:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
classMenuNewHaskellModule
self classMenuNewClass:HaskellModule
!
@@ -40117,78 +39985,6 @@
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'
! !
-!NewSystemBrowser methodsFor:'menu actions-hg'!
-
-commonMenuHGBrowseTemporaryWorkingCopy
- self selectedProjectsForHG value do:[:package|
- | pkg |
-
- pkg := HGPackageWorkingCopy named: package.
- pkg notNil ifTrue:[
- pkg temporaryWorkingCopy browse
- ].
- ].
-
- "Created: / 11-01-2013 / 18:47:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 05-03-2014 / 21:45:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-commonMenuHGBrowseWorkingCopy
- self selectedProjectsForHG value do:[:package|
- | pkg |
-
- pkg := HGPackageWorkingCopy named: package.
- pkg notNil ifTrue:[
- pkg repository workingCopy browse
- ].
- ].
-
- "Modified: / 05-03-2014 / 21:45:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-commonMenuHGPush:repository to: remote
- self
- showMessage: (resources string: 'Pushing to %1' with: remote url asString)
- while: [
- [
- [
- repository push: remote
- ] on: HGPushWouldCreateNewHeadError do:[:ex1 |
- (Dialog confirm: (resources string: 'Push would create a new head (%1)\\Push anyway?' with: ex1 parameter) withCRs) ifTrue:[
- repository push: remote force: true.
- ].
- ].
- ] on: HGError do:[:ex2 |
- self inlineMessageApp
- reset;
- beWarning;
- message: (resources string: 'Push failed: %1' with: ex2 description);
- addButtonOK.
- ]
- ]
- inBackground: true.
-
- "Created: / 26-03-2014 / 15:21:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-projectMenuHGBrowseRevisionHistory
- self selectedProjectsForHG value do:[:package|
- | pkg |
-
- pkg := HGPackageWorkingCopy named: package.
- pkg notNil ifTrue:[
- | browser |
-
- self withWaitCursorDo:[
- browser := HGChangesetBrowser new.
- browser repository: pkg repository.
- browser open.
- ]
- ].
- ].
-
- "Created: / 17-04-2014 / 09:41:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
!NewSystemBrowser methodsFor:'menu actions-inheritance'!
@@ -47175,7 +46971,7 @@
self activityNotification:nil.
browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
- browser window label:(resources string:'Revisions of %1 » %2' with:mclass name with:mselector).
+ browser window label:(resources string:'Revisions of %1 » %2' with:mclass name with:mselector).
browser readOnly:true.
].
@@ -51751,7 +51547,7 @@
label:[:chg |
|lbl|
"/ lbl := chg printString
- lbl := (chg className ? '???') , ' » ' , (chg selector ? '???') allBold.
+ lbl := (chg className ? '???') , ' » ' , (chg selector ? '???') allBold.
(chg isMethodChange and:[chg changeMethod isNil]) ifTrue:[
lbl := lbl asText allStrikedOut,' ','(removed)' allItalic.
].
@@ -53486,51 +53282,6 @@
"Modified: / 19-10-2011 / 16:48:31 / cg"
! !
-!NewSystemBrowser methodsFor:'menus-dynamic-hg'!
-
-commonMenuHGPushSlice
- | menu push submenu packages package remotes default |
-
- menu := Menu new.
- push := MenuItem new
- label: (resources string: 'Push...');
- yourself.
- menu addItem: push.
-
- packages := self selectedProjectsForHG value collect:[:id|HGPackageWorkingCopy named:id string].
- ((packages size ~~ 1) or:[packages anElement isNil]) ifTrue:[
- push enabled: false.
- ^menu.
- ].
-
- package := packages anElement.
- remotes := package repository remotes.
- remotes isEmpty ifTrue:[
- push enabled: false.
- ^menu.
- ].
-"/ default := package repository remoteDefault.
-"/ default notNil ifTrue:[
-"/ menu addItem: (MenuItem new
-"/ label:((resources string: 'Push to ') , 'default' asText allBold);
-"/ value:[package repository push: default];
-"/ yourself).
-"/ ].
- (remotes size ~~ 1 or:[remotes anElement ~~ default]) ifTrue:[
- submenu := Menu new.
- push submenu: submenu.
- remotes do:[:remote|
- submenu addItem: (MenuItem new
- label: remote displayString;
- value:[self commonMenuHGPush: package repository to: remote ];
- yourself).
- ].
- ].
- ^menu.
-
- "Created: / 10-12-2012 / 03:56:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 26-03-2014 / 15:22:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
!NewSystemBrowser methodsFor:'menus-dynamic-lint'!
@@ -59147,107 +58898,6 @@
^ selectorCompletion
! !
-!NewSystemBrowser methodsFor:'private-searching-smallsense'!
-
-searchCompletionBlock_SmallSense
- "This returns a class/selector name completion block that uses
- standard DoWhatIMeanSupport"
-
- ^ [:patternString | self smallSenseSearchCompletion:patternString ]
-
- "Created: / 25-11-2013 / 12:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-smallSenseSearchCompletion:patternString
- "/sorry, no method search yet"
-
- ^ self smallSenseSearchCompletionNewForClass:patternString
-
- "Modified: / 04-08-2011 / 19:05:28 / cg"
- "Created: / 04-12-2011 / 22:22:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-smallSenseSearchCompletionBlock
- "This returns a class/selector name completion block that uses
- standard DoWhatIMeanSupport"
-
- ^ [:patternString | self smallSenseSearchCompletion:patternString ]
-
- "Modified: / 04-08-2011 / 19:05:28 / cg"
- "Created: / 04-12-2011 / 22:13:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-smallSenseSearchCompletionEntryForClass:aClass showPrefix:showPrefix
- ^ (SmallSense::ClassPO new)
- klass:aClass;
- showPrefix:showPrefix.
-
- "Created: / 06-04-2012 / 12:55:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 25-11-2013 / 12:16:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-smallSenseSearchCompletionNewForClass:patternString
- | env pattern matcher matches relax withPrefix |
-
- patternString isEmptyOrNil ifTrue:[
- ^ #( '' #() )
- ].
- env := self theSingleSelectedNamespace ? #Smalltalk.
- env = NavigatorModel nameListEntryForALL ifTrue:[
- env := #Smalltalk
- ].
- env := Smalltalk at:env.
- withPrefix := patternString includes:$:.
- pattern := StringPattern readFrom:patternString onError:[ ^ #( '' #() ) ].
- withPrefix ifTrue:[
- matcher := [:cls | pattern match:cls name ]
- ] ifFalse:[
- matcher := [:cls | pattern match:cls nameWithoutPrefix ]
- ].
- relax := 1.
- [
- matches isEmptyOrNil and:[ relax <= 3 ]
- ] whileTrue:[
- matches := OrderedCollection new.
- env
- keysDo:[:nm |
- | cls |
-
- cls := env at:nm.
- (cls notNil and:[ cls isBehavior and:[ (matches includesIdentical:cls) not ] ])
- ifTrue:[
- "cls isJavaClass"false ifTrue:[
- cls isAnonymous ifFalse:[
- (matcher value:cls) ifTrue:[
- matches add:cls
- ].
- ].
- ] ifFalse:[
- (matcher value:cls) ifTrue:[
- matches add:cls
- ].
- ]
- ].
- ].
- relax := relax + 1.
- ].
- matches isEmpty ifTrue:[
- ^ #( nil #() )
- ] ifFalse:[
- matches := matches
- collect:[:cls |
- self smallSenseSearchCompletionEntryForClass:cls showPrefix:withPrefix
- ].
- ^ {
- matches first.
- matches
- }
- ]
-
- "Created: / 06-04-2012 / 12:56:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 07-08-2014 / 13:10:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
!NewSystemBrowser methodsFor:'private-semantic checks'!
checkAcceptedMethod:aMethod inClass:aClass