(FILECREATED "19-Sep-85 15:29:18" {QV}<NOTECARDS>RELEASE1.2I>NCTYPESMECH.;2
 17908  

      changes to:  (FNS NC.AddCardType)

      previous date: " 1-Apr-85 15:31:44" {QV}<NOTECARDS>RELEASE1.2I>NCTYPESMECH.;1)


(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT NCTYPESMECHCOMS)

(RPAQQ NCTYPESMECHCOMS
 ((E (SETQ NC.SystemDate (DATE))
			   (UNMARKASCHANGED (QUOTE NC.SystemDate)
					    (QUOTE VARS)))
	(VARS NC.SystemDate)
	(P (UNMARKASCHANGED (QUOTE NC.SystemDate)
			    (QUOTE VARS)))
	(* * Internal variables)
	(GLOBALVARS NC.CardTypes NC.SubstanceTypes NC.NoteCardTypeMenu)
	(* * Note Cards Type Mechanism)
	(RECORDS NoteCardType SubstanceType)
	(MACROS NC.Inherit)
	(FNS NC.SubstanceCopyFn NC.MakeSubstanceTypesList NC.MakeCardTypesList NC.MarkCardDirtyFn 
	     NC.AddSubstanceType NC.AddCardType NC.ListOfCardTypes NC.CollectReferencesFn 
	     NC.DelReferencesFn NC.EditFn NC.GetSubstanceFn NC.MakeCardFn NC.PutSubstanceFn 
	     NC.QuitCardFn NC.UpdateLinkIconsFn NC.SubstanceDirtyPFn NC.SubstanceMarkDirtyFn)
	(FNS NC.DefaultCardWidth NC.DefaultCardHeight NC.DefaultHeightFromType 
	     NC.DefaultWidthFromType)
	(FNS NC.InsertLinkFn NC.TranslateWindowPositionFn)
	(P (NC.MakeSubstanceTypesList)
	   (NC.MakeCardTypesList))))

(RPAQQ NC.SystemDate
 "19-Sep-85 15:29:20")
(UNMARKASCHANGED (QUOTE NC.SystemDate)
		 (QUOTE VARS))
(* * Internal variables)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS NC.CardTypes NC.SubstanceTypes NC.NoteCardTypeMenu)
)
(* * Note Cards Type Mechanism)


[DECLARE: EVAL@COMPILE 

(RECORD NoteCardType
 (TypeName SuperType SubstanceType MakeCardFn EditCardFn QuitCardFn GetCardFn 
			       PutCardFn CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn 
			       DeleteLinksInCardFn UpdateLinkIconsInCardFn InsertLinkInCardFn 
			       TranslateWindowPositionToCardPositionFn LinkDisplayMode 
			       CardDefaultWidth CardDefaultHeight CardLinkAnchorModesSupported 
			       CardDisplayedInMenuFlg))

(RECORD SubstanceType
 (SubstanceName CreateSubstanceFn EditSubstanceFn QuitSubstanceFn GetSubstanceFn 
				     PutSubstanceFn CopySubstanceFn MarkSubstanceDirtyFn 
				     SubstanceDirtyPFn CollectLinksInSubstanceFn 
				     DeleteLinksInSubstanceFn UpdateLinkIconsInSubstanceFn 
				     InsertLinkInSubstanceFn 
				     TranslateWindowPositionToSubstancePositionFn 
				     SubstanceDefaultWidth SubstanceDefaultHeight 
				     SubstanceLinkAnchorModesSupported))
]
(DECLARE: EVAL@COMPILE 

(PUTPROPS NC.Inherit MACRO
 ((NC.Fn CardFn SubstanceFn CardTypeVariableName)
	   (
PROG
 (SaveCardType (AtomCardType (
COND

					       ((
NLISTP
 CardTypeVariableName)
						 CardTypeVariableName)
					       (T (
CAR
 CardTypeVariableName)))))
	         (
RETURN
 (
OR
 (for
 CardType in
 NC.CardTypes when
 (
EQ
 AtomCardType (fetch
 (NoteCardType
											  TypeName)
										    of
 CardType))
				do
 (
SETQ
 SaveCardType CardType)
				   (
RETURN
 (
OR
 (fetch
 (NoteCardType CardFn) of
 CardType)
					       (
AND
 (fetch
 (NoteCardType SuperType) of
 CardType)
						    (NC.Fn (
LIST
 (fetch
 (NoteCardType SuperType)
								    of
 CardType))))))
				finally
 (
NC.ReportError
 (
MKSTRING
 (
QUOTE
 NC.Fn))
							(
CONCAT
 "Unknown note card type:  " 
								NoteCardType ".")))
			     (
AND
 (
NLISTP
 CardTypeVariableName)
				  (fetch
 (SubstanceType SubstanceFn)
				     of
 (for
 SubstanceType in
 NC.SubstanceTypes
					   when
 (
EQ
 (fetch
 (NoteCardType SubstanceType) of
 
										     SaveCardType)
						    (fetch
 (SubstanceType SubstanceName)
						       of
 SubstanceType))
					   do
 (
RETURN
 SubstanceType)))))))))
)
(DEFINEQ

(NC.SubstanceCopyFn

  (LAMBDA (NoteCardType)                                     (* fgh: "19-Oct-84 11:57")


          (* * Return the function that does a byte-wise copy of NoteCardType substance from one stream to another.)



    (NC.Inherit NC.SubstanceCopyFn CopyCardFn CopySubstanceFn NoteCardType)))

(NC.MakeSubstanceTypesList

  (LAMBDA NIL                                                (* fgh: "12-Feb-85 23:18")


          (* * Make the initial list of substance types.)



    (
SETQ
 NC.SubstanceTypes NIL)
    (
QUOTE
 Done)))

(NC.MakeCardTypesList

  (LAMBDA NIL                                                (* fgh: "12-Feb-85 23:18")


          (* * Make initial set of card types.)



    (
SETQ
 NC.CardTypes (
LIST
 (create
 NoteCardType
				     TypeName ←(
QUOTE
 NoteCard)
				     SuperType ← NIL
				     SubstanceType ← NIL
				     MakeCardFn ← NIL
				     EditCardFn ← NIL
				     QuitCardFn ← NIL
				     GetCardFn ← NIL
				     PutCardFn ← NIL
				     CopyCardFn ← NIL
				     MarkCardDirtyFn ← NIL
				     CardDirtyPFn ← NIL
				     CollectLinksInCardFn ← NIL
				     DeleteLinksInCardFn ← NIL
				     UpdateLinkIconsInCardFn ← NIL
				     LinkDisplayMode ←(
QUOTE
 Icon)
				     CardDefaultWidth ← NIL
				     CardDefaultHeight ← NIL)))
    (
SETQ
 NC.NoteCardTypeMenu)))

(NC.MarkCardDirtyFn

  (LAMBDA (NoteCardType)                                     (* fgh: "22-Oct-84 12:41")


          (* * Return the fuinction that marks a card of type NoteCardType dirty.)



    (NC.Inherit NC.MarkCardDirtyFn MarkCardDirtyFn MarkSubstanceDirtyFn NoteCardType)))

(NC.AddSubstanceType

  (LAMBDA (SubstanceName FnsAssocList VarsAssocList)         (* fgh: "16-Feb-85 01:35")


          (* * Add a substance ttype to the lists of substance types.)



    (
PROG
 (NewType)
          (
COND

	    ((
NULL
 SubstanceName)
	      (
NC.ReportError
 "NC.AddSubstanceType" "Illegal substance type name: NIL")))

          (* * Remove old instance of SubstanceType)



          (for
 SubstanceType in
 NC.SubstanceTypes when
 (
EQ
 (fetch
 (SubstanceType SubstanceName)
							      of
 SubstanceType)
							   SubstanceName)
	     do
 (
SETQ
 NC.SubstanceTypes (
REMOVE
 SubstanceType NC.SubstanceTypes)))

          (* * Add new SubstanceType to NC.SubstanceTypes list)



          (
SETQ
 NC.SubstanceTypes (
CONS
 (
SETQ
 NewType (create
 SubstanceType
							      SubstanceName ← SubstanceName
							      CreateSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 CreateSubstanceFn)
								       FnsAssocList))
							      EditSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 EditSubstanceFn)
								       FnsAssocList))
							      QuitSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 QuitSubstanceFn)
								       FnsAssocList))
							      GetSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 GetSubstanceFn)
								       FnsAssocList))
							      PutSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 PutSubstanceFn)
								       FnsAssocList))
							      CopySubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 CopySubstanceFn)
								       FnsAssocList))
							      MarkSubstanceDirtyFn ←(
CADR

								(
ASSOC
 (
QUOTE
 MarkSubstanceDirtyFn)
								       FnsAssocList))
							      SubstanceDirtyPFn ←(
CADR

								(
ASSOC
 (
QUOTE
 SubstanceDirtyPFn)
								       FnsAssocList))
							      CollectLinksInSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 
									CollectLinksInSubstanceFn)
								       FnsAssocList))
							      DeleteLinksInSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 
									 DeleteLinksInSubstanceFn)
								       FnsAssocList))
							      UpdateLinkIconsInSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 
								     UpdateLinkIconsInSubstanceFn)
								       FnsAssocList))
							      InsertLinkInSubstanceFn ←(
CADR

								(
ASSOC
 (
QUOTE
 InsertLinkInSubstanceFn)
								       FnsAssocList))
							      
						     TranslateWindowPositionToSubstancePositionFn ←(


								
CADR
 (
ASSOC
 (
QUOTE
 
						     TranslateWindowPositionToSubstancePositionFn)
									    FnsAssocList))
							      SubstanceDefaultWidth ←(
CADR

								(
ASSOC
 (
QUOTE
 SubstanceDefaultWidth)
								       VarsAssocList))
							      SubstanceDefaultHeight ←(
CADR

								(
ASSOC
 (
QUOTE
 SubstanceDefaultHeight)
								       VarsAssocList))
							      SubstanceLinkAnchorModesSupported ←(


								
CADR
 (
ASSOC
 (
QUOTE
 
								SubstanceLinkAnchorModesSupported)
									    VarsAssocList))))
					NC.SubstanceTypes))
          (
RETURN
 NewType))))

(NC.AddCardType

  (LAMBDA (TypeName SuperType SubstanceType FnsAssocList VarsAssocList)
                                                             (* fgh: "17-Sep-85 12:26")


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



    (
PROG
 (NewType)
          (
COND

	    ((
NULL
 TypeName)
	      (
NC.ReportError
 "NC.AddCardType" "Illegal type name: NIL"))
	    ((for
 Type in
 NC.CardTypes never
 (
EQ
 (fetch
 (NoteCardType TypeName) of
 Type)
						 SuperType))
	      (
NC.ReportError
 "NC.AddCardType" (
CONCAT
 "Unknown type in super type field:  " 
						       SuperType)))
	    ((for
 Substance in
 NC.SubstanceTypes never
 (
EQ
 SubstanceType (fetch
 (SubstanceType 
										    SubstanceName)
									    of
 Substance)))
	      (
NC.ReportError
 "NC.AddCardType" (
CONCAT
 "Unknown substance type field:  " 
						       SubstanceType))))

          (* * Remove old instance of this NoteCardType)



          (for
 CardType in
 NC.CardTypes when
 (
EQ
 (fetch
 (NoteCardType TypeName) of
 CardType)
						 TypeName)
	     do
 (
SETQ
 NC.CardTypes (
REMOVE
 CardType NC.CardTypes)))

          (* * Create new NoteCardType)



          (
SETQ
 NC.CardTypes
	    (
NCONC1
 NC.CardTypes
		    (
SETQ
 NewType (create
 NoteCardType
					  TypeName ← TypeName
					  SuperType ← SuperType
					  SubstanceType ← SubstanceType
					  MakeCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 MakeCardFn)
								   FnsAssocList))
					  EditCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 EditCardFn)
								   FnsAssocList))
					  QuitCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 QuitCardFn)
								   FnsAssocList))
					  GetCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 GetCardFn)
								  FnsAssocList))
					  PutCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 PutCardFn)
								  FnsAssocList))
					  CopyCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 CopyCardFn)
								   FnsAssocList))
					  MarkCardDirtyFn ←(
CADR
 (
ASSOC
 (
QUOTE
 MarkCardDirtyFn)
									FnsAssocList))
					  CardDirtyPFn ←(
CADR
 (
ASSOC
 (
QUOTE
 CardDirtyPFn)
								     FnsAssocList))
					  CollectLinksInCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 
									     CollectLinksInCardFn)
									     FnsAssocList))
					  DeleteLinksInCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 
									      DeleteLinksInCardFn)
									    FnsAssocList))
					  UpdateLinkIconsInCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 
									  UpdateLinkIconsInCardFn)
										FnsAssocList))
					  InsertLinkInCardFn ←(
CADR
 (
ASSOC
 (
QUOTE
 InsertLinkInCardFn)
									   FnsAssocList))
					  TranslateWindowPositionToCardPositionFn ←(
CADR

					    (
ASSOC
 (
QUOTE
 TranslateWindowPositionToCardPositionFn)
						   FnsAssocList))
					  LinkDisplayMode ←(
CADR
 (
ASSOC
 (
QUOTE
 LinkDisplayMode)
									VarsAssocList))
					  CardDefaultHeight ←(
OR
 (
CADR
 (
ASSOC
 (
QUOTE
 
										CardDefaultHeight)
									      VarsAssocList))
								 (
CADR
 (
ASSOC
 (
QUOTE
 DefaultHeight)
									      VarsAssocList)))
					  CardDefaultWidth ←(
OR
 (
CADR
 (
ASSOC
 (
QUOTE
 CardDefaultWidth)
									     VarsAssocList))
								(
CADR
 (
ASSOC
 (
QUOTE
 DefaultWidth)
									     VarsAssocList)))
					  CardLinkAnchorModesSupported ←(
CADR
 (
ASSOC
 (
QUOTE
 
								     CardLinkAnchorModesSupported)
										     VarsAssocList))
					  CardDisplayedInMenuFlg ←(
CADR
 (
ASSOC
 (
QUOTE
 
									   CardDisplayedInMenuFlg)
									       VarsAssocList))))))
          (
SETQ
 NC.NoteCardTypeMenu)
          (
RETURN
 NewType))))

(NC.ListOfCardTypes

  (LAMBDA (ForMenuFlg)                                       (* fgh: " 1-Apr-85 11:50")


          (* * Return a list of the note card types)




          (* * Special processing for older types to make them not all caps.)



    (for
 CardType in
 NC.CardTypes when
 (
AND
 CardType (
OR
 (
NULL
 ForMenuFlg)
							 (fetch
 (NoteCardType CardDisplayedInMenuFlg)
							    of
 CardType)))
       collect
 (fetch
 (NoteCardType TypeName) of
 CardType))))

(NC.CollectReferencesFn

  (LAMBDA (NoteCardType)                                     (* fgh: "19-Oct-84 12:02")


          (* * Return the function that will collect the links in a substance of NoteCardType)



    (NC.Inherit NC.CollectReferencesFn CollectLinksInCardFn CollectLinksInSubstanceFn NoteCardType)))

(NC.DelReferencesFn

  (LAMBDA (NoteCardType)                                     (* fgh: "19-Oct-84 12:03")


          (* * Return the function that deletes references to a card from another card of a given type.)



    (NC.Inherit NC.DelReferencesFn DeleteLinksInCardFn DeleteLinksInSubstanceFn NoteCardType)))

(NC.EditFn

  (LAMBDA (NoteCardType)                                     (* fgh: "18-Oct-84 23:03")


          (* * Return the function to call the editor on substances of type NoteCardtype)



    (NC.Inherit NC.EditFn EditCardFn EditSubstanceFn NoteCardType)))

(NC.GetSubstanceFn

  (LAMBDA (NoteCardType)                                     (* fgh: "18-Oct-84 23:11")


          (* * Return the funcion for getting the substance of NoteCardType from a databasestream)



    (NC.Inherit NC.GetSubstanceFn GetCardFn GetSubstanceFn NoteCardType)))

(NC.MakeCardFn

  (LAMBDA (NoteCardType)                                     (* fgh: "19-Oct-84 11:48")


          (* * Return the function that will make a the type specific part of cards of NoteCardType.)



    (NC.Inherit NC.MakeCardFn MakeCardFn CreateSubstanceFn NoteCardType)))

(NC.PutSubstanceFn

  (LAMBDA (NoteCardType)                                     (* fgh: "19-Oct-84 16:20")


          (* * Return the Put Substance Fn for NoteCardType)



    (NC.Inherit NC.PutSubstanceFn PutCardFn PutSubstanceFn NoteCardType)))

(NC.QuitCardFn

  (LAMBDA (NoteCardType)                                     (* fgh: "22-Oct-84 12:31")


          (* * Return the function that foreces a note card of NoteCardType to quit or stop)



    (NC.Inherit NC.QuitCardFn QuitCardFn QuitSubstanceFn NoteCardType)))

(NC.UpdateLinkIconsFn

  (LAMBDA (NoteCardType)                                     (* fgh: "24-Oct-84 18:36")


          (* * Return the function for updating the link icons in a card of NoteCardType)



    (NC.Inherit NC.UpdateLinkIconsFn UpdateLinkIconsInCardFn UpdateLinkIconsInSubstanceFn 
		NoteCardType)))

(NC.SubstanceDirtyPFn

  (LAMBDA (NoteCardType)                                     (* fgh: "19-Oct-84 11:58")


          (* * Return the function that determines DirtyP for the substance of NoteCardType)



    (NC.Inherit NC.SubstanceDirtyPFn CardDirtyPFn SubstanceDirtyPFn NoteCardType)))

(NC.SubstanceMarkDirtyFn

  (LAMBDA (NoteCardType)                                     (* fgh: "12-Oct-84 23:12")


          (* * Return the function that marks a or unamrks card of NoteCardType dirty)



    (
COND

      ((NC.TeditBasedP NoteCardType)
	(
FUNCTION
 NC.MarkTextDirty))
      ((
NC.SketchBasedP
 NoteCardType)
	(
FUNCTION
 NC.MarkSketchDirty))
      ((
NC.GrapherBasedP
 NoteCardType)
	(
FUNCTION
 NC.MarkGraphDirty))
      (T (
NC.ReportError
 "NC.SubstanceMarkDirtyFn" (
CONCAT
 NoteCardType ":  Unknown note card type."))
	 ))))
)
(DEFINEQ

(NC.DefaultCardWidth

  (LAMBDA (ID)                                               (* fgh: " 4-Feb-85 23:27")


          (* * Determine the default width for card ID from its CardType)



    (
PROG
 ((Type (
NC.FetchType
 ID)))
          (
RETURN
 (NC.DefaultWidthFromType
 Type)))))

(NC.DefaultCardHeight

  (LAMBDA (ID)                                               (* fgh: " 4-Feb-85 23:28")


          (* * Determine the default height for card ID from its CardType)



    (
PROG
 ((Type (
NC.FetchType
 ID)))
          (
RETURN
 (NC.DefaultHeightFromType
 Type)))))

(NC.DefaultHeightFromType

  (LAMBDA (NoteCardType)                                     (* fgh: " 4-Feb-85 22:48")

    (NC.Inherit NC.DefaultHeightFromType CardDefaultHeight SubstanceDefaultHeight NoteCardType)))

(NC.DefaultWidthFromType

  (LAMBDA (NoteCardType)                                     (* fgh: " 4-Feb-85 22:49")

    (NC.Inherit NC.DefaultWidthFromType CardDefaultWidth SubstanceDefaultWidth NoteCardType)))
)
(DEFINEQ

(NC.InsertLinkFn

  (LAMBDA (NoteCardType)                                     (* fgh: "16-Feb-85 00:54")


          (* * Find the InsertLinkFn for NoteCardType)



    (NC.Inherit NC.InsertLinkFn InsertLinkInCardFn InsertLinkInSubstanceFn NoteCardType)))

(NC.TranslateWindowPositionFn

  (LAMBDA (NoteCardType)                                     (* fgh: "16-Feb-85 00:59")


          (* * Find the TrasnalteWindowPosition for NoteCardType)



    (NC.Inherit NC.TranslateWindowPositionFn TranslateWindowPositionToCardPositionFn 
		TranslateWindowPositionToSubstancePositionFn NoteCardType)))
)
(NC.MakeSubstanceTypesList)
(NC.MakeCardTypesList)
(PUTPROPS NCTYPESMECH COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3804 16081 (NC.SubstanceCopyFn 3814 . 4131) (NC.MakeSubstanceTypesList 4133 . 4380) (
NC.MakeCardTypesList 4382 . 5181) (NC.MarkCardDirtyFn 5183 . 5476) (NC.AddSubstanceType 5478 . 8588) (
NC.AddCardType 8590 . 12293) (NC.ListOfCardTypes 12295 . 12815) (NC.CollectReferencesFn 12817 . 13140)
 (NC.DelReferencesFn 13142 . 13465) (NC.EditFn 13467 . 13739) (NC.GetSubstanceFn 13741 . 14036) (
NC.MakeCardFn 14038 . 14332) (NC.PutSubstanceFn 14334 . 14591) (NC.QuitCardFn 14593 . 14876) (
NC.UpdateLinkIconsFn 14878 . 15201) (NC.SubstanceDirtyPFn 15203 . 15504) (NC.SubstanceMarkDirtyFn 
15506 . 16079)) (16082 17143 (NC.DefaultCardWidth 16092 . 16395) (NC.DefaultCardHeight 16397 . 16703) 
(NC.DefaultHeightFromType 16705 . 16924) (NC.DefaultWidthFromType 16926 . 17141)) (17144 17770 (
NC.InsertLinkFn 17154 . 17419) (NC.TranslateWindowPositionFn 17421 . 17768)))))
STOP