(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "10-Aug-87 22:28:23" {ERINYES}<LISPUSERS>LYRIC>TEDIT-CLOSE-ON-SHRINK.;1
 4181   

      previous date%: " 4-Aug-87 15:37:00" {PHYLUM}<LISPUSERS>KOTO>TEDIT-CLOSE-ON-SHRINK.;2)


(* "
Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT TEDIT-CLOSE-ON-SHRINKCOMS)

(RPAQQ TEDIT-CLOSE-ON-SHRINKCOMS
 
       [(FNS \TEDIT-CLOSE-ON-SHRINK)
        (DECLARE%: DONTEVAL@LOAD DOCOPY
               (P [PUTPROP 'TEDIT.CREATEW 'READVICE
                         '(NIL (AFTER NIL (if [NOT (MEMB '\TEDIT-CLOSE-ON-SHRINK (WINDOWPROP
                                                                                  !VALUE
                                                                                  'SHRINKFN]
                                              then
                                              (WINDOWADDPROP !VALUE 'SHRINKFN '\TEDIT-CLOSE-ON-SHRINK
                                                     ]
                  [PUTPROP '\TEDIT.CREATEW.FROM.REGION 'READVICE
                         '(NIL (AFTER NIL (if [NOT (MEMB '\TEDIT-CLOSE-ON-SHRINK (WINDOWPROP
                                                                                  !VALUE
                                                                                  'SHRINKFN]
                                              then
                                              (WINDOWADDPROP !VALUE 'SHRINKFN '\TEDIT-CLOSE-ON-SHRINK
                                                     ]
                  [PUTPROP '\TEDIT.REOPEN.STREAM 'READVICE '(NIL (AFTER NIL (replace (TEXTOBJ TXTFILE
                                                                                            )
                                                                                   of
                                                                                   (TEXTOBJ 
                                                                                          TEXTSTREAM)
                                                                                   with !VALUE]
                  (READVISE TEDIT.CREATEW \TEDIT.CREATEW.FROM.REGION \TEDIT.REOPEN.STREAM)
                  (SETQ ADVISEDFNS (LDIFFERENCE ADVISEDFNS '(TEDIT.CREATEW \TEDIT.CREATEW.FROM.REGION 
                                                                   \TEDIT.REOPEN.STREAM])
(DEFINEQ

(\TEDIT-CLOSE-ON-SHRINK

  [LAMBDA (teditWindow)
                                      (* N.H.Briggs " 3-Aug-87 17:24")

    [LET* ((textObj (TEXTOBJ teditWindow))
           (backingStream (fetch
 (TEXTOBJ TXTFILE) of
 textObj)))
          (if
 (NOT (fetch
 (TEXTOBJ \DIRTY) of
 textObj))
              then
 (AND backingStream (CLOSEF? backingStream]
    T])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 
[PUTPROP 'TEDIT.CREATEW 'READVICE '(NIL (AFTER NIL (if [NOT (MEMB '\TEDIT-CLOSE-ON-SHRINK
                                                                  (WINDOWPROP !VALUE 'SHRINKFN]
                                                       then
                                                       (WINDOWADDPROP !VALUE 'SHRINKFN '
                                                              \TEDIT-CLOSE-ON-SHRINK]
[PUTPROP '\TEDIT.CREATEW.FROM.REGION 'READVICE
       '(NIL (AFTER NIL (if [NOT (MEMB '\TEDIT-CLOSE-ON-SHRINK (WINDOWPROP !VALUE 'SHRINKFN]
                            then
                            (WINDOWADDPROP !VALUE 'SHRINKFN '\TEDIT-CLOSE-ON-SHRINK]
[PUTPROP '\TEDIT.REOPEN.STREAM 'READVICE '(NIL (AFTER NIL (replace (TEXTOBJ TXTFILE)
                                                                 of
                                                                 (TEXTOBJ TEXTSTREAM)
                                                                 with !VALUE]
(READVISE TEDIT.CREATEW \TEDIT.CREATEW.FROM.REGION \TEDIT.REOPEN.STREAM)
[SETQ ADVISEDFNS (LDIFFERENCE ADVISEDFNS '(TEDIT.CREATEW \TEDIT.CREATEW.FROM.REGION 
                                                 \TEDIT.REOPEN.STREAM]
)
(PUTPROPS TEDIT-CLOSE-ON-SHRINK COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2429 2828 (\TEDIT-CLOSE-ON-SHRINK 2439 . 2826)))))
STOP