(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Oct-88 20:24:03" {QV}<NOTECARDS>1.3LNEXT>RGPATCH089.;2 34511
changes to%: (VARS RGPATCH089COMS)
(FNS NC.CloseNoteFile NC.OpenNoteFile)
previous date%: "20-Oct-88 18:22:20" {QV}<NOTECARDS>1.3LNEXT>RGPATCH089.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RGPATCH089COMS)
(RPAQQ RGPATCH089COMS [(FNS NC.CloseNoteFile NC.OpenNoteFile)
(ADDVARS (CH.PROPERTIES (NOTECARDS.SERVER 10051])
(DEFINEQ
(NC.CloseNoteFile
[LAMBDA (NoteFile InterestedWindow QuietFlg AutoConfirmFlg)
(* ; "Edited 20-Oct-88 19:40 by Gobbel")
(* ;; "Close a NoteFIle")
(* ;; "rg 3/4/87 changes for new concurrency machinery")
(* ;; "rht 3/25/87: Now calls NC.CoerceToInterestedWindow.")
(* ;; "rg 3/27/87 redid concurrency wrapper")
(* ;; "pmi 8/14/87: Added call to NC.NoticeNoteFile to make sure this file has been noticed. Also, added parameters in call to NC.AbortSession to stop confirmation and pass on the QuietFlg.")
(* ;; "rg 10/20/88 Made QuietFlg more thorough.")
(DECLARE (GLOBALVARS NC.MsgDelay NC.CloseNoteFileFns))
(NC.ProtectedNoteFileOperation
NoteFile "Close NoteFile" InterestedWindow (OR (OPENWP InterestedWindow)
(SETQ InterestedWindow (
NC.CoerceToInterestedWindow
NoteFile)))
(if (NC.ReadOnlyNoteFileP NoteFile)
then (NC.AbortSession NoteFile InterestedWindow T QuietFlg)
else
(ALLOW.BUTTON.EVENTS)
(PROG ((FullFileName (fetch (NoteFile FullFileName) of NoteFile))
CardTotal ActiveCards ReturnValue (OperationMsg ""))
(* ;; "Make sure NF is open")
(if [NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile]
then (SETQ ReturnValue 'OpenPFailed))
(if (NULL ReturnValue)
then
(* ;; "NoteFile is not open.")
(if (NOT QuietFlg)
then (NC.PrintMsg InterestedWindow T "Can't close a closed notefile."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T NC.MsgDelay))
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* ;; "Error return from NoteFileOpenPFn")
(if [NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on " FullFileName
"failed because " ReturnValue
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."
]
then (RETURN ReturnValue)))
(RETURN
(PROG NIL
[RESETSAVE NIL `(OR ,QuietFlg (NC.ClearMsg ,InterestedWindow T]
(* ;; "Delete the types and titles caching process if still alive. Have to do it now in order to make checking operations that follow suitably efficient. Note its a bit too early since we can still cancel this close. But any harm done is loss of speed if NoteFile remains open when close iss cancelled.")
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(* ;;
"See if any cards have operations in progress. If so, kill them after confirming with user.")
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Checking for card operations in progress ..."
(CHARACTER 13)))
(if (EQ 'ABORT (NC.CardOperationsInProgress NoteFile T))
then (RETURN NIL))
(OR QuietFlg (NC.ClearMsg InterestedWindow NIL))
(* ;; "If NULL QuietFlg then look for cards on the screen. If there are active cards ask the user if they still want to close. When there's a non-NIL QuietFlg we just close the active cards.")
(if (AND (NULL QuietFlg)
(NULL AutoConfirmFlg)
[for Window in (OPENWINDOWS)
thereis (LET (Card)
(AND [SETQ Card (OR (NC.CardFromWindow Window)
(AND (WINDOWP (WINDOWPROP
Window
'ICONFOR))
(NC.CardFromWindow
(WINDOWPROP Window
'ICONFOR]
(NC.SameNoteFileP NoteFile (fetch (Card NoteFile)
of Card]
(NULL (NC.AskYesOrNo (CONCAT
"There are still cards on the screen from this NoteFile "
FullFileName "." (CHARACTER 13)
"Want to close and save them? ")
" -- "
'Yes NIL InterestedWindow NIL NIL)))
then (RETURN NIL))
(* ;; "Run through CloseNoteFileFns with param of BEFORE. Exit if any returns DON'T")
(if [for Function in NC.CloseNoteFileFns
thereis (OR (EQ Function 'DON'T)
(EQ 'DON'T (APPLY* Function NoteFile 'BEFORE]
then (RETURN NIL))
(* ;; "Close all the active cards")
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Checking for active cards ..."
(CHARACTER 13)))
[if (SETQ ActiveCards (NC.MapCards NoteFile [FUNCTION (LAMBDA (Card)
Card]
(FUNCTION NC.ActiveCardP)))
then (OR QuietFlg (NC.PrintMsg InterestedWindow T
"Closing and saving active cards ... "))
(RESETLST
(RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceFilingFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(NC.CloseListOfActiveCards ActiveCards InterestedWindow QuietFlg)
(NC.CloseListOfActiveCards (for Card in (NC.FetchSpecialCards
NoteFile)
when (NC.ActiveCardP Card)
collect Card)
InterestedWindow QuietFlg))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "Done." (CHARACTER 13]
(* ;; "Checkpoint the NoteFile.")
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Closing Notefile ... " (CHARACTER
13)))
(if [NULL (CAR (ERSETQ (SETQ ReturnValue (NC.CheckpointNoteFile NoteFile QuietFlg
T InterestedWindow OperationMsg]
then (SETQ ReturnValue 'CheckpointFailed))
(* ;; "Process error returns from in NC.CheckpointNoteFile")
(if (NOT (type? NoteFile ReturnValue))
then (if [NULL (ERSETQ (NC.ReportError NIL (CONCAT "Checkpoint of NoteFile "
FullFileName
" failed because "
ReturnValue "."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."
]
then (RETURN ReturnValue)))
(* ;; "Close the file.")
(if [NULL (CAR (ERSETQ (SETQ ReturnValue (APPLY* (fetch (NoteFile CloseNoteFileFn
) of NoteFile)
NoteFile InterestedWindow]
then (SETQ ReturnValue 'CloseFailed))
(* ;; "Process error returns from the close.")
[if (NOT (type? NoteFile ReturnValue))
then (SELECTQ ReturnValue
(NoteFileNotOpen
(if [NULL (ERSETQ (NC.ReportError NIL (CONCAT "NoteFile"
FullFileName
" is not open."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."
]
then (RETURN ReturnValue)))
(PROGN [ERSETQ (NC.ReportError NIL (CONCAT "Close of NoteFile "
FullFileName
" failed because "
ReturnValue "."
(CHARACTER 13]
(RETURN ReturnValue]
(* ;; "Run through CloseNoteFileFns with param of AFTER. Stop if any returns DON'T")
[for Function in NC.CloseNoteFileFns thereis (EQ 'DON'T (APPLY* Function NoteFile
'AFTER]
(* ;;
"Reset the interface, make sure the notefile has been noticed, and notify the user.")
(NC.ResetNoteFileInterface NoteFile)
(NC.NoticeNoteFile NoteFile)
(OR QuietFlg (NC.PrintMsg InterestedWindow T FullFileName " closed."))
(* ;; " Clean up a bit.")
(* ; "Clean off the card caches")
(ADD.PROCESS (LIST (FUNCTION NC.CleanupCardObjects)
(fetch (NoteFile HashArray) of NoteFile)))
(* ;
"Clean off the NoteFile object to remove any circularities.")
(create NoteFile smashing NoteFile Stream ← NIL UID ← (fetch (NoteFile UID)
of NoteFile)
FullFileName ← FullFileName Menu ← (fetch (NoteFile Menu)
of NoteFile)
NoteFileDevice ← (fetch (NoteFile NoteFileDevice)
of NoteFile))
(* ;; "Return the NF")
(RETURN NoteFile])
(NC.OpenNoteFile
[LAMBDA (NoteFileOrFileName Don'tCacheTypesAndTitlesFlg Don'tCreateFlg ConvertNoConfirmFlg
Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg
InterestedWindow PublicOrPrivate MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg Don'tCheckVersionFlg)
(* ; "Edited 20-Oct-88 18:16 by Gobbel")
(* ;; "pmi 6/24/87: Added '(Highest version)' to question about opening highest version of a file. Added Don'tCheckVersionFlg for Create and Compact, which have already figured out the correct version.")
(* ;; "pmi 12/17/87: Added Don'tCreateInterfaceFlg argument to NC.SetUpNoteFileInterface so that esisting notefile icons will be updated properly when the Don'tCreateInterfaceFlg is T, as suggested by dsj.")
(* ;; "RG 10/10/88 now returns NoteFile if already open (for server). Trimmed comments.")
(DECLARE (GLOBALVARS NC.OpenNoteFileFns NC.LastNoteFileOpened))
(PROG ((TempInterestedWindow (OR InterestedWindow (NC.CoerceToInterestedWindow NoteFileOrFileName
)))
NoteFile FileName NewerFileName OldVersion NewVersion NoteFileMenu ReturnValue
CriticalUIDs)
(* ;; "Figure out the name of the file containing the NoteFile")
(if [NULL (SETQ FileName (if (type? NoteFile NoteFileOrFileName)
then (fetch (NoteFile FullFileName) of NoteFileOrFileName)
elseif NoteFileOrFileName
else (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T
NIL NIL TempInterestedWindow]
then (RETURN NIL))
(* ;; "Check for the .NoteFile extension if this notefile has not been noticed by NoteCards.")
(if (AND (NEQ (U-CASE (FILENAMEFIELD FileName 'EXTENSION))
'NOTEFILE)
(NOT (NC.NoteFileNoticedP FileName)))
then (NC.PrintMsg InterestedWindow T FileName " does not have a .NOTEFILE extension."
(CHARACTER 13))
(if (NULL (NC.AskYesOrNo (CONCAT "Are you sure you want to open " FileName
" as a NoteFile?")
" -- " "No" NIL InterestedWindow T NIL))
then (NC.ClearMsg InterestedWindow T)
(RETURN NIL)))
(* ;; "If this is an open NoteFIle, just bring up its menu.")
[if (NC.NoteFileOpenP FileName)
then (NC.SetUpNoteFileInterface (NC.NoteFileFromFileName FileName)
MenuPosition TempInterestedWindow Don'tCreateInterfaceFlg)
(NC.ClearMsg TempInterestedWindow T) (* ;
"bring up or create notefile icon if needed")
(RETURN (if (type? NoteFile NoteFileOrFileName)
then NoteFileOrFileName
else (NC.NoteFileFromFileName FileName]
(* ;; "Check for higher version of same notefile")
[if (AND (NOT Don'tCheckVersionFlg)
(SETQ OldVersion (FILENAMEFIELD FileName 'VERSION))
(SETQ NewVersion (FILENAMEFIELD (SETQ NewerFileName (FULLNAME (PACKFILENAME
'VERSION NIL
'BODY FileName)))
'VERSION))
(LESSP OldVersion NewVersion))
then
(* ;; "Notify user")
(NC.PrintMsg TempInterestedWindow T "A higher version of " FileName " exists."
(CHARACTER 13))
(* ;; "Open the version the user requests.")
(if (NC.AskYesOrNo (CONCAT "Open " NewerFileName " instead? (Highest version)")
" -- " "No" NIL TempInterestedWindow T NIL)
then (SETQ FileName NewerFileName)
(SETQ NoteFileOrFileName (NC.NoteFileFromFileName FileName))
(if (SETQ NoteFileMenu (NC.GetNoteFileMenu FileName))
then (NC.SetNoteFileMenu NoteFileOrFileName NoteFileMenu]
(* ;;
"Create a NoteFile object or use existing notefile object if there is one for this file name.")
[SETQ NoteFile (if (type? NoteFile NoteFileOrFileName)
then NoteFileOrFileName
else (OR (NC.NoteFileFromFileName FileName)
(create NoteFile]
(replace (NoteFile FullFileName) of NoteFile with FileName)
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile "Open NoteFile" InterestedWindow
(PROG NIL
(* ;; "Figure out the appropriate device vector from the file name.")
(NC.InstallDeviceVectorInNoteFile NoteFile PublicOrPrivate)
(* ;; "Moved this replace to after test for open notefile. Otherwise, if notefile is open read-only, it well be changed to regular open.")
(replace (NoteFile ReadOnlyFlg) of NoteFile with ReadOnlyFlg)
(* ;; "Notify user.")
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Opening NoteFile: " FileName " ..."
(CHARACTER 13)))
(SETQ ReturnValue
(PROG NIL
(* ;;
"Run through OpenNoteFileFns with param of BEFORE. Exit if any returns DON'T")
(if [for Function in NC.OpenNoteFileFns
thereis (OR (EQ Function 'DON'T)
(EQ 'DON'T (APPLY* Function FileName NoteFile
'BEFORE InterestedWindow]
then (if (WINDOWP InterestedWindow)
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile " FileName "."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T))
(RETURN))
(* ;;
"Call the device specific OpenNoteFileFn, which returns a list of special UIDs")
(if [NULL (ERSETQ (SETQ ReturnValue (APPLY* (fetch (NoteFile OpenNoteFileFn)
of NoteFile)
NoteFile InterestedWindow
Don'tCheckForTruncationFlg]
then (SETQ ReturnValue 'NoteFileOpenFailed))
(* ;; "Process error returns from the OpenNoteFileFn")
(if (NOT (LITATOM ReturnValue))
then
(* ;; "OpenNoteFileFn returned correctly")
(SETQ CriticalUIDs ReturnValue)
else
(* ;; "Error, process it.")
(SETQ ReturnValue
(OR [SELECTQ ReturnValue
(NoteFileNotFound
(NC.RemoveAccessToNoteFile NoteFile)
(SETQ InterestedWindow (NC.CoerceToInterestedWindow
InterestedWindow))
(NC.ProcessNoteFileNotFoundError NoteFile
Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
ConvertNoConfirmFlg Don'tCreateArrayFlg
Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow
PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg))
(NoteFileNeedsConversion
(NC.ProcessNoteFileNeedsConversionError NoteFile
Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
ConvertNoConfirmFlg Don'tCreateArrayFlg
Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow
PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg))
(NoteFileNeedsTruncation
(NC.ProcessNoteFileNeedsTruncationError NoteFile
Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
ConvertNoConfirmFlg Don'tCreateArrayFlg
Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow
PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg))
(NoteFileAlreadyOpen
(ERSETQ (NC.ReportError NIL (CONCAT (fetch (NoteFile
FullFileName
)
of NoteFile)
" is already open for exclusive access. Open failed."
))))
(NoteFileOpenFailed
(ERSETQ (NC.ReportError NIL (CONCAT "Open of "
(fetch (NoteFile
FullFileName
)
of NoteFile)
" failed for unknown reason."
))))
((NoteFileHeaderBad BadNextIndexNum BadHashArraySize
BadCheckptPtr BadNextLinkNum)
(ERSETQ (NC.ReportError NIL (CONCAT
"Header of NoteFile "
(fetch (NoteFile
FullFileName
)
of NoteFile)
" is bad: "
ReturnValue
". Contact a NoteCards wizard."
))))
(PROGN (ERSETQ (NC.ReportError NIL
(CONCAT "Unknown error code ("
ReturnValue
") returned by OpenNoteFileFn for NoteFile "
FileName]
ReturnValue))
(* ;; "notify the user. if there's been a problem")
(if (AND (NOT (type? NoteFile ReturnValue))
(WINDOWP InterestedWindow))
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile " FileName "."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T))
(* ;; "return whatever the error processing returned.")
(RETURN ReturnValue))
(SETQ ReturnValue)
(* ;; "Make sure there is no other open NF with this UID.")
(LET (NF)
(if (AND (SETQ NF (GETHASH (fetch (NoteFileCriticalUIDs NoteFile)
of CriticalUIDs)
NC.NoteFilesHashArray))
(NEQ (fetch (NoteFile FullFileName) of NoteFile)
(fetch (NoteFile FullFileName) of NF))
(NC.NoteFileOpenP NF))
then (FLASHW PROMPTWINDOW)
(NC.PrintMsg PROMPTWINDOW T "Couldn't open " FileName
(CHARACTER 13)
"because "
(fetch (NoteFile FullFileName) of NF)
" is already open "
(CHARACTER 13)
"and has the same UID.")
(NC.CloseNoteFile NoteFile InterestedWindow T)
(RETURN NIL)))
(* ;;
"If needed, build a hash array by calling the device specific BuilHashArrayFn.")
(replace (NoteFile UID) of NoteFile with (fetch (NoteFileCriticalUIDs
NoteFile)
of CriticalUIDs))
(* ;; "Store this NoteFile object in the appropriate NoteFile hash array")
(NC.NoticeNoteFile NoteFile)
(if (NOT Don'tCreateArrayFlg)
then
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName (CHARACTER 13)
"Building index array ..."
(CHARACTER 13)))
(if (OR [NULL (ERSETQ (SETQ ReturnValue
(APPLY* (fetch (NoteFile BuildHashArrayFn)
of NoteFile)
NoteFile QuietFlg InterestedWindow
(CONCAT "Opening NoteFile "
(fetch (NoteFile FullFileName)
of NoteFile)
(CHARACTER 13]
(NOT (type? NoteFile ReturnValue)))
then
(* ;; "Error during building of hash array")
(ERSETQ (NC.ReportError NIL (CONCAT
"Build Hash Array failed for NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" because " ReturnValue)))
(RETURN)))
(* ;;
"Set up critical UIDs in NoteFile object using the values returned from OpenNoteFileFn.")
(NC.InstallCriticalUIDsInNoteFile NoteFile CriticalUIDs)
(* ;; "if needed, cache the special cards")
[if (NOT Don'tGetSpecialCardsFlg)
then (NC.GetSpecialCards NoteFile QuietFlg InterestedWindow
(CONCAT "Opening NoteFile: " (fetch (NoteFile FullFileName)
of NoteFile)
(CHARACTER 13]
(* ;; "If needed, start the titles and types caching process")
[if (NOT Don'tCacheTypesAndTitlesFlg)
then (replace (NoteFile CachingProcess) of NoteFile
with (ADD.PROCESS (LIST (FUNCTION NC.CacheTypesAndTitles)
NoteFile]
(* ;; "If needed, open up a NoteFile interface.")
(NC.SetUpNoteFileInterface NoteFile MenuPosition InterestedWindow
Don'tCreateInterfaceFlg)
(* ;; "Record this as the last NF opened.")
(SETQ NC.LastNoteFileOpened NoteFile)
(RETURN NoteFile)))
(if (type? NoteFile ReturnValue)
then
(* ;;
"Run through OpenNoteFIleFns with param of AFTER. Stop if any returns DON'T")
(for Function in NC.OpenNoteFileFns
thereis (EQ 'DON'T (APPLY* Function FileName NoteFile 'AFTER
InterestedWindow)))
(* ;; "Go home, returning NoteFile")
(if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow T "Opening NoteFile: " FileName
(CHARACTER 13)
"Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(RETURN NoteFile)
else
(* ;; "Bail out if open was unsuccessful.")
(RETURN NIL])
)
(ADDTOVAR CH.PROPERTIES (NOTECARDS.SERVER 10051))
(PUTPROPS RGPATCH089 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (582 34374 (NC.CloseNoteFile 592 . 13284) (NC.OpenNoteFile 13286 . 34372)))))
STOP