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.DOMAIN.EXT
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXGKB 2601 printed Nov 22, 2024@17:12:30 Page 2
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.DOMAIN.EXT
+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
