(FILECREATED "20-Feb-86 15:00:36" {QV}<NOTECARDS>1.3K>RHTPATCH030.;3
 12674  

      changes to:  (VARS RHTPATCH030COMS)
		   (FNS NC.PutMainCardData NC.PutNoteCard)

      previous date: "17-Feb-86 16:25:17" {QV}<NOTECARDS>1.3K>RHTPATCH030.;1)


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

(PRETTYCOMPRINT RHTPATCH030COMS)

(RPAQQ RHTPATCH030COMS
 ((* * Changes to NCDATABASE)
			  (FNS NC.PutMainCardData NC.FixUpLinksInCardCopy NC.FixUpBrowserCardCopy)
			  (* * New function for NCDATABASE)
			  (FNS NC.PutNoteCard)))
(* * Changes to NCDATABASE)


(DEFINEQ

(NC.PutMainCardData

  (LAMBDA (Card UpdateUpdateListFlg UseOldDateFlg OverrideStream)
                                                             (* rht: "20-Feb-86 10:06")


          (* * Write note card specified by ID to the database specified by Database stream)




          (* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use 

	  current date.)




          (* * rht 11/10/85: Updated to handle NoteFile and Card scheme.)




          (* * fgh 11/20/85 Added call to NC.WriteCardPartHeader and the mechanism to write the start and end pointers of the

	  substance before calling the card type's putfn.)




          (* * kirk 29Nov85 Renamed from NC.PutNoteCard)




          (* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)




          (* * fgh 2/5/86 Added call to NC.ApplyFn)




          (* * fgh 2/6/86 Added support for version numbers on the substance put fn.)




          (* * kirk 14Feb86 Merged above two changes)




          (* * rht 2/14/86: Fixed so call to NC.WriteCardType takes Stream as arg.)




          (* * rht 2/17/86: Fixed so calls to NC.WriteCardPartHeader and to NC.WriteRegion take Stream arg.)



    (WITH.MONITOR (
NC.FetchMonitor
 (fetch
 (Card NoteFile) of
 Card))
		  (LET ((Stream (
OR
 (
STREAMP
 OverrideStream)
				      (
NC.CoerceToNoteFileStream
 Card)))
			DataLoc CardType StartSubstanceLoc SubstanceVersion)

          (* * Record update date on update list if necessary.)



		       (
AND
 UpdateUpdateListFlg (
NC.UpdateUpdateList
 Card))

          (* * First write out the card part header)



		       (
SETFILEPTR
 Stream (
SETQ
 DataLoc (
GETEOFPTR
 Stream)))
		       (
NC.WriteCardPartHeader
 Card NC.ItemIdentifier (
COND

						   (UseOldDateFlg (
NC.FetchItemDate
 Card))
						   (T (
NC.SetItemDate
 Card (
DATE
))))
						 Stream)

          (* * write out the type and region)



		       (
NC.WriteCardType
 Stream (
SETQ
 CardType (
NC.RetrieveType
 Card)))
		       (
NC.WriteRegion
 Card Stream)

          (* * Write out the dummy length pointer for and version byte the actual substance)



		       (
SETQ
 StartSubstanceLoc (
GETFILEPTR
 Stream))
		       (NC.WritePtr Stream 0 4)

          (* * Write out the substance of the card.)



		       (
SETQ
 SubstanceVersion (NC.ApplyFn PutFn Card Stream))

          (* * Update the length pointer at beginning of substance Subtract four so that length is the length of the actual 

	  substance and doesn't include the length pointer and version byte maintained here. Also updated the version number 

	  returned by the put fn.)



		       (
SETFILEPTR
 Stream StartSubstanceLoc)
		       (NC.WritePtr Stream (
DIFFERENCE
 (
DIFFERENCE
 (
GETEOFPTR
 Stream)
								       StartSubstanceLoc)
							 4)
				    3)
		       (
SETQ
 SubstanceVersion (
OR
 SubstanceVersion 0))
		       (NC.WritePtr Stream SubstanceVersion 1)

          (* * Update the length field at the beginning of the card info)



		       (
SETFILEPTR
 Stream DataLoc)
		       (NC.WritePtr Stream (
DIFFERENCE
 (
GETEOFPTR
 Stream)
							 DataLoc)
				    3)
		       (
SETFILEPTR
 Stream -1)

          (* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for 

	  some reason.)




          (* * Only update if no OverrideStream.)



		       (if
 (
NOT
 (
STREAMP
 OverrideStream))
			   then
 (replace
 (Card Status) of
 Card with
 (
QUOTE
 ACTIVE))
				  (
NC.SetMainLoc
 Card DataLoc))
		   Card))))

(NC.FixUpLinksInCardCopy

  (LAMBDA (CardCopy CardHashArray LinksHashArray CurrentLinkLabels NewLinkLabels)
                                                             (* rht: "17-Feb-86 15:58")


          (* * For all the links from or to CardCopy, change other endpoint's card according to mapping table in 

	  CardHashArray. If other endpoint is a card not found in the hash array, then drop that link altogether.

	  The mapping from old link UIDs to new ones is in LinksHashArray. Any new link labels not in CurrentLinkLabels get 

	  TCONC'ed onto NewLinkLabels.)




          (* * rht 2/17/86: Now uses NC.ApplyFn instead of APPLY* for deleting and collecting references.)



    (LET ((CardCopyType (
NC.FetchType
 CardCopy)))

          (* * Fix all the From links.)



         (
NC.SetFromLinks
 CardCopy (for
 Link in
 (
NC.FetchFromLinks
 CardCopy) eachtime

										      (
BLOCK
)
					bind
 SourceCard OldLinkUID
					when
 (
SETQ
 SourceCard (
GETHASH
 (fetch
 (Link 
										       SourceCard)
										of
 Link)
									     CardHashArray))
					collect
 (replace
 (Link DestinationCard) of
 Link
						     with
 CardCopy)
						  (replace
 (Link SourceCard) of
 Link
						     with
 SourceCard)
						  (replace
 (Link UID) of
 Link
						     with
 (
OR
 (
GETHASH
 (
SETQ
 OldLinkUID
									       (fetch
 (Link UID)
										  of
 Link))
									     LinksHashArray)
								  (
PUTHASH
 OldLinkUID (
NC.MakeUID
)
									     LinksHashArray)))
                                                             (* Keep track of link labels in case any are new.)

						  (
OR
 (
FMEMB
 (
SETQ
 LinkLabel
								   (fetch
 (Link Label)
								      of
 Link))
								 CurrentLinkLabels)
							(
NC.SystemLinkLabelP
 LinkLabel)
							(
FMEMB
 LinkLabel (
CAR
 NewLinkLabels))
							(
TCONC
 NewLinkLabels LinkLabel))
						  Link))

          (* * Do it all again for the To links.)



         (
NC.SetToLinks
 CardCopy (for
 Link in
 (
NC.FetchToLinks
 CardCopy) eachtime
 (
BLOCK
)
				      bind
 DestCard OldLinkUID when
 (
SETQ
 DestCard
									  (
GETHASH

									    (fetch
 (Link 
										  DestinationCard)
									       of
 Link)
									    CardHashArray))
				      collect
 (replace
 (Link SourceCard) of
 Link with
 
											 CardCopy)
						(replace
 (Link DestinationCard) of
 Link
						   with
 DestCard)
						(replace
 (Link UID) of
 Link
						   with
 (
OR
 (
GETHASH
 (
SETQ
 OldLinkUID
									     (fetch
 (Link UID)
										of
 Link))
									   LinksHashArray)
								(
PUTHASH
 OldLinkUID (
NC.MakeUID
)
									   LinksHashArray)))
                                                             (* Keep track of link labels in case any are new.)

						(
OR
 (
FMEMB
 (
SETQ
 LinkLabel (fetch

								   (Link Label) of
 Link))
							       CurrentLinkLabels)
						      (
NC.SystemLinkLabelP
 LinkLabel)
						      (
FMEMB
 LinkLabel (
CAR
 NewLinkLabels))
						      (
TCONC
 NewLinkLabels LinkLabel))
						Link))

          (* * Now fix the links inside imageobj's in the card's substance.)



         (
AND
 (fetch
 (Card LinkAnchorModesSupported) of
 CardCopy)
		(for
 Link in
 (
CAR
 (NC.ApplyFn CollectLinksFn CardCopy))
		   do
 (if
 (
SETQ
 DestCard (
GETHASH
 (fetch
 (Link DestinationCard)
							     of
 Link)
							  CardHashArray))
			    then
 (replace
 (Link SourceCard) of
 Link with
 CardCopy)
				   (replace
 (Link DestinationCard) of
 Link with
 DestCard)
				   (replace
 (Link UID) of
 Link
				      with
 (
OR
 (
GETHASH
 (
SETQ
 OldLinkUID (fetch

								  (Link UID) of
 Link))
							      LinksHashArray)
						   (
PUTHASH
 OldLinkUID (
NC.MakeUID
)
							      LinksHashArray)))
                                                             (* Keep track of link labels in case any are new.)

				   (
OR
 (
FMEMB
 (
SETQ
 LinkLabel (fetch
 (Link Label)
								       of
 Link))
						  CurrentLinkLabels)
					 (
NC.SystemLinkLabelP
 LinkLabel)
					 (
FMEMB
 LinkLabel (
CAR
 NewLinkLabels))
					 (
TCONC
 NewLinkLabels LinkLabel))
			  else
 (NC.ApplyFn DeleteLinksFn CardCopy Link)))))))

(NC.FixUpBrowserCardCopy

  (LAMBDA (BrowserCard CardsHashArray)                       (* rht: "20-Feb-86 12:23")


          (* * Fix up the parts of the new browser card copy. Need to fix roots and graphnodes.)



    (LET ((Graph (
NC.FetchSubstance
 BrowserCard))
	  (GraphNodeIDHashArray (
HASHARRAY
 NC.CopyBrowserHashArraySize NIL (
FUNCTION
 
					       NC.MakeHashKey)
					     (
FUNCTION
 NC.SameUIDP))))

          (* * Fix up browser roots.)



         (
NC.SetBrowserRoots
 BrowserCard (for
 Card in
 (
NC.FetchBrowserRoots
 BrowserCard)
					      collect
 (
GETHASH
 Card CardsHashArray)))

          (* * Fix up graph nodes.)



         (for
 GraphNode in
 (fetch
 (GRAPH GRAPHNODES) of
 Graph) eachtime
 (
BLOCK
)
	    do
 (replace
 (GRAPHNODE NODEID) of
 GraphNode with
 (


								 
NC.BrowserCopyConvertGraphNodeID

								       (fetch
 (GRAPHNODE NODEID)
									  of
 GraphNode)
								       GraphNodeIDHashArray))
		 (replace
 (GRAPHNODE TONODES) of
 GraphNode
		    with
 (for
 NodeID in
 (fetch
 (GRAPHNODE TONODES) of
 GraphNode)
			      collect
 (if
 (
EQ
 (
CAR
 NodeID)
						    LINKPARAMS)
					    then
 (
RPLACA
 (
CDR
 NodeID)
							     (
NC.BrowserCopyConvertGraphNodeID

							       (
CADR
 NodeID)
							       GraphNodeIDHashArray))
						   (
AND
 (
LISTGET
 NodeID (
QUOTE
 NODEID))
							  (
LISTPUT
 NodeID (
QUOTE
 NODEID)
								     (


								 
NC.BrowserCopyConvertGraphNodeID

								       (
LISTGET
 NodeID
										  (
QUOTE
 NODEID))
								       GraphNodeIDHashArray)))
						   (
AND
 (
LISTGET
 NodeID (
QUOTE
 DESTNODEID))
							  (
LISTPUT
 NodeID (
QUOTE
 DESTNODEID)
								     (


								 
NC.BrowserCopyConvertGraphNodeID

								       (
LISTGET
 NodeID
										  (
QUOTE
 DESTNODEID)
										  )
								       GraphNodeIDHashArray)))
						   NodeID
					  else
 (
NC.BrowserCopyConvertGraphNodeID
 NodeID 
									     GraphNodeIDHashArray))))
		 (replace
 (GRAPHNODE FROMNODES) of
 GraphNode
		    with
 (for
 NodeID in
 (fetch
 (GRAPHNODE FROMNODES) of
 GraphNode)
			      collect
 (if
 (
EQ
 (
CAR
 NodeID)
						    LINKPARAMS)
					    then
 (
RPLACA
 (
CDR
 NodeID)
							     (
NC.BrowserCopyConvertGraphNodeID

							       (
CADR
 NodeID)
							       GraphNodeIDHashArray))
						   NodeID
					  else
 (
NC.BrowserCopyConvertGraphNodeID
 NodeID 
									     GraphNodeIDHashArray)))))

          (* * Fix up the saved linking info.)



         (for
 SavedLinkingInfoForNode in
 (
NC.FetchBrowserSavedLinkingInfo
 BrowserCard)
	    do
 (
RPLACA
 SavedLinkingInfoForNode (
NC.BrowserCopyConvertGraphNodeID
 (
CAR
 
									  SavedLinkingInfoForNode)
										       
									     GraphNodeIDHashArray))
		 (for
 SavedLinkingInfo on
 (
CDR
 SavedLinkingInfoForNode) by
 (
CDDR
 
										 SavedLinkingInfo)
		    do
 (
RPLACA
 SavedLinkingInfo (
NC.BrowserCopyConvertGraphNodeID
 (
CAR
 
										 SavedLinkingInfo)
											
									     GraphNodeIDHashArray)))))
    ))
)
(* * New function for NCDATABASE)


(DEFINEQ

(NC.PutNoteCard

  (LAMBDA (Card UpdateUpdateListFlg UseOldDateFlg)           (* rht: "17-Feb-86 16:11")


          (* * Put down each of the card's parts to its notefile.)



    (WITH.MONITOR (
NC.FetchMonitor
 (fetch
 (Card NoteFile) of
 Card))
		  (NC.PutMainCardData
 Card UpdateUpdateListFlg UseOldDateFlg)
		  (
NC.PutLinks
 Card UseOldDateFlg)
		  (
NC.PutTitle
 Card UseOldDateFlg)
		  (
NC.PutPropList
 Card UseOldDateFlg))))
)
(PUTPROPS RHTPATCH030 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (588 12077 (NC.PutMainCardData 598 . 4376) (NC.FixUpLinksInCardCopy 4378 . 8833) (
NC.FixUpBrowserCardCopy 8835 . 12075)) (12118 12592 (NC.PutNoteCard 12128 . 12590)))))
STOP