(FILECREATED "28-Jun-86 20:38:07" {QV}<NOTECARDS>1.3K>FGHPATCH080.;1 10640
changes to: (VARS FGHPATCH080COMS)
(FNS NC.PrintMsg NC.CardSaveFn))
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH080COMS)
(RPAQQ FGHPATCH080COMS ((* * Small patches to fixup stuff from FGHPATCH073)
(FNS NC.PrintMsg NC.CardSaveFn)))
(* * Small patches to fixup stuff from FGHPATCH073)
(DEFINEQ
(NC.PrintMsg
(LAMBDA Msgs (* fgh: "28-Jun-86 20:18")
(* Print the msgs in the specified window. First argument is a window to print msg in, second arg is flag telling
whether to clear first, rest of arguments are simply prin1'ed to the msg window)
(* * rht 7/24/85: Now checks to be sure that window arg is a notecards window. If not, doesn't use promptwindow,
but prints directly to window.)
(* * rht 9/11/85: Added call to NC.MoveWindowOntoScreen in case we're crammed near the top of screen.)
(* * fgh 6/8/86 Now opens prompt window to width that matches longest line in Msg.)
(* * fgh 6/13/86 Now attaches prompt window to NF menus as well as cards.)
(* * fgh 6/26/86 Now tries to make the window an appropriate width to hold the whole msg. Height remains a
constant.)
(LET ((Font (FONTCREATE (QUOTE HELVETICA)
10))
NoteCardWinFlg PromptWin CachedStream Window MaxWidth)
(SETQ Window (ARG Msgs 1))
(* * find the maximun line length in the given arg list. Cached on the main window under the PromptWindowLastNotCR
prop is the length of the previous line if it didn't end in a carriage return. Need to add this to the length of
the first line in this call.)
(SETQ MaxWidth
(APPLY
(FUNCTION MAX)
(OR (bind (LastNotCR ←(if (AND Window (NULL (ARG Msgs 2)))
then (WINDOWPROP Window (QUOTE PromptWindowLastNotCR)
)))
for Msg from 3 to Msgs
join
(* * Parse each arg into a list of line lengths. Set the LastNotCR to the length of the last line in the arg if the
arg does not end in a CR. This will be added to the length of the first line in the next arg whether it be in this
call or the next call to Printmsg.)
(if (STREQUAL (ARG Msgs Msg)
"")
then (LIST 0)
else
(while (SETQ Char (GNC CopyString)) as Ctr from 1
bind Char (LastCR ← 0)
(CopyString ←(SUBSTRING (ARG Msgs Msg)
1))
(OriginalString ←(SUBSTRING (ARG Msgs Msg)
1))
when (EQ Char (CHARACTER 13))
collect (PROG1 (PLUS (OR LastNotCR 0)
(STRINGWIDTH
(OR (SUBSTRING OriginalString
(ADD1 LastCR)
(SUB1 Ctr))
"")
Font))
(SETQ LastCR Ctr)
(SETQ LastNotCR 0))
finally
(* if the last line doesn't end in a CR, save its length as LastNotCR but be sure to put its length on the list
anyway in case this is the last call.)
(if (NOT (EQP Ctr LastCR))
then (SETQ $$VAL
(CONS (PLUS (OR LastNotCR 0)
(STRINGWIDTH
(OR (SUBSTRING OriginalString
(ADD1 LastCR)
(SUB1 Ctr))
"")
Font))
$$VAL))
(SETQ LastNotCR (CAR $$VAL))
else (SETQ LastNotCR))))
finally (* Cache the last linelength if it didn't end in a CR,
we'll need it to add to the first line next time.)
(if Window
then (WINDOWPROP Window (QUOTE PromptWindowLastNotCR)
LastNotCR)))
0)))
(if (IGREATERP Msgs 2)
then
(* * Figure out the prompt window)
(SETQ NoteCardWinFlg (NC.NoteCardsWindowP Window))
(COND
((NOT (WINDOWP Window))
(SETQ PromptWin PROMPTWINDOW))
(NoteCardWinFlg (SETQ PromptWin (NC.AttachPromptWindow Window NIL NIL NIL T)
))
(T (SETQ PromptWin Window)))
(* * If requested, reset all the width cahces.)
(if (AND PromptWin (ARG Msgs 2))
then (WINDOWPROP PromptWin (QUOTE OldMaxWidth)
0))
(* * Set window width to the max width of the current max width and the cached max width from previous lines since
the last clear)
(WINDOWPROP PromptWin (QUOTE OldMaxWidth)
(SETQ MaxWidth (MAX MaxWidth (OR (WINDOWPROP PromptWin
(QUOTE
OldMaxWidth))
0))))
(* * Actual width of window is this maxwidth, except that if window is open, don't make it smaller.)
(if NoteCardWinFlg
then (SETQ PromptWin (NC.AttachPromptWindow
Window
(if (OPENWP PromptWin)
then (MAX MaxWidth (WINDOWPROP PromptWin (QUOTE WIDTH))
)
else MaxWidth)))
(NC.MoveWindowOntoScreen Window))
(* * Print the msg.)
(RESETLST (OR NoteCardWinFlg (RESETSAVE (TTYDISPLAYSTREAM PromptWin)))
(RESETSAVE NIL (BQUOTE (DSPFONT , (DSPFONT Font PromptWin)
, PromptWin)))
(if (ARG Msgs 2)
then (CLEARW PromptWin))
(LINELENGTH 1000 PromptWin)
(if (NULL PromptWin)
then (BREAK1 T T))
(for Msg from 3 to Msgs collect (PRIN1 (ARG Msgs Msg)
PromptWin))))
PromptWin)))
(NC.CardSaveFn
(LAMBDA (WindowOrID QuietFlg DontCheckForOpsInProgressFlg InterestedWindow OperationMsg)
(* fgh: "28-Jun-86 20:35")
(* * rht 2/1/85: New function for saving ANY kind of card. All strangenesses are handled in NC.CardDirtyP and
NC.MarkCardDirty. Added print statements to show what is being saved. Lets NC.CardDirtyP take care of proper dirty
checks.)
(* * rht 2/8/85: Added InsureFilingFlg)
(* * rht 6/25/85: Pulled out InsureFilingFlg. That check now done upstairs in NC.QuitCard.)
(* * rht 9/20/85: Added QuietFlg.)
(* * fgh 11/12/85 Updated to handle Card objects. Removed DatabaseStream object.)
(* * kirk 29Jan86 replaced call on undefined NC.UpdateRegionData with NC.PutRegion)
(* * fgh 6/13/86 Added operations in progress code and DontCheckForOpsInProgressFlg arg.)
(* * fgh 6/26/86 Added InterestedWindow & OperationMsg arg.)
(LET ((Card (NC.CoerceToCard WindowOrID))
Window OldRegion NewRegion DoneAPutP OperationInProgress)
(SETQ Window (NC.FetchWindow Card))
(SETQ InterestedWindow (OR Window InterestedWindow))
(if (AND (NULL DontCheckForOpsInProgressFlg)
(SETQ OperationInProgress (NC.OperationInProgress Card))
(NEQ OperationInProgress (QUOTE Close% Card)))
then (NC.PrintOperationInProgressMsg Window "Save Card" OperationInProgress)
else (NC.ProtectedCardOperation
Card Save% Card (OR QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Checking ... "))
(COND
((OR (NC.CardDirtyP Card)
(NC.FetchNewCardFlg Card))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "substance, "))
(NC.PutMainCardData Card T)
(SETQ DoneAPutP T)
(NC.MarkCardDirty Card (QUOTE RESET)))
((AND (NOT (NC.FetchBeingDeletedFlg Card))
Window
(OR (NOT (EQUAL (fetch (REGION WIDTH) of (SETQ OldRegion
(NC.FetchRegion
Card)))
(fetch (REGION WIDTH)
of (SETQ NewRegion (WINDOWPROP
Window
(QUOTE REGION))))))
(NOT (EQUAL (fetch (REGION HEIGHT) of OldRegion)
(fetch (REGION HEIGHT) of NewRegion)))))
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "region, "))
(NC.PutRegion Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchTitleDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "title, "))
(NC.PutTitle Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchPropListDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "proplist, "))
(NC.PutPropList Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchLinksDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "links, "))
(NC.PutLinks Card)
(SETQ DoneAPutP T)))
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL (CHARACTER 13)
"Nothing changed. "))
(* It's not a new card anymore.)
(NC.SetNewCardFlg Card NIL)
(OR QuietFlg (PROGN (NC.PrintMsg InterestedWindow NIL "Done." (CHARACTER
13))
(if Window
then (NC.ClearMsg Window T)))))))))
)
(PRETTYCOMPRINT FGHPATCH080COMS)
(RPAQQ FGHPATCH080COMS ((* * Small patches to fixup stuff from FGHPATCH073)
(FNS NC.PrintMsg NC.CardSaveFn)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA NC.PrintMsg)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NC.PrintMsg)
)
(PUTPROPS FGHPATCH080 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (444 10122 (NC.PrintMsg 454 . 6011) (NC.CardSaveFn 6013 . 10120)))))
STOP