"

stx:libscm - a new source code management library for Smalltalk/X

Copyright (C) 2012-2015 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

"{ Package: 'stx:libscm/mercurial' }"

"{ NameSpace: Smalltalk }"

HGRepositoryObject subclass:#HGConfig

	instanceVariableNames:'root timestamp'

	classVariableNames:'UserConfig'

	poolDictionaries:''

	category:'SCM-Mercurial-Core'

!

Object subclass:#Entry

	instanceVariableNames:'name value'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGConfig

!

Dictionary subclass:#Section

	instanceVariableNames:'name'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGConfig

!

!HGConfig class methodsFor:'documentation'!

copyright

"

stx:libscm - a new source code management library for Smalltalk/X

Copyright (C) 2012-2015 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

! !

!HGConfig class methodsFor:'accessing'!

userConfig

    UserConfig isNil ifTrue:[ 

        UserConfig := self new.

    ].

    ^ UserConfig

    "

    (HGConfig userConfig get:'ui') get:'username'

    "

    "Created: / 18-02-2014 / 11:14:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig class methodsFor:'accessing-file templates'!

userConfigFileTemplate

    ^

'[ui]

# At least, a username is required to commit.

username = FirstName LastName <Email>

'

! !

!HGConfig class methodsFor:'accessing-files'!

userConfigFile

    "Return user config file"

    | files |

    files := self userConfigFiles.

    ^ files detect:[:e | e asFilename exists ] ifNone:[ files first ].

    "Created: / 18-02-2014 / 10:33:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

userConfigFiles

    "Return a list of per-user config files"

    OperatingSystem isMSWINDOWSlike ifTrue:[

        ^{

            Filename homeDirectory / '.hgrc' .

            Filename homeDirectory / 'Mercurial.ini'

        }

    ].

    OperatingSystem isUNIXlike ifTrue:[

        ^{

            Filename homeDirectory / '.hgrc' .

        }

    ].

    self error:'Unsupported operating system'

    "Created: / 06-12-2012 / 20:30:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 06-12-2012 / 21:34:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig methodsFor:'accessing'!

at: key

    ^self root at:key

    "Created: / 06-12-2012 / 20:22:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

at: key ifAbsent: block

    ^self root at:key ifAbsent: block

    "Created: / 06-12-2012 / 20:23:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

at: key ifAbsentPut: block

    ^self root at:key ifAbsentPut: block

    "Created: / 06-12-2012 / 20:23:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

at: key put: val

    ^self root at:key put: val

    "Created: / 06-12-2012 / 20:23:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

get: key

    ^self root get:key

    "Created: / 06-12-2012 / 20:22:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

get: key default: default

    ^self root get:key default: default

    "Created: / 07-12-2012 / 15:46:07 / jv"

! !

!HGConfig methodsFor:'accessing-common values'!

ui_username

    ^ self get:#(ui username) default: nil.

    "

    HGConfig userConfig ui_username

    "

    "Created: / 18-02-2014 / 11:24:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig methodsFor:'private'!

mustReload

    root isNil ifTrue:[ ^ true ].

    repository notNil ifTrue:[

        (self mustReloadBecauseOf: repository path / '.hg' / 'hgrc') ifTrue:[

            ^true

        ].

    ].

    HGConfig userConfigFiles do:[:e|

        (self mustReloadBecauseOf: e) ifTrue:[ ^ true ].

    ].

    ^false

    "Created: / 06-12-2012 / 21:38:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-12-2012 / 16:28:33 / jv"

    "Modified: / 18-02-2014 / 11:20:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mustReloadBecauseOf: filenameOrString

    "Return true, if config must be reloaded because file is newer"

    | filename |

    filename := filenameOrString asFilename.

    "/compensate for lack of milliseconds in OS time ---v

    ^filename exists and:[(filename modificationTime + 1000) >= timestamp].

    "Created: / 07-12-2012 / 16:26:38 / jv"

    "Modified: / 18-02-2014 / 12:33:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

root

    self mustReload ifTrue:[

        | command |    

        timestamp := Timestamp now.

        command :=HGCommand showconfig.

        repository notNil ifTrue:[

            command workingDirectory: repository pathName.

        ].

        root := command execute.

    ].

    ^root

    "Created: / 06-12-2012 / 20:25:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-02-2014 / 11:16:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig::Entry methodsFor:'accessing'!

name

    ^ name

!

value

    ^ value

! !

!HGConfig::Entry methodsFor:'initialization'!

setName: nm value: val

    name := nm.

    value := val.

    "Created: / 06-12-2012 / 19:29:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig::Entry methodsFor:'testing'!

isEntry

    ^true

    "Created: / 06-12-2012 / 19:36:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

isSection

    ^false

    "Created: / 06-12-2012 / 19:36:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig::Section methodsFor:'accessing'!

get: key

    | entry |

    entry := self.

    (key isCollection and:[key isString not]) ifTrue:[

        key do:[:e|entry := entry at: e]

    ] ifFalse:[

        entry := entry at:key.

    ].

    ^entry value

    "Created: / 06-12-2012 / 20:01:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-12-2012 / 21:48:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

get: key default: default

    | entry |

    entry := self.

    (key isCollection and:[key isString not]) ifTrue:[

        key do:[:e|entry := entry at: e ifAbsent:[ ^ default ]]

    ] ifFalse:[

        entry := entry at:key ifAbsent:[ ^ default ].

    ].

    ^entry value

    "Created: / 06-12-2012 / 20:07:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-12-2012 / 21:49:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

name

    ^ name

! !

!HGConfig::Section methodsFor:'initialization'!

setName: nm 

    name := nm.

    "Created: / 06-12-2012 / 19:57:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-02-2014 / 12:31:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig::Section methodsFor:'testing'!

isEntry

    ^false

    "Created: / 06-12-2012 / 19:36:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

isSection

    ^true

    "Created: / 06-12-2012 / 19:36:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGConfig class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

!

version_HG

    ^ '$Changeset: <not expanded> $'

! !