(FILECREATED "16-May-87 01:16:05" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH262.;8 31742
changes to: (VARS RHTPATCH262COMS)
(FNS NC.ExpandIndexInPlace NC.CheckForExpandIndex NC.FindNextCardPart
NC.CompactNoteFileInPlace NC.CompactNoteFileToTarget
NC.CopyCardPartInPlaceToEOF NC.UpdateIndexLocIfNeeded NC.CopyCardPart
NCLocalDevice.NewCardUID)
(RECORDS CardPartRecord)
previous date: "15-May-87 15:15:02" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH262.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH262COMS)
(RPAQQ RHTPATCH262COMS ((DECLARE: FIRST (P (NC.LoadFileFromDirectories (QUOTE NCCOMPACT))))
(* * This changes the behavior of new card creation when the index is
nearly or completely full. Now it performs an ExpandIndexInPlace after
getting user confirmation rather than printing a warning message. The
compactor no longer ever does ExpandIndexInPlace.)
(* * New stuff for NCDATABASE)
(GLOBALVARS NC.IndexPercentUsedThreshold NC.IndexFractionToIncreaseBy)
(INITVARS (NC.IndexPercentUsedThreshold 90)
(NC.IndexFractionToExpandBy .5))
(RECORDS CardPartRecord)
(FNS NC.CheckForExpandIndex NC.FindNextCardPart NC.CopyCardPartInPlaceToEOF
NC.UpdateIndexLocIfNeeded)
(P (NC.StoreAutoloadFnFile (FUNCTION NC.FindNextCardPart)
(QUOTE NCREPAIR)
(QUOTE NOTECARDSDIRECTORIES)))
(* * These functions should be moved from coms of NCCOMPACT to coms of
NCDATABASE.)
(FNS NC.ExpandIndexInPlace NC.CopyCardPart)
(* * Change to NCLOCALDEVICE)
(FNS NCLocalDevice.NewCardUID)
(* * Changes to NCCOMPACT)
(FNS NC.CompactNoteFileInPlace NC.CompactNoteFileToTarget)
(* * The function NC.CopySortedCardPartInPlaceToEOF should be removed from
NCCOMPACT.)))
(DECLARE: FIRST
(NC.LoadFileFromDirectories (QUOTE NCCOMPACT))
)
(* * This changes the behavior of new card creation when the index is nearly or completely
full. Now it performs an ExpandIndexInPlace after getting user confirmation rather than
printing a warning message. The compactor no longer ever does ExpandIndexInPlace.)
(* * New stuff for NCDATABASE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.IndexPercentUsedThreshold NC.IndexFractionToIncreaseBy)
)
(RPAQ? NC.IndexPercentUsedThreshold 90)
(RPAQ? NC.IndexFractionToExpandBy .5)
[DECLARE: EVAL@COMPILE
(RECORD CardPartRecord (FileLoc UID CardPartTypeNum CardPartLength))
]
(DEFINEQ
(NC.CheckForExpandIndex
(LAMBDA (NoteFile QuietFlg InterestedWindow) (* rht: "16-May-87 01:00")
(* * If index is nearly full, then confirm with user whether it's okay to expand in place. Offer user ability to
change the amount to expand by. Return nil if no expand, return new index size otherwise. If index is full, then we
MUST expand otherwise error out.)
(DECLARE (GLOBALVARS NC.IndexPercentUsedThreshold NC.IndexFractionToExpandBy NC.MenuFont))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(LET ((NextIndexNum (fetch (NoteFile NextIndexNum) of NoteFile))
(IndexSize (fetch (NoteFile HashArraySize) of NoteFile))
(IndexNumsFreeList (fetch (NoteFile IndexNumsFreeList) of NoteFile))
PercentUsed NumUsed)
(if (GREATERP (SETQ PercentUsed (FIX (TIMES 100
(FQUOTIENT
(SETQ NumUsed
(SUB1 (DIFFERENCE
NextIndexNum
(LENGTH
IndexNumsFreeList))))
IndexSize))))
NC.IndexPercentUsedThreshold)
then (LET ((Menu (create MENU
ITEMS ← NIL
TITLE ← " Expand notefile index? "
CENTERFLG ← T
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 1
MENUROWS ← 1
MENUFONT ← NC.MenuFont
ITEMHEIGHT ←(IPLUS 10 (FONTPROP NC.MenuFont
(QUOTE HEIGHT)))
MENUTITLEFONT ←(FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD))))
(PromptWindow (OR (NC.AttachPromptWindow InterestedWindow)
PROMPTWINDOW))
IndexNum PercentFullMessage NewIndexSize NumNewSlots NewNum
ActualNumNewSlots IndexFullFlg)
(SETQ NewIndexSize (PLUS IndexSize (SETQ NumNewSlots
(FIX (FTIMES IndexSize
NC.IndexFractionToExpandBy)))))
(* * Fix menu and message depending on whether index is full or not.)
(if (SETQ IndexFullFlg (GEQ NumUsed IndexSize))
then (SETQ PercentFullMessage (CONCAT (fetch (NoteFile
FullFileName)
of NoteFile)
" is full (" NumUsed
" out of "
IndexSize " cards used)."
(CHARACTER 13)))
(replace (MENU ITEMS) of Menu
with (QUOTE ((Yes (QUOTE Yes)
"Go ahead and expand index to make room for new cards.")
(Cancel (QUOTE Cancel)
"Cancel creation of new card.")
(Change% Num (QUOTE Change% Num)
"Change the number of new cards to expand index by."))))
else (SETQ PercentFullMessage (CONCAT (fetch (NoteFile
FullFileName)
of NoteFile)
" is " PercentUsed "%% full ("
NumUsed " out of " IndexSize
" cards used)."
(CHARACTER 13)))
(replace (MENU ITEMS) of Menu
with (QUOTE ((Yes (QUOTE Yes)
"Go ahead and expand index to make room for new cards.")
(No (QUOTE No)
"Continue without expanding index.")
(Change% Num (QUOTE Change% Num)
"Change the number of new cards to expand index by.")))))
(for
do (NC.PrintMsg InterestedWindow T PercentFullMessage)
(NC.PrintMsg InterestedWindow NIL (CONCAT
"Okay to checkpoint notefile and make room for "
NumNewSlots
" new cards?"
(CHARACTER 13)))
(SELECTQ (MENU Menu (CREATEPOSITION (fetch (REGION LEFT)
of (WINDOWREGION
PromptWindow))
(fetch (REGION TOP)
of (WINDOWREGION
PromptWindow))))
(Yes (* Go ahead and expand index after checkpointing
notefile.)
(NC.CheckpointNoteFile NoteFile NIL NIL
InterestedWindow
(CONCAT
"Expanding notefile index"
(CHARACTER
13)))
(SETQ ActualNumNewSlots
(NC.ExpandIndexInPlace NoteFile NewIndexSize NIL
InterestedWindow))
(COND
((NULL ActualNumNewSlots)
(* Looks like NC.ExpandIndexInPlace bombed for some
reason.)
(FLASHW PROMPTWINDOW)
(if IndexFullFlg
then
(* If index is full, we have to bail out of card
creation.)
(NC.PrintMsg NIL T
"Couldn't expand index. Card creation operation canceled.")
(ERROR!)
else (NC.PrintMsg NIL T
"Couldn't expand index.")))
((LESSP ActualNumNewSlots NumNewSlots)
(* NC.ExpandIndexInPlace probably bombed but we at
least got some of what we asked for.)
(FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T
"Only able to make room for "
ActualNumNewSlots
" new cards out of "
NumNewSlots " requested." NIL)))
(NC.ClearMsg InterestedWindow T)
(RETURN NewIndexSize))
(No (* Don't expand index, just return.)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL))
(Cancel (* Bad news. We have to bail out because index is
full.)
(NC.ClearMsg InterestedWindow T)
(ERROR!))
(Change% Num (* Let user change number of new slots to make room
for.)
(SETQ NewNum
(RNUMBER "Number of new cards to add"
NIL NIL NIL T))
(if (AND (NUMBERP NewNum)
(GREATERP NewNum 0))
then (SETQ NewIndexSize
(PLUS IndexSize (SETQ
NumNewSlots NewNum))))
)
NIL)))))))
(NC.FindNextCardPart
(LAMBDA (NoteFile StartPtr) (* rht: "16-May-87 00:59")
(* * Start searching at the current stream pointer in NoteFile for the next card part. Return a "CardPartRecord" if
successful containing file loc, card uid and card part type number. This code largely stolen from
NC.RobustReadCardPart from NCREPAIR. Notice the calls to NCREPAIR fns.)
(DECLARE (GLOBALVARS NC.TitlesIdentifier NC.PropsIdentifier NC.LinksIdentifier
NC.ItemIdentifier))
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
EndPtr CardPartPtr IdentifierAndVersionNum IdentifierAtom UID CardPartLength
CardPartTypeNum)
(SETQ EndPtr (GETEOFPTR Stream))
(SETQ CardPartPtr (NC.SearchFor### Stream StartPtr))
(for
do (* Keep looping till we find a reasonable card part.)
(if (AND (SETQ CardPartLength (NC.ReadPtr Stream 3))
(LEQ (PLUS CardPartPtr CardPartLength)
EndPtr)
(SETQ IdentifierAndVersionNum (NC.RobustReadItemIdentifier Stream))
(if (GEQ (CDR IdentifierAndVersionNum)
1)
then (NC.RobustReadDate Stream)
else T)
(SETQ UID (NC.RobustReadUID Stream)))
then (SETQ IdentifierAtom (CAR IdentifierAndVersionNum))
(SETQ CardPartTypeNum (COND
((EQ IdentifierAtom NC.ItemIdentifier)
0)
((EQ IdentifierAtom NC.LinksIdentifier)
1)
((EQ IdentifierAtom NC.TitlesIdentifier)
2)
((EQ IdentifierAtom NC.PropsIdentifier)
3)))
(RETURN (create CardPartRecord
FileLoc ← CardPartPtr
UID ← UID
CardPartTypeNum ← CardPartTypeNum
CardPartLength ← CardPartLength))
else (if (NULL (SETQ CardPartPtr (NC.SearchFor### Stream
(PLUS CardPartPtr 4))
))
then (* We've reached EOF without finding a card part.)
(RETURN NIL)))))))
(NC.CopyCardPartInPlaceToEOF
(LAMBDA (NoteFile CardPartRecord TempStream InterestedWindow)
(* rht: "15-May-87 22:01")
(* * This copies given card part to the end of the notefile.)
(LET ((FromPtr (fetch (CardPartRecord FileLoc) of CardPartRecord))
(UID (fetch (CardPartRecord UID) of CardPartRecord))
(CardPartTypeNum (fetch (CardPartRecord CardPartTypeNum) of CardPartRecord)))
(WITH.MONITOR (NC.FetchMonitor NoteFile)
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
EOFPtr Length)
(SETQ EOFPtr (GETEOFPTR Stream))
(* * Copy the substance out to the {NODIRCORE} stream.)
(SETQ Length (NC.CopyCardPart Stream TempStream FromPtr 0
InterestedWindow))
(* * Now copy to its proper home.)
(if (NC.CopyCardPart TempStream Stream 0 EOFPtr InterestedWindow)
then (NC.UpdateIndexLocIfNeeded NoteFile UID CardPartTypeNum
FromPtr EOFPtr)
(PLUS EOFPtr Length)))))))
(NC.UpdateIndexLocIfNeeded
(LAMBDA (NoteFile UID CardPartTypeNum OldLoc NewLoc) (* rht: "15-May-87 22:00")
(* * See if the current index pointer for given UID's card part points to OldLoc. If so, then change to point to
NewLoc. Else do nothing, the card part version is not currently in use.)
(LET ((Card (NC.CardFromUID UID NoteFile)))
(if Card
then (AND (SELECTQ CardPartTypeNum
(0 (if (EQUAL (fetch (Card MainLoc) of Card)
OldLoc)
then (replace (Card MainLoc) of Card with NewLoc)
))
(1 (if (EQUAL (fetch (Card LinksLoc) of Card)
OldLoc)
then (replace (Card LinksLoc) of Card
with NewLoc)))
(2 (if (EQUAL (fetch (Card TitleLoc) of Card)
OldLoc)
then (replace (Card TitleLoc) of Card
with NewLoc)))
(3 (if (EQUAL (fetch (Card PropListLoc) of Card)
OldLoc)
then (replace (Card PropListLoc) of Card
with NewLoc)))
(PROGN (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T
"Bad NoteFile. Please Inspect and Repair."
(CHARACTER 13))
NIL))
(replace (Card IndexDirtyFlg) of Card with T))))))
)
(NC.StoreAutoloadFnFile (FUNCTION NC.FindNextCardPart)
(QUOTE NCREPAIR)
(QUOTE NOTECARDSDIRECTORIES))
(* * These functions should be moved from coms of NCCOMPACT to coms of NCDATABASE.)
(DEFINEQ
(NC.ExpandIndexInPlace
(LAMBDA (NoteFile NewIndexSize TempStream InterestedWindow OperationMsg)
(* rht: "16-May-87 01:15")
(* * Make room for a bigger index by copying a few card parts out to the end of the file. Assumes a checkpoint has
been done to write all information onto the file.)
(* * kirk 9/22/86 Changed to use NCLocalDevice fns)
(* * rht 11/3/86: Added InterestedWindow and OperationMsg arg and fixed typos.)
(* * rht 1/22/87: Was ignoring its TempStream argument. Now calls NC.CopySortedCardPartInPlaceToEOF instead of
NC.CopySortedCardPartInPlace and now checks that it succeeded before continuing.)
(* * rht 5/15/87: Completely rewrote to no longer sort card parts. Now searches in file for next card part to move
ala Inspect&repair.)
(OR OperationMsg (SETQ OperationMsg (CONCAT "Expanding Index" (CHARACTER 13))))
(OR TempStream (SETQ TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
NIL
(QUOTE ((TYPE BINARY))))))
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
(OldTotalIndexSize (NC.TotalIndexSize (fetch (NoteFile HashArraySize) of NoteFile)))
(NewTotalIndexSize (NC.TotalIndexSize NewIndexSize))
CardPartFileLocs FileLoc TotalNewIndexEntries)
(NC.PrintMsg InterestedWindow T OperationMsg "Making room for expanded index."
(CHARACTER 13)
"Moving card part " 1 "." (CHARACTER 13))
(if (GREATERP NewTotalIndexSize (GETEOFPTR Stream))
then (* Need to lengthen the file so that copies of cards
will be out of way of expanding index.)
(SETFILEPTR Stream NewTotalIndexSize))
(* * Search for a card part and copy it out to end of file. Repeat till we've freed up enough room for the desired
number of new index entries. FileLoc winds up pointing to new start of data area.)
(SETQ FileLoc OldTotalIndexSize)
(SETQ CardPartFileLocs (for CTR from 1 eachtime (BLOCK) bind CardPartRecord
ToPtr
while (AND (SETQ CardPartRecord
(NC.AutoloadApply* (FUNCTION
NC.FindNextCardPart)
NoteFile FileLoc))
(LESSP (SETQ FileLoc (fetch (CardPartRecord
FileLoc)
of CardPartRecord))
NewTotalIndexSize)
(PROGN (if (ZEROP (IREMAINDER CTR 100))
then (NC.PrintMsg
InterestedWindow T
OperationMsg
"Making room for expanded index."
(CHARACTER
13)
"Moving card part "
CTR "."
(CHARACTER
13)))
(SETQ ToPtr
(NC.CopyCardPartInPlaceToEOF
NoteFile
CardPartRecord
TempStream
InterestedWindow))))
collect (* Put out the new ChkptPtr to the file just in case
we crash inside this loop.)
(NC.PutCheckptPtr NoteFile ToPtr)
(PROG1 FileLoc (SETQ FileLoc
(PLUS FileLoc (fetch (CardPartRecord
CardPartLength)
of CardPartRecord))))))
(* * Compute the number of new entries we now have space to accomodate. May be less than was asked for if we bombed
in middle of copy.)
(SETQ TotalNewIndexEntries (QUOTIENT (DIFFERENCE FileLoc OldTotalIndexSize)
(CONSTANT (fetch (NoteFileVersion
NoteFileIndexWidth)
of (NC.FetchCurrentVersionObject)
))))
(if (GEQ TotalNewIndexEntries 1)
then
(* * We at least got room for one new index entry, so record new index size in file and write down hash array.)
(SETQ NewIndexSize (PLUS (fetch (NoteFile HashArraySize) of NoteFile)
TotalNewIndexEntries))
(NCLocalDevice.PutHashArray NoteFile InterestedWindow NIL OperationMsg)
(replace (NoteFile HashArraySize) of NoteFile with NewIndexSize)
(* Make sure new hash array size gets written down.)
(NC.PutNoteFileHeader NoteFile)
(* * An ugly kludge: must smash old %### indicators in file for newly copied card parts with 0's so no one will
accidentally back up to them using inspector. Those old card parts are now in index territory.
Had to wait until PutHashArray succeeded before doing this.)
(for OldFileLoc in CardPartFileLocs when (AND (NUMBERP OldFileLoc)
(LESSP OldFileLoc
(GETEOFPTR
Stream)))
do (SETFILEPTR Stream OldFileLoc)
(NC.WritePtr Stream 0 6)) (* Move index from old hash array into larger hash
array.)
(LET ((NewHashArray (NC.CreateUIDHashArray NewIndexSize)))
(REHASH (fetch (NoteFile HashArray) of NoteFile)
NewHashArray)
(replace (NoteFile HashArray) of NoteFile with NewHashArray))
TotalNewIndexEntries
else
(* * We weren't able to recover room for any new index entries.)
NIL))))
(NC.CopyCardPart
(LAMBDA (FromStream ToStream FromPtr ToPtr InterestedWindow)
(* rht: "15-May-87 22:01")
(* * Copy a card part from one stream to another)
(* * This function is used by both Compact to new file and CompactInPlace. Returns Length The Length result is used
by Compact to new file as a success flag. Length is used by CompactInPlace to compute the next place to write.)
(* * rht 11/3/86: Added flashw before error message.)
(* * rht 1/22/87: Removed unused CardPartTypeNum and Card args. Added InterestedWindow arg.)
(LET (Length EndPtr)
(SETFILEPTR FromStream FromPtr)
(SETFILEPTR ToStream ToPtr)
(if (SETQ Length (FIXP (NC.ReadPtr FromStream 3)))
then (SETQ EndPtr (PLUS FromPtr Length))
(until (if (CAR (ERSETQ (OR (COPYBYTES FromStream ToStream FromPtr
EndPtr)
0)))
then (RETURN Length)
else (if (EQ (ERRORN)
22)
then (* file system resources exceeded)
(ERROR "Trouble copying card."
(CONCAT "Try freeing at least "
(MAX 1 (IQUOTIENT
(IDIFFERENCE EndPtr
FromPtr)
512))
" pages in "
(FILENAMEFIELD ToStream
(QUOTE HOST))
(FILENAMEFIELD ToStream
(QUOTE
DIRECTORY))
"."
(CHARACTER 13)
"Then click here, type OK, and hit RETURN"))
NIL
else (RETURN NIL))))
else (FLASHW InterestedWindow)
(NC.PrintMsg InterestedWindow T "Bad NoteFile. Please Inspect and Repair."
(CHARACTER 13))
NIL))))
)
(* * Change to NCLOCALDEVICE)
(DEFINEQ
(NCLocalDevice.NewCardUID
(LAMBDA (Card) (* rht: "15-May-87 19:00")
(* * The local single user device vector function, which installs the UID and IndexLoc into the Card Object.)
(* * kef 8/6/86: Incorporated kirk's change: Kirk 7/25/86: Fixed overflow check to catch GEQ, gave warning message
a window to show message, changed warning message and changed break call to ERROR!.)
(* * rht 1/22/87: Now only calls NC.MakeUID if Card doesn't already have one. Made small change to calculation of
PercentUsed. Prevented NextIndexNum from being incremented in the case of full index.)
(* * rht 5/15/87: Now calls NC.CheckForExpandIndex to handle cases when index is full or nearly full.)
(LET ((NoteFile (fetch (Card NoteFile) of Card))
NextIndexNum IndexNumsFreeList IndexNum PercentUsed NumUsed)
(NC.CheckForExpandIndex NoteFile)
(SETQ NextIndexNum (fetch (NoteFile NextIndexNum) of NoteFile))
(SETQ IndexNumsFreeList (fetch (NoteFile IndexNumsFreeList) of NoteFile))
(if IndexNumsFreeList
then (SETQ IndexNum (pop IndexNumsFreeList))
(replace (NoteFile IndexNumsFreeList) of NoteFile with IndexNumsFreeList)
else (SETQ IndexNum NextIndexNum)
(replace (NoteFile NextIndexNum) of NoteFile with (ADD1 NextIndexNum)))
(replace (Card IndexLoc) of Card with (NC.NoteFileLocFromIndexNum IndexNum))
(replace (Card IndexDirtyFlg) of Card with T)
(OR (type? UID (fetch (Card UID) of Card))
(replace (Card UID) of Card with (NC.MakeUID)))
Card)))
)
(* * Changes to NCCOMPACT)
(DEFINEQ
(NC.CompactNoteFileInPlace
(LAMBDA (NoteFile InterestedWindow) (* rht: "16-May-87 00:39")
(* * 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.)
(* * rht 1/22/87: Now bails out if NC.ExpandIndexInPlace was called but returned NIL. Also fixed message when size
of notefile actually increases.)
(* * rht 5/16/87: No longer calls NC.ExpandIndexInPlace.)
(if (AND NoteFile (SETQ NoteFile (NC.OpenNoteFile NoteFile NIL T T NIL NIL T 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 OriginalLengthOfFile OperationMsg)
(* * Expand index if needed.)
(SETQ OperationMsg (CONCAT "Compacting " FullFileName
" in place."
(CHARACTER 13)))
(SETQ OriginalLengthOfFile (GETEOFPTR SourceStream))
(* * In sorted order, copy entries to lower locations in the file. Expand index first if necessary.)
(if (SETQ ToPtr (NC.CopySortedCardParts
(NC.SortIndexEntries NoteFile)
NIL
(NC.TotalIndexSize (fetch (NoteFile HashArraySize)
of NoteFile))
BufferStream
(GETEOFPTR SourceStream)
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)))
(if (MINUSP NumBytesSaved)
then (NC.PrintMsg
NIL T FullFileName
" compacted in place."
(CHARACTER 13)
"Increased by "
(MINUS NumBytesSaved)
" bytes ("
(FIX (TIMES 100 (FQUOTIENT
(MINUS NumBytesSaved)
OriginalLengthOfFile)))
"%%)"
(CHARACTER 13))
else (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.")))))))
(NC.CompactNoteFileToTarget
(LAMBDA (FromNoteFile ToFileName InterestedWindow) (* rht: "16-May-87 00:40")
(* * In sorted order, copy card parts to lower addresses in the file.)
(* * fgh 5/1/86 Now returns the ToNoteFile in order to be compatible with compact in place.)
(* * rht 11/3/86: Now opens FromNoteFile read-only. Also now takes InterestedWindow arg.)
(* * rht 1/22/87: Slight change to computation of new index size.)
(* * rht 3/17/87: Added RESETLST to make sure notefiles get closed in case of bombing out.)
(* * rht 5/15/87: No longer calls NC.ComputeNewDatabaseIndexSize. Target notefile's index will be same size as
source notefile's.)
(LET (ToNoteFile OperationMsg)
(SETQ FromNoteFile
(NC.OpenNoteFile FromNoteFile NIL T T T NIL T T T InterestedWindow NIL NIL NIL T))
(SETQ OperationMsg (CONCAT "Compacting " (fetch (NoteFile FullFileName) of
FromNoteFile)
(CHARACTER 13)))
(SETQ ToNoteFile (NC.OpenNoteFile (NC.CreateDatabaseFile ToFileName
(fetch (NoteFile
HashArraySize)
of FromNoteFile)
OperationMsg T NIL T
InterestedWindow)
NIL T T T T T T T InterestedWindow))
(RESETLST (RESETSAVE NIL (BQUOTE (NC.ForceDatabaseClose , FromNoteFile)))
(RESETSAVE NIL (BQUOTE (NC.ForceDatabaseClose , ToNoteFile)))
(LET ((OriginalStream (fetch (NoteFile Stream) of FromNoteFile))
(TargetStream (fetch (NoteFile Stream) of ToNoteFile))
FromFileLength TargetFileLength BytesRecovered)
(replace (NoteFile NextIndexNum) of ToNoteFile
with (fetch (NoteFile NextIndexNum) of FromNoteFile))
(SETFILEPTR TargetStream (NC.TotalIndexSize (fetch (NoteFile
HashArraySize)
of ToNoteFile)))
(* truncate ToNoteFile after the index)
(if (NC.CopySortedCardParts (NC.SortIndexEntries FromNoteFile)
ToNoteFile NIL NIL NIL InterestedWindow
OperationMsg)
then (* all useable card parts got copied)
(SETQ FromFileLength (GETEOFPTR OriginalStream))
(* * fool NC.PutHashArray into writing out the index for the new NoteFile)
(replace (NoteFile Stream) of FromNoteFile with
TargetStream)
(NCLocalDevice.PutHashArray FromNoteFile InterestedWindow T
OperationMsg)
(replace (NoteFile Stream) of FromNoteFile with
OriginalStream)
(* * Put out the new ChkptPtr to the file.)
(replace (NoteFile CheckptPtr) of ToNoteFile
with (SETQ TargetFileLength (GETEOFPTR TargetStream)))
(* * Steal the UID from the original file so links will work. Write out the header.)
(replace (NoteFile UID) of ToNoteFile
with (fetch (NoteFile UID) of FromNoteFile))
(NC.PutNoteFileHeader ToNoteFile)
(SETQ BytesRecovered (DIFFERENCE FromFileLength
TargetFileLength))
(NC.PrintMsg NIL T (fetch (NoteFile FullFileName)
of FromNoteFile)
" compacted to "
(fetch (NoteFile FullFileName) of ToNoteFile)
(CHARACTER 13)
"Recovered " BytesRecovered " bytes ("
(FIX (TIMES 100 (FQUOTIENT BytesRecovered
FromFileLength)))
"%%)"
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
ToNoteFile)))))
)
(* * The function NC.CopySortedCardPartInPlaceToEOF should be removed from NCCOMPACT.)
(PUTPROPS RHTPATCH262 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2544 13690 (NC.CheckForExpandIndex 2554 . 8921) (NC.FindNextCardPart 8923 . 11091) (
NC.CopyCardPartInPlaceToEOF 11093 . 12247) (NC.UpdateIndexLocIfNeeded 12249 . 13688)) (13889 21498 (
NC.ExpandIndexInPlace 13899 . 19561) (NC.CopyCardPart 19563 . 21496)) (21535 23368 (
NCLocalDevice.NewCardUID 21545 . 23366)) (23402 31567 (NC.CompactNoteFileInPlace 23412 . 27665) (
NC.CompactNoteFileToTarget 27667 . 31565)))))
STOP