(FILECREATED "11-Feb-85 17:20:05" {PHYLUM}<NOTECARDS>RELEASE1.1>NCDATABASE.;14 93697
changes to: (FNS NC.GetIdentifier NC.GetTitle NC.PutTitle)
previous date: " 8-Feb-85 00:13:14" {PHYLUM}<NOTECARDS>RELEASE1.1>NCDATABASE.;13)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCDATABASECOMS)
(RPAQQ NCDATABASECOMS ((* * Internal variables)
(GLOBALVARS PSA.Database NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier NC.DatabaseFileNameSuggestion
NC.NextLinkID NC.VersionNumber NC.UncachingNotCompleted)
(VARS (PSA.Database NIL)
(NC.VersionNumber 1)
(NC.LinkLabelsIdentifier (QUOTE ###LABELS###))
(NC.LinksIdentifier (QUOTE ###LINKS###))
(NC.ItemIdentifier (QUOTE ###ITEM###))
(NC.TitlesIdentifier (QUOTE ###TITLES###))
(NC.PropsIdentifier (QUOTE ###PROPS###))
(NC.UncachingNotCompleted NIL))
(* * 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.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)
(* * Database compactor)
(FNS NC.ComputeNewDatabaseIndexSize NC.CopyAndCompactDatabase NC.CopyNoteCard
NC.FastCopyNoteCard NC.FastCompactDatabase)
(* * 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)))
(* * Internal variables)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PSA.Database NC.LinkLabelsIdentifier NC.LinksIdentifier NC.ItemIdentifier
NC.TitlesIdentifier NC.PropsIdentifier NC.DatabaseFileNameSuggestion NC.NextLinkID
NC.VersionNumber NC.UncachingNotCompleted)
)
(RPAQQ PSA.Database NIL)
(RPAQQ NC.VersionNumber 1)
(RPAQQ NC.LinkLabelsIdentifier ###LABELS###)
(RPAQQ NC.LinksIdentifier ###LINKS###)
(RPAQQ NC.ItemIdentifier ###ITEM###)
(RPAQQ NC.TitlesIdentifier ###TITLES###)
(RPAQQ NC.PropsIdentifier ###PROPS###)
(RPAQQ NC.UncachingNotCompleted NIL)
(* * 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)
(* fgh: " 8-Oct-84 19:20")
(* 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.)
(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)
20000))
(SETQ Stream (GETSTREAM (OPENFILE FileName (QUOTE OUTPUT))))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile " (FULLNAME Stream)
". Please wait... ")
(SETFILEPTR Stream 0)
(NC.PutPtr Stream 1 2)
(NC.PutPtr Stream NC.IndexSizeInEntries 2)
(NC.PutPtr Stream 1 3)
(NC.PutPtr Stream NC.VersionNumber 1)
(NC.PutPtr Stream -1 8)
(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))
(NC.ForceDatabaseClose Stream)
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile " (FULLNAME Stream)
". Please wait... ")
(NC.InitializeSpecialCards (SETQ PSA.Database (NC.OpenDatabaseFile FileName NIL T T)))
(* Reserve the first 20 index entries for special cards
& future expansion)
(SETFILEPTR PSA.Database 0)
(NC.PutPtr PSA.Database 21 2)
(NC.ForceDatabaseClose PSA.Database)
(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) (* fgh: " 6-Nov-84 22:35")
(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) (* fgh: " 5-Oct-84 19:41")
(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.GetPtrs ID Stream))
(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))
(SETQ FromLinks (READ Stream))
(SETQ GlobalLinks (LISTP (READ Stream)))
(* 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) (* fgh: " 5-Oct-84 19:55")
(* 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.IndexFromID NC.LinkLabelsID "NC.GetLinkLabels"))
(SETFILEPTR DatabaseStream Index)
(NC.GetStatus DatabaseStream)
(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.GetNewID
(LAMBDA (DatabaseStream DontUpdateFlg) (* rht: " 9-Jan-85 16:01")
(* * rht 1/9/85: Keep track of the total number of cards in NC.UncachingNotCompleted.)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(PROG (NextID (Stream (COND
((STREAMP DatabaseStream)
DatabaseStream)
((AND DatabaseStream (OPENP DatabaseStream (QUOTE BOTH)))
(GETSTREAM DatabaseStream))
(T (NC.ReportError "NC.GetNextID" (CONCAT DatabaseStream
" not a stream or file.")))))
)
(SETFILEPTR Stream 0)
(SETQ NC.UncachingNotCompleted (SETQ NextID (NC.GetPtr Stream 2)))
(COND
((NULL DontUpdateFlg)
(SETFILEPTR Stream 0)
(NC.PutPtr Stream (ADD1 NextID)
2)))
(RETURN (MKATOM (CONCAT "NC" (RPLSTRING (CONCAT "00000")
(IMINUS (NCHARS NextID))
NextID))))))))
(NC.GetNoteCard
(LAMBDA (ID DatabaseStream IncludeDeletedCardsFlg Ptr) (* fgh: "17-Oct-84 15:44")
(* 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 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.GetPtrs ID Stream))
(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: " 7-Nov-84 20:43")
(* Retrieve the prop list for card specified by ID from
the database specified by DatabaseStream)
(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.GetPtrs ID Stream))
(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: " 9-Apr-84 23:08")
(* Get a text stream from the database file)
(PROG (StartPtr EndPtr)
(SETQ StartPtr (NC.GetPtr DatabaseStream))
(SETQ EndPtr (NC.GetPtr DatabaseStream))
(RETURN (OPENTEXTSTREAM DatabaseStream NIL StartPtr EndPtr (LIST (QUOTE FONT)
PSA.TimesRoman10))))))
(NC.GetTitle
(LAMBDA (ID DatabaseStream TitlePtr NoReportFlg) (* rht: "11-Feb-85 15:40")
(* Retrieve title for card specified by ID from the
database specified by DatabaseStream)
(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.GetPtrs ID Stream))
(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) (* fgh: " 5-Oct-84 19:50")
(* Retrieve the type and title for card specified by ID
from the database specified by DatabaseStream)
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetTitle")
(PROG (PtrList Ptr TitlePtr Status Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetTitle"))
(SETQ PtrList (NC.GetPtrs ID Stream))
(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) (* fgh: " 5-Oct-84 19:46")
(* Retrieve the NoteCardType of card specified by ID
from the database specified by DatabaseStream)
(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.GetPtrs ID DatabaseStream))
(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) (* fgh: " 5-Oct-84 19:09")
(LSH (COND
((NC.IDP ID)
(SUBATOM ID 3))
(T (NC.ReportError FromFunction (CONCAT ID ": Invalid ID"))))
4)))
(NC.InitializeSpecialCards
(LAMBDA (DatabaseStream) (* rht: " 3-Dec-84 15:38")
(* 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.GetNewID DatabaseStream))
(Orphan (NC.GetNewID DatabaseStream))
(Unclassified (NC.GetNewID DatabaseStream))
(LinkLabels (NC.GetNewID DatabaseStream))) (* 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) (* fgh: "19-Oct-84 15:17")
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GetNoteCard")
(PROG (Index Ptr LinksPtr Status ActualID Stream PtrList)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.GetNoteCard"))
(SETQ PtrList (NC.GetPtrs ID DatabaseStream))
(SETQ Status (fetch (POINTERLIST STATUS) of PtrList))
(SETQ Ptr (fetch (POINTERLIST MAINPTR) of PtrList))
(SETQ Index (fetch (POINTERLIST INDEXPTR) of PtrList))
(COND
((NEQ Status (QUOTE ACTIVE))
(RETURN Status))
(T (* Get Substance)
(SETFILEPTR Stream Ptr)
(COND
((NOT (NC.GetIdentifier Stream NC.ItemIdentifier))
(NC.ReportError "NC.MarkCardDeleted" (CONCAT ID
" Error in Database file -- incorrect item identifier."))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.MarkCardDeleted" (CONCAT
"ID mismatch while reading item. Expected ID: "
ID " Found ID: "
ActualID))))
(SETFILEPTR Stream Ptr)
(NC.PutDeletedIdentifier Stream)
(SETFILEPTR Stream Index)
(NC.PutStatus Stream DELETED)
(RETURN ID)))))))
(NC.MarkIndexEntryFree
(LAMBDA (ID DatabaseStream) (* fgh: "19-Nov-84 17:42")
(PROG (Index)
(SETQ Index (NC.IndexFromID ID))
(SETFILEPTR DatabaseStream Index)
(NC.PutStatus DatabaseStream FREE)
(NC.PutPtr DatabaseStream -1)
(NC.PutPtr DatabaseStream -1)
(NC.PutPtr DatabaseStream -1)
(NC.PutPtr DatabaseStream -1))))
(NC.OpenDatabaseFile
(LAMBDA (FileName Access NoSetFlg QuietFlg Don'tCreateFlg Convertw/oConfirmFlg)
(* rht: " 8-Feb-85 00:12")
(* 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)
(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))))
(if NC.UncachingNotCompleted
then (NC.ClearIDAtoms NC.UncachingNotCompleted))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opening ... " (CHARACTER 13)))
(SETQ Stream (OPENSTREAM Name (OR Access (QUOTE BOTH))
(QUOTE OLD)))
(NC.SetMonitor Stream (CREATE.MONITORLOCK (MKATOM (CONCAT Name ":LOCK"))))
(COND
((NULL (SETQ NewStream (NC.CheckForNeededConversion Stream Access Convertw/oConfirmFlg)))
(CLOSEF Stream)
(RETURN NIL))
(T (NC.SetMonitor NewStream (NC.FetchMonitor Stream))
(SETQ Stream NewStream)))
(SETFILEPTR Stream 0)
(NC.GetPtr Stream 2)
(SETTOPVAL (QUOTE NC.IndexSizeInEntries)
(NC.GetPtr Stream 2))
(SETQ NC.NextLinkID (NC.GetPtr Stream))
(NC.PutPtr Stream NC.VersionNumber 1)
(* * If the next link id on the disk is divisble by 100 then system must have crashed without closing database file.
In this case bump up the next link id to insure no conflicts)
(COND
((ZEROP (IREMAINDER NC.NextLinkID 100))
(SETQ NC.NextLinkID (IPLUS 101 NC.NextLinkID))))
(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) (* fgh: " 2-Apr-84 12:52")
(* Put a cached bit map corresponding to MapScreenElt
onto database file)
(PROG (CacheSpecs BitMap)
(AND (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) (* fgh: " 6-Nov-84 22:35")
(* 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) (* fgh: " 5-Oct-84 21:47")
(* * Put the link data for ID onto the database 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.)
(SETFILEPTR Stream Index)
(COND
((NOT (EQ (NC.GetStatus 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.)
(SETFILEPTR Stream Index)
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream DataPtr)
(RETURN ID)))))
(NC.PutLinkLabels
(LAMBDA (DatabaseStream LinkLabels) (* fgh: " 5-Oct-84 21:42")
(* 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)
(SETFILEPTR DatabaseStream (NC.IndexFromID NC.LinkLabelsID))
(NC.PutStatus DatabaseStream SPECIAL)
(NC.PutPtr DatabaseStream Ptr)))))
(NC.PutNoteCard
(LAMBDA (ID DatabaseStream UpdateUpdateListFlg) (* fgh: "10-Oct-84 20:09")
(* * 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"))
(SETFILEPTR Stream Index)
(NC.PutStatus Stream ACTIVE)
(NC.PutPtr Stream DataPtr)
(RETURN ID)))))
(NC.PutPropList
(LAMBDA (ID DatabaseStream) (* fgh: " 5-Oct-84 22:29")
(* * 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"))
(SETFILEPTR Stream Index)
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.PutPtr Stream DataPtr)
(NC.SetPropListDirtyFlg ID NIL)
(RETURN ID)))))
(NC.PutRegion
(LAMBDA (ID DatabaseStream) (* rht: "15-Dec-84 23:01")
(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 (NC.FetchType ID)))))
(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 (Type) (* rht: " 3-Jan-85 21:22")
(* * Returns a region based at (0 0) with default width and height according to Type.)
(SELECTQ Type
(FileBox (CREATEREGION 0 0 PSA.ContentsCardDefaultWidth PSA.ContentsCardDefaultHeight))
(Sketch (CREATEREGION 0 0 PSA.SketchCardDefaultWidth PSA.SketchCardDefaultHeight))
(Graph (CREATEREGION 0 0 PSA.GraphCardDefaultWidth PSA.GraphCardDefaultHeight))
(Browser (CREATEREGION 0 0 NC.BrowserCardDefaultWidth NC.BrowserCardDefaultHeight))
(CREATEREGION 0 0 PSA.TEditCardDefaultWidth PSA.TEditCardDefaultHeight))))
(NC.PutSketchSubstance
(LAMBDA (ID DatabaseStream) (* fgh: "17-Oct-84 14:39")
(* 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 "###ENDSKETCH###" DatabaseStream)
(SETQ EndPtr (GETFILEPTR DatabaseStream))
(SETFILEPTR DatabaseStream EndPtrLoc)
(NC.PutPtr DatabaseStream EndPtr))))
(NC.PutTextSubstance
(LAMBDA (ID DatabaseStream) (* fgh: "26-Oct-84 18:58")
(* Put text substance from card ID on the database
file)
(PROG ((Substance (NC.FetchSubstance ID))
EndPtr EndPtrLoc StartPtr TempStream TempFile)
(SETQ StartPtr (IPLUS (GETFILEPTR DatabaseStream)
6))
(NC.PutPtr DatabaseStream StartPtr)
(SETQ EndPtrLoc (GETFILEPTR DatabaseStream))
(NC.PutPtr DatabaseStream 0) (* Put textstream to temp file)
(SETQ TempStream (GETSTREAM (SETQ TempFile (OPENFILE (PACK* (QUOTE {CORE}NC)
(GENSYM))
(QUOTE OUTPUT)))))
(AND (ZEROP (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ Substance)))
(TEDIT.INSERT Substance " " 1))
(TEDIT.PUT.PCTB (TEXTOBJ Substance)
TempStream)
(SETFILEPTR DatabaseStream StartPtr) (* Copy temp file to database file fixing up pointers
on the way)
(SETQ TempStream (GETSTREAM (OPENFILE (CLOSEF TempFile)
(QUOTE INPUT))))
(COND
((IGREATERP (GETEOFPTR TempStream)
2)
(SETFILEPTR TempStream (IDIFFERENCE (GETEOFPTR TempStream)
2))
(COND
((FMEMB (\WIN TempStream)
(QUOTE (31415 31416)))
(COPYBYTES TempStream DatabaseStream 0 (IDIFFERENCE (GETEOFPTR TempStream)
8))
(\DWOUT DatabaseStream (IPLUS (\DWIN TempStream)
StartPtr))
(RPTQ 2 (\WOUT DatabaseStream (\WIN TempStream))))
(T (SETFILEPTR TempStream 0)
(COPYBYTES TempStream DatabaseStream))))
(T (SETFILEPTR TempStream 0)
(COPYBYTES TempStream DatabaseStream)))
(SETQ EndPtr (GETFILEPTR DatabaseStream))
(SETFILEPTR DatabaseStream EndPtrLoc)
(NC.PutPtr DatabaseStream EndPtr)
(DELFILE (CLOSEF TempFile)) (* Fix up PCTB of Substance in case want to go on
editing.)
(TEDIT.MAPPIECES (TEXTOBJ Substance)
(FUNCTION (LAMBDA (CH# PC PC# OBL)
(PROG (PFile)
(COND
((AND (SETQ PFile (fetch (PIECE PFILE) of PC))
(EQ (FULLNAME PFile)
(FULLNAME TempStream)))
(replace (PIECE PFILE) of PC with DatabaseStream)
(replace (PIECE PFPOS) of PC
with (IPLUS StartPtr (fetch (PIECE PFPOS) of PC)))))))))))
)
(NC.PutTitle
(LAMBDA (ID DatabaseStream) (* rht: "11-Feb-85 15:41")
(* * 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"))
(SETFILEPTR Stream Index)
(NC.GetStatus Stream)
(NC.GetPtr Stream)
(NC.GetPtr Stream)
(NC.PutPtr 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) (* fgh: " 5-Oct-84 20:05")
(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.GetPtrs ID Stream))
(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: "29-Oct-84 01:05")
(* * Is ID a currently extant card or box?)
(AND (NC.IDP ID)
(OR (EQ (QUOTE ACTIVE)
(fetch (POINTERLIST STATUS) of (NC.GetPtrs ID PSA.Database)))
(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))))
)
(* * Database compactor)
(DEFINEQ
(NC.ComputeNewDatabaseIndexSize
(LAMBDA (FromStream) (* Feuerman "29-Feb-84 09:44")
(* 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
((GREATERP NumberOfCurrentIndices (FIX (TIMES .75 CurrentIndexSize)))
(RETURN (ITIMES 2 CurrentIndexSize)))
(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) (* fgh: "23-Oct-84 19:40")
(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 Ptr))
(* 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) (* fgh: "23-Oct-84 11:41")
(* * Copy a card from FromStream to ToStream. Call on the type-specific byte-wise copy fns for copying the actual
substances.)
(PROG (PtrList DebugFlg Status NoteCardType MainPtr)
(SETQ PtrList (NC.GetPtrs ID FromStream))
(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)
(SETFILEPTR ToStream (fetch (POINTERLIST INDEXPTR) of PtrList))
(NC.PutStatus ToStream ACTIVE)
(NC.PutPtr 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)
(* fgh: "17-Oct-84 16:03")
(* * 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 ID TotalCount)
(SETQ FromStream (NC.OpenDatabaseFile FromDatabaseName (QUOTE INPUT)
T NIL T))
(AND (NULL FromStream)
(RETURN))
(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.FastCopyNoteCard ID FromStream ToStream))))
(CLOSEW (WFROMDS (TTYDISPLAYSTREAM)))
(SETQ PSA.Database)
(RETURN (LIST (NC.ForceDatabaseClose FromStream)
(NC.ForceDatabaseClose ToStream))))))
)
(* * Scavenger mechanisms)
(DEFINEQ
(NC.CollectAndCheckLinks
(LAMBDA (ID DatabaseStream ListOfValidCards) (* fgh: "23-Oct-84 11:54")
(* 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
(OR (LISTP ListOfValidCards)
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) (* fgh: "21-Mar-84 12:17")
(SETFILEPTR DatabaseStream 0)
(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) (* fgh: "21-Mar-84 13:56")
(SETFILEPTR DatabaseStream 0)
(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) (* fgh: "17-Oct-84 17:21")
(* 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.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)
(* NoteCards% User " 8-Oct-84 11:20")
(* 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)
(NC.GetPtr Stream 2)
(SETTOPVAL (QUOTE NC.IndexSizeInEntries)
(NC.GetPtr Stream 2))
(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)
(* NoteCards% User " 8-Oct-84 11:17")
(* 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 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
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)
(* fgh: " 1-Nov-84 14:41")
(* * 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))
(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")
(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 "Converting NoteFile" (CHARACTER 13)
"Copying item " CTR " of " TotalCount "." (CHARACTER 13))
(NC.CopyVersion0CardToVersion1Card ID FromStream ToStream IncludeDeleteCardsFlg)))
)
(NC.CacheTypesAndTitles FromStream T T)
(SETQ PSA.Database)
(NC.ForceDatabaseClose ToStream)
(NC.ForceDatabaseClose FromStream)
(NC.ScavengeDatabaseFile (FULLNAME ToStream))
(RETURN (LIST (FULLNAME FromStream)
(FULLNAME ToStream))))))
(NC.CopyVersion0CardToVersion1Card
(LAMBDA (ID FromStream ToStream IncludeDeleteCardsFlg) (* fgh: " 5-Nov-84 17:51")
(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 NIL T))
do (SETQ OldLink (NC.FetchLinkFromLinkIcon LinkIcon))
(NC.SetLinkInLinkIcon LinkIcon (create NOTECARDLINK
LINKID ←(NC.GetNewLinkID ToStream)
SOURCEID ← ID
DESTINATIONID ←(CAR OldLink)
ANCHORMODE ← NIL
DISPLAYMODE ←(CADDR OldLink)
LINKLABEL ←(CADR OldLink))))
(* * Put the partially converted card onto the ToStream)
(NC.PutNoteCard ID ToStream)
(NC.PutTitle ID ToStream)
(NC.PutPropList ID ToStream)
(NC.PutLinks ID ToStream)
(SETQ Window (NC.FetchWindow ID))
(AND (OPENWP Window)
(CLOSEW Window)))
(T (NC.MarkIndexEntryFree ID ToStream)
(AND DebugFlg (PRINT (CONCAT "Not Copied: " ID " Status: " Status)))))
(NC.DeactivateCard ID))))
(NC.GetGraphSubstanceVersion0
(LAMBDA (DatabaseStream) (* fgh: "13-Nov-84 20:46")
(PROG (Graph Anno) (* Read the Graph)
(SETQ Graph (HREAD DatabaseStream)) (* Then read the annotations)
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
do (AND (LITATOM (fetch (GRAPHNODE NODEID) of GraphNode))
(PUTPROP (fetch (GRAPHNODE NODEID) of GraphNode)
(QUOTE Annotation)
(HREAD DatabaseStream))))
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
do (AND (LITATOM (fetch (GRAPHNODE NODEID) of GraphNode))
(SETQ Anno (GETPROP (fetch (GRAPHNODE NODEID) of GraphNode)
(QUOTE Annotation)))
(OR (replace (GRAPHNODE NODELABEL) of GraphNode
with (COND
((type? ANNO Anno)
(NC.MakeLinkIcon (fetch (ANNONOTECARDSUBSTANCE ANNONOTECARDSPEC)
of (fetch (ANNO ANNO\SUBSTANCE)
of Anno))))
(T Anno)))
T)
(REMPROP (fetch (GRAPHNODE NODEID) of GraphNode)
(QUOTE Annotation))))
(RETURN Graph))))
(NC.GetSketchSubstanceVersion0
(LAMBDA (DatabaseStream) (* fgh: "17-Oct-84 14:46")
(* Get sketch substance from Database stream. Database stream is positioned. READ the global sketch description, the
locasl sketch scale and region viewed. Also read in any cached bit maps for the MAPS system.)
(PROG (Sketch Scale RegionViewed)
(* * Get the substance)
(SETQ Sketch (HREAD DatabaseStream))
(SETQ Scale (READ DatabaseStream))
(SETQ RegionViewed (READ DatabaseStream))
(while (EQ (READ DatabaseStream)
(QUOTE ###CACHEDMAP###))
do (NC.GetCachedMap DatabaseStream))
(RETURN (LIST Sketch Scale RegionViewed)))))
(NC.CheckForNeededConversion
(LAMBDA (DatabaseStream Access Convertw/oConfirmFlg) (* rht: "30-Nov-84 17:20")
(* * 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 1 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))))
)
(PUTPROPS NCDATABASE COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3991 49626 (NC.CoerceDatabaseStream 4001 . 4534) (NC.CreateDatabaseFile 4536 . 7931) (
NC.FetchMonitor 7933 . 8440) (NC.GetCachedMap 8442 . 8976) (NC.GetGraphSubstance 8978 . 9332) (
NC.GetIdentifier 9334 . 10020) (NC.GetLinks 10022 . 11729) (NC.GetLinkLabels 11731 . 12976) (
NC.GetNewID 12978 . 13999) (NC.GetNoteCard 14001 . 16711) (NC.GetPropList 16713 . 18280) (NC.GetPtrs
18282 . 19606) (NC.GetRegion 19608 . 19870) (NC.GetSketchSubstance 19872 . 20767) (NC.GetTextSubstance
20769 . 21278) (NC.GetTitle 21280 . 22794) (NC.GetTypeAndTitle 22796 . 23715) (NC.GetType 23717 .
25206) (NC.IndexFromID 25208 . 25470) (NC.InitializeSpecialCards 25472 . 27407) (NC.MarkCardDeleted
27409 . 28909) (NC.MarkIndexEntryFree 28911 . 29358) (NC.OpenDatabaseFile 29360 . 33342) (
NC.PutCachedMap 33344 . 34124) (NC.PutDeletedIdentifier 34126 . 34306) (NC.PutGraphSubstance 34308 .
35373) (NC.PutIdentifier 35375 . 35634) (NC.PutLinks 35636 . 37155) (NC.PutLinkLabels 37157 . 37971) (
NC.PutNoteCard 37973 . 39328) (NC.PutPropList 39330 . 40492) (NC.PutRegion 40494 . 41210) (
NC.MakeDummyRegion 41212 . 41913) (NC.PutSketchSubstance 41915 . 43211) (NC.PutTextSubstance 43213 .
45983) (NC.PutTitle 45985 . 47093) (NC.SetMonitor 47095 . 47284) (NC.UpdateRegionData 47286 . 48678) (
NC.ValidID 48680 . 49029) (NC.ClearIDAtoms 49031 . 49624)) (51406 52576 (WRITE.FONTDESCRIPTOR 51416 .
52200) (READ.FONTINTODESCRIPTOR 52202 . 52574)) (52608 61984 (NC.ComputeNewDatabaseIndexSize 52618 .
53340) (NC.CopyAndCompactDatabase 53342 . 55616) (NC.CopyNoteCard 55618 . 57319) (NC.FastCopyNoteCard
57321 . 59849) (NC.FastCompactDatabase 59851 . 61982)) (62018 73199 (NC.CollectAndCheckLinks 62028 .
64347) (NC.GetOldData 64349 . 66687) (NC.FindOldData 66689 . 67058) (NC.FindOldLinks 67060 . 67431) (
NC.ReinstateNthInstance 67433 . 68632) (NC.ScavengeDatabaseFile 68634 . 73197)) (73275 93611 (
NC.IndexFromIDVersion0 73285 . 73555) (NC.GetNoteCardVersion0 73557 . 78103) (
NC.OpenDatabaseFileVersion0 78105 . 80492) (NC.CacheTitlesVersion0 80494 . 81664) (NC.GetTitleVersion0
81666 . 83276) (NC.GetLinkLabelsVersion0 83278 . 84529) (NC.ConvertVersion0ToVersion1 84531 . 86913)
(NC.CopyVersion0CardToVersion1Card 86915 . 90258) (NC.GetGraphSubstanceVersion0 90260 . 91600) (
NC.GetSketchSubstanceVersion0 91602 . 92419) (NC.CheckForNeededConversion 92421 . 93609)))))
STOP