(FILECREATED "25-Nov-85 13:06:39" {QV}<NOTECARDS>1.3K>RHTPATCH008.;4 24970
changes to: (FNS NC.ScavengeDatabaseFile NC.ReadIdentifier)
(VARS RHTPATCH008COMS)
previous date: "23-Nov-85 18:38:17" {QV}<NOTECARDS>1.3K>RHTPATCH008.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH008COMS)
(RPAQQ RHTPATCH008COMS ((* * Redefined functions from NCREPAIR)
(FNS NC.ScavengeDatabaseFile NC.CollectAndCheckLinks)
(* * Bug fixes to two functions in NCLINKS)
(FNS NC.InsertLinkBeforeMarker NC.AddGlobalLinksToCard)
(* * Fixes to functions and Identifier vars in NCDATABASE)
(FNS NC.WriteIdentifier NC.ReadIdentifier)
(VARS (NC.LinksIdentifier (QUOTE ###LINKS#))
(NC.ItemIdentifier (QUOTE ###ITEM#))
(NC.PropsIdentifier (QUOTE ###PROPS#))
(NC.TitlesIdentifier (QUOTE ###TITLES#)))))
(* * Redefined functions from NCREPAIR)
(DEFINEQ
(NC.ScavengeDatabaseFile
(LAMBDA (NoteFileOrFileName BadLinkLabelsFlg ListOfCardsToReconstruct
ListOfGlobalLinksToReconstruct)
(* rht: "25-Nov-85 13:04")
(* Scavenge the database FileName. Essentially throw away all of the information about From and ToLinks and
recreate them by retrieving the link information from the substance of each card and from the list of global links
from the card.)
(* * rht 8/9/84: Now calls NC.OpenDatabaseFile to do the file open.)
(* * rht 7/17/85: Changed so can take a stream argument. Also handles link labels. If BadLinkLabelsFlg is non-nil,
then don't try to read current link labels. Just rebuild them from what's out there. Otherwise, only rebuild if
find new any new ones.)
(* * fgh 22-Jul-85 Takes a list of bad file box cards and reconstructs the file boxes from the From pointer lists
of all the cards in the NoteFile.)
(* * fgh 30-Jul-85 Takes a list of cards with bad global links and reconstructs the global links list from the From
pointer lists of all the cards in the NoteFile.)
(* * rht 11/23/85: Updated to handle new notefile and card object formats.)
(PROG ((ListOfValidCards (LIST (QUOTE **Header**)))
(NoteCardNumber 0)
NoteFile FileName OldLinkLabels DiscoveredLinkLabels FromLinks ToLinks Stream
HashArraySize Status ID Links Entry FullName CardTotal GlobalLinks ActiveCardsList
ReconstructLinks ReconstructGlobalLinks ThisCardsToLinks ThisCardsGlobalLinks
ToBeFiledCards)
(* * First, take care of checking stream's validity, etc.)
(SETQ FileName (if (type? NoteFile NoteFileOrFileName)
then (SETQ NoteFile NoteFileOrFileName)
(fetch (NoteFile FullFileName) of NoteFileOrFileName)
else NoteFileOrFileName))
(if (OPENP FileName)
then (NC.PrintMsg NIL T FileName " is an already open file." (CHARACTER 13))
(RETURN NIL)) (* Try to open notefile.)
(if (NULL (SETQ NoteFile (NC.OpenDatabaseFile FileName NIL T NIL NIL NIL NIL NIL
T)))
then (NC.PrintMsg NIL NIL "Couldn't open " FileName "." (CHARACTER 13)
"Repair aborted."
(CHARACTER 13))
(RETURN NIL))
(* * If link labels aren't screwed up, then read them in.)
(OR BadLinkLabelsFlg (SETQ OldLinkLabels (NC.RetrieveLinkLabels NoteFile T)))
(* Read through all NoteCard substances to find actual pointers. Use this to create the To Links list.
The list collection function checks to make sure each link is valid.)
(SETQ HashArraySize (fetch (NoteFile HashArraySize)
NoteFile))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER 13)
"Collecting Links for item " 1 " out of " HashArraySize "." (CHARACTER
13))
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(SETQ NoteCardNumber (ADD1 NoteCardNumber))
(AND (ZEROP (REMAINDER HashArraySize NoteCardNumber))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER
13)
"Collecting Links for item " NoteCardNumber
" out of "
HashArraySize "." (CHARACTER 13)))
(COND
((for CardToReconstruct in ListOfCardsToReconstruct
never (NC.SameCardP Card CardToReconstruct))
(NC.GetNoteCard Card)
(SETQ Status (fetch (Card Status) of Card))
(COND
((EQ Status (QUOTE ACTIVE))
(push ActiveCardsList Card)
(AND (for ValidCard in ListOfValidCards
never (NC.SameCardP Card ValidCard))
(push ListOfValidCards Card))
(SETQ Links (NC.CollectAndCheckLinks Card NoteFile
ListOfValidCards))
(push ToLinks (CONS Card Links))
(push GlobalLinks (CONS Card (NC.FetchGlobalLinks Card)))
(* If there are file boxes to be reconstructed, then look thru the From links to see if this card was filed in one
of the to-be-reconstructed boxes)
(AND ListOfCardsToReconstruct
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK)
when (for CardToReconstruct in
ListOfCardsToReconstruct
bind SourceCard ←(fetch (Link
SourceCard)
of Link)
thereis (NC.SameCardP SourceCard
CardToReconstruct))
do (push ReconstructLinks Link)))
(* If there are global links to be reconstructed, then look thru the From links to see if this card had a global
link to a card whose global links need reconstructing.)
(AND ListOfGlobalLinksToReconstruct
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK)
when (AND (NC.GlobalLinkP Link)
(for CardToReconstruct in
ListOfGlobalLinksToReconstruct
bind SourceCard ←(fetch
(Link SourceCard)
of Link)
thereis (NC.SameCardP
SourceCard
CardToReconstruct)))
do (push ReconstructGlobalLinks Link)))
(NC.DeactivateCard Card T))))
(T (NC.GetLinks Card)
(push GlobalLinks (CONS Card (NC.FetchGlobalLinks Card)))
(push ToLinks (CONS Card (NC.FetchGlobalLinks Card)))
(NC.DeactivateCard Card T))))))
(* * Reconstruct any cards as requested)
(for CardToReconstruct in ListOfCardsToReconstruct eachtime (BLOCK)
do (* Make a new file box using the given card.)
(NC.MakeNoteCard (QUOTE FileBox)
NoteFile "Untitled: Reconstructed during repair" T NIL
CardToReconstruct) (* File cards whose from links indicate that they used
to be filed in this file box)
(SETQ Links (for Link in ReconstructLinks bind DestCard eachtime
(BLOCK)
when (AND (NC.SameCardP CardToReconstruct
(fetch (Link SourceCard)
of Link))
(OR (NC.ContentsLinkP Link)
(NC.SubContentsLinkP Link)))
collect (NC.FileBoxCollectChildren
(NC.FetchSubstance CardToReconstruct)
CardToReconstruct
(LIST (SETQ DestCard (fetch (Link
DestinationCard)
of Link)))
T)
(* * rht 9/20/85: Have to find link just created in the ToLinks of filebox, so we can be sure that LinkID matches.
This is ugly to have to do this search every time!)
(create Link
copying (for CardLink in (NCP.GetLinks
CardToReconstruct)
eachtime (BLOCK)
when (NC.SameCardP
DestCard
(fetch (Link
DestinationCard)
of CardLink))
do (RETURN CardLink)))))
(* Add the new links to the collected links list)
(COND
((SETQ ThisCardsToLinks (for CardLinkPair in ToLinks eachtime (BLOCK)
when (NC.SameCardP (CAR CardLinkPair)
CardToReconstruct)
do (RETURN CardLinkPair)))
(NCONC ThisCardsToLinks Links))
(T (push ToLinks (CONS CardToReconstruct Links))))
(push ActiveCardsList CardToReconstruct)
(* Put the card away)
(NC.PutNoteCard CardToReconstruct)
(NC.DeactivateCard CardToReconstruct T))
(* * Reconstruct any global link lists as required)
(for Link in ReconstructGlobalLinks eachtime (BLOCK)
do (* Add it to the GlobalLinks list)
(COND
((SETQ ThisCardsGlobalLinks (for CardAndGlobalLink in GlobalLinks
when (NC.SameCardP (fetch (Link
SourceCard)
of Link)
(CAR
CardAndGlobalLink))
do (RETURN CardAndGlobalLink)))
(COND
((for GlobalLink in ThisCardsGlobalLinks eachtime (BLOCK)
never (NC.SameLinkP Link GlobalLink))
(COND
((CADR ThisCardsGlobalLinks)
(* were there global links before?)
(NCONC1 ThisCardsGlobalLinks Link))
(T (RPLACD ThisCardsGlobalLinks (LIST Link)))))))
(T (push GlobalLinks (CONS (fetch (Link SourceCard) of Link)
(LIST Link)))))
(* Add it to the ToLinks list if its not already
there)
(COND
((SETQ ThisCardsToLinks (for CardAndLinks in ToLinks
when (NC.SameCardP (fetch (Link SourceCard)
of Link)
(CAR CardAndLinks))
do (RETURN CardAndLinks)))
(COND
((for ToLink in ThisCardsToLinks eachtime (BLOCK)
never (NC.SameLinkP Link ToLink))
(COND
((CADR ThisCardsToLinks)
(NCONC1 ThisCardsToLinks Link))
(T (RPLACD ThisCardsToLinks (LIST Link)))))))
(T (SETQ ToLinks (CONS (CONS (fetch (Link SourceCard) of Link)
(LIST Link))
ToLinks)))))
(* * Compute the From Links list by "inverting" the To Links list)
(NC.PrintMsg NIL T "Processing Links ... ")
(for Item in ToLinks eachtime (BLOCK)
do (for Link in (CDR Item) bind LinkLabel eachtime (BLOCK)
do (SETQ Entry (for CardAndLinks in FromLinks
when (NC.SameCardP (fetch (Link DestinationCard)
of Link)
(CAR CardAndLinks))
do (RETURN CardAndLinks)))
(COND
(Entry (NCONC1 Entry Link))
(T (push FromLinks (LIST (fetch (Link DestinationCard)
of Link)
Link))))
(* Accumulate the link labels into a list.)
(COND
((NOT (FMEMB (SETQ LinkLabel (fetch (Link Label) of Link))
DiscoveredLinkLabels))
(push DiscoveredLinkLabels LinkLabel)))))
(* Reset all of the To and From Links lists in the
database)
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " 1 " out of " HashArraySize "." (CHARACTER
13))
(SETQ NoteCardNumber 0)
(NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
(SETQ NoteCardNumber (ADD1 NoteCardNumber))
(AND (ZEROP (REMAINDER NoteCardNumber 10))
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " NoteCardNumber
" out of "
HashArraySize "." (CHARACTER 13)))
(COND
((for ActiveCard in ActiveCardsList thereis (NC.SameCardP
ActiveCard Card))
(NC.SetGlobalLinks Card (CDR (for CardAndLinks in
GlobalLinks
when (NC.SameCardP
Card
(CAR CardAndLinks))
do (RETURN CardAndLinks))))
(NC.SetToLinks Card (CDR (for CardAndLinks in ToLinks
when (NC.SameCardP
Card
(CAR CardAndLinks))
do (RETURN CardAndLinks))))
(NC.SetFromLinks Card (CDR (for CardAndLinks in FromLinks
when (NC.SameCardP
Card
(CAR CardAndLinks))
do (RETURN CardAndLinks))))
(if (AND (for TopLevelCard in (NC.FetchTopLevelCards
NoteFile)
never (NC.SameCardP Card TopLevelCard))
(NOT (NC.SameCardP Card (fetch (NoteFile
LinkLabelsCard)
of NoteFile)))
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK) never (NC.ChildLinkP
Link)))
then (push ToBeFiledCards Card))
(NC.PutLinks Card)
(NC.DeactivateCard Card T))))))
(* File any unfiled cards in the ToBeFiled box.)
(if ToBeFiledCards
then (NC.PrintMsg NIL T "Filing " (LENGTH ToBeFiledCards)
" cards in ToBeFiled box."
(CHARACTER 13))
(NCP.FileCards ToBeFiledCards (fetch (NoteFile ToBeFiledCard)
of NoteFile)))
(* Rewrite link labels if we've found any new ones.)
(COND
((LDIFFERENCE DiscoveredLinkLabels OldLinkLabels)
(NC.StoreLinkLabels NoteFile (UNION DiscoveredLinkLabels OldLinkLabels))))
(NC.CheckpointDatabase NoteFile T)
(NC.ForceDatabaseClose NoteFile)
(NC.PrintMsg NIL T "Repair Completed for " (FULLNAME FileName)
"."
(CHARACTER 13))
(if ToBeFiledCards
then (NC.PrintMsg NIL NIL "Filed cards " (for Card in ToBeFiledCards
collect (NC.FetchTitle Card))
" in ToBeFiled box.")))))
(NC.CollectAndCheckLinks
(LAMBDA (Card NoteFile ListOfValidCards) (* rht: "23-Nov-85 18:35")
(* Return the list of all of the NoteCardLinks in the substance of NoteCard ID. Check each link to make sure it is
legal. If not legal delete it from the substance.)
(* * rht 11/23/85: updated to handle new notefile and card object formats.)
(* Assumes that the Card is already an active
NoteCard)
(PROG (NoteCardType Links DirtyFlg ActualLink GlobalLinks LinkIcon LinksDirtyFlg
CollectReferencesFn)
(SETQ NoteCardType (NC.RetrieveType Card)) (* Collect the links. Check the validity of each link
and delete it if it is not a valid link.)
(COND
((SETQ CollectReferencesFn (NC.CollectReferencesFn NoteCardType))
(SETQ Links (APPLY* CollectReferencesFn Card T))
(SETQ DirtyFlg (CDR Links))
(SETQ Links (CAR Links))))
(* * Process the GlobalLinks as well .... same for all substance types)
(SETQ Links (NCONC Links (for Link
in
(SETQ GlobalLinks
(for GlobalLink in (NC.FetchGlobalLinks Card)
eachtime (BLOCK)
when (COND
((AND (LISTP ListOfValidCards)
(for ValidCard in
ListOfValidCards
thereis
(NC.SameCardP
(fetch (Link
DestinationCard)
of GlobalLink)
ValidCard))))
((NC.ValidLinkP GlobalLink))
(T (SETQ LinksDirtyFlg T)
NIL))
collect GlobalLink))
eachtime (BLOCK) collect Link)))
(NC.SetGlobalLinks Card GlobalLinks)
(* * Update list of valid cards with good links returned from Collect references)
(AND (LISTP ListOfValidCards)
(NCONC ListOfValidCards (for Link in Links eachtime (BLOCK)
collect (fetch (Link DestinationCard)
of Link))))
(* * Write out the card or links if it has been modified)
(AND DirtyFlg (NC.PutNoteCard Card))
(AND LinksDirtyFlg (NC.PutLinks Card))
(RETURN Links))))
)
(* * Bug fixes to two functions in NCLINKS)
(DEFINEQ
(NC.InsertLinkBeforeMarker
(LAMBDA (SourceCard DestinationCard LinkLabel DisplayMode Marker# NoSpacerFlg)
(* rht: "24-Nov-85 15:04")
(* Insert a link to DestinationCard in SourceCard just
before the Marker#'th place marker object)
(* * rht 12/7/84: Now returns the newly created link.)
(* * rht 9/13/85: When card is inactive, there won't be a current cursor position. So if no marker# is specified,
then insert at end.)
(* * kirk: 14Nov85: deleted use of of DatabaseStream)
(LET (Objects TextStream TextObject (Spacer (CONCAT (CHARACTER 13)))
Link)
(COND
((NC.ActiveCardP SourceCard)
(SETQ TextObject (TEXTOBJ (SETQ TextStream (NC.FetchSubstance SourceCard))))
(COND
((AND (FIXP Marker#)
(SETQ Objects (TEDIT.LIST.OF.OBJECTS TextObject (FUNCTION
NC.PlaceMarkerP))))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (ADD1 (fetch (TEXTOBJ TEXTLEN) of TextObject))
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects Marker#))
0
(QUOTE LEFT)))))
(NC.MarkersInFileBoxesFlg (TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT))))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel DestinationCard SourceCard
DisplayMode))
(COND
((NULL NoSpacerFlg)
(TEDIT.INSERT TextStream Spacer))))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of SourceCard))
(COND
((NC.CardP (NC.GetNoteCard SourceCard))
(SETQ TextObject (TEXTOBJ (SETQ TextStream (NC.FetchSubstance
SourceCard))))
(COND
((AND (FIXP Marker#)
(SETQ Objects (TEDIT.LIST.OF.OBJECTS
TextObject
(FUNCTION NC.PlaceMarkerP))))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (ADD1 (fetch (TEXTOBJ
TEXTLEN)
of TextObject))
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects Marker#))
0
(QUOTE LEFT)))))
(T (* Cursor has no position in closed Tedit win, so just
set selection to end.)
(TEDIT.SETSEL TextStream (ADD1 (fetch (TEXTOBJ TEXTLEN)
of TextObject))
0
(QUOTE RIGHT))))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel
DestinationCard SourceCard
DisplayMode))
(COND
((NULL NoSpacerFlg)
(TEDIT.INSERT TextStream Spacer)))
(NC.PutNoteCard SourceCard)
(NC.PutLinks SourceCard)
(NC.DeactivateCard SourceCard))))))
Link)))
(NC.AddGlobalLinksToCard
(LAMBDA (CardIdentifier SingleLinkFlg) (* rht: "24-Nov-85 14:39")
(* * Called from card's menu to add some global links.)
(* * rht 11/24/85: Fixed bugs. It was calling NC.CoerceToID.)
(LET (Window SourceCard DestinationCards Label)
(SETQ SourceCard (NC.CoerceToCard CardIdentifier))
(SETQ Window (NC.FetchWindow SourceCard))
(SETQ Label (NC.AskLinkLabel Window NIL NIL T T))
(AND Label (if SingleLinkFlg
then (NC.MakeGlobalLink Window Label NIL SourceCard)
(NC.ClearMsg Window T)
else (SETQ DestinationCards (NC.SelectNoteCards
NIL
(FUNCTION (LAMBDA (Card)
(COND
((NEQ Card SourceCard)
T)
(T (NC.PrintMsg Window T
"A Card/Box cannot point to itself. "
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL))))
NC.SelectingMultipleCardsMenu SourceCard NIL
"Please select the Cards or Boxes to be pointed to."))
(NC.ClearMsg Window T)
(for DestinationCard in DestinationCards
do (NC.MakeGlobalLink Window Label DestinationCard SourceCard)))
))))
)
(* * Fixes to functions and Identifier vars in NCDATABASE)
(DEFINEQ
(NC.WriteIdentifier
(LAMBDA (NoteFile Identifier) (* rht: "24-Nov-85 21:50")
(* Put Identifier on DatabaseStream)
(* * Now puts out new data format style. This consists of the identifier with the last two #'s clipped off followed
by the data format version byte.)
(* * rht 11/12/85: Now handles new notefile format.)
(* * rht 11/24/85: Assumes identifier is already clipped.)
(LET ((Stream (fetch (NoteFile Stream) of NoteFile)))
(PRINT Identifier Stream NC.OrigReadTable)
(NC.WritePtr Stream NC.DataFormatVersionNumber 1))))
(NC.ReadIdentifier
(LAMBDA (NoteFile Identifier) (* rht: "24-Nov-85 21:58")
(* Return T if next item on databaseStream is the
identifier specified by Identifier)
(* * rht 2/4/85: A horrible hack for the case of titles identifier. This is because a previous typo was causing
NOBIND to get written for titles identifiers.)
(* * rht 7/9/85: Now checks for new data format. This is indicated by identifiers with the last two #'s clipped
off. Then comes the one-byte version number of the data format. If identifier is not clipped then it's old style
and there is no version number. Return version number if there is one, 0 if old style, and NIL if can't match
identifier.)
(* * fkr 11/8/85 Changed to handle NoteFile object.)
(* * rht 11/24/85: No longer worries about the screwy NOBIND Titles identifier. Also assumes Identifier is already
clipped.)
(LET ((Stream (fetch (NoteFile Stream) of NoteFile)))
(if (AND (EQ (READ Stream NC.OrigReadTable)
Identifier)
(NUMBERP (PROGN (* First char is separator.
Next is one-byte version number.)
(READC Stream)
(NC.ReadPtr Stream 1))))
else NIL))))
)
(RPAQQ NC.LinksIdentifier ###LINKS#)
(RPAQQ NC.ItemIdentifier ###ITEM#)
(RPAQQ NC.PropsIdentifier ###PROPS#)
(RPAQQ NC.TitlesIdentifier ###TITLES#)
(PUTPROPS RHTPATCH008 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (938 17731 (NC.ScavengeDatabaseFile 948 . 15313) (NC.CollectAndCheckLinks 15315 . 17729)
) (17782 22478 (NC.InsertLinkBeforeMarker 17792 . 21149) (NC.AddGlobalLinksToCard 21151 . 22476)) (
22544 24720 (NC.WriteIdentifier 22554 . 23275) (NC.ReadIdentifier 23277 . 24718)))))
STOP