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

(FILECREATED " 5-Feb-88 23:37:02" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH308.;2
 3979   

      changes to%:  (FNS NC.TextCardShrinkFn)
                    (VARS RHTPATCH308COMS)

      previous date%: " 5-Feb-88 23:36:33" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH308.;1)


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

(PRETTYCOMPRINT RHTPATCH308COMS)

(RPAQQ RHTPATCH308COMS
 (

(* ;;; "New file")


                        (DECLARE%: DONTCOPY (PROPS (RHTPATCH308 MAKEFILE-ENVIRONMENT)
                                                   (RHTPATCH308 FILETYPE)))
                        
          
          (* ;; "Simple fix to text card shrink fn to add IconTitlePrefixString argument.  This so that file card shrink fn can pass buck by calling NC.TextCardShrinkFn.")


                        
          
          (* ;; "Change to NCTEXTCARD")


                        (FNS NC.TextCardShrinkFn)))



(* ;;; "New file")


(DECLARE%: DONTCOPY 

(PUTPROPS RHTPATCH308 MAKEFILE-ENVIRONMENT
 (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))

(PUTPROPS RHTPATCH308 FILETYPE
 :TCOMPL)
)



(* ;; 
"Simple fix to text card shrink fn to add IconTitlePrefixString argument.  This so that file card shrink fn can pass buck by calling NC.TextCardShrinkFn."
)





(* ;; "Change to NCTEXTCARD")


(DEFINEQ

(NC.TextCardShrinkFn

  [LAMBDA (W IconTitlePrefixString)
                          (* ; "Edited  5-Feb-88 23:36 by Trigg")


(* ;;; "This is in order to get the right title on the TEdit icon.  This is a kludgy finesse around TEdit's shrunken icon title facility.")

          
          (* ;; "rht 4/30/86: Now optionally kills TEdit process at shrink time.")

          
          (* ;; "fgh 6/5/86 Fixed to KLUDGE around problem that TEdit will call GETBOXPOSITION even when SHRINKW is called with a position argument.  Kludge involves looking up the stack for the position being specified in SHRINKW since its not passed down to here.")

          
          (* ;; "rg 11/18/86 Added GLOBALVARS")

          
          (* ;; "rht 1/30/87: Changed NC.DelTEditProcessAtShrinkFlg stuff to use Bagley's package via KILL-PROCESS-OF-TEDIT-WINDOW.")

          
          (* ;; "rht 2/5/88: Now takes extra IconTitlePrefixString which defaults to %"NC: %".")


    (DECLARE
 (GLOBALVARS TEDIT.ICON.FONT TEDIT.TITLED.ICON.TEMPLATE NC.DelTEditProcessAtShrinkFlg))
    (OR IconTitlePrefixString (SETQ IconTitlePrefixString "NC: "))
    (LET ((OldIconTitle (WINDOWPROP W 'NoteCardsIconTitle))
          (Icon (WINDOWPROP W 'ICON))
          (Card (NC.CoerceToCard W))
          IconTitle)
         [if
 (NULL Icon)
             then
 (WINDOWPROP W 'TEDIT.ICON.TITLE "")
                  (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE "" TEDIT.ICON.FONT
                                             (LET [(StkPos (STKPOS 'SHRINKW]
                                                  (if
 StkPos
                                                      then
 (PROG1 (STKARG 'ICONPOSITION StkPos)
                                                                  (RELSTK StkPos))
                                                    else
 NIL))
                                             T T NIL))
                  (APPLY* (WINDOWPROP W 'ICONFN)
                         W)
                  (SETQ Icon (WINDOWPROP W 'ICON]
         (if
 [NOT (EQUAL OldIconTitle (SETQ IconTitle (CONCAT IconTitlePrefixString (NC.RetrieveTitle
                                                                                     Card]
             then
 (ICONTITLE IconTitle NIL NIL Icon)
                  (WINDOWPROP W 'NoteCardsIconTitle IconTitle))
         (if
 NC.DelTEditProcessAtShrinkFlg
             then
 (KILL-PROCESS-OF-TEDIT-WINDOW W])
)
(PUTPROPS RHTPATCH308 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1394 3896 (NC.TextCardShrinkFn 1404 . 3894)))))
STOP