(FILECREATED " 4-Feb-86 21:46:11" {QV}<NOTECARDS>1.3K>FGHPATCH019.;3 25963
changes to: (VARS FGHPATCH019COMS)
(FNS NC.CardPartsAttachedMenuWhenSelectedFn NC.CardInspectorMenuWhenSelectedFn
NC.EncodeCardProblems)
previous date: " 4-Feb-86 20:05:12" {QV}<NOTECARDS>1.3K>FGHPATCH019.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH019COMS)
(RPAQQ FGHPATCH019COMS ((* * Fixes from NCREPAIR for bugs in inspect & repair.)
(FNS NC.EncodeCardProblems NC.BuildBadCardsList
NC.CardInspectorMenuWhenSelectedFn NC.ScavengeDatabaseFile
NC.CardPartsAttachedMenuWhenSelectedFn)))
(* * Fixes from NCREPAIR for bugs in inspect & repair.)
(DEFINEQ
(NC.EncodeCardProblems
(LAMBDA (ProblemIndicators) (* fgh: " 4-Feb-86 19:54")
(* * 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.)
(* * rht 12/8/85: Took out the problem identifier atoms like BADLINKSPTR that are no longer kept.)
(* * fgh 2/4/86 Removed parens around many of the problem identifier atoms which were not supposed to be there.)
(CONCAT (COND
((FMEMB (QUOTE BADLINKS)
ProblemIndicators)
(QUOTE L))
((FMEMB (QUOTE LINKSPASTCHKPT)
ProblemIndicators)
(QUOTE l))
(T ""))
(COND
((FMEMB (QUOTE BADMAINDATA)
ProblemIndicators)
(QUOTE S))
((FMEMB (QUOTE MAINDATAPASTCHKPT)
ProblemIndicators)
(QUOTE s))
(T ""))
(COND
((FMEMB (QUOTE BADPROPLIST)
ProblemIndicators)
(QUOTE P))
((FMEMB (QUOTE PROPLISTPASTCHKPT)
ProblemIndicators)
(QUOTE p))
(T ""))
(COND
((FMEMB (QUOTE BADTITLE)
ProblemIndicators)
(QUOTE T))
((FMEMB (QUOTE TITLEPASTCHKPT)
ProblemIndicators)
(QUOTE t))
(T ""))
(COND
((FMEMB (QUOTE UNKNOWNCARDTYPE)
ProblemIndicators)
(QUOTE U))
(T "")))))
(NC.BuildBadCardsList
(LAMBDA (NoteFile MessageWin FirstTimeFlg) (* fgh: " 4-Feb-86 19:14")
(* * 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.)
(* * rht 12/7/85: Modified to reflect new card and notefile object formats.)
(* * fgh 2/4/86 Fixed minor bug where UNKNOWNCARDTYPE apeeared in a singleton list.)
(LET ((CardTotal (SUB1 (fetch (NoteFile NextIndexNum) of NoteFile)))
(CheckptPtr (fetch (NoteFile CheckptPtr) of NoteFile))
(Num 0)
Results)
(NC.PrintMsg NIL T "Building bad cards list ..." (CHARACTER 13)
"Processing item number " 1 " out of " CardTotal "." (CHARACTER 13))
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(LET (Problems)
(SETQ Num (ADD1 Num))
(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)))
(* If card is not worthless, has reasonable status,
and at least one problem, then make a bad card entry
for it.)
(if (AND (NOT (NC.WorthlessCardP Card))
(FMEMB (NC.FetchStatus Card)
(QUOTE (ACTIVE DELETED SPECIAL BADPOINTER
NIL)))
(SETQ Problems
(LET ((IndexLocsProblems (NC.CheckIndexLocs Card
MessageWin
CheckptPtr
FirstTimeFlg))
(Type (NC.FetchTypeFromScavengerInfo Card)))
(if (AND Type (NOT (NCP.ValidCardType
Type)))
then (CONS (QUOTE UNKNOWNCARDTYPE)
IndexLocsProblems)
else IndexLocsProblems))))
then (push Results (BQUOTE (, Card , (NC.FetchStatus
Card)
,
(NC.EncodeCardProblems
Problems)
,@ Problems))))))))
(NC.PrintMsg NIL T "Done.")
Results)))
(NC.CardInspectorMenuWhenSelectedFn
(LAMBDA (CardPair Menu MouseKey) (* fgh: " 4-Feb-86 21:14")
(* * Called when a card is selected from main card inspector menu. Pop up menu offering choice of "Inspect" or
"Delete".)
(* * rht 12/8/85: Modified to reflect new card and notefile object formats.)
(* * fgh 2/4/86 Fixed bug where delete was no marking the index dirty.)
(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."))))
(Card (CADR CardPair))
DeletedCards NoteFile ExistingWin MessageWin)
(SETQ MessageWin (MAINWINDOW Win))
(SETQ DeletedCards (WINDOWPROP MessageWin (QUOTE DELETEDCARDS)))
(SETQ NoteFile (WINDOWPROP Win (QUOTE NOTEFILE)))
(if (EQ MouseKey (QUOTE MIDDLE))
then (MENU (create MENU
ITEMS ←(LIST (NC.FetchTitleFromScavengerInfo
Card))))
else (SELECTQ
(MENU (create MENU
ITEMS ←(COND
((NC.UndeletableCardP Card)
ItemsWithoutDelete)
((FMEMB Card DeletedCards)
ItemsWithUndelete)
(T NormalItems))))
(Inspect (if (SETQ ExistingWin
(for InspectorWindow
in (WINDOWPROP MessageWin (QUOTE
INSPECTORWINDOWS))
when (AND (OPENWP Win)
(NC.SameCardP
Card
(WINDOWPROP Win
(QUOTE CARD)))
)
do (RETURN Win)))
then (FLASHW ExistingWin)
else (WINDOWADDPROP (MAINWINDOW Win)
(QUOTE INSPECTORWINDOWS)
(NC.BuildCardPartsInspector
Card NoteFile Win))))
(Delete (NC.SetStatus Card (QUOTE DELETED))
(WINDOWPROP Win (QUOTE MADECHANGES)
T)
(WINDOWPROP Win (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW Win))
(Undelete (* I wonder if allowing undeletion is dangerous.
We shall see.)
(NC.SetStatus Card (QUOTE ACTIVE))
(* Indicate that we made a real change to some card.)
(WINDOWPROP Win (QUOTE MADECHANGES)
T)
(WINDOWPROP Win (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW Win))
NIL))))))
(NC.ScavengeDatabaseFile
(LAMBDA (NoteFileOrFileName BadLinkLabelsFlg ListOfBoxesToReconstruct
ListOfCardsNeedingGlobalLinksReconstructed)
(* fgh: " 4-Feb-86 20:29")
(* Scavenge the database FileName. Essentially throw away all of the information about From and ToLinks and
recreate them by retrieving the link information from the substance of each card and from the list of global links
from the card.)
(* * rht 8/9/84: Now calls NC.OpenDatabaseFile to do the file open.)
(* * rht 7/17/85: Changed so can take a stream argument. Also handles link labels. If BadLinkLabelsFlg is non-nil,
then don't try to read current link labels. Just rebuild them from what's out there. Otherwise, only rebuild if
find new any new ones.)
(* * fgh 22-Jul-85 Takes a list of bad file box cards and reconstructs the file boxes from the From pointer lists
of all the cards in the NoteFile.)
(* * fgh 30-Jul-85 Takes a list of cards with bad global links and reconstructs the global links list from the From
pointer lists of all the cards in the NoteFile.)
(* * rht 11/23/85: Updated to handle new notefile and card object formats.)
(* * rht 12/1/85: Now calls NC.GetMainCardData and NC.GetLinks instead of NC.GetNoteCard.)
(* * rht 12/19/85: Massive overhaul for sake of speed. Should be wizzier now.)
(* * fgh 2/4/86 Now works on open NFs. No need to error check since this function should always be called from
earlier phases of the inspect & repaier.)
(PROG (NoteFile FileName CardTotal NoteCardNumber OldLinkLabels DiscoveredLinkLabels
ReconstructLinks ReconstructGlobalLinks ToBeFiledCards)
(* * First, take care of checking stream's validity, etc.)
(SETQ FileName (if (type? NoteFile NoteFileOrFileName)
then (SETQ NoteFile NoteFileOrFileName)
(fetch (NoteFile FullFileName) of NoteFileOrFileName)
else NoteFileOrFileName)) (* Try to open notefile.)
(if (NULL (OPENP FileName))
then (if (NULL (SETQ NoteFile
(NC.OpenDatabaseFile FileName NIL T NIL NIL NIL NIL NIL T)))
then (NC.PrintMsg NIL NIL "Couldn't open " FileName "." (CHARACTER
13)
"Repair aborted."
(CHARACTER 13))
(RETURN NIL)))
(* * If link labels aren't screwed up, then read them in.)
(OR BadLinkLabelsFlg (SETQ OldLinkLabels (NC.RetrieveLinkLabels NoteFile T)))
(* * Mark every card that needs its global links or substance reconstructed so we don't have to search the lists so
much.)
(for Card in ListOfCardsNeedingGlobalLinksReconstructed do (NC.SetUserDataProp
Card
(QUOTE
NeedsGlobalLinksReconstructedFlg)
T))
(for Box in ListOfBoxesToReconstruct do (NC.SetUserDataProp Box (QUOTE
NeedsReconstructingFlg)
T))
(* Read through all NoteCard substances to find actual pointers. Use this to create the To Links list.
The list collection function checks to make sure each link is valid.)
(SETQ CardTotal (SUB1 (fetch (NoteFile NextIndexNum)
NoteFile)))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER 13)
"Collecting Links for item " 1 " out of " CardTotal "." (CHARACTER
13))
(SETQ NoteCardNumber 0)
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(SETQ NoteCardNumber (ADD1 NoteCardNumber))
(AND (ZEROP (REMAINDER NoteCardNumber 10))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER
13)
"Collecting Links for item " NoteCardNumber
" out of "
CardTotal "." (CHARACTER 13)))
(if (NC.FetchUserDataProp Card (QUOTE NeedsReconstructingFlg))
then (* Card substance and links will be reconstructed so
no need to try to read substance.)
(NC.GetLinks Card)
(if (NOT (NC.FetchUserDataProp Card (QUOTE
NeedsGlobalLinksReconstructedFlg)))
then (NC.SetUserDataProp Card (QUOTE
ScavengerToLinks)
(NC.FetchGlobalLinks
Card))
(NC.SetUserDataProp Card (QUOTE
ScavengerGlobalLinks)
(NC.FetchGlobalLinks
Card)))
(NC.DeactivateCard Card T)
else
(NC.GetMainCardData Card)
(NC.GetLinks Card)
(NC.ActivateCard Card)
(if (EQ (NC.FetchStatus Card)
(QUOTE ACTIVE))
then (* Collect links having active destinations.
Delete the others.)
(NC.SetUserDataProp
Card
(QUOTE ScavengerToLinks)
(for Link in (CAR (NC.CollectReferences Card))
eachtime (BLOCK)
when (if (EQ (NC.FetchStatus
(fetch (Link DestinationCard)
of Link))
(QUOTE ACTIVE))
else (NC.DelReferencesToCard Card Link)
NIL)
collect Link))
(if (NC.FetchUserDataProp Card (QUOTE
NeedsGlobalLinksReconstructedFlg))
else (NC.SetUserDataProp Card (QUOTE
ScavengerGlobalLinks)
(NC.FetchGlobalLinks
Card)))
(* If there are file boxes to be reconstructed, then look thru the From links to see if this card was filed in one
of the to-be-reconstructed boxes)
(AND ListOfBoxesToReconstruct
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK)
when (AND (NC.ChildLinkP Link)
(NC.FetchUserDataProp
(fetch (Link SourceCard)
of Link)
(QUOTE
NeedsReconstructingFlg)))
do (push ReconstructLinks Link)))
(* If there are global links to be reconstructed, then look thru the From links to see if this card had a global
link from a card whose global links need reconstructing.)
(AND ListOfCardsNeedingGlobalLinksReconstructed
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK)
when (AND (NC.GlobalLinkP Link)
(NC.FetchUserDataProp
(fetch (Link SourceCard)
of Link)
(QUOTE
NeedsGlobalLinksReconstructedFlg)))
do (push ReconstructGlobalLinks Link)))
(NC.DeactivateCard Card T))))))
(* * Reconstruct any cards as requested)
(for BoxToReconstruct in ListOfBoxesToReconstruct eachtime (BLOCK)
do (* Make a new file box using the given card.)
(NC.MakeNoteCard (QUOTE FileBox)
NoteFile "Untitled: Reconstructed during repair" T NIL
BoxToReconstruct)
(* File cards whose from links indicate that they used to be filed in this file box. Also add these new links to
collected ToLinks.)
(NC.SetUserDataProp BoxToReconstruct (QUOTE ScavengerToLinks)
(APPEND (NC.FetchUserDataProp BoxToReconstruct
(QUOTE ScavengerToLinks)
)
(for Link in ReconstructLinks
eachtime (BLOCK)
when (NC.SameCardP BoxToReconstruct
(fetch (Link
SourceCard)
of Link))
collect (NC.MakeChildLink
(fetch (Link DestinationCard)
of Link)
BoxToReconstruct NIL))))
(* Put the card away)
(NC.PutMainCardData BoxToReconstruct)
(NC.DeactivateCard BoxToReconstruct T))
(* * Reconstruct any global link lists as required)
(for Link in ReconstructGlobalLinks bind ThisCardsToLinks ThisCardsGlobalLinks
SourceCard
eachtime (BLOCK)
do (SETQ SourceCard (fetch (Link SourceCard) of Link))
(* Add it to the GlobalLinks list for its source card
unless it's already there.)
(if (for GlobalLink in (SETQ ThisCardsGlobalLinks (NC.FetchUserDataProp
SourceCard
(QUOTE ScavengerGlobalLinks)))
eachtime (BLOCK) never (NC.SameLinkP Link GlobalLink))
then (NC.SetUserDataProp SourceCard (QUOTE ScavengerGlobalLinks)
(CONS Link ThisCardsGlobalLinks)))
(* Add it to the source card's ToLinks list unless
it's already there)
(if (for ToLink in (SETQ ThisCardsToLinks (NC.FetchUserDataProp
SourceCard
(QUOTE ScavengerToLinks)))
eachtime (BLOCK) never (NC.SameLinkP Link ToLink))
then (NC.SetUserDataProp SourceCard (QUOTE ScavengerToLinks)
(CONS Link ThisCardsToLinks))))
(* * Compute the From Links list by "inverting" the To Links list)
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Inverting links for item " 1 " out of " CardTotal "." (CHARACTER 13))
(SETQ NoteCardNumber 0)
(NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
(SETQ NoteCardNumber (ADD1 NoteCardNumber))
(AND (ZEROP (REMAINDER NoteCardNumber 100))
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Inverting links for item " NoteCardNumber
" out of "
CardTotal "." (CHARACTER 13)))
(if (EQ (NC.FetchStatus Card)
(QUOTE ACTIVE))
then (for Link in (NC.FetchUserDataProp Card (QUOTE
ScavengerToLinks)
)
bind DestinationCard LinkLabel eachtime (BLOCK)
do (* Add this ToLink as a FromLink for the link's
destination card.)
(NC.SetUserDataProp (SETQ DestinationCard
(fetch (Link
DestinationCard)
of Link))
(QUOTE ScavengerFromLinks)
(CONS Link
(
NC.FetchUserDataProp
DestinationCard
(QUOTE
ScavengerFromLinks))))
(* Accumulate the link labels into a list.)
(if (NOT (FMEMB (SETQ LinkLabel
(fetch (Link Label)
of Link))
DiscoveredLinkLabels))
then (push DiscoveredLinkLabels LinkLabel)))
))))
(* * Reset all of the To and From Links lists in the database)
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " 1 " out of " CardTotal "." (CHARACTER 13))
(SETQ NoteCardNumber 0)
(NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
(SETQ NoteCardNumber (ADD1 NoteCardNumber))
(AND (ZEROP (REMAINDER NoteCardNumber 10))
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " NoteCardNumber
" out of "
CardTotal "." (CHARACTER 13)))
(if (EQ (NC.FetchStatus Card)
(QUOTE ACTIVE))
then (NC.SetGlobalLinks Card (NC.FetchUserDataProp
Card
(QUOTE ScavengerGlobalLinks)))
(NC.SetToLinks Card (NC.FetchUserDataProp Card
(QUOTE
ScavengerToLinks)))
(NC.SetFromLinks Card (NC.FetchUserDataProp
Card
(QUOTE ScavengerFromLinks)))
(* Check whether this card isn't filed anywhere.)
(if (AND (NOT (NC.UndeletableCardP Card))
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK) never (
NC.ChildLinkP
Link)))
then (push ToBeFiledCards Card))
(NC.PutLinks Card))
(* Clean any junk off the card.)
(NC.DeactivateCard Card T)
(NC.SetUserDataPropList Card NIL))))
(* * File any unfiled cards in the ToBeFiled box.)
(if ToBeFiledCards
then (NC.PrintMsg NIL T "Filing " (LENGTH ToBeFiledCards)
" cards in ToBeFiled box ..."
(CHARACTER 13))
(NCP.FileCards ToBeFiledCards (fetch (NoteFile ToBeFiledCard)
of NoteFile)))
(* Rewrite link labels if we've found any new ones.)
(if (LDIFFERENCE DiscoveredLinkLabels OldLinkLabels)
then (NC.StoreLinkLabels NoteFile (UNION DiscoveredLinkLabels OldLinkLabels)))
(* Clean up and get out.)
(NC.CheckpointDatabase NoteFile T)
(NC.ForceDatabaseClose NoteFile)
(NC.PrintMsg NIL T "Repair Completed for " (FULLNAME FileName)
"."
(CHARACTER 13))
(if ToBeFiledCards
then (NC.PrintMsg NIL NIL "Filed " (LENGTH ToBeFiledCards)
" cards in ToBeFiled box.")))))
(NC.CardPartsAttachedMenuWhenSelectedFn
(LAMBDA (Item Menu MouseKey) (* fgh: " 4-Feb-86 21:45")
(* * 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.)
(* * rht 12/8/85: Modified to reflect new card and notefile object formats.)
(LET ((MainWin (MAINWINDOW (WFROMMENU Menu)))
Menus OldItemNums Card CardsMenuWindow)
(SETQ Menus (WINDOWPROP MainWin (QUOTE CARDPARTSMENUS)))
(SETQ OldItemNums (WINDOWPROP MainWin (QUOTE CARDPARTSMENUOLDITEMNUMS)))
(SETQ Card (WINDOWPROP MainWin (QUOTE CARD)))
(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.SetStatus Card (QUOTE DELETED))
(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.SetStatus Card (QUOTE ACTIVE))
(CLOSEW MainWin) (* Indicate that we made a real change to some card.)
(WINDOWPROP CardsMenuWindow (QUOTE MADECHANGES)
T)
(WINDOWPROP CardsMenuWindow (QUOTE NEEDLINKSCAVENGE)
T)
(REDISPLAYW CardsMenuWindow))
(UPDATE (* Change the card locs for each card part that user
has decided to change.)
(for Menu in Menus as OldItemNum in OldItemNums as SetLocFn
in (QUOTE (NC.SetTitleLoc NC.SetMainLoc NC.SetLinksLoc
NC.SetPropListLoc))
bind CurItemNum when (NEQ OldItemNum (SETQ CurItemNum
(GETMENUPROP Menu (QUOTE
CURITEMNUM))))
do (APPLY* SetLocFn Card (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 or substance require a link
scavenge.)
(if (FMEMB SetLocFn (QUOTE (NC.SetMainLoc NC.SetLinksLoc))
)
then (WINDOWPROP CardsMenuWindow (QUOTE
NEEDLINKSCAVENGE)
T)))
(CLOSEW MainWin))
NIL))))
)
(PUTPROPS FGHPATCH019 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (741 25881 (NC.EncodeCardProblems 751 . 2425) (NC.BuildBadCardsList 2427 . 4885) (
NC.CardInspectorMenuWhenSelectedFn 4887 . 7913) (NC.ScavengeDatabaseFile 7915 . 22271) (
NC.CardPartsAttachedMenuWhenSelectedFn 22273 . 25879)))))
STOP