RGUTEDT ;CAIRO/DKM - Screen-oriented line editor;04-Sep-1998 11:26;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
;=================================================================
; Inputs:
; RGDATA = Data to edit
; RGLEN = Maximum length of data
; RGX = Starting column position
; RGY = Starting row position
; RGVALD = List of valid inputs (optional)
; RGDISV = DISV node to save under (optional)
; RGTERM = Valid input terminators (default=<CR>)
; RGABRT = Valid input abort characters (default=none)
; RGRM = Right margin setting (default=IOM or 80)
; RGQUIT = Exit code (returned)
; RGOPT = Input options
; C = Mark <CR> with ~
; E = Echo off
; H = Horizontal scroll
; I = No timeout
; L = Lowercase only
; O = Overwrite mode
; Q = Quiet mode
; R = Reverse video
; T = Auto-terminate
; U = Uppercase only
; V = Up/down cursor keys terminate input
; X = Suppress auto-erase
; Outputs:
; Return value = Edited data
;=================================================================
ENTRY(RGDATA,RGLEN,RGX,RGY,RGVALD,RGOPT,RGDISV,RGTERM,RGABRT,RGRM,RGQUIT) ;
N RGZ,RGZ1,RGZ2,RGSAVE,RGINS,RGAE,RGBUF,RGTAB,RGPOS,RGEON,RGLEFT,RGBEL,RGMAX,RGRVON,RGRVOFF,RGC,RGW
S RGVALD=$G(RGVALD),RGOPT=$$UP^XLFSTR($G(RGOPT)),RGBEL=$S(RGOPT'["Q":$C(7),1:""),RGDISV=$G(RGDISV)
S:$G(RGTERM)="" RGTERM=$C(13) ; Valid line terminators
S RGABRT=$G(RGABRT) ; Valid input abort keys
S RGRVON=$C(27,91,55,109),RGRVOFF=$C(27,91,109) ; Reverse video control
S RGINS=RGOPT'["O" ; Default mode = insert
S RGAE=RGOPT'["X" ; Auto-erase option
S RGEON=RGOPT'["E" ; No echo option
I RGOPT["I"!'$D(DTIME) N DTIME S DTIME=9999999999 ; Suppress timeout option
S RGBUF=""
S RGRM=$G(RGRM,$G(IOM,80)) ; Display width
S RGTAB=$C(9) ; Tab character
S RGX=$G(RGX,$X),RGY=$G(RGY,$Y),RGW=RGRM-RGX
S:RGW'>0 RGW=1
S:'$G(RGLEN) RGLEN=RGW ; Default field width
S RGMAX=$S(RGOPT["H":250,1:RGLEN) ; Maximum data length
S (RGSAVE,RGDATA)=$E($G(RGDATA),1,RGMAX) ; Truncate data if too long
I $$NEWERR^%ZTER N $ET S $ET=""
S @$$TRAP^RGZOSF("ERROR^RGUTEDT")
D RM^RGZOSF(0)
X ^%ZOSF("EOFF")
F Q:RGDATA'[RGTAB S RGZ=$P(RGDATA,RGTAB),RGDATA=RGZ_$J("",8-($L(RGZ)#8))_$P(RGDATA,RGTAB,2,999)
RESTART D RESET
AGAIN F RGQUIT=0:0 Q:RGQUIT D NXT S RGAE=0
X ^%ZOSF("EON")
W $$XY^RGUT(RGX,RGY),$S(RGOPT["R":RGRVOFF,1:"")
I RGDISV'="" Q:"^^"[RGDATA RGDATA S:RGDATA=" " RGDATA=$G(^DISV(DUZ,RGDISV))
S:RGDISV'="" ^DISV(DUZ,RGDISV)=RGDATA
Q RGDATA ; Return to calling routine
NXT D POSCUR() ; Position cursor
R *RGC:DTIME ; Next character typed
I RGC=27 D ESC Q:'RGC
I RGC<1!(RGABRT[$C(RGC)) S RGDATA=U,RGQUIT=1 Q
I RGTERM[$C(RGC) D TERM Q
I RGC<28 D:RGC'=27 @("CTL"_$C(RGC+64)) Q
I RGC=127!(RGC=240) D CTLH Q
I RGC>64,RGC<91,RGOPT["L" S RGC=RGC+32
E I RGC>96,RGC<123,RGOPT["U" S RGC=RGC-32
I $L(RGVALD),RGVALD'[$C(RGC) D RAISE^RGZOSF()
D:RGAE CTLK,POSCUR() ; Erase buffer if auto erase on
D INSW($C(RGC))
S RGQUIT=RGPOS=RGLEN&(RGOPT["T")
Q
CTLA S RGINS='RGINS ; Toggle insert mode
Q
CTLB D MOVETO(0) ; Move cursor to beginning
Q
CTLX S RGDATA=RGSAVE ; Restore buffer to original
G RESET
CTLE D MOVETO($L(RGDATA)) ; Move cursor to end
Q
CTLI D INSW($J("",8-(RGPOS#8))) ; Insert expanded tab
Q
CTLJ F RGZ=RGPOS:-1:1 Q:$A(RGDATA,RGZ)'=32 ; Find previous nonspace
F RGZ=RGZ:-1:1 Q:$A(RGDATA,RGZ)=32 ; Find previous space
S RGBUF=$E(RGDATA,RGZ,RGPOS) ; Save deleted portion
S RGDATA=$E(RGDATA,1,RGZ-1)_$E(RGDATA,RGPOS+1,RGLEN) ; Remove word
D MOVETO(RGZ-1)
Q
CTLK S RGBUF=RGDATA ; Save buffer
S RGDATA="" ; Erase buffer
D RESET
Q
CTLL S RGBUF=$E(RGDATA,RGPOS+1,RGLEN) ; Save deleted portion
S RGDATA=$E(RGDATA,1,RGPOS) ; Truncate at current position
D DSPLY(RGPOS)
Q
CTLM D POSCUR(RGPOS),INSW("~"):RGOPT["C",MOVETO(RGPOS-$X+RGX+RGW)
Q
CTLR D INSW(RGBUF) ; Insert at current position
Q
CTLT D CTLL
Q
CTLU S RGBUF=$E(RGDATA,1,RGPOS) ; Save deleted portion
S RGDATA=$E(RGDATA,RGPOS+1,RGLEN) ; Remove to left of cursor
D RESET
Q
CTLH I 'RGPOS W RGBEL Q
D LEFT
CTLD S RGDATA=$E(RGDATA,1,RGPOS)_$E(RGDATA,RGPOS+2,RGMAX) ; Delete character to left
D DSPLY(RGPOS,1)
Q
TERM S RGQUIT=2
Q
ESC R *RGZ:1
R:RGZ>0 *RGZ:1
S RGC=0
G UP:RGZ=65,DOWN:RGZ=66,RIGHT:RGZ=67,LEFT:RGZ=68 ;Execute code
S RGC=27
Q
DSPLY(RGP1,RGP2) ;
Q:'RGEON ; Refresh buffer display starting at position RGP1
N RGZ,RGZ1
S RGP1=+$G(RGP1,RGLEFT),RGZ=$E(RGDATA,RGP1+1,RGLEFT+RGLEN),RGP2=$S($D(RGP2):RGP2+$L(RGZ),1:RGLEN-RGP1+RGLEFT)
S:RGP2>RGLEN RGP2=RGLEN
S RGZ=RGZ_$J("",RGP2-$L(RGZ))
F D Q:RGZ=""
.D POSCUR(RGP1)
.S RGZ1=RGRM-$X
.S:RGZ1<1 RGZ1=1
.W $E(RGZ,1,RGZ1)
.S RGZ=$E(RGZ,RGZ1+1,999),RGP1=RGP1+RGZ1
Q
INSW(RGTXT) ;
S:RGPOS>$L(RGDATA) RGDATA=RGDATA_$J("",RGPOS-$L(RGDATA)) ; Pad if past end of buffer
S RGDATA=$E($E(RGDATA,1,RGPOS)_RGTXT_$E(RGDATA,RGPOS+2-RGINS,RGMAX),1,RGMAX)
D DSPLY(RGPOS,0),MOVETO(RGPOS+$L(RGTXT))
Q
POSCUR(RGP) ;
N RGZX,RGZY
S RGP=+$G(RGP,RGPOS),RGZX=RGP-RGLEFT,RGZY=RGZX\RGW+RGY,RGZX=RGZX#RGW+RGX
W $$XY^RGUT(RGZX,RGZY)
Q
MOVETO(RGP) ;
I RGP>RGMAX!(RGP<0) W RGBEL Q
S RGPOS=RGP,RGP=RGLEFT
S:RGPOS<RGLEFT RGLEFT=RGPOS-RGW-1
S:RGLEFT+RGLEN<RGPOS RGLEFT=RGPOS-RGW+1
S:RGLEFT'<RGMAX RGLEFT=RGMAX-RGW
S:RGLEFT<0 RGLEFT=0
D DSPLY():RGLEFT'=RGP,POSCUR()
Q
UP I RGOPT["V" S RGQUIT=3
E D MOVETO(RGPOS-RGW)
Q
DOWN I RGOPT["V" S RGQUIT=4
E D MOVETO(RGPOS+RGW)
Q
RIGHT D MOVETO(RGPOS+1)
Q
LEFT D MOVETO(RGPOS-1)
Q
RESET W $S(RGOPT["R":RGRVON,1:RGRVOFF)
S (RGPOS,RGLEFT)=0 ; Current edit offset
D DSPLY() ; Refresh display
Q
ERROR W RGBEL ; Sound bell
S @$$TRAP^RGZOSF("ERROR^RGUTEDT")
G AGAIN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTEDT 7563 printed Oct 16, 2024@18:37:57 Page 2
RGUTEDT ;CAIRO/DKM - Screen-oriented line editor;04-Sep-1998 11:26;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
+2 ;=================================================================
+3 ; Inputs:
+4 ; RGDATA = Data to edit
+5 ; RGLEN = Maximum length of data
+6 ; RGX = Starting column position
+7 ; RGY = Starting row position
+8 ; RGVALD = List of valid inputs (optional)
+9 ; RGDISV = DISV node to save under (optional)
+10 ; RGTERM = Valid input terminators (default=<CR>)
+11 ; RGABRT = Valid input abort characters (default=none)
+12 ; RGRM = Right margin setting (default=IOM or 80)
+13 ; RGQUIT = Exit code (returned)
+14 ; RGOPT = Input options
+15 ; C = Mark <CR> with ~
+16 ; E = Echo off
+17 ; H = Horizontal scroll
+18 ; I = No timeout
+19 ; L = Lowercase only
+20 ; O = Overwrite mode
+21 ; Q = Quiet mode
+22 ; R = Reverse video
+23 ; T = Auto-terminate
+24 ; U = Uppercase only
+25 ; V = Up/down cursor keys terminate input
+26 ; X = Suppress auto-erase
+27 ; Outputs:
+28 ; Return value = Edited data
+29 ;=================================================================
ENTRY(RGDATA,RGLEN,RGX,RGY,RGVALD,RGOPT,RGDISV,RGTERM,RGABRT,RGRM,RGQUIT) ;
+1 NEW RGZ,RGZ1,RGZ2,RGSAVE,RGINS,RGAE,RGBUF,RGTAB,RGPOS,RGEON,RGLEFT,RGBEL,RGMAX,RGRVON,RGRVOFF,RGC,RGW
+2 SET RGVALD=$GET(RGVALD)
SET RGOPT=$$UP^XLFSTR($GET(RGOPT))
SET RGBEL=$SELECT(RGOPT'["Q":$CHAR(7),1:"")
SET RGDISV=$GET(RGDISV)
+3 ; Valid line terminators
if $GET(RGTERM)=""
SET RGTERM=$CHAR(13)
+4 ; Valid input abort keys
SET RGABRT=$GET(RGABRT)
+5 ; Reverse video control
SET RGRVON=$CHAR(27,91,55,109)
SET RGRVOFF=$CHAR(27,91,109)
+6 ; Default mode = insert
SET RGINS=RGOPT'["O"
+7 ; Auto-erase option
SET RGAE=RGOPT'["X"
+8 ; No echo option
SET RGEON=RGOPT'["E"
+9 ; Suppress timeout option
IF RGOPT["I"!'$DATA(DTIME)
NEW DTIME
SET DTIME=9999999999
+10 SET RGBUF=""
+11 ; Display width
SET RGRM=$GET(RGRM,$GET(IOM,80))
+12 ; Tab character
SET RGTAB=$CHAR(9)
+13 SET RGX=$GET(RGX,$X)
SET RGY=$GET(RGY,$Y)
SET RGW=RGRM-RGX
+14 if RGW'>0
SET RGW=1
+15 ; Default field width
if '$GET(RGLEN)
SET RGLEN=RGW
+16 ; Maximum data length
SET RGMAX=$SELECT(RGOPT["H":250,1:RGLEN)
+17 ; Truncate data if too long
SET (RGSAVE,RGDATA)=$EXTRACT($GET(RGDATA),1,RGMAX)
+18 IF $$NEWERR^%ZTER
NEW $ETRAP
SET $ETRAP=""
+19 SET @$$TRAP^RGZOSF("ERROR^RGUTEDT")
+20 DO RM^RGZOSF(0)
+21 XECUTE ^%ZOSF("EOFF")
+22 FOR
if RGDATA'[RGTAB
QUIT
SET RGZ=$PIECE(RGDATA,RGTAB)
SET RGDATA=RGZ_$JUSTIFY("",8-($LENGTH(RGZ)#8))_$PIECE(RGDATA,RGTAB,2,999)
RESTART DO RESET
AGAIN FOR RGQUIT=0:0
if RGQUIT
QUIT
DO NXT
SET RGAE=0
+1 XECUTE ^%ZOSF("EON")
+2 WRITE $$XY^RGUT(RGX,RGY),$SELECT(RGOPT["R":RGRVOFF,1:"")
+3 IF RGDISV'=""
if "^^"[RGDATA
QUIT RGDATA
if RGDATA=" "
SET RGDATA=$GET(^DISV(DUZ,RGDISV))
+4 if RGDISV'=""
SET ^DISV(DUZ,RGDISV)=RGDATA
+5 ; Return to calling routine
QUIT RGDATA
NXT ; Position cursor
DO POSCUR()
+1 ; Next character typed
READ *RGC:DTIME
+2 IF RGC=27
DO ESC
if 'RGC
QUIT
+3 IF RGC<1!(RGABRT[$CHAR(RGC))
SET RGDATA=U
SET RGQUIT=1
QUIT
+4 IF RGTERM[$CHAR(RGC)
DO TERM
QUIT
+5 IF RGC<28
if RGC'=27
DO @("CTL"_$CHAR(RGC+64))
QUIT
+6 IF RGC=127!(RGC=240)
DO CTLH
QUIT
+7 IF RGC>64
IF RGC<91
IF RGOPT["L"
SET RGC=RGC+32
+8 IF '$TEST
IF RGC>96
IF RGC<123
IF RGOPT["U"
SET RGC=RGC-32
+9 IF $LENGTH(RGVALD)
IF RGVALD'[$CHAR(RGC)
DO RAISE^RGZOSF()
+10 ; Erase buffer if auto erase on
if RGAE
DO CTLK
DO POSCUR()
+11 DO INSW($CHAR(RGC))
+12 SET RGQUIT=RGPOS=RGLEN&(RGOPT["T")
+13 QUIT
CTLA ; Toggle insert mode
SET RGINS='RGINS
+1 QUIT
CTLB ; Move cursor to beginning
DO MOVETO(0)
+1 QUIT
CTLX ; Restore buffer to original
SET RGDATA=RGSAVE
+1 GOTO RESET
CTLE ; Move cursor to end
DO MOVETO($LENGTH(RGDATA))
+1 QUIT
CTLI ; Insert expanded tab
DO INSW($JUSTIFY("",8-(RGPOS#8)))
+1 QUIT
CTLJ ; Find previous nonspace
FOR RGZ=RGPOS:-1:1
if $ASCII(RGDATA,RGZ)'=32
QUIT
+1 ; Find previous space
FOR RGZ=RGZ:-1:1
if $ASCII(RGDATA,RGZ)=32
QUIT
+2 ; Save deleted portion
SET RGBUF=$EXTRACT(RGDATA,RGZ,RGPOS)
+3 ; Remove word
SET RGDATA=$EXTRACT(RGDATA,1,RGZ-1)_$EXTRACT(RGDATA,RGPOS+1,RGLEN)
+4 DO MOVETO(RGZ-1)
+5 QUIT
CTLK ; Save buffer
SET RGBUF=RGDATA
+1 ; Erase buffer
SET RGDATA=""
+2 DO RESET
+3 QUIT
CTLL ; Save deleted portion
SET RGBUF=$EXTRACT(RGDATA,RGPOS+1,RGLEN)
+1 ; Truncate at current position
SET RGDATA=$EXTRACT(RGDATA,1,RGPOS)
+2 DO DSPLY(RGPOS)
+3 QUIT
CTLM DO POSCUR(RGPOS)
if RGOPT["C"
DO INSW("~")
DO MOVETO(RGPOS-$X+RGX+RGW)
+1 QUIT
CTLR ; Insert at current position
DO INSW(RGBUF)
+1 QUIT
CTLT DO CTLL
+1 QUIT
CTLU ; Save deleted portion
SET RGBUF=$EXTRACT(RGDATA,1,RGPOS)
+1 ; Remove to left of cursor
SET RGDATA=$EXTRACT(RGDATA,RGPOS+1,RGLEN)
+2 DO RESET
+3 QUIT
CTLH IF 'RGPOS
WRITE RGBEL
QUIT
+1 DO LEFT
CTLD ; Delete character to left
SET RGDATA=$EXTRACT(RGDATA,1,RGPOS)_$EXTRACT(RGDATA,RGPOS+2,RGMAX)
+1 DO DSPLY(RGPOS,1)
+2 QUIT
TERM SET RGQUIT=2
+1 QUIT
ESC READ *RGZ:1
+1 if RGZ>0
READ *RGZ:1
+2 SET RGC=0
+3 ;Execute code
if RGZ=65
GOTO UP
if RGZ=66
GOTO DOWN
if RGZ=67
GOTO RIGHT
if RGZ=68
GOTO LEFT
+4 SET RGC=27
+5 QUIT
DSPLY(RGP1,RGP2) ;
+1 ; Refresh buffer display starting at position RGP1
if 'RGEON
QUIT
+2 NEW RGZ,RGZ1
+3 SET RGP1=+$GET(RGP1,RGLEFT)
SET RGZ=$EXTRACT(RGDATA,RGP1+1,RGLEFT+RGLEN)
SET RGP2=$SELECT($DATA(RGP2):RGP2+$LENGTH(RGZ),1:RGLEN-RGP1+RGLEFT)
+4 if RGP2>RGLEN
SET RGP2=RGLEN
+5 SET RGZ=RGZ_$JUSTIFY("",RGP2-$LENGTH(RGZ))
+6 FOR
Begin DoDot:1
+7 DO POSCUR(RGP1)
+8 SET RGZ1=RGRM-$X
+9 if RGZ1<1
SET RGZ1=1
+10 WRITE $EXTRACT(RGZ,1,RGZ1)
+11 SET RGZ=$EXTRACT(RGZ,RGZ1+1,999)
SET RGP1=RGP1+RGZ1
End DoDot:1
if RGZ=""
QUIT
+12 QUIT
INSW(RGTXT) ;
+1 ; Pad if past end of buffer
if RGPOS>$LENGTH(RGDATA)
SET RGDATA=RGDATA_$JUSTIFY("",RGPOS-$LENGTH(RGDATA))
+2 SET RGDATA=$EXTRACT($EXTRACT(RGDATA,1,RGPOS)_RGTXT_$EXTRACT(RGDATA,RGPOS+2-RGINS,RGMAX),1,RGMAX)
+3 DO DSPLY(RGPOS,0)
DO MOVETO(RGPOS+$LENGTH(RGTXT))
+4 QUIT
POSCUR(RGP) ;
+1 NEW RGZX,RGZY
+2 SET RGP=+$GET(RGP,RGPOS)
SET RGZX=RGP-RGLEFT
SET RGZY=RGZX\RGW+RGY
SET RGZX=RGZX#RGW+RGX
+3 WRITE $$XY^RGUT(RGZX,RGZY)
+4 QUIT
MOVETO(RGP) ;
+1 IF RGP>RGMAX!(RGP<0)
WRITE RGBEL
QUIT
+2 SET RGPOS=RGP
SET RGP=RGLEFT
+3 if RGPOS<RGLEFT
SET RGLEFT=RGPOS-RGW-1
+4 if RGLEFT+RGLEN<RGPOS
SET RGLEFT=RGPOS-RGW+1
+5 if RGLEFT'<RGMAX
SET RGLEFT=RGMAX-RGW
+6 if RGLEFT<0
SET RGLEFT=0
+7 if RGLEFT'=RGP
DO DSPLY()
DO POSCUR()
+8 QUIT
UP IF RGOPT["V"
SET RGQUIT=3
+1 IF '$TEST
DO MOVETO(RGPOS-RGW)
+2 QUIT
DOWN IF RGOPT["V"
SET RGQUIT=4
+1 IF '$TEST
DO MOVETO(RGPOS+RGW)
+2 QUIT
RIGHT DO MOVETO(RGPOS+1)
+1 QUIT
LEFT DO MOVETO(RGPOS-1)
+1 QUIT
RESET WRITE $SELECT(RGOPT["R":RGRVON,1:RGRVOFF)
+1 ; Current edit offset
SET (RGPOS,RGLEFT)=0
+2 ; Refresh display
DO DSPLY()
+3 QUIT
ERROR ; Sound bell
WRITE RGBEL
+1 SET @$$TRAP^RGZOSF("ERROR^RGUTEDT")
+2 GOTO AGAIN
