(FILECREATED "15-Jul-86 13:16:46" {QV}<NOTECARDS>1.3K>RHTPATCH073.;2
 4926   

      changes to:  (FNS NC.ModifyCardType NC.RecomputeCardType NC.AddCardType)
		   (VARS RHTPATCH073COMS)

      previous date: "15-Jul-86 11:54:00" {QV}<NOTECARDS>1.3K>RHTPATCH073.;1)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT RHTPATCH073COMS)

(RPAQQ RHTPATCH073COMS
 ((* * New functions for NCTYPESMECH)
			  (FNS NC.ModifyCardType NC.RecomputeCardType)
			  (* * Changes for NCTYPESMECH)
			  (FNS NC.AddCardType)))
(* * New functions for NCTYPESMECH)


(DEFINEQ

(NC.ModifyCardType

  (LAMBDA (TypeRecord FnsAssocList VarsAssocList)            (* rht: "15-Jul-86 13:13")


          (* * Changes the fields of the given type, inheriting other fields from the super and propagating changes downward.

	  This used to be the innards of NC.AddCardType.)



    (if
 (type?
 NoteCardType TypeRecord)
	then
 (LET ((MainFieldNames (
CONSTANT
 (for
 FieldName in
 (
RECORDFIELDNAMES

									 (
QUOTE
 NoteCardType))
						    when
 (
NEQ
 (
QUOTE
 InheritedFlg)
								  (
SUBATOM
 FieldName -12 -1))
						    collect
 FieldName))))
		    (for
 AssocPair in
 (
APPEND
 FnsAssocList VarsAssocList)
		       when
 (
FMEMB
 (
CAR
 AssocPair)
				       MainFieldNames)
		       do
 

          (* * Set the proper field to the given value)



			    (
RECORDACCESS
 (
BQUOTE
 (NoteCardType , (
CAR
 AssocPair)))
					    TypeRecord NIL (
QUOTE
 replace)
					    (
CADR
 AssocPair))

          (* * Set the corresponding InheritedFlg to indicate that this field is not inherited.)



			    (
RECORDACCESS
 (
BQUOTE
 (NoteCardType , (
PACK*
 (
CAR
 AssocPair)
									       (
QUOTE
 InheritedFlg))
								    ))
					    TypeRecord NIL (
QUOTE
 replace)
					    NIL)))

          (* * Inherit any NIL fields from super type record.)



	       (
AND
 (fetch
 (NoteCardType SuperType) of
 TypeRecord)
		      (
NC.InheritFieldsFromSuperType
 TypeRecord))

          (* * Propagate any changes downward to the subtypes of this type.)



	       (
NC.PropagateCardTypeFieldsDownward
 TypeRecord))))

(NC.RecomputeCardType

  (LAMBDA (TypeName FnsAssocList VarsAssocList)              (* rht: "15-Jul-86 13:16")


          (* * Recomputes an existing card type, changing those fields present on FnsAssocList and VarsAssocList.)



    (LET ((TypeRecord (
NC.CardTypeRecord
 TypeName)))
         (
COND

	   ((
NULL
 TypeRecord)
	     (
NC.ReportError
 "NC.RecomputeCardType" (
CONCAT
 "Unknown type: " TypeName)))
	   ((
AND
 (
NEQ
 TypeName (
QUOTE
 NoteCard))
		   (
NULL
 (
NC.CardTypeRecord
 (fetch
 (NoteCardType SuperType) of
 TypeRecord))))
	     (
NC.ReportError
 "NC.RecomputeCardType" (
CONCAT
 TypeName " has unknown super type:  " 
								SuperType))))

          (* * Compute fields, inheriting from above and propagating downward.)



         (NC.ModifyCardType
 TypeRecord FnsAssocList VarsAssocList)

          (* * reset the menu)



         (
SETQ
 NC.NoteCardTypeMenu)
     TypeName)))
)
(* * Changes for NCTYPESMECH)


(DEFINEQ

(NC.AddCardType

  (LAMBDA (TypeName SuperType FnsAssocList VarsAssocList)    (* rht: "15-Jul-86 13:16")


          (* * Create a new note card type and link it into the card type heirarchy.)




          (* * fgh 1/31/86 Updated to handle card type hash table.)




          (* * fgh 2/3/86 Updated to do inheritance at definition time rather than at access time.)




          (* * rht 7/15/86: Innards replaced by call to NC.ModifyCardType.)



    (LET (NewType (MainFieldNames (
CONSTANT
 (for
 FieldName in
 (
RECORDFIELDNAMES
 (
QUOTE

											  
										     NoteCardType))
						 when
 (
NEQ
 (
QUOTE
 InheritedFlg)
							       (
SUBATOM
 FieldName -12 -1))
						 collect
 FieldName))))
         (
COND

	   ((
NULL
 TypeName)
	     (
NC.ReportError
 "NC.AddCardType" "Illegal type name: NIL"))
	   ((
AND
 (
NEQ
 TypeName (
QUOTE
 NoteCard))
		   (
NULL
 (
NC.CardTypeRecord
 SuperType)))
	     (
NC.ReportError
 "NC.AddCardType" (
CONCAT
 "Unknown type in super type field:  " 
							  SuperType))))

          (* * Create new NoteCardType)



         (
SETQ
 NewType (create
 NoteCardType
				   TypeName ← TypeName
				   SuperType ← SuperType))

          (* * Compute fields, inheriting from above and propagating downward.)



         (NC.ModifyCardType
 NewType FnsAssocList VarsAssocList)

          (* * Stash the new card type record, reset the menu and then return.)



         (
PUTHASH
 TypeName NewType NC.CardTypes)
         (
SETQ
 NC.NoteCardTypeMenu)
     NewType)))
)
(PUTPROPS RHTPATCH073 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (592 3202 (NC.ModifyCardType 602 . 2241) (NC.RecomputeCardType 2243 . 3200)) (3239 4844 
(NC.AddCardType 3249 . 4842)))))
STOP