(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "22-Aug-88 14:44:44" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH334.;2 7758
changes to%: (FNS NCP.OpenCard NCP.CloseCards NCP.DisplayCard NCP.UndisplayCards)
previous date%: " 8-Aug-88 18:44:31" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH334.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH334COMS)
(RPAQQ RHTPATCH334COMS ((DECLARE%: DONTCOPY (PROPS (RHTPATCH334 MAKEFILE-ENVIRONMENT)
(RHTPATCH334 FILETYPE)))
(* ;; "Fixes Julian's bug whereby tabletops were unshrinking cards that had just been shrunken. NCP.OpenCard now checks that %"OldProc%" has an open window before trying to hand it the tty.")
(* ;; "Changes to NCPROGINT")
(FNS NCP.OpenCard NCP.CloseCards NCP.DisplayCard NCP.UndisplayCards)))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH334 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH334 FILETYPE :TCOMPL)
)
(* ;;
"Fixes Julian's bug whereby tabletops were unshrinking cards that had just been shrunken. NCP.OpenCard now checks that %"OldProc%" has an open window before trying to hand it the tty."
)
(* ;; "Changes to NCPROGINT")
(DEFINEQ
(NCP.OpenCard
[LAMBDA (Card Region/Position TypeSpecificArgs ReadOnly) (* ; "Edited 22-Aug-88 14:44 by Burwell")
(* ;;; "Cache this card, if necessary, and display on the screen.")
(* ;; "rht 11/16/86: Changed call to NCP.ReportError")
(* ;; "rht 8/8/88: Added check that old proc's window is open before giving it the tty.")
(* ;; "rht 8/22/88: Fixed typo in above fix.")
(if (NC.ValidCardP Card)
then [LET ((OldProc (TTY.PROCESS)))
(PROG1 (NC.EditNoteCard Card (OR ReadOnly (fetch (NoteFile ReadOnlyFlg)
of (fetch (Card NoteFile) of Card)))
Region/Position TypeSpecificArgs)
(AND (PROCESSP OldProc)
(OPENWP (PROCESSPROP OldProc 'WINDOW))
(TTY.PROCESS OldProc)))]
else (NCP.ReportError 'NCP.OpenCard (CONCAT Card " not an existing card or box."])
(NCP.CloseCards
[LAMBDA (Cards QuietFlg) (* ; "Edited 22-Aug-88 14:43 by Burwell")
(* ;; "Uncache and undisplay any active cards in Cards")
(* ;; "rht 11/16/86: Changed call to NCP.ReportError")
(* ;; "rht 3/9/87: Fixed so that wouldn't try to get PROCESS windowprop from NIL Win.")
(* ;; "rg 3/9/87 fixed args to NC.QuitCard ; added NC.ProtectedSessionOperation wrapper")
(* ;; "rg 4/2/87 changed NC.ProtectedSessionOperation to NCP.WithLockedCards ; added NC.IfAllCardsFree wrapper")
(* ;; "rg 8/4/88 Changed CANCELLED to DON'T")
(* ;; "rht 8/8/88: Added check that old proc's window is open before giving it the tty.")
(* ;; "rht 8/22/88: Fixed typo in above fix.")
(NCP.WithLockedCards
(NC.IfAllCardsFree (NC.LockListOfCards (MKLIST Cards)
"Close Cards")
(for Card in (MKLIST Cards) bind Win (OldProc ← (TTY.PROCESS))
do (if (NOT (NC.ValidCardP Card))
then (NCP.ReportError "NCP.CloseCards" (CONCAT Card
" not an existing card or filebox."
))
elseif (AND (NCP.CardCachedP Card)
(NEQ (NC.QuitCard Card T NIL NIL NIL NIL QuietFlg)
'DON'T)
(SETQ Win (NC.FetchWindow Card)))
then (bind [Process ← (AND Win (WINDOWPROP Win 'PROCESS]
until (OR (NULL Process)
(PROCESS.FINISHEDP Process)) do (BLOCK)))
finally (AND (PROCESSP OldProc)
(OPENWP (PROCESSPROP OldProc 'WINDOW))
(TTY.PROCESS OldProc))
(RETURN Card])
(NCP.DisplayCard
[LAMBDA (Card Region/Position TypeSpecificArgs ReadOnly) (* ; "Edited 22-Aug-88 14:44 by Burwell")
(* ;;; "display Card on the screen.")
(* ;; "rht 11/16/86: Changed call to NCP.ReportError")
(* ;; "rg 11/4/87 added ReadOnly")
(* ;; "rht 8/8/88: Added check that old proc's window is open before giving it the tty.")
(* ;; "rht 8/22/88: Fixed typo in above fix.")
(if (NC.ValidCardP Card)
then (if (NCP.CardCachedP Card)
then [LET ((OldProc (TTY.PROCESS)))
(PROG1 (NC.EditNoteCard Card (OR ReadOnly (fetch (NoteFile ReadOnlyFlg)
of (fetch (Card NoteFile)
of Card)))
Region/Position TypeSpecificArgs)
(AND (PROCESSP OldProc)
(OPENWP (PROCESSPROP OldProc 'WINDOW))
(TTY.PROCESS OldProc)))]
else (NCP.ReportError 'NCP.DisplayCard (CONCAT Card
" must be cached before displayed: NCP.DisplayCard."
)))
else (NCP.ReportError 'NCP.DisplayCard (CONCAT Card " not an existing card or box."])
(NCP.UndisplayCards
[LAMBDA (Cards QuietFlg WriteChangesFlg) (* ; "Edited 22-Aug-88 14:44 by Burwell")
(* ;;; "If card is valid and displayed, then undisplay it but leave it cached. If WriteChangesFlg is non-nil, then save changes to the file, otherwise saving will wait until card is uncached.")
(* ;; "rht 11/16/86: Changed call to NCP.ReportError")
(* ;; "rht 8/8/88: Added check that old proc's window is open before giving it the tty.")
(* ;; "rht 8/22/88: Fixed typo in above fix.")
(for Card in (MKLIST Cards) do [COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError 'NCP.UndisplayCards (CONCAT Card
" not an existing card or filebox."
)))
((NOT (NCP.CardDisplayedP Card))
(NCP.PrintMsg NIL T Card
" already undisplayed: NCP.UndisplayCards"))
(T (LET ((OldProc (TTY.PROCESS)))
(PROG1 (NC.QuitCard Card T (NOT WriteChangesFlg)
NIL NIL NIL QuietFlg T)
(AND (PROCESSP OldProc)
(OPENWP (PROCESSPROP OldProc 'WINDOW))
(TTY.PROCESS OldProc)))]
finally (RETURN Card])
)
(PUTPROPS RHTPATCH334 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1436 7675 (NCP.OpenCard 1446 . 2475) (NCP.CloseCards 2477 . 4482) (NCP.DisplayCard 4484
. 5961) (NCP.UndisplayCards 5963 . 7673)))))
STOP