(FILECREATED "31-Oct-85 12:54:58" {QV}<NOTECARDS>1.3K>RHTPATCH003.;1 42370
changes to: (VARS RHTPATCH003COMS))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH003COMS)
(RPAQQ RHTPATCH003COMS ((* * Fixes to functions in NCREPAIR)
(FNS NC.ScavengerPhase1 NC.BuildBadCardsList
NC.MessageWinAttachedMenuWhenSelectedFn NC.BuildCardPartsInspector
NC.ScavengeDatabaseFile)))
(* * Fixes to functions in NCREPAIR)
(DEFINEQ
(NC.ScavengerPhase1
(LAMBDA (FileNameOrStream ReadSubstancesFlg ScavengerInteractionWin)
(* rht: "31-Oct-85 12:21")
(* * 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. We can also fix even bad substances if they're for fileboxes.)
(if (for News in BadNewsList eachtime (BLOCK) unless (FMEMB (CADR News)
(QUOTE (DELETED FREE)))
unless (FMEMB (CAR News)
BadBoxes)
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.BuildBadCardsList
(LAMBDA (Stream ScavengerArray MessageWin FirstTimeFlg) (* rht: "31-Oct-85 11:53")
(* * 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 ..." (CHARACTER 13)
"Processing item number " 0 " out of " CardTotal "." (CHARACTER 13))
(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.MessageWinAttachedMenuWhenSelectedFn
(LAMBDA (Item Menu MouseKey) (* rht: "31-Oct-85 11:59")
(* * 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 IndexPtrs
eachtime (BLOCK)
(SETQ ID (NC.IDFromNumber
Num))
(SETQ IndexPtrs
(NC.GetPtrsFromIndex Stream
ID))
when (FMEMB (fetch (POINTERLIST STATUS)
of IndexPtrs)
(QUOTE (ACTIVE BADPOINTER
NIL)))
unless (NC.WorthlessCardP ID Stream
ScavengerArray
IndexPtrs)
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 NIL
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.BuildCardPartsInspector
(LAMBDA (Card ScavengerArray Stream CardsMenuWindow) (* rht: "31-Oct-85 12:07")
(* * 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 DELETE))
then (QUOTE (UNDELETE (QUOTE UNDELETE)
"Undelete this card, restoring to indicated or most recent versions of card parts."))
else (QUOTE (DELETE (QUOTE DELETE)
"Mark this card as deleted.")))))
))
MENUFONT ← NC.CardInspectorAttachedMenuFont
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 1
CENTERFLG ← T
MENUROWS ← 1
WHENSELECTEDFN ←(FUNCTION NC.CardPartsAttachedMenuWhenSelectedFn)
))
MainWindow
(QUOTE TOP)
(QUOTE LEFT))
MainWindow)))
(NC.ScavengeDatabaseFile
(LAMBDA (FileNameOrStream BadLinkLabelsFlg ListOfCardsToReconstruct ListOfGlobalLinksToReconstruct)
(* rht: "31-Oct-85 12:51")
(* 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)
eachtime (BLOCK)
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) eachtime (BLOCK)
never (NC.ChildLinkP Link)))
then (push ToBeFiledCards ID))
(NC.PutLinks ID DatabaseStream)
(NC.DeactivateCard ID T)))) (* File any unfiled cards in the ToBeFiled box.)
(NC.PrintMsg NIL T "Filing " (LENGTH ToBeFiledCards)
" cards in ToBeFiled box."
(CHARACTER 13))
(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.")))))
)
(PUTPROPS RHTPATCH003 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (498 42288 (NC.ScavengerPhase1 508 . 14694) (NC.BuildBadCardsList 14696 . 20370) (
NC.MessageWinAttachedMenuWhenSelectedFn 20372 . 25540) (NC.BuildCardPartsInspector 25542 . 29604) (
NC.ScavengeDatabaseFile 29606 . 42286)))))
STOP