(FILECREATED " 8-Jan-86 23:13:35" {QV}<NOTECARDS>1.3K>RHTPATCH021.;2 22325
changes to: (VARS RHTPATCH021COMS)
previous date: " 8-Jan-86 18:47:54" {QV}<NOTECARDS>1.3K>RHTPATCH021.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH021COMS)
(RPAQQ RHTPATCH021COMS ((* * This stuff fixes some of the efficiency and gc problems. e.g. we
should no longer be leaving around un-gc'able cycles.)
(* * New functions for NCDATABASE)
(FNS NC.NoteFileFromFileName NC.CleanupCardObjects)
(* * Redefined functions from NCDATABASE)
(FNS NC.OpenDatabaseFile NC.CreateDatabaseFile NC.ForceDatabaseClose
NC.CloseDatabaseFile NC.AbortSession)))
(* * This stuff fixes some of the efficiency and gc problems. e.g. we should no longer be
leaving around un-gc'able cycles.)
(* * New functions for NCDATABASE)
(DEFINEQ
(NC.NoteFileFromFileName
(LAMBDA (FileName) (* rht: " 7-Jan-86 18:21")
(* * Return the notefile object for the given file name or NIL if none. Done by checking notefiles hash array.)
(LET ((FullFileName (FULLNAME FileName)))
(for NoteFile in (NC.ListOfNoteFiles) when (EQ FullFileName (fetch (NoteFile
FullFileName)
of NoteFile))
do (RETURN NoteFile)))))
(NC.CleanupCardObjects
(LAMBDA (HashArray) (* rht: " 8-Jan-86 16:34")
(* * For every cardobject in HashArray, smash CardCache and UserData fields cause they might cause circular links.)
(MAPHASH HashArray (FUNCTION (LAMBDA (Card Key)
(replace (Card CardCache) of Card with NIL)
(replace (Card UserData) of Card with NIL))))))
)
(* * Redefined functions from NCDATABASE)
(DEFINEQ
(NC.OpenDatabaseFile
(LAMBDA (NoteFileOrFileName Access Don'tCacheTypesAndTitlesFlg QuietFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Don'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg)
(* rht: " 8-Jan-86 15:15")
(* * Open an already existing NoteFile and return a NoteFile object)
(* * rht 8/7/84: For nonexistent files, asks user whether to create unless Don'tCreateFlg is non-nil.)
(* * rht 1/9/85: Checks NC.UncachingNotCompleted global var. If non-nil, then previous notefile died unnaturally,
so we first clear junk off the IDs.)
(* * rht 8/6/85: Added Don'tTruncateFlg, which, if on, prevents the check for truncation.)
(* * fgh 10/16/85 Updated to use new cacheing scheme.)
(* * kirk 10/29/85: Now does cacheing of types and titles as background process.)
(* * fkr 11/8/85: Converted from Streams to NoteFile object.)
(* * kirk 30Nov85 Added a check for correct version number.)
(* * rht 12/6/85: Moved Kirk's above patch to NC.CheckForNeededConversion and modified somewhat.
Added check for plausible header.)
(* * rht 1/8/86: Now reuses old notefile object if there is one for this filename.)
(PROG (NoteFile FileName Name Stream NewStream Card CardTotal)
(OR Access (SETQ Access (QUOTE BOTH)))
(SETQ FileName (COND
((type? NoteFile NoteFileOrFileName)
(SETQ NoteFile NoteFileOrFileName)
(fetch (NoteFile FullFileName) of NoteFileOrFileName))
(T NoteFileOrFileName)))
(if (NOT (OR FileName (SETQ FileName (NC.DatabaseFileName
"Name of NoteFile to open:"
" -- " T))))
then (RETURN NIL))
(if (OPENP FileName)
then (NC.PrintMsg NIL T FileName " is an already open file." (CHARACTER 13))
(RETURN NIL))
(if (NOT (SETQ Name (INFILEP FileName)))
then (COND
(Don'tCreateFlg (NC.PrintMsg NIL T "Couldn't find NoteFile " FileName "."
(CHARACTER 13))
(RETURN NIL))
((NC.YesP (NC.AskUser (CONCAT "Unable to find NoteFile " FileName "."
(CHARACTER 13)
"Want to create new NoteFile by that name? ")
" -- " "Yes" T NIL T NIL T))
(SETQ NoteFile (NC.CreateDatabaseFile FileName NIL "Opening NoteFile"
T))
(if (NOT (type? NoteFile NoteFile))
then (NC.PrintMsg NIL T "Unable to create Notefile " FileName "."
(CHARACTER 13))
(RETURN NIL)))
(T (RETURN NIL))))
(OR QuietFlg (NC.PrintMsg NIL T "Opening ... " (CHARACTER 13)))
(if (NULL (SETQ Stream (CAR (ERSETQ (OPENSTREAM Name Access (QUOTE OLD)
(QUOTE ((TYPE BINARY))))))))
then (NC.PrintMsg NIL T "Couldn't open " FileName "." (CHARACTER 13))
(RETURN NIL)) (* Use existing notefile object if there is one for
this file name.)
(OR (type? NoteFile NoteFile)
(SETQ NoteFile (OR (NC.NoteFileFromFileName FileName)
(create NoteFile))))
(replace (NoteFile Stream) of NoteFile with Stream)
(replace (NoteFile FullFileName) of NoteFile with (FULLNAME Stream))
(NC.SetMonitor NoteFile (CREATE.MONITORLOCK (MKATOM (CONCAT Name ":LOCK"))))
(NC.GetNoteFileHeader NoteFile) (* See if notefile is out of date.
If so, convert to current version.)
(if (NOT (NC.CheckForNeededConversion NoteFile Convertw/oConfirmFlg))
then (CLOSEF (fetch (NoteFile Stream) of NoteFile))
(NC.PrintMsg NIL T "Open cancelled.")
(RETURN NIL)) (* See if notefile header seems reasonable.
If not, bail out.)
(if (NOT (NC.PlausibleNoteFileHeaderP NoteFile))
then (NC.PrintMsg NIL NIL
"Notefile has bad header. Please see a NoteCards wizard."
(CHARACTER 13)
"Open cancelled.")
(RETURN NIL))
(COND
((NULL Don'tTruncateFlg) (* Can either bail out entirely or run inspector and
then bail out.)
(SELECTQ (SETQ NewStream (NC.CheckForNeededTruncation NoteFile Access))
(ABORT (CLOSEF Stream)
(NC.PrintMsg NIL T "Open cancelled.")
(RETURN NIL))
(ABORTANDINSPECT (CLOSEF Stream)
(NC.ScavengerPhase1 Name)
(RETURN NIL))
NIL)
(AND (STREAMP NewStream)
(replace (NoteFile Stream) of NoteFile with NewStream))))
(OR Don'tCreateArrayFlg (NC.BuildHashArray NoteFile))
(* * Make sure the NF can't be closed by CLOSEALL)
(WHENCLOSE (fetch (NoteFile Stream) of NoteFile)
(QUOTE CLOSEALL)
(QUOTE NO))
(COND
((NULL Don'tCacheTypesAndTitlesFlg) (* Cache all of the titles in this database)
(replace (NoteFile CachingProcess) of NoteFile
with (ADD.PROCESS (LIST (FUNCTION NC.CacheTypesAndTitles)
NoteFile)))))
(* Stash the special cards into the NoteFile object.)
(OR Don'tGetSpecialCardsFlg (NC.GetSpecialCards NoteFile))
(* Stash the notefile in the global notefiles hash
array.)
(NC.StoreNoteFile NoteFile)
(COND
((NULL Don'tCreateInterfaceFlg) (* Make an interface menu for this notefile.)
(NC.SetUpNoteFileInterface NoteFile)))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opened " (FULLNAME Stream)
(CHARACTER 13)))
(SETQ NC.LastNoteFileOpened NoteFile)
(RETURN NoteFile))))
(NC.CreateDatabaseFile
(LAMBDA (FileName HashArraySize CallingOperationMsg OmitFinalNoteFlg StartingNextFreeIndex
NoSpecialCardsFlg) (* rht: " 8-Jan-86 15:21")
(* * Create a NoteCards database on file FileName. Just creates an index HashArraySize 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 HashArraySize 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.)
(* * fkr 11/8/85: Added check that OPENSTREAM succeeded. Added call to NC.CreateNoteFileObject in which lots of
work is now being done.)
(* * fgh 11/17/85 Wrapped whole thing in ERSETQ to close file if somethinghappens during the create.)
(* * kirk 26Dec85 Added NoSpecialCardsFlg flag for use by Compact to target file.)
(* * rht 1/8/86: Now reuses old notefile object if there is one for this file name.)
(LET (Stream NoteFile)
(OR (CAR (ERSETQ (PROG NIL
(SETQ CallingOperationMsg (COND
(CallingOperationMsg (CONCAT CallingOperationMsg
(CHARACTER 13)))
(T "")))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to be created?"
" -- "
T T)))
(RETURN (QUOTE CANCELLED)))
(OR (FIXP HashArraySize)
(SETQ HashArraySize NC.DefaultIndexSizeInEntries))
(COND
((NULL (SETQ Stream
(CAR (ERSETQ (OPENSTREAM
FileName
(QUOTE BOTH)
(QUOTE NEW)
(QUOTE ((TYPE BINARY))))))))
(NC.PrintMsg NIL T "Can't open file: " FileName
(CHARACTER 13)
"Create cancelled."
(CHARACTER 13))
(RETURN (QUOTE CANCELLED))))
(RESETSAVE NIL (BQUOTE (PROGN (CLOSEF , Stream)
(DELFILE (FULLNAME
, Stream)))))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile "
(FULLNAME Stream)
". Please wait... ")
(SETQ NoteFile (OR (NC.NoteFileFromFileName FileName)
(create NoteFile)))
(create NoteFile
smashing NoteFile UID ←(NC.MakeUID)
Stream ← Stream FullFileName ←(FULLNAME
Stream)
HashArray ←(HASHARRAY HashArraySize)
HashArraySize ← HashArraySize NextIndexNum ←(
OR (FIXP StartingNextFreeIndex)
(CONSTANT (ADD1 (fetch
(NoteFileVersion
NumberOfReservedCards)
of (
NC.FetchCurrentVersionObject)))
))
Version ← NC.VersionNumber NextLinkNum ← 1
CheckptPtr ←(NC.TotalIndexSize HashArraySize)
MonitorLock ←(CREATE.MONITORLOCK
(QUOTE Creating)))
(* Write the header down to the file.)
(NC.PutNoteFileHeader NoteFile)
(for CTR from 1 to HashArraySize eachtime (BLOCK)
do (AND (ZEROP (IREMAINDER CTR 1000))
(NC.PrintMsg NIL T CallingOperationMsg
"Creating NoteFile."
(CHARACTER 13)
"Processing item " CTR
" out of "
HashArraySize "." (CHARACTER
13)))
(NC.WriteStatus Stream (QUOTE FREE))
(SETFILEPTR
Stream
(PLUS (GETFILEPTR Stream)
(CONSTANT (SUB1 (fetch (
NoteFileVersion NoteFileIndexWidth) of (NC.FetchCurrentVersionObject)))))))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile "
(FULLNAME Stream)
". Please wait... ")
(* Move NextIndexNum back to the beginning so that
special cards will have the correct index nums.)
(replace (NoteFile NextIndexNum) of NoteFile
with 1)
(OR NoSpecialCardsFlg (NC.InitializeSpecialCards NoteFile)
)
(NC.CheckpointDatabase NoteFile T)
(NC.ForceDatabaseClose NoteFile)
(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))))
(RETURN NoteFile))))
(CLOSEF Stream (DELFILE (FULLNAME Stream)))
(QUOTE CANCELLED)))))
(NC.ForceDatabaseClose
(LAMBDA (NoteFile Don'tMenuFlg) (* rht: " 8-Jan-86 16:35")
(* * Really close the database, i.e.. bypass the ADVISE on CLOSEF that prevents closing of the database.)
(* * rht 1/10/85: Note new kludgey call to \UPDATEOF recommended by Tayloe to avoid truncation problems.)
(* * rht 2/5/85: Added resetting of NC.UncachingNotCompleted here so it will happen after compact, repair, etc.)
(* * rht 7/9/85: Added resetting of NC.LinkLabelsDate.)
(* * rht 11/10/85: Updated to incorporate new NoteFile scheme.)
(* * kirk 31Dec85: added Don'tMenuFlg)
(* * rht 1/8/86: Now smashes old notefile object to remove cycles. Don't you love interlisp gc'er?)
(CLOSEF (fetch (NoteFile Stream) of NoteFile)) (* Smash the cardcache and userdata fields of all card
objects for this notefile to remove circular links.)
(ADD.PROCESS (LIST (FUNCTION NC.CleanupCardObjects)
(fetch (NoteFile HashArray) of NoteFile)))
(replace (NoteFile Stream) of NoteFile with NIL) (* Smash the notefile object so we don't have cycles -
card -> notefile -> card.)
(create NoteFile smashing NoteFile UID ←(fetch (NoteFile UID) of NoteFile)
FullFileName ←(fetch (NoteFile FullFileName) of NoteFile))
(* Usually we leave shell in notefiles hash array so
there's a record.)
(if Don'tMenuFlg
then (NC.RemoveNoteFile NoteFile))
NoteFile))
(NC.CloseDatabaseFile
(LAMBDA (NoteFile) (* rht: " 8-Jan-86 17:08")
(* Close the currently open database file.)
(* * rht 10/23/84: Now gives user option of closing and saving all open cards on the screen.)
(* * rht 11/8/84: Put RESETLST around NC.CacheTitles call.)
(* * rht 1/9/85: Clear the NC.UncachingNotCompleted variable when close successfully completes.)
(* * rht 1/31/85: Added call to checkpoint database. That in turn dumps the next nodeID and next linkID.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh 10/16/85 removed call to CacheTypesAndTitles because uncacheing now done automatically by cache
mechanism.)
(* * fkr 10/29/85: Now kills caching process from database streamprop.)
(* * fkr 11/8/85 Updated to handle new NoteFile object and new CardID scheme.)
(PROG ((Stream (fetch (NoteFile Stream) of NoteFile))
FileName CardTotal OpenWindows)
(COND
((OR (NULL (STREAMP Stream))
(NOT (OPENP Stream)))
(NC.PrintMsg NIL T (fetch (NoteFile FullFileName) of NoteFile)
" is not an open NoteFile!!!"
(CHARACTER 13)))
(T (COND
((SETQ OpenWindows (bind Card for Window in (OPENWINDOWS)
when (AND (NC.ActiveCardP
(SETQ Card
(OR (NC.CoerceToCard Window)
(NC.CoerceToCard
(WINDOWPROP Window
(QUOTE ICONFOR)))
)))
(NC.SameNoteFileP NoteFile
(fetch (Card NoteFile)
of Card)))
collect Window))
(NC.PrintMsg NIL T "There are cards in NoteFile " (fetch (NoteFile
FullFileName)
of NoteFile)
" still active on the screen."
(CHARACTER 13))
(COND
((NC.YesP (NC.AskUser "Want to close and save them? " " -- " (QUOTE
Yes)
NIL NIL NIL NIL T))
(NC.PrintMsg NIL T "Closing and saving active cards ... ")
(RESETLST (RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceFilingFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(for Window in OpenWindows
do (COND
((WINDOWPROP Window (QUOTE ICONFOR))
(SETQ Window (EXPANDW Window))))
(NC.QuitCard (NC.CoerceToCard Window)
T)
(bind (Process ←(WINDOWPROP Window (QUOTE PROCESS))
)
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK))))
(NC.PrintMsg NIL NIL "Done." (CHARACTER 13)))
(T (RETURN NIL)))))
(NC.PrintMsg NIL T "Closing Notefile ... " (CHARACTER 13))
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(* Delete the types and titles caching process if
still alive.)
(NC.CheckpointDatabase NoteFile)
(SETQ FileName (fetch (NoteFile FullFileName) of NoteFile))
(* * Set DatabaseStream GlobalVar to NIL so that the advise to CLOSEF will not refuse to close this file.)
(NC.ResetNoteFileInterface NoteFile)
(NC.ForceDatabaseClose NoteFile)
(NC.PrintMsg NIL T FileName " closed."))))))
(NC.AbortSession
(LAMBDA (NoteFile) (* rht: " 8-Jan-86 17:11")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh & rht 10/16/85 Update with new cacheing mechanism.)
(* * fkr 11/8/85 Updated to handle noteFile object and new CardID scheme.)
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(LastChkptPtr (fetch (NoteFile CheckptPtr) of NoteFile))
EndPtr CardTotal NewBytes)
(if (AND (STREAMP Stream)
(OPENP Stream))
then (SETQ EndPtr (GETEOFPTR Stream))
(SETQ NewBytes (IDIFFERENCE EndPtr LastChkptPtr))
(COND
((OR (ZEROP NewBytes)
(PROGN (NC.PrintMsg NIL T
"Aborting will lose work since the last checkpoint i.e., the last "
NewBytes " bytes of " FullFileName (CHARACTER
13))
(NC.YesP (NC.AskUser "Want to abort anyway? " "--" "Yes"
NIL NIL NIL T T))))
(LET ((CardNumber 0)
(CardTotal (fetch (NoteFile HashArraySize) of NoteFile)))
(NC.MapCards
NoteFile
(FUNCTION (LAMBDA (Card)
(LET (Win)
(SETQ CardNumber (ADD1 CardNumber))
(COND
((ZEROP (IREMAINDER CardNumber 100))
(NC.PrintMsg NIL T "Quitting from active cards ... "
(CHARACTER 13)
"Processing item number " CardNumber
" out of "
CardTotal "." (CHARACTER 13))))
(COND
((NC.ActiveCardP Card)
(SETQ Win (NC.FetchWindow Card))
(NC.AbortCard Card)
(COND
(Win (bind (Process ←(WINDOWPROP Win (QUOTE
PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK))
(CLOSEW Win))))))))))
(COND
((LESSP LastChkptPtr EndPtr)
(NC.PrintMsg NIL T "Truncating file " FullFileName " ...")
(COND
((NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg NIL NIL "Couldn't truncate " FullFileName "."
(CHARACTER 13))))))
(NC.ResetNoteFileInterface NoteFile)
(NC.ForceDatabaseClose NoteFile)
(NC.PrintMsg NIL T FullFileName " closed."))
(T (NC.ClearMsg NIL)))
else (NC.PrintMsg NIL T FullFileName " is not an open NoteFile!!!" (CHARACTER 13)))))
)
)
(PUTPROPS RHTPATCH021 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (912 1883 (NC.NoteFileFromFileName 922 . 1442) (NC.CleanupCardObjects 1444 . 1881)) (
1932 22243 (NC.OpenDatabaseFile 1942 . 8226) (NC.CreateDatabaseFile 8228 . 13793) (
NC.ForceDatabaseClose 13795 . 15511) (NC.CloseDatabaseFile 15513 . 19306) (NC.AbortSession 19308 .
22241)))))
STOP