- 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 Mar 13, 2025@21:07:14 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
