(FILECREATED " 9-Dec-86 15:54:25" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH170.;1
 4737   

      changes to:  (VARS RHTPATCH170COMS)
		   (FNS NC.CompactNoteFileInPlace))


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

(PRETTYCOMPRINT RHTPATCH170COMS)

(RPAQQ RHTPATCH170COMS
 ((* * Fix to problem with compact in place on never before opened notefiles.)
			  (* * Change to NCCOMPACT)
			  (FNS NC.CompactNoteFileInPlace)))
(* * Fix to problem with compact in place on never before opened notefiles.)


(* * Change to NCCOMPACT)


(DEFINEQ

(NC.CompactNoteFileInPlace

  (LAMBDA (NoteFile InterestedWindow)                        (* rht: " 9-Dec-86 15:50")


          (* * Compact the notefile in place. If index needs to be increased, then first make room for bigger index by 

	  copying. Compaction is done by sorting index pointers and moving each entry in the file to lower addresses.)




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




          (* * kirk 19Nov85: Created from NC.CompactDatabaseInPlace)




          (* * rht 11/3/86: Added InterestedWindow arg.)




          (* * rht&pmi 12/9/86: Moved RESETLST to be after call to NC.OpenDatabaseFile.)



    (if
 (
AND
 NoteFile (
SETQ
 NoteFile (
NC.OpenDatabaseFile
 NoteFile (
QUOTE
 BOTH)
								  T NIL T NIL NIL T T 
								  InterestedWindow)))
	then
 (
RESETLST
 (
RESETSAVE
 NIL (
BQUOTE
 (
NC.ForceDatabaseClose
 , NoteFile)))
			   (LET ((SourceStream (fetch
 (NoteFile Stream) of
 NoteFile))
				 (BufferStream (
OPENSTREAM
 (
QUOTE
 {NODIRCORE})
							     (
QUOTE
 BOTH)
							     NIL
							     (
QUOTE
 ((TYPE BINARY)))))
				 (FullFileName (fetch
 (NoteFile FullFileName) of
 NoteFile))
				 ToPtr SortedSortingRecords OriginalLengthOfFile 
				 TotalUseableCardParts OperationMsg)

          (* * Expand index if needed.)



			        (
SETQ
 OperationMsg (
CONCAT
 "Compacting " FullFileName 
							       " in place."
							       (
CHARACTER
 13)))
			        (LET ((NewIndexSize (
NC.ComputeNewDatabaseIndexSize
 NoteFile)))
				     (if
 (
GREATERP
 NewIndexSize (fetch
 (NoteFile HashArraySize)
								       of
 NoteFile))
					 then
              (* Expand index if needed.)

						(
NC.ExpandIndexInPlace
 NoteFile NewIndexSize 
									 BufferStream 
									 InterestedWindow 
									 OperationMsg)))

          (* * In sorted order, copy entries to lower locations in the file.)



			        (
SETQ
 ToPtr (
NC.TotalIndexSize
 (fetch
 (NoteFile HashArraySize)
								      of
 NoteFile)))
			        (
SETQ
 SortedSortingRecords (
NC.SortIndexEntries
 NoteFile))
			        (
SETQ
 OriginalLengthOfFile (
GETEOFPTR
 SourceStream))
			        (if
 (
SETQ
 ToPtr (
NC.CopySortedCardParts
 SortedSortingRecords 
									      NIL ToPtr BufferStream 
									     OriginalLengthOfFile 
									      InterestedWindow 
									      OperationMsg))
				    then
                   (* all useable card parts got copied)

					   (
NC.PutCheckptPtr
 NoteFile ToPtr) 
                                                             (* Put out the new ChkptPtr to the file.)


          (* * Truncate file at that point.)



					   (
NC.PrintMsg
 InterestedWindow T "Truncating file " 
							  FullFileName " ...")
					   (
NCLocalDevice.PutHashArray
 NoteFile InterestedWindow T 
									 OperationMsg)
					   (if
 (
NOT
 (
SETFILEINFO
 FullFileName (
QUOTE
 LENGTH)
								       ToPtr))
					       then
 (
NC.PrintMsg
 InterestedWindow NIL 
								     "Couldn't truncate "
								     FullFileName "." (
CHARACTER

								       13))
					     else
 (
NC.PrintMsg
 InterestedWindow T "Done."
								   (
CHARACTER
 13))
						    (
NC.ClearMsg
 InterestedWindow T))
					   (LET ((NumBytesSaved (
DIFFERENCE
 OriginalLengthOfFile 
									      ToPtr)))
					        (
NC.PrintMsg
 NIL T FullFileName 
							       " compacted in place."
							       (
CHARACTER
 13)
							       "Recovered " NumBytesSaved " bytes ("
							       (
FIX
 (
TIMES
 100 (
FQUOTIENT

										 NumBytesSaved 
									     OriginalLengthOfFile)))
							       "%%)"
							       (
CHARACTER
 13)))
					   (
SETQ
 NC.DatabaseFileNameSuggestion (
PACKFILENAME

					       (
QUOTE
 VERSION)
					       NIL
					       (
QUOTE
 BODY)
					       FullFileName))
				  else
 (
FLASHW
 PROMPTWINDOW)
					 (
NC.PrintMsg
 NIL T "Compact of " FullFileName 
							" cancelled.")))))))
)
(PUTPROPS RHTPATCH170 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (562 4655 (NC.CompactNoteFileInPlace 572 . 4653)))))
STOP