(FILECREATED "11-Jul-85 20:50:05" {PHYLUM}<NOTECARDS>RELEASE1.2I>RHTPATCH001.;4 54442
changes to: (FNS NC.PutNoteCard NC.PutLinkLabels NC.PutLinks NC.PutTitle NC.PutPropList
NC.PutMainCardData NC.GetLinkLabels NC.CopyMainCardData NC.CopyLinks
NC.CopyTitle NC.CopyPropList NC.CopyLinkLabels NC.FastCopyNoteCard
NC.CompactDatabaseInPlace)
(VARS RHTPATCH001COMS)
previous date: " 9-Jul-85 19:00:15" {PHYLUM}<NOTECARDS>RELEASE1.2I>RHTPATCH001.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH001COMS)
(RPAQQ RHTPATCH001COMS ((* * Changes for adding date info to data entries in notefile.)
(* * Old functions from NCDATABASE.)
(FNS NC.GetIdentifier NC.PutIdentifier)
(FNS NC.GetNoteCard NC.GetLinkLabels NC.GetLinks NC.GetTitle NC.GetType
NC.GetPropList)
(FNS NC.PutNoteCard NC.PutLinkLabels NC.PutLinks NC.PutTitle NC.PutPropList
NC.PutMainCardData)
(FNS NC.CopyMainCardData NC.CopyLinks NC.CopyTitle NC.CopyPropList
NC.CopyLinkLabels NC.FastCopyNoteCard)
(* * New stuff for NCDATABASE.)
(GLOBALVARS NC.DataFormatVersionNumber NC.DateStringLength NC.LinkLabelsDate
NC.ClippedIdentifierAtoms)
(VARS (NC.DataFormatVersionNumber 1)
(NC.DateStringLength 18)
(NC.LinkLabelsDate NIL)
(NC.ClippedIdentifierAtoms (for Atom in NC.IdentifierAtoms collect
(SUBATOM Atom 1 -3))))
(FNS NC.PutDate NC.GetDate)
(* * Old functions from NCCARDS.)
(FNS NC.DeactivateCard)
(* * New stuff for NCCARDS.)
(FNS NC.FetchTitleDate NC.FetchItemDate NC.FetchPropListDate
NC.FetchLinksDate)
(FNS NC.SetTitleDate NC.SetItemDate NC.SetPropListDate NC.SetLinksDate)
(* * Old functions from NCINTERFACE)
(FNS NC.ForceDatabaseClose)
(* * Random fixes.)
(FNS NC.CompactDatabaseInPlace)))
(* * Changes for adding date info to data entries in notefile.)
(* * Old functions from NCDATABASE.)
(DEFINEQ
(NC.GetIdentifier
(LAMBDA (DatabaseStream Identifier) (* rht: " 9-Jul-85 15:41")
(* Return T if next item on databaseStream is the
identifier specified by Identifier)
(* * rht 2/4/85: A horrible hack for the case of titles identifier. This is because a previous typo was causing
NOBIND to get written for titles identifiers.)
(* * rht 7/9/85: Now checks for new data format. This is indicated by identifiers with the last two #'s clipped off.
Then comes the one-byte version number of the data format. If identifier is not clipped then it's old style and
there is no version number. Return version number if there is one, 0 if old style, and NIL if can't match
identifier.)
(LET ((ThingRead (READ DatabaseStream))
(ClippedIdentifier (SUBATOM Identifier 1 -3)))
(COND
((OR (EQ ThingRead Identifier)
(AND (EQ Identifier NC.TitlesIdentifier)
(EQ ThingRead (QUOTE NOBIND))))
0)
((AND (EQ ThingRead ClippedIdentifier)
(NUMBERP (PROGN (* First char is separator. Next is one-byte version
number.)
(READC DatabaseStream)
(NC.GetPtr DatabaseStream 1)))))
(T NIL)))))
(NC.PutIdentifier
(LAMBDA (DatabaseStream Identifier) (* rht: " 9-Jul-85 15:40")
(* Put Identifier on DatabaseStream)
(* * Now puts out new data format style. This consists of the identifier with the last two #'s clipped off followed
by the data format version byte.)
(PRINT (SUBATOM Identifier 1 -3)
DatabaseStream)
(NC.PutPtr DatabaseStream NC.DataFormatVersionNumber 1)))
)
(DEFINEQ
(NC.GetNoteCard
(LAMBDA (ID DatabaseStream IncludeDeletedCardsFlg) (* rht: " 9-Jul-85 17:36")
(* Get a note card from the database. If IncludeDeletedCardsFlg is NIL, then return immediately if card is deleted
or free. Otherwise, get dekleted but not free cards.)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetNoteCard")
(PROG (Index PtrList Ptr LinksPtr TitlePtr PropsPtr Status ActualID NoteCardType
Title Substance PropList FromLinks ToLinks Region GlobalLinks Stream
VersionNumber) (* IncludeDeletedCardsFlg -- Include delete not yet
implemented)
(SETQ IncludeDeletedCardsFlg)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetNoteCard"))
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(SETQ Ptr (CADR PtrList))
(SETQ LinksPtr (CADDR PtrList))
(SETQ TitlePtr (CADDDR PtrList))
(SETQ PropsPtr (CAR (CDDDDR PtrList)))
(COND
((AND (NEQ Status (QUOTE ACTIVE))
(OR (NOT IncludeDeletedCardsFlg)
(NEQ Status (QUOTE DELETED))))
(RETURN Status))
(T (* Get Substance)
(SETFILEPTR Stream Ptr)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier Stream NC.ItemIdentifier)))
(NC.ReportError "NC.GetNoteCard" (CONCAT ID
" Error in Database file -- incorrect item identifier."))))
(if (GEQ VersionNumber 1)
then (NC.SetItemDate ID (NC.GetDate Stream)))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetNoteCard" (CONCAT
"ID mismatch while reading item. Expected ID: "
ID " Found ID: " ActualID)
)))
(SETQ NoteCardType (READ Stream))
(READC Stream)
(SETQ Region (NC.GetRegion ID Stream))
(SETQ Substance (APPLY* (NC.GetSubstanceFn NoteCardType)
Stream ID))
(* * Setup ID with appropriate properties for retrieved card)
(NC.SetType ID NoteCardType)
(NC.SetRegion ID Region)
(NC.SetSubstance ID Substance)
(* * Get Links)
(NC.GetLinks ID Stream LinksPtr)
(* * GetTitle)
(NC.GetTitle ID Stream TitlePtr)
(* * Get Prop List)
(NC.GetPropList ID Stream PropsPtr)
(* * Activate Card and return)
(NC.ActivateCard ID)
(RETURN ID)))))))
(NC.GetLinkLabels
(LAMBDA (DatabaseStream) (* rht: " 9-Jul-85 19:35")
(* Get the set of link labels from DatabaseStream.
Link label list is stored in normal way indexed by ID
NC.LinkLabelsID)
(* * rht 1/31/85: Now reads index from array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(PROG (Index VersionNumber)
(RETURN (WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(SETQ Index (NC.IndexFromID NC.LinkLabelsID "NC.GetLinkLabels"))
(NC.SetIndexOffset DatabaseStream Index)
(NC.GetStatusFromIndex DatabaseStream)
(SETQ Index (NC.GetPtrFromIndex DatabaseStream))
(SETFILEPTR DatabaseStream Index)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier DatabaseStream
NC.LinkLabelsIdentifier)))
(NC.ReportError "NC.GetLinkLabels" (CONCAT ID
" Error in Database file -- incorrect identifier."))))
(if (GEQ VersionNumber 1)
then (SETQ NC.LinkLabelsDate (NC.GetDate DatabaseStream)))
(SETQ ActualID (READ DatabaseStream))
(COND
((NEQ ActualID NC.LinkLabelsID)
(NC.ReportError "NC.GetLinkLabels" (CONCAT
"ID mismatch while reading links. Expected ID: "
NC.LinkLabelsID
" Found ID: "
ActualID))))
(READ DatabaseStream))))))
(NC.GetLinks
(LAMBDA (ID DatabaseStream LinksPtr) (* rht: " 9-Jul-85 17:33")
(* * rht 1/31/85: Now reads pointers from index array.)
(* * rht 2/9/85: Now fixes display formats on links read in.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetNoteCard")
(PROG (Index PtrList Status ActualID FromLinks ToLinks GlobalLinks Stream
VersionNumber)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetLinks"))
(COND
((NULL LinksPtr)
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(AND (NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(SETQ LinksPtr (CADDR PtrList))))
(* Get Links)
(SETFILEPTR Stream LinksPtr)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier Stream NC.LinksIdentifier)))
(NC.ReportError "NC.GetLinks" (CONCAT ID
" Error in Database file -- incorrect links identifier."))))
(if (GEQ VersionNumber 1)
then (NC.SetLinksDate ID (NC.GetDate Stream)))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetLinks" (CONCAT
"ID mismatch while reading links. Expected ID: "
ID " Found ID: " ActualID))))
(SETQ ToLinks (READ Stream))
(for Link in ToLinks do (NC.CheckDisplayModeFormat Link))
(SETQ FromLinks (READ Stream))
(for Link in FromLinks do (NC.CheckDisplayModeFormat Link))
(SETQ GlobalLinks (LISTP (READ Stream)))
(for Link in GlobalLinks do (NC.CheckDisplayModeFormat Link))
(* Setup ID with appropriate properties for retrieved
card)
(NC.SetToLinks ID ToLinks)
(NC.SetFromLinks ID FromLinks)
(NC.SetGlobalLinks ID GlobalLinks)
(NC.SetLinksDirtyFlg ID NIL)
(RETURN ID)))))
(NC.GetTitle
(LAMBDA (ID DatabaseStream TitlePtr NoReportFlg) (* rht: " 9-Jul-85 17:33")
(* Retrieve title for card specified by ID from the
database specified by DatabaseStream)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetTitle")
(PROG (PtrList Status ActualID Title Stream VersionNumber)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetTitle"))
(COND
((NULL TitlePtr)
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(AND (NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(SETQ TitlePtr (CADDDR PtrList))))
(SETFILEPTR Stream TitlePtr)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier Stream NC.TitlesIdentifier)))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetTitle" (CONCAT ID
" Error in Database file -- incorrect title identifier.")))))
)
(if (GEQ VersionNumber 1)
then (NC.SetTitleDate ID (NC.GetDate Stream)))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetTitle" (CONCAT
"ID mismatch while reading item. Expected ID: "
ID " Found ID: " ActualID))))
))
(SETQ Title (READ Stream))
(NC.SetTitle ID Title)
(RETURN Title)))))
(NC.GetType
(LAMBDA (ID DatabaseStream Ptr) (* rht: " 9-Jul-85 17:34")
(* Retrieve the NoteCardType of card specified by ID
from the database specified by DatabaseStream)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetType")
(PROG (PtrList Status ActualID NoteCardType Stream VersionNumber)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetType"))
(COND
((NULL Ptr)
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(AND (NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(SETQ Ptr (CADR PtrList))))
(SETFILEPTR Stream Ptr)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier Stream NC.ItemIdentifier)))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetType" (CONCAT ID
" Error in Database file -- incorrect item identifier.")))))
)
(if (GEQ VersionNumber 1)
then (NC.SetItemDate ID (NC.GetDate Stream)))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetType" (CONCAT
"ID mismatch while reading item. Expected ID: "
ID " Found ID: " ActualID)))))
)
(SETQ NoteCardType (READ Stream))
(RETURN NoteCardType)))))
(NC.GetPropList
(LAMBDA (ID DatabaseStream PropPtr) (* rht: " 9-Jul-85 17:34")
(* Retrieve the prop list for card specified by ID from
the database specified by DatabaseStream)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetPropList")
(PROG (PtrList Status ActualID Props Stream VersionNumber)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetPropList"))
(COND
((NULL PropPtr)
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(AND (NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(SETQ PropPtr (fetch (POINTERLIST PROPSPTR) of PtrList))))
(SETFILEPTR Stream PropPtr)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier Stream NC.PropsIdentifier)))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetPropList" (CONCAT ID
" Error in Database file -- incorrect prop list identifier.")))))
)
(if (GEQ VersionNumber 1)
then (NC.SetPropListDate ID (NC.GetDate Stream)))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetPropList" (CONCAT
"ID mismatch while reading item. Expected ID: "
ID " Found ID: " ActualID)
)))))
(SETQ Props (READ Stream))
(NC.SetPropList ID Props)
(RETURN Props)))))
)
(DEFINEQ
(NC.PutNoteCard
(LAMBDA (ID DatabaseStream UpdateUpdateListFlg UseOldDateFlg)
(* rht: "11-Jul-85 20:48")
(* * Write note card specified by ID to the database specified by Database stream)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.PutNoteCard")
(PROG (DataPtr Index Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.PutNoteCard"))
(AND UpdateUpdateListFlg (NC.UpdateUpdateList ID))
(* * First write out the attached stuff of the card i.e., title, prop list, etc.)
(SETFILEPTR Stream (SETQ DataPtr (GETEOFPTR Stream)))
(NC.PutIdentifier Stream NC.ItemIdentifier)
(NC.PutDate Stream (if UseOldDateFlg
then (NC.FetchItemDate ID)
else (NC.SetItemDate ID (DATE))))
(PRINT ID Stream)
(PRINT (NC.FetchType ID)
Stream)
(NC.PutRegion ID Stream)
(* * Write out the substance of the card.)
(APPLY* (NC.PutSubstanceFn (NC.FetchType ID))
ID Stream)
(* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for
some reason.)
(SETQ Index (NC.IndexFromID ID "NC.PutNoteCard"))
(NC.SetIndexOffset Stream Index)
(NC.PutStatusToIndex Stream (QUOTE ACTIVE))
(NC.PutPtrToIndex Stream DataPtr)
(RETURN ID)))))
(NC.PutLinkLabels
(LAMBDA (DatabaseStream LinkLabels UseOldDateFlg) (* rht: "11-Jul-85 20:47")
(* * Put onto DatabaseStream the list of LinkLabel. Do so by writing at eof and then updating the index entry for ID
NC.LinkLabelID)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(PROG (Ptr)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(SETQ Ptr (GETEOFPTR DatabaseStream))
(SETFILEPTR DatabaseStream Ptr)
(NC.PutIdentifier DatabaseStream NC.LinkLabelsIdentifier)
(NC.PutDate DatabaseStream (if UseOldDateFlg
then NC.LinkLabelsDate
else (SETQ NC.LinkLabelsDate (DATE))))
(PRINT NC.LinkLabelsID DatabaseStream)
(PRINT LinkLabels DatabaseStream)
(NC.SetIndexOffset DatabaseStream (NC.IndexFromID NC.LinkLabelsID))
(NC.PutStatusToIndex DatabaseStream (QUOTE SPECIAL))
(NC.PutPtrToIndex DatabaseStream Ptr)))))
(NC.PutLinks
(LAMBDA (ID DatabaseStream UseOldDateFlg) (* rht: "11-Jul-85 20:47")
(* * Put the link data for ID onto the database file.)
(* * rht 1/30/85: Changed to use index array instead of file.)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.PutLinks")
(PROG (DataPtr Index (Stream (NC.CoerceDatabaseStream DatabaseStream "NC.PutLinks"))
)
(SETQ Index (NC.IndexFromID ID "NC.PutLinks"))
(* * Check to make sure this is an active note card.)
(NC.SetIndexOffset Stream Index)
(COND
((NOT (EQ (NC.GetStatusFromIndex Stream)
(QUOTE ACTIVE)))
(NC.ReportError "NC.PutLinks" (CONCAT ID " is not an active note card.")))
)
(* * Write the links data at the end of the database file.)
(SETFILEPTR Stream (SETQ DataPtr (GETEOFPTR Stream)))
(NC.PutIdentifier Stream NC.LinksIdentifier)
(NC.PutDate Stream (if UseOldDateFlg
then (NC.FetchLinksDate ID)
else (NC.SetLinksDate ID (DATE))))
(PRINT ID Stream)
(PRINT (NC.FetchToLinks ID)
Stream)
(PRINT (NC.FetchFromLinks ID)
Stream)
(PRINT (NC.FetchGlobalLinks ID)
Stream)
(NC.SetLinksDirtyFlg ID)
(* * Now update the index to point to the link data just written. Done last in case writing of links doesn't
complete okay.)
(NC.SetIndexOffset Stream Index)
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream DataPtr)
(RETURN ID)))))
(NC.PutTitle
(LAMBDA (ID DatabaseStream UseOldDateFlg) (* rht: "11-Jul-85 20:46")
(* * Put the title of card ID onto DatabaseStream)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.PutTitle")
(PROG (DataPtr Index Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.PutTitle"))
(* * First write out the title.)
(SETFILEPTR Stream (SETQ DataPtr (GETEOFPTR Stream)))
(NC.PutIdentifier Stream NC.TitlesIdentifier)
(NC.PutDate Stream (if UseOldDateFlg
then (NC.FetchTitleDate ID)
else (NC.SetTitleDate ID (DATE))))
(PRINT ID Stream)
(PRINT (NC.FetchTitle ID)
Stream)
(* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for
some reason.)
(SETQ Index (NC.IndexFromID ID "NC.PutTitle"))
(NC.SetIndexOffset Stream Index)
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream DataPtr)
(NC.SetTitleDirtyFlg ID NIL)
(RETURN ID)))))
(NC.PutPropList
(LAMBDA (ID DatabaseStream UseOldDateFlg) (* rht: "11-Jul-85 20:48")
(* * Put the prop list of card ID onto DatabaseStream)
(* * Write note card specified by ID to the database specified by Database stream)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.PutPropList")
(PROG (DataPtr Index Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.PutPropList"))
(* * First write out the prop list.)
(SETFILEPTR Stream (SETQ DataPtr (GETEOFPTR Stream)))
(NC.PutIdentifier Stream NC.PropsIdentifier)
(NC.PutDate Stream (if UseOldDateFlg
then (NC.FetchPropListDate ID)
else (NC.SetPropListDate ID (DATE))))
(PRINT ID Stream)
(PRINT (NC.FetchPropList ID)
Stream)
(* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for
some reason.)
(SETQ Index (NC.IndexFromID ID "NC.PutPropList"))
(NC.SetIndexOffset Stream Index)
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream DataPtr)
(NC.SetPropListDirtyFlg ID NIL)
(RETURN ID)))))
(NC.PutMainCardData
(LAMBDA (Stream ID NoteCardType Region SubstanceStream DontUpdateArrayFlg UseOldDateFlg)
(* rht: "11-Jul-85 20:48")
(* * Write out the junk for a card at current location in Stream finding the substance out on SubstanceStream.
Then update index.)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(PROG (MainPtr EndPtr SubstancePtr)
(SETQ MainPtr (GETFILEPTR Stream))
(NC.PutIdentifier Stream NC.ItemIdentifier)
(NC.PutDate Stream (if UseOldDateFlg
then (NC.FetchItemDate ID)
else (NC.SetItemDate ID (DATE))))
(PRINT ID Stream)
(PRINT NoteCardType Stream)
(NC.PutRegion ID Stream)
(SETQ SubstancePtr (GETFILEPTR Stream))
(APPLY* (NC.SubstanceCopyFn NoteCardType)
ID SubstanceStream Stream)
(SETFILEPTR Stream SubstancePtr)
(NC.GetPtr Stream 3)
(SETQ EndPtr (NC.GetPtr Stream 3)) (* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.PutPtrToIndex Stream MainPtr)) (* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.PutMainCardData"))
(NC.GetStatus Stream)
(NC.PutPtr Stream MainPtr)
(SETFILEPTR Stream EndPtr))))
)
(DEFINEQ
(NC.CopyMainCardData
(LAMBDA (Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg)
(* rht: " 9-Jul-85 19:26")
(* * Copy a card's ID#, type, region, substance, etc.)
(* * rht 7/9/85: Now copies dates if any.)
(PROG (ID NoteCardType Region EndPtr SubstancePtr VersionNumber Date)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (SETQ VersionNumber (NC.GetIdentifier Stream NC.ItemIdentifier))
(PROGN (if (GEQ VersionNumber 1)
then (SETQ Date (NC.GetDate Stream)))
(EQ ID (READ Stream))))
(NC.SetItemDate ID Date)
(SETQ NoteCardType (READ Stream))
(READC Stream) (* Have to cache the region of ID since later
NC.PutRegion needs it.)
(NC.SetRegion ID (SETQ Region (NC.GetRegion ID Stream)))
(SETQ SubstancePtr (GETFILEPTR Stream)) (* Copy the substance out to the {CORE} stream.)
(APPLY* (NC.SubstanceCopyFn NoteCardType)
ID Stream TempStream)
(SETFILEPTR Stream SubstancePtr)
(NC.GetPtr Stream 3)
(SETQ EndPtr (NC.GetPtr Stream 3))
(if (ILESSP (IDIFFERENCE FromPtr ToPtr)
(IDIFFERENCE EndPtr FromPtr))
then
(* We're trying to move N bytes to a location less than N bytes away. To be safe, we first move junk to end of
file.)
(SETFILEPTR Stream (GETEOFPTR Stream))
(SETFILEPTR TempStream 0)
(NC.PutMainCardData Stream ID NoteCardType Region TempStream
DontUpdateArrayFlg T))
(* Now copy junk to its proper home.)
(SETFILEPTR Stream ToPtr)
(SETFILEPTR TempStream 0)
(NC.PutMainCardData Stream ID NoteCardType Region TempStream DontUpdateArrayFlg T)
(RETURN (GETFILEPTR Stream)))
((NC.YesP (NC.AskUser (CONCAT "Trouble copying main card data for " ID (CHARACTER 13)
"Want to delete this card? ")
"--"
(QUOTE Yes)
T NIL NIL NIL T))
(OR DontUpdateArrayFlg (NC.MarkIndexEntryFree ID Stream))
(NC.MarkIndexEntryFreeInFile ID Stream)
(RETURN ToPtr))
(T (RETURN NIL))))))
(NC.CopyLinks
(LAMBDA (Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg)
(* rht: " 9-Jul-85 19:25")
(* * Copy a card's links from one point in the stream to another.)
(* * rht 7/9/85: Now handles dates if any.)
(PROG (ID EndPtr Length VersionNumber)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (SETQ VersionNumber (NC.GetIdentifier Stream NC.LinksIdentifier))
(PROGN (if (GEQ VersionNumber 1)
then (NC.GetDate Stream))
(EQ ID (READ Stream)))) (* Read ToLinks, FromLinks, and GlobalLinks.)
(READ Stream)
(READ Stream)
(READ Stream) (* Get past space at end.)
(READC Stream)
(SETQ EndPtr (GETFILEPTR Stream))
(COPYBYTES Stream TempStream FromPtr EndPtr)
(if (ILESSP (IDIFFERENCE FromPtr ToPtr)
(SETQ Length (IDIFFERENCE EndPtr FromPtr)))
then
(* We're trying to move N bytes to a location less than N bytes away. To be safe, we first move junk to end of
file.)
(SETFILEPTR Stream (SETQ FromPtr (GETEOFPTR Stream)))
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr))
(* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.PutMainCardData"))
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream FromPtr)) (* Now copy junk to its proper home.)
(SETFILEPTR Stream ToPtr)
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(SETQ EndPtr (GETFILEPTR Stream)) (* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr)) (* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.PutMainCardData"))
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream ToPtr)
(RETURN EndPtr))
((NC.YesP (NC.AskUser (CONCAT "Trouble copying links for" ID (CHARACTER 13)
"Want to delete this card? ")
"--"
(QUOTE Yes)
T NIL NIL NIL T))
(OR DontUpdateArrayFlg (NC.MarkIndexEntryFree ID Stream))
(NC.MarkIndexEntryFreeInFile ID Stream)
(RETURN ToPtr))
(T (RETURN NIL))))))
(NC.CopyTitle
(LAMBDA (Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg)
(* rht: " 9-Jul-85 19:27")
(* * Copy a card's title from one point in the stream to another.)
(* * rht 7/9/85: Now handles dates if any.)
(PROG (ID EndPtr Length VersionNumber)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (SETQ VersionNumber (NC.GetIdentifier Stream NC.TitlesIdentifier))
(PROGN (if (GEQ VersionNumber 1)
then (NC.GetDate Stream))
(EQ ID (READ Stream)))) (* Read title.)
(READ Stream) (* Get past space at end.)
(READC Stream)
(SETQ EndPtr (GETFILEPTR Stream))
(COPYBYTES Stream TempStream FromPtr EndPtr)
(if (ILESSP (IDIFFERENCE FromPtr ToPtr)
(SETQ Length (IDIFFERENCE EndPtr FromPtr)))
then
(* We're trying to move N bytes to a location less than N bytes away. To be safe, we first move junk to end of
file.)
(SETFILEPTR Stream (SETQ FromPtr (GETEOFPTR Stream)))
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr))
(* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.CopyTitle"))
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream FromPtr)) (* Now copy junk to its proper home.)
(SETFILEPTR Stream ToPtr)
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(SETQ EndPtr (GETFILEPTR Stream)) (* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr)) (* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.CopyTitle"))
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream ToPtr)
(RETURN EndPtr))
((NC.YesP (NC.AskUser (CONCAT "Trouble copying title for" ID (CHARACTER 13)
"Want to delete this card? ")
"--"
(QUOTE Yes)
T NIL NIL NIL T))
(OR DontUpdateArrayFlg (NC.MarkIndexEntryFree ID Stream))
(NC.MarkIndexEntryFreeInFile ID Stream)
(RETURN ToPtr))
(T (RETURN NIL))))))
(NC.CopyPropList
(LAMBDA (Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg)
(* rht: " 9-Jul-85 19:26")
(* * Copy a card's PropList from one point in the stream to another.)
(* * rht 7/9/85: Now handles dates if any.)
(PROG (ID EndPtr Length VersionNumber)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (SETQ VersionNumber (NC.GetIdentifier Stream NC.PropsIdentifier))
(PROGN (if (GEQ VersionNumber 1)
then (NC.GetDate Stream))
(EQ ID (READ Stream)))) (* Read prop list.)
(READ Stream) (* Get past the space at the end.)
(READC Stream)
(SETQ EndPtr (GETFILEPTR Stream))
(COPYBYTES Stream TempStream FromPtr EndPtr)
(if (ILESSP (IDIFFERENCE FromPtr ToPtr)
(SETQ Length (IDIFFERENCE EndPtr FromPtr)))
then
(* We're trying to move N bytes to a location less than N bytes away. To be safe, we first move junk to end of
file.)
(SETFILEPTR Stream (SETQ FromPtr (GETEOFPTR Stream)))
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr))
(* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.CopyPropList"))
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream FromPtr)) (* Now copy junk to its proper home.)
(SETFILEPTR Stream ToPtr)
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(SETQ EndPtr (GETFILEPTR Stream)) (* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.GetPtrFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr)) (* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.CopyPropList"))
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream ToPtr)
(RETURN EndPtr))
((NC.YesP (NC.AskUser (CONCAT "Trouble copying prop list for" ID (CHARACTER 13)
"Want to delete this card?")
"--"
(QUOTE Yes)
T NIL NIL NIL T))
(OR DontUpdateArrayFlg (NC.MarkIndexEntryFree ID Stream))
(NC.MarkIndexEntryFreeInFile ID Stream)
(RETURN ToPtr))
(T (RETURN NIL))))))
(NC.CopyLinkLabels
(LAMBDA (Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg)
(* rht: " 9-Jul-85 19:26")
(* * Copy the link labels from one point in the stream to another.)
(* * rht 7/9/85: Now handles dates if any.)
(PROG (ID EndPtr Length VersionNumber)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (SETQ VersionNumber (NC.GetIdentifier Stream NC.LinkLabelsIdentifier))
(PROGN (if (GEQ VersionNumber 1)
then (NC.GetDate Stream))
(EQ ID (READ Stream)))) (* Read the link labels.)
(READ Stream) (* Get past space at end.)
(READC Stream)
(SETQ EndPtr (GETFILEPTR Stream))
(COPYBYTES Stream TempStream FromPtr EndPtr)
(if (ILESSP (IDIFFERENCE FromPtr ToPtr)
(SETQ Length (IDIFFERENCE EndPtr FromPtr)))
then
(* We're trying to move N bytes to a location less than N bytes away. To be safe, we first move junk to end of
file.)
(SETFILEPTR Stream (SETQ FromPtr (GETEOFPTR Stream)))
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr))
(* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.CopyLinkLabels"))
(NC.GetStatus Stream)
(NC.PutPtr Stream FromPtr)) (* Now copy junk to its proper home.)
(SETFILEPTR Stream ToPtr)
(SETFILEPTR TempStream 0)
(COPYBYTES TempStream Stream 0 Length)
(SETQ EndPtr (GETFILEPTR Stream)) (* Update index array.)
(if (NOT DontUpdateArrayFlg)
then (NC.SetIndexOffset Stream (NC.IndexFromID ID))
(NC.GetStatusFromIndex Stream)
(NC.PutPtrToIndex Stream FromPtr)) (* Update index.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.CopyLinkLabels"))
(NC.GetStatus Stream)
(NC.PutPtr Stream ToPtr)
(RETURN EndPtr))
((NC.YesP (NC.AskUser (CONCAT "Trouble copying prop list for" ID (CHARACTER 13)
"Want to delete this card?")
"--"
(QUOTE Yes)
T NIL NIL NIL T))
(OR DontUpdateArrayFlg (NC.MarkIndexEntryFree ID Stream))
(NC.MarkIndexEntryFreeInFile ID Stream)
(RETURN ToPtr))
(T (RETURN NIL))))))
(NC.FastCopyNoteCard
(LAMBDA (ID FromStream ToStream) (* rht: " 9-Jul-85 19:25")
(* * Copy a card from FromStream to ToStream. Call on the type-specific byte-wise copy fns for copying the actual
substances.)
(* * rht 1/31/85: Now writes status to index array rather than file. Note that the index array is associated with
ToStream, not FromStream.)
(* * rht 7/9/85: Now copies dates if any.)
(PROG (PtrList DebugFlg Status NoteCardType MainPtr VersionNumber Date)
(SETQ PtrList (NC.GetPtrsFromIndex FromStream ID))
(SETQ Status (fetch (POINTERLIST STATUS) of PtrList))
(COND
((EQ Status (QUOTE SPECIAL))
(* * Process the link labels special card)
(NC.PutLinkLabels ToStream (NC.GetLinkLabels FromStream)
T))
((NEQ Status (QUOTE ACTIVE))
(* * this is an inactive or deleted card)
(NC.MarkIndexEntryFree ID ToStream)
(AND DebugFlg (PRINT (CONCAT "Not copied: " ID " Status: " Status))))
(T
(* * Active card: copy it to ToStream)
(SETFILEPTR FromStream (fetch (POINTERLIST MAINPTR) of PtrList))
(COND
((AND (SETQ VersionNumber (NC.GetIdentifier FromStream NC.ItemIdentifier))
(PROGN (if (GEQ VersionNumber 1)
then (SETQ Date (NC.GetDate FromStream)))
(EQ ID (READ FromStream))))
(* * Copy the main card data)
(SETFILEPTR ToStream (SETQ MainPtr (GETEOFPTR ToStream)))
(NC.PutIdentifier ToStream NC.ItemIdentifier)
(* Copy the date)
(NC.SetItemDate ID Date)
(NC.PutDate ToStream (NC.FetchItemDate ID))
(PRINT ID ToStream)
(SETQ NoteCardType (READ FromStream))
(READC FromStream)
(PRINT NoteCardType ToStream)
(NC.SetRegion ID (NC.GetRegion ID FromStream))
(NC.PutRegion ID ToStream)
(APPLY* (NC.SubstanceCopyFn NoteCardType)
ID FromStream ToStream)
(NC.SetIndexOffset ToStream (fetch (POINTERLIST INDEXPTR) of PtrList))
(NC.PutStatusToIndex ToStream (QUOTE ACTIVE))
(NC.PutPtrToIndex ToStream MainPtr)
(* * Copy the links)
(NC.GetLinks ID FromStream (fetch (POINTERLIST LINKSPTR) of PtrList))
(NC.PutLinks ID ToStream T)
(* * Copy the title)
(NC.GetTitle ID FromStream (fetch (POINTERLIST TITLEPTR) of PtrList))
(NC.PutTitle ID ToStream T)
(* * Copy the PropList)
(NC.GetPropList ID FromStream (fetch (POINTERLIST PROPSPTR) of PtrList))
(NC.PutPropList ID ToStream T))
(T (NC.MarkIndexEntryFree ID ToStream)
(AND DebugFlg (PRINT (CONCAT "Not copied: " ID " Status: " Status)))))
(NC.DeactivateCard ID T)))
(RETURN ID))))
)
(* * New stuff for NCDATABASE.)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.DataFormatVersionNumber NC.DateStringLength NC.LinkLabelsDate
NC.ClippedIdentifierAtoms)
)
(RPAQQ NC.DataFormatVersionNumber 1)
(RPAQQ NC.DateStringLength 18)
(RPAQQ NC.LinkLabelsDate NIL)
(RPAQ NC.ClippedIdentifierAtoms (for Atom in NC.IdentifierAtoms collect (SUBATOM Atom 1 -3)))
(DEFINEQ
(NC.PutDate
(LAMBDA (Stream Date) (* rht: " 9-Jul-85 18:03")
(* * Write a date string out to Stream.)
(PRINT Date Stream)))
(NC.GetDate
(LAMBDA (Stream) (* rht: " 9-Jul-85 17:47")
(* * Read a date string from Stream. All dates have the same length, so can use that as a check.
I'm allowing null date since we may be compacting an old style (non-dated) notefile. Thus we won't give it a
misleadingly new date.)
(LET ((Date (READ Stream)))
(if (OR (NULL Date)
(EQ (NCHARS Date)
NC.DateStringLength))
then Date
else (NC.ReportError "NC.GetDate" (CONCAT Date " is not a proper date."))
NIL))))
)
(* * Old functions from NCCARDS.)
(DEFINEQ
(NC.DeactivateCard
(LAMBDA (ID DeleteTypeAndTitleFlg) (* rht: " 9-Jul-85 15:58")
(* * Remove all the information from the prop list of the NoteCard ID, except for the title which usually statys
cached.)
(* * rht 7/9/85: Now also removes the new date properties.)
(REMPROP ID (QUOTE NoteCardRegion))
(REMPROP ID (QUOTE NoteCardActive))
(REMPROP ID (QUOTE NoteCardFromLinks))
(REMPROP ID (QUOTE NoteCardToLinks))
(REMPROP ID (QUOTE NoteCardPropList))
(REMPROP ID (QUOTE NoteCardGlobalLinks))
(REMPROP ID (QUOTE NoteCardLinksDirty))
(REMPROP ID (QUOTE SKETCH))
(REMPROP ID (QUOTE NoteCardSketchScale))
(REMPROP ID (QUOTE NoteCardRegionViewed))
(REMPROP ID (QUOTE NoteCardNewCard))
(REMPROP ID (QUOTE NoteCardTitleDirty))
(REMPROP ID (QUOTE NoteCardPropListDirty))
(REMPROP ID (QUOTE NoteCardSubstanceDirty))
(REMPROP ID (QUOTE VALUE))
(REMPROP ID (QUOTE NoteCardItemDate))
(REMPROP ID (QUOTE NoteCardLinksDate))
(REMPROP ID (QUOTE NoteCardTitleDate))
(REMPROP ID (QUOTE NoteCardPropListDate))
(COND
(DeleteTypeAndTitleFlg (REMPROP ID (QUOTE NoteCardTitle))
(REMPROP ID (QUOTE NoteCardType))))
(SET ID)))
)
(* * New stuff for NCCARDS.)
(DEFINEQ
(NC.FetchTitleDate
(LAMBDA (ID) (* rht: " 9-Jul-85 16:00")
(GETPROP ID (QUOTE NoteCardTitleDate))))
(NC.FetchItemDate
(LAMBDA (ID) (* rht: " 9-Jul-85 16:02")
(GETPROP ID (QUOTE NoteCardItemDate))))
(NC.FetchPropListDate
(LAMBDA (ID) (* rht: " 9-Jul-85 16:02")
(GETPROP ID (QUOTE NoteCardPropListDate))))
(NC.FetchLinksDate
(LAMBDA (ID) (* rht: " 9-Jul-85 16:02")
(GETPROP ID (QUOTE NoteCardLinksDate))))
)
(DEFINEQ
(NC.SetTitleDate
(LAMBDA (ID Date) (* rht: " 9-Jul-85 16:05")
(PUTPROP ID (QUOTE NoteCardTitleDate)
Date)))
(NC.SetItemDate
(LAMBDA (ID Date) (* rht: " 9-Jul-85 16:05")
(PUTPROP ID (QUOTE NoteCardItemDate)
Date)))
(NC.SetPropListDate
(LAMBDA (ID Date) (* rht: " 9-Jul-85 16:06")
(PUTPROP ID (QUOTE NoteCardPropListDate)
Date)))
(NC.SetLinksDate
(LAMBDA (ID Date) (* rht: " 9-Jul-85 16:06")
(PUTPROP ID (QUOTE NoteCardLinksDate)
Date)))
)
(* * Old functions from NCINTERFACE)
(DEFINEQ
(NC.ForceDatabaseClose
(LAMBDA (DatabaseStream) (* rht: " 9-Jul-85 18:44")
(* * Really close the database, i.e.. bypass the ADVISE on CLOSEF that prevents closing of the database.)
(* * rht 1/10/85: Note new kludgey call to \UPDATEOF recommended by Tayloe to avoid truncation problems.)
(* * rht 2/5/85: Added resetting of NC.UncachingNotCompleted here so it will happen after compact, repair, etc.)
(* * rht 7/9/85: Added resetting of NC.LinkLabelsDate.)
(\UPDATEOF DatabaseStream)
(SETQ PSA.Database NIL)
(SETQ NC.UncachingNotCompleted NIL)
(SETQ NC.LinkLabelsDate NIL)
(CLOSEF DatabaseStream)))
)
(* * Random fixes.)
(DEFINEQ
(NC.CompactDatabaseInPlace
(LAMBDA (DatabaseName) (* rht: " 9-Jul-85 19:48")
(* * 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.)
(PROG (Stream TempStream OldIndexSize NewIndexSize NextFreeIndex ID TotalCount FullFileName
SortedIndexTuples ToPtr OldLength NumBytesSaved SuccessFlg)
(if (AND PSA.Database (OPENP PSA.Database))
then (NC.PrintMsg NIL T "There is an open NoteFile." (CHARACTER 13)
"The NoteFile must be closed before any other NoteFile can be compacted."
(CHARACTER 13))
(RETURN))
(OR DatabaseName (SETQ DatabaseName (NC.DatabaseFileName
"Name of NoteFile to be compacted in place:"
" -- " T)))
(NC.ClearMsg)
(AND DatabaseName (SETQ Stream (NC.OpenDatabaseFile DatabaseName (QUOTE BOTH)
T NIL T)))
(AND (NULL Stream)
(RETURN))
(SETQ OldLength (GETFILEINFO Stream (QUOTE LENGTH)))
(SETQ FullFileName (FULLNAME Stream)) (* Create a temporary stream on {CORE} with name not
already extant.)
(for i from 1 bind TempFileName unless (FULLNAME (SETQ TempFileName (PACK* (QUOTE
{CORE}NCTEMPFILE)
i)))
do (RETURN (SETQ TempStream (OPENSTREAM TempFileName (QUOTE BOTH)))))
(* Get the current index size and see if needs to be
expanded.)
(SETFILEPTR Stream 2)
(SETQ OldIndexSize (NC.GetPtr Stream 2))
(SETQ NewIndexSize (NC.ComputeNewDatabaseIndexSize Stream))
(* Expand index if needed.)
(if (IGREATERP NewIndexSize OldIndexSize)
then (NC.ExpandIndexInPlace Stream NewIndexSize TempStream))
(* In sorted order, copy entries to lower addresses in
the file.)
(SETQ SortedIndexTuples (NC.SortIndexEntries Stream))
(SETQ ToPtr (LSH (ADD1 NewIndexSize)
4))
(SETQ SuccessFlg (for Tuple in SortedIndexTuples as CTR from 1 to (SETQ TotalCount
(LENGTH
SortedIndexTuples))
bind Result
do (if (ZEROP (IREMAINDER CTR 10))
then (NC.PrintMsg NIL T "Compacting NoteFile." (CHARACTER 13)
"Copying piece " CTR " of " TotalCount "."
(CHARACTER 13)))
(if (SETQ Result (NC.CopyCardPart Tuple Stream TempStream ToPtr))
then (SETQ ToPtr Result)
else (RETURN NIL))
finally (RETURN T)))
(if SuccessFlg
then (* Change all deleted entries to FREE in the index.)
(NC.CleanupIndexEntries Stream) (* Put out the new ChkptPtr to the file.)
(SETFILEPTR Stream 8)
(NC.PutPtr Stream ToPtr)) (* Delete the temporary {CORE} file.)
(DELFILE (CLOSEF TempStream)) (* Truncate file at that point.)
(RETURN (PROG2 (AND SuccessFlg (NC.PrintMsg NIL T "Truncating file " FullFileName " ..."))
(NC.ForceDatabaseClose Stream)
(AND SuccessFlg (if (NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
ToPtr))
then (NC.PrintMsg NIL NIL "Couldn't truncate "
FullFileName "." (CHARACTER 13))
else (NC.PrintMsg NIL T "Done." (CHARACTER 13))))
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM)))
(if SuccessFlg
then (NC.PrintMsg NIL T FullFileName " compacted in place."
(CHARACTER 13)
"Recovered "
(SETQ NumBytesSaved (DIFFERENCE OldLength ToPtr))
" bytes ("
(FIX (TIMES 100 (FQUOTIENT NumBytesSaved ToPtr)))
"%%)"
(CHARACTER 13))
else (NC.PrintMsg NIL T "Compact of " FullFileName " aborted."))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FullFileName)))))))
)
(PUTPROPS RHTPATCH001 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1995 3930 (NC.GetIdentifier 2005 . 3409) (NC.PutIdentifier 3411 . 3928)) (3931 16465 (
NC.GetNoteCard 3941 . 6912) (NC.GetLinkLabels 6914 . 8525) (NC.GetLinks 8527 . 10897) (NC.GetTitle
10899 . 12745) (NC.GetType 12747 . 14559) (NC.GetPropList 14561 . 16463)) (16466 25997 (NC.PutNoteCard
16476 . 18249) (NC.PutLinkLabels 18251 . 19347) (NC.PutLinks 19349 . 21327) (NC.PutTitle 21329 .
22809) (NC.PutPropList 22811 . 24309) (NC.PutMainCardData 24311 . 25995)) (25998 44593 (
NC.CopyMainCardData 26008 . 28572) (NC.CopyLinks 28574 . 31777) (NC.CopyTitle 31779 . 35022) (
NC.CopyPropList 35024 . 38424) (NC.CopyLinkLabels 38426 . 41440) (NC.FastCopyNoteCard 41442 . 44591))
(44991 45820 (NC.PutDate 45001 . 45196) (NC.GetDate 45198 . 45818)) (45861 47323 (NC.DeactivateCard
45871 . 47321)) (47359 48049 (NC.FetchTitleDate 47369 . 47536) (NC.FetchItemDate 47538 . 47703) (
NC.FetchPropListDate 47705 . 47878) (NC.FetchLinksDate 47880 . 48047)) (48050 48776 (NC.SetTitleDate
48060 . 48236) (NC.SetItemDate 48238 . 48412) (NC.SetPropListDate 48414 . 48596) (NC.SetLinksDate
48598 . 48774)) (48820 49581 (NC.ForceDatabaseClose 48830 . 49579)) (49608 54360 (
NC.CompactDatabaseInPlace 49618 . 54358)))))
STOP