(FILECREATED "24-May-87 00:46:19" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH266.;4 23964
changes to: (VARS RHTPATCH266COMS)
(FNS NCP.ExpandNoteFileIndex NC.ExpandIndexInPlace NCLocalDevice.PutHashArray
NCP.NumCardSlotsRemaining NC.CheckForExpandIndex NCP.RegisterCardByName
NCP.LookupCardByName NCP.UnregisterName NCP.ListRegisteredCards)
previous date: "23-May-87 22:46:58" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH266.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH266COMS)
(RPAQQ RHTPATCH266COMS ((* * Fixes several programmer's interface bugs including %#573, 472, 242,
366.0 Can now set the region of a card, perform Registry card operations
on one's own registry cards, and expand a notefile's index.)
(* * Changes to NCPROGINT)
(FNS NCP.CardRegion)
(FNS NCP.RegisterCardByName NCP.LookupCardByName NCP.UnregisterName)
(* * New functions for NCPROGINT)
(FNS NCP.ListRegisteredCards)
(FNS NCP.NumCardSlotsRemaining NCP.ExpandNoteFileIndex)
(* * Changes to NCDATABASE)
(FNS NC.CheckForExpandIndex NC.ExpandIndexInPlace)
(* * Changes to NCLOCALDEVICE)
(FNS NCLocalDevice.PutHashArray)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA NCP.CardRegion)))))
(* * Fixes several programmer's interface bugs including %#573, 472, 242, 366.0 Can now set
the region of a card, perform Registry card operations on one's own registry cards, and expand
a notefile's index.)
(* * Changes to NCPROGINT)
(DEFINEQ
(NCP.CardRegion
(LAMBDA Args (* rht: "23-May-87 22:42")
(* * Return the substance for this card.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht 5/23/87: Now takes optional second argument which should be new region for Card.)
(LET (Card)
(COND
((AND (NEQ Args 1)
(NEQ Args 2))
(NCP.ReportError (QUOTE NCP.CardRegion)
(CONCAT "Improper number of args: " Args))
NIL)
((NCP.ValidCardP (SETQ Card (ARG Args 1)))
(LET (WasActive Region)
(OR (SETQ WasActive (NCP.CardCachedP Card))
(NCP.CacheCards Card))
(PROG1 (NC.FetchRegion Card)
(if (EQ Args 2)
then (if (REGIONP (SETQ Region (ARG Args 2)))
then (NC.SetRegion Card Region)
(if (NCP.CardDisplayedP Card)
then (SHAPEW (NCP.CardWindow Card)
Region)
else (NC.PutRegion Card))
else (NCP.ReportError (QUOTE NCP.CardRegion)
(CONCAT Region
" not a valid REGION."))))
(OR WasActive (NCP.CloseCards Card T)))))
(T (NCP.ReportError (QUOTE NCP.CardRegion)
(CONCAT Card " not an existing card."))
NIL)))))
)
(DEFINEQ
(NCP.RegisterCardByName
(LAMBDA (Name Card RegistryCard) (* rht: "23-May-87 23:21")
(* * Hash Card under Name in Card's notefile's system registry card.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht 5/23/87: Added RegistryCard arg which defaults to the notefile registry card.)
(OR RegistryCard (SETQ RegistryCard (fetch (NoteFile RegistryCard) of (
NCP.NoteFileFromCard
Card))))
(COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError (QUOTE NCP.RegisterCardByName)
(CONCAT Card " is not a valid notecard.")))
((NOT (AND (NC.ValidCardP RegistryCard)
(EQ (NCP.CardType RegistryCard)
(QUOTE Registry))))
(NCP.ReportError (QUOTE NCP.RegisterCardByName)
(CONCAT RegistryCard " is not a valid registry card.")))
(T (NC.RegisterCardByName RegistryCard Name Card)))))
(NCP.LookupCardByName
(LAMBDA (Name NoteFileOrRegistryCard) (* rht: "23-May-87 23:37")
(* * Lookup Name in notefile's system registry card.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht 5/23/87: Second arg can now be RegistryCard or NoteFile. If the latter, then grab notefile's
RegistryCard.)
(LET (RegistryCard)
(COND
((NCP.OpenNoteFileP NoteFileOrRegistryCard)
(SETQ RegistryCard (fetch (NoteFile RegistryCard) of NoteFileOrRegistryCard)))
((AND (NC.ValidCardP NoteFileOrRegistryCard)
(EQ (NCP.CardType NoteFileOrRegistryCard)
(QUOTE Registry)))
(SETQ RegistryCard NoteFileOrRegistryCard))
(T (NCP.ReportError (QUOTE NCP.LookupCardByName)
(CONCAT "Improper arg: " NoteFileOrRegistryCard))))
(NC.LookupCardByName RegistryCard Name))))
(NCP.UnregisterName
(LAMBDA (Name NoteFileOrRegistryCard) (* rht: "23-May-87 23:37")
(* * Lookup Name in notefile's system registry card.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht 5/23/87: Second arg can now be RegistryCard or NoteFile. If the latter, then grab notefile's
RegistryCard.)
(LET (RegistryCard)
(COND
((NCP.OpenNoteFileP NoteFileOrRegistryCard)
(SETQ RegistryCard (fetch (NoteFile RegistryCard) of NoteFileOrRegistryCard)))
((AND (NC.ValidCardP NoteFileOrRegistryCard)
(EQ (NCP.CardType NoteFileOrRegistryCard)
(QUOTE Registry)))
(SETQ RegistryCard NoteFileOrRegistryCard))
(T (NCP.ReportError (QUOTE NCP.UnregisterName)
(CONCAT "Improper arg: " NoteFileOrRegistryCard))))
(NC.UnregisterName RegistryCard Name))))
)
(* * New functions for NCPROGINT)
(DEFINEQ
(NCP.ListRegisteredCards
(LAMBDA (NoteFileOrRegistryCard IncludeKeysFlg) (* rht: "23-May-87 23:35")
(* * Return the list of cards registered in the RegistryCard or notefile. If IncludeKeysFlg is non-nil, then return
dotted pairs of key and card, else just list of cards.)
(LET (RegistryCard Result)
(COND
((NCP.OpenNoteFileP NoteFileOrRegistryCard)
(SETQ RegistryCard (fetch (NoteFile RegistryCard) of NoteFileOrRegistryCard)))
((AND (NC.ValidCardP NoteFileOrRegistryCard)
(EQ (NCP.CardType NoteFileOrRegistryCard)
(QUOTE Registry)))
(SETQ RegistryCard NoteFileOrRegistryCard))
(T (NCP.ReportError (QUOTE NCP.ListRegisteredCards)
(CONCAT "Improper arg: " NoteFileOrRegistryCard))))
(if IncludeKeysFlg
then (MAPHASH (NCP.CardSubstance RegistryCard)
(FUNCTION (LAMBDA (Val Key)
(push Result (CONS Key Val)))))
else (MAPHASH (NCP.CardSubstance RegistryCard)
(FUNCTION (LAMBDA (Val Key)
(push Result Val)))))
Result)))
)
(DEFINEQ
(NCP.NumCardSlotsRemaining
(LAMBDA (NoteFile) (* rht: "24-May-87 00:04")
(* * Return the number of card slots remaining in NoteFile. After they run out, it will have to have its index
expanded.)
(if (NCP.OpenNoteFileP NoteFile)
then (DIFFERENCE (fetch (NoteFile HashArraySize) of NoteFile)
(NC.TotalCardsInNoteFile NoteFile))
else (NCP.ReportError (QUOTE NCP.NumCardSlotsRemaining)
(CONCAT NoteFile " is not an open notefile.")))))
(NCP.ExpandNoteFileIndex
(LAMBDA (NoteFile NumNewSlots QuietFlg) (* rht: "24-May-87 00:37")
(* * Expand NoteFile's index in place after first checkpointing. Add room for NumNewSlots new slots.)
(LET (WasOpenFlg)
(if (SETQ WasOpenFlg (NCP.OpenNoteFileP NoteFile))
then (NCP.CheckpointNoteFiles NoteFile QuietFlg)
else (NCP.OpenNoteFile NoteFile T NIL QuietFlg NIL NIL T))
(NC.ExpandIndexInPlace NoteFile (PLUS (fetch (NoteFile HashArraySize) of NoteFile)
NumNewSlots)
NIL NIL NIL QuietFlg)
(OR WasOpenFlg (NCP.CloseNoteFiles NoteFile QuietFlg)))))
)
(* * Changes to NCDATABASE)
(DEFINEQ
(NC.CheckForExpandIndex
(LAMBDA (NoteFile QuietFlg InterestedWindow) (* rht: "24-May-87 00:19")
(* * 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.)
(* * rht 5/24/87: Now passes QuietFlg to NC.ExpandIndexInPlace.)
(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 NIL
QuietFlg))
(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.ExpandIndexInPlace
(LAMBDA (NoteFile NewIndexSize TempStream InterestedWindow OperationMsg QuietFlg)
(* rht: "24-May-87 00:36")
(* * 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.)
(* * rht 5/24/87: Added QuietFlg arg.)
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(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)
(OR QuietFlg (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 (OR QuietFlg
(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)
))))
(PROG1 (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
QuietFlg)
(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)
(OR QuietFlg (NC.ClearMsg InterestedWindow T))))))
)
(* * Changes to NCLOCALDEVICE)
(DEFINEQ
(NCLocalDevice.PutHashArray
(LAMBDA (NoteFile InterestedWindow AllCardsFlg OperationMsg QuietFlg)
(* rht: "24-May-87 00:32")
(* * Write down the hash array's contents to the notefile.)
(* * kirk 27Nov85 Added AllCardsFlg for use by the compactor.)
(* * fgh 5/26/86 Adapted from NC.PutHashArray with minor changes.)
(* * fgh 9/1/86 Reimplemented QuietFlg.)
(* * fgh 9/5/86 Put in check for HARRAYP of NoteFile's HashArray becuase MAPHASH of NIL will map hash down an
arbitrary array.)
(* * rht 3/13/87: Fixed the "TPutting" print msg. Changed AllActiveCardsFlg to be AllCardsFlg.
This allows cards with Deleted status to be written down with Free status.)
(* * rht 5/24/87: Now sets InterestedWindow if was passed in nil.)
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(if (HARRAYP (fetch (NoteFile HashArray) of NoteFile))
then (LET ((CardTotal (SUB1 (fetch (NoteFile NextIndexNum) of NoteFile)))
(Num 0))
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Putting index array."
(CHARACTER 13)
"Processing item number " 1 " out of " CardTotal
"."
(CHARACTER 13)))
(NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
(OR QuietFlg (PROGN (SETQ Num (ADD1 Num))
(AND (ZEROP (IREMAINDER Num 100))
(NC.PrintMsg InterestedWindow T
(OR OperationMsg
"")
"Putting index array."
(CHARACTER
13)
"Processing item number "
Num " out of "
CardTotal "."
(CHARACTER
13)))))
(* Turn deleted slots into free ones.)
(if (AND AllCardsFlg (NEQ (fetch (Card Status)
of Card)
(QUOTE ACTIVE)))
then (replace (Card Status) of Card
with (QUOTE FREE)))
(if (OR AllCardsFlg (fetch (Card IndexDirtyFlg)
of Card))
then (NCLocalDevice.PutIndexEntry Card)))))))))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NCP.CardRegion)
)
(PUTPROPS RHTPATCH266 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1624 3221 (NCP.CardRegion 1634 . 3219)) (3222 6184 (NCP.RegisterCardByName 3232 . 4260)
(NCP.LookupCardByName 4262 . 5224) (NCP.UnregisterName 5226 . 6182)) (6225 7405 (
NCP.ListRegisteredCards 6235 . 7403)) (7406 8693 (NCP.NumCardSlotsRemaining 7416 . 7989) (
NCP.ExpandNoteFileIndex 7991 . 8691)) (8728 21227 (NC.CheckForExpandIndex 8738 . 15214) (
NC.ExpandIndexInPlace 15216 . 21225)) (21265 23736 (NCLocalDevice.PutHashArray 21275 . 23734)))))
STOP