(FILECREATED "20-Dec-86 00:01:50" {QV}<NOTECARDS>1.3K>NEXT>KIRKPATCH033.;2 19188  

      changes to:  (VARS KIRKPATCH033COMS x)
		   (FNS NCLocalDevice.CompactNoteFile NC.ScavengeDatabaseFile)

      previous date: "19-Dec-86 23:46:59" {QV}<NOTECARDS>1.3K>NEXT>KIRKPATCH033.;1)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT KIRKPATCH033COMS)

(RPAQQ KIRKPATCH033COMS ((* * Fixes unreported bugs that show up in Lyric where OPENP does not work 
			      on filenames by converting to calls on NC.OpenNoteFileP 
			      {BrokenAtom}#53,120776)
			   (* * changes to NCLOCALDEVICE)
			   (FNS NCLocalDevice.CompactNoteFile)
			   (* * changes to NCREPAIR)
			   (FNS NC.ScavengeDatabaseFile)))
(* * Fixes unreported bugs that show up in Lyric where OPENP does not work on filenames by 
converting to calls on NC.OpenNoteFileP {BrokenAtom}#53,120776)

(* * changes to NCLOCALDEVICE)

(DEFINEQ

(NCLocalDevice.CompactNoteFile
  (LAMBDA (FromNoteFile ToFileName InPlaceFlg PromptWindow)
                                                             (* kirk: "19-Dec-86 23:53")

          (* * Compact a NoteFile. If InPlaceFlg is T calls NC.CompactNoteFileInPlace. Otherwise if ToFileName is NIL, asks 
	  for a new file name.)



          (* * fkr 11/8/85 Updated to handle new CardID scheme and NoteFile object.)



          (* * kirk 19Nov85: Created from NC.CompactDatabaseInPlace to handle new NoteFile format)



          (* * fgh 5/186 Totally rewritten to get rid of numerous bugs. Added new PromptWindow parameter.)



          (* * rht 7/2/86: Fixed bug in call to NC.CompactToTarget and NC.CompactInPlace. They were being called with 
	  FromNoteFile instead of (OR FromNoteFile FromFileName).)



          (* * kirk 3Jul86 Added SETQ NC.DatabaseFileNameSuggestion)



          (* * rht 10/16/86: Now autoloads NCREPAIR.)



          (* * rht 11/3/86: No longer reopens if was originally open. Also now passes PromptWindow along to called 
	  functions.)



          (* * kirk 12/19/86 Changed OPENP check to NC.NoteFileOpenP)


    (DECLARE (GLOBALVARS NC.DatabaseFileNameSuggestion))
    (LET (FromFileName ToNoteFile success)

          (* * Get the name of the file to be compacted)


         (SETQ FromFileName (COND
	     ((NULL FromNoteFile)
	       (PROG1 (NC.DatabaseFileName "Name of NoteFile to be compacted:" " -- " T NIL NIL 
					       PromptWindow)
			(NC.ClearMsg PromptWindow)))
	     ((type? NoteFile FromNoteFile)
	       (fetch (NoteFile FullFileName) of FromNoteFile))
	     (T FromNoteFile)))

          (* * If compact to target, get the name of the target file)


         (if (NULL InPlaceFlg)
	     then (SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
									NIL
									(QUOTE BODY)
									(FULLNAME FromFileName)))
		  (SETQ ToFileName (OR ToFileName (PROG1 (NC.DatabaseFileName 
								  "Name of target of compaction:"
										      " -- " T NIL 
										      NIL 
										     PromptWindow)
							       (NC.ClearMsg PromptWindow)))))

          (* * As long as you have file names, go ahead!)


         (if (AND FromFileName (OR InPlaceFlg ToFileName))
	     then 

          (* * Make full names)


		  (SETQ FromFileName (FULLNAME FromFileName (QUOTE OLD)))
		  (SETQ ToFileName (FULLNAME ToFileName (QUOTE NEW))) 

          (* * Close the file if its open)


		  (if (AND (SETQ FromNoteFile (NC.NoteFileFromFileName FromFileName))
			     (NC.NoteFileOpenP FromNoteFile))
		      then (NC.CloseDatabaseFile FromNoteFile))

          (* * Compact the file and reopen if successfull and was previously open)


		  (NC.PrintMsg PromptWindow T "Compacting " FromFileName " ...")
		  (if (SETQ ToNoteFile (if InPlaceFlg
					     then (NC.AutoloadApply* (FUNCTION 
								       NC.CompactNoteFileInPlace)
								     (OR FromNoteFile FromFileName)
								     PromptWindow)
					   else              (* compact to target)
						(NC.AutoloadApply* (FUNCTION 
								     NC.CompactNoteFileToTarget)
								   (OR FromNoteFile FromFileName)
								   ToFileName PromptWindow)))
		      then (NC.ClearMsg PromptWindow T)
		    else (NC.PrintMsg NIL T "Compact of " FromFileName " cancelled."))))))
)
(* * changes to NCREPAIR)

(DEFINEQ

(NC.ScavengeDatabaseFile
  (LAMBDA (NoteFileOrFileName BadLinkLabelsFlg ListOfBoxesToReconstruct 
			      ListOfCardsNeedingGlobalLinksReconstructed InterestedWindow)
                                                             (* kirk: "19-Dec-86 23:53")

          (* 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.)



          (* * fgh 5/21/86 Fixed bug in handling of global links.)



          (* * rht 7/16/86: Added InterestedWindow arg.)



          (* * rht 7/16/86: Now calls NC.PutLinks passing UseOldDatesFlg.)



          (* * rht 9/5/86: Now checks that link is valid before passing it to NC.DelReferencesToCard.)



          (* * rht 10/29/86: Now closes prompt win at end if no filing info to tell.)



          (* * rht 12/10/86: No longer calls NC.GetLinks for cards appearing on the 
	  ListOfCardsNeedingGlobalLinksReconstructed list.)



          (* * kirk 12/19/86 Changed OPENP check to NC.NoteFileOpenP)


    (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.)
	    (OR (NC.NoteFileOpenP NoteFileOrFileName)
		  (SETQ NoteFile (NC.OpenDatabaseFile FileName NIL T NIL NIL NIL NIL T T NIL 
							  InterestedWindow))
		  (PROGN (NC.PrintMsg InterestedWindow NIL "Couldn't open " FileName "."
					  (CHARACTER 13)
					  "Repair aborted.")
			   (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 InterestedWindow T "Rebuilding notefile links." (CHARACTER 13)
			   "Collecting Links for item " 1 " out of " CardTotal ".")
	    (SETQ NoteCardNumber 0)
	    (NC.MapCards
	      NoteFile
	      (FUNCTION (LAMBDA (Card)
		  (BLOCK)
		  (SETQ NoteCardNumber (ADD1 NoteCardNumber))
		  (AND (ZEROP (REMAINDER NoteCardNumber 10))
			 (NC.PrintMsg InterestedWindow T "Rebuilding notefile links." (CHARACTER
					  13)
					"Collecting Links for item " NoteCardNumber " out of " 
					CardTotal "."))      (* Get global links unless links are unreadable.)
		  (if (NOT (NC.FetchUserDataProp Card (QUOTE NeedsGlobalLinksReconstructedFlg)))
		      then (NC.GetLinks Card))
		  (if (NC.FetchUserDataProp Card (QUOTE NeedsReconstructingFlg))
		      then                                   (* Card substance and links will be reconstructed so 
							     no need to try to read substance.)
			   (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.ActivateCard Card)
			 (if (EQ (NC.FetchStatus Card)
				   (QUOTE ACTIVE))
			     then                            (* Collect links having active destinations.
							     Delete the others.)
				  (NC.SetUserDataProp
				    Card
				    (QUOTE ScavengerToLinks)
				    (NCONC (for Link in (CAR (NC.CollectReferences Card))
						eachtime (BLOCK)
						when (if (EQ (NC.FetchStatus (fetch (Link 
										  DestinationCard)
										    of Link))
							       (QUOTE ACTIVE))
						       else (AND (type? Link Link)
								   (NC.DelReferencesToCard Card 
											     Link))
							    NIL)
						collect Link)
					     (if (NC.FetchUserDataProp Card (QUOTE 
								 NeedsGlobalLinksReconstructedFlg))
					       else (NC.SetUserDataProp Card (QUOTE 
									     ScavengerGlobalLinks)
									  (NC.FetchGlobalLinks
									    Card))
						    (NC.FetchGlobalLinks Card))))
				  (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 InterestedWindow T "Repairing NoteFile." (CHARACTER 13)
			   "Inverting links for item " 1 " out of " CardTotal ".")
	    (SETQ NoteCardNumber 0)
	    (NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
			     (SETQ NoteCardNumber (ADD1 NoteCardNumber))
			     (AND (ZEROP (REMAINDER NoteCardNumber 100))
				    (NC.PrintMsg InterestedWindow T "Repairing NoteFile."
						   (CHARACTER 13)
						   "Inverting links for item " NoteCardNumber 
						   " out of "
						   CardTotal "."))
			     (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 InterestedWindow T "Repairing NoteFile." (CHARACTER 13)
			   "Rewriting links for item " 1 " out of " CardTotal ".")
	    (SETQ NoteCardNumber 0)
	    (NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
			     (SETQ NoteCardNumber (ADD1 NoteCardNumber))
			     (AND (ZEROP (REMAINDER NoteCardNumber 10))
				    (NC.PrintMsg InterestedWindow T "Repairing NoteFile."
						   (CHARACTER 13)
						   "Rewriting links for item " NoteCardNumber 
						   " out of "
						   CardTotal "."))
			     (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 T))
                                                             (* 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 InterestedWindow T "Filing " (LENGTH ToBeFiledCards)
				    " cards in ToBeFiled box ...")
		     (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 InterestedWindow T "Repair Completed for " (FULLNAME FileName)
			   ".")
	    (if ToBeFiledCards
		then (NC.PrintMsg InterestedWindow NIL "Filed " (LENGTH ToBeFiledCards)
				    " cards in ToBeFiled box.")
	      else (NC.ClearMsg InterestedWindow T)))))
)
(PUTPROPS KIRKPATCH033 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (941 4482 (NCLocalDevice.CompactNoteFile 951 . 4480)) (4515 19105 (
NC.ScavengeDatabaseFile 4525 . 19103)))))
STOP