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

(FILECREATED "29-Oct-87 18:18:54" {ERINYES}<LISPUSERS>LISPCORE>DLIONFNKEYS.;1
 6304   

      changes to%:  (FNS BUILDFNKEYS)

      previous date%: "19-Nov-85 12:20:57" {ERINYES}<LISP>LYRIC>LISPUSERS>DLIONFNKEYS.;1)


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

(PRETTYCOMPRINT DLIONFNKEYSCOMS)

(RPAQQ DLIONFNKEYSCOMS
 [(FILES KEYOBJ)
                        (GLOBALVARS DLION.FN.KEYS DLION.FN.KEYLABELS KEYOBJ.TEMPLATE)
                        [VARS (DLION.FN.KEYS '(CENTER BOLD ITALICS UNDERLINE SUPERSCRIPT SUBSCRIPT 
                                                     SMALLER DEFAULTS))
                              (DLION.FN.KEYLABELS '(CENTER BOLD ITALICS (UNDER- LINE)
                                                          (SUPER- SCRIPT)
                                                          (SUB- SCRIPT)
                                                          SMALLER DEFAULTS]
                        (BITMAPS FNKEYICON)
                        (FNS BUILDFNKEYS FNKEY.MENUFN)
                        (INITVARS (FNKEY.MENU (create MENU ITEMS _ '((Close 'CLOSEW "Closes a window"
                                                                            )
                                                                     (Bury 'BURYW 
                                                                       "Puts a window on the bottom."
                                                                           )
                                                                     (Move 'MOVEW 
                                                                        "Moves a window by a corner."
                                                                           )
                                                                     (Shrink 'SHRINKW 
                                                                 "Replaces this window with its icon"
                                                                            ])
(FILESLOAD KEYOBJ)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DLION.FN.KEYS DLION.FN.KEYLABELS KEYOBJ.TEMPLATE)
)

(RPAQQ DLION.FN.KEYS
 (CENTER BOLD ITALICS UNDERLINE SUPERSCRIPT SUBSCRIPT SMALLER DEFAULTS))

(RPAQQ DLION.FN.KEYLABELS
 (CENTER BOLD ITALICS (UNDER- LINE)
                                 (SUPER- SCRIPT)
                                 (SUB- SCRIPT)
                                 SMALLER DEFAULTS))

(RPAQQ FNKEYICON
 #*(80 50)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@@@@@@@@@@@@@@OOOH@@@@@@@@@@@@@@@@AOOH@@@@@@@@@@@@@@@@AONL@@@@@@@@@@@@@@@@BGOFCOOOOOOOOOOOOOOLDGNKF@@@@@@@@@@@@@@FHGMEH@@@@@@@@@@@@@@A@CNK@@@@@@@@@@@@@@@@HCMG@@@@@@@@@@@@@@@@LCNJ@@@@@@@@@@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@D@@@@@DCMF@CO@@@@@@DD@@@@@DCNJ@B@@@@@@@D@@@@@@DCMF@B@BABNALODGHKH@DCNJ@CNBACABBDDHDLD@DCMF@B@BABAB@DDHDHD@DCNJ@B@BABAB@DDHDHD@DCMF@B@BCBABBDDHDHD@DCNJ@B@AMBAALCDGHHD@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNJ@@@@@@@@@@@@@@@@DCMF@@@@BA@@@@@@@@@@DCNJ@@@@BB@@@@@@@@@@DCMF@@@@BD@NBBCH@@@@DCNJ@@@@BHAABBDD@@@@DCMF@@@@CDAOADCH@@@@DCNJ@@@@BBA@AD@D@@@@DCMF@@@@BAAA@HDD@@@@DCNJ@@@@B@HN@HCH@@@@DCMF@@@@@@@@@H@@@@@@DCNJ@@@@@@@@C@@@@@@@DCMF@@@@@@@@@@@@@@@@DCNK@@@@@@@@@@@@@@@@LCME@@@@@@@@@@@@@@@@HCNKH@@@@@@@@@@@@@@A@COBN@@@@@@@@@@@@@@GHGNDKOOOOOOOOOOOOOONLGOIAEEEEEEEEEEEEEEEFGOBBJJJJJJJJJJJJJJJKOOLEEEEEEEEEEEEEEEEEOONBJJJJJJJJJJJJJJJOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
)
(DEFINEQ

(BUILDFNKEYS

  [LAMBDA NIL
                                                (* ; "Edited 29-Oct-87 18:14 by jds")


    (PROG ((TXT (OPENTEXTSTREAM NIL NIL NIL NIL))
           (WIDTH (FIX (TIMES (BITMAPWIDTH KEYOBJ.TEMPLATE)
                              8.3)))
           W)
          (TEDIT.INSERT TXT (CHARACTER (CHARCODE EOL))
                 1)
          (for
 KEY in
 DLION.FN.KEYS as
 LABEL in
 DLION.FN.KEYLABELS
             do
 (TEDIT.INSERT.OBJECT (KEYOBJ.CREATE KEY LABEL T)
                       TXT))                                 (* ; 

   "this will create abortable key objects (if you slide out of the region, no transitions are sent)")


          (TEDIT.SETSEL TXT 2 0 'LEFT)
          (TEDIT.PARALOOKS TXT '(QUAD CENTERED))             (* ; 

                                     "(TEDIT.NORMALIZECARET TXT (TEDIT.SETSEL TXT 0 0 (QUOTE LEFT)))")


          (SETQ W (CREATEW (CREATEREGION (IQUOTIENT (IDIFFERENCE (BITMAPWIDTH (SCREENBITMAP))
                                                           WIDTH)
                                                2)
                                  5 WIDTH (IPLUS (FONTPROP MENUFONT 'HEIGHT)
                                                 (BITMAPHEIGHT KEYOBJ.TEMPLATE)
                                                 10))
                         "Dandelion function keys" 2))
          (SCROLLW W 0 -5)                                   (* ; 

                                                             "used to have NOTITLE T in the props")

                                                             (* ; 

                                            "TEDIT TXT W NIL (QUOTE (LEAVETTY T PROMPTWINDOW DON'T))")


          (OPENTEXTSTREAM TXT W NIL NIL '(READONLY T))
          (WINDOWPROP W 'WINDOWENTRYFN 'NIL)                 (* ; 

                                                           "(WINDOWPROP W (QUOTE TITLE) (QUOTE NIL))")


          (WINDOWPROP W 'ICON FNKEYICON)
          (WINDOWPROP W 'RIGHTBUTTONFN 'FNKEY.MENUFN)
          (SETQ DLIONFNKEYS W])

(FNKEY.MENUFN

  [LAMBDA (KEYWINDOW)
                                        (* gbn "28-Jan-85 01:17")

    (PROG ((ITEM (MENU FNKEY.MENU)))
          (COND
             (ITEM (APPLY* ITEM KEYWINDOW])
)

(RPAQ? FNKEY.MENU
 [create MENU ITEMS _ '((Close 'CLOSEW "Closes a window")
                                         (Bury 'BURYW "Puts a window on the bottom.")
                                         (Move 'MOVEW "Moves a window by a corner.")
                                         (Shrink 'SHRINKW "Replaces this window with its icon"])
(PUTPROPS DLIONFNKEYS COPYRIGHT ("Xerox Corporation" 1985 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3544 5868 (BUILDFNKEYS 3554 . 5655) (FNKEY.MENUFN 5657 . 5866)))))
STOP