(FILECREATED " 5-Nov-85 21:08:26" {QV}<NOTECARDS>RELEASE1.2I>NCDATABASE.;40 137311
changes to: (FNS NC.AbortSession)
previous date: "20-Oct-85 15:45:25" {QV}<NOTECARDS>RELEASE1.2I>NCDATABASE.;39)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCDATABASECOMS)
(RPAQQ NCDATABASECOMS ((E (SETQ NC.SystemDate (DATE))
(PUTPROP (QUOTE NC.SystemDate)
(QUOTE NewestFile)
(ROOTFILENAME (FULLNAME (OUTPUT)))))
(* * Internal variables)
(GLOBALVARS PSA.Database NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier NC.IdentifierAtoms
NC.DatabaseFileNameSuggestion NC.VersionNumber NC.UncachingNotCompleted
NC.DefaultIndexSizeInEntries NC.IndexSizeInEntries NC.UnclassifiedID
NC.LinkLabelsID NC.OrphanID NC.RootID NC.InitialLinkLabels
NC.DataFormatVersionNumber NC.DateStringLength NC.LinkLabelsDate
NC.ClippedIdentifierAtoms NC.MainMenu NC.OrigReadTable
NC.TEditPasswordDividedBy100)
(VARS (NC.VersionNumber 2)
(NC.LinkLabelsIdentifier (QUOTE ###LABELS###))
(NC.LinksIdentifier (QUOTE ###LINKS###))
(NC.ItemIdentifier (QUOTE ###ITEM###))
(NC.TitlesIdentifier (QUOTE ###TITLES###))
(NC.PropsIdentifier (QUOTE ###PROPS###))
(NC.IdentifierAtoms (LIST NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier))
(NC.UncachingNotCompleted NIL)
(NC.DefaultIndexSizeInEntries 2000))
(INITVARS (PSA.Database NIL)
(NC.OrigReadTable (COPYREADTABLE (QUOTE ORIG))))
(* Vars for date stuff.)
(VARS (NC.DataFormatVersionNumber 1)
(NC.DateStringLength 18)
(NC.LinkLabelsDate NIL)
(NC.ClippedIdentifierAtoms (for Atom in NC.IdentifierAtoms collect
(SUBATOM Atom 1 -3))))
(* * The Notecard Database)
(DECLARE: DONTCOPY (RECORDS MONITORLOCK WORD))
(RECORDS POINTERLIST)
(FNS NC.CoerceDatabaseStream NC.CreateDatabaseFile NC.FetchMonitor NC.GetCachedMap
NC.GetGraphSubstance NC.GetIdentifier NC.GetLinks NC.GetLinkLabels NC.GetNewID
NC.GetNoteCard NC.GetPropList NC.GetPtrs NC.GetRegion NC.GetSketchSubstance
NC.GetTextSubstance NC.GetTitle NC.GetTypeAndTitle NC.GetType NC.IndexFromID
NC.InitializeSpecialCards NC.MarkCardDeleted NC.MarkIndexEntryFree NC.OpenDatabaseFile
NC.PutCachedMap NC.PutDeletedIdentifier NC.PutGraphSubstance NC.PutIdentifier
NC.PutLinks NC.PutMainCardData NC.PutLinkLabels NC.PutNoteCard NC.PutPropList
NC.PutRegion NC.MakeDummyRegion NC.PutSketchSubstance NC.PutTextSubstance NC.PutTitle
NC.SetMonitor NC.UpdateRegionData NC.ValidID NC.ClearIDAtoms)
(MACROS NC.PutPtr NC.PutStatus NC.GetPtr NC.GetStatus)
(ADDVARS (HPRINTMACROS (FONTDESCRIPTOR . WRITE.FONTDESCRIPTOR)))
(FNS WRITE.FONTDESCRIPTOR READ.FONTINTODESCRIPTOR)
(* * In core index array stuff)
(FNS NC.GetPtrsFromIndex NC.GetPtrFromIndex NC.GetStatusFromIndex NC.SetIndexOffset
NC.GetIndexOffset NC.PutStatusToIndex NC.PutPtrToIndex NC.BuildIndexArray
NC.IncreaseIndexArray NC.OutOfBoundsIndexPtr)
(* * Checkpointing mechanism stuff)
(FNS NC.CheckForNeededTruncation NC.CheckpointDatabase NC.AbortSession NC.SaveDirtyCards)
(* * Database compactor)
(FNS NC.ComputeNewDatabaseIndexSize NC.FastCopyNoteCard NC.FastCompactDatabase)
(* * In place database compactor.)
(FNS NC.CompactDatabaseInPlace NC.ExpandIndexInPlace NC.SortIndexEntries NC.CopyCardPart
NC.CopyMainCardData NC.CopyLinks NC.CopyTitle NC.CopyPropList NC.CopyLinkLabels
NC.IndexInFileFromID NC.MarkIndexEntryFreeInFile NC.CleanupIndexEntries)
(* * Convert Version0 files to Version1 files -- based on compactor)
(FNS NC.IndexFromIDVersion0 NC.GetNoteCardVersion0 NC.OpenDatabaseFileVersion0
NC.CacheTitlesVersion0 NC.GetTitleVersion0 NC.GetLinkLabelsVersion0
NC.ConvertVersion0ToVersion1 NC.CopyVersion0CardToVersion1Card
NC.GetGraphSubstanceVersion0 NC.GetSketchSubstanceVersion0 NC.CheckForNeededConversion)
(* * Database copier.)
(FNS NC.CopyDatabase)
(* * Functions for handling dates.)
(FNS NC.PutDate NC.GetDate)))
(* * Internal variables)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PSA.Database NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier NC.IdentifierAtoms NC.DatabaseFileNameSuggestion
NC.VersionNumber NC.UncachingNotCompleted NC.DefaultIndexSizeInEntries
NC.IndexSizeInEntries NC.UnclassifiedID NC.LinkLabelsID NC.OrphanID NC.RootID
NC.InitialLinkLabels NC.DataFormatVersionNumber NC.DateStringLength NC.LinkLabelsDate
NC.ClippedIdentifierAtoms NC.MainMenu NC.OrigReadTable NC.TEditPasswordDividedBy100)
)
(RPAQQ NC.VersionNumber 2)
(RPAQQ NC.LinkLabelsIdentifier ###LABELS###)
(RPAQQ NC.LinksIdentifier ###LINKS###)
(RPAQQ NC.ItemIdentifier ###ITEM###)
(RPAQQ NC.TitlesIdentifier ###TITLES###)
(RPAQQ NC.PropsIdentifier ###PROPS###)
(RPAQ NC.IdentifierAtoms (LIST NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier))
(RPAQQ NC.UncachingNotCompleted NIL)
(RPAQQ NC.DefaultIndexSizeInEntries 2000)
(RPAQ? PSA.Database NIL)
(RPAQ? NC.OrigReadTable (COPYREADTABLE (QUOTE ORIG)))
(* Vars for date stuff.)
(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)))
(* * The Notecard Database)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE MONITORLOCK ((NIL FLAG)
(MLOCKPERPROCESS FLAG)
(NIL BITS 6)
(MLOCKQUEUETAIL POINTER)
(MLOCKOWNER POINTER)
(MLOCKNAME POINTER)
(MLOCKLINK POINTER)))
(ACCESSFNS WORD ((HIBYTE (LRSH DATUM 8))
(LOBYTE (LOGAND DATUM 255)))
(CREATE (IPLUS (LLSH HIBYTE 8)
LOBYTE)))
]
(/DECLAREDATATYPE (QUOTE MONITORLOCK)
(QUOTE (FLAG FLAG (BITS 6)
POINTER POINTER POINTER POINTER))
(QUOTE ((MONITORLOCK 0 (FLAGBITS . 0))
(MONITORLOCK 0 (FLAGBITS . 16))
(MONITORLOCK 0 (BITS . 37))
(MONITORLOCK 0 POINTER)
(MONITORLOCK 2 POINTER)
(MONITORLOCK 4 POINTER)
(MONITORLOCK 6 POINTER)))
(QUOTE 8))
)
[DECLARE: EVAL@COMPILE
(RECORD POINTERLIST (STATUS MAINPTR LINKSPTR TITLEPTR PROPSPTR INDEXPTR))
]
(DEFINEQ
(NC.CoerceDatabaseStream
(LAMBDA (DatabaseStream FromFunction) (* NoteCards% User "15-Jun-84 20:26")
(* Coerce argument from name of open file to a stream
if necessary.)
(COND
((STREAMP DatabaseStream)
DatabaseStream)
((OPENP DatabaseStream (QUOTE BOTH))
(GETSTREAM DatabaseStream))
(T (NC.ReportError FromFunction (CONCAT DatabaseStream " not a stream or file."))))))
(NC.CreateDatabaseFile
(LAMBDA (FileName IndexSizeInEntries CallingOperationMsg OmitFinalNoteFlg StartingNextFreeIndex)
(* rht: "21-Sep-85 12:53")
(* * Create a NoteCards database on file FileName. Just creates an index IndexSizeInEntries entries long, then
writes out the Root and Orphan cards)
(* * rht 8/7/84: Added OmitFinalNoteFlg flag parameter to prevent the final message. Changed parameter name from
NC.IndexSizeInEntries to IndexSizeInEntries since the fomer is a global.)
(* * rht 1/30/85: Reserved 3 bytes of the remaining 8 to hold pointer to last checkpointed EOFPTR.)
(* * rht 3/21/85: Added the StartingNextFreeIndex argument which if non-nil, gives a NextID Num to be filled in to
the file before returning. This is useful when compacting.)
(PROG (Stream)
(SETQ CallingOperationMsg (COND
(CallingOperationMsg (CONCAT CallingOperationMsg (CHARACTER 13)))
(T "")))
(COND
((AND PSA.Database (OPENP PSA.Database))
(NC.PrintMsg NIL T "There is already an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before a new one" " can be created." (CHARACTER 13))
(RETURN NIL)))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to be created?"
" -- " T T)))
(RETURN NIL))
(SETQ NC.IndexSizeInEntries (OR (FIXP IndexSizeInEntries)
NC.DefaultIndexSizeInEntries))
(SETQ Stream (GETSTREAM (OPENFILE FileName (QUOTE OUTPUT))))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile " (FULLNAME Stream)
". Please wait... ") (* Fill in the 16 information bytes for the notefile.)
(SETFILEPTR Stream 0) (* 2 bytes for next card ID)
(NC.PutPtr Stream 1 2) (* 2 bytes for index size)
(NC.PutPtr Stream NC.IndexSizeInEntries 2) (* 3 bytes for next link ID)
(NC.PutPtr Stream 1 3) (* 1 byte for notecards version number)
(NC.PutPtr Stream NC.VersionNumber 1) (* 3 bytes for pointer to last EOFPTR)
(NC.PutPtr Stream 1 3) (* 5 bytes for future needs)
(NC.PutPtr Stream -1 5)
(for CTR from 1 to NC.IndexSizeInEntries eachtime (BLOCK)
do (AND (ZEROP (IREMAINDER CTR 1000))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile." (CHARACTER 13)
"Processing item " CTR " out of " NC.IndexSizeInEntries "."
(CHARACTER 13)))
(NC.PutStatus Stream FREE)
(NC.PutPtr Stream -1 3)
(NC.PutPtr Stream -1 3)
(NC.PutPtr Stream -1 3)
(NC.PutPtr Stream -1 3)
(NC.PutPtr Stream -1 3)) (* Reserve the first 20 index entries for special cards
& future expansion)
(SETFILEPTR Stream 0)
(NC.PutPtr Stream 21 2) (* Write the EOFPTR out to the notefile.)
(SETFILEPTR Stream 8)
(NC.PutPtr Stream (GETEOFPTR Stream))
(NC.ForceDatabaseClose Stream)
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile " (FULLNAME Stream)
". Please wait... ")
(NC.InitializeSpecialCards (SETQ Stream (NC.OpenDatabaseFile FileName NIL T T NIL NIL NIL)))
(* Currently the next index is 21 since this is a fresh notefile. But can override if desired.
This is probably only useful when compacting so that new file will be set up properly.)
(NC.CheckpointDatabase Stream T)
(if StartingNextFreeIndex
then (SETFILEPTR Stream 0)
(NC.PutPtr Stream StartingNextFreeIndex 2))
(NC.ForceDatabaseClose Stream)
(NC.SetMonitor Stream NIL)
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME FileName)))
(COND
(OmitFinalNoteFlg (NC.PrintMsg NIL NIL " Done!" (CHARACTER 13)))
(T (NC.PrintMsg NIL NIL " Done!" (CHARACTER 13)
"Note that the NoteFile must still" " be opened before it is used."
(CHARACTER 13)))))))
(NC.FetchMonitor
(LAMBDA (DatabaseStream FromFunction) (* fgh: "31-Oct-84 00:28")
(PROG (MonitorLock)
(SETQ MonitorLock (STREAMPROP DatabaseStream (QUOTE NCDatabaseLock)))
(COND
((type? MONITORLOCK MonitorLock)
(RETURN MonitorLock))
(T (NC.ReportError "NC.FetchMonitor" (CONCAT "Called from " FromFunction
". No monitorlock property on database stream -- "
DatabaseStream)))))))
(NC.GetCachedMap
(LAMBDA (DatabaseStream) (* fgh: "28-Sep-85 22:54")
(* Read a bit map from the file and then put it onto
the cached maps list)
(* * FGH 9/28/85 Updated to handle new map changes. In particular, caching now done on the map resolution and noit
on the x and y offsets.)
(PROG (CacheSpecs BitMap)
(SETQ CacheSpecs (READ DatabaseStream))
(COND
((EQ (LENGTH CacheSpecs)
8)
(* * Old Scheme for cahcing)
(SETQ CacheSpecs (CONS (QUOTE HIGH)
(CDDR CacheSpecs)))))
(SETQ BitMap (HREAD DatabaseStream))
(AND CacheSpecs BitMap (APPLY (FUNCTION SetCachedBitMap)
(CONS BitMap CacheSpecs))))))
(NC.GetGraphSubstance
(LAMBDA (DatabaseStream ID) (* rht: "12-Jun-85 12:51")
(PROG (Graph Anno)
(* * Skip the start/end ptrs)
(NC.GetPtr DatabaseStream 6)
(* * Read the Graph)
(SETQ Graph (HREAD DatabaseStream))
(RETURN Graph))))
(NC.GetIdentifier
(LAMBDA (DatabaseStream Identifier) (* rht: " 3-Oct-85 14:33")
(* 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 NC.OrigReadTable))
(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.GetLinks
(LAMBDA (ID DatabaseStream LinksPtr) (* rht: "17-Jul-85 17:47")
(* * 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))
(NC.CheckLinkRecordFormat ToLinks)
(for Link in ToLinks do (NC.CheckDisplayModeFormat Link))
(SETQ FromLinks (READ Stream))
(NC.CheckLinkRecordFormat FromLinks)
(for Link in FromLinks do (NC.CheckDisplayModeFormat Link))
(SETQ GlobalLinks (LISTP (READ Stream)))
(NC.CheckLinkRecordFormat GlobalLinks)
(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.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.GetNewID
(LAMBDA (DatabaseStream DontUpdateFlg) (* rht: " 1-Feb-85 11:30")
(* * rht 1/9/85: Keep track of the total number of cards in NC.UncachingNotCompleted.)
(* * rht 1/31/85: Increases array size if needed. Also now stores highest ID number in a global var and only writes
to the file at checkpoint time.)
(* * rht 2/1/85: Now warn user if within 90% of index full. Also if index array is full, then increase its size.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(PROG (NextIDNum PercentUsed (Stream (COND
((STREAMP DatabaseStream)
DatabaseStream)
((AND DatabaseStream (OPENP DatabaseStream
(QUOTE BOTH)))
(GETSTREAM DatabaseStream))
(T (NC.ReportError "NC.GetNewID"
(CONCAT DatabaseStream
" not a stream or file.")))))
)
(SETQ NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
(COND
((IGREATERP (SETQ PercentUsed (FIX (TIMES 100 (QUOTIENT (FLOAT NextIDNum)
(FLOAT
NC.IndexSizeInEntries)))))
90)
(NC.PrintMsg NIL T "Index for notefile: " (FULLNAME Stream)
" is " PercentUsed "%% full." (CHARACTER 13)
"Please close notefile soon and compact.")))
(COND
((EQ NextIDNum NC.IndexSizeInEntries)
(NC.ReportError "NC.GetNewID" "Index full.")))
(SETQ NC.UncachingNotCompleted NextIDNum)
(COND
((IGREATERP (ITIMES 5 NextIDNum)
(ARRAYSIZE (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(NC.IncreaseIndexArray Stream)))
(RETURN (PROG1 (MKATOM (CONCAT "NC" (RPLSTRING (CONCAT "00000")
(IMINUS (NCHARS NextIDNum))
NextIDNum)))
(OR DontUpdateFlg (STREAMPROP Stream (QUOTE NCNEXTIDNUM)
(ADD1 NextIDNum)))))))))
(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.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)))))
(NC.GetPtrs
(LAMBDA (ID DatabaseStream) (* fgh: "19-Nov-84 17:40")
(* * Return a list of pointers from the index of card ID)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetPtrs")
(PROG (Index Ptr LinksPtr TitlePtr PropsPtr Status Stream PtrList EofPtr)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetPtrs"))
(SETQ Index (NC.IndexFromID ID "NC.GetPtrs"))
(SETFILEPTR Stream Index)
(SETQ Status (NC.GetStatus Stream))
(SETQ Ptr (NC.GetPtr Stream))
(SETQ LinksPtr (NC.GetPtr Stream))
(SETQ TitlePtr (NC.GetPtr Stream))
(SETQ PropsPtr (NC.GetPtr Stream))
(SETQ PtrList
(create POINTERLIST
STATUS ← Status
MAINPTR ← Ptr
LINKSPTR ← LinksPtr
TITLEPTR ← TitlePtr
PROPSPTR ← PropsPtr
INDEXPTR ← Index))
(SETQ EofPtr (GETEOFPTR DatabaseStream))
(AND (EQ Status (QUOTE ACTIVE))
(for Ptr in (CDR PtrList) when (OR (IGREATERP Ptr EofPtr)
(MINUSP Ptr))
do (replace (POINTERLIST STATUS) of PtrList with (QUOTE BADPOINTER))))
(RETURN PtrList)))))
(NC.GetRegion
(LAMBDA (ID DatabaseStream) (* fgh: "15-Feb-84 18:16")
(CREATEREGION (NC.GetPtr DatabaseStream 2)
(NC.GetPtr DatabaseStream 2)
(NC.GetPtr DatabaseStream 2)
(NC.GetPtr DatabaseStream 2))))
(NC.GetSketchSubstance
(LAMBDA (DatabaseStream ID) (* rht: "12-Jun-85 12:51")
(* Get sketch substance from Database stream. Database stream is positioned. READ the global sketch description, the
locasl sketch scale and region viewed. Also read in any cached bit maps for the MAPS system.)
(PROG (Sketch Scale RegionViewed)
(* * Skip the Start/End ptrs)
(NC.GetPtr DatabaseStream 6)
(* * Get the substance)
(SETQ Sketch (HREAD DatabaseStream))
(SETQ Scale (READ DatabaseStream))
(SETQ RegionViewed (READ DatabaseStream))
(while (EQ (READ DatabaseStream)
(QUOTE ###CACHEDMAP###))
do (NC.GetCachedMap DatabaseStream))
(RETURN (LIST Sketch Scale RegionViewed)))))
(NC.GetTextSubstance
(LAMBDA (DatabaseStream ID) (* fgh: " 8-Oct-85 15:37")
(* Get a text stream from the database file)
(LET ((TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
StartPtr EndPtr StartFormatPtr TempFileEof TextStream)
(SETQ StartPtr (NC.GetPtr DatabaseStream))
(SETQ EndPtr (NC.GetPtr DatabaseStream))
(* * Copy text stream to a NODIRCORE file)
(COPYBYTES DatabaseStream TempStream StartPtr EndPtr)
(* * fix up file absolute pinter to the beginning of the formatting nformation)
(COND
((IGREATERP (SETQ TempFileEof (GETEOFPTR TempStream))
2)
(SETFILEPTR TempStream (IDIFFERENCE TempFileEof 2))
(COND
((EQUAL (IQUOTIENT (\WIN TempStream)
100)
NC.TEditPasswordDividedBy100)
(SETFILEPTR TempStream (IDIFFERENCE TempFileEof 8))
(SETQ StartFormatPtr (\DWIN TempStream))
(SETFILEPTR TempStream (IDIFFERENCE TempFileEof 8))
(\DWOUT TempStream (IDIFFERENCE StartFormatPtr StartPtr))))))
(* * return an open textstream on the temp file)
(SETQ TextStream (OPENTEXTSTREAM TempStream NIL NIL NIL (NC.MakeTEditPropsList)))
(STREAMPROP TextStream (QUOTE NoteCardID)
ID)
TextStream)))
(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.GetTypeAndTitle
(LAMBDA (ID DatabaseStream NoReportFlg) (* rht: "31-Jan-85 18:59")
(* Retrieve the type and 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.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetTitle")
(PROG (PtrList Ptr TitlePtr Status Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetTitle"))
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(SETQ Ptr (CADR PtrList))
(SETQ TitlePtr (CADDDR PtrList))
(COND
((NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(T (RETURN (CONS (NC.GetType ID Stream Ptr)
(NC.GetTitle ID Stream TitlePtr NoReportFlg)))))))))
(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.IndexFromID
(LAMBDA (ID FromFunction) (* rht: "30-Jan-85 17:45")
(* * rht 1/30/85: Now returns offset into the index array.)
(COND
((NC.IDP ID)
(ITIMES (SUB1 (SUBATOM ID 3))
5))
(T (NC.ReportError FromFunction (CONCAT ID ": Invalid ID"))))))
(NC.InitializeSpecialCards
(LAMBDA (DatabaseStream) (* rht: " 5-Feb-85 21:22")
(* Create and put the initial versions of Root, Orphan, and Unclassified cards onto database specified by
DatabaseStream. Also initialize the List of link labels)
(PROG ((Root NC.RootID)
(Orphan NC.OrphanID)
(Unclassified NC.UnclassifiedID)
(LinkLabels NC.LinkLabelsID)) (* Root card)
(NC.MakeNoteCard (QUOTE FileBox)
"Table of Contents" T NIL Root)
(NC.SetPropList Root NIL)
(NC.PutNoteCard Root DatabaseStream)
(NC.PutTitle Root DatabaseStream)
(NC.PutPropList Root DatabaseStream)
(NC.PutLinks Root DatabaseStream)
(NC.DeactivateCard Root) (* Orphan card)
(NC.MakeNoteCard (QUOTE FileBox)
"Orphans" T NIL Orphan)
(NC.SetPropList Orphan NIL)
(NC.PutNoteCard Orphan DatabaseStream)
(NC.PutTitle Orphan DatabaseStream)
(NC.PutPropList Orphan DatabaseStream)
(NC.PutLinks Orphan DatabaseStream)
(NC.DeactivateCard Orphan) (* Unclassified Card)
(NC.MakeNoteCard (QUOTE FileBox)
"To Be Filed" T NIL Unclassified)
(NC.SetPropList Unclassified NIL)
(NC.PutNoteCard Unclassified DatabaseStream)
(NC.PutTitle Unclassified DatabaseStream)
(NC.PutPropList Unclassified DatabaseStream)
(NC.PutLinks Unclassified DatabaseStream)
(NC.DeactivateCard Unclassified) (* Link Labels)
(NC.PutLinkLabels DatabaseStream NC.InitialLinkLabels)
(RETURN DatabaseStream))))
(NC.MarkCardDeleted
(LAMBDA (ID DatabaseStream) (* rht: "13-Feb-85 15:56")
(* * rht 1/30/85: Removed the NC.PutDeletedIdentifier call.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.MarkCardDeleted")
(PROG (Index Ptr LinksPtr Status ActualID Stream PtrList)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.MarkCardDeleted"))
(SETQ Index (NC.IndexFromID ID))
(NC.SetIndexOffset Stream Index)
(NC.PutStatusToIndex Stream (QUOTE DELETED))
(RETURN ID)))))
(NC.MarkIndexEntryFree
(LAMBDA (ID DatabaseStream) (* rht: "31-Jan-85 14:31")
(* * rht 1/30/85: Now writes to index array rather than to file.)
(NC.SetIndexOffset DatabaseStream (NC.IndexFromID ID))
(NC.PutStatusToIndex DatabaseStream (QUOTE FREE))
(NC.PutPtrToIndex DatabaseStream -1)
(NC.PutPtrToIndex DatabaseStream -1)
(NC.PutPtrToIndex DatabaseStream -1)
(NC.PutPtrToIndex DatabaseStream -1)))
(NC.OpenDatabaseFile
(LAMBDA (FileName Access NoSetFlg QuietFlg Don'tCreateFlg Convertw/oConfirmFlg Don'tCreateArrayFlg
Don'tTruncateFlg) (* rht: " 4-Oct-85 00:09")
(* Open an already existing database file.)
(* * rht 8/7/84: For nonexistent files, asks user whether to create unless Don'tCreateFlg is non-nil.)
(* * rht 1/9/85: Checks NC.UncachingNotCompleted global var. If non-nil, then previous notefile died unnaturally, so
we first clear junk off the IDs.)
(* * rht 8/6/85: Added Don'tTruncateFlg, which, if on, prevents the check for truncation.)
(PROG (Name Stream NewStream ID CardTotal)
(OR Access (SETQ Access (QUOTE BOTH)))
(COND
((AND PSA.Database (OPENP PSA.Database))
(NC.PrintMsg NIL T "There is already an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before a new one" " can be opened." (CHARACTER 13))
(RETURN NIL)))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T)))
(RETURN NIL))
(COND
((OPENP FileName)
(NC.PrintMsg NIL T FileName " is an already open file." (CHARACTER 13))
(RETURN)))
(AND (NOT (SETQ Name (INFILEP FileName)))
(COND
(Don'tCreateFlg (NC.PrintMsg NIL T "Couldn't find NoteFile " FileName "."
(CHARACTER 13))
(RETURN NIL))
((NC.YesP (NC.AskUser (CONCAT "Unable to find NoteFile " FileName "." (CHARACTER
13)
"Want to create new NoteFile by that name? ")
" -- " "Yes" T NIL T NIL T))
(NC.CreateDatabaseFile FileName NIL "Opening NoteFile" T)
(AND (NOT (SETQ Name (INFILEP FileName)))
(NC.PrintMsg NIL T "Still unable to find Notefile " FileName "."
(CHARACTER 13))
(RETURN NIL)))
(T (RETURN NIL))))
(COND
(NC.UncachingNotCompleted (NC.ClearIDAtoms NC.UncachingNotCompleted)))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opening ... " (CHARACTER 13)))
(SETQ Stream (OPENSTREAM Name Access (QUOTE OLD)))
(NC.SetMonitor Stream (CREATE.MONITORLOCK (MKATOM (CONCAT Name ":LOCK"))))
(SETFILEPTR Stream 0)
(STREAMPROP Stream (QUOTE NCNEXTIDNUM)
(NC.GetPtr Stream 2))
(COND
((NULL (SETQ NewStream (NC.CheckForNeededConversion Stream Access Convertw/oConfirmFlg)))
(CLOSEF Stream)
(RETURN NIL))
(T (NC.SetMonitor NewStream (NC.FetchMonitor Stream))
(SETQ Stream NewStream)))
(if (AND (NULL Don'tTruncateFlg)
(SETQ NewStream (NC.CheckForNeededTruncation Stream Access)))
then (* Can either bail out entirely or run inspector and
then bail out.)
(SELECTQ NewStream
(ABORT (CLOSEF Stream)
(RETURN NIL))
(ABORTANDINSPECT (CLOSEF Stream)
(NC.ScavengerPhase1 Name)
(RETURN NIL))
NIL))
(COND
(NewStream (NC.SetMonitor NewStream (NC.FetchMonitor Stream))
(SETQ Stream NewStream)))
(SETFILEPTR Stream 0)
(STREAMPROP Stream (QUOTE NCNEXTIDNUM)
(NC.GetPtr Stream 2))
(SETTOPVAL (QUOTE NC.IndexSizeInEntries)
(NC.GetPtr Stream 2))
(STREAMPROP Stream (QUOTE NCNEXTLINKID)
(NC.GetPtr Stream))
(OR Don'tCreateArrayFlg (NC.BuildIndexArray Stream))
(COND
((NULL NoSetFlg)
(SETQ PSA.Database Stream) (* Cache all of the titles in this database)
(NC.CacheTypesAndTitles PSA.Database NIL QuietFlg "Opening NoteFile.")
(NC.SetMainMenuTitle Stream)))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opened " (FULLNAME Stream)
(CHARACTER 13)))
(RETURN Stream))))
(NC.PutCachedMap
(LAMBDA (MapScreenElt DatabaseStream) (* rht: "22-May-85 01:32")
(* Put a cached bit map corresponding to MapScreenElt
onto database file)
(PROG (CacheSpecs BitMap)
(AND (EQ (fetch (SCREENELT GTYPE) of MapScreenElt)
(QUOTE MAP))
(LISTP (SETQ CacheSpecs (fetch (LOCALMAP MAPLOCALCACHESPECS)
of (fetch (SCREENELT LOCALPART) of MapScreenElt))))
(for CacheSpec in CacheSpecs
do (BITMAPP (SETQ BitMap (APPLY (FUNCTION FetchCachedBitMap)
CacheSpec)))
(PRINT (QUOTE ###CACHEDMAP###)
DatabaseStream)
(PRINT CacheSpec DatabaseStream)
(HPRINT BitMap DatabaseStream T T))))))
(NC.PutDeletedIdentifier
(LAMBDA (DatabaseStream) (* fgh: "26-Feb-84 01:44")
(PRINT (QUOTE ##DELETE##)
DatabaseStream)))
(NC.PutGraphSubstance
(LAMBDA (ID DatabaseStream) (* rht: "11-Mar-85 12:54")
(* Put Graph in card ID onto DatabaseStream)
(PROG ((Graph (NC.FetchSubstance ID))
EndPtr EndPtrLoc StartPtr) (* Clean up BITMAPS in Graph data structure)
(SETQ StartPtr (IPLUS (GETFILEPTR DatabaseStream)
6))
(NC.PutPtr DatabaseStream StartPtr)
(SETQ EndPtrLoc (GETFILEPTR DatabaseStream))
(NC.PutPtr DatabaseStream 0)
(for GraphNode in (fetch GRAPHNODES of Graph) do (replace (GRAPHNODE NODELABELBITMAP)
of GraphNode with NIL))
(* Write data stucture)
(HPRINT Graph DatabaseStream)
(SETQ EndPtr (GETFILEPTR DatabaseStream))
(SETFILEPTR DatabaseStream EndPtrLoc)
(NC.PutPtr DatabaseStream EndPtr))))
(NC.PutIdentifier
(LAMBDA (DatabaseStream Identifier) (* rht: " 3-Oct-85 14:34")
(* 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.OrigReadTable)
(NC.PutPtr DatabaseStream NC.DataFormatVersionNumber 1)))
(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.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))))
(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.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.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.PutRegion
(LAMBDA (ID DatabaseStream) (* rht: " 4-Oct-85 01:35")
(* * rht 10/3/85: Now checks first for a saved region (probably there because card got moved off screen).)
(LET ((Window (NC.FetchWindow ID))
Region)
(SETQ Region (OR (NC.FetchSavedRegion ID)
(AND Window (WINDOWPROP Window (QUOTE REGION)))
(NC.FetchRegion ID)
(NC.MakeDummyRegion ID)))
(AND (NC.ActiveCardP ID)
(NC.SetRegion ID Region))
(NC.PutPtr DatabaseStream (fetch LEFT of Region)
2)
(NC.PutPtr DatabaseStream (fetch BOTTOM of Region)
2)
(NC.PutPtr DatabaseStream (fetch WIDTH of Region)
2)
(NC.PutPtr DatabaseStream (fetch HEIGHT of Region)
2))))
(NC.MakeDummyRegion
(LAMBDA (ID) (* fgh: " 5-Feb-85 19:12")
(* * Returns a region based at (0 0) with default width and height according to Type.)
(CREATEREGION 0 0 (NC.DefaultCardWidth ID)
(NC.DefaultCardHeight ID))))
(NC.PutSketchSubstance
(LAMBDA (ID DatabaseStream) (* rht: "22-Aug-85 20:27")
(* Put the sketch substance for card ID to the database. Store the global sketch descriptor, the scale and region
viewed for ID and any cached bit maps.)
(PROG ((Substance (NC.FetchSubstance ID))
(Window (NC.FetchWindow ID))
SketchSpecs EndPtr EndPtrLoc StartPtr)
(SETQ StartPtr (IPLUS (GETFILEPTR DatabaseStream)
6))
(NC.PutPtr DatabaseStream StartPtr)
(SETQ EndPtrLoc (GETFILEPTR DatabaseStream))
(NC.PutPtr DatabaseStream 0)
(HPRINT Substance DatabaseStream NIL T)
(PRINT (OR (AND Window (SCALE.FROM.SKW Window))
(NC.FetchScale ID))
DatabaseStream)
(PRINT (OR (AND Window (SK.REGION.VIEWED Window))
(NC.FetchRegionViewed ID))
DatabaseStream)
(COND
((AND Window (SETQ SketchSpecs (LOCALSPECS.FROM.VIEWER Window)))
(MAPSKETCHSPECS SketchSpecs (FUNCTION NC.PutCachedMap)
DatabaseStream)))
(PRINT (QUOTE ###ENDSKETCH###)
DatabaseStream)
(SETQ EndPtr (GETFILEPTR DatabaseStream))
(SETFILEPTR DatabaseStream EndPtrLoc)
(NC.PutPtr DatabaseStream EndPtr))))
(NC.PutTextSubstance
(LAMBDA (ID DatabaseStream) (* rht: "13-Sep-85 14:44")
(* Put text substance from card ID on the database
file)
(* * rht 9/13/85: Now doesn't try to write piece table at all if substance has zero length.)
(LET ((Substance (NC.FetchSubstance ID))
EndPtr EndPtrLoc StartPtr)
(SETQ StartPtr (IPLUS (GETFILEPTR DatabaseStream)
6))
(NC.PutPtr DatabaseStream StartPtr)
(SETQ EndPtrLoc (GETFILEPTR DatabaseStream))
(NC.PutPtr DatabaseStream 0)
(if (NOT (ZEROP (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ Substance))))
then (TEDIT.PUT.PCTB (TEXTOBJ Substance)
DatabaseStream))
(SETQ EndPtr (GETFILEPTR DatabaseStream))
(SETFILEPTR DatabaseStream EndPtrLoc)
(NC.PutPtr DatabaseStream EndPtr))))
(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.SetMonitor
(LAMBDA (DatabaseStream MonitorLock) (* fgh: "31-Oct-84 00:28")
(STREAMPROP DatabaseStream (QUOTE NCDatabaseLock)
MonitorLock)))
(NC.UpdateRegionData
(LAMBDA (ID DatabaseStream) (* rht: "24-Jul-85 19:00")
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.UpdateRegionData")
(PROG (Index Ptr Status ActualID NoteCardType Title PropList Region Stream
VersionNumber)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.UpdateRegionData"))
(SETQ PtrList (NC.GetPtrsFromIndex Stream ID))
(SETQ Status (CAR PtrList))
(SETQ Ptr (CADR PtrList))
(COND
((NEQ Status (QUOTE ACTIVE))
(NC.ReportError "NC.UpdateRegionData" (CONCAT ID
" not an active note card on "
(FULLNAME DatabaseStream))))
(T (SETFILEPTR Stream Ptr)
(COND
((NOT (SETQ VersionNumber (NC.GetIdentifier Stream NC.ItemIdentifier)))
(NC.ReportError "NC.UpdateRegionData" (CONCAT ID
"Error in database file -- incorrect item identifier"))))
(if (GEQ VersionNumber 1)
then (NC.GetDate Stream))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.UpdateRegionData" (CONCAT
"ID mismatch: Expected ID: "
ID " Found ID: "
ActualID))))
(SETQ NoteCardType (READ Stream))
(READC Stream)
(NC.PutRegion ID Stream)
(RETURN ID)))))))
(NC.ValidID
(LAMBDA (ID) (* rht: "31-Jan-85 19:00")
(* * Is ID a currently extant card or box?)
(* * rht 1/31/85: Now reads status from index array rather than file.)
(AND (NC.IDP ID)
(OR (EQ (QUOTE ACTIVE)
(fetch (POINTERLIST STATUS) of (NC.GetPtrsFromIndex PSA.Database ID)))
(NC.FetchNewCardFlg ID)))))
(NC.ClearIDAtoms
(LAMBDA (NumIDs) (* rht: "27-Jul-85 23:02")
(* * Clear the junk off the given number of IDs.)
(for i from 1 to NumIDs bind ID
do (BLOCK)
(AND (ZEROP (IREMAINDER i 10))
(NC.PrintMsg NIL T "Cleaning up after previous notefile ..." (CHARACTER 13)
"Clearing item number " i " out of " NumIDs "." (CHARACTER 13)))
(if (NC.ActiveCardP (SETQ ID (NC.IDFromNumber i)))
then (SET ID NIL)
(SETPROPLIST ID NIL)))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS NC.PutPtr MACRO (X (CONS (QUOTE PROGN)
(for I from (COND
((CADDR X)
(SUB1 (CADDR X)))
(T 2))
to 0 by -1
collect (LIST (QUOTE BOUT)
(CAR X)
(LIST (QUOTE LOGAND)
255
(COND
((ZEROP I)
(CADR X))
(T (LIST (QUOTE RSH)
(CADR X)
(ITIMES 8 I))))))))))
(PUTPROPS NC.PutStatus MACRO (X (LIST (QUOTE BOUT)
(CAR X)
(SELECTQ (CADR X)
((A ACTIVE)
(CONSTANT (CHARCODE A)))
((D DELETED)
(CONSTANT (CHARCODE D)))
((F FREE)
(CONSTANT (CHARCODE F)))
((S SPECIAL)
(CONSTANT (CHARCODE S)))
(NILL)))))
(PUTPROPS NC.GetPtr MACRO (X (CONS (QUOTE IPLUS)
(for I from (COND
((CADR X)
(SUB1 (CADR X)))
(T 2))
to 0 by -1 collect (COND
((ZEROP I)
(LIST (QUOTE BIN)
(CAR X)))
(T (LIST (QUOTE LLSH)
(LIST (QUOTE BIN)
(CAR X))
(ITIMES 8 I))))))))
(PUTPROPS NC.GetStatus MACRO (X (LIST (QUOTE SELCHARQ)
(LIST (QUOTE BIN)
(CAR X))
(QUOTE (A (QUOTE ACTIVE)))
(QUOTE (F (QUOTE FREE)))
(QUOTE (D (QUOTE DELETED)))
(QUOTE (S (QUOTE SPECIAL)))
(QUOTE NIL))))
)
(ADDTOVAR HPRINTMACROS (FONTDESCRIPTOR . WRITE.FONTDESCRIPTOR))
(DEFINEQ
(WRITE.FONTDESCRIPTOR
(LAMBDA (FONTDESCRIPTOR OUTFILE) (* rrb " 4-OCT-83 19:12")
(* writes out the name of a font instead of the
descriptor.)
(* only works for TEXTSTREAMS)
(PRIN1 (QUOTE (READ.FONTINTODESCRIPTOR))
OUTFILE)
(printout OUTFILE "(" (FONTPROP FONTDESCRIPTOR (QUOTE FAMILY))
,
(FONTPROP FONTDESCRIPTOR (QUOTE SIZE))
,
(FONTPROP FONTDESCRIPTOR (QUOTE FACE))
,
(FONTPROP FONTDESCRIPTOR (QUOTE ROTATION))
,
(FONTPROP FONTDESCRIPTOR (QUOTE DEVICE))
")" T)
T))
(READ.FONTINTODESCRIPTOR
(LAMBDA (FILE) (* rrb " 4-OCT-83 19:06")
(* reads a text stream from the file that was written
by WRITE.TEXTSTREAM which is an HPRINT macro.)
(APPLY* (FUNCTION FONTCREATE)
(READ FILE))))
)
(* * In core index array stuff)
(DEFINEQ
(NC.GetPtrsFromIndex
(LAMBDA (Stream ID) (* rht: " 4-Feb-85 01:26")
(* * A version of NC.GetPtrs that gets the pointers from the index array instead of the file.)
(PROG (Index Ptr LinksPtr TitlePtr PropsPtr Status PtrList EofPtr)
(SETQ Index (NC.IndexFromID ID "NC.GetPtrs"))
(NC.SetIndexOffset Stream Index)
(SETQ Status (NC.GetStatusFromIndex Stream))
(SETQ Ptr (NC.GetPtrFromIndex Stream))
(SETQ LinksPtr (NC.GetPtrFromIndex Stream))
(SETQ TitlePtr (NC.GetPtrFromIndex Stream))
(SETQ PropsPtr (NC.GetPtrFromIndex Stream))
(SETQ PtrList
(create POINTERLIST
STATUS ← Status
MAINPTR ← Ptr
LINKSPTR ← LinksPtr
TITLEPTR ← TitlePtr
PROPSPTR ← PropsPtr
INDEXPTR ← Index))
(SETQ EofPtr (GETEOFPTR Stream))
(AND (EQ Status (QUOTE ACTIVE))
(for Ptr in (CDR PtrList) when (OR (IGREATERP Ptr EofPtr)
(MINUSP Ptr))
do (replace (POINTERLIST STATUS) of PtrList with (QUOTE BADPOINTER))))
(RETURN PtrList))))
(NC.GetPtrFromIndex
(LAMBDA (Stream) (* rht: "31-Jan-85 19:09")
(* * Read a value from the current spot in index array and increment counter. The array and its offset are found on
stream's props.)
(PROG ((Offset (STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET))))
(RETURN (PROG1 (ELT (STREAMPROP Stream (QUOTE NCINDEXARRAY))
Offset)
(STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET)
(ADD1 Offset)))))))
(NC.GetStatusFromIndex
(LAMBDA (Stream) (* rht: "31-Jan-85 19:09")
(* * Read status from the current spot in the index array.)
(SELCHARQ (NC.GetPtrFromIndex Stream)
(A (QUOTE ACTIVE))
(F (QUOTE FREE))
(D (QUOTE DELETED))
(S (QUOTE SPECIAL))
NIL)))
(NC.SetIndexOffset
(LAMBDA (Stream Num) (* rht: "31-Jan-85 19:10")
(* * Sets the current offset into the index array.)
(STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET)
Num)))
(NC.GetIndexOffset
(LAMBDA (Stream) (* rht: "27-Feb-85 16:42")
(* * Return the current index array offset for the given stream.)
(STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET))))
(NC.PutStatusToIndex
(LAMBDA (Stream Status) (* rht: "31-Jan-85 19:10")
(* * Write the status at the current spot in the index array.)
(NC.PutPtrToIndex Stream (SELECTQ Status
((A ACTIVE)
(CONSTANT (CHARCODE A)))
((D DELETED)
(CONSTANT (CHARCODE D)))
((F FREE)
(CONSTANT (CHARCODE F)))
((S SPECIAL)
(CONSTANT (CHARCODE S)))
(NILL)))))
(NC.PutPtrToIndex
(LAMBDA (Stream Ptr) (* rht: "11-Jun-85 11:14")
(* * Write this pointer value at the current spot in the index array.)
(PROG ((Offset (STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET))))
(SETA (STREAMPROP Stream (QUOTE NCINDEXARRAY))
Offset
(OR Ptr 0))
(STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET)
(ADD1 Offset))
(RETURN Ptr))))
(NC.BuildIndexArray
(LAMBDA (Stream) (* rht: "27-Jul-85 23:03")
(* * Build the index array by copying from the index on the file.)
(PROG ((NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
BadGuysList
(EofPtr (GETEOFPTR Stream))
(IndexPtr (TIMES (ADD1 NC.IndexSizeInEntries)
16)))
(STREAMPROP Stream (QUOTE NCINDEXARRAY)
(ARRAY (ITIMES 5 (IMAX NC.DefaultIndexSizeInEntries (FIX (TIMES 1.5 NextIDNum)))
)
(QUOTE FIXP)
NIL 0)) (* Copy entries from index on file to index array.)
(SETFILEPTR Stream 16)
(NC.SetIndexOffset Stream 0)
(COND
((GREATERP NextIDNum 1)
(for Index from 1 to (SUB1 NextIDNum) bind ReasonsList ActiveCardFlg
do (BLOCK)
(SETQ ReasonsList NIL)
(if (NULL (NC.PutStatusToIndex Stream (NC.GetStatus Stream)))
then (push ReasonsList (QUOTE BADSTATUS)))
(NC.SetIndexOffset Stream (SUB1 (NC.GetIndexOffset Stream)))
(SETQ ActiveCardFlg (EQ (NC.GetStatusFromIndex Stream)
(QUOTE ACTIVE)))
(if (NC.OutOfBoundsIndexPtr Stream (NC.PutPtrToIndex Stream (NC.GetPtr Stream))
EofPtr IndexPtr)
then (AND ActiveCardFlg (push ReasonsList (QUOTE BADITEMPTR))))
(if (NC.OutOfBoundsIndexPtr Stream (NC.PutPtrToIndex Stream (NC.GetPtr Stream))
EofPtr IndexPtr)
then (AND ActiveCardFlg (push ReasonsList (QUOTE BADLINKSPTR))))
(if (NC.OutOfBoundsIndexPtr Stream (NC.PutPtrToIndex Stream (NC.GetPtr Stream))
EofPtr IndexPtr)
then (AND ActiveCardFlg (push ReasonsList (QUOTE BADTITLEPTR))))
(if (NC.OutOfBoundsIndexPtr Stream (NC.PutPtrToIndex Stream (NC.GetPtr Stream))
EofPtr IndexPtr)
then (AND ActiveCardFlg (push ReasonsList (QUOTE BADPROPLISTPTR))))
(AND ReasonsList (push BadGuysList (CONS (NC.IDFromNumber Index)
(DREVERSE ReasonsList))))
(NC.GetPtr Stream))
(STREAMPROP Stream (QUOTE NCBADCARDS)
BadGuysList))))))
(NC.IncreaseIndexArray
(LAMBDA (Stream) (* rht: " 1-Feb-85 11:29")
(* * Make a new array half again as big and copy the contents from the old one. But don't make the new array any
bigger than the current index size.)
(PROG ((Array (STREAMPROP Stream (QUOTE NCINDEXARRAY)))
OldSize NewArray)
(SETQ OldSize (ARRAYSIZE Array))
(SETQ NewArray (ARRAY (IMIN NC.IndexSizeInEntries (FIX (TIMES 1.5 OldSize)))
(QUOTE FIXP)
NIL 0))
(for i from 0 to OldSize do (SETA NewArray i (ELT Array i)))
(STREAMPROP Stream (QUOTE NCINDEXARRAY)
NewArray))))
(NC.OutOfBoundsIndexPtr
(LAMBDA (Stream Ptr EofPtr IndexPtr) (* rht: " 9-Jun-85 23:50")
(* * Make sure that Ptr is between the end of the index and the end of the file.)
(OR EofPtr (SETQ EofPtr (GETEOFPTR Stream)))
(OR IndexPtr (SETQ IndexPtr (TIMES (ADD1 NC.IndexSizeInEntries)
16)))
(OR (LESSP Ptr IndexPtr)
(GEQ Ptr EofPtr))))
)
(* * Checkpointing mechanism stuff)
(DEFINEQ
(NC.CheckForNeededTruncation
(LAMBDA (DatabaseStream Access) (* rht: "20-Sep-85 00:26")
(* * See if there was a crash or aborted close last time. That is, has the notefile got junk beyond the last
checkpoint EOFPTR? If so, ask if user wants to save the extra junk in a file. In any case, truncate at the old
point. If the version number is less than 2, change to a version 2 file and write the the new checkpoint pointer.)
(* * rht 9/20/85: Now allows user to enter inspector rather than truncating -
uses a pop up menu.)
(PROG (FullFileName Version LastChkptPtr EndPtr SaveFile SaveStream Ptr Menu)
(SETFILEPTR DatabaseStream 7)
(SETQ Version (NC.GetPtr DatabaseStream 1))
(COND
((LESSP Version 2) (* Pronounce this a version 2 file and write the new
lastchkptr value.)
(SETFILEPTR DatabaseStream 7)
(NC.PutPtr DatabaseStream 2 1)
(SETFILEPTR DatabaseStream 8)
(SETQ Ptr (GETEOFPTR DatabaseStream))
(NC.PutPtr DatabaseStream Ptr)
(RETURN NIL)))
(SETFILEPTR DatabaseStream 8)
(SETQ LastChkptPtr (NC.GetPtr DatabaseStream))
(SETQ EndPtr (GETEOFPTR DatabaseStream))
(SETQ FullFileName (FULLNAME DatabaseStream))
(COND
((LESSP LastChkptPtr EndPtr)
(NC.PrintMsg NIL T "Last " (IDIFFERENCE EndPtr LastChkptPtr)
" bytes of "
(FULLNAME DatabaseStream)
" were written since last checkpoint or successful close."
(CHARACTER 13))
(SETQ Menu (create MENU
ITEMS ←(QUOTE ((Abort (QUOTE Abort)
"Abort this open notefile altogether.")
(Inspect% &% Repair (QUOTE Inspect% &% Repair)
"Run the Inspect&Repair facility to integrate extra work since checkpoint.")
(Truncate% File (QUOTE Truncate% File)
"Truncate the file, either throwing away or saving changes since last checkpoint.")))
MENUOUTLINESIZE ← 2
MENUFONT ←(FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD))))
(SELECTQ (MENU Menu (create POSITION
XCOORD ←(fetch (POSITION XCOORD) of (SETQ PromptWinPos
(WINDOWPOSITION
PROMPTWINDOW)))
YCOORD ←(DIFFERENCE (fetch (POSITION YCOORD) of
PromptWinPos)
(fetch (MENU IMAGEHEIGHT) of Menu))))
(Abort (RETURN (QUOTE ABORT)))
(Inspect% &% Repair (RETURN (QUOTE ABORTANDINSPECT)))
NIL)
(COND
((NC.YesP (NC.AskUser "Want to save info beyond checkpoint to a file? " "--" "Yes"
NIL NIL NIL T T))
(COND
((AND (SETQ SaveFile (NC.AskUser (CONCAT (CHARACTER 13)
"File to save info in: ")
NIL NIL NIL NIL T))
(SETQ SaveStream (OPENSTREAM SaveFile (QUOTE OUTPUT))))
(NC.PrintMsg NIL T "Saving extra info to " SaveFile " ...")
(COPYBYTES DatabaseStream SaveStream LastChkptPtr EndPtr)
(CLOSEF SaveStream)
(NC.PrintMsg NIL NIL "Done." (CHARACTER 13)))
(T (NC.PrintMsg NIL T "Can't open " SaveFile "." (CHARACTER 13)
"Open aborted."
(CHARACTER 13))
(RETURN (QUOTE ABORT))))))
(COND
((NC.YesP (NC.AskUser (CONCAT (CHARACTER 13)
"Are you sure you want to truncate " FullFileName "? ")
"--" "No" NIL NIL NIL T T))
(NC.PrintMsg NIL T "Truncating file " FullFileName " ...")
(CLOSEF DatabaseStream)
(COND
((NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg NIL NIL "Couldn't truncate " FullFileName "." (CHARACTER 13)
"Open aborted."
(CHARACTER 13))
(RETURN (QUOTE ABORT))))
(NC.PrintMsg NIL T "Done." (CHARACTER 13))
(RETURN (OPENSTREAM FullFileName Access)))
(T (NC.PrintMsg NIL NIL (CHARACTER 13)
"Open aborted."
(CHARACTER 13))
(RETURN (QUOTE ABORT)))))))))
(NC.CheckpointDatabase
(LAMBDA (Stream QuietFlg) (* rht: "21-Sep-85 12:49")
(* * First save to the database any cards currently dirty. Copy the index array back into the file and set the
LastChkptPtr to the end of the file.)
(PROG (Ptr OperationMsg CardTotal)
(OR Stream (SETQ Stream PSA.Database))
(SETQ OperationMsg (CONCAT "Checkpointing notefile " (FILENAMEFIELD (FULLNAME Stream)
(QUOTE NAME))
(CHARACTER 13)))
(COND
((OR (NULL Stream)
(NOT (OPENP Stream)))
(NC.PrintMsg NIL T "There is no open NoteFile!!!" (CHARACTER 13)))
(T (OR QuietFlg (NC.PrintMsg NIL T "Checkpointing current notefile " (FULLNAME Stream)
" ..."))
(NC.SaveDirtyCards Stream)
(SETFILEPTR Stream 16)
(NC.SetIndexOffset Stream 0)
(for Num from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID Stream T)
3)))
bind Ptr eachtime (BLOCK)
do (OR QuietFlg (AND (ZEROP (IREMAINDER Num 10))
(NC.PrintMsg NIL T OperationMsg "Processing item number " Num
" out of "
CardTotal "." (CHARACTER 13))))
(* Put out the 1 byte status and 4 pointers.)
(SETQ Ptr (NC.GetPtrFromIndex Stream))
(NC.PutPtr Stream Ptr 1)
(SETQ Ptr (NC.GetPtrFromIndex Stream))
(NC.PutPtr Stream Ptr)
(SETQ Ptr (NC.GetPtrFromIndex Stream))
(NC.PutPtr Stream Ptr)
(SETQ Ptr (NC.GetPtrFromIndex Stream))
(NC.PutPtr Stream Ptr)
(SETQ Ptr (NC.GetPtrFromIndex Stream))
(NC.PutPtr Stream Ptr)
(NC.GetPtr Stream)) (* Put out the new ChkptPtr to the file.)
(SETFILEPTR Stream 8)
(SETQ Ptr (GETEOFPTR Stream))
(NC.PutPtr Stream Ptr) (* Put out the new highest ID number to the file.)
(SETFILEPTR Stream 0)
(SETQ Ptr (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
(NC.PutPtr Stream Ptr 2) (* Put out the new next link id to notefile.)
(SETFILEPTR Stream 4)
(SETQ Ptr (STREAMPROP Stream (QUOTE NCNEXTLINKID)))
(NC.PutPtr Stream Ptr)
(OR QuietFlg (NC.PrintMsg NIL NIL "Done." (CHARACTER 13))))))))
(NC.AbortSession
(LAMBDA (Stream) (* rht: " 5-Nov-85 19:56")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * rht 11/5/85: Added Stream arg and changed PSA.Database to Stream throughout. Now bails out if Stream not open.)
(PROG (FullFileName LastChkptPtr EndPtr CardTotal)
(OR Stream (SETQ Stream PSA.Database))
(if (OR (NULL Stream)
(NOT (OPENP Stream)))
then (NC.PrintMsg NIL T "There is no open NoteFile!!!" (CHARACTER 13))
(RETURN NIL))
(SETQ FullFileName (FULLNAME Stream))
(SETFILEPTR Stream 8)
(SETQ LastChkptPtr (NC.GetPtr Stream))
(SETQ EndPtr (GETEOFPTR Stream))
(NC.PrintMsg NIL T "Aborting will lose work since the last checkpoint i.e., the last "
(IDIFFERENCE EndPtr LastChkptPtr)
" bytes of " FullFileName (CHARACTER 13))
(if (NC.YesP (NC.AskUser "Want to abort anyway? " "--" "Yes" NIL NIL NIL T T))
then (for CardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID Stream T)
3)))
bind ID Win
do (BLOCK)
(if (ZEROP (IREMAINDER CardNumber 10))
then (NC.PrintMsg NIL T "Quitting from active cards ... " (CHARACTER
13)
"Processing item number " CardNumber " out of "
CardTotal "." (CHARACTER 13)))
(if (NC.ActiveCardP (SETQ ID (NC.IDFromNumber CardNumber)))
then (SETQ Win (NC.FetchWindow ID))
(NC.AbortCard ID)
(if Win
then (bind (Process ←(WINDOWPROP Win (QUOTE PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK))
(CLOSEW Win))))
(NC.CacheTypesAndTitles Stream T NIL "Aborting session.")
(NC.ForceDatabaseClose Stream)
(if (LESSP LastChkptPtr EndPtr)
then (NC.PrintMsg NIL T "Truncating file " FullFileName " ...")
(COND
((NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg NIL NIL "Couldn't truncate " FullFileName "."
(CHARACTER 13)))))
(NC.ResetMainMenu)
(NC.PrintMsg NIL T FullFileName " closed.")
else (NC.ClearMsg NIL)))))
(NC.SaveDirtyCards
(LAMBDA (Stream) (* rht: "20-Oct-85 15:12")
(* * Save every card that is both active and dirty to the notefile.)
(* * rht 9/21/85: Now records cards that were shrunken and reshrinks after checkpoint is completed.)
(* * rht 10/20/85: Now uses NC.GetShrunkenWin to find if card's win is shrunken, rather than looking at all open
windows on the screen.)
(LET (ActiveCards ShrunkenCardWins)
(SETQ ActiveCards (for CardNumber from 1 to (SUB1 (SUBATOM (NC.GetNewID Stream T)
3))
bind ID eachtime (BLOCK) when (NC.ActiveCardP (SETQ ID (NC.IDFromNumber
CardNumber)))
collect (if (NC.GetShrunkenWin ID)
then (push ShrunkenCardWins (NC.FetchWindow ID)))
ID))
(RESETLST (RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(for Card in ActiveCards eachtime (BLOCK) do (NC.CardSaveFn Card Stream)))
(for Win in ShrunkenCardWins eachtime (BLOCK) do (SHRINKW Win)))))
)
(* * Database compactor)
(DEFINEQ
(NC.ComputeNewDatabaseIndexSize
(LAMBDA (FromStream) (* rht: " 1-Mar-85 10:39")
(* If the number of notecards we have is more than 3/4 the size of the index, double the index size;
otherwise just keep the same size)
(PROG (NumberOfCurrentIndices CurrentIndexSize)
(SETFILEPTR FromStream 0)
(SETQ NumberOfCurrentIndices (NC.GetPtr FromStream 2))
(SETQ CurrentIndexSize (NC.GetPtr FromStream 2))
(COND
((IGREATERP NumberOfCurrentIndices (FIX (TIMES .75 CurrentIndexSize)))
(RETURN (ITIMES 2 CurrentIndexSize)))
((IGREATERP CurrentIndexSize (ITIMES 2 NumberOfCurrentIndices))
(RETURN (MAX NC.DefaultIndexSizeInEntries (ITIMES 2 NumberOfCurrentIndices))))
(T (RETURN CurrentIndexSize))))))
(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))))
(NC.FastCompactDatabase
(LAMBDA (FromDatabaseName ToDatabaseName IncludeDeleteCardsFlg)
(* rht: "27-Jul-85 22:56")
(* * Copy a database file from FromDatabaseName to ToDatabaseName compacting it along the way by simpluy not copying
obsolete or deleted information.)
(* * rht 8/7/84: Now calls NC.OpenDatabaseFile with the Don'tCreateFlg on, won't try to create if can't open.)
(* * fgh 10/17/84 Swithed to fast compact and copy functions.)
(PROG (FromStream ToStream NextFreeIndex NextFreeLinkIndex ID TotalCount)
(SETQ FromStream (NC.OpenDatabaseFile FromDatabaseName (QUOTE INPUT)
T NIL T))
(AND (NULL FromStream)
(RETURN))
(SETFILEPTR FromStream 0)
(SETQ NextFreeIndex (NC.GetPtr FromStream 2))
(SETFILEPTR FromStream 4)
(SETQ NextFreeLinkIndex (NC.GetPtr FromStream))
(NC.CreateDatabaseFile (COND
((EQ FromDatabaseName ToDatabaseName)
(SETQ ToDatabaseName (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
ToDatabaseName)))
(T ToDatabaseName))
(NC.ComputeNewDatabaseIndexSize FromStream)
"Compacting NoteFile." T NextFreeIndex)
(SETQ ToStream (NC.OpenDatabaseFile ToDatabaseName NIL T))
(AND (NULL ToStream)
(RETURN))
(STREAMPROP ToStream (QUOTE NCNEXTLINKID)
NextFreeLinkIndex)
(COND
((NEQ NextFreeIndex 1)
(for CTR from 1 to (SETQ TotalCount (SUB1 NextFreeIndex))
do (BLOCK)
(SETQ ID (NC.IDFromNumber CTR))
(NC.PrintMsg NIL T "Compacting NoteFile." (CHARACTER 13)
"Copying item " CTR " of " TotalCount "." (CHARACTER 13))
(NC.FastCopyNoteCard ID FromStream ToStream))))
(NC.CheckpointDatabase ToStream T)
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM)))
(RETURN (LIST (NC.ForceDatabaseClose FromStream)
(NC.ForceDatabaseClose ToStream))))))
)
(* * In place database compactor.)
(DEFINEQ
(NC.CompactDatabaseInPlace
(LAMBDA (DatabaseName) (* rht: "13-Aug-85 14:43")
(* * 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 (BLOCK)
(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 OldLength)))
"%%)"
(CHARACTER 13))
else (NC.PrintMsg NIL T "Compact of " FullFileName " aborted."))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FullFileName)))))))
(NC.ExpandIndexInPlace
(LAMBDA (Stream NewIndexSize TempStream) (* rht: "27-Jul-85 23:01")
(* * Make room for a bigger index by copying a few card parts out to the end of the file.)
(PROG (SortedIndexTuples)
(SETQ SortedIndexTuples (NC.SortIndexEntries Stream))
(for Entry in SortedIndexTuples as CTR from 1 bind (ToPtr ←(GETEOFPTR Stream))
until (IGREATERP (CAR Entry)
(ITIMES 16 (ADD1 NewIndexSize)))
do (BLOCK)
(NC.PrintMsg NIL T "Compacting NoteFile." (CHARACTER 13)
"Making room for expanded index."
(CHARACTER 13)
"Copying item " CTR "." (CHARACTER 13))
(SETQ ToPtr (NC.CopyCardPart Entry Stream TempStream ToPtr))
(* Put out the new ChkptPtr to the file just in case we
crash inside this loop.)
(SETFILEPTR Stream 8)
(NC.PutPtr Stream ToPtr)) (* Record new index size in file.)
(SETFILEPTR Stream 2)
(NC.PutPtr Stream NewIndexSize 2))))
(NC.SortIndexEntries
(LAMBDA (Stream) (* rht: " 1-Mar-85 11:43")
(* * Using the IndexArray for Stream, return the sorted list of index entries as triples of fileptr, ID, and
EntryType.)
(PROG ((NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
(IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(NC.SetIndexOffset Stream 0)
(RETURN (SORT (for Index from 1 to (SUB1 NextIDNum)
join (SELECTQ (NC.GetStatusFromIndex Stream)
(ACTIVE (PROG1 (BQUOTE ((, (NC.GetPtrFromIndex Stream)
, Index 0)
(, (NC.GetPtrFromIndex Stream)
, Index 1)
(, (NC.GetPtrFromIndex Stream)
, Index 2)
(, (NC.GetPtrFromIndex Stream)
, Index 3)))))
(SPECIAL (PROG1 (BQUOTE ((, (NC.GetPtrFromIndex Stream)
, Index 4)))
(NC.SetIndexOffset Stream
(IPLUS 3 (
NC.GetIndexOffset
Stream)))))
(PROGN (NC.SetIndexOffset Stream (IPLUS 4 (NC.GetIndexOffset
Stream)))
NIL)))
T)))))
(NC.CopyCardPart
(LAMBDA (IndexTriple Stream TempStream ToPtr DontUpdateArrayFlg)
(* rht: " 1-Mar-85 11:13")
(* * Copy some portion of a card; title, links, substance, proplist, to ptr in Stream and update index accordingly.)
(PROG ((FromPtr (CAR IndexTriple))
(Index (CADR IndexTriple))
(EntryType (CADDR IndexTriple)))
(RETURN (SELECTQ EntryType
(0 (* Copy a card substance.)
(NC.CopyMainCardData Stream TempStream FromPtr ToPtr Index
DontUpdateArrayFlg))
(1 (* Copy links.)
(NC.CopyLinks Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg))
(2 (* Copy title.)
(NC.CopyTitle Stream TempStream FromPtr ToPtr Index DontUpdateArrayFlg))
(3 (* Copy prop list.)
(NC.CopyPropList Stream TempStream FromPtr ToPtr Index
DontUpdateArrayFlg))
(4 (* Copy link labels.)
(NC.CopyLinkLabels Stream TempStream FromPtr ToPtr Index
DontUpdateArrayFlg))
NIL)))))
(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.IndexInFileFromID
(LAMBDA (ID FromFunction) (* rht: "28-Feb-85 22:43")
(* * Returns the ptr into the current notefile corresponding to the index entry of ID.)
(LSH (COND
((NC.IDP ID)
(SUBATOM ID 3))
(T (NC.ReportError FromFunction (CONCAT ID ": Invalid ID"))))
4)))
(NC.MarkIndexEntryFreeInFile
(LAMBDA (ID Stream) (* rht: " 1-Mar-85 16:00")
(* * Mark's the index for this card as FREE directly on the file rather than to the index array.)
(SETFILEPTR Stream (NC.IndexInFileFromID ID "NC.MarkIndexEntryFreeInFile"))
(NC.PutStatus Stream FREE)
(NC.PutPtr Stream -1)
(NC.PutPtr Stream -1)
(NC.PutPtr Stream -1)
(NC.PutPtr Stream -1)))
(NC.CleanupIndexEntries
(LAMBDA (Stream) (* rht: "27-Jul-85 22:59")
(* * Take a pass through index, replacing any entries not ACTIVE, SPECIAL, or FREE, by FREE entries.
This uses the array to save time, so it better be up to date with the file.)
(PROG ((NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
(IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(NC.SetIndexOffset Stream 0)
(for Index from 1 to (SUB1 NextIDNum)
do (BLOCK)
(if (NOT (FMEMB (NC.GetStatusFromIndex Stream)
(QUOTE (ACTIVE SPECIAL FREE))))
then (NC.MarkIndexEntryFreeInFile (NC.IDFromNumber Index)
Stream))
(NC.SetIndexOffset Stream (IPLUS 4 (NC.GetIndexOffset Stream)))))))
)
(* * Convert Version0 files to Version1 files -- based on compactor)
(DEFINEQ
(NC.IndexFromIDVersion0
(LAMBDA (ID FromFunction) (* fgh: "15-Feb-84 23:31")
(LSH (COND
((NC.IDP ID)
(SUBATOM ID 3))
(T (NC.ReportError FromFunction (CONCAT ID ": Invalid ID"))))
3)))
(NC.GetNoteCardVersion0
(LAMBDA (ID DatabaseStream IncludeDeletedCardsFlg) (* fgh: "17-Oct-84 14:49")
(* 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.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetNoteCard")
(PROG (Index Ptr LinksPtr Status ActualID NoteCardType Title Substance Scale
RegionViewed PropList FromLinks ToLinks Region GlobalLinks Stream)
(* IncludeDeletedCardsFlg -- Include delete not yet
implemented)
(SETQ IncludeDeletedCardsFlg)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetNoteCard"))
(SETQ Index (NC.IndexFromIDVersion0 ID "NC.GetNoteCard"))
(SETFILEPTR Stream Index)
(SETQ Ptr (NC.GetPtr Stream))
(SETQ LinksPtr (NC.GetPtr Stream))
(SETQ Status (NC.GetStatus Stream))
(COND
((AND (NEQ Status (QUOTE ACTIVE))
(OR (NOT IncludeDeletedCardsFlg)
(NEQ Status (QUOTE DELETED))))
(RETURN Status))
((OR (IGREATERP Ptr (GETEOFPTR DatabaseStream))
(IGREATERP LinksPtr (GETEOFPTR DatabaseStream))
(MINUSP Ptr)
(MINUSP LinksPtr))
(RETURN (QUOTE IndexEntry)))
(T (* Get Substance)
(SETFILEPTR Stream Ptr)
(COND
((NOT (NC.GetIdentifier Stream NC.ItemIdentifier))
(NC.ReportError "NC.GetNoteCard" (CONCAT ID
" Error in Database file -- incorrect item identifier."))))
(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))
(SETQ Title (READ Stream))
(SETQ PropList (READ Stream))
(READC Stream)
(SETQ Region (NC.GetRegion ID Stream))
(SETQ Substance (SETQ Substance (SELECTQ NoteCardType
((TEXT CONTENTS CONTEXT)
(NC.GetTextSubstance Stream
ID
Region))
((SKETCH MAP)
(PROG ((Value (
NC.GetSketchSubstanceVersion0 Stream)))
(SETQ Scale
(CADR Value))
(SETQ RegionViewed
(CADDR Value))
(RETURN (CAR Value))))
((GRAPH BROWSER)
(NC.GetGraphSubstanceVersion0
Stream))
(NC.ReportError
"NC.GetNoteCard"
(CONCAT
NoteCardType
" Unknown Note Card Type")))))
(* Get Links)
(SETFILEPTR Stream LinksPtr)
(COND
((NOT (NC.GetIdentifier Stream NC.LinksIdentifier))
(NC.ReportError "NC.GetNoteCard" (CONCAT ID
" Error in Database file -- incorrect links identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetNoteCard" (CONCAT
"ID mismatch while reading links. Expected ID: "
ID " Found ID: " ActualID)
)))
(SETQ ToLinks (READ Stream))
(SETQ FromLinks (READ Stream))
(SETQ GlobalLinks (LISTP (READ Stream)))
(* Setup ID with appropriate properties for retrieved
card)
(NC.SetType ID NoteCardType)
(NC.SetRegion ID Region)
(NC.SetTitle ID Title)
(NC.SetSubstance ID Substance)
(COND
((FMEMB NoteCardType (QUOTE (SKETCH MAP)))
(NC.SetScale ID Scale)
(NC.SetRegionViewed ID RegionViewed)))
(NC.SetGlobalLinks ID GlobalLinks)
(NC.SetPropList ID PropList)
(NC.SetToLinks ID ToLinks)
(NC.SetLinksDirtyFlg ID)
(NC.SetFromLinks ID FromLinks)
(NC.SetLinksDirtyFlg ID)
(NC.ActivateCard ID)
(RETURN ID)))))))
(NC.OpenDatabaseFileVersion0
(LAMBDA (FileName Access NoSetFlg QuietFlg Don'tCreateFlg)
(* rht: "28-Mar-85 11:29")
(* Open an already existing database file.)
(* * rht 8/7/84: For nonexistent files, asks user whether to create unless Don'tCreateFlg is non-nil.)
(PROG (Name Stream ID CardTotal)
(COND
((AND PSA.Database (OPENP PSA.Database))
(NC.PrintMsg NIL T "There is already an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before a new one" " can be opened." (CHARACTER 13))
(RETURN NIL)))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T)))
(RETURN NIL))
(COND
((OPENP FileName)
(NC.PrintMsg NIL T FileName " is an already open file." (CHARACTER 13))
(RETURN)))
(AND (NOT (SETQ Name (INFILEP FileName)))
(COND
(T (RETURN NIL))))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opening ... " (CHARACTER 13)))
(SETQ Stream (GETSTREAM (OPENFILE Name (OR Access (QUOTE BOTH))
(QUOTE OLD))))
(NC.SetMonitor Stream (CREATE.MONITORLOCK (MKATOM (CONCAT Name ":LOCK"))))
(SETFILEPTR Stream 0)
(STREAMPROP Stream (QUOTE NCNEXTIDNUM)
(NC.GetPtr Stream 2))
(SETTOPVAL (QUOTE NC.IndexSizeInEntries)
(NC.GetPtr Stream 2))
(STREAMPROP Stream (QUOTE NCNEXTLINKID)
(NC.GetPtr Stream))
(COND
((NULL NoSetFlg)
(SETQ PSA.Database Stream) (* Cache all of the titles in this database)
(NC.CacheTitlesVersion0 PSA.Database NIL QuietFlg "Opening NoteFile.")
(replace (MENU TITLE) of NC.MainMenu with (CONCAT "NoteFile: "
(LISTGET (UNPACKFILENAME
(FULLNAME Stream))
(QUOTE NAME))))
(replace (MENU IMAGE) of NC.MainMenu with NIL)
(NC.DisplayMainMenu)))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opened " (FULLNAME Stream)
(CHARACTER 13)))
(RETURN Stream))))
(NC.CacheTitlesVersion0
(LAMBDA (DatabaseStream UncacheFlg QuietFlg OperationMsg)
(* rht: " 5-Aug-85 19:14")
(* Cache or uncache all of the titles on DatabaseSteam
onto the prop lists of the NoteCard IDs)
(PROG (CardTotal Title ID)
(for CardNumber from 1 to (SETQ CardTotal (SUB1 (STREAMPROP DatabaseStream (QUOTE
NCNEXTIDNUM))))
do (BLOCK)
(COND
((AND (NULL QuietFlg)
(ZEROP (IREMAINDER CardNumber 10)))
(NC.PrintMsg NIL T (COND
(OperationMsg (CONCAT OperationMsg (CHARACTER 13)))
(T ""))
"Processing item number " CardNumber " out of " CardTotal "."
(CHARACTER 13))))
(SETQ ID (NC.IDFromNumber CardNumber))
(COND
(UncacheFlg (REMPROP ID (QUOTE NoteCardTitle)))
(T (SETQ Title (NC.GetTitleVersion0 ID DatabaseStream T))
(AND (NOT (FMEMB Title (QUOTE (FREE DELETED SPECIAL))))
(NC.SetTitle ID Title))))))))
(NC.GetTitleVersion0
(LAMBDA (ID DatabaseStream NoReportFlg) (* NoteCards% User " 8-Oct-84 11:14")
(* Retrieve the title for card specified by ID from the
database specified by DatabaseStream)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetTitle")
(PROG (Index Ptr Status ActualID NoteCardType Title Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetTitle"))
(SETQ Index (NC.IndexFromIDVersion0 ID "NC.GetTitle"))
(SETFILEPTR Stream Index)
(SETQ Ptr (NC.GetPtr Stream))
(NC.GetPtr Stream)
(SETQ Status (NC.GetStatus Stream))
(COND
((NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(T (SETFILEPTR Stream Ptr)
(COND
((NOT (NC.GetIdentifier Stream NC.ItemIdentifier))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetTitle" (CONCAT ID
" Error in Database file -- incorrect item identifier.")))))
)
(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 NoteCardType (READ Stream))
(SETQ Title (READ Stream))
(RETURN Title)))))))
(NC.GetLinkLabelsVersion0
(LAMBDA (DatabaseStream) (* NoteCards% User " 8-Oct-84 12:33")
(* Get the set of link labels from DatabaseStream.
Link label list is stored in normal way indexed by ID
NC.LinkLabelsID)
(PROG (Index)
(RETURN (WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(SETQ Index (NC.IndexFromIDVersion0 NC.LinkLabelsID
"NC.GetLinkLabels"))
(SETFILEPTR DatabaseStream Index)
(SETQ Index (NC.GetPtr DatabaseStream))
(SETFILEPTR DatabaseStream Index)
(COND
((NOT (NC.GetIdentifier DatabaseStream NC.LinkLabelsIdentifier))
(NC.ReportError "NC.GetLinkLabels" (CONCAT ID
" Error in Database file -- incorrect identifier."))))
(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.ConvertVersion0ToVersion1
(LAMBDA (FromDatabaseName ToDatabaseName IncludeDeleteCardsFlg)
(* rht: "27-Jul-85 22:59")
(* * Copy a database file from FromDatabaseName to ToDatabaseName compacting it along the way by simpluy not copying
obsolete or deleted information.)
(* * rht 8/7/84: Now calls NC.OpenDatabaseFile with the Don'tCreateFlg on, won't try to create if can't open.)
(PROG (FromStream ToStream NextFreeIndex ID TotalCount)
(SETQ FromStream (NC.OpenDatabaseFileVersion0 FromDatabaseName (QUOTE INPUT)
T NIL T))
(AND (NULL FromStream)
(RETURN))
(SETFILEPTR FromStream 0)
(SETQ NextFreeIndex (NC.GetPtr FromStream 2))
(NC.CacheTitlesVersion0 FromStream NIL NIL (CONCAT "Converting NoteFile" (CHARACTER 13)
"Opening Old NoteFile."))
(NC.CreateDatabaseFile (COND
((EQ FromDatabaseName ToDatabaseName)
(SETQ ToDatabaseName (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
ToDatabaseName)))
(T ToDatabaseName))
(NC.ComputeNewDatabaseIndexSize FromStream)
"Converting NoteFile" T NextFreeIndex)
(SETQ ToStream (NC.OpenDatabaseFile ToDatabaseName NIL T))
(AND (NULL ToStream)
(RETURN))
(STREAMPROP ToStream (QUOTE NCNEXTLINKID)
1)
(COND
((NEQ NextFreeIndex 1)
(for CTR from 1 to (SETQ TotalCount (SUB1 NextFreeIndex))
do (BLOCK)
(SETQ ID (NC.IDFromNumber CTR))
(NC.PrintMsg NIL T "Converting NoteFile" (CHARACTER 13)
"Copying item " CTR " of " TotalCount "." (CHARACTER 13))
(NC.CopyVersion0CardToVersion1Card ID FromStream ToStream IncludeDeleteCardsFlg)))
)
(NC.CacheTypesAndTitles FromStream T T)
(NC.CheckpointDatabase ToStream T)
(NC.ForceDatabaseClose ToStream)
(NC.ForceDatabaseClose FromStream)
(NC.ScavengeDatabaseFile (FULLNAME ToStream))
(RETURN (LIST (FULLNAME FromStream)
(FULLNAME ToStream))))))
(NC.CopyVersion0CardToVersion1Card
(LAMBDA (ID FromStream ToStream IncludeDeleteCardsFlg) (* rht: "28-Mar-85 21:01")
(PROG (Status Window DebugFlg Anno) (* Activate ID so that when we do a put, all of the
notecard information is available to us)
(SETQ Status (NC.GetNoteCardVersion0 ID FromStream IncludeDeleteCardsFlg))
(* Check status here. Note that NC.GetNoteCard won't
activate notecard if its status isn't ACTIVE)
(COND
((EQ Status (QUOTE SPECIAL)) (* Process Special "card" containing the list of link
labels.)
(NC.PutLinkLabels ToStream (NC.GetLinkLabelsVersion0 FromStream)))
((EQ Status ID)
(COND
((FMEMB (NC.FetchType ID)
(QUOTE (SKETCH MAP)))
(WINDOWPROP (SKETCHW.CREATE (NC.FetchSubstance ID)
(NC.FetchRegionViewed ID)
(CREATEREGION 1000 2000 (fetch (REGION WIDTH)
of (NC.FetchRegion ID))
(fetch (REGION HEIGHT)
of (NC.FetchRegion ID)))
NIL
(NC.FetchScale ID))
(QUOTE NoteCardID)
ID)))
(* * Convert the NoteCardType name)
(NC.SetType ID (SELECTQ (NC.FetchType ID)
(TEXT (QUOTE Text))
(BROWSER (QUOTE Browser))
(CONTENTS (QUOTE FileBox))
(GRAPH (QUOTE Graph))
((MAP SKETCH)
(QUOTE Sketch))
(NC.FetchType ID)))
(* * Links to be fixed by repair in second pass!!)
(NC.SetFromLinks ID NIL)
(NC.SetToLinks ID NIL)
(* * LinkICons and global links to be converted now!)
(NC.SetGlobalLinks ID (for GlobalLink in (NC.FetchGlobalLinks ID)
collect (create NOTECARDLINK
LINKID ←(NC.GetNewLinkID ToStream)
SOURCEID ← ID
DESTINATIONID ←(CAR GlobalLink)
ANCHORMODE ←(QUOTE GlobalGlobal)
DISPLAYMODE ←(CADDR GlobalLink)
LINKLABEL ←(CADR GlobalLink))))
(bind OldLink for LinkIcon in (CAR (APPLY* (NC.CollectReferencesFn (NC.FetchType ID))
ID NIL FromStream T))
do (SETQ OldLink (NC.FetchLinkFromLinkIcon LinkIcon))
(NC.SetLinkInLinkIcon LinkIcon (create NOTECARDLINK
LINKID ←(NC.GetNewLinkID ToStream)
SOURCEID ← ID
DESTINATIONID ←(CAR OldLink)
ANCHORMODE ← NIL
DISPLAYMODE ←(CADDR OldLink)
LINKLABEL ←(CADR OldLink))))
(* * Put the partially converted card onto the ToStream)
(NC.PutNoteCard ID ToStream)
(NC.PutTitle ID ToStream)
(NC.PutPropList ID ToStream)
(NC.PutLinks ID ToStream)
(SETQ Window (NC.FetchWindow ID))
(AND (OPENWP Window)
(CLOSEW Window)))
(T (NC.MarkIndexEntryFree ID ToStream)
(AND DebugFlg (PRINT (CONCAT "Not Copied: " ID " Status: " Status)))))
(NC.DeactivateCard ID))))
(NC.GetGraphSubstanceVersion0
(LAMBDA (DatabaseStream) (* fgh: "13-Nov-84 20:46")
(PROG (Graph Anno) (* Read the Graph)
(SETQ Graph (HREAD DatabaseStream)) (* Then read the annotations)
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
do (AND (LITATOM (fetch (GRAPHNODE NODEID) of GraphNode))
(PUTPROP (fetch (GRAPHNODE NODEID) of GraphNode)
(QUOTE Annotation)
(HREAD DatabaseStream))))
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
do (AND (LITATOM (fetch (GRAPHNODE NODEID) of GraphNode))
(SETQ Anno (GETPROP (fetch (GRAPHNODE NODEID) of GraphNode)
(QUOTE Annotation)))
(OR (replace (GRAPHNODE NODELABEL) of GraphNode
with (COND
((type? ANNO Anno)
(NC.MakeLinkIcon (fetch (ANNONOTECARDSUBSTANCE ANNONOTECARDSPEC)
of (fetch (ANNO ANNO\SUBSTANCE)
of Anno))))
(T Anno)))
T)
(REMPROP (fetch (GRAPHNODE NODEID) of GraphNode)
(QUOTE Annotation))))
(RETURN Graph))))
(NC.GetSketchSubstanceVersion0
(LAMBDA (DatabaseStream) (* fgh: "17-Oct-84 14:46")
(* Get sketch substance from Database stream. Database stream is positioned. READ the global sketch description, the
locasl sketch scale and region viewed. Also read in any cached bit maps for the MAPS system.)
(PROG (Sketch Scale RegionViewed)
(* * Get the substance)
(SETQ Sketch (HREAD DatabaseStream))
(SETQ Scale (READ DatabaseStream))
(SETQ RegionViewed (READ DatabaseStream))
(while (EQ (READ DatabaseStream)
(QUOTE ###CACHEDMAP###))
do (NC.GetCachedMap DatabaseStream))
(RETURN (LIST Sketch Scale RegionViewed)))))
(NC.CheckForNeededConversion
(LAMBDA (DatabaseStream Access Convertw/oConfirmFlg) (* rht: "30-May-85 22:27")
(* * Check to see if this is a version 0 database file. If so, then offer to convert it to a version 1 file.)
(PROG (Version)
(SETFILEPTR DatabaseStream 4)
(SETQ Version (NC.GetPtr DatabaseStream 4))
(COND
((EQUAL Version -1)
(NC.PrintMsg NIL T (FULLNAME DatabaseStream)
" is a Version 0 NoteFile."
(CHARACTER 13)
"It is incompatible with this release of NoteCards."
(CHARACTER 13))
(COND
((OR Convertw/oConfirmFlg (NC.YesP (NC.AskUser
"Do you want me to convert it to a Version 2 NoteFile? "
" -- " "Yes" NIL NIL NIL NIL T)))
(CLOSEF DatabaseStream)
(SETQ DatabaseStream (OPENSTREAM (FULLNAME (CADR (NC.ConvertVersion0ToVersion1
(FULLNAME DatabaseStream)
(FULLNAME DatabaseStream))))
(OR Access (QUOTE BOTH))
(QUOTE OLD))))
(T (SETQ DatabaseStream NIL)))))
(RETURN DatabaseStream))))
)
(* * Database copier.)
(DEFINEQ
(NC.CopyDatabase
(LAMBDA NIL (* rht: "11-Sep-85 19:21")
(* * Copy a notefile. Ask user for names of FromFileName and ToFileName.)
(PROG (FullFromFileName ToFileName FromFileName Result)
(COND
((AND PSA.Database (OPENP PSA.Database))
(NC.PrintMsg NIL T "There is an open NoteFile." (CHARACTER 13)
"The NoteFile must be closed before any NoteFile can be copied."
(CHARACTER 13)))
((AND (SETQ FullFromFileName (FULLNAME (SETQ FromFileName (NC.DatabaseFileName
"Name of NoteFile to be copied:"
" -- " T)))
)
(SETQ ToFileName (NC.DatabaseFileName "Name of target of copy:" " -- " T)))
(NC.PrintMsg NIL T "Copying " FullFromFileName " to " ToFileName " ...")
(COND
((SETQ Result (COPYFILE FullFromFileName ToFileName))
(NC.PrintMsg NIL T FullFromFileName " copied to " Result "." (CHARACTER 13))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
Result)))))
((NULL FullFromFileName)
(NC.PrintMsg NIL T "Can't open file for copy: " FromFileName (CHARACTER 13)))))))
)
(* * Functions for handling dates.)
(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))))
)
(PUTPROPS NCDATABASE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6533 61085 (NC.CoerceDatabaseStream 6543 . 7076) (NC.CreateDatabaseFile 7078 . 11740) (
NC.FetchMonitor 11742 . 12249) (NC.GetCachedMap 12251 . 13150) (NC.GetGraphSubstance 13152 . 13506) (
NC.GetIdentifier 13508 . 14929) (NC.GetLinks 14931 . 17454) (NC.GetLinkLabels 17456 . 19067) (
NC.GetNewID 19069 . 21157) (NC.GetNoteCard 21159 . 24130) (NC.GetPropList 24132 . 26034) (NC.GetPtrs
26036 . 27360) (NC.GetRegion 27362 . 27624) (NC.GetSketchSubstance 27626 . 28521) (NC.GetTextSubstance
28523 . 30045) (NC.GetTitle 30047 . 31893) (NC.GetTypeAndTitle 31895 . 32913) (NC.GetType 32915 .
34727) (NC.IndexFromID 34729 . 35081) (NC.InitializeSpecialCards 35083 . 36955) (NC.MarkCardDeleted
36957 . 37577) (NC.MarkIndexEntryFree 37579 . 38091) (NC.OpenDatabaseFile 38093 . 42476) (
NC.PutCachedMap 42478 . 43346) (NC.PutDeletedIdentifier 43348 . 43528) (NC.PutGraphSubstance 43530 .
44595) (NC.PutIdentifier 44597 . 45131) (NC.PutLinks 45133 . 47111) (NC.PutMainCardData 47113 . 48797)
(NC.PutLinkLabels 48799 . 49895) (NC.PutNoteCard 49897 . 51670) (NC.PutPropList 51672 . 53170) (
NC.PutRegion 53172 . 54021) (NC.MakeDummyRegion 54023 . 54334) (NC.PutSketchSubstance 54336 . 55732) (
NC.PutTextSubstance 55734 . 56728) (NC.PutTitle 56730 . 58210) (NC.SetMonitor 58212 . 58401) (
NC.UpdateRegionData 58403 . 60025) (NC.ValidID 60027 . 60473) (NC.ClearIDAtoms 60475 . 61083)) (62865
64035 (WRITE.FONTDESCRIPTOR 62875 . 63659) (READ.FONTINTODESCRIPTOR 63661 . 64033)) (64074 71374 (
NC.GetPtrsFromIndex 64084 . 65356) (NC.GetPtrFromIndex 65358 . 65910) (NC.GetStatusFromIndex 65912 .
66291) (NC.SetIndexOffset 66293 . 66543) (NC.GetIndexOffset 66545 . 66803) (NC.PutStatusToIndex 66805
. 67319) (NC.PutPtrToIndex 67321 . 67819) (NC.BuildIndexArray 67821 . 70174) (NC.IncreaseIndexArray
70176 . 70928) (NC.OutOfBoundsIndexPtr 70930 . 71372)) (71417 82417 (NC.CheckForNeededTruncation 71427
. 75817) (NC.CheckpointDatabase 75819 . 78415) (NC.AbortSession 78417 . 81195) (NC.SaveDirtyCards
81197 . 82415)) (82449 88740 (NC.ComputeNewDatabaseIndexSize 82459 . 83353) (NC.FastCopyNoteCard 83355
. 86504) (NC.FastCompactDatabase 86506 . 88738)) (88782 114451 (NC.CompactDatabaseInPlace 88792 .
93553) (NC.ExpandIndexInPlace 93555 . 94741) (NC.SortIndexEntries 94743 . 95998) (NC.CopyCardPart
96000 . 97293) (NC.CopyMainCardData 97295 . 99859) (NC.CopyLinks 99861 . 103064) (NC.CopyTitle 103066
. 106309) (NC.CopyPropList 106311 . 109711) (NC.CopyLinkLabels 109713 . 112727) (NC.IndexInFileFromID
112729 . 113102) (NC.MarkIndexEntryFreeInFile 113104 . 113568) (NC.CleanupIndexEntries 113570 .
114449)) (114527 134989 (NC.IndexFromIDVersion0 114537 . 114807) (NC.GetNoteCardVersion0 114809 .
119355) (NC.OpenDatabaseFileVersion0 119357 . 121875) (NC.CacheTitlesVersion0 121877 . 123064) (
NC.GetTitleVersion0 123066 . 124676) (NC.GetLinkLabelsVersion0 124678 . 125929) (
NC.ConvertVersion0ToVersion1 125931 . 128278) (NC.CopyVersion0CardToVersion1Card 128280 . 131630) (
NC.GetGraphSubstanceVersion0 131632 . 132972) (NC.GetSketchSubstanceVersion0 132974 . 133791) (
NC.CheckForNeededConversion 133793 . 134987)) (135019 136353 (NC.CopyDatabase 135029 . 136351)) (
136396 137225 (NC.PutDate 136406 . 136601) (NC.GetDate 136603 . 137223)))))
STOP