Tools__NavigationHistory.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Sun, 29 Jan 2012 12:53:39 +0000
branchjv
changeset 12123 4bde08cebd48
parent 10715 df89f53ca12e
child 12125 0c49a3b13e43
permissions -rw-r--r--
trunk branched into /branches/jv

"
 COPYRIGHT (c) 2006 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 }"

Object subclass:#NavigationHistory
	instanceVariableNames:'items position isGlobalHistory'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-History'
!

!NavigationHistory class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 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
"
    two variants:
        a forward-backward history, as in a browser:
            navigating backward moves a pointer in a list
        a global history
            navigating moves the navigated item to the front position

    hack: configurable to behave either as a global history
          or as a local-tab navigation history.
    Also implement backward compatible list-style acccess interface,
    to support old browsers (I guess, this is temporary and the other 
    users of the global history (debugger, old systembrowser etc. should
    be changed)
"
! !

!NavigationHistory class methodsFor:'instance creation'!

new
    ^ self basicNew initialize.

    "Created: / 21-02-2008 / 15:26:05 / janfrog"
! !

!NavigationHistory methodsFor:'accessing'!

currentItem

    ^(position between:1 and: items size) 
        ifTrue:[items at: position]
        ifFalse:[nil]

    "Created: / 27-02-2008 / 08:46:37 / janfrog"
!

currentItem: anObject

    self goTo: anObject

    "Created: / 27-02-2008 / 08:47:04 / janfrog"
!

goBackItems
    isGlobalHistory ifTrue:[^ items "isEmpty ifTrue:[items] ifFalse:[items copyFrom:2]"].

    ^ (items copyTo:position - 1) reverse

    "Created: / 27-02-2008 / 11:52:12 / janfrog"
    "Modified: / 05-07-2011 / 16:53:18 / cg"
!

goForwardItems
    isGlobalHistory ifTrue:[^ #()].

    ^ items copyFrom:position + 1

    "Created: / 27-02-2008 / 11:52:26 / janfrog"
    "Modified: / 03-07-2011 / 16:00:45 / cg"
! !

!NavigationHistory methodsFor:'backward list compatibility'!

addFirst:anEntry
    "backward compatible list protocol"

    items addFirst:anEntry.
    items size > 30 ifTrue:[
        items removeLast
    ].
    self changed: #value with: anEntry.

    "Created: / 03-07-2011 / 13:26:48 / cg"
!

collect:aBlock 
    "backward compatible list protocol"

    ^ items collect:aBlock

    "Created: / 04-07-2011 / 22:45:21 / cg"
!

collect:aBlock thenSelect:filter
    "backward compatible list protocol"

    ^ items collect:aBlock thenSelect:filter

    "Created: / 03-07-2011 / 13:34:14 / cg"
!

detect:aBlock ifNone:exeptionalValue
    "backward compatible list protocol"

    ^ items detect:aBlock ifNone:exeptionalValue

    "Created: / 03-07-2011 / 13:25:37 / cg"
!

isEmpty
    "backward compatible list protocol"

    ^ items isEmpty

    "Created: / 04-07-2011 / 22:44:54 / cg"
!

notEmpty
    "backward compatible list protocol"

    ^ items notEmpty

    "Created: / 04-07-2011 / 22:45:45 / cg"
!

removeIdentical:anEntry
    "backward compatible list protocol"

    items removeIdentical:anEntry.
    self changed: #value with:nil.

    "Created: / 03-07-2011 / 13:27:34 / cg"
!

reverseDo:aBlock
    "backward compatible list protocol"

    items reverseDo:aBlock

    "Created: / 04-07-2011 / 22:44:28 / cg"
! !

!NavigationHistory methodsFor:'initialization'!

beGlobalHistory
    isGlobalHistory := true

    "Created: / 03-07-2011 / 14:42:57 / cg"
!

initialize
    "Invoked when a new instance is created."

    "/ please change as required (and remove this comment)
    "/ items := nil.
    "/ position := nil.

    "/ super initialize.   -- commented since inherited method does nothing
    items := OrderedCollection new.
    position := 0.
    isGlobalHistory := false.

    "Created: / 21-02-2008 / 15:26:05 / janfrog"
    "Modified: / 03-07-2011 / 14:43:08 / cg"
! !

!NavigationHistory methodsFor:'menu & menu actions'!

goBackMenu
    |menu|

    menu := Menu new.
    self goBackItems do:[:item | 
        menu addItem:(MenuItem label:item displayString value:[ self goTo:item ])
    ].
    ^ menu

    "Created: / 22-02-2008 / 16:57:46 / janfrog"
    "Modified: / 27-02-2008 / 11:52:12 / janfrog"
!

goForwardMenu
    |menu|

    menu := Menu new.
    self goForwardItems do:[:item | 
        menu addItem:(MenuItem label:item displayString value:[ self goTo:item ])
    ].
    ^ menu

    "Created: / 22-02-2008 / 16:58:11 / janfrog"
    "Modified: / 27-02-2008 / 11:52:26 / janfrog"
! !

!NavigationHistory methodsFor:'navigation'!

goBack
    | value |

    isGlobalHistory ifTrue:[
        items size <= 1 ifTrue:[^ nil].
        ^ self goTo:(items second).
    ].

    position := (position - 1) max: 1.
    self changed: #currentItem with: (value := self currentItem).
    ^value

    "Created: / 21-02-2008 / 16:37:37 / janfrog"
    "Modified: / 27-02-2008 / 08:48:14 / janfrog"
    "Modified: / 03-07-2011 / 16:19:27 / cg"
!

goForward
    | value |

    position := (position + 1) min: items size.
    self changed: #currentItem with: (value := self currentItem).
    ^value

    "Created: / 21-02-2008 / 16:37:37 / janfrog"
    "Modified: / 27-02-2008 / 08:48:24 / janfrog"
!

goTo: navigationHistoryItem
    | idx |

    idx := items indexOf:navigationHistoryItem.
    isGlobalHistory ifTrue:[
        idx ~~ 0 ifTrue:[
            items removeIndex:idx.
        ].
        items addFirst:navigationHistoryItem.
    ] ifFalse:[
        idx == 0 ifFalse: [
            position := idx
        ] ifTrue:[
            position < items size ifTrue:[
                items removeFromIndex: position + 1 toIndex: items size
            ].
            items addLast: navigationHistoryItem.
            position := position + 1
        ].
    ].

    "/ for the canGoXXX apect.
    self changed: #value with: navigationHistoryItem.
    ^ navigationHistoryItem

    "Created: / 21-02-2008 / 16:40:39 / janfrog"
    "Modified: / 21-02-2008 / 19:12:35 / janfrog"
    "Modified: / 03-07-2011 / 16:03:11 / cg"
! !

!NavigationHistory methodsFor:'queries'!

canGoBack
    isGlobalHistory ifTrue:[
        ^ items size > 2
    ].

    ^ position > 1

    "Created: / 21-02-2008 / 16:40:48 / janfrog"
!

canGoForward

    ^position < items size

    "Created: / 21-02-2008 / 16:40:48 / janfrog"
! !

!NavigationHistory class methodsFor:'documentation'!

version_CVS
    ^ '§Header: /cvs/stx/stx/libtool/Tools__NavigationHistory.st,v 1.9 2011/07/05 15:45:36 cg Exp §'
!

version_CVS_jvrany
    ^ '§Header: /opt/data/cvs/stx/goodies/libtool3/Tools__NavigationHistory.st,v 1.2 2008-02-27 13:45:21 vranyj1 Exp §'
!

version_SVN
    ^ '$Id: Tools__NavigationHistory.st 7486 2009-10-26 22:06:24Z vranyj1 $'
! !