| 1 | XGKB ;SFISC/VYD - Read with Escape Processing ;10/23/2006
|
|---|
| 2 | ;;8.0;KERNEL;**34,244,365**;Jul 10, 1995;Build 5
|
|---|
| 3 | ;;Special thanks to MELDRUM.KEVIN@ISC-SLC.VA.GOV
|
|---|
| 4 | ;
|
|---|
| 5 | INIT(XGTRM) ;turn escape processing on and passed terminator string if any
|
|---|
| 6 | N %,%OS S %OS=^%ZOSF("OS")
|
|---|
| 7 | I %OS["VAX DSM" U $I:(NOLINE:ESCAPE) D:'$D(^XUTL("XGKB")) VAXDSM^XGKB1
|
|---|
| 8 | I %OS["MSM" U $I:(0::::64) D:'$D(^XUTL("XGKB")) MSM^XGKB1
|
|---|
| 9 | I %OS["DTM" U $I:(VT=1:ESCAPE=1) D:'$D(^XUTL("XGKB")) DTM^XGKB1
|
|---|
| 10 | I %OS["OpenM" U $I:(:"CT") D:'$D(^XUTL("XGKB")) DTM^XGKB1 S:$G(XGTRM)="*" XGTRM=""
|
|---|
| 11 | I %OS["GT.M" U $I:(ESCAPE) D:'$D(^XUTL("XGKB")) GTM^XGKB1
|
|---|
| 12 | I $G(XGTRM)="*" X ^%ZOSF("TRMON") I 1 ;turn all on
|
|---|
| 13 | E I $L($G(XGTRM)) S %=$$SETTRM^%ZOSV(XGTRM) ;turn on passed terminators
|
|---|
| 14 | S XGRT=""
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | EXIT ; Reset device (disable escape processing, turn terminators off)
|
|---|
| 19 | N %OS S %OS=^%ZOSF("OS")
|
|---|
| 20 | I %OS["VAX DSM" U $I:(LINE:NOESCAPE)
|
|---|
| 21 | I %OS["MSM" U $I:(0:::::64)
|
|---|
| 22 | I %OS["DTM" U $I:(ESCAPE=0)
|
|---|
| 23 | I %OS["GT.M" U $I:(NOESCAPE)
|
|---|
| 24 | X ^%ZOSF("TRMOFF")
|
|---|
| 25 | K XGRT
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | ACTION(XGKEY,XGACTION) ;add or remove key-action
|
|---|
| 30 | ;XGKEY:key mnemonic ("F10","NEXT",etc.)
|
|---|
| 31 | ;XGACTION:M executable string
|
|---|
| 32 | ;if action is passed ADD mode is assumed otherwise REMOVE
|
|---|
| 33 | I $D(XGACTION) S ^TMP("XGKEY",$J,XGKEY)=XGACTION
|
|---|
| 34 | E K ^TMP("XGKEY",$J,XGKEY)
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | READ(XGCHARS,XGTO) ; read XGCHARS using escape processing. XGTO timeout (optional). Result returned.
|
|---|
| 39 | ; Char that terminated the read will be in XGRT
|
|---|
| 40 | N S,XGW1,XGT1,XGSEQ ;string,window,timer,timer sequence
|
|---|
| 41 | K DTOUT
|
|---|
| 42 | S XGRT=""
|
|---|
| 43 | D:$G(XGTO)="" ;set timeout value if one wasn't passed
|
|---|
| 44 | . I $D(XGT) D Q ;if timers are defined
|
|---|
| 45 | . . S XGTO=$O(XGT(0,"")) ;get shortest time left of all timers
|
|---|
| 46 | . . S XGW1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,1) ;get timer's window
|
|---|
| 47 | . . S XGT1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,3) ;get timer's name
|
|---|
| 48 | . I $D(XGW) S XGTO=99999999 Q ;in emulation read forever
|
|---|
| 49 | . S XGTO=$G(DTIME,600)
|
|---|
| 50 | ;
|
|---|
| 51 | I $G(XGCHARS)>0 R S#XGCHARS:XGTO S:'$T DTOUT=1 I 1 ;fixed length read
|
|---|
| 52 | E R S:XGTO S:'$T DTOUT=1 I 1 ;read as many as possible
|
|---|
| 53 | S:$G(DTOUT)&('$D(XGT1)) S=U ;stuff ^
|
|---|
| 54 | ;
|
|---|
| 55 | S:$L($ZB) XGRT=$G(^XUTL("XGKB",$ZB)) ;get terminator if any
|
|---|
| 56 | I $G(DTOUT),$D(XGT1),$D(^TMP("XGW",$J,XGW1,"T",XGT1,"EVENT","TIMER")) D I 1 ;if timed out
|
|---|
| 57 | . D E^XGEVNT1(XGW1,"T",XGT1,"","TIMER")
|
|---|
| 58 | E I $L(XGRT),$D(^TMP("XGKEY",$J,XGRT)) X ^(XGRT) ;do some action
|
|---|
| 59 | ; this really should be handled by keyboard mapping -- later
|
|---|
| 60 | Q S
|
|---|
| 61 | ;
|
|---|
| 62 | ;
|
|---|
| 63 | TEST F S X=$$READ Q:X["^" W ?20,X,?40,XGRT,?60,$ZB,!
|
|---|
| 64 | Q
|
|---|
