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

(FILECREATED " 2-Feb-94 13:26:29" {DSK}<users>nilsson>mnw>WINDOWICON.;2
 12057  

      changes to%:  (FNS SHRINKW EXPANDW)

      previous date%: "29-Sep-93 14:57:05" {DSK}<users>nilsson>mnw>WINDOWICON.;1)


(* ; "
Copyright (c) 1986, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT WINDOWICONCOMS)

(RPAQQ WINDOWICONCOMS

       ((FNS SHRINKW ICONBUTTONEVENTFN ICONPOSITION.FROM.WINDOW MAKETITLEBARICON \TITLEICONMINSIZE 
             \NOTENEWICONPOSITION EXPANDW DOICONWINDOWCOM CLOSEMAINWINDOW CLOSEICONWINDOW)
        (INITVARS (IconWindowMenu)
               (DEFAULTICONFN 'MAKETITLEBARICON))
        (ADDVARS (IconWindowMenuCommands (Close 'CLOSEW "Closes the icon and its associated window")
                        (Snap 'SNAPW "Saves a snapshot of a region of the screen.")
                        (Paint 'PAINTW 
  "Starts a painting mode in which the mouse can
be used to draw pictures or make notes on the icon.")
                        (Bury 'BURYW "Puts the icon on the bottom.")
                        (Move 'MOVEW "Moves the icon by a corner.")
                        (Shape 'SHAPEW "Gets a new region for the icon.")
                        (Expand 'EXPANDW "Expands the window for which this is the ICON.")))
        (GLOBALVARS DEFAULTICONFN IconWindowMenu IconWindowMenuCommands)))
(DEFINEQ

(SHRINKW

  [LAMBDA (WINDOW TOWHAT ICONPOSITION EXPANDFN)

                                                  (* ; 

                                                "Edited  2-Feb-94 13:10 by sybalsky:mv:envos")

    (WINDOWOP 'SHRINKWFN (fetch
 (WINDOW SCREEN) of
 (SETQ WINDOW (\INSUREWINDOW WINDOW)))
           WINDOW TOWHAT ICONPOSITION EXPANDFN])

(ICONBUTTONEVENTFN

  [LAMBDA (ICONW)
                                            (* bvm%: "25-Mar-86 17:23")

          
          (* * Default icon BUTTONEVENTFN -- middle button expands it, left button moves 

          it)


    (COND
       [(LASTMOUSESTATE MIDDLE)
        (CURSOR (PROG1 (CURSOR WAITINGCURSOR)
                       (EXPANDW
 ICONW]
       (T (MOVEW ICONW])

(ICONPOSITION.FROM.WINDOW

  [LAMBDA (WINDOW ICONREGION)
                                (* bvm%: "18-Mar-86 14:03")

    (OR (POSITIONP (WINDOWPROP WINDOW 'ICONPOSITION))
        (LET ((WREG (WINDOWPROP WINDOW 'REGION))
              SCREEN)
             (SETQ SCREEN (fetch
 (WINDOW SCREEN) of
 WINDOW))
             (create
 POSITION
                    XCOORD _ [COND
                                ((ILESSP (fetch
 (REGION LEFT) of
 WREG)
                                        (IDIFFERENCE (fetch
 (SCREEN SCWIDTH) of
 SCREEN)
                                               (fetch
 (REGION PRIGHT) of
 WREG)))
                                 (IMAX 0 (fetch
 (REGION LEFT) of
 WREG)))
                                (T (IDIFFERENCE (IMIN (fetch
 (SCREEN SCWIDTH) of
 SCREEN)
                                                      (fetch
 (REGION PRIGHT) of
 WREG))
                                          (fetch
 (REGION WIDTH) of
 ICONREGION]
                    YCOORD _ (COND
                                ((ILESSP (fetch
 (REGION BOTTOM) of
 WREG)
                                        (IDIFFERENCE (fetch
 (SCREEN SCHEIGHT) of
 SCREEN)
                                               (fetch
 (REGION PTOP) of
 WREG)))
                                 (IMAX 0 (fetch
 (REGION BOTTOM) of
 WREG)))
                                (T (IDIFFERENCE (IMIN (fetch
 (SCREEN SCHEIGHT) of
 SCREEN)
                                                      (fetch
 (REGION PTOP) of
 WREG))
                                          (fetch
 (REGION HEIGHT) of
 ICONREGION])

(MAKETITLEBARICON

  [LAMBDA (WINDOW TEXT)
                                      (* bvm%: "18-Mar-86 14:04")

          
          (* * Make a "title bar" icon consisting of TEXT or WINDOW's TITLE if TEXT is 

          NIL)


    (PROG ((SCREEN (fetch
 (WINDOW SCREEN) of
 WINDOW))
           W REG POS)
          [COND
             ((AND (NULL TEXT)
                   (OR [NULL (SETQ TEXT (WINDOWPROP WINDOW 'TITLE]
                       (EQ (NCHARS TEXT)
                           0)))
              (SETQ TEXT (CONCAT "Icon made " (DATE]
          [SETQ POS (ICONPOSITION.FROM.WINDOW
 WINDOW
                           (SETQ REG (create
 REGION
                                            LEFT _ 0
                                            BOTTOM _ 0
                                            HEIGHT _ (IMINUS (DSPLINEFEED NIL (fetch
 (SCREEN 
                                                                                            SCTITLEDS
                                                                                            )
                                                                                 of
 SCREEN)))
                                            WIDTH _ (IMAX MinWindowWidth
                                                          (IPLUS 8 (STRINGWIDTH TEXT
                                                                          (fetch
 (SCREEN SCTITLEDS)
                                                                             of
 SCREEN]
          
          (* Position the icon near the current location of the window)


          (replace
 (REGION LEFT) of
 REG with
 (fetch
 (POSITION XCOORD) of
 POS))
          (replace
 (REGION BOTTOM) of
 REG with
 (fetch
 (POSITION YCOORD) of
 POS))
          (SETQ W (CREATEW REG TEXT NIL T))
          (WINDOWPROP W 'MINSIZE (FUNCTION \TITLEICONMINSIZE))
          (RETURN W])

(\TITLEICONMINSIZE

  [LAMBDA (WINDOW)
                                           (* kbr%: "29-Mar-85 14:14")

                                                             (* returns the minimum size the 

                                                             default icon can be.)

    (CONS MinWindowWidth (IMINUS (DSPLINEFEED NIL (fetch
 (SCREEN SCTITLEDS)
                                                     of
 (fetch
 (WINDOW SCREEN) of
 WINDOW])

(\NOTENEWICONPOSITION

  [LAMBDA (ICONW NEWPOS)
                                     (* rrb "13-Jan-84 10:39")

          
          (* saves the new position of the icon on the property list so that the icon 

          will come up there again.)


    (AND (SETQ ICONW (WINDOWPROP ICONW 'ICONFOR))
         (WINDOWPROP ICONW 'ICONPOSITION NEWPOS))
    NEWPOS])

(EXPANDW

  [LAMBDA (ICONW)
                             (* ; 

                                                "Edited  2-Feb-94 13:10 by sybalsky:mv:envos")

    (WINDOWOP 'EXPANDWFN (fetch
 (WINDOW SCREEN) of
 (SETQ ICONW (\INSUREWINDOW ICONW)))
           ICONW])

(DOICONWINDOWCOM

  [LAMBDA (WINDOW)
                                           (* rrb " 7-AUG-83 18:52")

          
          (* the button handler for an ICON window Test for non-NIL WINDOW means that 

          caller needn't worry about whether the mouse is pointing at a window.)


    (AND (type?
 WINDOW WINDOW)
         (PROG (COM)
               (TOTOPW WINDOW)
               (RETURN (COND
                          ((SETQ COM (MENU [COND
                                              ((TYPENAMEP IconWindowMenu 'MENU)
                                               IconWindowMenu)
                                              ((SETQ IconWindowMenu
                                                (create
 MENU
                                                       ITEMS _ IconWindowMenuCommands
                                                       CHANGEOFFSETFLG _ 'Y
                                                       MENUOFFSET _
                                                       (create
 POSITION
                                                              XCOORD _ -1
                                                              YCOORD _ 0)
                                                       WHENHELDFN _ (FUNCTION PPROMPT3)
                                                       WHENUNHELDFN _ (FUNCTION CLRPROMPT)
                                                       CENTERFLG _ T]
                                           IconWindowMenu))
                           (APPLY* COM WINDOW)
                           T])

(CLOSEMAINWINDOW

  [LAMBDA (ICONWIN)
                                          (* rrb "28-JUN-83 11:58")

          
          (* the closefn for an icon window that closes the main window as well.)


    (PROG [(MAINWIN (WINDOWPROP ICONWIN 'ICONFOR]
          [COND
             (MAINWIN (COND
                         ((NULL (\OKTOCLOSEW MAINWIN))
          
          (* Call the main windows closefns. If main window won't close, don't close the 

          icon. The main window has already been removed from the window stack but its 

          closefns haven't been executed.)


                          (RETURN 'DON'T))
                         (T 
          
          (* closefns for main window may have opened it for example by printing to it.

          Close it if it is open.)


                            (AND (OPENWP MAINWIN)
                                 (\CLOSEW1 MAINWIN]
          
          (* break link between the icon and the main window.

          This may give problems if someone holds onto the icon window and explicitly 

          reopens it and expects it to still be an icon.)


          (WINDOWPROP ICONWIN 'ICONFOR NIL)
          (RETURN NIL])

(CLOSEICONWINDOW

  [LAMBDA (MAINWIN)
                                          (* rrb " 1-May-85 15:55")

          
          (* the open function for a window which has an icon.

          It closes the (icon and does the expandfns))


    (PROG ((ICONW (WINDOWPROP MAINWIN 'ICONWINDOW))
           USEREXPANDFN)
          
          (* this code duplicates much of EXPANDW but I couldn't quite get it to be a 

          call because EXPANDW opens the main window which in this case is already open.)


          (COND
             (ICONW                                          (* Don't die if user removed the 

                                                             ICONWINDOW prop)

                    (WINDOWDELPROP ICONW 'CLOSEFN 'CLOSEMAINWINDOW)
                                                             (* remove the mainwindowclosing 

                                                             function first.)

                    (CLOSEW ICONW)
                    (DOUSERFNS (WINDOWPROP MAINWIN 'EXPANDFN)
                           MAINWIN)                          (* break link from icon to main 

                                                             window.)

                    (WINDOWPROP ICONW 'ICONFOR NIL)))        (* remove icon closing function.)

          (WINDOWDELPROP MAINWIN 'OPENFN 'CLOSEICONWINDOW])
)

(RPAQ? IconWindowMenu
 )

(RPAQ? DEFAULTICONFN
 'MAKETITLEBARICON)

(ADDTOVAR IconWindowMenuCommands

          (Close 'CLOSEW "Closes the icon and its associated window")
          (Snap 'SNAPW "Saves a snapshot of a region of the screen.")
          (Paint 'PAINTW 
  "Starts a painting mode in which the mouse can
be used to draw pictures or make notes on the icon.")
          (Bury 'BURYW "Puts the icon on the bottom.")
          (Move 'MOVEW "Moves the icon by a corner.")
          (Shape 'SHAPEW "Gets a new region for the icon.")
          (Expand 'EXPANDW "Expands the window for which this is the ICON."))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DEFAULTICONFN IconWindowMenu IconWindowMenuCommands)
)
(PUTPROPS WINDOWICON COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1993 1994))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1431 11211 (SHRINKW 1441 . 1810) (ICONBUTTONEVENTFN 1812 . 2211) (
ICONPOSITION.FROM.WINDOW 2213 . 3889) (MAKETITLEBARICON 3891 . 5840) (\TITLEICONMINSIZE 5842 . 6329) (
\NOTENEWICONPOSITION 6331 . 6708) (EXPANDW 6710 . 6995) (DOICONWINDOWCOM 6997 . 8582) (CLOSEMAINWINDOW
 8584 . 9807) (CLOSEICONWINDOW 9809 . 11209)))))
STOP