(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "10-Feb-88 16:55:46" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH087.;2 12224
changes to%: (FNS NCHist.ComputeHistory)
(VARS PMIPATCH087COMS)
previous date%: "10-Feb-88 16:50:04" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH087.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH087COMS)
(RPAQQ PMIPATCH087COMS (
(* ;;; "More changes to History Cards")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH087 MAKEFILE-ENVIRONMENT)
(PMIPATCH087 FILETYPE)))
(FNS NCHist.ComputeHistory)))
(* ;;; "More changes to History Cards")
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH087 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH087 FILETYPE :BCOMPL)
)
(DEFINEQ
(NCHist.ComputeHistory
[LAMBDA (Window) (* ; "Edited 10-Feb-88 16:54 by pmi")
(* ;; "Computes stuff for History card.")
(* ;; "pmi 2/10/88: Added RESETLIST and RESETSAVE to change the cursor to a waiting cursor. Attempted to speed up computations to decide if any cards are dirty.")
(DECLARE (GLOBALVARS NCHist.HistoryEventHashArray NCHist.HistoryLinkType))
[RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(PROG ((HistoryCard (NCP.CoerceToCard Window))
NoteFile NCLogInfo LinkLabelsCard RegistryCard OpenEventsCard)
(SETQ NoteFile (NCP.CardNoteFile HistoryCard))
(SETQ NCLogInfo (NCP.CardUserDataProp HistoryCard 'NCLogInfo))
(SETQ LinkLabelsCard (fetch (NoteFile LinkLabelsCard) of NoteFile))
(SETQ RegistryCard (fetch (NoteFile RegistryCard) of NoteFile))
(SETQ OpenEventsCard (NCP.LookupCardByName 'OpenEventsCard NoteFile))
(if (for Card in (NCP.AllCards NoteFile) thereis (AND (NC.ActiveCardP Card)
(NC.CardDirtyP Card)
(NEQ Card LinkLabelsCard)
(NEQ Card RegistryCard)
(NEQ Card OpenEventsCard)))
then (SELECTQ (NC.AskUserWithMenu '(Yes No Cancel) (CONCAT
"Warning - information about cards not yet saved will not be logged."
(CHARACTER 13)
"Checkpoint before computing history?"
)
Window NIL T)
(Yes (NCP.CheckpointNoteFiles NoteFile))
(No)
(Cancel (RETURN NIL))
(RETURN NIL)))
(RETURN (RESETLST
[RESETSAVE `(NCLOG.SuspendLogging ,NoteFile ,NCLogInfo)
`(NCLOG.StartLogging ,NoteFile ,NCLogInfo]
(LET (LoggingStream SectionEndPtr SectionPtrs HistoryEventTypes)
(SETQ LoggingStream (fetch (NCLogInfo LoggingStream) of NCLogInfo))
(SETQ SectionEndPtr (GETEOFPTR LoggingStream))
(SETQ SectionPtrs (NCP.CardUserDataProp HistoryCard 'SectionPtrs))
(* ;; "Compute history for current section if it has not already been computed.")
(if (NOT (NCP.ValidLinkTypeP NCHist.HistoryLinkType NoteFile))
then (NCP.CreateLinkType NCHist.HistoryLinkType NoteFile))
(if (NOT (FMEMB SectionEndPtr SectionPtrs))
then (if SectionPtrs
then (SETQ SectionStartPtr (CAR (LAST SectionPtrs)))
else (SETQ SectionStartPtr 0))
(SETQ SectionPtrs (NCONC1 SectionPtrs SectionEndPtr))
(NCP.CardUserDataProp HistoryCard 'SectionPtrs SectionPtrs)
(SETQ HistoryEventTypes)
(* ;; "Gather up all of the events to be logged for this History card. They are stored on the History card, as separate lists for each event category.")
[for HistoryEventList in (NCP.CardUserDataProp HistoryCard
'HistoryEventSpecs)
do (for HistoryEventType in HistoryEventList
do (SETQ HistoryEventTypes (APPEND (MKLIST (GETHASH
HistoryEventType
NCHist.HistoryEventHashArray
))
HistoryEventTypes]
(SETFILEPTR LoggingStream SectionStartPtr)
(while (NOT (EOFP LoggingStream)) first (SKIPSEPRS LoggingStream)
finally (NCP.CardAddText HistoryCard
(CONCAT (CHARACTER 13)
"--- "
(DATE (DATEFORMAT NO.DATE NO.SECONDS))
" ---"
(CHARACTER 13)
(CHARACTER 13))
'END) do (NCHist.GetLogEventFromStream
LoggingStream HistoryEventTypes
HistoryCard]
(PROG ((HistoryCard (NCP.CoerceToCard Window))
NoteFile NCLogInfo ActiveCards LinkLabelsCard RegistryCard OpenEventsCard)
(if (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(SETQ NoteFile (NCP.CardNoteFile HistoryCard))
(SETQ NCLogInfo (NCP.CardUserDataProp HistoryCard 'NCLogInfo))
(* ;; "(SETQ ActiveCards (NC.MapCards NoteFile (FUNCTION (LAMBDA (Card) Card)) (FUNCTION NC.ActiveCardP)))")
(* ;;
"Warn the user about changes to unsaved cards not being logged until a checkpoint is done.")
(SETQ LinkLabelsCard (fetch (NoteFile LinkLabelsCard) of NoteFile))
(SETQ RegistryCard (fetch (NoteFile RegistryCard) of NoteFile))
(SETQ OpenEventsCard (NCP.LookupCardByName 'OpenEventsCard NoteFile))
(if (for Card in (NCP.AllCards NoteFile) thereis (AND (NC.ActiveCardP Card)
(NC.CardDirtyP Card)
(NEQ Card LinkLabelsCard)
(NEQ Card RegistryCard)
(NEQ Card OpenEventsCard))
)
then (SELECTQ (NC.AskUserWithMenu '(Yes No Cancel) (CONCAT
"Warning - information about cards not yet saved will not be logged."
(CHARACTER 13)
"Checkpoint before computing history?"
)
Window NIL T)
(Yes (PROGN (NCP.CheckpointNoteFiles NoteFile)
T))
(No T)
(Cancel NIL)
NIL)))
then
(RETURN
(RESETLST [RESETSAVE `(NCLOG.SuspendLogging ,NoteFile ,NCLogInfo)
`(NCLOG.StartLogging ,NoteFile ,NCLogInfo]
(LET (LoggingStream SectionEndPtr SectionPtrs HistoryEventTypes)
(SETQ LoggingStream (fetch (NCLogInfo LoggingStream) of NCLogInfo))
(SETQ SectionEndPtr (GETEOFPTR LoggingStream))
(SETQ SectionPtrs (NCP.CardUserDataProp HistoryCard 'SectionPtrs))
(* ;; "Compute history for current section if it has not already been computed.")
(if (NOT (NCP.ValidLinkTypeP NCHist.HistoryLinkType NoteFile))
then (NCP.CreateLinkType NCHist.HistoryLinkType NoteFile))
(if (NOT (FMEMB SectionEndPtr SectionPtrs))
then (if SectionPtrs
then (SETQ SectionStartPtr (CAR (LAST SectionPtrs)))
else (SETQ SectionStartPtr 0))
(SETQ SectionPtrs (NCONC1 SectionPtrs SectionEndPtr))
(NCP.CardUserDataProp HistoryCard 'SectionPtrs SectionPtrs)
(SETQ HistoryEventTypes)
(* ;; "Gather up all of the events to be logged for this History card. They are stored on the History card, as separate lists for each event category.")
[for HistoryEventList in (NCP.CardUserDataProp HistoryCard
'HistoryEventSpecs)
do (for HistoryEventType in HistoryEventList
do (SETQ HistoryEventTypes
(APPEND (MKLIST (GETHASH HistoryEventType
NCHist.HistoryEventHashArray)
)
HistoryEventTypes]
(SETFILEPTR LoggingStream SectionStartPtr)
(while (NOT (EOFP LoggingStream)) first (SKIPSEPRS LoggingStream)
finally (NCP.CardAddText HistoryCard
(CONCAT (CHARACTER 13)
"--- "
(DATE (DATEFORMAT NO.DATE NO.SECONDS))
" ---"
(CHARACTER 13)
(CHARACTER 13))
'END) do (NCHist.GetLogEventFromStream
LoggingStream HistoryEventTypes
HistoryCard])
)
(PUTPROPS PMIPATCH087 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (936 12141 (NCHist.ComputeHistory 946 . 12139)))))
STOP