(FILECREATED "25-Oct-85 21:35:34" {QV}<NOTECARDS>RELEASE1.2I>NCREPAIR.;56 138196
changes to: (FNS NC.BuildBadCardsList NC.ScavengerPhase1
NC.MessageWinAttachedMenuWhenSelectedFn NC.BuildScavengerArray
NC.WorthlessCardP NC.CheckIndexPtrAgainstScavengerArray)
(VARS NCREPAIRCOMS)
previous date: "18-Oct-85 15:37:39" {QV}<NOTECARDS>RELEASE1.2I>NCREPAIR.;55)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCREPAIRCOMS)
(RPAQQ NCREPAIRCOMS ((E (SETQ NC.SystemDate (DATE))
(PUTPROP (QUOTE NC.SystemDate)
(QUOTE NewestFile)
(ROOTFILENAME (FULLNAME (OUTPUT)))))
(* * Scavenger mechanisms)
(GLOBALVARS NC.TitlesIdentifier NC.PropsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.LinkLabelsIdentifier NC.LinkLabelsID NC.ScavengerArrayTitleOffset
NC.ScavengerArrayLinksOffset NC.ScavengerArraySubstanceOffset
NC.ScavengerArrayPropListOffset NC.ScavengerArrayLinkLabelsOffset
NC.CardInspectorAttachedMenuFont NC.IdentifierAtoms NC.ClippedIdentifierAtoms
NC.LightShade NC.IndexArrayOffsets PSA.Database NC.ScavengerInteractionWinRegion
NC.IndexArrayLinkLabelsOffset NC.ScavengerCriticalOffsets NC.OffScreenPosition
NC.CardsPerMenuLimit NC.TopLevelCards NC.NextNOBINDLoc
NC.ScavengerAttachedMenuFont)
(VARS (NC.ScavengerArraySubstanceOffset 0)
(NC.ScavengerArrayLinksOffset 1)
(NC.ScavengerArrayTitleOffset 2)
(NC.ScavengerArrayPropListOffset 3)
(NC.ScavengerArrayLinkLabelsOffset 4)
(NC.IndexArrayOffsets (QUOTE (3 1 2 4)))
(NC.ScavengerCriticalOffsets (QUOTE (1 2)))
(NC.IndexArrayLinkLabelsOffset 1)
(NC.CardInspectorAttachedMenuFont (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)))
(NC.LightShade 4096)
(NC.OffScreenPosition (CONS 1500 1500))
(NC.ScavengerInteractionWinRegion (CREATEREGION (fetch (POSITION XCOORD)
of NC.OffScreenPosition)
(fetch (POSITION YCOORD)
of NC.OffScreenPosition)
400 250))
(NC.CardsPerMenuLimit 200)
(NC.ScavengerAttachedMenuFont (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD))))
(* * Old scavenger stuff.)
(FNS NC.CollectAndCheckLinks NC.GetOldData NC.FindOldData NC.FindOldLinks
NC.ReinstateNthInstance NC.ScavengeDatabaseFile)
(* * Top level functions.)
(FNS NC.ScavengerPhase1 NC.ScavengerCleanup NC.CheckUnknownCardTypes
NC.RepositionWindowIfNeeded NC.MessageWinAttachedMenuWhenSelectedFn NC.MessageWinCloseFn)
(* * Functions for building the scavenger array and reading things in the data area robustly.)
(FNS NC.BuildScavengerArray NC.RobustReadCardPart NC.ScavengerArrayOffsetFromID
NC.CheckForValidSubstance NC.SearchFor###OrNOBIND NC.AtEndOfItemP NC.RobustRead
NC.RobustReadItemIdentifier NC.RobustReadID NC.RobustReadString NC.RobustReadList
NC.RobustReadLinks NC.RobustReadAtom NC.RobustReadRegion NC.RobustGetSubstance
NC.SkipWhiteSpace NC.RobustReadDate NC.RobustReadChar NC.RobustReadByte)
(* * Functions for accessing the scavenger array.)
(FNS NC.GetTypeFromScavengerArray NC.GetTitleFromScavengerArray)
(* * Functions for building bad cards list based on the index array and scavenger array.)
(FNS NC.BuildBadCardsList NC.WorthlessCardP NC.CheckIndexPtrAgainstScavengerArray)
(* * Functions for backing up a card part to its previous version.)
(FNS NC.RestorePreviousTitle NC.RestorePreviousSubstance NC.RestorePreviousLinks
NC.RestorePreviousPropList)
(* * Functions for interacting with the user.)
(FNS NC.BuildCardInspectorMenu NC.EncodeCardProblems NC.CardInspectorCloseFn
NC.CardInspectorRepaintFn NC.CardInspectorMenuWhenSelectedFn
NC.CardInspectorAttachedMenuWhenSelectedFn NC.BuildLinkLabelsInspector
NC.BuildLinkLabelsInspectorMenu NC.BuildCardPartsInspector
NC.CardPartsAttachedMenuWhenSelectedFn NC.BuildTitlesInspectorMenu
NC.BuildSubstancesInspectorMenu NC.BuildLinksInspectorMenu
NC.BuildPropListsInspectorMenu NC.CardPartsMenusWhenSelectedFn
NC.CardTitleVersionInspector NC.CardSubstanceVersionInspector
NC.CardLinksVersionInspector NC.CardPropListVersionInspector
NC.LinkLabelsVersionInspector)
(* * Miscellaneous.)
(FNS NC.ComputeMenuPosition NC.CheckForBadLinksAndTitlesAndPropLists)
(RECORDS LINKSDATA TITLEDATA PROPLISTDATA LINKLABELSDATA)
(* * Possible reasons for bad card parts.)
(P (PUTPROP (QUOTE BADITEMPTR)
(QUOTE ReasonString)
"out of bounds item pointer(s).")
(PUTPROP (QUOTE BADSUBSTANCEPTR)
(QUOTE ReasonString)
"out of bounds substance pointer(s).")
(PUTPROP (QUOTE BADLINKSPTR)
(QUOTE ReasonString)
"out of bounds links pointer(s).")
(PUTPROP (QUOTE BADTITLEPTR)
(QUOTE ReasonString)
"out of bounds title pointer(s).")
(PUTPROP (QUOTE BADPROPLISTPTR)
(QUOTE ReasonString)
"out of bounds prop list pointer(s).")
(PUTPROP (QUOTE BADITEM)
(QUOTE ReasonString)
"improper substance data.")
(PUTPROP (QUOTE BADSUBSTANCE)
(QUOTE ReasonString)
"improper substance data.")
(PUTPROP (QUOTE BADLINKS)
(QUOTE ReasonString)
"improper links data.")
(PUTPROP (QUOTE BADTITLE)
(QUOTE ReasonString)
"improper title data.")
(PUTPROP (QUOTE BADPROPLIST)
(QUOTE ReasonString)
"improper prop list data.")
(PUTPROP (QUOTE BADLINKLABELS)
(QUOTE ReasonString)
"improper link labels.")
(PUTPROP (QUOTE ITEMPASTCHKPT)
(QUOTE ReasonString)
"item beyond chkpt pointer.")
(PUTPROP (QUOTE SUBSTANCEPASTCHKPT)
(QUOTE ReasonString)
"substance beyond chkpt pointer.")
(PUTPROP (QUOTE LINKSPASTCHKPT)
(QUOTE ReasonString)
"links beyond chkpt pointer.")
(PUTPROP (QUOTE TITLEPASTCHKPT)
(QUOTE ReasonString)
"title beyond chkpt pointer.")
(PUTPROP (QUOTE PROPLISTPASTCHKPT)
(QUOTE ReasonString)
"prop list beyond chkpt pointer.")
(PUTPROP (QUOTE LINKLABELSPASTCHKPT)
(QUOTE ReasonString)
"link labels beyond chkpt pointer.")
(PUTPROP (QUOTE UNKNOWNCARDTYPE)
(QUOTE ReasonString)
"card type definition not loaded."))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA)))))
(* * Scavenger mechanisms)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.TitlesIdentifier NC.PropsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.LinkLabelsIdentifier NC.LinkLabelsID NC.ScavengerArrayTitleOffset
NC.ScavengerArrayLinksOffset NC.ScavengerArraySubstanceOffset
NC.ScavengerArrayPropListOffset NC.ScavengerArrayLinkLabelsOffset
NC.CardInspectorAttachedMenuFont NC.IdentifierAtoms NC.ClippedIdentifierAtoms
NC.LightShade NC.IndexArrayOffsets PSA.Database NC.ScavengerInteractionWinRegion
NC.IndexArrayLinkLabelsOffset NC.ScavengerCriticalOffsets NC.OffScreenPosition
NC.CardsPerMenuLimit NC.TopLevelCards NC.NextNOBINDLoc NC.ScavengerAttachedMenuFont)
)
(RPAQQ NC.ScavengerArraySubstanceOffset 0)
(RPAQQ NC.ScavengerArrayLinksOffset 1)
(RPAQQ NC.ScavengerArrayTitleOffset 2)
(RPAQQ NC.ScavengerArrayPropListOffset 3)
(RPAQQ NC.ScavengerArrayLinkLabelsOffset 4)
(RPAQQ NC.IndexArrayOffsets (3 1 2 4))
(RPAQQ NC.ScavengerCriticalOffsets (1 2))
(RPAQQ NC.IndexArrayLinkLabelsOffset 1)
(RPAQ NC.CardInspectorAttachedMenuFont (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)))
(RPAQQ NC.LightShade 4096)
(RPAQ NC.OffScreenPosition (CONS 1500 1500))
(RPAQ NC.ScavengerInteractionWinRegion (CREATEREGION (fetch (POSITION XCOORD)
of NC.OffScreenPosition)
(fetch (POSITION YCOORD)
of NC.OffScreenPosition)
400 250))
(RPAQQ NC.CardsPerMenuLimit 200)
(RPAQ NC.ScavengerAttachedMenuFont (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)))
(* * Old scavenger stuff.)
(DEFINEQ
(NC.CollectAndCheckLinks
(LAMBDA (ID DatabaseStream ListOfValidCards) (* fgh: "28-Sep-85 18:04")
(* 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.)
(* Assumes that the ID is already an active NoteCard)
(PROG (NoteCardType Links DirtyFlg ActualLink GlobalLinks LinkIcon LinksDirtyFlg
CollectReferencesFn)
(SETQ NoteCardType (NC.FetchType ID)) (* 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 ID T DatabaseStream))
(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 ID)
eachtime (BLOCK)
when (COND
((AND (LISTP ListOfValidCards)
(FMEMB (fetch (NOTECARDLINK
DESTINATIONID)
of GlobalLink)
ListOfValidCards)))
((NC.ValidLinkP GlobalLink DatabaseStream
T))
(T (SETQ LinksDirtyFlg T)
NIL))
collect GlobalLink))
eachtime (BLOCK) when (NEQ (fetch (NOTECARDLINK DESTINATIONID)
of Link)
(QUOTE NC00000))
collect Link)))
(NC.SetGlobalLinks ID 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 (NOTECARDLINK DESTINATIONID) of Link))))
(* * Write out the card or links if it has been modified)
(AND DirtyFlg (NC.PutNoteCard ID DatabaseStream))
(AND LinksDirtyFlg (NC.PutLinks ID DatabaseStream))
(RETURN Links))))
(NC.GetOldData
(LAMBDA (ID Ptr LinksPtr DatabaseStream) (* fgh: "10-Oct-84 22:51")
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetOldData")
(PROG (Index Status ActualID NoteCardType Title Substance PropList FromLinks
ToLinks Region Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetOldData"))
(* Get Substance)
(SETFILEPTR Stream Ptr)
(COND
((NOT (NC.GetIdentifier Stream NC.ItemIdentifier))
(NC.ReportError "NC.GetOldData" (CONCAT ID
" Error in Database file -- incorrect item identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetOldData" (CONCAT
"ID mismatch while reading item. Expected ID: "
ID " Found ID: " ActualID))))
(SETQ NoteCardType (READ Stream))
(READC Stream)
(SETQ Region (NC.GetRegion ID Stream))
(SETQ Substance (APPLY* (NC.GetSubstanceFn NoteCardType)
Stream ID Region))
(* Get Links)
(SETFILEPTR Stream LinksPtr)
(COND
((NOT (NC.GetIdentifier Stream NC.LinksIdentifier))
(NC.ReportError "NC.GetOldData" (CONCAT ID
" Error in Database file -- incorrect links identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetOldData" (CONCAT
"ID mismatch while reading links. Expected ID: "
ID " Found ID: " ActualID))))
(SETQ ToLinks (READ Stream))
(SETQ FromLinks (READ Stream)) (* Setup ID with appropriate properties for retrieved
card)
(NC.SetType ID NoteCardType)
(NC.SetRegion ID Region)
(NC.SetSubstance ID Substance)
(NC.SetToLinks ID ToLinks)
(NC.SetLinksDirtyFlg ID)
(NC.SetFromLinks ID FromLinks)
(NC.SetLinksDirtyFlg ID)
(NC.ActivateCard ID)
(RETURN ID)))))
(NC.FindOldData
(LAMBDA (ID DatabaseStream) (* rht: " 5-Feb-85 23:52")
(PROG (Pos)
(SETFILEPTR DatabaseStream 0)
(RETURN (while (SETQ Pos (FILEPOS "###ITEM###" DatabaseStream NIL NIL NIL NIL))
when (PROGN (READ DatabaseStream)
(EQ (READ DatabaseStream)
ID))
collect Pos)))))
(NC.FindOldLinks
(LAMBDA (ID DatabaseStream) (* rht: " 5-Feb-85 23:52")
(PROG (Pos)
(SETFILEPTR DatabaseStream 0)
(RETURN (while (SETQ Pos (FILEPOS "###LINKS###" DatabaseStream NIL NIL NIL NIL))
when (PROGN (READ DatabaseStream)
(EQ (READ DatabaseStream)
ID))
collect Pos)))))
(NC.ReinstateNthInstance
(LAMBDA (ID NData NLinks DatabaseStream) (* fgh: " 3-May-84 18:15")
(PROG (Ptr LinksPtr)
(COND
((MINUSP NData)
(SETQ Ptr (CAR (NLEFT (NC.FindOldData ID DatabaseStream)
(ABS NData)))))
(T (SETQ Ptr (CAR (NTH (NC.FindOldData ID DatabaseStream)
NData)))))
(COND
((MINUSP NLinks)
(SETQ LinksPtr (CAR (NLEFT (NC.FindOldLinks ID DatabaseStream)
(ABS NLinks)))))
(T (SETQ LinksPtr (CAR (NTH (NC.FindOldLinks ID DatabaseStream)
NLinks))))) (* (NC.GetOldData ID Ptr LinksPtr DatabaseStream)
(NC.PutNoteCard ID DatabaseStream)
(NC.PutLinks ID DatabaseStream)
(NC.DeactivateCard ID))
(RETURN (COND
((AND (NC.IDP ID)
Ptr LinksPtr)
(SETFILEPTR DatabaseStream (NC.IndexFromID ID))
(NC.PutPtr DatabaseStream Ptr)
(NC.PutPtr DatabaseStream LinksPtr)
(NC.PutStatus DatabaseStream ACTIVE)
(QUOTE DONE))
(T (QUOTE ERROR)))))))
(NC.ScavengeDatabaseFile
(LAMBDA (FileNameOrStream BadLinkLabelsFlg ListOfCardsToReconstruct ListOfGlobalLinksToReconstruct)
(* rht: " 4-Oct-85 00:48")
(* 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.)
(PROG (FileName OldLinkLabels DiscoveredLinkLabels FromLinks ToLinks DatabaseStream Status ID
Links Entry FullName CardTotal GlobalLinks ActiveCardsList ReconstructLinks
ReconstructGlobalLinks (ListOfValidCards (LIST (QUOTE **Header**)))
ThisCardsToLinks ThisCardsGlobalLinks ToBeFiledCards)
(* * First, take care of checking stream's validity, etc.)
(COND
((AND (STREAMP FileNameOrStream)
(OPENP FileNameOrStream)) (* There's already an open stream to repair.)
(SETQ DatabaseStream FileNameOrStream))
(T (* Get file name and open the file if conditions are
okay.)
(COND
((AND (STREAMP PSA.Database)
(OPENP PSA.Database))
(NC.PrintMsg NIL T "There is an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before link rebuilding can be done."
(CHARACTER 13))
(RETURN)))
(SETQ FileName FileNameOrStream)
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to repair? "
NIL T)))
(RETURN NIL))
(AND (NULL (SETQ PSA.Database (SETQ DatabaseStream (NC.OpenDatabaseFile FileName NIL T)
)))
(NC.PrintMsg NIL NIL "Couldn't open " FileName "." (CHARACTER 13)
"Repair aborted."
(CHARACTER 13))
(RETURN NIL))
(NC.PrintMsg NIL NIL "Done.")))
(* * If link labels aren't screwed up, then read them in.)
(OR BadLinkLabelsFlg (SETQ OldLinkLabels (NC.GetLinkLabels DatabaseStream)))
(* 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.)
(NC.PrintMsg NIL T "Collecting Links ... ")
(for NoteCardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
eachtime (BLOCK)
do (SETQ ID (NC.IDFromNumber NoteCardNumber))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER 13)
"Collecting Links for item " NoteCardNumber " out of " CardTotal "."
(CHARACTER 13))
(COND
((NOT (FMEMB ID ListOfCardsToReconstruct))
(SETQ Status (NC.GetNoteCard ID DatabaseStream))
(COND
((NC.IDP Status)
(SETQ ActiveCardsList (CONS Status ActiveCardsList))
(AND (NOT (FMEMB ID ListOfValidCards))
(SETQ ListOfValidCards (CONS ID ListOfValidCards)))
(SETQ Links (NC.CollectAndCheckLinks ID DatabaseStream ListOfValidCards))
(SETQ ToLinks (CONS (CONS ID Links)
ToLinks))
(SETQ GlobalLinks (CONS (CONS ID (NC.FetchGlobalLinks ID))
GlobalLinks))
(* 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 ID)
eachtime (BLOCK)
when (FMEMB (fetch (NOTECARDLINK SOURCEID)
of Link)
ListOfCardsToReconstruct)
do (SETQ ReconstructLinks (CONS Link
ReconstructLinks))))
(* 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 ID)
eachtime (BLOCK)
when
(AND (NC.GlobalLinkP Link)
(FMEMB (fetch (NOTECARDLINK
SOURCEID)
of Link)
ListOfGlobalLinksToReconstruct))
do (SETQ ReconstructGlobalLinks
(CONS Link ReconstructGlobalLinks)
)))
(NC.DeactivateCard ID T))))
(T (NC.GetLinks ID DatabaseStream)
(SETQ GlobalLinks (CONS (CONS ID (NC.FetchGlobalLinks ID))
GlobalLinks))
(SETQ ToLinks (CONS (CONS ID (NC.FetchGlobalLinks ID))
GlobalLinks))
(NC.DeactivateCard ID T))))
(* * Reconstruct any cards as requested)
(for CardID in ListOfCardsToReconstruct eachtime (BLOCK)
do (* Make a new file box with the given ID)
(NC.MakeNoteCard (QUOTE FileBox)
"Untitled: Reconstructed during repair" T NIL CardID)
(* 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 (EQ CardID (fetch (NOTECARDLINK SOURCEID) of Link))
(OR (NC.ContentsLinkP Link)
(NC.SubContentsLinkP Link)))
collect (NC.FileBoxCollectChildren (NC.FetchSubstance CardID)
CardID
(LIST (SETQ DestCard
(fetch (NOTECARDLINK
DESTINATIONID)
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 NOTECARDLINK copying
(for CardLink in (NCP.GetLinks CardID)
when (EQ DestCard
(fetch (NOTECARDLINK
DESTINATIONID)
of CardLink))
do (RETURN CardLink)))))
(* Add the new links to the collected links list)
(COND
((SETQ ThisCardsToLinks (FASSOC CardID ToLinks))
(NCONC ThisCardsToLinks Links))
(T (SETQ ToLinks (CONS (CONS CardID Links)
ToLinks))))
(SETQ ActiveCardsList (CONS CardID ActiveCardsList))
(* Put the card away)
(NC.PutNoteCard CardID DatabaseStream)
(NC.DeactivateCard CardID T))
(* * Reconstruct any global link lists as required)
(for Link in ReconstructGlobalLinks eachtime (BLOCK)
do (* Add it to the GlobalLinks list)
(COND
((SETQ ThisCardsGlobalLinks (FASSOC (fetch (NOTECARDLINK SOURCEID) of Link)
GlobalLinks))
(COND
((for GlobalLink in ThisCardsGlobalLinks eachtime (BLOCK)
never (EQUAL (fetch (NOTECARDLINK LINKID) of Link)
(fetch (NOTECARDLINK LINKID) of GlobalLink)))
(COND
((CADR ThisCardsGlobalLinks) (* were there global links before?)
(NCONC1 ThisCardsGlobalLinks Link))
(T (RPLACD ThisCardsGlobalLinks (LIST Link)))))))
(T (SETQ GlobalLinks (CONS (CONS (fetch (NOTECARDLINK SOURCEID) of Link)
(LIST Link))
GlobalLinks))))
(* Add it to the ToLinks list if its not already there)
(COND
((SETQ ThisCardsToLinks (FASSOC (fetch (NOTECARDLINK SOURCEID) of Link)
ToLinks))
(COND
((for ToLink in ThisCardsToLinks eachtime (BLOCK)
never (EQUAL (fetch (NOTECARDLINK LINKID) of Link)
(fetch (NOTECARDLINK LINKID) of ToLink)))
(COND
((CADR ThisCardsToLinks)
(NCONC1 ThisCardsToLinks Link))
(T (RPLACD ThisCardsToLinks (LIST Link)))))))
(T (SETQ ToLinks (CONS (CONS (fetch (NOTECARDLINK SOURCEID) 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 (FASSOC (fetch (NOTECARDLINK DESTINATIONID) of Link)
FromLinks))
(COND
(Entry (NCONC1 Entry Link))
(T (SETQ FromLinks (CONS (LIST (fetch (NOTECARDLINK DESTINATIONID)
of Link)
Link)
FromLinks))))
(* Accumulate the link labels into a list.)
(COND
((NOT (FMEMB (SETQ LinkLabel (fetch (NOTECARDLINK LINKLABEL) of Link))
DiscoveredLinkLabels))
(SETQ DiscoveredLinkLabels (CONS LinkLabel DiscoveredLinkLabels))))))
(* Reset all of the To and From Links lists in the
database)
(NC.PrintMsg NIL T "Rewriting Links ... ")
(for NoteCardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
eachtime (BLOCK)
do (AND (ZEROP (IREMAINDER NoteCardNumber 10))
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " NoteCardNumber " out of " CardTotal "."
(CHARACTER 13)))
(SETQ ID (NC.IDFromNumber NoteCardNumber))
(COND
((FMEMB ID ActiveCardsList)
(NC.SetGlobalLinks ID (CDR (FASSOC ID GlobalLinks)))
(NC.SetToLinks ID (CDR (FASSOC ID ToLinks)))
(NC.SetFromLinks ID (CDR (FASSOC ID FromLinks)))
(if (AND (NOT (FMEMB ID NC.TopLevelCards))
(for Link in (NC.FetchFromLinks ID) never (NC.ChildLinkP Link)))
then (push ToBeFiledCards ID))
(NC.PutLinks ID DatabaseStream)
(NC.DeactivateCard ID T)))) (* File any unfiled cards in the ToBeFiled box.)
(NCP.FileCards ToBeFiledCards NC.UnclassifiedID) (* Rewrite link labels if we've found any new ones.)
(COND
((LDIFFERENCE DiscoveredLinkLabels OldLinkLabels)
(NC.PutLinkLabels DatabaseStream (UNION DiscoveredLinkLabels OldLinkLabels))))
(NC.CheckpointDatabase DatabaseStream T)
(NC.ForceDatabaseClose DatabaseStream)
(NC.PrintMsg NIL T "Repair Completed for " (FULLNAME DatabaseStream)
"."
(CHARACTER 13))
(if ToBeFiledCards
then (NC.PrintMsg NIL NIL "Filed cards " ToBeFiledCards " in ToBeFiled box.")))))
)
(* * Top level functions.)
(DEFINEQ
(NC.ScavengerPhase1
(LAMBDA (FileNameOrStream ReadSubstancesFlg ScavengerInteractionWin)
(* rht: "25-Oct-85 20:23")
(* * This is the first phase of the scavenger. Runs over entire data portion of the notefile, accumulating pointers
to healthy parts of cards. Then runs over index array asking user what to do with bad or outdated pointers.
If ReadSubstancesFlg is non-nil then it'll do robust gets of the substances. This slows things down, but makes
checking more comprehensive.)
(PROG (ScavengerArray FileName DatabaseStream UnknownCardTypesList ReasonsList CardsToDelete
CardsToBackUp Menu MenuItems LinkLabelsNews MaxIDNum BadNewsList BadBoxes
ExtraBadNews FirstTimeFlg InspectorPendingEvent NoteFileOpsMenuItem
CanDoPhase3Flg)
(* * First, take care of checking stream's validity, etc.)
(if (AND (STREAMP FileNameOrStream)
(OPENP FileNameOrStream))
then (* There's already an open stream to repair.)
(SETQ DatabaseStream FileNameOrStream)
else (* Get file name and open the file if conditions are
okay.)
(COND
((AND (STREAMP PSA.Database)
(OPENP PSA.Database))
(NC.PrintMsg NIL T "There is an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before Inspect&Repair can begin."
(CHARACTER 13))
(RETURN)))
(SETQ FileName FileNameOrStream)
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to Inspect&Repair? "
NIL T)))
(RETURN NIL))
(AND (NULL (SETQ PSA.Database (SETQ DatabaseStream
(NC.OpenDatabaseFile FileName NIL T NIL NIL NIL NIL T))))
(NC.PrintMsg NIL NIL "Couldn't open " FileName "." (CHARACTER 13)
"Repair aborted."
(CHARACTER 13))
(RETURN NIL))
(NC.PrintMsg NIL NIL "Done.")) (* Build a window for talking to the user if it one
wasn't passed in.)
(if (WINDOWP ScavengerInteractionWin)
then (CLEARW ScavengerInteractionWin)
else (SETQ ScavengerInteractionWin (CREATEW NC.ScavengerInteractionWinRegion
"Inspect&Repair Interaction Window"
NIL T))
(* This flg indicates that we're in the first call to
the scavenger.)
(SETQ FirstTimeFlg T)
(WINDOWADDPROP ScavengerInteractionWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn)
T)) (* Get all relevant info about the data area of the
notefile into ScavengerArray.)
(if (NULL (SETQ ScavengerArray (OR (WINDOWPROP ScavengerInteractionWin (QUOTE
SCAVENGERARRAY))
(NC.BuildScavengerArray DatabaseStream ReadSubstancesFlg
ScavengerInteractionWin))))
then (* Something's wrong. There's no scavenger array.
Bail out.)
(CLOSEW ScavengerInteractionWin)
(NC.ScavengerCleanup DatabaseStream)
(RETURN NIL)
else (WINDOWPROP ScavengerInteractionWin (QUOTE SCAVENGERARRAY)
ScavengerArray)
(if (GEQ (SETQ MaxIDNum (WINDOWPROP ScavengerInteractionWin (QUOTE MAXIDNUM)))
(STREAMPROP DatabaseStream (QUOTE NCNEXTIDNUM)))
then (STREAMPROP DatabaseStream (QUOTE NCNEXTIDNUM)
(ADD1 MaxIDNum))))
(* * Check the list of card types that are undefined to see if user has loaded a definition since the last time we
checked. If he has, then go try to read the substance card parts for those newly defined card types.)
(NC.CheckUnknownCardTypes DatabaseStream ScavengerArray ReadSubstancesFlg
ScavengerInteractionWin)
(* * Next step is to run down the in-core index and find those cards having pointers to bad items in the data area.
We also need to look for undefined card types and for pointers past the checkpoint pointer.)
(SETQ BadNewsList (NC.BuildBadCardsList DatabaseStream ScavengerArray
ScavengerInteractionWin FirstTimeFlg))
(* * Okay, now all the troublesome IDs and the reasons for their troubles are recorded in BadNewsList.
We next need to get directives from the user as to what to do for each problem card.)
(NC.RepositionWindowIfNeeded ScavengerInteractionWin)
(* If there's bad news on link labels then take off
list and store in a local var.)
(if (SETQ LinkLabelsNews (FASSOC (QUOTE LNTYPES)
BadNewsList))
then (SETQ BadNewsList (DREMOVE LinkLabelsNews BadNewsList)))
(* Accumulate general statistics on the problems.)
(for BadNews in BadNewsList bind ID Type eachtime (BLOCK)
unless (FMEMB (CADR BadNews)
(QUOTE (DELETED FREE)))
do (SETQ ID (CAR BadNews))
(for Reason in (CDDDR BadNews) eachtime (BLOCK)
do (ADDPROP Reason (QUOTE BADIDS)
ID)
(if (NOT (FMEMB Reason ReasonsList))
then (SETQ ReasonsList (CONS Reason ReasonsList)))
(if (EQ Reason (QUOTE UNKNOWNCARDTYPE))
then (* Accumulate the list of unknown card types for
nondeleted cards.)
(if (NOT (FMEMB (SETQ Type (NC.GetTypeFromScavengerArray ID
ScavengerArray))
UnknownCardTypesList))
then (push UnknownCardTypesList Type)))))
(SETQ MenuItems (QUOTE ((Abort (QUOTE Abort)
"Quit this Inspect&Repair operation.")
(Recheck% Bad% Cards (QUOTE Recheck% Bad% Cards)
"Recompute bad cards list. Useful if you've just loaded some card type definitions.")
(Inspect% Cards (QUOTE Inspect% Cards)
"Bring up the cards inspector menu."
(SUBITEMS (Include% Deleted% Cards (QUOTE
Include% Deleted% Cards)
"Throw in deleted cards as well.")))))
) (* Print a message if news on link labels is worse than
just past checkpoint.)
(if (AND LinkLabelsNews (NOT (EQUAL (CDDDR LinkLabelsNews)
(QUOTE (LINKLABELSPASTCHKPT)))))
then (push ExtraBadNews LinkLabelsNews)
(NC.PrintMsg ScavengerInteractionWin NIL "The link types are bad." (CHARACTER
13)
"If you don't back them up to a previous version, then phase 3 of Inspect&Repair will rebuild them."
(CHARACTER 13))
(WINDOWPROP ScavengerInteractionWin (QUOTE NEEDLINKSCAVENGE)
T)) (* Collect any fileboxes that have bad substances.)
(if (SETQ BadBoxes (for News in BadNewsList bind Box eachtime (BLOCK)
when (AND (EQ (NC.GetTypeFromScavengerArray (SETQ Box (CAR News))
ScavengerArray)
(QUOTE FileBox))
(INTERSECTION (CDDDR News)
(QUOTE (BADITEMPTR BADSUBSTANCEPTR BADITEM
BADSUBSTANCE))))
collect Box))
then (* If nothing else is wrong with those boxes, then take
off bad news list.)
(for Box in BadBoxes bind BoxNews eachtime (BLOCK)
when (NULL (LDIFFERENCE (CDDDR (SETQ BoxNews (FASSOC Box BadNewsList)))
(QUOTE (BADITEMPTR BADSUBSTANCEPTR BADITEM BADSUBSTANCE)
)))
do (push ExtraBadNews BoxNews)
(SETQ BadNewsList (DREMOVE BoxNews BadNewsList)))
(NC.PrintMsg ScavengerInteractionWin NIL "Fileboxes " BadBoxes
" have bad substance(s)."
(CHARACTER 13)
"If you don't delete them or back up to a previous version, then phase 3 of Inspect&Repair will rebuild their contents."
(CHARACTER 13))
(WINDOWPROP ScavengerInteractionWin (QUOTE NEEDLINKSCAVENGE)
T)) (* Print out totals of active and deleted cards.)
(for Num from 1 to MaxIDNum
bind (ActivesTotal ← 0)
(DeletedsTotal ← 0)
eachtime (BLOCK) do (SELECTQ (CAR (NC.GetPtrsFromIndex DatabaseStream (NC.IDFromNumber
Num)))
(ACTIVE (SETQ ActivesTotal (ADD1 ActivesTotal)))
(DELETED (SETQ DeletedsTotal (ADD1 DeletedsTotal)))
NIL)
finally (NC.PrintMsg ScavengerInteractionWin NIL "Out of " MaxIDNum " card IDs:"
(CHARACTER 13)
"there are " ActivesTotal " active cards and " DeletedsTotal
" deleted cards."
(CHARACTER 13)))
(if ReasonsList
then (* Print out messages for bad cards.)
(NC.PrintMsg ScavengerInteractionWin NIL "Of the non-deleted ones," (CHARACTER
13))
(for Reason in ReasonsList eachtime (BLOCK)
do (NC.PrintMsg ScavengerInteractionWin NIL (LENGTH (GETPROP Reason
(QUOTE BADIDS)))
" have "
(GETPROP Reason (QUOTE ReasonString))
(CHARACTER 13))
(if (EQ Reason (QUOTE UNKNOWNCARDTYPE))
then (NC.PrintMsg ScavengerInteractionWin NIL "The unknown types are: "
UnknownCardTypesList "." (CHARACTER 13)))
(REMPROP Reason (QUOTE BADIDS)))
else (NC.PrintMsg ScavengerInteractionWin NIL "All non-deleted cards look okay."
(CHARACTER 13)))
(* Only allow continuation to phase 3 of repair, links rebuilding, if there's no bad news that can't be fixed.
We can fix bad proplist, titles or links.)
(if (for News in BadNewsList eachtime (BLOCK) unless (FMEMB (CADR News)
(QUOTE (DELETED FREE)))
never (INTERSECTION (CDDDR News)
(QUOTE (BADITEMPTR BADSUBSTANCEPTR BADITEM BADSUBSTANCE
UNKNOWNCARDTYPE))))
then (* Add the appropriate menu items.)
(if (NOT (WINDOWPROP ScavengerInteractionWin (QUOTE NEEDLINKSCAVENGE)))
then (SETQ MenuItems (CONS (QUOTE (End% Inspect&Repair (QUOTE
End% Inspect&Repair)
"This exits Inspect&Repair normally, closing the notefile."))
MenuItems)))
(SETQ CanDoPhase3Flg T)
(SETQ MenuItems (CONS (QUOTE (Continue% Repair (QUOTE Continue% Repair)
"Complete Inspect&Repair by rebuilding the links."))
MenuItems))) (* Make sure a checkpoint will happen before continuing
to phase 3 if there are any card parts beyond the
checkpt pointer.)
(if (INTERSECTION ReasonsList (QUOTE (ITEMPASTCHKPT SUBSTANCEPASTCHKPT LINKSPASTCHKPT
TITLEPASTCHKPT PROPLISTPASTCHKPT
LINKLABELSPASTCHKPT)))
then (AND CanDoPhase3Flg (NC.PrintMsg ScavengerInteractionWin NIL
"'Continue Repair' will integrate any card part versions beyond chkpt pointer."
(CHARACTER 13)))
(WINDOWPROP ScavengerInteractionWin (QUOTE NEEDCHECKPOINT)
T)) (* Ugliness! Have to cache all these vars on window so
that attached menu whenselectedfn will be able to grab
them.)
(WINDOWPROP ScavengerInteractionWin (QUOTE BADNEWSLIST)
BadNewsList)
(WINDOWPROP ScavengerInteractionWin (QUOTE EXTRABADNEWS)
ExtraBadNews)
(WINDOWPROP ScavengerInteractionWin (QUOTE LINKSLABELSNEWS)
LinkLabelsNews)
(WINDOWPROP ScavengerInteractionWin (QUOTE BADBOXES)
BadBoxes)
(WINDOWPROP ScavengerInteractionWin (QUOTE STREAM)
DatabaseStream)
(ATTACHMENU (create MENU
ITEMS ← MenuItems
WHENSELECTEDFN ←(FUNCTION NC.MessageWinAttachedMenuWhenSelectedFn)
MENUFONT ← NC.ScavengerAttachedMenuFont)
ScavengerInteractionWin
(QUOTE RIGHT)
(QUOTE TOP))
(if FirstTimeFlg
then (SETQ NoteFileOpsMenuItem (FASSOC (QUOTE NoteFile% Ops)
(fetch (MENU ITEMS) of NC.MainMenu)))
(RESETLST (* If this is the first time in, then get notefile
title on main menu.)
(NC.SetMainMenuTitle DatabaseStream)
(RESETSAVE (SHADEITEM NoteFileOpsMenuItem NC.MainMenu GRAYSHADE)
(LIST (QUOTE SHADEITEM)
NoteFileOpsMenuItem NC.MainMenu WHITESHADE))
(* wait for inspector phase 2 to finish using event
hung on STREAMPROP.)
(STREAMPROP DatabaseStream (QUOTE InspectorPendingEvent)
(SETQ InspectorPendingEvent (CREATE.EVENT (QUOTE
InspectorPending))))
(AWAIT.EVENT InspectorPendingEvent))))))
(NC.ScavengerCleanup
(LAMBDA (Stream) (* rht: " 4-Oct-85 01:45")
(* * Abort the scavenger by closing the notefile without checkpointing.)
(if (OPENP Stream)
then (NC.CacheTypesAndTitles Stream T NIL "Aborting repair.")
(NC.ForceDatabaseClose Stream)
(NC.ResetMainMenu)
(NC.PrintMsg NIL T "Repair of " (FULLNAME Stream)
" aborted.") (* Tell the NC.ScavengerPhase1 that it can return now.)
(NOTIFY.EVENT (STREAMPROP Stream (QUOTE InspectorPendingEvent))))))
(NC.CheckUnknownCardTypes
(LAMBDA (Stream ScavengerArray ReadSubstancesFlg MessageWin)
(* rht: "18-Oct-85 12:55")
(* * Check whether any of the card types on UnknownCardTypesList have suddenly become defined.
If so, then go try to read the substances of cards of that type and update ScavengerArray. Return the new
UnknownCardTypesList.)
(* * rht 10/18/85: Now fixes the windowprop of MessageWin here. Also returns the list of newly found types, or NIL
if none.)
(LET ((UnknownCardTypesList (WINDOWPROP MessageWin (QUOTE UNKNOWNCARDTYPESLIST)))
OkayTypes)
(for Type in UnknownCardTypesList bind (EndPtr ←(GETEOFPTR Stream)) when (NCP.ValidCardType
Type)
do (push OkayTypes Type)
(for SubstancePtr in (GETPROP Type (QUOTE SUBSTANCEPTRS))
do (SETFILEPTR Stream SubstancePtr)
(NC.RobustReadCardPart Stream ReadSubstancesFlg MessageWin ScavengerArray EndPtr))
(REMPROP Type (QUOTE SUBSTANCEPTRS)))
(if OkayTypes
then (WINDOWPROP MessageWin (QUOTE UNKNOWNCARDTYPESLIST)
(LDIFFERENCE UnknownCardTypesList OkayTypes)))
OkayTypes)))
(NC.RepositionWindowIfNeeded
(LAMBDA (Win) (* rht: "17-Jul-85 17:04")
(* * If window is at NC.OffScreenPosition, then let user move to new location.)
(if (EQUAL (WINDOWPOSITION Win)
NC.OffScreenPosition)
then (LET ((Region (WINDOWREGION Win)))
(MOVEW Win (GETBOXPOSITION (fetch (REGION WIDTH) of Region)
(fetch (REGION HEIGHT) of Region)
NIL NIL NIL
"Please position the repair interaction window."))))))
(NC.MessageWinAttachedMenuWhenSelectedFn
(LAMBDA (Item Menu MouseKey) (* rht: "25-Oct-85 21:27")
(* * Called when selecting from the attached menu to the main message window.)
(* * rht 9/17/85: Now gets MaxIDNum from WINDOWPROP of MessageWin and uses it for looping through cards.)
(LET ((MenuWin (WFROMMENU Menu))
(Operation (CAR Item))
MessageWin Stream InspectorWins ScavengerArray BadNewsList ExtraBadNews MaxIDNum)
(SETQ MessageWin (MAINWINDOW MenuWin))
(SETQ ScavengerArray (WINDOWPROP MessageWin (QUOTE SCAVENGERARRAY)))
(SETQ Stream (WINDOWPROP MessageWin (QUOTE STREAM)))
(SETQ BadNewsList (WINDOWPROP MessageWin (QUOTE BADNEWSLIST)))
(SETQ ExtraBadNews (WINDOWPROP MessageWin (QUOTE EXTRABADNEWS)))
(SETQ MaxIDNum (WINDOWPROP MessageWin (QUOTE MAXIDNUM)))
(SELECTQ Operation
(Abort (FLASHW PROMPTWINDOW)
(if (NC.YesP (NC.AskUser
"Do you really want to abort the Inspect & Repair process? "
NIL
(QUOTE Yes)
T NIL T NIL T))
then (* Bail out.)
(WINDOWDELPROP MessageWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MessageWin)
(NC.ScavengerCleanup Stream)))
(Recheck% Bad% Cards (* Rerun the end of phase1.)
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin)
(NC.ScavengerPhase1 Stream NIL MessageWin))
(Inspect% Cards (* Bring up the big card inspector menu.)
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin)
(NC.BuildCardInspectorMenu (for Num from 1 to MaxIDNum bind ID
eachtime (BLOCK)
when
(FMEMB (CAR (NC.GetPtrsFromIndex
Stream
(SETQ ID (NC.IDFromNumber
Num))))
(QUOTE (ACTIVE BADPOINTER)))
collect ID)
ScavengerArray
(APPEND ExtraBadNews BadNewsList)
Stream MessageWin))
(Include% Deleted% Cards (* Like above except include also the deleted cards.)
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin)
(NC.BuildCardInspectorMenu (for Num from 1 to MaxIDNum
bind ID IndexPtrs
eachtime (BLOCK)
(SETQ ID (
NC.IDFromNumber
Num))
(SETQ IndexPtrs
(NC.GetPtrsFromIndex
Stream ID))
when
(FMEMB (fetch (POINTERLIST
STATUS)
of IndexPtrs)
(QUOTE (ACTIVE
BADPOINTER
DELETED)))
unless (NC.WorthlessCardP
ID Stream
ScavengerArray
IndexPtrs)
collect ID)
ScavengerArray
(APPEND ExtraBadNews BadNewsList)
Stream MessageWin))
(Continue% Repair (* If changes were made, then checkpoint the notefile.)
(if (NEQ (NC.CheckForBadLinksAndTitlesAndPropLists Stream MessageWin
BadNewsList
ScavengerArray)
(QUOTE ABORT))
then (if (WINDOWPROP MessageWin (QUOTE NEEDCHECKPOINT))
then (NC.CheckpointDatabase Stream))
(WINDOWDELPROP MessageWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MessageWin)
(* Rebuild the links.)
(NC.ScavengeDatabaseFile Stream (WINDOWPROP MessageWin
(QUOTE
LINKSLABELSNEWS))
(WINDOWPROP MessageWin
(QUOTE BADBOXES))
(WINDOWPROP MessageWin
(QUOTE
CARDSWITHLINKSRESET)))
(NC.ResetMainMenu)
(NOTIFY.EVENT (STREAMPROP Stream (QUOTE
InspectorPendingEvent)))))
(End% Inspect&Repair (* Don't have to scavenge links.
Close up gracefully.)
(NC.CheckForBadLinksAndTitlesAndPropLists Stream MessageWin
BadNewsList
ScavengerArray)
(WINDOWDELPROP MessageWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MessageWin)
(NC.CloseDatabaseFile)
(NOTIFY.EVENT (STREAMPROP Stream (QUOTE InspectorPendingEvent))))
NIL))))
(NC.MessageWinCloseFn
(LAMBDA (MainWin) (* rht: "18-Oct-85 14:52")
(* * Runs when main message win is closed. Checks whether user means to abort and closes each card inspector
window.)
(LET ((Stream (WINDOWPROP MainWin (QUOTE STREAM))))
(FLASHW PROMPTWINDOW)
(if (NC.YesP (NC.AskUser "Do you really want to abort the Inspect & Repair process? " NIL
(QUOTE Yes)
T NIL T NIL T))
then (for MenuWin in (WINDOWPROP MainWin (QUOTE MENUWINDOWS))
do (WINDOWDELPROP MenuWin (QUOTE CLOSEFN)
(FUNCTION NC.CardInspectorCloseFn))
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin))
(MOVEW MainWin NC.OffScreenPosition)
(AND (OPENP Stream)
(NC.ScavengerCleanup Stream))
else (QUOTE DON'T)))))
)
(* * Functions for building the scavenger array and reading things in the data area robustly.)
(DEFINEQ
(NC.BuildScavengerArray
(LAMBDA (Stream ReadSubstancesFlg MessageWin) (* rht: "25-Oct-85 20:35")
(* * Return an array containing pointers to all valid versions of notecard parts, i.e. substances, titles, links,
and proplists. If ReadSubstancesFlg is non-nil, then read substances when checking rather than just checking that
start and end substance pointers make sense.)
(* * rht 9/17/85: Now keeps track of largest ID seen and caches on MessageWin's WINDOWPROP.)
(PROG (ScavengerArray EndPtr CurPtr BadCardTypesList (MaxIDNum 0))
(SETFILEPTR Stream 8)
(SETQ EndPtr (GETEOFPTR Stream)) (* Initialize bad card types list to nil.
NC.RobustReadCardPart will add to it as it finds
unknown card types.)
(WINDOWPROP MessageWin (QUOTE BADCARDTYPESLIST)
NIL)
(SETQ ScavengerArray (ARRAY (ARRAYSIZE (STREAMPROP Stream (QUOTE NCINDEXARRAY)))
NIL NIL 0))
(NC.PrintMsg NIL T "Processing data area of notefile ..." (CHARACTER 13)
"Searching for start of data area ..."
(CHARACTER 13)) (* Find start of data area)
(SETQ CurPtr (NC.SearchFor###OrNOBIND Stream 0)) (* Walk, don't run, through the data area trying to
find good card parts.)
(if (for bind (LastPtrHighBits ← 0)
CurPtrHighBits ID
eachtime (BLOCK) while (AND CurPtr (LESSP CurPtr EndPtr))
do (* Print a message every 8K or so bytes.)
(if (GREATERP (SETQ CurPtrHighBits (LRSH CurPtr 13))
LastPtrHighBits)
then (NC.PrintMsg NIL T "Processing data area of notefile ..." (CHARACTER
13)
"Byte number: "
(QUOTIENT CurPtr 1000)
"K out of "
(QUOTIENT EndPtr 1000)
"K."
(CHARACTER 13))
(SETQ LastPtrHighBits CurPtrHighBits))
(* Try to read a card part. If returns nil, then search
for next # marker and try again.)
(if (SETQ ID (NC.RobustReadCardPart Stream ReadSubstancesFlg MessageWin
ScavengerArray EndPtr))
then (SETQ CurPtr (GETFILEPTR Stream))
(SETQ MaxIDNum (MAX (NC.NumberFromID ID)
MaxIDNum))
else (SETQ CurPtr (NC.SearchFor###OrNOBIND Stream (ADD1 CurPtr))))
finally (RETURN (QUOTE SUCCESS)))
then (NC.PrintMsg NIL NIL "Done." (CHARACTER 13))
(WINDOWPROP MessageWin (QUOTE MAXIDNUM)
MaxIDNum)
(RETURN ScavengerArray)))))
(NC.RobustReadCardPart
(LAMBDA (Stream ReadSubstancesFlg MessageWin ScavengerArray EndPtr)
(* rht: "26-Sep-85 00:37")
(* * Assume stream is positioned at start of a card part. Try to read one and modify scavenger array according to
what we find.)
(* * rht 9/17/85: Now returns ID rather than litatom SUCCESS is wins.)
(OR EndPtr (SETQ EndPtr (GETEOFPTR Stream)))
(LET ((CurPtr (GETFILEPTR Stream))
IdentifierAndVersionNum Date ID ArrayIDOffset IdentifierAtom Title Offset ToLinks FromLinks
GlobalLinks PropList Type SubstanceLength LinkLabels)
(if (AND (SETQ IdentifierAndVersionNum (NC.RobustReadItemIdentifier Stream))
(if (GEQ (CDR IdentifierAndVersionNum)
1)
then (SETQ Date (NC.RobustReadDate Stream))
else T)
(SETQ ID (NC.RobustReadID Stream))
(SETQ ArrayIDOffset (NC.ScavengerArrayOffsetFromID ID)))
then (SETQ Date (CAR Date))
(SETQ IdentifierAtom (CAR IdentifierAndVersionNum))
(if (COND
((EQ IdentifierAtom NC.TitlesIdentifier)
(* Hoping to get a healthy title.)
(if (AND (SETQ Title (NC.RobustReadString Stream))
(NC.AtEndOfItemP Stream EndPtr))
then (SETA ScavengerArray (SETQ Offset (PLUS ArrayIDOffset
NC.ScavengerArrayTitleOffset))
(CONS (LIST CurPtr Date Title)
(ELT ScavengerArray Offset)))))
((EQ IdentifierAtom NC.PropsIdentifier)
(* Hoping to get a healthy prop list.)
(if (AND (SETQ PropList (NC.RobustReadList Stream))
(NC.AtEndOfItemP Stream))
then (SETA ScavengerArray (SETQ Offset (PLUS ArrayIDOffset
NC.ScavengerArrayPropListOffset))
(CONS (LIST CurPtr Date (LENGTH (CAR PropList)))
(ELT ScavengerArray Offset)))))
((EQ IdentifierAtom NC.LinksIdentifier)
(* Hoping to get healthy links.
Try to read three lists: ToLinks, FromLinks, and Global
links.)
(if (AND (SETQ ToLinks (NC.RobustReadLinks Stream))
(SETQ FromLinks (NC.RobustReadLinks Stream))
(SETQ GlobalLinks (NC.RobustReadLinks Stream))
(NC.AtEndOfItemP Stream EndPtr))
then (SETA ScavengerArray (SETQ Offset (PLUS ArrayIDOffset
NC.ScavengerArrayLinksOffset))
(CONS (LIST CurPtr Date (LIST (LENGTH (CAR ToLinks))
(LENGTH (CAR FromLinks))
(LENGTH (CAR GlobalLinks))))
(ELT ScavengerArray Offset)))))
((EQ IdentifierAtom NC.ItemIdentifier)
(* Hoping to get healthy substance.)
(if (AND (SETQ Type (CAR (NC.RobustReadAtom Stream)))
(NC.RobustReadRegion Stream EndPtr)
(SETQ SubstanceLength (NC.CheckForValidSubstance Stream EndPtr ID
Type
ReadSubstancesFlg))
(NC.AtEndOfItemP Stream))
then (if (NOT (NCP.ValidCardType Type))
then (* Code for this card part type has not been loaded.)
(WINDOWADDPROP MessageWin (QUOTE UNKNOWNCARDTYPESLIST)
Type)
(* Save the pointer to the substance card part on the
unknown type's proplist.)
(ADDPROP Type (QUOTE SUBSTANCEPTRS)
CurPtr))
(SETA ScavengerArray (SETQ Offset (PLUS ArrayIDOffset
NC.ScavengerArraySubstanceOffset))
(CONS (LIST CurPtr Date Type (OR SubstanceLength (QUOTE
UNKNOWNCARDTYPE)))
(ELT ScavengerArray Offset)))))
((EQ IdentifierAtom NC.LinkLabelsIdentifier)
(* Hoping to get healthy link labels.)
(if (AND (SETQ LinkLabels (NC.RobustReadList Stream))
(NC.AtEndOfItemP Stream EndPtr))
then (SETA ScavengerArray (SETQ Offset (PLUS ArrayIDOffset
NC.ScavengerArrayLinkLabelsOffset))
(CONS (LIST CurPtr Date (LENGTH LinkLabels))
(ELT ScavengerArray Offset))))))
then ID)))))
(NC.ScavengerArrayOffsetFromID
(LAMBDA (ID) (* rht: " 6-Jun-85 17:06")
(* * Compute the offset in the scavenger array for this ID. For now, this works just like the index array since both
have 5 elements per ID.)
(NC.IndexFromID ID)))
(NC.CheckForValidSubstance
(LAMBDA (Stream EofPtr ID CardType ReadSubstanceFlg) (* rht: "30-Sep-85 10:57")
(* * Check whether we've got a valid substance at current pos in Stream. Check for a valid StartPtr and EndPtr.
If ReadSubstanceFlg is non-nil, then do robust get of the substance. Return length of substance or nil.)
(LET ((OldPtr (GETFILEPTR Stream))
StartPtr EndPtr Val)
(OR EofPtr (SETQ EofPtr (GETEOFPTR Stream)))
(if (AND (LESSP (GETFILEPTR Stream)
(DIFFERENCE EofPtr 6))
(SETQ StartPtr (NC.GetPtr Stream))
(SETQ EndPtr (NC.GetPtr Stream))
(EQUAL StartPtr (GETFILEPTR Stream))
(GEQ EndPtr StartPtr)
(LESSP EndPtr EofPtr)
(OR (NOT ReadSubstanceFlg)
(NOT (NCP.ValidCardType CardType))
(PROGN (SETFILEPTR Stream OldPtr)
(NC.RobustGetSubstance Stream ID CardType)))
(SETFILEPTR Stream EndPtr)
(DIFFERENCE EndPtr StartPtr))
else (SETFILEPTR Stream OldPtr)
NIL))))
(NC.SearchFor###OrNOBIND
(LAMBDA (Stream Ptr) (* rht: "26-Aug-85 18:49")
(* * Move the file ptr to next occurrence of either # or NOBIND. The latter is for the stupid case of NOBIND instead
of titles identifier. The choice of FFILEPOS rather than FILEPOS for the NOBIND search is based on empirical
evidence from TIMEALL.)
(LET (NewPtr)
(if (ZEROP Ptr)
then (* If we're here for the first time, then find first
occurrence of ### and see if there's a NOBIND before
it.)
(SETQ NewPtr (FILEPOS (QUOTE ###)
Stream Ptr))
(if (SETQ NC.NextNOBINDLoc (FFILEPOS (QUOTE NOBIND)
Stream Ptr NewPtr))
then (SETFILEPTR Stream NC.NextNOBINDLoc)
else (SETQ NC.NextNOBINDLoc 0)
(AND NewPtr (SETFILEPTR Stream NewPtr)))
else (if (ILESSP NC.NextNOBINDLoc Ptr)
then (SETQ NC.NextNOBINDLoc (OR (FFILEPOS (QUOTE NOBIND)
Stream Ptr)
MAX.INTEGER)))
(if (ILESSP (SETQ NewPtr (IMIN NC.NextNOBINDLoc (OR (FILEPOS (QUOTE ###)
Stream Ptr)
MAX.INTEGER)))
MAX.INTEGER)
then (SETFILEPTR Stream NewPtr)
else NIL)))))
(NC.AtEndOfItemP
(LAMBDA (Stream EofPtr) (* rht: " 9-Aug-85 15:26")
(* * Return T if at the end of an item. That means either we're at the end of the file, or there's a # at the
current location.)
(LET ((OldPtr (GETFILEPTR Stream))
AfterWhiteSpacePtr)
(OR EofPtr (SETQ EofPtr (GETEOFPTR Stream)))
(NC.SkipWhiteSpace Stream EofPtr T)
(SETQ AfterWhiteSpacePtr (GETFILEPTR Stream))
(COND
((OR (GEQ (GETFILEPTR Stream)
EofPtr)
(EQ (PEEKC Stream)
(QUOTE #))))
((EQ (CAR (NC.RobustReadAtom Stream))
(QUOTE NOBIND)) (* This is to handle that ugly 1.1 error where the
litatom NOBIND was being written out in place of titles
item identifier.)
(SETFILEPTR Stream AfterWhiteSpacePtr)
T)
(T (SETFILEPTR Stream OldPtr)
NIL)))))
(NC.RobustRead
(LAMBDA (Stream) (* rht: "16-Jul-85 20:14")
(* * Try to read an object, In an NLSETQ so we won't see error messages. The RESETVAR is so that no breaks will
occur. This returns list of the one element read or NIL if unsuccessful read.)
(RESETVAR HELPFLAG NIL (NLSETQ (READ Stream)))))
(NC.RobustReadItemIdentifier
(LAMBDA (Stream) (* rht: "16-Jul-85 17:25")
(* * Look for an item identifier at the current position in Stream. If successful, return the part/item type.)
(LET ((OldPtr (GETFILEPTR Stream))
Atom VersionNumber)
(SETQ Atom (CAR (NC.RobustRead Stream))) (* UGLY! This is to handle a 1.1 bug that was writing
out the litatom NOBIND instead of title item
identifier.)
(if (EQ Atom (QUOTE NOBIND))
then (SETQ Atom NC.TitlesIdentifier))
(COND
((FMEMB Atom NC.IdentifierAtoms)
(CONS Atom 0))
((AND (FMEMB Atom NC.ClippedIdentifierAtoms)
(NC.RobustReadChar Stream)
(NUMBERP (SETQ VersionNumber (CAR (NC.RobustReadByte Stream)))))
(CONS (PACK* Atom (QUOTE ##))
VersionNumber))
(T (SETFILEPTR Stream OldPtr)
NIL)))))
(NC.RobustReadID
(LAMBDA (Stream) (* rht: " 6-Jun-85 23:14")
(* * Try to read a Notecards ID from Stream. Return NIL if it's not a valid ID.)
(PROG (Val (OldPtr (GETFILEPTR Stream)))
(RETURN (if (NC.IDP (SETQ Val (CAR (NC.RobustRead Stream))))
then Val
else (SETFILEPTR Stream OldPtr)
NIL)))))
(NC.RobustReadString
(LAMBDA (Stream) (* rht: "10-Jul-85 10:56")
(* * Try to read a string from Stream. Return NIL if not.)
(LET (Val (OldPtr (GETFILEPTR Stream)))
(if (STRINGP (SETQ Val (CAR (NC.RobustRead Stream))))
then Val
else (SETFILEPTR Stream OldPtr)
NIL))))
(NC.RobustReadList
(LAMBDA (Stream) (* rht: "22-Jul-85 17:06")
(* * Try to read a list from Stream. Returns a list of one element, the list read, if successful.
NIL otherwise.)
(LET (Val (OldPtr (GETFILEPTR Stream)))
(if (AND (SETQ Val (NC.RobustRead Stream))
(OR (NULL (CAR Val))
(LISTP (CAR Val))))
then Val
else (SETFILEPTR Stream OldPtr)
NIL))))
(NC.RobustReadLinks
(LAMBDA (Stream) (* rht: "22-Jul-85 17:06")
(* * Try to read a list of links from Stream. Return list of one element, the list read, if successful, NIL
otherwise.)
(LET ((ListThing (NC.RobustReadList Stream))
List)
(if (SETQ List (CAR ListThing))
then (NC.CheckLinkRecordFormat List)
(for Link in List do (NC.CheckDisplayModeFormat Link)))
ListThing)))
(NC.RobustReadAtom
(LAMBDA (Stream) (* rht: " 6-Jun-85 23:24")
(* * Returns a list of one element, the atom found. If unsuccessful read, then return nil.)
(PROG ((OldPtr (GETFILEPTR Stream))
Val)
(RETURN (if (AND (SETQ Val (NC.RobustRead Stream))
(ATOM (CAR Val)))
then Val
else (SETFILEPTR Stream OldPtr)
NIL)))))
(NC.RobustReadRegion
(LAMBDA (Stream EofPtr) (* rht: " 6-Jun-85 22:28")
(* * Try to read a notecards region. Return region or nil.)
(PROG ((OldPtr (GETFILEPTR Stream))
Val)
(OR EofPtr (SETQ EofPtr (GETEOFPTR Stream)))
(NC.SkipWhiteSpace Stream EofPtr)
(RETURN (if (AND (LESSP (GETFILEPTR Stream)
(DIFFERENCE EofPtr 8))
(for i from 1 to 4 bind Num collect (if (GEQ (SETQ Num (NC.GetPtr Stream 2)
)
0)
then Num
else (RETURN NIL))))
else (SETFILEPTR Stream OldPtr)
NIL)))))
(NC.RobustGetSubstance
(LAMBDA (Stream ID CardType) (* rht: "27-Jul-85 23:38")
(* * Try to get substance robustly. RESETVAR prevents breaks. Returns either substance or nil if unsuccessful.)
(RESETVAR HELPFLAG NIL (NLSETQ (APPLY* (NC.GetSubstanceFn CardType)
Stream ID)))))
(NC.SkipWhiteSpace
(LAMBDA (Stream EofPtr SkipNullsFlg) (* rht: " 9-Aug-85 15:25")
(* * Skip over all separator characters. There seem to be nulls at the end of the file sometimes
(char code = 0) so SkipNullsFlg = T calls them white space.)
(PROG ((CurPtr (GETFILEPTR Stream))
(SeprChars (GETSEPR)))
(OR EofPtr (SETQ EofPtr (GETEOFPTR Stream)))
(if SkipNullsFlg
then (SETQ SeprChars (CONS 0 SeprChars)))
(for Ptr from CurPtr while (AND (LESSP Ptr EofPtr)
(FMEMB (NTHCHARCODE (PEEKC Stream)
1)
SeprChars))
do (READC Stream)))))
(NC.RobustReadDate
(LAMBDA (Stream) (* rht: "10-Jul-85 13:35")
(* * Try to read a date string or the litatom NIL. Return a list containing the date or NIL indicating failure.)
(LET (Val (OldPtr (GETFILEPTR Stream)))
(if (OR (NULL (SETQ Val (CAR (NC.RobustRead Stream))))
(AND (STRINGP Val)
(EQ (NCHARS Val)
NC.DateStringLength)))
then (LIST Val)
else (SETFILEPTR Stream OldPtr)
NIL))))
(NC.RobustReadChar
(LAMBDA (Stream) (* rht: "10-Jul-85 12:31")
(* * Try to read a character, In an NLSETQ so we won't see error messages. The RESETVAR is so that no breaks will
occur. This returns list of the one element read or NIL if unsuccessful read.)
(RESETVAR HELPFLAG NIL (NLSETQ (READC Stream)))))
(NC.RobustReadByte
(LAMBDA (Stream) (* rht: "10-Jul-85 23:07")
(* * Try to read a byte, In an NLSETQ so we won't see error messages. The RESETVAR is so that no breaks will occur.
This returns list of the one element read or NIL if unsuccessful read.)
(RESETVAR HELPFLAG NIL (NLSETQ (NC.GetPtr Stream 1)))))
)
(* * Functions for accessing the scavenger array.)
(DEFINEQ
(NC.GetTypeFromScavengerArray
(LAMBDA (ID ScavengerArray) (* rht: "10-Jul-85 14:06")
(* * Return the type from the most recent instance of ID in the ScavengerArray.)
(CADDAR (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID ID)
NC.ScavengerArraySubstanceOffset)))))
(NC.GetTitleFromScavengerArray
(LAMBDA (ID ScavengerArray) (* rht: "10-Jul-85 14:06")
(* * Return the title from the most recent instance of ID in the ScavengerArray.)
(CADDAR (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID ID)
NC.ScavengerArrayTitleOffset)))))
)
(* * Functions for building bad cards list based on the index array and scavenger array.)
(DEFINEQ
(NC.BuildBadCardsList
(LAMBDA (Stream ScavengerArray MessageWin FirstTimeFlg) (* rht: "25-Oct-85 21:20")
(* * Returns a list of all IDs with illegal index pointers, i.e. pointers not to valid data areas recorded in
ScavengerArray. Also record those IDs with pointers beyond checkpoint ptr.)
(* * rht 9/17/85: Now takes MessageWin argument so can extract the MaxIDNum off its props.)
(LET ((CardTotal (WINDOWPROP MessageWin (QUOTE MAXIDNUM))))
(NC.PrintMsg NIL T "Building bad cards list ...")
(PROG1 (for Num from 1 to CardTotal bind ID ArrayIDOffset (BadIndicesList ←(STREAMPROP
Stream
(QUOTE NCBADCARDS)))
BadNewsIndicators IndexPtrs Problems
(CheckptPtr ←(PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream)))
Status OldStatus LinkLabelsProblem Type
eachtime (BLOCK)
join (if (ZEROP (IREMAINDER Num 100))
then (NC.PrintMsg NIL T "Building bad cards list ..." (CHARACTER 13)
"Processing item number " Num " out of " CardTotal "."
(CHARACTER 13)))
(SETQ ID (NC.IDFromNumber Num))
(SETQ ArrayIDOffset (NC.ScavengerArrayOffsetFromID ID))
(* Grab any bad news about index pointers for this ID
that was cached on the stream by NC.BuildIndexArray.)
(SETQ BadNewsIndicators (CDAR (FMEMB ID BadIndicesList)))
(SETQ IndexPtrs (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (SETQ OldStatus (fetch (POINTERLIST STATUS) of IndexPtrs)))
(* Return BadNewsIndicators plus any new ones found by
checking index pointers against scavenger array.
Throw out NILs.)
(PROG1 (COND
((NC.WorthlessCardP ID Stream ScavengerArray IndexPtrs)
(* Don't even bother checking the truly worthless
cards.)
NIL)
((EQ ID NC.LinkLabelsID)
(if (SETQ LinkLabelsProblem (NC.CheckIndexPtrAgainstScavengerArray
ScavengerArray
(fetch (POINTERLIST MAINPTR) of IndexPtrs)
(PLUS ArrayIDOffset NC.ScavengerArrayLinkLabelsOffset)
(QUOTE LINKLABELS)
CheckptPtr Stream ID IndexPtrs MessageWin FirstTimeFlg))
then (* Deal with the special case of the ID for link
labels.)
(BQUOTE ((, (QUOTE LNTYPES)
,
(SETQ Status (fetch (POINTERLIST STATUS)
of IndexPtrs))
,
(PACK* (QUOTE LNTYPES)
(NC.EncodeCardProblems (LIST
LinkLabelsProblem)))
, LinkLabelsProblem)))))
((AND (FMEMB Status (QUOTE (ACTIVE DELETED SPECIAL BADPOINTER NIL)))
(SETQ Problems
(NCONC (LSUBST NIL NIL
(LIST (if (NOT (FMEMB (QUOTE BADITEMPTR)
BadNewsIndicators))
then (
NC.CheckIndexPtrAgainstScavengerArray ScavengerArray (fetch (POINTERLIST MAINPTR) of IndexPtrs)
(PLUS ArrayIDOffset NC.ScavengerArraySubstanceOffset)
(QUOTE SUBSTANCE)
CheckptPtr Stream ID IndexPtrs MessageWin FirstTimeFlg))
(if (NOT (FMEMB (QUOTE BADLINKSPTR)
BadNewsIndicators))
then (
NC.CheckIndexPtrAgainstScavengerArray ScavengerArray (fetch (POINTERLIST LINKSPTR) of IndexPtrs)
(PLUS ArrayIDOffset NC.ScavengerArrayLinksOffset)
(QUOTE LINKS)
CheckptPtr Stream ID IndexPtrs MessageWin FirstTimeFlg))
(if (NOT (FMEMB (QUOTE BADTITLEPTR)
BadNewsIndicators))
then (
NC.CheckIndexPtrAgainstScavengerArray ScavengerArray (fetch (POINTERLIST TITLEPTR) of IndexPtrs)
(PLUS ArrayIDOffset NC.ScavengerArrayTitleOffset)
(QUOTE TITLE)
CheckptPtr Stream ID IndexPtrs MessageWin FirstTimeFlg))
(if (NOT (FMEMB (QUOTE BADPROPLISTPTR)
BadNewsIndicators))
then (
NC.CheckIndexPtrAgainstScavengerArray ScavengerArray (fetch (POINTERLIST PROPSPTR) of IndexPtrs)
(PLUS ArrayIDOffset NC.ScavengerArrayPropListOffset)
(QUOTE PROPLIST)
CheckptPtr Stream ID IndexPtrs MessageWin FirstTimeFlg))))
BadNewsIndicators
(if (AND (SETQ Type (NC.GetTypeFromScavengerArray ID
ScavengerArray))
(NOT (NCP.ValidCardType Type)))
then (LIST (QUOTE UNKNOWNCARDTYPE))
else NIL))))
(BQUOTE ((, ID , (SETQ Status (fetch (POINTERLIST STATUS)
of IndexPtrs))
,
(PACK* ID (NC.EncodeCardProblems Problems))
,@ Problems)))))
(if (NEQ Status OldStatus)
then
(* * If one of calls to NC.CheckIndexPtrAgainstScavengerArray changed status, to ACTIVE or SPECIAL, then change out
in the index array.)
(NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.PutStatusToIndex Stream Status))))
(NC.PrintMsg NIL T "Done.")))))
(NC.WorthlessCardP
(LAMBDA (ID Stream ScavengerArray IndexPtrs) (* rht: "25-Oct-85 21:33")
(* * Return non-nil if card is totally worthless, i.e. is not a top level card, has no valid versions of any of its
parts in scavenger array, has zeroes in all the fields of the index array, and has status NIL or DELETED.)
(OR IndexPtrs (SETQ IndexPtrs (NC.GetPtrsFromIndex Stream ID)))
(LET ((ArrayIDOffset (NC.ScavengerArrayOffsetFromID ID)))
(AND (FMEMB (fetch (POINTERLIST STATUS) of IndexPtrs)
(QUOTE (NIL DELETED)))
(ZEROP (fetch (POINTERLIST MAINPTR) of IndexPtrs))
(ZEROP (fetch (POINTERLIST LINKSPTR) of IndexPtrs))
(ZEROP (fetch (POINTERLIST TITLEPTR) of IndexPtrs))
(ZEROP (fetch (POINTERLIST PROPSPTR) of IndexPtrs))
(NOT (FMEMB ID NC.TopLevelCards))
(NULL (ELT ScavengerArray (PLUS ArrayIDOffset NC.ScavengerArraySubstanceOffset)))
(NULL (ELT ScavengerArray (PLUS ArrayIDOffset NC.ScavengerArrayLinksOffset)))
(NULL (ELT ScavengerArray (PLUS ArrayIDOffset NC.ScavengerArrayTitleOffset)))
(NULL (ELT ScavengerArray (PLUS ArrayIDOffset NC.ScavengerArrayPropListOffset)))))))
(NC.CheckIndexPtrAgainstScavengerArray
(LAMBDA (Array Ptr ArrayOffset ItemAtom ChkptPtr Stream ID IndexPtrs MessageWin CanModifyFlg)
(* rht: "25-Oct-85 20:13")
(* * Check if Ptr is a valid ptr in the scavenger array. If not, return an atom indicating the problem.)
(* * rht 9/25/85: Now returns the PASTCHKPT indicator if any version is past the checkpoint, not just the current
one. Also updates index array to point to latest/largest value if any are beyond checkpoint ptr.)
(* * rht 9/26/85: Added CanModifyFlg to prevent modification of the index array. This will be NIL on every scavenger
run after the first.)
(LET ((ScavengerInfo (ELT Array ArrayOffset))
(Status (fetch (POINTERLIST STATUS) of IndexPtrs))
MaxBeyondCheckptPtr) (* See if there's any version that's beyond the
checkpoint. If so, record the biggest.)
(SETQ MaxBeyondCheckptPtr (CAR (for Elt in ScavengerInfo eachtime (BLOCK)
when (GEQ (CAR Elt)
ChkptPtr)
largest (CAR Elt))))
(COND
((AND CanModifyFlg MaxBeyondCheckptPtr) (* Must be case that card part was changed after
checkpoint. So update index array with ptr to latest
version.)
(if (NULL Status)
then (* Make status ACTIVE or SPECIAL if NIL before.)
(replace (POINTERLIST STATUS) of IndexPtrs with (if (EQ ItemAtom (QUOTE LINKLABELS)
)
then (QUOTE SPECIAL)
else (QUOTE ACTIVE))))
(NC.SetIndexOffset Stream (PLUS ArrayOffset 1))
(NC.PutPtrToIndex Stream MaxBeyondCheckptPtr) (* Since we've modified index array, user must go to
phase 3 or abort.)
(WINDOWPROP MessageWin (QUOTE NEEDLINKSCAVENGE)
T)
(PACK* ItemAtom (QUOTE PASTCHKPT)))
((SASSOC Ptr ScavengerInfo) (* Found an occurrence of the index ptr in the
scavenger array. We return NIL signifying no error or a
"past checkpoint" indicator.)
(if (GEQ Ptr ChkptPtr)
then (PACK* ItemAtom (QUOTE PASTCHKPT))
else NIL))
(T (* The index points to a bad item.)
(PACK* (QUOTE BAD)
ItemAtom))))))
)
(* * Functions for backing up a card part to its previous version.)
(DEFINEQ
(NC.RestorePreviousTitle
(LAMBDA (ID ScavengerArray Stream) (* rht: "26-Jun-85 18:19")
(* * For given ID, restore its title to the previous version. Pointers to previous versions are found in
ScavengerArray.)
(NC.PrintMsg NIL NIL "Restoring previous title of " ID "..." (CHARACTER 13))
(NC.SetIndexOffset Stream (PLUS (NC.IndexFromID ID)
NC.ScavengerArrayTitleOffset))
(NC.PutPtrToIndex Stream (CAAR (ELT ScavengerArray (PLUS NC.ScavengerArrayTitleOffset
(NC.ScavengerArrayOffsetFromID ID)))))))
(NC.RestorePreviousSubstance
(LAMBDA (ID ScavengerArray Stream) (* rht: "26-Jun-85 18:18")
(* * For given ID, restore its substance to the previous version. Pointers to previous versions are found in
ScavengerArray.)
(NC.PrintMsg NIL NIL "Restoring previous substance of " ID "..." (CHARACTER 13))
(NC.SetIndexOffset Stream (PLUS (NC.IndexFromID ID)
NC.ScavengerArraySubstanceOffset))
(NC.PutPtrToIndex Stream (CAAR (ELT ScavengerArray (PLUS NC.ScavengerArraySubstanceOffset
(NC.ScavengerArrayOffsetFromID ID)))))))
(NC.RestorePreviousLinks
(LAMBDA (ID ScavengerArray Stream) (* rht: "12-Jul-85 14:04")
(* * For given ID, restore its links to the previous version. Pointers to previous versions are found in
ScavengerArray.)
(NC.PrintMsg NIL NIL "Restoring previous links of " ID "..." (CHARACTER 13))
(NC.SetIndexOffset Stream (PLUS (NC.IndexFromID ID)
NC.ScavengerArrayLinksOffset 1))
(NC.PutPtrToIndex Stream (CAR (ELT ScavengerArray (PLUS NC.ScavengerArrayLinksOffset
(NC.ScavengerArrayOffsetFromID ID)))))))
(NC.RestorePreviousPropList
(LAMBDA (ID ScavengerArray Stream) (* rht: "26-Jun-85 18:19")
(* * For given ID, restore its prop list to the previous version. Pointers to previous versions are found in
ScavengerArray.)
(NC.PrintMsg NIL NIL "Restoring previous prop list of " ID "..." (CHARACTER 13))
(NC.SetIndexOffset Stream (PLUS (NC.IndexFromID ID)
NC.ScavengerArrayPropListOffset))
(NC.PutPtrToIndex Stream (CAR (ELT ScavengerArray (PLUS NC.ScavengerArrayPropListOffset
(NC.ScavengerArrayOffsetFromID ID)))))))
)
(* * Functions for interacting with the user.)
(DEFINEQ
(NC.BuildCardInspectorMenu
(LAMBDA (Cards ScavengerArray BadNewsList Stream MessageWin)
(* rht: "18-Oct-85 15:35")
(* * Build a list of menu containing all valid cards giving ID #s and indicators as to problems, if any.
ID #s can be invoked causing a window/menu containing info on the card to be brought up.)
(LET (MenuWindows TotalMenus FirstWindow FirstWindowSize AttachedMenu)
(if (NOT (WINDOWP MessageWin))
then (NC.ReportError "NC.BuildCardInspectorMenu" (CONCAT "Arg not window: " MessageWin)))
(SETQ Cards (CONS (QUOTE LNTYPES)
Cards))
(OR Stream (SETQ Stream PSA.Database))
(SETQ TotalMenus (ADD1 (QUOTIENT (SUB1 (LENGTH Cards))
NC.CardsPerMenuLimit)))
(* Build the attached menu for global menu operations
including moving to next or previous page if
necessary.)
(SETQ AttachedMenu (create MENU
ITEMS ←(BQUOTE ((Abort (QUOTE Abort)
"Abort the repair process, throwing away all changes.")
(Done (QUOTE Done)
"Integrate changes (i.e. checkpoint notefile) and continue repair.")
(Search (QUOTE Search)
"Find IDs for cards with titles containing search string.")
,@(if (GEQ TotalMenus 2)
then (QUOTE ((Previous% Page (QUOTE
Previous% Page)
"Move to menu for previous page of cards.")
(Next% Page (QUOTE Next% Page)
"Move to menu for previous page of cards.")
(First% Page (QUOTE First% Page)
"Move to menu for first page of cards.")))))
)
CENTERFLG ← T
MENUCOLUMNS ← 1
WHENSELECTEDFN ←(FUNCTION NC.CardInspectorAttachedMenuWhenSelectedFn)
MENUFONT ← NC.ScavengerAttachedMenuFont))
(* Build the menus and attachments and store on message
window prop.)
(WINDOWPROP MessageWin (QUOTE MENUWINDOWS)
(SETQ MenuWindows
(for MenuNum from 1 to TotalMenus bind (RestOfCards ← Cards)
Menu Window Items AttachedWindow
collect (SETQ Menu
(create MENU
ITEMS ←(SETQ Items
(for old RestOfCards on RestOfCards as i from 1
to NC.CardsPerMenuLimit bind Card
collect (LIST (OR (CADDR (FASSOC (SETQ Card
(CAR RestOfCards))
BadNewsList))
Card)
Card)))
TITLE ←(CONCAT "Card inspector: Page " MenuNum " of "
TotalMenus)
WHENSELECTEDFN ←(FUNCTION NC.CardInspectorMenuWhenSelectedFn)
MENUROWS ←(MIN 30 (LENGTH Items))))
(SETQ Window (ADDMENU Menu NIL NC.OffScreenPosition))
(* Shade the troublesome items in this menu.)
(for News in BadNewsList bind Item when (SETQ Item
(FASSOC (CADDR News)
Items))
do (SHADEITEM Item Menu NC.LightShade))
(WINDOWPROP Window (QUOTE SCAVENGERARRAY)
ScavengerArray)
(WINDOWPROP Window (QUOTE STREAM)
Stream) (* Rig so that lines through deleted entries will be
drawn whenever menu is redisplayed.)
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.CardInspectorRepaintFn))
(* This makes closing the cards inspector menu same as
selecting "abort" from the attached menu.
That is, abort the repair process.)
(WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.CardInspectorCloseFn)
(QUOTE FIRST))
(ATTACHWINDOW (ADDMENU AttachedMenu NIL NC.OffScreenPosition)
Window
(QUOTE RIGHT)
(QUOTE TOP))
Window))) (* Attach the first menu with its attached operations
menu to message window's lower left edge.)
(SETQ FirstWindow (CAR MenuWindows))
(ATTACHWINDOW FirstWindow MessageWin (QUOTE BOTTOM)
(QUOTE LEFT))
(REDISPLAYW FirstWindow))))
(NC.EncodeCardProblems
(LAMBDA (ProblemIndicators) (* rht: "17-Aug-85 23:26")
(* * Return a string of up to 4 characters encoding the problems with Card. It's null if card is okay.
Otherwise contains the chars L, S, P, and/or T representing bum links, substance, prop list or title.
Lowercase letters l, s, p, t represent fact that latest links, say, were written out beyond the checkpoint pointer.
There's also the letter U representing unknown card type.)
(CONCAT (COND
((INTERSECTION (QUOTE (BADLINKS BADLINKSPTR))
ProblemIndicators)
(QUOTE L))
((FMEMB (QUOTE LINKSPASTCHKPT)
ProblemIndicators)
(QUOTE l))
(T ""))
(COND
((INTERSECTION (QUOTE (BADSUBSTANCE BADSUBSTANCEPTR BADLINKLABELS))
ProblemIndicators)
(QUOTE S))
((INTERSECTION (QUOTE (SUBSTANCEPASTCHKPT LINKLABELSPASTCHKPT))
ProblemIndicators)
(QUOTE s))
(T ""))
(COND
((INTERSECTION (QUOTE (BADPROPLIST BADPROPLISTPTR))
ProblemIndicators)
(QUOTE P))
((FMEMB (QUOTE PROPLISTPASTCHKPT)
ProblemIndicators)
(QUOTE p))
(T ""))
(COND
((INTERSECTION (QUOTE (BADTITLE BADTITLEPTR))
ProblemIndicators)
(QUOTE T))
((FMEMB (QUOTE TITLEPASTCHKPT)
ProblemIndicators)
(QUOTE t))
(T ""))
(COND
((FMEMB (QUOTE UNKNOWNCARDTYPE)
ProblemIndicators)
(QUOTE U))
(T "")))))
(NC.CardInspectorCloseFn
(LAMBDA (Win Don'tAskFlg) (* rht: "26-Sep-85 01:57")
(* * Closing inspector window is just like selecting "abort" from attached menu, i.e. abort the repair process.)
(LET ((Stream (WINDOWPROP Win (QUOTE STREAM)))
MainWin)
(if (OR Don'tAskFlg (NC.YesP (NC.AskUser
"Do you really want to abort the Inspect & Repair process? "
NIL
(QUOTE Yes)
T NIL T NIL T)))
then (SETQ MainWin (MAINWINDOW Win))
(DETACHWINDOW Win)
(for MenuWin in (WINDOWPROP MainWin (QUOTE MENUWINDOWS)) unless (EQ MenuWin Win)
do (WINDOWDELPROP MenuWin (QUOTE CLOSEFN)
(FUNCTION NC.CardInspectorCloseFn))
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin))
(WINDOWDELPROP MainWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MainWin)
(MOVEW Win NC.OffScreenPosition)
(AND (OPENP Stream)
(NC.ScavengerCleanup Stream))
else (QUOTE DON'T)))))
(NC.CardInspectorRepaintFn
(LAMBDA (Win Region) (* rht: "26-Jul-85 19:02")
(* * Checks the list of cards and draws lines through all the newly deleted or undeleted ones.
Draws in invert mode.)
(LET ((Stream (WINDOWPROP Win (QUOTE STREAM)))
(Menu (CAR (WINDOWPROP Win (QUOTE MENU))))
(MessageWin (MAINWINDOW Win))
DeletedCards)
(SETQ DeletedCards (COPY (WINDOWPROP MessageWin (QUOTE DELETEDCARDIDS))))
(for Item in (fetch (MENU ITEMS) of Menu) bind Status OnDeletedListFlg ID ItemRegion
when (NC.IDP (SETQ ID (CADR Item)))
do (SETQ ItemRegion (MENUITEMREGION Item Menu))
(SETQ Status (fetch (POINTERLIST STATUS) of (NC.GetPtrsFromIndex Stream ID)))
(SETQ OnDeletedListFlg (FMEMB ID DeletedCards))
(* Either take off newly undeleted card or add newly
deleted one.)
(COND
((AND OnDeletedListFlg (EQ Status (QUOTE ACTIVE)))
(SETQ DeletedCards (DREMOVE ID DeletedCards))
(SETQ OnDeletedListFlg NIL))
((AND (NOT OnDeletedListFlg)
(EQ Status (QUOTE DELETED)))
(SETQ DeletedCards (CONS ID DeletedCards))
(SETQ OnDeletedListFlg T)))
(if OnDeletedListFlg
then (* Draw line in invert mode through menu item.)
(LET ((YPoint (PLUS (LRSH (fetch (REGION HEIGHT) of ItemRegion)
1)
(fetch (REGION BOTTOM) of ItemRegion)))
(XLeft (fetch (REGION LEFT) of ItemRegion)))
(DRAWLINE XLeft YPoint (PLUS XLeft (fetch (REGION WIDTH) of ItemRegion))
YPoint 1 (QUOTE INVERT)
Win))))
(WINDOWPROP MessageWin (QUOTE DELETEDCARDIDS)
DeletedCards))))
(NC.CardInspectorMenuWhenSelectedFn
(LAMBDA (CardPair Menu MouseKey) (* rht: "13-Aug-85 14:40")
(* * Called when a card is selected from main card inspector menu. Pop up menu offering choice of "Inspect" or
"Delete".)
(AND CardPair (LET ((Win (WFROMMENU Menu))
(NormalItems (QUOTE ((Inspect (QUOTE Inspect)
"Bring up description of card.")
(Delete (QUOTE Delete)
"Mark this card as deleted."))))
(ItemsWithUndelete (QUOTE ((Inspect (QUOTE Inspect)
"Bring up description of card.")
(Undelete (QUOTE Undelete)
"Undelete this card."))))
(ItemsWithoutDelete (QUOTE ((Inspect (QUOTE Inspect)
"Bring up description of card."))))
(CardID (CADR CardPair))
DeletedCardIDs Stream ExistingWin MessageWin)
(SETQ MessageWin (MAINWINDOW Win))
(SETQ DeletedCardIDs (WINDOWPROP MessageWin (QUOTE DELETEDCARDIDS)))
(SETQ Stream (WINDOWPROP Win (QUOTE STREAM)))
(SELECTQ (MENU (create MENU
ITEMS ←(COND
((OR (EQ CardID (QUOTE LNTYPES))
(FMEMB CardID NC.TopLevelCards))
ItemsWithoutDelete)
((FMEMB CardID DeletedCardIDs)
ItemsWithUndelete)
(T NormalItems))))
(Inspect (if (SETQ ExistingWin (for InspectorWindow in (WINDOWPROP MessageWin
(QUOTE
INSPECTORWINDOWS))
when (AND (OPENWP Win)
(EQ CardID (WINDOWPROP Win
(QUOTE CARDID))
))
do (RETURN Win)))
then (FLASHW ExistingWin)
else (WINDOWADDPROP (MAINWINDOW Win)
(QUOTE INSPECTORWINDOWS)
(if (EQ CardID (QUOTE LNTYPES))
then (NC.BuildLinkLabelsInspector
(WINDOWPROP Win (QUOTE SCAVENGERARRAY))
(WINDOWPROP Win (QUOTE STREAM))
Win)
else (NC.BuildCardPartsInspector
CardID
(WINDOWPROP Win (QUOTE SCAVENGERARRAY))
(WINDOWPROP Win (QUOTE STREAM))
Win)))))
(Delete (NC.MarkCardDeleted CardID (WINDOWPROP Win (QUOTE STREAM)))
(WINDOWPROP Win (QUOTE MADECHANGES)
T)
(WINDOWPROP Win (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW Win))
(Undelete (* I wonder if allowing undeletion is dangerous.
We shall see.)
(NC.SetIndexOffset Stream (NC.IndexFromID CardID))
(NC.PutStatusToIndex Stream (QUOTE ACTIVE))
(* Indicate that we made a real change to some card.)
(WINDOWPROP Win (QUOTE MADECHANGES)
T) (* Not sure about this, but just to be safe, I decree
that undeleting requires link scavenge.)
(WINDOWPROP Win (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW Win))
NIL)))))
(NC.CardInspectorAttachedMenuWhenSelectedFn
(LAMBDA (Item Menu MouseKey) (* rht: "18-Oct-85 15:29")
(* * Called when leaving the main cards inspector menu. User is either aborting the scavenge or absorbing changes
and continuing. In latter case, we need to recompute scavenger array to check for if she has fixed whatever problems
there were. If so, then continue with link scavenge.)
(LET ((MainWin (MAINWINDOW (WFROMMENU Menu)))
(Operation (CAR Item))
MessageWin Stream InspectorWins NextWin MenuWindows ScavengerArray SearchString)
(SETQ ScavengerArray (WINDOWPROP MainWin (QUOTE SCAVENGERARRAY)))
(SETQ MessageWin (MAINWINDOW MainWin))
(SETQ MenuWindows (WINDOWPROP MessageWin (QUOTE MENUWINDOWS)))
(if (AND (OR (NEQ Operation (QUOTE ABORT))
(PROGN (FLASHW PROMPTWINDOW)
(NC.YesP (NC.AskUser
"Do you really want to abort the Inspect & Repair process? "
NIL
(QUOTE Yes)
T NIL T NIL T))))
(OR (NOT (FMEMB Operation (QUOTE (ABORT DONE))))
(for Win in (SETQ InspectorWins (WINDOWPROP MessageWin (QUOTE INSPECTORWINDOWS)))
never (OPENWP Win))
(PROG2 (NC.PrintMsg NIL T "There are open card inspector windows.")
(if (NC.YesP (NC.AskUser "Want to close them? " NIL "Yes" NIL NIL T NIL T))
then (for Win in InspectorWins when (OPENWP Win) do (CLOSEW Win))
T))))
then (SETQ Stream (WINDOWPROP MainWin (QUOTE STREAM)))
(SELECTQ Operation
(Abort (WINDOWDELPROP MainWin (QUOTE CLOSEFN)
(FUNCTION NC.CardInspectorCloseFn))
(NC.CardInspectorCloseFn MainWin T)
(CLOSEW MainWin))
(Done (DETACHWINDOW MainWin)
(WINDOWDELPROP MainWin (QUOTE CLOSEFN)
(FUNCTION NC.CardInspectorCloseFn))
(for MenuWin in (WINDOWPROP MessageWin (QUOTE MENUWINDOWS))
unless (EQ MenuWin MainWin)
do (WINDOWDELPROP MenuWin (QUOTE CLOSEFN)
(FUNCTION NC.CardInspectorCloseFn))
(CLOSEW MenuWin))
(if (WINDOWPROP MainWin (QUOTE MADECHANGES))
then (WINDOWPROP MessageWin (QUOTE NEEDCHECKPOINT)
T))
(WINDOWPROP MessageWin (QUOTE NEEDLINKSCAVENGE)
(OR (WINDOWPROP MessageWin (QUOTE NEEDLINKSCAVENGE))
(WINDOWPROP MainWin (QUOTE NEEDLINKSCAVENGE))))
(CLOSEW MainWin)
(* This "recursive" call will check to make sure everything is okay before invoking link scavenge.
I'm calling with ReadSubstancesFlg off, even if this call had it on. That's because we don't want it to be so slow
on the second go-around.)
(NC.ScavengerPhase1 Stream NIL MessageWin))
(Search
(* Simple-minded search for IDs of cards having titles containing the given search string. User is asked for string
in the prompt window, but answer appears in MessageWin for easy access.)
(SETQ SearchString (NC.AskUser "Search string? " NIL NIL T NIL T T
NIL))
(NC.PrintMsg NIL T "Searching ... ")
(NC.PrintMsg MessageWin NIL "IDs containing string '" SearchString
"': "
(for IDNum from 1 to (SUB1 (STREAMPROP Stream
(QUOTE
NCNEXTIDNUM)))
bind ID when (PROGN (BLOCK)
(AND (NC.ValidID (SETQ ID
(
NC.IDFromNumber IDNum)))
(STRPOS SearchString
(
NC.GetTitleFromScavengerArray ID ScavengerArray))))
collect ID)
(CHARACTER 13))
(NC.PrintMsg NIL NIL "Done."))
(Previous% Page (* Get previous menu window by accessing list of
windows cached on MessageWin.)
(DETACHWINDOW MainWin)
(MOVEW MainWin NC.OffScreenPosition)
(ATTACHWINDOW (SETQ NextWin
(if (EQ MainWin (CAR MenuWindows))
then (CAR (LAST MenuWindows))
else (CAR (NLEFT MenuWindows 1
(FMEMB MainWin MenuWindows)
))))
MessageWin
(QUOTE BOTTOM)
(QUOTE LEFT)))
(Next% Page (* Get next menu window by accessing list of windows
cached on MessageWin.)
(DETACHWINDOW MainWin)
(MOVEW MainWin NC.OffScreenPosition)
(ATTACHWINDOW (SETQ NextWin (if (EQ MainWin (CAR (LAST
MenuWindows)))
then (CAR MenuWindows)
else (CADR (FMEMB MainWin
MenuWindows))))
MessageWin
(QUOTE BOTTOM)
(QUOTE LEFT)))
(First% Page (* Get first menu window by accessing list of windows
cached on MessageWin.)
(if (EQ MainWin (SETQ NextWin (CAR MenuWindows)))
then (FLASHW MainWin)
else (DETACHWINDOW MainWin)
(MOVEW MainWin NC.OffScreenPosition)
(ATTACHWINDOW NextWin MessageWin (QUOTE BOTTOM)
(QUOTE LEFT))))
NIL)))))
(NC.BuildLinkLabelsInspector
(LAMBDA (ScavengerArray Stream CardsMenuWindow) (* rht: "17-Jul-85 13:26")
(* * Build an inspector for the link labels versions. Return a list of user's changes.)
(LET ((IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY)))
(CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream)))
MenuAndItemNum MainWindow Menu OldItemNum)
(SETQ MenuAndItemNum (NC.BuildLinkLabelsInspectorMenu ScavengerArray Stream IndexArray
CheckptPtr))
(SETQ Menu (CAR MenuAndItemNum))
(SETQ OldItemNum (CDR MenuAndItemNum))
(SETQ MainWindow (ADDMENU Menu NIL (GETBOXPOSITION (fetch (MENU IMAGEWIDTH) of Menu)
(fetch (MENU IMAGEHEIGHT) of Menu)
NIL NIL NIL "Position the link types menu."))
) (* Save menus and item numbers of original selections.)
(WINDOWPROP MainWindow (QUOTE CARDPARTSMENUS)
(LIST Menu))
(WINDOWPROP MainWindow (QUOTE CARDPARTSMENUOLDITEMNUMS)
(LIST OldItemNum))
(WINDOWPROP MainWindow (QUOTE STREAM)
Stream)
(WINDOWPROP MainWindow (QUOTE CARDID)
NC.LinkLabelsID)
(WINDOWPROP MainWindow (QUOTE CARDSMENUWINDOW)
CardsMenuWindow) (* Shade the original selection.)
(SHADEITEM (CAR (FNTH (fetch (MENU ITEMS) of Menu)
OldItemNum))
Menu NC.LightShade)
(PUTMENUPROP Menu (QUOTE CURITEMNUM)
OldItemNum)
(ATTACHWINDOW (ADDMENU (create MENU
ITEMS ←(QUOTE ((UPDATE (QUOTE UPDATE)
"Change to indicated versions of link types.")
(ABORT (QUOTE ABORT)
"Quit this link types inspector, throwing away changes.")
(RESET (QUOTE RESET)
"Go back to original version of link types.")))
MENUFONT ← NC.CardInspectorAttachedMenuFont
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 1
CENTERFLG ← T
MENUCOLUMNS ← 3
WHENSELECTEDFN ←(FUNCTION NC.CardPartsAttachedMenuWhenSelectedFn)
))
MainWindow
(QUOTE TOP)
(QUOTE LEFT))
MainWindow)))
(NC.BuildLinkLabelsInspectorMenu
(LAMBDA (ScavengerArray Stream IndexArray CheckptPtr) (* rht: "17-Jul-85 12:34")
(* * Make a menu containing items for each title version on Stream for Card. Menu item contains date and title.
There is no further detail obtainable for titles. Return cons of menu and current selection.)
(OR IndexArray (SETQ IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(OR CheckptPtr (SETQ CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream))))
(LET (MenuItems SelectionNum (Versions (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID
NC.LinkLabelsID)
NC.ScavengerArrayLinkLabelsOffset)))
(CurLinkLabelsPtr (ELT IndexArray (PLUS (NC.IndexFromID NC.LinkLabelsID)
NC.IndexArrayLinkLabelsOffset)))
Menu Ptrs)
(SETQ MenuItems (for LinkLabelsInfo in Versions as ItemNum from 1
collect (LET ((Ptr (CAR LinkLabelsInfo))
(Date (CADR LinkLabelsInfo))
(NumberOfLinkLabels (CADDR LinkLabelsInfo))
Item)
(PROG1 (SETQ Item (LIST (CONCAT (if (GEQ Ptr CheckptPtr)
then "*"
else "")
"[" NumberOfLinkLabels "] "
(OR Date "NO DATE AVAILABLE"))
Ptr))
(if (EQUAL Ptr CurLinkLabelsPtr)
then (SETQ SelectionNum ItemNum))))))
(if (NULL SelectionNum)
then (SETQ MenuItems (CONS (LIST (QUOTE BADLINKLABELS)
CurLinkLabelsPtr)
MenuItems))
(SETQ SelectionNum 1))
(PROG1 (CONS (SETQ Menu (create MENU
ITEMS ← MenuItems
TITLE ← "Versions of link types"
WHENSELECTEDFN ←(FUNCTION NC.CardPartsMenusWhenSelectedFn)))
SelectionNum) (* Seems like the only way to communicate to the
whenselectedfn is through menuprops.)
(PUTMENUPROP Menu (QUOTE VERSIONS)
Versions)
(PUTMENUPROP Menu (QUOTE INSPECTORFN)
(FUNCTION NC.LinkLabelsVersionInspector))))))
(NC.BuildCardPartsInspector
(LAMBDA (Card ScavengerArray Stream CardsMenuWindow) (* rht: "15-Aug-85 17:36")
(* * Build an attached group of menus for the 4 card parts: substance, links, title, and proplist.
These contain items for each version of that part of Card found on Stream. The highlighted item is the one currently
pointed to. Return a list of user's changes.)
(LET ((IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY)))
(CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream)))
(CardType (NC.GetTypeFromScavengerArray Card ScavengerArray))
(CardStatus (CAR (NC.GetPtrsFromIndex Stream Card)))
MenusAndItemNums MainWindow Menus OldItemNums)
(SETQ MenusAndItemNums (LIST (NC.BuildTitlesInspectorMenu Card CardType CardStatus
ScavengerArray Stream IndexArray
CheckptPtr)
(NC.BuildSubstancesInspectorMenu Card CardType ScavengerArray
Stream IndexArray CheckptPtr
CardsMenuWindow)
(NC.BuildLinksInspectorMenu Card ScavengerArray Stream IndexArray
CheckptPtr)
(NC.BuildPropListsInspectorMenu Card ScavengerArray Stream
IndexArray CheckptPtr)))
(SETQ Menus (for MenuAndItemNum in MenusAndItemNums collect (CAR MenuAndItemNum)))
(SETQ OldItemNums (for MenuAndItemNum in MenusAndItemNums collect (CDR MenuAndItemNum)))
(* Titles menu occupies main window.
Rest of menus are attached in order below.)
(SETQ MainWindow (ADDMENU (CAR Menus)
NIL
(GETBOXPOSITION (fetch (MENU IMAGEWIDTH) of (CAR Menus))
(fetch (MENU IMAGEHEIGHT) of (CAR Menus))
NIL NIL NIL "Position the card parts menu.")))
(for Menu in (CDR Menus) do (ATTACHWINDOW (ADDMENU Menu)
MainWindow
(QUOTE BOTTOM)
(QUOTE LEFT)))
(* Save menus and item numbers of original selections.)
(WINDOWPROP MainWindow (QUOTE CARDPARTSMENUS)
Menus)
(WINDOWPROP MainWindow (QUOTE CARDPARTSMENUOLDITEMNUMS)
OldItemNums)
(WINDOWPROP MainWindow (QUOTE STREAM)
Stream)
(WINDOWPROP MainWindow (QUOTE CARDID)
Card)
(WINDOWPROP MainWindow (QUOTE CARDSMENUWINDOW)
CardsMenuWindow) (* Shade the original selections.)
(for Menu in Menus as ItemNum in OldItemNums
do (SHADEITEM (CAR (FNTH (fetch (MENU ITEMS) of Menu)
ItemNum))
Menu NC.LightShade)
(PUTMENUPROP Menu (QUOTE CURITEMNUM)
ItemNum))
(ATTACHWINDOW (ADDMENU (create MENU
ITEMS ←(BQUOTE
((UPDATE (QUOTE UPDATE)
"Change to indicated versions for this card.")
(ABORT (QUOTE ABORT)
"Quit this card parts inspector, throwing away changes.")
(RESET (QUOTE RESET)
"Go back to original version of card parts for this card.")
,@(if (NOT (FMEMB Card NC.TopLevelCards))
then (LIST (if (EQ CardStatus (QUOTE ACTIVE))
then (QUOTE (DELETE (QUOTE DELETE)
"Mark this card as deleted."))
else (QUOTE (UNDELETE (QUOTE UNDELETE)
"Undelete this card, restoring to indicated or most recent versions of card parts.")))))
))
MENUFONT ← NC.CardInspectorAttachedMenuFont
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 1
CENTERFLG ← T
MENUROWS ← 1
WHENSELECTEDFN ←(FUNCTION NC.CardPartsAttachedMenuWhenSelectedFn)
))
MainWindow
(QUOTE TOP)
(QUOTE LEFT))
MainWindow)))
(NC.CardPartsAttachedMenuWhenSelectedFn
(LAMBDA (Item Menu MouseKey) (* rht: "13-Aug-85 14:40")
(* * Called from the upper attached menu of the card parts menu. Contains options on what to do with changes to
versions of this card. Can RESET to original versions, UPDATE by returning the new versions selected, ABORT, or
DELETE the card.)
(LET ((MainWin (MAINWINDOW (WFROMMENU Menu)))
Menus OldItemNums Stream CardID CardsMenuWindow)
(SETQ Menus (WINDOWPROP MainWin (QUOTE CARDPARTSMENUS)))
(SETQ OldItemNums (WINDOWPROP MainWin (QUOTE CARDPARTSMENUOLDITEMNUMS)))
(SETQ CardID (WINDOWPROP MainWin (QUOTE CARDID)))
(SETQ Stream (WINDOWPROP MainWin (QUOTE STREAM)))
(SETQ CardsMenuWindow (WINDOWPROP MainWin (QUOTE CARDSMENUWINDOW)))
(SELECTQ (CAR Item)
(RESET (for Menu in Menus as OldItemNum in OldItemNums bind Items
do (* First unshade currently shaded item, then shade the
original one.)
(SETQ Items (fetch (MENU ITEMS) of Menu))
(SHADEITEM (CAR (FNTH Items (GETMENUPROP Menu (QUOTE CURITEMNUM))))
Menu)
(SHADEITEM (CAR (FNTH Items OldItemNum))
Menu NC.LightShade)
(PUTMENUPROP Menu (QUOTE CURITEMNUM)
OldItemNum)))
(ABORT (CLOSEW MainWin))
(DELETE (NC.MarkCardDeleted CardID Stream)
(CLOSEW MainWin) (* Indicate that we made a real change to some card.)
(WINDOWPROP CardsMenuWindow (QUOTE MADECHANGES)
T)
(WINDOWPROP CardsMenuWindow (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW CardsMenuWindow))
(UNDELETE (* I wonder if allowing undeletion is dangerous.
We shall see.)
(NC.SetIndexOffset Stream (NC.IndexFromID CardID))
(NC.PutStatusToIndex Stream (QUOTE ACTIVE))
(CLOSEW MainWin) (* Indicate that we made a real change to some card.)
(WINDOWPROP CardsMenuWindow (QUOTE MADECHANGES)
T) (* Not sure about this, but just to be safe, I decree
that undeleting requires link scavenge.)
(WINDOWPROP CardsMenuWindow (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW CardsMenuWindow))
(UPDATE (* Change the pointers in the index array for each card
part that user has decided to change.)
(for Menu in Menus as OldItemNum in OldItemNums as Offset in
NC.IndexArrayOffsets
bind CurItemNum when (NEQ OldItemNum (SETQ CurItemNum (GETMENUPROP
Menu
(QUOTE CURITEMNUM))))
do (NC.SetIndexOffset Stream (PLUS (NC.IndexFromID CardID)
(if (EQ CardID NC.LinkLabelsID)
then NC.IndexArrayLinkLabelsOffset
else Offset)))
(NC.PutPtrToIndex Stream (CADAR (FNTH (fetch (MENU ITEMS) of Menu)
CurItemNum)))
(* Indicate that we made a real change to some card.)
(WINDOWPROP CardsMenuWindow (QUOTE MADECHANGES)
T) (* Changes to links, substances, and/or link labels
require a link scavenge.)
(if (OR (EQ CardID NC.LinkLabelsID)
(FMEMB Offset NC.ScavengerCriticalOffsets))
then (WINDOWPROP CardsMenuWindow (QUOTE NEEDLINKSCAVENGE)
T)))
(CLOSEW MainWin))
NIL))))
(NC.BuildTitlesInspectorMenu
(LAMBDA (Card CardType CardStatus ScavengerArray Stream IndexArray CheckptPtr)
(* rht: "30-Jul-85 10:06")
(* * Make a menu containing items for each title version on Stream for Card. Menu item contains date and title.
There is no further detail obtainable for titles. Return cons of menu and current selection.)
(OR IndexArray (SETQ IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(OR CheckptPtr (SETQ CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream))))
(LET (MenuItems SelectionNum (Versions (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID
Card)
NC.ScavengerArrayTitleOffset)))
(CurTitlePtr (ELT IndexArray (PLUS (NC.IndexFromID Card)
NC.ScavengerArrayTitleOffset 1)))
Menu Ptrs)
(SETQ MenuItems (for TitleInfo in Versions as ItemNum from 1
collect (LET ((Ptr (CAR TitleInfo))
(Date (CADR TitleInfo))
(Title (CADDR TitleInfo))
Item)
(PROG1 (SETQ Item (LIST (CONCAT (if (GEQ Ptr CheckptPtr)
then "*"
else "")
"["
(SUBATOM Title 1
(MIN 10 (NCHARS Title)))
"] "
(OR Date "NO DATE AVAILABLE"))
Ptr))
(if (EQUAL Ptr CurTitlePtr)
then (SETQ SelectionNum ItemNum))))))
(if (NULL SelectionNum)
then (SETQ MenuItems (CONS (LIST (QUOTE BADTITLE)
CurTitlePtr)
MenuItems))
(SETQ SelectionNum 1))
(PROG1 (CONS (SETQ Menu (create MENU
ITEMS ← MenuItems
TITLE ←(CONCAT (if (EQ CardStatus (QUOTE DELETED))
then "DELETED "
else "")
CardType " Card: " Card " Title Versions")
WHENSELECTEDFN ←(FUNCTION NC.CardPartsMenusWhenSelectedFn)))
SelectionNum) (* Seems like the only way to communicate to the
whenselectedfn is through menuprops.)
(PUTMENUPROP Menu (QUOTE VERSIONS)
Versions)
(PUTMENUPROP Menu (QUOTE INSPECTORFN)
(FUNCTION NC.CardTitleVersionInspector))))))
(NC.BuildSubstancesInspectorMenu
(LAMBDA (Card CardType ScavengerArray Stream IndexArray CheckptPtr CardsMenuWindow)
(* rht: "15-Aug-85 22:37")
(* * Make a menu containing items for each title version on Stream for Card. Menu item contains date and title.
There is no further detail obtainable for titles. Return cons of menu and current selection.)
(OR IndexArray (SETQ IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(OR CheckptPtr (SETQ CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream))))
(LET (MenuItems SelectionNum (Versions (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID
Card)
NC.ScavengerArraySubstanceOffset)
))
(CurSubstancePtr (ELT IndexArray (PLUS (NC.IndexFromID Card)
NC.ScavengerArraySubstanceOffset 1)))
(BadTypeFlg (FMEMB CardType (WINDOWPROP (MAINWINDOW CardsMenuWindow)
(QUOTE UNKNOWNCARDTYPESLIST))))
Menu Ptrs)
(OR BadTypeFlg (SETQ MenuItems (for SubstanceInfo in Versions as ItemNum from 1
collect (LET ((Ptr (CAR SubstanceInfo))
(Date (CADR SubstanceInfo))
(Type (CADDR SubstanceInfo))
(SubstanceLength (CADDDR SubstanceInfo))
Item)
(PROG1 (SETQ Item
(LIST (CONCAT (if (GEQ Ptr CheckptPtr)
then "*"
else "")
"[" SubstanceLength "] "
(OR Date "NO DATE AVAILABLE")
)
Ptr))
(if (EQUAL Ptr CurSubstancePtr)
then (SETQ SelectionNum ItemNum)))))))
(if (NULL SelectionNum)
then (SETQ MenuItems (CONS (LIST (if BadTypeFlg
then (QUOTE UNKNOWNCARDTYPE)
else (QUOTE BADSUBSTANCE))
CurSubstancePtr)
MenuItems))
(SETQ SelectionNum 1))
(PROG1 (CONS (SETQ Menu (create MENU
ITEMS ← MenuItems
TITLE ← "Substance Versions"
WHENSELECTEDFN ←(FUNCTION NC.CardPartsMenusWhenSelectedFn)))
SelectionNum) (* Seems like the only way to communicate to the
whenselectedfn is through menuprops.)
(PUTMENUPROP Menu (QUOTE VERSIONS)
Versions)
(PUTMENUPROP Menu (QUOTE INSPECTORFN)
(FUNCTION NC.CardSubstanceVersionInspector))))))
(NC.BuildLinksInspectorMenu
(LAMBDA (Card ScavengerArray Stream IndexArray CheckptPtr)
(* rht: "11-Jul-85 23:25")
(* * Make a menu containing items for each title version on Stream for Card. Menu item contains date and title.
There is no further detail obtainable for titles. Return cons of menu and current selection.)
(OR IndexArray (SETQ IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(OR CheckptPtr (SETQ CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream))))
(LET (MenuItems SelectionNum (Versions (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID
Card)
NC.ScavengerArrayLinksOffset)))
(CurLinksPtr (ELT IndexArray (PLUS (NC.IndexFromID Card)
NC.ScavengerArrayLinksOffset 1)))
Menu Ptrs)
(SETQ MenuItems (for LinksInfo in Versions as ItemNum from 1
collect (LET ((Ptr (CAR LinksInfo))
(Date (CADR LinksInfo))
(LinkListsLengths (CADDR LinksInfo))
Item)
(PROG1 (SETQ Item (LIST (CONCAT (if (GEQ Ptr CheckptPtr)
then "*"
else "")
"["
(CAR LinkListsLengths)
"|"
(CADR LinkListsLengths)
"|"
(CADDR LinkListsLengths)
"] "
(OR Date "NO DATE AVAILABLE"))
Ptr))
(if (EQUAL Ptr CurLinksPtr)
then (SETQ SelectionNum ItemNum))))))
(if (NULL SelectionNum)
then (SETQ MenuItems (CONS (LIST (QUOTE BADLINKS)
CurLinksPtr)
MenuItems))
(SETQ SelectionNum 1))
(PROG1 (CONS (SETQ Menu (create MENU
ITEMS ← MenuItems
TITLE ← "Links Versions"
WHENSELECTEDFN ←(FUNCTION NC.CardPartsMenusWhenSelectedFn)))
SelectionNum) (* Seems like the only way to communicate to the
whenselectedfn is through menuprops.)
(PUTMENUPROP Menu (QUOTE VERSIONS)
Versions)
(PUTMENUPROP Menu (QUOTE INSPECTORFN)
(FUNCTION NC.CardLinksVersionInspector))))))
(NC.BuildPropListsInspectorMenu
(LAMBDA (Card ScavengerArray Stream IndexArray CheckptPtr)
(* rht: "11-Jul-85 23:25")
(* * Make a menu containing items for each title version on Stream for Card. Menu item contains date and title.
There is no further detail obtainable for titles. Return cons of menu and current selection.)
(OR IndexArray (SETQ IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(OR CheckptPtr (SETQ CheckptPtr (PROGN (SETFILEPTR Stream 8)
(NC.GetPtr Stream))))
(LET (MenuItems SelectionNum (Versions (ELT ScavengerArray (PLUS (NC.ScavengerArrayOffsetFromID
Card)
NC.ScavengerArrayPropListOffset))
)
(CurPropListPtr (ELT IndexArray (PLUS (NC.IndexFromID Card)
NC.ScavengerArrayPropListOffset 1)))
Menu Ptrs)
(SETQ MenuItems (for PropListInfo in Versions as ItemNum from 1
collect (LET ((Ptr (CAR PropListInfo))
(Date (CADR PropListInfo))
(PropListLength (CADDR PropListInfo))
Item)
(PROG1 (SETQ Item (LIST (CONCAT (if (GEQ Ptr CheckptPtr)
then "*"
else "")
"[" PropListLength "] "
(OR Date "NO DATE AVAILABLE"))
Ptr))
(if (EQUAL Ptr CurPropListPtr)
then (SETQ SelectionNum ItemNum))))))
(if (NULL SelectionNum)
then (SETQ MenuItems (CONS (LIST (QUOTE BADPROPLIST)
CurPropListPtr)
MenuItems))
(SETQ SelectionNum 1))
(PROG1 (CONS (SETQ Menu (create MENU
ITEMS ← MenuItems
TITLE ← "PropList Versions"
WHENSELECTEDFN ←(FUNCTION NC.CardPartsMenusWhenSelectedFn)))
SelectionNum) (* Seems like the only way to communicate to the
whenselectedfn is through menuprops.)
(PUTMENUPROP Menu (QUOTE VERSIONS)
Versions)
(PUTMENUPROP Menu (QUOTE INSPECTORFN)
(FUNCTION NC.CardPropListVersionInspector))))))
(NC.CardPartsMenusWhenSelectedFn
(LAMBDA (SelectedItem Menu MouseKey) (* rht: "25-Sep-85 22:29")
(* * Called when a version is selected from card stylesheet. Pop up menu offering choice of Inspect or
ChangeSelection.)
(LET ((MainWin (MAINWINDOW (WFROMMENU Menu)))
(Items (fetch (MENU ITEMS) of Menu))
(InspectItem (QUOTE (Inspect (QUOTE Inspect)
"Bring up display of this version.")))
(ChangeSelectionItem (QUOTE (ChangeSelection (QUOTE ChangeSelection)
"Change to this version.")))
OldShadedItem OperationItems)
(SETQ OldShadedItem (CAR (FNTH Items (GETMENUPROP Menu (QUOTE CURITEMNUM)))))
(SETQ OperationItems (BQUOTE (,@(if (NOT (FMEMB (CAR SelectedItem)
(QUOTE (BADTITLE BADSUBSTANCE UNKNOWNCARDTYPE
BADPROPLIST BADLINKS))))
then (LIST InspectItem))
,@(if (NEQ OldShadedItem SelectedItem)
then (LIST ChangeSelectionItem)))))
(SELECTQ (AND OperationItems (MENU (create MENU
ITEMS ← OperationItems)))
(Inspect (APPLY* (GETMENUPROP Menu (QUOTE INSPECTORFN))
(WINDOWPROP MainWin (QUOTE CARDID))
(SASSOC (CADR SelectedItem)
(GETMENUPROP Menu (QUOTE VERSIONS)))
(WINDOWPROP MainWin (QUOTE STREAM)))
(QUOTE ABORT))
(ChangeSelection (* First unshade currently shaded item, then shade this
one.)
(SHADEITEM OldShadedItem Menu)
(SHADEITEM SelectedItem Menu NC.LightShade)
(PUTMENUPROP Menu (QUOTE CURITEMNUM)
(for Item in Items as i from 1 when (EQ SelectedItem
Item)
do (RETURN i))))
(QUOTE ABORT)))))
(NC.CardTitleVersionInspector
(LAMBDA (CardID TitleInfo Stream) (* rht: "11-Jul-85 23:03")
(* * Fill in a TITLEDATA record and bring up an inspector on it.)
(INSPECT (create TITLEDATA
CARDID ← CardID
VERSIONDATE ←(CADR TitleInfo)
TITLE ←(CADDR TitleInfo))
(QUOTE TITLEDATA))))
(NC.CardSubstanceVersionInspector
(LAMBDA (CardID SubstanceInfo Stream) (* rht: "26-Aug-85 11:12")
(* * Fill in a SUBSTANCEDATA record and bring up an inspector on it.)
(LET (IdentifierAndVersionNum Type ID SketchData SketchObjDatum)
(* Position file at links lists.
Hopefully no need to check validity of what we're
reading.)
(SETFILEPTR Stream (CAR SubstanceInfo))
(SETQ IdentifierAndVersionNum (NC.RobustReadItemIdentifier Stream))
(if (GEQ (CDR IdentifierAndVersionNum)
1)
then (NC.RobustReadDate Stream))
(SETQ ID (NC.RobustReadID Stream))
(SETQ Type (CAR (NC.RobustReadAtom Stream)))
(NC.RobustReadRegion Stream (GETEOFPTR Stream)) (* Unfortunately, can only inspect TEXT substances
now.)
(SELECTQ (NCP.CardTypeSubstance Type)
(TEXT (* This is so that user edits a copy of the text and
can't affect original.)
(OPENTEXTSTREAM (COPYTEXTSTREAM (OPENTEXTSTREAM Stream NIL (NC.GetPtr Stream)
(NC.GetPtr Stream))
T)
(CREATEW (PROGN (NC.PrintMsg NIL T
"Choose region for TEXT substance display.")
(GETREGION))
(CONCAT "CardID: " CardID ", Type: " Type ", Date: "
(CADR SubstanceInfo)))))
(GRAPH (SHOWGRAPH (NC.MakeExternalGraphCopy (NC.GetGraphSubstance Stream ID))
(CREATEW (PROGN (NC.PrintMsg NIL T
"Choose region for GRAPH substance display.")
(GETREGION))
(CONCAT "CardID: " CardID ", Type: " Type ", Date: "
(CADR SubstanceInfo)))
NIL NIL NIL T))
(SKETCH (SETQ SketchData (NC.GetSketchSubstance Stream ID))
(SETQ SketchObjDatum (IMAGEOBJPROP (MAKE.IMAGE.OBJECT.OF.SKETCH (CAR
SketchData)
(CADDR
SketchData)
(CADR
SketchData))
(QUOTE OBJECTDATUM)))
(SKETCHW.CREATE (CAR SketchObjDatum)
(CADR SketchObjDatum)
(PROGN (NC.PrintMsg NIL T
"Choose region for SKETCH substance display.")
(GETREGION))
(CONCAT "CardID: " CardID ", Type: " Type ", Date: "
(CADR SubstanceInfo))
(CADDR SketchObjDatum)))
(NC.PrintMsg NIL T "Sorry, can only inspect TEXT, GRAPH, or SKETCH substances.")))))
(NC.CardLinksVersionInspector
(LAMBDA (CardID LinksInfo Stream) (* rht: "22-Jul-85 17:07")
(* * Fill in a LINKSDATA record and bring up an inspector on it.)
(LET (IdentifierAndVersionNum) (* Position file at links lists.
Hopefully no need to check validity of what we're
reading.)
(SETFILEPTR Stream (CAR LinksInfo))
(SETQ IdentifierAndVersionNum (NC.RobustReadItemIdentifier Stream))
(if (GEQ (CDR IdentifierAndVersionNum)
1)
then (NC.RobustReadDate Stream))
(NC.RobustReadID Stream)
(INSPECT (create LINKSDATA
CARDID ← CardID
VERSIONDATE ←(CADR LinksInfo)
TOLINKS ←(CAR (NC.RobustReadLinks Stream))
FROMLINKS ←(CAR (NC.RobustReadLinks Stream))
GLOBALLINKS ←(CAR (NC.RobustReadLinks Stream)))
(QUOTE LINKSDATA))
(NC.PrintMsg NIL T "Inspect individual links as record NOTECARDLINK."))))
(NC.CardPropListVersionInspector
(LAMBDA (CardID PropListInfo Stream) (* rht: "11-Jul-85 23:30")
(* * Fill in a PROPLISTDATA record and bring up an inspector on it.)
(LET (IdentifierAndVersionNum) (* Position file at prop list.
Hopefully no need to check validity of what we're
reading.)
(SETFILEPTR Stream (CAR PropListInfo))
(SETQ IdentifierAndVersionNum (NC.RobustReadItemIdentifier Stream))
(if (GEQ (CDR IdentifierAndVersionNum)
1)
then (NC.RobustReadDate Stream))
(NC.RobustReadID Stream)
(INSPECT (create PROPLISTDATA
CARDID ← CardID
VERSIONDATE ←(CADR PropListInfo)
PROPLIST ←(CAR (NC.RobustReadList Stream)))
(QUOTE PROPLISTDATA)))))
(NC.LinkLabelsVersionInspector
(LAMBDA (CardID LinkLabelsInfo Stream) (* rht: "17-Jul-85 03:26")
(* * Fill in a LINKLABELSDATA record and bring up an inspector on it.)
(LET (IdentifierAndVersionNum) (* Position file at link labels lists.
Hopefully no need to check validity of what we're
reading.)
(SETFILEPTR Stream (CAR LinkLabelsInfo))
(SETQ IdentifierAndVersionNum (NC.RobustReadItemIdentifier Stream))
(if (GEQ (CDR IdentifierAndVersionNum)
1)
then (NC.RobustReadDate Stream))
(NC.RobustReadID Stream)
(INSPECT (create LINKLABELSDATA
CARDID ←(QUOTE LINK% TYPES)
VERSIONDATE ←(CADR LinkLabelsInfo)
LINKTYPES ←(CAR (NC.RobustReadList Stream)))
(QUOTE LINKLABELSDATA)))))
)
(* * Miscellaneous.)
(DEFINEQ
(NC.ComputeMenuPosition
(LAMBDA (Menu Win) (* rht: "14-Jul-85 22:52")
(* * Compute the position to put Menu so it sits along upper right edge of Win.)
(LET ((WinRegion (WINDOWREGION Win)))
(create POSITION
XCOORD ←(PLUS (fetch (REGION LEFT) of WinRegion)
(fetch (REGION WIDTH) of WinRegion))
YCOORD ←(PLUS (fetch (REGION BOTTOM) of WinRegion)
(fetch (REGION HEIGHT) of WinRegion)
(MINUS (fetch (MENU IMAGEHEIGHT) of Menu)))))))
(NC.CheckForBadLinksAndTitlesAndPropLists
(LAMBDA (Stream MessageWin BadNewsList ScavengerArray) (* rht: "25-Sep-85 22:26")
(* * For any cards with bad links, set links to NIL if user agrees. This will only really destroy global links,
since Tolinks and Fromlinks will get rebuilt by link scavenger later. Look around for bad titles and see if user
wants to set them all to "Untitled" Untitled. Then check for cards with bad prop lists and reset to NIL if user
wants. Set a windowprop on the MessageWin to the cards with bad links, if they got reset. Then the 2nd phase of the
scavenger can rebuild those cards' global links.)
(LET ((IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY)))
ActiveCardsWithBadNews CardsWithBadLinks CardsWithBadTitles CardsWithBadPropLists)
(* Collect active cards on the bad news list.)
(SETQ ActiveCardsWithBadNews (for BadNews in BadNewsList bind Card
when (EQ (PROGN (NC.SetIndexOffset Stream
(NC.IndexFromID
(SETQ Card (CAR BadNews))))
(NC.GetStatusFromIndex Stream))
(QUOTE ACTIVE))
collect Card)) (* Collect active cards that still have bad links.)
(SETQ CardsWithBadLinks (for Card in ActiveCardsWithBadNews bind Versions CurLinksPtr
when (PROGN (SETQ Versions (ELT ScavengerArray (PLUS (
NC.ScavengerArrayOffsetFromID Card)
NC.ScavengerArrayLinksOffset)))
(SETQ CurLinksPtr (ELT IndexArray (PLUS (NC.IndexFromID
Card)
NC.ScavengerArrayLinksOffset 1)))
(NOT (SASSOC CurLinksPtr Versions)))
collect Card)) (* Collect active cards that still have bad titles.)
(SETQ CardsWithBadTitles (for Card in ActiveCardsWithBadNews bind Versions CurTitlePtr
when (PROGN (SETQ Versions (ELT ScavengerArray (PLUS (
NC.ScavengerArrayOffsetFromID Card)
NC.ScavengerArrayTitleOffset)))
(SETQ CurTitlePtr (ELT IndexArray (PLUS (NC.IndexFromID
Card)
NC.ScavengerArrayTitleOffset 1)))
(NOT (SASSOC CurTitlePtr Versions)))
collect Card)) (* Collect active cards that still have bad prop
lists.)
(SETQ CardsWithBadPropLists (for Card in ActiveCardsWithBadNews bind Versions CurPropListPtr
when (PROGN (SETQ Versions (ELT ScavengerArray
(PLUS (
NC.ScavengerArrayOffsetFromID Card)
NC.ScavengerArrayPropListOffset)))
(SETQ CurPropListPtr (ELT IndexArray
(PLUS (NC.IndexFromID
Card)
NC.ScavengerArrayPropListOffset 1)))
(NOT (SASSOC CurPropListPtr Versions)))
collect Card))
(if (OR CardsWithBadLinks CardsWithBadTitles CardsWithBadPropLists)
then (* Print out the bad news.)
(if CardsWithBadLinks
then (NC.PrintMsg MessageWin NIL "Cards: " CardsWithBadLinks
" still have bad links. Links rebuilder will rebuild them."
(CHARACTER 13)))
(if CardsWithBadTitles
then (NC.PrintMsg MessageWin NIL "Cards: " CardsWithBadTitles
" still have bad titles. They will be set to 'Untitled'."
(CHARACTER 13)))
(if CardsWithBadPropLists
then (NC.PrintMsg MessageWin NIL "Cards: " CardsWithBadPropLists
" still have bad prop lists. They will be set to NIL."
(CHARACTER 13))) (* If it's okay with user, then reset links, titles and
prop lists for those cards.)
(if (NC.YesP (NC.AskUser "Is this okay?" NIL (QUOTE Yes)
NIL MessageWin NIL NIL T))
then (WINDOWPROP MessageWin (QUOTE CARDSWITHLINKSRESET)
(if CardsWithBadLinks
then (NC.PrintMsg MessageWin NIL "Resetting links ...")
(for Card in CardsWithBadLinks
do (NC.SetToLinks Card NIL)
(NC.SetFromLinks Card NIL)
(NC.SetGlobalLinks Card NIL)
(NC.PutLinks Card Stream))
(NC.PrintMsg MessageWin NIL "Done.")
CardsWithBadLinks))
(if CardsWithBadTitles
then (NC.PrintMsg MessageWin NIL "Resetting titles ...")
(for Card in CardsWithBadTitles
do (NC.SetTitle Card "Untitled")
(NC.PutTitle Card Stream)
(NC.SetTitle Card NIL))
(NC.PrintMsg MessageWin NIL "Done."))
(if CardsWithBadPropLists
then (NC.PrintMsg MessageWin NIL "Resetting prop lists ...")
(for Card in CardsWithBadPropLists
do (NC.SetPropList Card NIL)
(NC.PutPropList Card Stream))
(NC.PrintMsg MessageWin NIL "Done."))
else (QUOTE ABORT))))))
)
[DECLARE: EVAL@COMPILE
(RECORD LINKSDATA (CARDID VERSIONDATE TOLINKS FROMLINKS GLOBALLINKS))
(RECORD TITLEDATA (CARDID VERSIONDATE TITLE))
(RECORD PROPLISTDATA (CARDID VERSIONDATE PROPLIST))
(RECORD LINKLABELSDATA (CARDID VERSIONDATE LINKTYPES))
]
(* * Possible reasons for bad card parts.)
(PUTPROP (QUOTE BADITEMPTR)
(QUOTE ReasonString)
"out of bounds item pointer(s).")
(PUTPROP (QUOTE BADSUBSTANCEPTR)
(QUOTE ReasonString)
"out of bounds substance pointer(s).")
(PUTPROP (QUOTE BADLINKSPTR)
(QUOTE ReasonString)
"out of bounds links pointer(s).")
(PUTPROP (QUOTE BADTITLEPTR)
(QUOTE ReasonString)
"out of bounds title pointer(s).")
(PUTPROP (QUOTE BADPROPLISTPTR)
(QUOTE ReasonString)
"out of bounds prop list pointer(s).")
(PUTPROP (QUOTE BADITEM)
(QUOTE ReasonString)
"improper substance data.")
(PUTPROP (QUOTE BADSUBSTANCE)
(QUOTE ReasonString)
"improper substance data.")
(PUTPROP (QUOTE BADLINKS)
(QUOTE ReasonString)
"improper links data.")
(PUTPROP (QUOTE BADTITLE)
(QUOTE ReasonString)
"improper title data.")
(PUTPROP (QUOTE BADPROPLIST)
(QUOTE ReasonString)
"improper prop list data.")
(PUTPROP (QUOTE BADLINKLABELS)
(QUOTE ReasonString)
"improper link labels.")
(PUTPROP (QUOTE ITEMPASTCHKPT)
(QUOTE ReasonString)
"item beyond chkpt pointer.")
(PUTPROP (QUOTE SUBSTANCEPASTCHKPT)
(QUOTE ReasonString)
"substance beyond chkpt pointer.")
(PUTPROP (QUOTE LINKSPASTCHKPT)
(QUOTE ReasonString)
"links beyond chkpt pointer.")
(PUTPROP (QUOTE TITLEPASTCHKPT)
(QUOTE ReasonString)
"title beyond chkpt pointer.")
(PUTPROP (QUOTE PROPLISTPASTCHKPT)
(QUOTE ReasonString)
"prop list beyond chkpt pointer.")
(PUTPROP (QUOTE LINKLABELSPASTCHKPT)
(QUOTE ReasonString)
"link labels beyond chkpt pointer.")
(PUTPROP (QUOTE UNKNOWNCARDTYPE)
(QUOTE ReasonString)
"card type definition not loaded.")
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS NCREPAIR COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8097 27407 (NC.CollectAndCheckLinks 8107 . 10544) (NC.GetOldData 10546 . 12884) (
NC.FindOldData 12886 . 13301) (NC.FindOldLinks 13303 . 13720) (NC.ReinstateNthInstance 13722 . 14921)
(NC.ScavengeDatabaseFile 14923 . 27405)) (27441 49888 (NC.ScavengerPhase1 27451 . 41515) (
NC.ScavengerCleanup 41517 . 42145) (NC.CheckUnknownCardTypes 42147 . 43468) (
NC.RepositionWindowIfNeeded 43470 . 44033) (NC.MessageWinAttachedMenuWhenSelectedFn 44035 . 48957) (
NC.MessageWinCloseFn 48959 . 49886)) (49990 68423 (NC.BuildScavengerArray 50000 . 52866) (
NC.RobustReadCardPart 52868 . 57613) (NC.ScavengerArrayOffsetFromID 57615 . 57937) (
NC.CheckForValidSubstance 57939 . 59070) (NC.SearchFor###OrNOBIND 59072 . 60481) (NC.AtEndOfItemP
60483 . 61483) (NC.RobustRead 61485 . 61876) (NC.RobustReadItemIdentifier 61878 . 62886) (
NC.RobustReadID 62888 . 63326) (NC.RobustReadString 63328 . 63719) (NC.RobustReadList 63721 . 64231) (
NC.RobustReadLinks 64233 . 64756) (NC.RobustReadAtom 64758 . 65231) (NC.RobustReadRegion 65233 . 65965
) (NC.RobustGetSubstance 65967 . 66325) (NC.SkipWhiteSpace 66327 . 67068) (NC.RobustReadDate 67070 .
67625) (NC.RobustReadChar 67627 . 68025) (NC.RobustReadByte 68027 . 68421)) (68481 69213 (
NC.GetTypeFromScavengerArray 68491 . 68851) (NC.GetTitleFromScavengerArray 68853 . 69211)) (69310
78849 (NC.BuildBadCardsList 69320 . 74898) (NC.WorthlessCardP 74900 . 76219) (
NC.CheckIndexPtrAgainstScavengerArray 76221 . 78847)) (78924 81481 (NC.RestorePreviousTitle 78934 .
79560) (NC.RestorePreviousSubstance 79562 . 80208) (NC.RestorePreviousLinks 80210 . 80836) (
NC.RestorePreviousPropList 80838 . 81479)) (81535 130124 (NC.BuildCardInspectorMenu 81545 . 86210) (
NC.EncodeCardProblems 86212 . 87847) (NC.CardInspectorCloseFn 87849 . 89029) (
NC.CardInspectorRepaintFn 89031 . 91035) (NC.CardInspectorMenuWhenSelectedFn 91037 . 94241) (
NC.CardInspectorAttachedMenuWhenSelectedFn 94243 . 99796) (NC.BuildLinkLabelsInspector 99798 . 102181)
(NC.BuildLinkLabelsInspectorMenu 102183 . 104435) (NC.BuildCardPartsInspector 104437 . 108492) (
NC.CardPartsAttachedMenuWhenSelectedFn 108494 . 112424) (NC.BuildTitlesInspectorMenu 112426 . 114880)
(NC.BuildSubstancesInspectorMenu 114882 . 117492) (NC.BuildLinksInspectorMenu 117494 . 119857) (
NC.BuildPropListsInspectorMenu 119859 . 122122) (NC.CardPartsMenusWhenSelectedFn 122124 . 124065) (
NC.CardTitleVersionInspector 124067 . 124446) (NC.CardSubstanceVersionInspector 124448 . 127198) (
NC.CardLinksVersionInspector 127200 . 128289) (NC.CardPropListVersionInspector 128291 . 129189) (
NC.LinkLabelsVersionInspector 129191 . 130122)) (130152 136089 (NC.ComputeMenuPosition 130162 . 130765
) (NC.CheckForBadLinksAndTitlesAndPropLists 130767 . 136087)))))
STOP