XGKB.m

XGKB ;SFISC/VYD - Read with Escape Processing ;10/23/2006

 ;;8.0;KERNEL;**34,244,365**;Jul 10, 1995;Build 5

 ;;Special thanks to MELDRUM.KEVIN@ISC-SLC.VA.GOV

 ;

INIT(XGTRM) ;turn escape processing on and passed terminator string if any

 N %,%OS S %OS=^%ZOSF("OS")

 I %OS["VAX DSM" U $I:(NOLINE:ESCAPE) D:'$D(^XUTL("XGKB")) VAXDSM^XGKB1

 I %OS["MSM" U $I:(0::::64) D:'$D(^XUTL("XGKB")) MSM^XGKB1

 I %OS["DTM" U $I:(VT=1:ESCAPE=1) D:'$D(^XUTL("XGKB")) DTM^XGKB1

 I %OS["OpenM" U $I:(:"CT") D:'$D(^XUTL("XGKB")) DTM^XGKB1 S:$G(XGTRM)="*" XGTRM=""

 I %OS["GT.M" U $I:(ESCAPE) D:'$D(^XUTL("XGKB")) GTM^XGKB1

 I $G(XGTRM)="*" X ^%ZOSF("TRMON") I 1 ;turn all on

 E  I $L($G(XGTRM)) S %=$$SETTRM^%ZOSV(XGTRM) ;turn on passed terminators

 S XGRT=""

 Q

 ;

 ;

EXIT ; Reset device (disable escape processing, turn terminators off)

 N %OS S %OS=^%ZOSF("OS")

 I %OS["VAX DSM" U $I:(LINE:NOESCAPE)

 I %OS["MSM" U $I:(0:::::64)

 I %OS["DTM" U $I:(ESCAPE=0)

 I %OS["GT.M" U $I:(NOESCAPE)

 X ^%ZOSF("TRMOFF")

 K XGRT

 Q

 ;

 ;

ACTION(XGKEY,XGACTION) ;add or remove key-action

 ;XGKEY:key mnemonic ("F10","NEXT",etc.)

 ;XGACTION:M executable string

 ;if action is passed ADD mode is assumed otherwise REMOVE

 I $D(XGACTION) S ^TMP("XGKEY",$J,XGKEY)=XGACTION

 E  K ^TMP("XGKEY",$J,XGKEY)

 Q

 ;

 ;

READ(XGCHARS,XGTO) ; read XGCHARS using escape processing. XGTO timeout (optional).  Result returned.

 ; Char that terminated the read will be in XGRT

 N S,XGW1,XGT1,XGSEQ ;string,window,timer,timer sequence

 K DTOUT

 S XGRT=""

 D:$G(XGTO)=""                 ;set timeout value if one wasn't passed

 . I $D(XGT) D  Q              ;if timers are defined

 . . S XGTO=$O(XGT(0,""))      ;get shortest time left of all timers

 . . S XGW1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,1) ;get timer's window

 . . S XGT1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,3) ;get timer's name

 . I $D(XGW) S XGTO=99999999 Q  ;in emulation read forever

 . S XGTO=$G(DTIME,600)

 ;

 I $G(XGCHARS)>0 R S#XGCHARS:XGTO S:'$T DTOUT=1 I 1 ;fixed length read

 E  R S:XGTO S:'$T DTOUT=1 I 1 ;read as many as possible

 S:$G(DTOUT)&('$D(XGT1)) S=U                          ;stuff ^

 ;

 S:$L($ZB) XGRT=$G(^XUTL("XGKB",$ZB))          ;get terminator if any

 I $G(DTOUT),$D(XGT1),$D(^TMP("XGW",$J,XGW1,"T",XGT1,"EVENT","TIMER")) D  I 1 ;if timed out

 . D E^XGEVNT1(XGW1,"T",XGT1,"","TIMER")

 E  I $L(XGRT),$D(^TMP("XGKEY",$J,XGRT)) X ^(XGRT)     ;do some action

 ; this really should be handled by keyboard mapping -- later

 Q S

 ;

 ;

TEST F  S X=$$READ Q:X["^"  W ?20,X,?40,XGRT,?60,$ZB,!

 Q

XGKB      ;SFISC/VYD - Read with Escape Processing ;10/23/2006

 +1       ;;8.0;KERNEL;**34,244,365**;Jul 10, 1995;Build 5

 +2       ;;Special thanks to MELDRUM.KEVIN@ISC-SLC.VA.GOV

 +3       ;

INIT(XGTRM) ;turn escape processing on and passed terminator string if any

 +1        NEW %,%OS

           SET %OS=^%ZOSF("OS")

 +2        IF %OS["VAX DSM"

               USE $IO:(NOLINE:ESCAPE)

               IF '$DATA(^XUTL("XGKB"))

                   DO VAXDSM^XGKB1

 +3        IF %OS["MSM"

               USE $IO:(0::::64)

               IF '$DATA(^XUTL("XGKB"))

                   DO MSM^XGKB1

 +4        IF %OS["DTM"

               USE $IO:(VT=1:ESCAPE=1)

               IF '$DATA(^XUTL("XGKB"))

                   DO DTM^XGKB1

 +5        IF %OS["OpenM"

               USE $IO:(:"CT")

               IF '$DATA(^XUTL("XGKB"))

                   DO DTM^XGKB1

               IF $GET(XGTRM)="*"

                   SET XGTRM=""

 +6        IF %OS["GT.M"

               USE $IO:(ESCAPE)

               IF '$DATA(^XUTL("XGKB"))

                   DO GTM^XGKB1

 +7       ;turn all on

           IF $GET(XGTRM)="*"

               XECUTE ^%ZOSF("TRMON")

               IF 1

 +8       ;turn on passed terminators

          IF '$TEST

               IF $LENGTH($GET(XGTRM))

                   SET %=$$SETTRM^%ZOSV(XGTRM)

 +9        SET XGRT=""

 +10       QUIT 

 +11      ;

 +12      ;

EXIT      ; Reset device (disable escape processing, turn terminators off)

 +1        NEW %OS

           SET %OS=^%ZOSF("OS")

 +2        IF %OS["VAX DSM"

               USE $IO:(LINE:NOESCAPE)

 +3        IF %OS["MSM"

               USE $IO:(0:::::64)

 +4        IF %OS["DTM"

               USE $IO:(ESCAPE=0)

 +5        IF %OS["GT.M"

               USE $IO:(NOESCAPE)

 +6        XECUTE ^%ZOSF("TRMOFF")

 +7        KILL XGRT

 +8        QUIT 

 +9       ;

 +10      ;

ACTION(XGKEY,XGACTION) ;add or remove key-action

 +1       ;XGKEY:key mnemonic ("F10","NEXT",etc.)

 +2       ;XGACTION:M executable string

 +3       ;if action is passed ADD mode is assumed otherwise REMOVE

 +4        IF $DATA(XGACTION)

               SET ^TMP("XGKEY",$JOB,XGKEY)=XGACTION

 +5       IF '$TEST

               KILL ^TMP("XGKEY",$JOB,XGKEY)

 +6        QUIT 

 +7       ;

 +8       ;

READ(XGCHARS,XGTO) ; read XGCHARS using escape processing. XGTO timeout (optional).  Result returned.

 +1       ; Char that terminated the read will be in XGRT

 +2       ;string,window,timer,timer sequence

           NEW S,XGW1,XGT1,XGSEQ

 +3        KILL DTOUT

 +4        SET XGRT=""

 +5       ;set timeout value if one wasn't passed

           IF $GET(XGTO)=""

               Begin DoDot:1

 +6       ;if timers are defined

                   IF $DATA(XGT)

                       Begin DoDot:2

 +7       ;get shortest time left of all timers

                           SET XGTO=$ORDER(XGT(0,""))

 +8       ;get timer's window

                           SET XGW1=$PIECE(XGT(0,XGTO,$ORDER(XGT(0,XGTO,"")),"ID"),U,1)

 +9       ;get timer's name

                           SET XGT1=$PIECE(XGT(0,XGTO,$ORDER(XGT(0,XGTO,"")),"ID"),U,3)

                       End DoDot:2

                       QUIT 

 +10      ;in emulation read forever

                   IF $DATA(XGW)

                       SET XGTO=99999999

                       QUIT 

 +11               SET XGTO=$GET(DTIME,600)

               End DoDot:1

 +12      ;

 +13      ;fixed length read

           IF $GET(XGCHARS)>0

               READ S#XGCHARS:XGTO

               IF '$TEST

                   SET DTOUT=1

               IF 1

 +14      ;read as many as possible

          IF '$TEST

               READ S:XGTO

               IF '$TEST

                   SET DTOUT=1

               IF 1

 +15      ;stuff ^

           IF $GET(DTOUT)&('$DATA(XGT1))

               SET S=U

 +16      ;

 +17      ;get terminator if any

           IF $LENGTH($ZB)

               SET XGRT=$GET(^XUTL("XGKB",$ZB))

 +18      ;if timed out

           IF $GET(DTOUT)

               IF $DATA(XGT1)

                   IF $DATA(^TMP("XGW",$JOB,XGW1,"T",XGT1,"EVENT","TIMER"))

                       Begin DoDot:1

 +19                       DO E^XGEVNT1(XGW1,"T",XGT1,"","TIMER")

                       End DoDot:1

                       IF 1

 +20      ;do some action

          IF '$TEST

               IF $LENGTH(XGRT)

                   IF $DATA(^TMP("XGKEY",$JOB,XGRT))

                       XECUTE ^(XGRT)

 +21      ; this really should be handled by keyboard mapping -- later

 +22       QUIT S

 +23      ;

 +24      ;

TEST       FOR 

               SET X=$$READ

               IF X["^"

                   QUIT 

               WRITE ?20,X,?40,XGRT,?60,$ZB,!

 +1        QUIT