(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