--- a/Tools__NewSystemBrowser.st Wed Sep 14 08:56:32 2016 +0200
+++ b/Tools__NewSystemBrowser.st Wed Sep 14 11:50:56 2016 +0200
@@ -14845,6 +14845,45 @@
"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."
@@ -16505,6 +16544,49 @@
"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."
@@ -19872,6 +19954,21 @@
"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'!
@@ -31535,6 +31632,39 @@
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
!
@@ -39987,6 +40117,78 @@
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'!
@@ -40264,14 +40466,14 @@
existing := environment at:nm asSymbol ifAbsent:nil.
existing notNil ifTrue:[
existing isNameSpace ifTrue:[
- self warn:'A NameSpace named ''%1'' alread exists.' with:nm.
+ self warn:'A NameSpace named ''%1'' already exists.' with:nm.
^ self
].
existing isBehavior ifFalse:[
- self warn:'A class named ''%1'' alread exists.' with:nm.
+ self warn:'A class named ''%1'' already exists.' with:nm.
^ self
].
- self warn:'A global named ''%1'' alread exists.\(Currently bound to %2)' with:nm with:existing classNameWithArticle.
+ self warn:'A global named ''%1'' already exists.\(Currently bound to %2)' with:nm with:existing classNameWithArticle.
^ self
].
Class nameSpaceQuerySignal answer:Smalltalk do:[
@@ -53284,6 +53486,51 @@
"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'!
@@ -58900,6 +59147,107 @@
^ 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