(FILECREATED "23-May-85 14:34:13" {PHYLUM}<NOTECARDS>RELEASE1.2>NCDATABASE.;30 139885
changes to: (FNS NC.GetTextSubstance NC.PutTextSubstance)
previous date: "22-May-85 02:01:03" {PHYLUM}<NOTECARDS>RELEASE1.2>NCDATABASE.;29)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCDATABASECOMS)
(RPAQQ NCDATABASECOMS ((E (SETQ NC.SystemDate (DATE))
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(VARS NC.SystemDate)
(P (UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(* * Internal variables)
(GLOBALVARS PSA.Database NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier NC.DatabaseFileNameSuggestion
NC.VersionNumber NC.UncachingNotCompleted NC.DefaultIndexSizeInEntries
NC.IndexSizeInEntries NC.UnclassifiedID NC.LinkLabelsID NC.OrphanID NC.RootID
NC.InitialLinkLabels)
(VARS (PSA.Database NIL)
(NC.VersionNumber 2)
(NC.LinkLabelsIdentifier (QUOTE ###LABELS###))
(NC.LinksIdentifier (QUOTE ###LINKS###))
(NC.ItemIdentifier (QUOTE ###ITEM###))
(NC.TitlesIdentifier (QUOTE ###TITLES###))
(NC.PropsIdentifier (QUOTE ###PROPS###))
(NC.UncachingNotCompleted NIL)
(NC.DefaultIndexSizeInEntries 2000))
(* * 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)
(* * Checkpointing mechanism stuff)
(FNS NC.CheckForNeededTruncation NC.CheckpointDatabase NC.AbortSession NC.SaveDirtyCards)
(* * Database compactor)
(FNS NC.ComputeNewDatabaseIndexSize NC.CopyAndCompactDatabase NC.CopyNoteCard
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)
(* * Scavenger mechanisms)
(FNS NC.CollectAndCheckLinks NC.GetOldData NC.FindOldData NC.FindOldLinks
NC.ReinstateNthInstance NC.ScavengeDatabaseFile)
(* * 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)))
(RPAQQ NC.SystemDate "23-May-85 14:34:16")
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS))
(* * Internal variables)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PSA.Database NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier NC.DatabaseFileNameSuggestion NC.VersionNumber
NC.UncachingNotCompleted NC.DefaultIndexSizeInEntries NC.IndexSizeInEntries
NC.UnclassifiedID NC.LinkLabelsID NC.OrphanID NC.RootID NC.InitialLinkLabels)
)
(RPAQQ PSA.Database NIL)
(RPAQQ NC.VersionNumber 2)
(RPAQQ NC.LinkLabelsIdentifier ###LABELS###)
(RPAQQ NC.LinksIdentifier ###LINKS###)
(RPAQQ NC.ItemIdentifier ###ITEM###)
(RPAQQ NC.TitlesIdentifier ###TITLES###)
(RPAQQ NC.PropsIdentifier ###PROPS###)
(RPAQQ NC.UncachingNotCompleted NIL)
(RPAQQ NC.DefaultIndexSizeInEntries 2000)
(* * 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)))
)
[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-Mar-85 15:14")
(* * 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
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: " 2-Apr-84 16:23")
(* Read a bit map from the file and then put it onto
the cached maps list)
(PROG (CacheSpecs BitMap)
(SETQ CacheSpecs (READ DatabaseStream))
(SETQ BitMap (HREAD DatabaseStream))
(AND CacheSpecs BitMap (APPLY (FUNCTION SetCachedBitMap)
(CONS BitMap CacheSpecs))))))
(NC.GetGraphSubstance
(LAMBDA (DatabaseStream) (* rht: "11-Mar-85 12:54")
(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: " 4-Feb-85 01:31")
(* 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.)
(PROG ((ThingRead (READ DatabaseStream)))
(RETURN (OR (EQ ThingRead Identifier)
(AND (EQ Identifier NC.TitlesIdentifier)
(EQ ThingRead (QUOTE NOBIND))))))))
(NC.GetLinks
(LAMBDA (ID DatabaseStream LinksPtr) (* rht: "10-Feb-85 15:50")
(* * rht 1/31/85: Now reads pointers from index array.)
(* * rht 2/9/85: Now fixes display formats on links read in.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetNoteCard")
(PROG (Index PtrList Status ActualID FromLinks ToLinks GlobalLinks Stream)
(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 (NC.GetIdentifier Stream NC.LinksIdentifier))
(NC.ReportError "NC.GetLinks" (CONCAT ID
" Error in Database file -- incorrect links identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetLinks" (CONCAT
"ID mismatch while reading links. Expected ID: "
ID " Found ID: " ActualID))))
(SETQ ToLinks (READ Stream))
(for Link in ToLinks do (NC.CheckDisplayModeFormat Link))
(SETQ FromLinks (READ Stream))
(for Link in FromLinks do (NC.CheckDisplayModeFormat Link))
(SETQ GlobalLinks (LISTP (READ Stream)))
(for Link in GlobalLinks do (NC.CheckDisplayModeFormat Link))
(* Setup ID with appropriate properties for retrieved
card)
(NC.SetToLinks ID ToLinks)
(NC.SetFromLinks ID FromLinks)
(NC.SetGlobalLinks ID GlobalLinks)
(NC.SetLinksDirtyFlg ID NIL)
(RETURN ID)))))
(NC.GetLinkLabels
(LAMBDA (DatabaseStream) (* rht: "31-Jan-85 18:57")
(* 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.)
(PROG (Index)
(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 (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.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: " 5-Feb-85 23:50")
(* 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.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetNoteCard")
(PROG (Index PtrList Ptr LinksPtr TitlePtr PropsPtr 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 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 (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))
(READC Stream)
(SETQ Region (NC.GetRegion ID Stream))
(SETQ Substance (APPLY* (NC.GetSubstanceFn NoteCardType)
Stream ID Region))
(* * 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.SetTitle ID (NC.GetTitle ID Stream TitlePtr))
(* * Get Prop List)
(NC.SetPropList ID (NC.GetPropList ID Stream PropsPtr))
(* * Activate Card and return)
(NC.ActivateCard ID)
(RETURN ID)))))))
(NC.GetPropList
(LAMBDA (ID DatabaseStream PropPtr) (* rht: "31-Jan-85 18:59")
(* 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.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetPropList")
(PROG (PtrList Status ActualID Props Stream)
(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 (NC.GetIdentifier Stream NC.PropsIdentifier))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetPropList" (CONCAT ID
" Error in Database file -- incorrect prop list identifier.")))))
)
(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) (* fgh: "17-Oct-84 14:39")
(* 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 Region) (* fgh: " 2-May-85 15:33")
(* Get a text stream from the database file)
(PROG ((TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
StartPtr EndPtr StartFormatPtr TempFileEof)
(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
((FMEMB (\WIN TempStream)
(QUOTE (31415 31416 31417)))
(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)
(RETURN (OPENTEXTSTREAM TempStream NIL NIL NIL (LIST (QUOTE FONT)
NC.DefaultFont))))))
(NC.GetTitle
(LAMBDA (ID DatabaseStream TitlePtr NoReportFlg) (* rht: " 4-Feb-85 01:31")
(* 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.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetTitle")
(PROG (PtrList Status ActualID Title Stream)
(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 (NC.GetIdentifier Stream NC.TitlesIdentifier))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetTitle" (CONCAT ID
" Error in Database file -- incorrect title 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 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: "31-Jan-85 18:59")
(* 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.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetType")
(PROG (PtrList Status ActualID NoteCardType Stream)
(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 (NC.GetIdentifier Stream NC.ItemIdentifier))
(COND
(NoReportFlg (RETURN))
(T (NC.ReportError "NC.GetType" (CONCAT ID
" Error in Database file -- incorrect item identifier.")))))
)
(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)
(* 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.)
(* * 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.)
(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))
(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)))
(COND
((EQ (SETQ NewStream (NC.CheckForNeededTruncation Stream Access))
(QUOTE ABORT))
(CLOSEF Stream)
(RETURN 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.")
(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.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) (* fgh: "20-Apr-84 16:11")
(* Put Identifier on DatabaseStream)
(PRINT Identifier DatabaseStream)))
(NC.PutLinks
(LAMBDA (ID DatabaseStream) (* rht: "31-Jan-85 14:33")
(* * Put the link data for ID onto the database file.)
(* * rht 1/30/85: Changed to use index array instead of file.)
(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)
(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)
(* rht: " 1-Mar-85 16:15")
(* * Write out the junk for a card at current location in Stream finding the substance out on SubstanceStream.
Then update index.)
(PROG (MainPtr EndPtr SubstancePtr)
(SETQ MainPtr (GETFILEPTR Stream))
(NC.PutIdentifier Stream NC.ItemIdentifier)
(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) (* rht: " 5-Feb-85 21:38")
(* Put onto DatabaseStream the list of LinkLabel.
Do so by writing at eof and then updating the index
entry for ID NC.LinkLabelID)
(PROG (Ptr)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(SETQ Ptr (GETEOFPTR DatabaseStream))
(SETFILEPTR DatabaseStream Ptr)
(NC.PutIdentifier DatabaseStream NC.LinkLabelsIdentifier)
(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) (* rht: "31-Jan-85 15:05")
(* * Write note card specified by ID to the database specified by Database stream)
(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)
(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) (* rht: "31-Jan-85 15:06")
(* * Put the prop list of card ID onto DatabaseStream)
(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)
(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: " 6-Feb-85 16:45")
(PROG (Region)
(COND
((AND (SETQ Region (NC.FetchWindow ID))
(SETQ Region (WINDOWPROP Region (QUOTE REGION)))))
((SETQ Region (NC.FetchRegion ID)))
(T (SETQ Region (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-May-85 01:42")
(* 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 T T)
(PRINT (AND Window (SCALE.FROM.SKW Window))
DatabaseStream)
(PRINT (AND Window (SK.REGION.VIEWED Window))
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) (* fgh: " 2-May-85 14:25")
(* Put text substance from card ID on the database
file)
(PROG ((Substance (NC.FetchSubstance ID))
EndPtr EndPtrLoc StartPtr TempStream)
(SETQ TempStream (GETSTREAM (fetch (TEXTOBJ TXTFILE) of (TEXTOBJ Substance))))
(SETQ StartPtr (IPLUS (GETFILEPTR DatabaseStream)
6))
(NC.PutPtr DatabaseStream StartPtr)
(SETQ EndPtrLoc (GETFILEPTR DatabaseStream))
(NC.PutPtr DatabaseStream 0)
(AND (ZEROP (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ Substance)))
(TEDIT.INSERT Substance " " 1))
(TEDIT.PUT.PCTB (TEXTOBJ Substance)
DatabaseStream)
(SETQ EndPtr (GETFILEPTR DatabaseStream))
(SETFILEPTR DatabaseStream EndPtrLoc)
(NC.PutPtr DatabaseStream EndPtr) (* Fix up PCTB of Substance in case want to go on
editing.)
(TEDIT.MAPPIECES (TEXTOBJ Substance)
(FUNCTION (LAMBDA (CH# PC PC# OBL)
(COND
((EQ (FULLNAME (fetch (PIECE PFILE) of PC))
(FULLNAME DatabaseStream))
(replace (PIECE PFILE) of PC with TempStream)
(replace (PIECE PFPOS) of PC with (IDIFFERENCE
(fetch (PIECE PFPOS)
of PC)
StartPtr))))))))))
(NC.PutTitle
(LAMBDA (ID DatabaseStream) (* rht: " 4-Feb-85 11:20")
(* * Put the title of card ID onto DatabaseStream)
(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)
(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: "31-Jan-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)
(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 (NC.GetIdentifier Stream NC.ItemIdentifier))
(NC.ReportError "NC.UpdateRegionData" (CONCAT ID
"Error in database file -- incorrect item identifier"))))
(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: " 9-Jan-85 17:22")
(* * Clear the junk off the given number of IDs.)
(for i from 1 to NumIDs bind ID
do (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: "31-Jan-85 19:13")
(* * Write this pointer value at the current spot in the index array.)
(PROG ((Offset (STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET))))
(SETA (STREAMPROP Stream (QUOTE NCINDEXARRAY))
Offset Ptr)
(STREAMPROP Stream (QUOTE NCINDEXARRAYOFFSET)
(ADD1 Offset))
(RETURN Ptr))))
(NC.BuildIndexArray
(LAMBDA (Stream) (* rht: "21-Mar-85 14:22")
(* * Build the index array by copying from the index on the file.)
(PROG ((NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM))))
(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)
do (NC.PutStatusToIndex Stream (NC.GetStatus Stream))
(NC.PutPtrToIndex Stream (NC.GetPtr Stream))
(NC.PutPtrToIndex Stream (NC.GetPtr Stream))
(NC.PutPtrToIndex Stream (NC.GetPtr Stream))
(NC.PutPtrToIndex Stream (NC.GetPtr Stream))
(NC.GetPtr Stream)))))))
(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))))
)
(* * Checkpointing mechanism stuff)
(DEFINEQ
(NC.CheckForNeededTruncation
(LAMBDA (DatabaseStream Access) (* fgh: " 8-Feb-85 02:42")
(* * 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.)
(PROG (FullFileName Version LastChkptPtr EndPtr SaveFile SaveStream Ptr)
(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))
(COND
((NC.YesP (NC.AskUser "Want to save this info in a file? " "--" "Yes" NIL NIL NIL T))
(COND
((AND (SETQ SaveFile (NC.AskUser (CONCAT (CHARACTER 13)
"File to save info in: ")
"--" 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)
"Want to truncate " FullFileName "?")
"--" "Yes" NIL NIL NIL 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: " 9-Feb-85 13:25")
(* * 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
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 NIL (* rht: " 9-Feb-85 22:57")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(PROG (FullFileName LastChkptPtr EndPtr CardTotal)
(SETQ FullFileName (FULLNAME PSA.Database))
(SETFILEPTR PSA.Database 8)
(SETQ LastChkptPtr (NC.GetPtr PSA.Database))
(SETQ EndPtr (GETEOFPTR PSA.Database))
(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))
then (for CardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID PSA.Database
T)
3)))
bind ID Win
do (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)))))
(NC.CacheTypesAndTitles PSA.Database T NIL "Aborting session.")
(NC.ForceDatabaseClose PSA.Database)
(replace (MENU TITLE) of NC.MainMenu with "No Open NoteFile")
(replace (MENU IMAGE) of NC.MainMenu with NIL)
(WINDOWPROP (WFROMMENU NC.MainMenu)
(QUOTE CLOSEFN)
NIL)
(NC.DisplayMainMenu)
(SETQ PSA.Database)
(NC.PrintMsg NIL T FullFileName " closed.")
else (NC.ClearMsg NIL)))))
(NC.SaveDirtyCards
(LAMBDA (Stream) (* rht: " 9-Feb-85 22:42")
(* * Save every card that is both active and dirty to the notefile.)
(PROG (ActiveCards CardsNeedingFiling)
(SETQ ActiveCards (for CardNumber from 1 to (SUB1 (SUBATOM (NC.GetNewID Stream T)
3))
bind ID when (NC.ActiveCardP (SETQ ID (NC.IDFromNumber CardNumber)))
collect ID))
(SETQ CardsNeedingFiling (for Card in ActiveCards when (NC.CardNeedsFilingP Card)
collect Card))
(RESETLST (RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(for Card in ActiveCards do (NC.CardSaveFn Card Stream T))))))
)
(* * 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.CopyAndCompactDatabase
(LAMBDA (FromDatabaseName ToDatabaseName IncludeDeleteCardsFlg)
(* fgh: " 2-Oct-84 16:43")
(* * 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.OpenDatabaseFile FromDatabaseName (QUOTE INPUT)
T NIL T))
(AND (NULL FromStream)
(RETURN))
(NC.CacheTypesAndTitles FromStream NIL NIL (CONCAT "Compacting 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)
"Compacting NoteFile.")
(SETQ ToStream (NC.OpenDatabaseFile ToDatabaseName NIL T))
(AND (NULL ToStream)
(RETURN))
(SETFILEPTR FromStream 0)
(SETQ NextFreeIndex (NC.GetPtr FromStream 2))
(NC.GetPtr FromStream 2)
(NC.GetPtr FromStream 4)
(SETFILEPTR ToStream 0)
(NC.PutPtr ToStream NextFreeIndex 2)
(COND
((NEQ NextFreeIndex 1)
(for CTR from 1 to (SETQ TotalCount (SUB1 NextFreeIndex))
do (SETQ ID (NC.IDFromNumber CTR))
(NC.PrintMsg NIL T "Compacting NoteFile." (CHARACTER 13)
"Copying item " CTR " of " TotalCount "." (CHARACTER 13))
(NC.CopyNoteCard ID FromStream ToStream IncludeDeleteCardsFlg))))
(NC.CacheTypesAndTitles FromStream T T)
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM)))
(SETQ PSA.Database)
(RETURN (LIST (NC.ForceDatabaseClose FromStream)
(NC.ForceDatabaseClose ToStream))))))
(NC.CopyNoteCard
(LAMBDA (ID FromStream ToStream IncludeDeleteCardsFlg) (* rht: " 5-Feb-85 23:50")
(PROG (Status Title PropList Window DebugFlg) (* Activate ID so that when we do a put, all of the
notecard information is available to us)
(SETQ Status (NC.GetNoteCard 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.GetLinkLabels 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))))
(QUOTE NoteCardID)
ID)))
(NC.PutNoteCard ID ToStream)
(NC.PutTitle ID ToStream)
(NC.PutPropList ID ToStream)
(NC.PutLinks ID ToStream)
(SETQ Window (NC.FetchWindow ID))
(NC.DeactivateCard ID)
(AND (OPENWP Window)
(CLOSEW Window)))
(T (NC.MarkIndexEntryFree ID ToStream)
(AND DebugFlg (PRINT (CONCAT "Not Copied: " ID " Status: " Status))))))))
(NC.FastCopyNoteCard
(LAMBDA (ID FromStream ToStream) (* rht: "31-Jan-85 19:04")
(* * 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.)
(PROG (PtrList DebugFlg Status NoteCardType MainPtr)
(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)))
((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 (NC.GetIdentifier FromStream NC.ItemIdentifier)
(EQ ID (READ FromStream)))
(* * Copy the main card data)
(SETFILEPTR ToStream (SETQ MainPtr (GETEOFPTR ToStream)))
(NC.PutIdentifier ToStream NC.ItemIdentifier)
(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)
(* * Copy the title)
(NC.GetTitle ID FromStream (fetch (POINTERLIST TITLEPTR) of PtrList))
(NC.PutTitle ID ToStream)
(* * Copy the PropList)
(NC.GetPropList ID FromStream (fetch (POINTERLIST PROPSPTR) of PtrList))
(NC.PutPropList ID ToStream))
(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: "21-Mar-85 15:35")
(* * 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 (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: "22-May-85 01:45")
(* * Compact the notefile in place. If index needs to be increased, then first make room for bigger index by
copying. Compaction is done by sorting index pointers and moving each entry in the file to lower addresses.)
(PROG (Stream TempStream OldIndexSize NewIndexSize NextFreeIndex ID TotalCount FullFileName
SortedIndexTuples ToPtr OldLength NumBytesSaved SuccessFlg)
(if (AND PSA.Database (OPENP PSA.Database))
then (NC.PrintMsg NIL T "There is an open NoteFile." (CHARACTER 13)
"The NoteFile must be closed before any other NoteFile can be compacted."
(CHARACTER 13))
(RETURN))
(OR DatabaseName (SETQ DatabaseName (NC.DatabaseFileName
"Name of NoteFile to be compacted in place:"
" -- " T)))
(NC.ClearMsg)
(AND DatabaseName (SETQ Stream (NC.OpenDatabaseFile DatabaseName (QUOTE BOTH)
T NIL T)))
(AND (NULL Stream)
(RETURN))
(SETQ OldLength (GETFILEINFO Stream (QUOTE LENGTH)))
(SETQ FullFileName (FULLNAME Stream)) (* Create a temporary stream on {CORE} with name not
already extant.)
(for i from 1 bind TempFileName unless (FULLNAME (SETQ TempFileName (PACK* (QUOTE
{CORE}NCTEMPFILE)
i)))
do (RETURN (SETQ TempStream (OPENSTREAM TempFileName (QUOTE BOTH)))))
(* Get the current index size and see if needs to be
expanded.)
(SETFILEPTR Stream 2)
(SETQ OldIndexSize (NC.GetPtr Stream 2))
(SETQ NewIndexSize (NC.ComputeNewDatabaseIndexSize Stream))
(* Expand index if needed.)
(if (IGREATERP NewIndexSize OldIndexSize)
then (NC.ExpandIndexInPlace Stream NewIndexSize TempStream))
(* In sorted order, copy entries to lower addresses in
the file.)
(SETQ SortedIndexTuples (NC.SortIndexEntries Stream))
(SETQ ToPtr (LSH (ADD1 NewIndexSize)
4))
(SETQ SuccessFlg (for Tuple in SortedIndexTuples as CTR from 1 to (SETQ TotalCount
(LENGTH
SortedIndexTuples))
bind Result
do (if (ZEROP (IREMAINDER CTR 10))
then (NC.PrintMsg NIL T "Compacting NoteFile." (CHARACTER 13)
"Copying piece " CTR " of " TotalCount "."
(CHARACTER 13)))
(if (SETQ Result (NC.CopyCardPart Tuple Stream TempStream ToPtr))
then (SETQ ToPtr Result)
else (RETURN NIL))))
(if SuccessFlg
then (* Change all deleted entries to FREE in the index.)
(NC.CleanupIndexEntries Stream) (* Put out the new ChkptPtr to the file.)
(SETFILEPTR Stream 8)
(NC.PutPtr Stream ToPtr)) (* Delete the temporary {CORE} file.)
(DELFILE (CLOSEF TempStream)) (* Truncate file at that point.)
(RETURN (PROG2 (AND SuccessFlg (NC.PrintMsg NIL T "Truncating file " FullFileName " ..."))
(NC.ForceDatabaseClose Stream)
(AND SuccessFlg (if (NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
ToPtr))
then (NC.PrintMsg NIL NIL "Couldn't truncate "
FullFileName "." (CHARACTER 13))
else (NC.PrintMsg NIL T "Done." (CHARACTER 13))))
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM)))
(if SuccessFlg
then (NC.PrintMsg NIL T FullFileName " compacted in place."
(CHARACTER 13)
"Recovered "
(SETQ NumBytesSaved (DIFFERENCE OldLength ToPtr))
" bytes ("
(FIX (TIMES 100 (FQUOTIENT NumBytesSaved ToPtr)))
"%%)"
(CHARACTER 13))
else (NC.PrintMsg NIL T "Compact of " FullFileName " aborted."))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FullFileName)))))))
(NC.ExpandIndexInPlace
(LAMBDA (Stream NewIndexSize TempStream) (* rht: " 1-Mar-85 10:48")
(* * 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 (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: " 1-Mar-85 11:22")
(* * Copy a card's ID#, type, region, substance, etc.)
(PROG (ID NoteCardType Region EndPtr SubstancePtr)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (NC.GetIdentifier Stream NC.ItemIdentifier)
(EQ ID (READ Stream)))
(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))
(* Now copy junk to its proper home.)
(SETFILEPTR Stream ToPtr)
(SETFILEPTR TempStream 0)
(NC.PutMainCardData Stream ID NoteCardType Region TempStream DontUpdateArrayFlg)
(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))
(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: " 1-Mar-85 17:59")
(* * Copy a card's links from one point in the stream to another.)
(PROG (ID ToLinks FromLinks GlobalLinks EndPtr Length)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (NC.GetIdentifier Stream NC.LinksIdentifier)
(EQ ID (READ Stream)))
(SETQ ToLinks (READ Stream))
(SETQ FromLinks (READ Stream))
(SETQ GlobalLinks (LISTP (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))
(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: " 1-Mar-85 18:13")
(* * Copy a card's title from one point in the stream to another.)
(PROG (ID Title EndPtr Length)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (NC.GetIdentifier Stream NC.TitlesIdentifier)
(EQ ID (READ Stream)))
(SETQ 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))
(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: " 1-Mar-85 17:59")
(* * Copy a card's PropList from one point in the stream to another.)
(PROG (ID PropList EndPtr Length)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (NC.GetIdentifier Stream NC.PropsIdentifier)
(EQ ID (READ Stream)))
(SETQ PropList (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))
(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: " 1-Mar-85 11:12")
(* * Copy the link labels from one point in the stream to another.)
(PROG (ID LinkLabels EndPtr Length)
(SETQ ID (NC.IDFromNumber Index))
(SETFILEPTR Stream FromPtr)
(SETFILEPTR TempStream 0)
(COND
((AND (NC.GetIdentifier Stream NC.LinkLabelsIdentifier)
(EQ ID (READ Stream)))
(SETQ LinkLabels (READ 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))
(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: " 1-Mar-85 12:22")
(* * 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 (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)))))))
)
(* * Scavenger mechanisms)
(DEFINEQ
(NC.CollectAndCheckLinks
(LAMBDA (ID DatabaseStream ListOfValidCards) (* rht: "28-Mar-85 21:34")
(* Return the list of all of the NoteCardLinks in the substance of NoteCard ID. Check each link to make sure it is
legal. If not legal delete it from the substance.)
(* Assumes that the ID is already an active NoteCard)
(PROG (NoteCardType Links DirtyFlg ActualLink GlobalLinks LinkIcon LinksDirtyFlg)
(SETQ NoteCardType (NC.FetchType ID)) (* Collect the links. Check the validity of each link
and delete it if it is not a valid link.)
(SETQ Links (APPLY* (NC.CollectReferencesFn NoteCardType)
ID T DatabaseStream))
(SETQ DirtyFlg (CDR Links))
(SETQ Links (CAR Links))
(* * Process the GlobalLinks as well .... same for all substance types)
(SETQ Links (NCONC Links (for Link in (SETQ GlobalLinks
(for GlobalLink in (NC.FetchGlobalLinks ID)
when (COND
((AND (LISTP ListOfValidCards)
(FMEMB (fetch (NOTECARDLINK
DESTINATIONID)
of GlobalLink)
ListOfValidCards)))
((NC.ValidLinkP GlobalLink DatabaseStream
T))
(T (SETQ LinksDirtyFlg T)
NIL))
collect GlobalLink))
when (NEQ (fetch (NOTECARDLINK DESTINATIONID) of Link)
(QUOTE NC00000))
collect Link)))
(NC.SetGlobalLinks ID GlobalLinks)
(* * Update list of valid cards with good links returned from Collect references)
(AND (LISTP ListOfValidCards)
(NCONC ListOfValidCards (for Link in Links collect (fetch (NOTECARDLINK DESTINATIONID)
of Link))))
(* * Write out the card or links if it has been modified)
(AND DirtyFlg (NC.PutNoteCard ID DatabaseStream))
(AND LinksDirtyFlg (NC.PutLinks ID DatabaseStream))
(RETURN Links))))
(NC.GetOldData
(LAMBDA (ID Ptr LinksPtr DatabaseStream) (* fgh: "10-Oct-84 22:51")
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetOldData")
(PROG (Index Status ActualID NoteCardType Title Substance PropList FromLinks
ToLinks Region Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetOldData"))
(* Get Substance)
(SETFILEPTR Stream Ptr)
(COND
((NOT (NC.GetIdentifier Stream NC.ItemIdentifier))
(NC.ReportError "NC.GetOldData" (CONCAT ID
" Error in Database file -- incorrect item identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetOldData" (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 Region))
(* Get Links)
(SETFILEPTR Stream LinksPtr)
(COND
((NOT (NC.GetIdentifier Stream NC.LinksIdentifier))
(NC.ReportError "NC.GetOldData" (CONCAT ID
" Error in Database file -- incorrect links identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.GetOldData" (CONCAT
"ID mismatch while reading links. Expected ID: "
ID " Found ID: " ActualID))))
(SETQ ToLinks (READ Stream))
(SETQ FromLinks (READ Stream)) (* Setup ID with appropriate properties for retrieved
card)
(NC.SetType ID NoteCardType)
(NC.SetRegion ID Region)
(NC.SetSubstance ID Substance)
(NC.SetToLinks ID ToLinks)
(NC.SetLinksDirtyFlg ID)
(NC.SetFromLinks ID FromLinks)
(NC.SetLinksDirtyFlg ID)
(NC.ActivateCard ID)
(RETURN ID)))))
(NC.FindOldData
(LAMBDA (ID DatabaseStream) (* rht: " 5-Feb-85 23:52")
(PROG (Pos)
(SETFILEPTR DatabaseStream 0)
(RETURN (while (SETQ Pos (FILEPOS "###ITEM###" DatabaseStream NIL NIL NIL NIL))
when (PROGN (READ DatabaseStream)
(EQ (READ DatabaseStream)
ID))
collect Pos)))))
(NC.FindOldLinks
(LAMBDA (ID DatabaseStream) (* rht: " 5-Feb-85 23:52")
(PROG (Pos)
(SETFILEPTR DatabaseStream 0)
(RETURN (while (SETQ Pos (FILEPOS "###LINKS###" DatabaseStream NIL NIL NIL NIL))
when (PROGN (READ DatabaseStream)
(EQ (READ DatabaseStream)
ID))
collect Pos)))))
(NC.ReinstateNthInstance
(LAMBDA (ID NData NLinks DatabaseStream) (* fgh: " 3-May-84 18:15")
(PROG (Ptr LinksPtr)
(COND
((MINUSP NData)
(SETQ Ptr (CAR (NLEFT (NC.FindOldData ID DatabaseStream)
(ABS NData)))))
(T (SETQ Ptr (CAR (NTH (NC.FindOldData ID DatabaseStream)
NData)))))
(COND
((MINUSP NLinks)
(SETQ LinksPtr (CAR (NLEFT (NC.FindOldLinks ID DatabaseStream)
(ABS NLinks)))))
(T (SETQ LinksPtr (CAR (NTH (NC.FindOldLinks ID DatabaseStream)
NLinks))))) (* (NC.GetOldData ID Ptr LinksPtr DatabaseStream)
(NC.PutNoteCard ID DatabaseStream)
(NC.PutLinks ID DatabaseStream)
(NC.DeactivateCard ID))
(RETURN (COND
((AND (NC.IDP ID)
Ptr LinksPtr)
(SETFILEPTR DatabaseStream (NC.IndexFromID ID))
(NC.PutPtr DatabaseStream Ptr)
(NC.PutPtr DatabaseStream LinksPtr)
(NC.PutStatus DatabaseStream ACTIVE)
(QUOTE DONE))
(T (QUOTE ERROR)))))))
(NC.ScavengeDatabaseFile
(LAMBDA (FileName UpdateLinkLabelsFlg) (* rht: "28-Mar-85 12:06")
(* Scavenge the database FileName. Essentially throw away all of the information about From and ToLinks and recreate
them by retrieving the link information from the substance of each card and from the list of global links from the
card.)
(* * rht 8/9/84: Now calls NC.OpenDatabaseFile to do the file open.)
(PROG (FromLinks ToLinks DatabaseStream Status ID Links Entry FullName CardTotal GlobalLinks
ActiveCardsList (ListOfValidCards (QUOTE (**Header**))))
(* Get File NAme and open the file if conditions are
okay.)
(COND
((AND (STREAMP PSA.Database)
(OPENP PSA.Database))
(NC.PrintMsg NIL T "There is an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before the repair procedure can be done."
(CHARACTER 13))
(RETURN)))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to repair?"
" -- " T)))
(RETURN NIL))
(AND (NULL (SETQ PSA.Database (SETQ DatabaseStream (NC.OpenDatabaseFile FileName NIL T))))
(NC.PrintMsg NIL NIL "Couldn't open " FileName "." (CHARACTER 13)
"Repair aborted."
(CHARACTER 13))
(RETURN NIL))
(* Read through all NoteCard substances to find actual pointers. Use this to create the To Links list.
The list collection function checks to make sure each link is valid.)
(NC.PrintMsg NIL T "Collecting Links ... ")
(for NoteCardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
do (SETQ ID (NC.IDFromNumber NoteCardNumber))
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Collecting Links for item " NoteCardNumber " out of " CardTotal "."
(CHARACTER 13))
(SETQ Status (NC.GetNoteCard ID DatabaseStream))
(COND
((NC.IDP Status)
(SETQ ActiveCardsList (CONS Status ActiveCardsList))
(AND (NOT (FMEMB ID ListOfValidCards))
(SETQ ListOfValidCards (CONS ID ListOfValidCards)))
(SETQ Links (NC.CollectAndCheckLinks ID DatabaseStream ListOfValidCards))
(SETQ ToLinks (CONS (CONS ID Links)
ToLinks))
(SETQ GlobalLinks (CONS (CONS ID (NC.FetchGlobalLinks ID))
GlobalLinks))
(NC.DeactivateCard ID T))))
(* * Compute the From Links list by "inverting" the To Links list)
(NC.PrintMsg NIL T "Processing Links ... ")
(for Item in ToLinks do (for Link in (CDR Item)
do (SETQ Entry (FASSOC (fetch (NOTECARDLINK DESTINATIONID)
of Link)
FromLinks))
(COND
(Entry (NCONC1 Entry Link))
(T (SETQ FromLinks (CONS (LIST (fetch (NOTECARDLINK
DESTINATIONID)
of Link)
Link)
FromLinks))))))
(* Reset all of the To and From Links lists in the
database)
(NC.PrintMsg NIL T "Rewriting Links ... ")
(for NoteCardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
do (AND (ZEROP (IREMAINDER NoteCardNumber 10))
(NC.PrintMsg NIL T "Repairing NoteFile." (CHARACTER 13)
"Rewriting links for item " NoteCardNumber " out of " CardTotal "."
(CHARACTER 13)))
(SETQ ID (NC.IDFromNumber NoteCardNumber))
(COND
((FMEMB ID ActiveCardsList)
(NC.SetGlobalLinks ID (CDR (FASSOC ID GlobalLinks)))
(NC.SetToLinks ID (CDR (FASSOC ID ToLinks)))
(NC.SetFromLinks ID (CDR (FASSOC ID FromLinks)))
(NC.PutLinks ID DatabaseStream)
(NC.DeactivateCard ID T))))
(NC.CheckpointDatabase DatabaseStream T)
(NC.ForceDatabaseClose DatabaseStream)
(NC.PrintMsg NIL T "Repair Completed for " (FULLNAME DatabaseStream)
"."
(CHARACTER 13)))))
)
(* * 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: "28-Mar-85 11:34")
(* Cache or uncache all of the titles on DatabaseSteam
onto the prop lists of the NoteCard IDs)
(PROG (CardTotal Title)
(for CardNumber from 1 to (SETQ CardTotal (SUB1 (STREAMPROP DatabaseStream (QUOTE
NCNEXTIDNUM))))
do (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: "28-Mar-85 21:30")
(* * 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 (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: "28-Mar-85 13:03")
(* * 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 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: "17-Mar-85 16:33")
(* * Copy a notefile. Ask user for names of FromFileName and ToFileName.)
(PROG (FullFromFileName ToFileName)
(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 (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)))))))))
)
(PUTPROPS NCDATABASE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5334 55210 (NC.CoerceDatabaseStream 5344 . 5877) (NC.CreateDatabaseFile 5879 . 10516) (
NC.FetchMonitor 10518 . 11025) (NC.GetCachedMap 11027 . 11561) (NC.GetGraphSubstance 11563 . 11917) (
NC.GetIdentifier 11919 . 12605) (NC.GetLinks 12607 . 14733) (NC.GetLinkLabels 14735 . 16094) (
NC.GetNewID 16096 . 18184) (NC.GetNoteCard 18186 . 20995) (NC.GetPropList 20997 . 22663) (NC.GetPtrs
22665 . 23989) (NC.GetRegion 23991 . 24253) (NC.GetSketchSubstance 24255 . 25150) (NC.GetTextSubstance
25152 . 26576) (NC.GetTitle 26578 . 28191) (NC.GetTypeAndTitle 28193 . 29211) (NC.GetType 29213 .
30793) (NC.IndexFromID 30795 . 31147) (NC.InitializeSpecialCards 31149 . 33021) (NC.MarkCardDeleted
33023 . 33643) (NC.MarkIndexEntryFree 33645 . 34157) (NC.OpenDatabaseFile 34159 . 38388) (
NC.PutCachedMap 38390 . 39258) (NC.PutDeletedIdentifier 39260 . 39440) (NC.PutGraphSubstance 39442 .
40507) (NC.PutIdentifier 40509 . 40768) (NC.PutLinks 40770 . 42433) (NC.PutMainCardData 42435 . 43799)
(NC.PutLinkLabels 43801 . 44656) (NC.PutNoteCard 44658 . 46054) (NC.PutPropList 46056 . 47288) (
NC.PutRegion 47290 . 48068) (NC.MakeDummyRegion 48070 . 48381) (NC.PutSketchSubstance 48383 . 49692) (
NC.PutTextSubstance 49694 . 51314) (NC.PutTitle 51316 . 52481) (NC.SetMonitor 52483 . 52672) (
NC.UpdateRegionData 52674 . 54165) (NC.ValidID 54167 . 54613) (NC.ClearIDAtoms 54615 . 55208)) (56990
58160 (WRITE.FONTDESCRIPTOR 57000 . 57784) (READ.FONTINTODESCRIPTOR 57786 . 58158)) (58199 63773 (
NC.GetPtrsFromIndex 58209 . 59481) (NC.GetPtrFromIndex 59483 . 60035) (NC.GetStatusFromIndex 60037 .
60416) (NC.SetIndexOffset 60418 . 60668) (NC.GetIndexOffset 60670 . 60928) (NC.PutStatusToIndex 60930
. 61444) (NC.PutPtrToIndex 61446 . 61931) (NC.BuildIndexArray 61933 . 63017) (NC.IncreaseIndexArray
63019 . 63771)) (63816 72543 (NC.CheckForNeededTruncation 63826 . 66976) (NC.CheckpointDatabase 66978
. 69549) (NC.AbortSession 69551 . 71696) (NC.SaveDirtyCards 71698 . 72541)) (72575 82418 (
NC.ComputeNewDatabaseIndexSize 72585 . 73479) (NC.CopyAndCompactDatabase 73481 . 75755) (
NC.CopyNoteCard 75757 . 77454) (NC.FastCopyNoteCard 77456 . 80200) (NC.FastCompactDatabase 80202 .
82416)) (82460 106821 (NC.CompactDatabaseInPlace 82470 . 87174) (NC.ExpandIndexInPlace 87176 . 88346)
(NC.SortIndexEntries 88348 . 89603) (NC.CopyCardPart 89605 . 90898) (NC.CopyMainCardData 90900 . 93197
) (NC.CopyLinks 93199 . 96211) (NC.CopyTitle 96213 . 99227) (NC.CopyPropList 99229 . 102400) (
NC.CopyLinkLabels 102402 . 105111) (NC.IndexInFileFromID 105113 . 105486) (NC.MarkIndexEntryFreeInFile
105488 . 105952) (NC.CleanupIndexEntries 105954 . 106819)) (106855 118121 (NC.CollectAndCheckLinks
106865 . 109122) (NC.GetOldData 109124 . 111462) (NC.FindOldData 111464 . 111879) (NC.FindOldLinks
111881 . 112298) (NC.ReinstateNthInstance 112300 . 113499) (NC.ScavengeDatabaseFile 113501 . 118119))
(118197 138618 (NC.IndexFromIDVersion0 118207 . 118477) (NC.GetNoteCardVersion0 118479 . 123025) (
NC.OpenDatabaseFileVersion0 123027 . 125545) (NC.CacheTitlesVersion0 125547 . 126717) (
NC.GetTitleVersion0 126719 . 128329) (NC.GetLinkLabelsVersion0 128331 . 129582) (
NC.ConvertVersion0ToVersion1 129584 . 131913) (NC.CopyVersion0CardToVersion1Card 131915 . 135265) (
NC.GetGraphSubstanceVersion0 135267 . 136607) (NC.GetSketchSubstanceVersion0 136609 . 137426) (
NC.CheckForNeededConversion 137428 . 138616)) (138648 139799 (NC.CopyDatabase 138658 . 139797)))))
STOP