!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: classhistory.gs,v 1.8 2008-01-09 22:50:09 stever Exp $
!
! Superclass Hierarchy:
!   ClassHistory, Array, SequenceableCollection, Collection, Object.
!
!=========================================================================

removeallmethods ClassHistory
removeallclassmethods ClassHistory

category: 'For Documentation Installation only'
classmethod: ClassHistory
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'A ClassHistory is a sequence of Class objects that logically represent the
 historical revisions to a Class.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'A textual description of the function of the Class.'.
doc documentInstVar: #description with: txt.

txt := (GsDocText new) details:
'The class history''s name for itself; a Symbol of up to 64 Characters.'.
doc documentInstVar: #name with: txt.

self description: doc.
%

category: 'Instance Creation'
classmethod: ClassHistory
new

"Create a new ClassHistory."

| result |
result := super new .
result _setNoStubbing  .
^ result
%
category: 'Instance Creation'
classmethod
new: anInt

"Disallowed"

self shouldNotImplement: #new: .
self _uncontinuableError
%
category: 'Instance Creation'
classmethod
with: anObj

"Disallowed"

self shouldNotImplement: #with: .
self _uncontinuableError
%
category: 'Instance Creation'
classmethod
with: anObj with: obj2

"Disallowed"

self shouldNotImplement: #with:with: .
self _uncontinuableError
%
category: 'Instance Creation'
classmethod
with: anObj with: obj2 with: obj3

"Disallowed"

self shouldNotImplement: #with:with:with: .
self _uncontinuableError
%
category: 'Instance Creation'
classmethod
with: anObj with: obj2 with: obj3 with: obj4

"Disallowed"

self shouldNotImplement: #with:with:with:with: .
self _uncontinuableError
%
category: 'Instance Creation'
classmethod
withAll: aCollection

"Disallowed"

self shouldNotImplement: #withAll: .
self _uncontinuableError
%

category: 'Accessing'
method: ClassHistory
at: aTimeOrIndex

"Returns the Class that was current at the given time.  The time may be
 specified absolutely using a DateTime, or relatively using an integer.  If a
 DateTime is specified, returns the version of the class that was active at
 that time, or nil if the time is before the earliest version.

 If an Integer is specified, it is used to chronologically select the
 version, with 1 indicating the first version created, 2 the version, and so on.
 If the index is less than one or greater than the number of versions in
 the history, an error is generated."

| candidate aClass|

(aTimeOrIndex class == DateTime)
  ifFalse: [ ^ super at: aTimeOrIndex ]
  ifTrue: [
    "candidate is initially nil.  Iterate through the history from
    the beginning.  If the entry's time is before the specified time,
    it is possibly the class that was active so save it as the best
    candidate.  If the entry's time is after the specified time, it
    cannot be the answer and no subsequent ones can be, so returns the
    current candidate."

    1 to: self size do: [ :j |
      aClass := self at: j.
      (aClass timeStamp <= aTimeOrIndex)
        ifTrue: [ candidate := aClass ]
        ifFalse: [ ^ candidate ].
    ].
    ^ candidate
  ]
%

category: 'Accessing'
method: ClassHistory
current

"Returns the current, or most recent class."

^ super at: self size
%

category: 'Accessing'
method: ClassHistory
description

"Returns the description of this ClassHistory."

^ description
%

category: 'Accessing'
method: ClassHistory
name

"Returns the name of this ClassHistory."

^ name
%

category: 'Updating'
method: ClassHistory
description: aString

"Updates the description of this ClassHistory."

description := aString
%

category: 'Updating'
method: ClassHistory
name: aString

"Updates the name of this ClassHistory."

name := aString asString asSymbol
%

category: 'Accessing'
method: ClassHistory
currentVersion

"Returns the most recent version in the receiver's collection of versions."

| sz |
(sz := self size) = 0 ifTrue: [ ^nil ].
^self at: sz
%

category: 'Updating'
method: ClassHistory
newVersion: aClass

"Installs the given class as the receiver's most current version.  Does not
 install the receiver in the given class as its version history.
 Returns the class object.  

 Generates an error if the receiver's basicSize would exceed 2034 "

| currSize idxSize |
currSize := self basicSize .
currSize >= 2034 ifTrue:[   "virtual machine constant"
  "VM restriction, classHistory cannot be a large object" 
  idxSize := self size .
  self _error: #objErrMaxSize args:#[ idxSize, idxSize + 1 ].
  self _uncontinuableError
  ] 
ifFalse:[ 
  ^ self add: aClass 
  ]
%

category: 'Updating'
method: ClassHistory
removeVersion: aClass

"Removes the given class from the receiver's list of versions."

| idx |
idx := self indexOf: aClass.
idx > 0 ifTrue: [
  self removeFrom: idx to: idx
].
%

category: 'Updating
classmethod: ClassHistory
unifyClassHistories: anArrayOfClasses

"Creates a new instance of the receiver containing all classes in
 the argument, and modifies each class in the argument to have the
 new ClassHistory as its classHistory.

 Generates an error if the new instances' basicSize would exceed 2034.

 Generates an error and does not modify any class if any element of
 the argument is not a Class."

| hist idxSize |
anArrayOfClasses do:[ :aClass | aClass validateIsClass ] .
hist := self withAll: anArrayOfClasses .
hist basicSize > 2034 ifTrue:[ "virtual machine constant"
  "VM restriction, classHistory cannot be a large object"
  idxSize := hist size .
  self _error: #objErrMaxSize args:#[ idxSize, idxSize + 1 ].
  self _uncontinuableError .
  ^ nil
  ].
anArrayOfClasses do:[ :aClass | aClass classHistory: hist ].
^ hist
%

! fix 33479
category: 'Class Membership'
method: ClassHistory
species

"Returns a class similar to, or the same as, the receiver's class which
 can be used for containing derived copies of the receiver."

^ Array
%
