(FILECREATED "17-Dec-85 20:37:16" {QV}<NOTECARDS>1.3K>FGHPATCH007.;2 23549
changes to: (VARS FGHPATCH007COMS)
(FNS NC.ScavengeDatabaseFile)
previous date: "17-Dec-85 20:08:15" {QV}<NOTECARDS>1.3K>FGHPATCH007.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH007COMS)
(RPAQQ FGHPATCH007COMS ((* * From NCTEXTCARD so that Text card appears in menu)
(FNS NC.AddTextCard)
(* * From NCCONVERTVERSION2TO3 do get rid of version # when creating
database file)
(FNS NC.ConvertNoteFileVersion2To3 NC.ReadVersion2MainCardData)
(* * From NCREPAIR to fix msg in ScavenegDatabaseFile to reflect number of
active cards rather than size of index.)
(FNS NC.ScavengeDatabaseFile)))
(* * From NCTEXTCARD so that Text card appears in menu)
(DEFINEQ
(NC.AddTextCard
(LAMBDA NIL (* fgh: "17-Dec-85 19:54")
(NC.AddCardType (QUOTE Text)
(QUOTE NoteCard)
(BQUOTE ((MakeFn , (FUNCTION NC.MakeTEditCard))
(EditFn , (FUNCTION NC.BringUpTEditCard))
(QuitFn , (FUNCTION NC.TEditCloseFn))
(GetFn , (FUNCTION NC.GetTextSubstance))
(PutFn , (FUNCTION NC.PutTextSubstance))
(CopyFn , (FUNCTION NC.TextCopySubstance))
(MarkDirtyFn , (FUNCTION NC.MarkTextDirty))
(DirtyPFn , (FUNCTION NC.TextDirtyP))
(CollectLinksFn , (FUNCTION NC.CollectReferencesInText))
(DeleteLinksFn , (FUNCTION NC.DelReferencesToCardFromText))
(UpdateLinkIconsFn , (FUNCTION NC.UpdateLinkImagesInText))
(InsertLinkFn , (FUNCTION NC.InsertLinkInTextWindow))
(TranslateWindowPositionFn , (FUNCTION
NC.TranslateWindowPositionToTEditPosition))))
(BQUOTE ((LinkDisplayMode Title)
(DisplayedInMenuFlg T)
(DefaultWidth 300)
(DefaultHeight 200)
(LinkAnchorModesSupported T))))))
)
(* * From NCCONVERTVERSION2TO3 do get rid of version # when creating database file)
(DEFINEQ
(NC.ConvertNoteFileVersion2To3
(LAMBDA (StreamOrFileName) (* fgh: "17-Dec-85 19:58")
(* * Convert this notefile to version 3 outputting the version 3 notefile to new version with same filename.)
(* * fgh 12/17/85 fixed call to CreateDatabaseFile to lop the version off of the file name.)
(LET ((OperationMsg "Converting file to version 3.")
CardTotal FileName FromStream FromNoteFile ToNoteFile Version2HashArray Version
NextIndexNum IndexSizeInEntries NextLinkNum CheckptPtr)
(if (STREAMP StreamOrFileName)
then (SETQ FromStream StreamOrFileName)
(SETQ FileName (FULLNAME StreamOrFileName))
else (SETQ FileName StreamOrFileName)
(SETQ FromStream (OPENSTREAM FileName (QUOTE BOTH))))
(SETFILEPTR FromStream 7)
(if (EQ (SETQ Version (NC.ReadPtr FromStream 1))
2)
then (* FromStream is indeed version 2.0)
(* Get all the header info off the 1.2 stream.)
(SETFILEPTR FromStream 0)
(SETQ NextIndexNum (NC.ReadPtr FromStream 2))
(SETQ CardTotal (SUB1 NextIndexNum))
(SETQ IndexSizeInEntries (NC.ReadPtr FromStream 2))
(SETQ NextLinkNum (NC.ReadPtr FromStream 3))
(* Skip version number.)
(NC.ReadPtr FromStream 1)
(SETQ CheckptPtr (NC.ReadPtr FromStream 3))
(* * Create a dummy notefile object for the 1.2 source notefile.)
(SETQ FromNoteFile (create NoteFile
UID ←(NC.MakeUID)
Stream ← FromStream
FullFileName ←(FULLNAME FileName)
NextIndexNum ← NextIndexNum
Version ← Version
NextLinkNum ← NextLinkNum
CheckptPtr ← CheckptPtr))
(SETQ ToNoteFile (NC.CreateDatabaseFile (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FileName)
IndexSizeInEntries OperationMsg T))
(if (AND (type? NoteFile ToNoteFile)
(NC.OpenDatabaseFile ToNoteFile NIL T T NIL NIL NIL NIL T))
then
(* * Fill in NewNoteFile's hash array with new UIDs. Return a hash array mapping version 2 style ID atoms to
version 3 style Cards.)
(NC.PrintMsg NIL T "Reading index of version 2 notefile ...")
(SETQ Version2HashArray (NC.BuildVersion2HashArray FromNoteFile
ToNoteFile
CardTotal))
(* * For each card in the old notefile, fill in a version 3 card object for it and put the filled in card down to
NewNoteFile.)
(NC.PrintMsg NIL T OperationMsg (CHARACTER 13)
"Processing card ID 1 out of " CardTotal)
(for IDNum from 1 to CardTotal eachtime (BLOCK)
do (if (ZEROP (REMAINDER IDNum 10))
then (NC.PrintMsg NIL T OperationMsg (CHARACTER
13)
"Processing card ID " IDNum
" out of "
CardTotal))
(NC.GetAndPutVersion2Card FromStream (NC.IDFromNumber
IDNum)
Version2HashArray FromNoteFile
ToNoteFile))
(NC.CheckpointDatabase ToNoteFile T)
(NC.ForceDatabaseClose ToNoteFile)
(CLOSEF FromStream) (* Rebuild To and From links.)
(NC.ScavengeDatabaseFile (fetch (NoteFile FullFileName)
of ToNoteFile))
(NC.PrintMsg NIL T "Done.")
FileName)
else (NC.ReportError "NC.ConvertNoteFileVersion2To3" (CONCAT "Filename " FileName
" is version "
Version
". Can only convert version 2 notefiles."))
NIL))))
(NC.ReadVersion2MainCardData
(LAMBDA (Stream ID Card Version2HashArray FromNoteFile ToNoteFile)
(* fgh: "17-Dec-85 20:01")
(* * Stream should be positioned at the main data card part of ID. Get the main data and fill in for Card.)
(* * fgh 12/17/85 changed Apply of CollectReferencesFn to be done only if there is a CollectReferencesFn for the
card type)
(LET (CardType Region StartPtr EndPtr Length TEditBasedFlg StartFormatPtr CollectReferencesFn)
(NC.SetItemDate Card (NC.ReadVersion2CardPartHeader Stream ID NC.Version2ItemIdentifier))
(* * Read card type and region)
(NC.SetType Card (SETQ CardType (READ Stream)))
(SETQ TEditBasedFlg (NC.TEditBasedP CardType))
(READC Stream)
(NC.SetRegion Card (NC.ReadVersion2Region Stream))
(* * Read the substance pointers, compute the length, then call the substance get fn)
(SETQ StartPtr (NC.ReadPtr Stream 3))
(SETQ EndPtr (NC.ReadPtr Stream 3))
(SETQ Length (DIFFERENCE EndPtr StartPtr))
(* * A horrible kludge: Change the infamous file absolute pointer in the text stream to be file relative for
duration of the GetSubstance call. Also unfortunate is the need to temporarily make FromNoteFile the notefile for
Card.)
(if TEditBasedFlg
then (SETFILEPTR Stream (DIFFERENCE EndPtr 8))
(SETQ StartFormatPtr (NC.ReadPtr Stream 4))
(SETFILEPTR Stream (DIFFERENCE EndPtr 8))
(NC.WritePtr Stream (DIFFERENCE StartFormatPtr StartPtr)
4)
(SETFILEPTR Stream StartPtr))
(replace (Card NoteFile) of Card with FromNoteFile)
(NC.SetSubstance Card (APPLY* (NC.GetSubstanceFn CardType)
Card Length))
(* * Now put back the infamous file absolute pointer. Also put back Card's ToNoteFile.)
(replace (Card NoteFile) of Card with ToNoteFile)
(if TEditBasedFlg
then (SETFILEPTR Stream (DIFFERENCE EndPtr 8))
(NC.WritePtr Stream StartFormatPtr 4)
(SETFILEPTR Stream EndPtr))
(* * Now convert each link in the embedded link icons in the substance.)
(if (SETQ CollectReferencesFn (NC.CollectReferencesFn CardType))
then (for LinkIcon in (CAR (APPLY* CollectReferencesFn Card NIL T))
eachtime (BLOCK) do (NC.ConvertVersion2LinkIcon LinkIcon Card
Version2HashArray))))))
)
(* * From NCREPAIR to fix msg in ScavenegDatabaseFile to reflect number of active cards rather
than size of index.)
(DEFINEQ
(NC.ScavengeDatabaseFile
(LAMBDA (NoteFileOrFileName BadLinkLabelsFlg ListOfCardsToReconstruct
ListOfGlobalLinksToReconstruct)
(* fgh: "17-Dec-85 20:32")
(* 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.)
(PROG ((ListOfValidCards (LIST (QUOTE **Header**)))
(NoteCardNumber 0)
NoteFile FileName OldLinkLabels DiscoveredLinkLabels FromLinks ToLinks Stream
NumberOfActiveCards Status ID Links Entry FullName CardTotal GlobalLinks ActiveCardsList
ReconstructLinks ReconstructGlobalLinks ThisCardsToLinks ThisCardsGlobalLinks
ToBeFiledCards)
(* * First, take care of checking stream's validity, etc.)
(SETQ FileName (if (type? NoteFile NoteFileOrFileName)
then (SETQ NoteFile NoteFileOrFileName)
(fetch (NoteFile FullFileName) of NoteFileOrFileName)
else NoteFileOrFileName))
(if (OPENP FileName)
then (NC.PrintMsg NIL T FileName " is an already open file." (CHARACTER 13))
(RETURN NIL)) (* Try to open notefile.)
(if (NULL (SETQ NoteFile (NC.OpenDatabaseFile FileName NIL T NIL NIL NIL NIL NIL
T)))
then (NC.PrintMsg NIL NIL "Couldn't open " FileName "." (CHARACTER 13)
"Repair aborted."
(CHARACTER 13))
(RETURN NIL))
(* * If link labels aren't screwed up, then read them in.)
(OR BadLinkLabelsFlg (SETQ OldLinkLabels (NC.RetrieveLinkLabels NoteFile T)))
(* Read through all NoteCard substances to find actual pointers. Use this to create the To Links list.
The list collection function checks to make sure each link is valid.)
(SETQ NumberOfActiveCards (fetch (NoteFile NextIndexNum)
NoteFile))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER 13)
"Collecting Links for item " 1 " out of " NumberOfActiveCards "."
(CHARACTER 13))
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(SETQ NoteCardNumber (ADD1 NoteCardNumber))
(AND (ZEROP (REMAINDER NoteCardNumber 50))
(NC.PrintMsg NIL T "Rebuilding notefile links." (CHARACTER
13)
"Collecting Links for item " NoteCardNumber
" out of "
NumberOfActiveCards "." (CHARACTER 13)))
(COND
((for CardToReconstruct in ListOfCardsToReconstruct
never (NC.SameCardP Card CardToReconstruct))
(NC.GetMainCardData Card)
(NC.GetLinks Card)
(SETQ Status (NC.FetchStatus Card))
(COND
((EQ Status (QUOTE ACTIVE))
(push ActiveCardsList Card)
(AND (for ValidCard in ListOfValidCards
never (NC.SameCardP Card ValidCard))
(push ListOfValidCards Card))
(SETQ Links (NC.CollectAndCheckLinks Card NoteFile
ListOfValidCards))
(push ToLinks (CONS Card Links))
(push GlobalLinks (CONS Card (NC.FetchGlobalLinks Card)))
(* If there are file boxes to be reconstructed, then look thru the From links to see if this card was filed in one
of the to-be-reconstructed boxes)
(AND ListOfCardsToReconstruct
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK)
when (for CardToReconstruct in
ListOfCardsToReconstruct
bind (SourceCard ←(fetch (Link
SourceCard)
of Link))
thereis (NC.SameCardP SourceCard
CardToReconstruct))
do (push ReconstructLinks Link)))
(* If there are global links to be reconstructed, then look thru the From links to see if this card had a global
link to a card whose global links need reconstructing.)
(AND ListOfGlobalLinksToReconstruct
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK)
when (AND (NC.GlobalLinkP Link)
(for CardToReconstruct in
ListOfGlobalLinksToReconstruct
bind (SourceCard
←(fetch (Link SourceCard)
of Link))
thereis (NC.SameCardP
SourceCard
CardToReconstruct)))
do (push ReconstructGlobalLinks Link)))
(NC.DeactivateCard Card T))))
(T (NC.GetLinks Card)
(push GlobalLinks (CONS Card (NC.FetchGlobalLinks Card)))
(push ToLinks (CONS Card (NC.FetchGlobalLinks Card)))
(NC.DeactivateCard Card T))))))
(* * Reconstruct any cards as requested)
(for CardToReconstruct in ListOfCardsToReconstruct eachtime (BLOCK)
do (* Make a new file box using the given card.)
(NC.MakeNoteCard (QUOTE FileBox)
NoteFile "Untitled: Reconstructed during repair" T NIL
CardToReconstruct) (* File cards whose from links indicate that they used
to be filed in this file box)
(SETQ Links (for Link in ReconstructLinks bind DestCard eachtime
(BLOCK)
when (AND (NC.SameCardP CardToReconstruct
(fetch (Link SourceCard)
of Link))
(OR (NC.ContentsLinkP Link)
(NC.SubContentsLinkP Link)))
collect (NC.FileBoxCollectChildren
(NC.FetchSubstance CardToReconstruct)
CardToReconstruct
(LIST (SETQ DestCard (fetch (Link
DestinationCard)
of Link)))
T)
(* * rht 9/20/85: Have to find link just created in the ToLinks of filebox, so we can be sure that LinkID matches.
This is ugly to have to do this search every time!)
(create Link
copying (for CardLink in (NCP.GetLinks
CardToReconstruct)
eachtime (BLOCK)
when (NC.SameCardP
DestCard
(fetch (Link
DestinationCard)
of CardLink))
do (RETURN CardLink)))))
(* Add the new links to the collected links list)
(COND
((SETQ ThisCardsToLinks (for CardLinkPair in ToLinks eachtime (BLOCK)
when (NC.SameCardP (CAR CardLinkPair)
CardToReconstruct)
do (RETURN CardLinkPair)))
(NCONC ThisCardsToLinks Links))
(T (push ToLinks (CONS CardToReconstruct Links))))
(push ActiveCardsList CardToReconstruct)
(* Put the card away)
(NC.PutMainCardData CardToReconstruct)
(NC.DeactivateCard CardToReconstruct T))
(* * Reconstruct any global link lists as required)
(for Link in ReconstructGlobalLinks eachtime (BLOCK)
do (* Add it to the GlobalLinks list)
(COND
((SETQ ThisCardsGlobalLinks (for CardAndGlobalLink in GlobalLinks
when (NC.SameCardP (fetch (Link
SourceCard)
of Link)
(CAR
CardAndGlobalLink))
do (RETURN CardAndGlobalLink)))
(COND
((for GlobalLink in ThisCardsGlobalLinks eachtime (BLOCK)
never (NC.SameLinkP Link GlobalLink))
(COND
((CADR ThisCardsGlobalLinks)
(* were there global links before?)
(NCONC1 ThisCardsGlobalLinks Link))
(T (RPLACD ThisCardsGlobalLinks (LIST Link)))))))
(T (push GlobalLinks (CONS (fetch (Link SourceCard) of Link)
(LIST Link)))))
(* Add it to the ToLinks list if its not already
there)
(COND
((SETQ ThisCardsToLinks (for CardAndLinks in ToLinks
when (NC.SameCardP (fetch (Link SourceCard)
of Link)
(CAR CardAndLinks))
do (RETURN CardAndLinks)))
(COND
((for ToLink in ThisCardsToLinks eachtime (BLOCK)
never (NC.SameLinkP Link ToLink))
(COND
((CADR ThisCardsToLinks)
(NCONC1 ThisCardsToLinks Link))
(T (RPLACD ThisCardsToLinks (LIST Link)))))))
(T (SETQ ToLinks (CONS (CONS (fetch (Link SourceCard) of Link)
(LIST Link))
ToLinks)))))
(* * Compute the From Links list by "inverting" the To Links list)
(NC.PrintMsg NIL T "Processing Links ... ")
(for Item in ToLinks eachtime (BLOCK)
do (for Link in (CDR Item) bind LinkLabel eachtime (BLOCK)
do (SETQ Entry (for CardAndLinks in FromLinks
when (NC.SameCardP (fetch (Link DestinationCard)
of Link)
(CAR CardAndLinks))
do (RETURN CardAndLinks)))
(COND
(Entry (NCONC1 Entry Link))
(T (push FromLinks (LIST (fetch (Link DestinationCard)
of Link)
Link))))
(* Accumulate the link labels into a list.)
(COND
((NOT (FMEMB (SETQ LinkLabel (fetch (Link Label) of Link))
DiscoveredLinkLabels))
(push DiscoveredLinkLabels LinkLabel)))))
(* Reset all of the To and From Links lists in the
database)
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " 1 " out of " NumberOfActiveCards "."
(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 "
NumberOfActiveCards "." (CHARACTER 13)))
(COND
((for ActiveCard in ActiveCardsList thereis (NC.SameCardP
ActiveCard Card))
(NC.SetGlobalLinks Card (CDR (for CardAndLinks in
GlobalLinks
when (NC.SameCardP
Card
(CAR CardAndLinks))
do (RETURN CardAndLinks))))
(NC.SetToLinks Card (CDR (for CardAndLinks in ToLinks
when (NC.SameCardP
Card
(CAR CardAndLinks))
do (RETURN CardAndLinks))))
(NC.SetFromLinks Card (CDR (for CardAndLinks in FromLinks
when (NC.SameCardP
Card
(CAR CardAndLinks))
do (RETURN CardAndLinks))))
(if (AND (for TopLevelCard in (NC.FetchTopLevelCards
NoteFile)
never (NC.SameCardP Card TopLevelCard))
(NOT (NC.SameCardP Card (fetch (NoteFile
LinkLabelsCard)
of NoteFile)))
(for Link in (NC.FetchFromLinks Card)
eachtime (BLOCK) never (NC.ChildLinkP
Link)))
then (push ToBeFiledCards Card))
(NC.PutLinks Card)
(NC.DeactivateCard Card T))))))
(* File any unfiled cards in the ToBeFiled box.)
(if ToBeFiledCards
then (NC.PrintMsg NIL T "Filing " (LENGTH ToBeFiledCards)
" cards in ToBeFiled box."
(CHARACTER 13))
(NCP.FileCards ToBeFiledCards (fetch (NoteFile ToBeFiledCard)
of NoteFile)))
(* Rewrite link labels if we've found any new ones.)
(COND
((LDIFFERENCE DiscoveredLinkLabels OldLinkLabels)
(NC.StoreLinkLabels NoteFile (UNION DiscoveredLinkLabels OldLinkLabels))))
(NC.CheckpointDatabase NoteFile T)
(NC.ForceDatabaseClose NoteFile)
(NC.PrintMsg NIL T "Repair Completed for " (FULLNAME FileName)
"."
(CHARACTER 13))
(if ToBeFiledCards
then (NC.PrintMsg NIL NIL "Filed cards " (for Card in ToBeFiledCards
collect (NC.FetchTitle Card))
" in ToBeFiled box.")))))
)
(PUTPROPS FGHPATCH007 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (849 1985 (NC.AddTextCard 859 . 1983)) (2076 8803 (NC.ConvertNoteFileVersion2To3 2086 .
6074) (NC.ReadVersion2MainCardData 6076 . 8801)) (8927 23467 (NC.ScavengeDatabaseFile 8937 . 23465))))
)
STOP