(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