[comp.sys.xerox] Case Lock Monitor

ttf@VAX3.ITI.ORG ("Tihamer T. Toth-Fejel") (09/09/89)

If you always type in upper case, like we did at Ford Aerospace,
ignore this message.
If you are working on a true Xerox (as opposed to a Sun), you
may also ignore this message.

However, if you HATE the fact that the upper case lock button on the
Sun does not light up, and you use it often enough to be distracted
by it, the following code may help. It brings up a small window
in the lower left hand corner that lets you know whether you are in
locked mode or not.

internet:  ttf@iti.org     (Tihamer T. Toth-Fejel)
Industrial Technologies Institute, Ann Arbor, Michigan 48106
(313) 769-4248 or 4345     home: (313) 622-4741
*----*----*----*----*----*----*----*----*----*----*----*----*----*
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "30-Aug-89 00:09:40" {DSK}/home/curly/ttf/envos/CASE-MONITOR.;3 6893   

      changes to%:  (FNS INIT-CASE-LOCK RESET-CASE-LOCK UPDATE-CASE-LOCK EXIT-CASE-LOCK)
                    (VARS CASE-MONITORCOMS)

      previous date%: "29-Aug-89 19:28:38" {DSK}/home/curly/ttf/envos/CASE-MONITOR.;1)


(* "
Copyright (c) 1989 by ITI.  All rights reserved.
")

(PRETTYCOMPRINT CASE-MONITORCOMS)

(RPAQQ CASE-MONITORCOMS ((FNS EXIT-CASE-LOCK INIT-CASE-LOCK RESET-CASE-LOCK UPDATE-CASE-LOCK)
                             (VARS *locked-bitmap* *unlocked-bitmap*)))
(DEFINEQ

(EXIT-CASE-LOCK
  [LAMBDA NIL                                     (* ; "Edited 29-Aug-89 22:25 by t.toth-fejel")
    (SETQ BACKGROUNDFNS (REMOVE 'UPDATE-CASE-LOCK BACKGROUNDFNS])

(INIT-CASE-LOCK
  [LAMBDA NIL                                     (* ; "Edited 29-Aug-89 22:40 by t.toth-fejel")
    (SETQ *case-lock-window*
     (CREATEW (create REGION
                     LEFT _ 0
                     BOTTOM _ 0
                     WIDTH _ 220
                     HEIGHT _ 70)
            "Case Lock Monitor"))
    (if (NOT (MEMBER 'UPDATE-CASE-LOCK BACKGROUNDFNS))
        then (SETQ BACKGROUNDFNS (CONS 'UPDATE-CASE-LOCK BACKGROUNDFNS)))
    (RESET-CASE-LOCK)
    (WINDOWPROP *case-lock-window* 'BUTTONEVENTFN 'RESET-CASE-LOCK)
    (WINDOWPROP *case-lock-window* 'CLOSEFN 'EXIT-CASE-LOCK])

(RESET-CASE-LOCK
  [LAMBDA NIL                                     (* ; "Edited 29-Aug-89 22:40 by t.toth-fejel")
    (WINDOWPROP *case-lock-window* 'old-shift-lock 'unknown)
    (TOTOPW *case-lock-window*)
    (UPDATE-CASE-LOCK])

(UPDATE-CASE-LOCK
  [LAMBDA NIL                                     (* ; "Edited 29-Aug-89 22:21 by t.toth-fejel")
    (LET [(state (SHIFTDOWNP 'LOCK))
          (old-state (WINDOWPROP *case-lock-window* 'old-shift-lock]
         (if (AND state (NULL old-state))
             then (CENTERBM *locked-bitmap* *case-lock-window* T)
                   (WINDOWPROP *case-lock-window* 'old-shift-lock state)
           elseif (AND old-state (NULL state))
             then (CENTERBM *unlocked-bitmap* *case-lock-window* T)
                   (WINDOWPROP *case-lock-window* 'old-shift-lock state])
)

(RPAQQ *locked-bitmap* #*(212 50)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOO




OOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOO@@COOOOOO@@GOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOL@@@GOOOOH@@@GOOOOH@@@ML@@@L@@CL@@@@@GL@@@@AOOOOOO@@@OOOO@@AOOOON@AN@AOOON@@F@AO@@AO@@OO@@@@@GO@@@@@COOOOO@@@OOOOH@COOOOH@GOH@GOOL@AOLAOH@COHCOOH@CN@GOH@AN@@OOOOO@@@OOOOH@COOOO@@GOH@COO@@CONAOH@COHGOOH@COHGOH@CO@@GOOOO@@@OOOOH@COOON@@OOL@AOO@@GOOAOH@CO@OO




OH@COLGOH@COH@COOOO@@@OOOOH@COOOL@@OOL@@ON@@GOOAOH@COAOOOH@CONGOH@COH@COOOO@@@OOOOH@COOOL@@OOL@@OL@@OOOIOH@CNCOOOH@CONGOH@COL@AOOOO@@@OOOOH@COOOH@@OOL@@GL@@OOOIOH@CLGOOOH@CLOOOH@COL@@OOOO@@@OOOOH@COOOH@AOON@@GL@@OOOOOH@CHOOOOH@CLOOOH@COL@@OOOO@@@OOOOH@COOOH@AOON@@GH@AOOOOOH@C@OOOOH@CLOOOH@CON@@OOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@B@GOOOH@CHOOOH@CON@@OOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@@@GOOOH@C@OOOH@CON@@GOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@@@COOOH@@@OOOH@CON@@GOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@@@AOOOH@@@OO




OH@CON@@GOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@@@AOOOH@C@OOOH@CON@@GOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@@@@OOOH@CHOOOH@CON@@GOOO@@@OOOOH@COOO@@AOON@@CH@AOOOOOH@B@@GOOH@CLOOOH@CON@@OOOO@@@OOOOH@COOOH@AOON@@GH@@OOOOOH@B@@GOOH@CLOOOH@CON@@OOOO@@@OOOOH@COOGH@AOON@@GL@@OOOOOH@C@@COOH@CLOOOH@CON@@OOOO@@@OOOOH@COOGH@@OOL@@GL@@OOOOOH@C@@AOOH@COOIOH@COL@@OOOO@@@OOOOH@CONGL@@OOL@@OL@@GOOOOH@CH@AOOH@COOIOH@COL@AOOOO@@@OOOOH@CONGL@@OOL@@ON@@GOOOOH@CH@@OOH@COOAOH@COL@AOOOO@@@OOOOH@COLGN@@OOL@AOO@@COOIOH@CL@@GOH@COOCOH@COH@




C




OOOO@@@OOOOH@COHGO@@GOH@COO@@AONAOH@CL@@GOH@CONCOH@COH@GOOOO@@@OOOOH@AN@OOH@GOH@GOOL@@GHCOH@CN@@COH@COHCOH@AO@@OOOOO@@@OOOO@@@@@OON@AN@AOOON@@@@GO@@AN@@AO@@@@@CO@@@@@COOOOO@@@OOOL@@@@@OOOH@@@GOOOOH@@AOL@@@L@@@L@@@@@GL@@@@@OOOOOO@@@OOOOOOOOOOOOO@@COOOOOO@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@




OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO@@@
)

(RPAQQ *unlocked-bitmap* #*(174 36)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AOOH@@@@@@@@@@COO@@@@@@@@@@@OOL@@@@@@@@@@@@@@OOH@@@@@@@@@@AOO@@@@@@@@@@@GOL@@@@@@@@@@@@@@GOH@@@@@@@@@@@OO@@@@@@@@@@@COL@@@@@@@@@@@@@@GOH@@@@@@@@@@@OO@@@@@@@@@@@COL@@@@@@@@@@@@@@GOH@@@@@@@@@@@OO@@@@@@@@@@@COL@@@@@@@@@@@@@@GOH@@@@@@@@@@@OO@@@@@@@@@@@COL@@@@@@@@@@@@@@GOH@@@@@@@@@@@OO@@@@@@@@@@@COL@@@@@@@@@@@@@@GOH@@@@@@@@@@@OO@@@@@@@@@@@COL@@@@@@@@@@@G@@GOH@@@@@@@@@@@OO@@@@@@@




@@@@COL@@OOOOOAOOIOL@GOH@AOL@@@OO@@OOGON@@ON@@AOCOL@@GOMOO@OOKON@GOH@GOO@@COOL@OOCOL@COOH@GOKOL@@COLOO@GOOOO@GOHAOMOL@GNGN@OOAO@@GNGL@OOOOL@@COLOO@GOMOO@GOHCOHON@ONGO@OOAN@@OLCNAOOGOL@@COLOO@GOHOO@GOHCOHONAOLGO@OOCL@@OLCNAONCOL@@COLOO@GOHOO@GOHGOHOOAOLGO@OOGH@AOLCOAONCOL@@COLOO@GOHOO@GOHGOHOOAOLCN@OOOL@AOLCOCOLCOL@@COLOO@GOHOO@GOHGO@GOCOLAL@OOOL@AOLCOCOLCOL@@COLOO@GOHOO@GOHOO@GOKOL@@@OOON@COOOOCOLCOL@@COLOO@GOHOO@GOHOO@GOKOL@@@OOON@COOOOCOLCOL@@COLOO@GOHOO@GOHOO@GOKOL@@@OOOO@COL@@COLCOL@@COLOO@GOHOO@GOH




OO@GOKOL@@@OOOO@COL@@COLCOL@@COLOO@GOHOO@GOHGO@GOCOL@@@OOGOHAOL@@COLCOL@@COLOO@GOHOO@GOHGOHOOCON@@@OOGOHAON@@AONCOL@@COLOO@GOHOO@GOHGOHOOAON@@@OOCOLAON@FAONCOL@@COLOO@GOHOO@GOHCOHONAOOHF@OOCOL@OOHNAOOCOL@@COMOO@GOHOO@GOHCOHON@OOON@OOAON@OOOL@OOOOL@@AOOOOHOOMOOHOOLAOMOL@GOOLAOOION@GOOL@OOOON@@AOOGOMOOOOOMOON@GOO@@COOHCOOOOO@COO@@GOCOO@@@GL@@@@@@@@@@@@@AOL@@@OL@@@@@@@@@OL@@ALCH@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@




@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
)
(PUTPROPS CASE-MONITOR COPYRIGHT ("ITI" 1989))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (641 2355 (EXIT-CASE-LOCK 651 . 841) (INIT-CASE-LOCK 843 . 1485) (RESET-CASE-LOCK 1487
 . 1733) (UPDATE-CASE-LOCK 1735 . 2353)))))
STOP