extensions.st
author fm
Thu, 01 Oct 2009 15:26:52 +0200
changeset 241 a3b16e3f4d52
parent 240 4f87d0e71d54
child 264 6bf328cd9572
permissions -rw-r--r--
*** empty log message ***

"{ Package: 'cvut:stx/goodies/libsvn' }"
!

!ApplicationDefinition class methodsFor:'file templates'!

make_dot_proto

^
'# $','Header','$
#
# -------------- no need to change anything below ----------
#
# This makefile generates some standalone demo applications
#
#    make
#       generates %(APPLICATION)
#

TOP=%(TOP)
INCLUDE_TOP=$(TOP)/..

PACKAGE=%(APPLICATION_PACKAGE)
SUBDIRS=
SUPPRESS_LOCAL_ABBREVS="yes"
NOAUTOLOAD=1
NOSUBAUTOLOAD=1

LOCALINCLUDES=-I$(INCLUDE_TOP)/stx/libbasic %(LOCAL_INCLUDES)
LOCALDEFINES=%(LOCAL_DEFINES)
GLOBALDEFINES=%(GLOBAL_DEFINES)
MAIN_DEFINES=%(MAIN_DEFINES)

RCSSOURCES=Make.proto *.st
LINKSOURCES=Make.proto *.st

DELIVERBINARIES=

target: %(BUILD_TARGET)

all::   prereq exe

exe:    %(APPLICATION) $(REQUIRED_SUPPORT_DIRS)

LIBNAME=%(LIBRARY_NAME)
STCLOCALOPT=''-package=$(PACKAGE)'' -I. -H. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) %(HEADEROUTPUTARG) %(COMMONSYMFLAG) -varPrefix=$(LIBNAME)


# ********** OPTIONAL: MODIFY the next line ***
# additional C-libraries that should be pre-linked with the class-objects
LD_OBJ_LIBS=%(ADDITIONAL_LINK_LIBRARIES)
LOCAL_SHARED_LIBS=%(ADDITIONAL_SHARED_LINK_LIBRARIES)


# ********** OPTIONAL: MODIFY the next line ***
# additional C targets or libraries should be added below
LOCAL_EXTRA_TARGETS=

OBJS= $(COMMON_OBJS) $(UNIX_OBJS)

%(ADDITIONAL_DEFINITIONS)

%(ADDITIONAL_DEFINITIONS_SVN)

LIBLIST = $(REQUIRED_LIBS)

# required libs:
#

REQUIRED_LIBS=%(REQUIRED_LIBS)

REQUIRED_LIBOBJS=%(REQUIRED_LIBOBJS)

REQUIRED_LINK_LIBOBJS=%(REQUIRED_LINK_LIBOBJS)

REQUIRED_SUPPORT_DIRS=%(REQUIRED_SUPPORT_DIRS)


%(APPLICATION):   %(STARTUP_CLASSFILENAME).$(O) $(APP_DIRS_TO_MAKE) $(APP_LIBOBJS) $(OBJS)
	$(MAKE) %(APPLICATION_TYPE) \
		    TARGET=%(APPLICATION) \
		    APPLICATION_CLASSES="%(STARTUP_CLASSFILENAME)" \
		    APPLICATION_OBJS="$(OBJS)" \
		    APPLICATION_LIBLIST="$(REQUIRED_LIBS)" \
		    APPLICATION_LIBOBJS="$(REQUIRED_LIBOBJS)" \
		    APPLICATION_LINK_LIBOBJS="$(REQUIRED_LINK_LIBOBJS)" \
		    STARTUP_CLASS="%(STARTUP_CLASS)" \
		    STARTUP_SELECTOR="%(STARTUP_SELECTOR)" \
		    MAIN_DEFINES="%(MAIN_DEFINES)"

# build all prerequisite packages for this package
prereq:
%(MAKE_PREREQUISITES)

SOURCEFILES: %(APPLICATION)_SOURCES \
	stx_SOURCES

%(SOURCE_RULES)
%(STX_SOURCE_RULES)

RESOURCEFILES: %(APPLICATION)_RESOURCES %(APPLICATION)_BITMAPS %(ADDITIONAL_RESOURCE_TARGETS) \
	stx_RESOURCES stx_STYLES stx_BITMAPS

%(RESOURCE_RULES)
%(STX_RESOURCE_RULES)

%(PREREQUISITES_LIBS)
%(SUBPROJECTS_LIBS)

%(ADDITIONAL_RULES)

%(ADDITIONAL_RULES_SVN)

clean::
	-rm -f *.so %(APPLICATION).$(O)

clobber:: clean
	-rm -f %(APPLICATION) *.img *.sav

# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
%(DEPENDENCIES)
# ENDMAKEDEPEND --- do not remove this line
'

    "Modified: / 09-08-2006 / 16:50:23 / fm"
    "Created: / 29-09-2006 / 23:47:07 / cg"
    "Modified: / 24-06-2009 / 21:40:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!ChangeSet methodsFor:'queries'!

changesForPackage:aPackageSymbol

    "
	ChangeSet current changesForPackage:#'stx:goodies/libsvn'.

    "

    ^(self select:[:aChange |
	|removeThis mClass mthd|

	removeThis := false.
	(aChange isMethodChange or:[aChange isMethodRemoveChange]) ifTrue:[
	    mClass := aChange changeClass.
	    mClass notNil ifTrue:[
		mthd := mClass compiledMethodAt:(aChange selector).
		mthd isNil ifTrue:[
		    aChange isMethodRemoveChange ifTrue:[
			removeThis := (mClass package = aPackageSymbol)
		    ].
		] ifFalse:[
		    removeThis := (mthd package = aPackageSymbol)
		]
	    ].
	] ifFalse:[
	    (aChange isClassChange) ifTrue:[
		(aChange changeClass notNil) ifTrue:[
		    removeThis := (aChange changeClass package = aPackageSymbol)
		].
	    ].
	].
	removeThis
    ])

    "Created: / 05-11-2001 / 14:21:17 / cg"
    "Modified: / 12-10-2006 / 16:51:27 / cg"
    "Modified: / 22-10-2008 / 13:25:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!ChangeSet methodsFor:'utilities'!

condenseChanges

    | changesToRemove changesToKeep |
    changesToKeep := self class new.
    changesToRemove := self class new.
    self reverseDo:
	[:change|
	(changesToKeep anySatisfy:[:each|each isForSameAs: change])
	    ifTrue:[changesToRemove add: change]
	    ifFalse:[changesToKeep add: change]
	].
    self condenseChanges: changesToRemove.

    "Created: / 22-10-2008 / 13:05:13 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!ChangeSet methodsFor:'utilities'!

condenseChangesForPackage2:aPackageSymbol
    "remove more changes for aPackageSymbol
     This is invoked when a project is checked into the repository."

    |changesToRemove|

    changesToRemove := self select:[:aChange |
	|removeThis mClass mthd|

	removeThis := false.
	(aChange isMethodChange or:[aChange isMethodRemoveChange]) ifTrue:[
	    mClass := aChange changeClass.
	    mClass notNil ifTrue:[
		mthd := mClass compiledMethodAt:(aChange selector).
		mthd isNil ifTrue:[
		    removeThis := (mClass package = aPackageSymbol)
		] ifFalse:[
		    removeThis := (mthd package = aPackageSymbol)
		]
	    ].
	] ifFalse:[
	    (aChange isClassChange) ifTrue:[
		(aChange changeClass notNil) ifTrue:[
		    removeThis := (aChange changeClass package = aPackageSymbol)
		].
	    ].
	].
	removeThis
    ].

    self condenseChanges:changesToRemove

    "Modified: / 12-10-2006 / 16:51:27 / cg"
    "Created: / 09-08-2009 / 14:29:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!ChangeSet methodsFor:'utilities'!

diffSetsAgainstImage

    |imageChangeSet|

    imageChangeSet := self class new.
    self changedClasses do:
	[:class|
	(class isMetaclass or:[class isPrivate]) ifFalse:
	    [imageChangeSet addAll:
		(self class fromStream: class source asString readStream)]].
    ^self diffSetsAgainst: imageChangeSet

    "Created: / 04-12-2007 / 16:03:28 / janfrog"
! !

!ChangeSet class methodsFor:'instance creation'!

forPackage: package

    ^self forPackage: package ignoreAutoloaded: false.

    "Created: / 20-05-2008 / 17:56:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 12-08-2009 / 14:23:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!ChangeSet class methodsFor:'instance creation'!

forPackage: package ignoreAutoloaded: ignoreAutoloaded
    "build a changeSet for a given package"

    |changeSet packageClasses packageExtensions|

    packageClasses := ProjectDefinition searchForClassesWithProject: package.
    packageExtensions := ProjectDefinition searchForExtensionsWithProject: package.
    changeSet := self forExistingMethods: packageExtensions.
    packageClasses do:
	[:cls|
	(ignoreAutoloaded not and:[cls isLoaded not])
	    ifTrue:[cls autoload].
	cls isLoaded
	    ifTrue:
		[changeSet addAll:
		    (self
			forExistingClass:cls
			withExtensions:false
			extensionsOnly:false)]].
    ^changeSet

    "Created: / 12-08-2009 / 14:22:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Class methodsFor:'fileOut'!

fileOutAsMethodIn: class selector: selector

    ^self fileOutAsMethodIn: class selector: selector category: 'sources'

    "Created: / 08-04-2009 / 20:58:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Class methodsFor:'accessing'!

svnRepository

    ^SVN::RepositoryManager repositoryForPackage: self package

    "Created: / 19-04-2008 / 18:24:54 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Filename methodsFor:'reading-directories'!

directoryContentsAsFilenamesMatching: patternOrCollectionOfThose

    "
	Same as directoryContentsAsFilenames, but returns only files
	that matches given patterns. This uses String>>matches:
	for pattern matching
    "

    |names|

    names := self directoryContentsMatching: patternOrCollectionOfThose .
    names isNil ifTrue:[^ nil].
    ^ names asOrderedCollection collect:[:entry | self construct:entry].

    "
    '/etc' asFilename
	directoryContentsAsFilenamesMatching: 'pass*'

    '/etc' asFilename
	    directoryContentsAsFilenamesMatching: #('pass*' 'nsswitch.conf')
    "

    "Created: / 03-06-2009 / 09:57:45 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Filename methodsFor:'reading-directories'!

directoryContentsMatching: patternOrCollectionOfThose

    "
	Same as directoryContants, but returns only files
	that matches given patterns. This uses String>>matches:
	for pattern matching
    "

    | names patterns |
    patterns := patternOrCollectionOfThose isString
		    ifTrue: [Array with: patternOrCollectionOfThose]
		    ifFalse:[patternOrCollectionOfThose].
    names := self directoryContents.
    names ifNil:[^nil].
    ^names select:
	[:e|patterns anySatisfy:[:pattern|e matches: pattern]]

    "
     '/etc' asFilename
	directoryContentsMatching: 'pass*'

    '/etc' asFilename
	directoryContentsMatching: #('pass*' 'nsswitch.conf')

    '/etc' asFilename
	directoryContentsMatching: #('does-not-exists.txt')

    "

    "Created: / 03-06-2009 / 09:52:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Method methodsFor:'accessing'!

makeSourceFileAbsolute

    "
	Makes a source file reference absolute.
	This is required by SVN, because svn working copy
	is in package path, so it's existence may corrupt source
	files.
    "

    | fileStream |

    "check whether my source is in external file. If not, this is noop"
    sourcePosition ifNil:[^nil].
    "already absolute"
    source asFilename isAbsolute ifTrue:[^self].
    fileStream := self rawSourceStream.
    fileStream isFileStream ifTrue:
	[source := fileStream fileName asAbsoluteFilename pathName].

    "
	(Method compiledMethodAt:#mclass:)
	    makeSourceFileAbsolute
    "

    "Created: / 21-08-2009 / 17:24:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!MethodChange methodsFor:'queries'!

isForGeneratedSubject
    "
    Answers true iff subject of this method is somewhat
    auto-generated by some tool - just like version methods
    are.
    "

    ^self isForMeta 
        and:[((self selector) == #version)
          or:[self selector startsWith:'version_' ]
        ]

    "Created: / 17-08-2009 / 18:56:59 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Smalltalk class methodsFor:'system management-files'!

fileNameForClass:aClassOrClassName
    "return a actual or expected (or most wanted) filename for aClassOrClassName."

    |cls nonMetaclass nm nm1 nm2 compatQuery|


    compatQuery := Smalltalk classNamed: 'SVN::CompatModeQuery'.
    (compatQuery notNil and:
	    [compatQuery isLoaded  and:[compatQuery query not]])
	ifTrue:
	[nm := aClassOrClassName isBehavior
		    ifTrue:[aClassOrClassName name]
		    ifFalse:[aClassOrClassName].
	nm := nm copyReplaceAll:$: with:$_.
	^nm].

    aClassOrClassName isBehavior ifTrue:[
	nonMetaclass := aClassOrClassName theNonMetaclass.
	nm := nonMetaclass getClassFilename.
	nm notNil ifTrue:[^ nm asFilename withoutSuffix baseName].
	nm1 := nonMetaclass name.
	nm2 := nonMetaclass nameWithoutPrefix.
    ] ifFalse:[
	cls := Smalltalk classNamed:aClassOrClassName.
	cls notNil ifTrue:[
	    nonMetaclass := cls theNonMetaclass.
	    nm := nonMetaclass getClassFilename.
	    nm notNil ifTrue:[^ nm asFilename withoutSuffix baseName].
	    nm1 := nonMetaclass name.
	    nm2 := nonMetaclass nameWithoutPrefix.
	] ifFalse:[
	    nm1 := aClassOrClassName.
	    nm2 := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
	].
    ].
    nm1 := nm1 asSymbol.
    nm2 := nm2 asSymbol.

    CachedAbbreviations notNil ifTrue:[
	(CachedAbbreviations includesKey:nm1) ifTrue:[
	    ^ (CachedAbbreviations at:nm1) asFilename baseName
	].
	(CachedAbbreviations includesKey:nm2) ifTrue:[
	    ^ (CachedAbbreviations at:nm2) asFilename baseName
	].
    ].
    ^ nm1 copyReplaceAll:$: with:$_

    "
     Smalltalk fileNameForClass:#Complex
     Smalltalk fileNameForClass:'SmallInteger'
     Smalltalk fileNameForClass:'UnixOperatingSystem'
     Smalltalk fileNameForClass:'Launcher'
     Smalltalk fileNameForClass:'SomeUnknownClass'
     Smalltalk fileNameForClass:OSI::FTAMOperation
     Smalltalk fileNameForClass:'OSI::Foobar'
     Smalltalk fileNameForClass:(Workflow::UnsuccessfulFinishReasons)
     Workflow::UnsuccessfulFinishReasons classFilename
    "

    "Modified: / 06-10-2006 / 16:16:01 / cg"
    "Modified: / 15-07-2009 / 20:18:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 22-08-2009 / 11:57:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Smalltalk class methodsFor:'system management-packages'!

loadPackageWithId:aPackageId asAutoloaded:doLoadAsAutoloaded
    "make certain, that some particular package is loaded into the system.
     Experimental."

    |packageDir|

    packageDir := self packageDirectoryForPackageId:aPackageId.
    packageDir isNil ifTrue:[
	(aPackageId includes:$:) ifFalse:[
	    "/ assume stx
	    packageDir := self packageDirectoryForPackageId:('stx:',aPackageId).
	].
    ].
    (packageDir isNil and: [SVN::RepositoryManager notNil]) ifTrue:
	[^self loadPackageWithId: aPackageId fromRepositoryAsAutoloaded: doLoadAsAutoloaded].

    ^ self
	loadPackageWithId:aPackageId
	fromDirectory:packageDir
	asAutoloaded:doLoadAsAutoloaded.

    "
     Smalltalk loadPackageWithId:'stx:libbasic'
     Smalltalk loadPackageWithId:'stx:goodies/persistency'
     Smalltalk loadPackageWithId:'exept:ctypes'
    "

    "Modified: / 07-12-2006 / 15:04:39 / cg"
    "Modified: / 28-10-2008 / 15:56:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 22-08-2009 / 11:58:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Smalltalk class methodsFor:'system management-packages'!

loadPackageWithId:aPackageId fromRepositoryAsAutoloaded:doLoadAsAutoloaded

    self
	loadPackageWithId:aPackageId
	fromRepositoryAsAutoloaded:doLoadAsAutoloaded
	usingRepositoryManager: SVN::RepositoryManager current

    "Created: / 28-10-2008 / 15:53:37 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-04-2009 / 17:20:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Smalltalk class methodsFor:'system management-packages'!

loadPackageWithId:aPackageId fromRepositoryAsAutoloaded:doLoadAsAutoloaded usingRepositoryManager: manager

    | retval loadBlock |
    loadBlock :=
	[| repo packageDir |
	repo := manager repositoryForPackage: aPackageId.
	retval := (repo notNil and:[repo exists])
	    ifTrue:
		[repo workingCopy checkout.
		packageDir := self packageDirectoryForPackageId:aPackageId.
		self
		    loadPackageWithId:aPackageId
		    fromDirectory:packageDir
		    asAutoloaded:doLoadAsAutoloaded]
	    ifFalse:
		[false]].

    (Query query == true)
	ifTrue:
	    [loadBlock value]
	ifFalse:
	    [Query answer: true do:
		[SVN::ProgressDialog
		    openOn: loadBlock
		    title: ' Loading...'
		    subtitle: aPackageId asText allItalic]].
    ^retval

    "Created: / 09-04-2009 / 17:20:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-class'!

classMenuSubversionCommit

    | classesPerPackage |
    classesPerPackage := Dictionary new.
    self selectedClasses value do:
	[:class|
	(classesPerPackage at: class theNonMetaclass package ifAbsentPut:[Set new])
	    add: class theNonMetaclass].
    classesPerPackage keysAndValuesDo:
	[:package :classes| | repo |
	repo := SVN::RepositoryManager repositoryForPackage:package.
	SVN::CommitWizard new
		task: (repo workingCopy commitTask
			classes: classes;
			extensionMethods: #()
			yourself);
		open]

    "Modified: / 16-06-2009 / 21:05:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-class'!

classMenuSubversionCompareImageWithRevision

    | cls branch revisionLog revision |
    cls := self theSingleSelectedClass theNonMetaclass.
    branch := cls theNonMetaclass svnRepository branch.
    revisionLog := branch log: cls.
    revision := SVN::RevisionSelectionDialog openOn: revisionLog.
    self classMenuSubversionCompareImageWithRevision: revision

    "Created: / 19-04-2008 / 18:38:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-class'!

classMenuSubversionCompareImageWithRevision: revision

    | cls branch  diffSet tool smalltalkDiffToolClass|
    revision ifNil:[^self].
    cls := self theSingleSelectedClass theNonMetaclass.
    branch := cls theNonMetaclass svnRepository branch.
    SVN::ProgressDialog
        openOn:[diffSet := branch diffSetForClass: cls betweenImageAndRevision: revision]
        title: 'Creating diffset for class ', cls fullName asText allItalic
        subtitle:
            ('Package: ' , branch package asText allItalic ,
             ' Revision ' , revision asString).

    smalltalkDiffToolClass := Smalltalk classNamed:#'Tools::SmalltalkDiffTool'.

    tool := (smalltalkDiffToolClass notNil
            and:[smalltalkDiffToolClass isLoaded]) 
                ifTrue:[ smalltalkDiffToolClass ]
                ifFalse:[ VersionDiffBrowser ].
    tool
        openOnDiffSet:diffSet
        labelA: 'Image'
        labelB: 'r',revision printString
        title: 'Differences of ',cls fullName,' between image and revision ',revision printString.

    "Created: / 19-04-2008 / 18:54:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-08-2009 / 14:14:37 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-class'!

classMenuSubversionCompareImageWithRevisionHead

    self classMenuSubversionCompareImageWithRevision: SVN::Revision head

    "Created: / 19-04-2008 / 18:56:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-class'!

classMenuSubversionUpdate
    "automatically generated by UIEditor ..."

    "*** the code below performs no action"
    "*** (except for some feedback on the Transcript)"
    "*** Please change as required and accept in the browser."
    "*** (and replace this comment by something more useful ;-)"

    "action to be added ..."

    Transcript showCR:self class name, ': action for #classMenuSubversionUpdate ...'.
! !

!Tools::NewSystemBrowser methodsFor:'aspects-queries'!

hasClassesSelectedAndSubversionRepositoryExists

    | classes |
    classes := self selectedClasses value.
    classes size = 0 ifTrue:[^false].
    ^classes
        allSatisfy:
            [:cls|self hasSubversionRepositoryFor: cls theNonMetaclass package]

    "Created: / 20-06-2009 / 12:10:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 21-06-2009 / 00:31:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 22-08-2009 / 11:19:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'aspects-queries'!

hasProjectSelectedSubversionRepositoryExists
    ^ [ self hasProjectSelected 
            and:[self selectedProjects value size = 1 
                and:[self hasSubversionRepositoryFor: self selectedProjects value anyOne]]]

    "Created: / 31-03-2008 / 15:07:52 / janfrog"
! !

!Tools::NewSystemBrowser methodsFor:'aspects-queries'!

hasSingleClassAndSubversionRepositoryExists
    ^ self hasSingleClassSelected
        and:[self hasSubversionRepositoryFor: self theSingleSelectedClass package]

    "Created: / 19-04-2008 / 17:40:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'aspects-queries'!

hasSubversionRepositoryFor: package

    ^self hasSubversionSupport and:
        [SVN::RepositoryManager hasRepositoryForPackage: package]

    "Created: / 31-03-2008 / 15:08:13 / janfrog"
    "Modified: / 22-08-2009 / 10:49:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menus-dynamic'!

projectMenuSubversionBranches

    <resource: #programMenu >

    | menu repository |
    menu := Menu new.
    repository := self selectedProjectSubversionRepository.
    repository branches do:
	[:branch|
	menu addItem:
	    (MenuItem new
		label: branch name;
		choiceValue: branch;
		choice:(repository workingCopy branch);
		enabled:(repository workingCopy branch) = branch;
		yourself)
	].

    ^menu

    "Created: / 19-04-2008 / 11:06:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionBrowseWorkingCopy

    self selectedProjects value do:
	[:package|
	| pkg repo |
	pkg := self theSingleSelectedProject.
	repo := (SVN::RepositoryManager repositoryForPackage: pkg) .
	FileBrowserV2 openOn: repo workingCopy path]

    "Created: / 09-04-2009 / 13:19:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCommit

    self selectedProjects value do:
	[:package|
	| repo |
	repo := SVN::RepositoryManager repositoryForPackage:package.
	SVN::CommitWizard new
	    task: repo workingCopy commitTask;
	    open]

    "Created: / 01-04-2008 / 19:02:42 / janfrog"
    "Modified: / 16-08-2009 / 19:17:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCommitMode

    ^(PluggableAdaptor on: self theSingleSelectedProject)
	getBlock:
	    [:prjHolder| | wc |
	    wc := SVN::RepositoryManager workingCopyForPackage: self theSingleSelectedProject value.
	    wc ifNotNil:[wc commitMode] ifNil:[nil]]
	putBlock:
	    [:prjHolder :value| | wc |
	    wc := SVN::RepositoryManager workingCopyForPackage: self theSingleSelectedProject value.
	    wc ifNotNil:[wc commitMode:value]]
	updateBlock:
	    [:prjHolder :aspect :value|true].

    "Created: / 13-08-2009 / 15:05:45 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCompareExtensionsInImageWithRevision

    | pkg branch revisionLog revision  |
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    revisionLog := branch log:(branch repository containerNameForExtensions).
    revision := SVN::RevisionSelectionDialog openOn: revisionLog.
    self projectMenuSubversionCompareExtensionsInImageWithRevision: revision

    "Created: / 19-04-2008 / 19:13:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCompareExtensionsInImageWithRevision: revision

    | pkg diffSet  branch tool smalltalkDiffToolClass|
    revision ifNil:[^self].
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    SVN::ProgressDialog
        openOn:[diffSet := branch diffSetForExtensionsBetweenImageAndRevision: revision.]
        title: 'Creating diffset for extensions'
        subtitle:
            ('Package: ' , branch package asText allItalic ,
             ' Revision ' , revision asString).

    smalltalkDiffToolClass := Smalltalk classNamed:#'Tools::SmalltalkDiffTool'.

    tool := (smalltalkDiffToolClass notNil
            and:[smalltalkDiffToolClass isLoaded]) 
                ifTrue:[ smalltalkDiffToolClass ]
                ifFalse:[ VersionDiffBrowser ].
    tool
        openOnDiffSet:diffSet
        labelA: 'Image'
        labelB: 'r',revision printString
        title: 'Differences of extensions for ',pkg,' between image and revision ',revision printString.

    "Created: / 19-04-2008 / 19:13:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-08-2009 / 14:14:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCompareImageWithRevision

    | pkg branch revisionLog revision  |
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    revisionLog := branch log:'.'.
    revision := SVN::RevisionSelectionDialog openOn: revisionLog.
    self projectMenuSubversionCompareImageWithRevision: revision

    "Created: / 20-05-2008 / 18:09:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCompareImageWithRevision: revision

    | pkg diffSet  branch tool smalltalkDiffToolClass|
    revision ifNil:[^self].
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    SVN::ProgressDialog
        openOn:[diffSet := branch diffSetBetweenImageAndRevision: revision]
        title: 'Creating diffset'
        subtitle:
            ('Package: ' , branch package asText allItalic ,
             ' Revision ' , revision asString).

    smalltalkDiffToolClass := Smalltalk classNamed:#'Tools::SmalltalkDiffTool'.

    tool := (smalltalkDiffToolClass notNil
            and:[smalltalkDiffToolClass isLoaded]) 
                ifTrue:[ smalltalkDiffToolClass ]
                ifFalse:[ VersionDiffBrowser ].
    tool
        openOnDiffSet:diffSet
        labelA: 'Image'
        labelB: 'r',revision printString
        title: 'Differences for ',pkg,' between image and revision ',revision printString.

    "Created: / 20-05-2008 / 18:09:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-08-2009 / 14:14:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionCompareImageWithRevisionHEAD

    self projectMenuSubversionCompareImageWithRevision: SVN::Revision head

    "Created: / 20-05-2008 / 18:10:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionLoadRevision

    ^self projectMenuSubversionLoadRevision: nil

    "Created: / 22-10-2008 / 11:49:35 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-04-2009 / 09:38:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionLoadRevision: aRevision

    self selectedProjects value do:
	[:package|
	| pkg task |
	pkg := self theSingleSelectedProject.
	task := (SVN::RepositoryManager repositoryForPackage: pkg) updateTask.
	task revision: aRevision.
	SVN::UpdateWizard openOn: task]

    "Created: / 09-04-2009 / 09:38:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionMergeImageWithRevision

    | pkg branch revisionLog revision  |
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    revisionLog := branch log:'.'.
    revision := SVN::RevisionSelectionDialog openOn: revisionLog.
    self projectMenuSubversionMergeImageWithRevision: revision

    "Created: / 20-05-2008 / 23:41:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionMergeImageWithRevision: revision

    | pkg diffSet  branch smalltalkMergeToolClass|
    revision ifNil:[^self].
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    SVN::ProgressDialog
        openOn:[diffSet := branch diffSetBetweenImageAndRevision: revision]
        title: 'Creating diffset'
        subtitle:
            ('Package: ' , branch package asText allItalic ,
             ' Revision ' , revision asString).

    smalltalkMergeToolClass := Smalltalk classNamed:#'Tools::SmalltalkMergeTool'.

    (smalltalkMergeToolClass notNil
        and:[smalltalkMergeToolClass isLoaded]) not ifTrue:[ 
            Dialog warn: 'Merge is not possible. Tools::SmalltalkMergeTool class is not present'.
            ^ self.
    ].

    smalltalkMergeToolClass
        openOnDiffSet:diffSet
        labelA: 'Image'
        labelB: 'r',revision printString
        title: 'Merge ',pkg,' revision ',revision printString, ' into image'

    "Created: / 20-05-2008 / 23:44:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-08-2009 / 14:15:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionMergeImageWithRevisionHEAD

    self projectMenuSubversionMergeImageWithRevision: SVN::Revision head

    "Created: / 20-05-2008 / 23:44:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionRemoveWorkingCopy

    self selectedProjects value do:
	[:package|
	| pkg repo |
	pkg := self theSingleSelectedProject.
	repo := (SVN::RepositoryManager repositoryForPackage: pkg) .
	repo workingCopy path asFilename recursiveRemove]

    "Created: / 09-04-2009 / 13:19:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionShowRevisionLog

     | pkg branch revisionLog revision  |
    pkg := self theSingleSelectedProject.
    branch := (SVN::RepositoryManager repositoryForPackage: pkg) branch.
    revisionLog := branch log:'.'.
    revision := SVN::RevisionLogBrowser openOn: revisionLog.

    "Created: / 21-05-2008 / 09:37:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 21-10-2008 / 19:52:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'menu actions-subversion-project'!

projectMenuSubversionUpdate

    ^self projectMenuSubversionLoadRevision: SVN::Revision head

    "Created: / 22-10-2008 / 11:49:35 / Jan Vrany <vranyj1@fel.cvut.cz>"
    "Modified: / 09-04-2009 / 09:38:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser methodsFor:'private-helpers'!

selectedProjectSubversionRepository

    self selectedProjects value size ~= 1 ifTrue:[^nil].
    ^SVN::RepositoryManager repositoryForPackage: self selectedProjects value anyOne.

    "Created: / 19-04-2008 / 11:09:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!Tools::NewSystemBrowser class methodsFor:'menu specs - subversion'!

classMenuSubversion
    "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:#classMenuSubversion
     (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSubversion)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Commit'
            itemValue: classMenuSubversionCommit
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' commit 'Commit')
          )
         (MenuItem
            enabled: false
            label: 'Update'
            itemValue: classMenuSubversionUpdate
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' update 'Update')
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Compare with revision HEAD'
            itemValue: classMenuSubversionCompareImageWithRevisionHead
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare with revision HEAD')
          )
         (MenuItem
            label: 'Compare with revision'
            itemValue: classMenuSubversionCompareImageWithRevision
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare with revision')
          )
         )
        nil
        nil
      )
! !

!Tools::NewSystemBrowser class methodsFor:'menu specs - subversion'!

projectMenuSubversion
    "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:#projectMenuSubversion
     (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSubversion)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            enabled: false
            label: 'Branch'
            translateLabel: true
            submenuChannel: projectMenuSubversionBranches
            labelImage: (ResourceRetriever #'SVN::IconLibrary' checkout 'Branch')
            keepLinkedMenu: true
          )
         (MenuItem
            label: 'Commit'
            itemValue: projectMenuSubversionCommit
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' commit 'Commit')
          )
         (MenuItem
            label: 'Update'
            itemValue: projectMenuSubversionUpdate
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' update 'Update')
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Browse revision log'
            itemValue: projectMenuSubversionShowRevisionLog
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' log 'Browse revision log')
          )
         (MenuItem
            label: 'Browse working copy'
            itemValue: projectMenuSubversionBrowseWorkingCopy
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Compare with revision HEAD'
            itemValue: projectMenuSubversionCompareImageWithRevisionHEAD
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare with revision HEAD')
          )
         (MenuItem
            label: 'Compare with revision'
            itemValue: projectMenuSubversionCompareImageWithRevision
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' compare 'Compare with revision')
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Merge with revision HEAD'
            itemValue: projectMenuSubversionMergeImageWithRevisionHEAD
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' merge 'Merge with revision HEAD')
          )
         (MenuItem
            label: 'Merge with revision'
            itemValue: projectMenuSubversionMergeImageWithRevision
            translateLabel: true
            labelImage: (ResourceRetriever #'SVN::IconLibrary' merge 'Merge with revision')
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'More'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Load revision...'
                  itemValue: projectMenuSubversionLoadRevision
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Remove working copy'
                  itemValue: projectMenuSubversionRemoveWorkingCopy
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: hasSingleProjectSelected
                  label: 'Fast commit'
                  translateLabel: true
                  choice: projectMenuSubversionCommitMode
                  choiceValue: fast
                )
               (MenuItem
                  enabled: hasSingleProjectSelected
                  label: 'Full commit'
                  translateLabel: true
                  choice: projectMenuSubversionCommitMode
                  choiceValue: full
                )
               )
              nil
              nil
            )
          )
         )
        nil
        nil
      )
! !

!URL methodsFor:'queries'!

isValidSvnRepositoryUrl

    ^#('file' 'http' 'https' 'svn' 'svn+ssh')
	includes: self method

    "Created: / 16-08-2009 / 16:39:38 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!URL methodsFor:'printing & storing'!

printOn: aStream
    method notNil ifTrue: [
	aStream nextPutAll: method; nextPut: $:
    ].
    aStream nextPutAll: '//'.
    host notNil ifTrue: [
	aStream nextPutAll: host
    ].
    port notNil ifTrue: [
	aStream nextPut: $:; nextPutAll: port printString
    ].
    path notNil ifTrue: [
	aStream nextPutAll: path
    ].
    (otherPart notNil and: [self hasPostData not]) ifTrue:[
	self hasFragmentPart ifTrue: [
	    aStream nextPut: $#
	] ifFalse:[
	    aStream nextPut: $?
	].
	aStream nextPutAll: otherPart
    ].

    "Modified: / 19-08-2009 / 13:14:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !

!XML::NodeSet methodsFor:'navigation'!

@ attributeName
    "XPath like processing - if singleton set, answer an value of
    atribute named attributeName, error otherwise.
    This method is used in libsvn"

    self size = 1 ifTrue:[^self first @ attributeName].
    self error:'More than one element in node set'
! !