!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: gsclassdoc.gs,v 1.4 2008-01-09 22:50:11 stever Exp $
!
! Superclass Hierarchy:
!   GsClassDocumentation, Object.
!
!=========================================================================

!  Create the class if it does not already exist

expectvalue %String
run
  Object _newKernelSubclass: 'GsClassDocumentation'
    instVarNames: #('itsClass' 'gsObsolete' 'gsPrivate' 'classDoc'
                    'instVarDoc' 'classVarDoc' 'classInstVarDoc'
                    'poolVarDoc' 'categoryDoc' 'classCategoryDoc')
    classVars: #()
    classInstVars: #()
    poolDictionaries: #[]
    inDictionary: Globals
    constraints: #[ #[ #itsClass, Class],
                    #[ #gsObsolete, String],
                    #[ #gsPrivate, Boolean],
                    #[ #classDoc, GsDocText],
                    #[ #instVarDoc, SymbolDictionary],
                    #[ #classVarDoc, SymbolDictionary],
                    #[ #classInstVarDoc, SymbolDictionary],
                    #[ #poolVarDoc, SymbolDictionary],
                    #[ #categoryDoc, SymbolDictionary],
                    #[ #classCategoryDoc, SymbolDictionary]
                  ]
    instancesInvariant: false
    isModifiable: false
    reservedOop: 745
%

!========================================================================
!  Remove all existing behavior from the class

removeallmethods GsClassDocumentation
removeallclassmethods GsClassDocumentation

!========================================================================
!  Instance and class methods used only while creating the GemStone image.
!  These methods are not present in the final image.

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

| doc txt |

doc := GsClassDocumentation _newForPrivateGsClass: self.

txt := (GsDocText new) details:
'An instance of GsClassDocumentation retains and organizes textual information
 that documents the purpose, operation, and implementation of a class.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'The class that this instance documents.'.
doc documentInstVar: #itsClass with: txt.

txt := (GsDocText new) details:
'This variable is nil unless the class is an obsolete GemStone class.
 Otherwise, a String that holds the GemStone version number in which the class
 became obsolete.'.
doc documentInstVar: #gsObsolete with: txt.

txt := (GsDocText new) details:
'A Boolean that is true when the class that this instance documents
 implements only GemStone internals.  This means that the class is not
 intended for customer use, by creating instances or by subclassing.  It
 provides only functionality required by GemStone itself.'.
doc documentInstVar: #gsPrivate with: txt.

txt := (GsDocText new) details:
'A GsDocText that provides documentation about the class as a whole.'.
doc documentInstVar: #classDoc with: txt.

txt := (GsDocText new) details:
'A SymbolDictionary that organizes documentation for each of the class''s
 instance variables.  Each key is the name of an instance variable and each
 value is the GsDocText that documents it.'.
doc documentInstVar: #instVarDoc with: txt.

txt := (GsDocText new) details:
'A SymbolDictionary that organizes documentation for each of the class''s
 class variables.  Each key is the name of a class variable and each
 value is the GsDocText that documents it.'.
doc documentInstVar: #classVarDoc with: txt.

txt := (GsDocText new) details:
'A SymbolDictionary that organizes documentation for each of the class''s
 class instance variables.  Each key is the name of a class instance variable
 and each value is the GsDocText that documents it.'.
doc documentInstVar: #classInstVarDoc with: txt.

txt := (GsDocText new) details:
'A SymbolDictionary that organizes documentation for the class''s
 pool variables.  Each key is the name of a pool variable and each
 value is the GsDocText that documents it.'.
doc documentInstVar: #poolVarDoc with: txt.

txt := (GsDocText new) details:
'A SymbolDictionary that organizes documentation for the class''s
 instance method categories.  Each key is the name of a category and each
 value is the GsDocText that documents it.'.
doc documentInstVar: #categoryDoc with: txt.

txt := (GsDocText new) details:
'A SymbolDictionary that organizes documentation for the class''s
 class method categories.  Each key is the name of a category and each
 value is the GsDocText that documents it.'.
doc documentInstVar: #classCategoryDoc with: txt.

self description: doc.
%

!========================================================================
!  Class methods

category: 'Instance Creation'
classmethod: GsClassDocumentation
new

"Disallowed.  All instances of this class must initialize the
 itsClass instance variable.  Use newForClass: instead."

self shouldNotImplement: #new .
%

category: 'Instance Creation'
classmethod: GsClassDocumentation
newForClass: aClass

"Creates an object that documents a class."

| result |

result := super new.
result _initialize: aClass.

^ result
%

category: 'Private'
classmethod: GsClassDocumentation
_newForObsoleteGsClass: aClass asOfGsVersion: aString

"Private.  Only for use by GemStone."

"Creates an object that documents a GemStone class that is obsolete."

| result |

result := self newForClass: aClass.
result _markAsObsoleteGsClass: aString.

^ result
%

category: 'Private'
classmethod: GsClassDocumentation
_newForPrivateGsClass: aClass

"Private.  Only for use by GemStone."

"Creates an object that documents a GemStone class that is private."

| result |

result := self newForClass: aClass.
result _markAsPrivateGsClass.

^ result
%

category: 'Private'
classmethod: GsClassDocumentation
_newForObsoletePrivateGsClass: aClass asOfGsVersion: aString

"Private.  Only for use by GemStone."

"Creates an object that documents a GemStone private class that is obsolete."

| result |

result := self newForClass: aClass.
result _markAsPrivateGsClass.
result _markAsObsoleteGsClass: aString.

^ result
%

!========================================================================
!  Instance methods

category: 'Accessing'
method: GsClassDocumentation
itsClass

"Returns the class that the receiver documents."

^ itsClass
%

category: 'Accessing'
method: GsClassDocumentation
isGsPrivate

"Returns true when the class that the receiver documents implements only
 GemStone internals, and false otherwise.  Private means that the class is not
 intended for customer use, by creating instances or by subclassing.  It
 provides only functionality required by GemStone itself."

^ gsPrivate
%

category: 'Accessing'
method: GsClassDocumentation
isGsObsolete

"Returns true when the class that the receiver documents is obsolete."

(gsObsolete == nil) ifTrue: [ ^ false ].

^ true
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutClass

"Returns the CharacterCollection that contains detailed documentation about the
 class as a whole."

(classDoc == nil) ifTrue: [ ^ nil ].
^ (classDoc details)
%

category: 'Accessing'
method: GsClassDocumentation
instVarList

"Returns an Array of Symbols.  The Array contains an alphabetical list of the
 documented instance variable names of the class that is associated with the
 receiver."

^ (self _sortKeysFrom: instVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutInstVar: aSymbol

"Returns the CharacterCollection that contains detailed documentation about the
 instance variable named aSymbol."

^ (self _getDetailsAbout: aSymbol in: instVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
classVarList

"Returns an Array of Symbols.  The Array contains an alphabetical list of the
 documented class variable names of the class that is associated with the
 receiver."

^ (self _sortKeysFrom: classVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutClassVar: aSymbol

"Returns the CharacterCollection that contains detailed documentation about the
 class variable named aSymbol."

^ (self _getDetailsAbout: aSymbol in: classVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
classInstVarList

"Returns an Array of Symbols.  The Array contains an alphabetical list of the
 documented class instance variable names of the class that is associated with
 the receiver."

^ (self _sortKeysFrom: classInstVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutClassInstVar: aSymbol

"Returns the CharacterCollection that contains detailed documentation about the
 class instance variable named aSymbol."

^ (self _getDetailsAbout: aSymbol in: classInstVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
poolVarList

"Returns an Array of Symbols.  The Array contains an alphabetical list of the
 documented pool variable names of the class that is associated with the
 receiver."

^ (self _sortKeysFrom: poolVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutPoolVar: aSymbol

"Returns the CharacterCollection that contains detailed documentation about the
 pool variable named aSymbol."

^ (self _getDetailsAbout: aSymbol in: poolVarDoc)
%

category: 'Accessing'
method: GsClassDocumentation
categoryList

"Returns an Array of Symbols.  The Array contains an alphabetical list of the
 documented instance method categories of the class that is associated with the
 receiver."

^ (self _sortKeysFrom: categoryDoc)
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutCategory: aSymbol

"Returns the CharacterCollection that contains detailed documentation about the
 instance method category named aSymbol."

^ (self _getDetailsAbout: aSymbol in: categoryDoc)
%

category: 'Accessing'
method: GsClassDocumentation
classCategoryList

"Returns an Array of Symbols.  The Array contains an alphabetical list of the
 documented class method categories of the class that is associated with the
 receiver."

^ (self _sortKeysFrom: classCategoryDoc)
%

category: 'Accessing'
method: GsClassDocumentation
detailsAboutClassCategory: aSymbol

"Returns the CharacterCollection that contains detailed documentation about the
 class method category named aSymbol."

^ (self _getDetailsAbout: aSymbol in: classCategoryDoc)
%

category: 'Private'
method: GsClassDocumentation
_classDocDetailsDelimiter

""

^ ((String new) lf; lf; add: ' '; yourself)
%

category: 'Private'
method: GsClassDocumentation
_classDocDetailsObsolete

""

^ ((String withAll: 'The class ')
      add: (itsClass name);
      add: ' is obsolete as of GemStone version ';
      add: gsObsolete;
      add: ' and will be removed in a future release.  GemStone recommends';
      add: ' that you retire or migrate your instances in this release.';
      yourself
  )
%

category: 'Private'
method: GsClassDocumentation
_classDocDetailsPrivate

""

^ ((String withAll: 'The class ')
      add: (itsClass name);
      add: ' implements only GemStone internals.  That is, it provides only';
      add: ' functionality required by GemStone itself.  It is not intended';
      add: ' for customer use, by creating instances or by subclassing.';
      yourself
  )
%

category: 'Private'
method: GsClassDocumentation
_prependToGsClassDoc: aGsDocText

"Prepends appropriate text to the class documentation if the class is
 obsolete or private.  Only GemStone classes can be obsolete or private."

| detls str |

(self isGsObsolete)
  ifTrue:  [ str := self _classDocDetailsObsolete. ]
  ifFalse: [
    (self isGsPrivate)
      ifTrue:  [ str := self _classDocDetailsPrivate. ]
      ifFalse: [ ^ self ].
    ].

detls := aGsDocText details.
(detls == nil) ifFalse: [
  str add: (self _classDocDetailsDelimiter).
  str add: detls.
  ].
aGsDocText details: str.
%

category: 'Private'
method: GsClassDocumentation
_document: aSymbol in: aSymbolDict with: aGsDocText

""

(aGsDocText isKindOf: GsDocText)
  ifTrue: [ aSymbolDict at: aSymbol put: aGsDocText. ].
%

category: 'Private'
method: GsClassDocumentation
_getDetailsAbout: aSymbol in: aSymbolDict

""

| txt |

(aSymbolDict == nil) ifTrue: [ ^ nil  ].
txt := aSymbolDict at: aSymbol ifAbsent: [ ^ nil ].
(txt == nil) ifTrue: [ ^ nil ].

^ (txt details)
%

category: 'Private'
method: GsClassDocumentation
_sortKeysFrom: aSymbolDict

""

(aSymbolDict == nil) ifTrue: [ ^ (Array new) ].

^ ((aSymbolDict keys) sortAscending: '' )
%

category: 'Private'
method: GsClassDocumentation
_initialize: aClass

""

(itsClass == nil) ifTrue: [
  itsClass := aClass.
  gsPrivate := false.
  ].
%

category: 'Private'
method: GsClassDocumentation
_markAsObsoleteGsClass: theGsVersion

"Private.  Only for use by GemStone."

gsObsolete := theGsVersion.
%

category: 'Private'
method: GsClassDocumentation
_markAsPrivateGsClass

"Private.  Only for use by GemStone."

gsPrivate := true.
%

category: 'Updating'
method: GsClassDocumentation
documentClassWith: aGsDocText

"Documents the class that is associated with the receiver."

self _prependToGsClassDoc: aGsDocText.
classDoc := aGsDocText.
%

category: 'Updating'
method: GsClassDocumentation
documentInstVar: aSymbol with: aGsDocText

"Documents an instance variable named aSymbol."

(instVarDoc == nil) ifTrue: [ instVarDoc := SymbolDictionary new. ].
self _document: aSymbol in: instVarDoc with: aGsDocText.
%

category: 'Updating'
method: GsClassDocumentation
documentClassVar: aSymbol with: aGsDocText

"Documents a class variable named aSymbol."

(classVarDoc == nil) ifTrue: [ classVarDoc := SymbolDictionary new. ].
self _document: aSymbol in: classVarDoc with: aGsDocText.
%

category: 'Updating'
method: GsClassDocumentation
documentClassInstVar: aSymbol with: aGsDocText

"Documents a class instance variable named aSymbol."

(classInstVarDoc == nil) ifTrue: [
  classInstVarDoc := SymbolDictionary new.
  ].
self _document: aSymbol in: classInstVarDoc with: aGsDocText.
%

category: 'Updating'
method: GsClassDocumentation
documentPoolVar: aSymbol with: aGsDocText

"Documents a pool variable named aSymbol."

(poolVarDoc == nil) ifTrue: [ poolVarDoc := SymbolDictionary new. ].
self _document: aSymbol in: poolVarDoc with: aGsDocText.
%

category: 'Updating'
method: GsClassDocumentation
documentCategory: aSymbol with: aGsDocText

"Documents an instance method category named aSymbol."

(categoryDoc == nil) ifTrue: [ categoryDoc := SymbolDictionary new. ].
self _document: aSymbol in: categoryDoc with: aGsDocText.
%

category: 'Updating'
method: GsClassDocumentation
documentClassCategory: aSymbol with: aGsDocText

"Documents a class method category named aSymbol."

(classCategoryDoc == nil)
  ifTrue: [ classCategoryDoc := SymbolDictionary new. ].
self _document: aSymbol in: classCategoryDoc with: aGsDocText.
%

