RGUTEDT.m

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 ---RGUTEDT   7563     printed  Feb 19, 2025@00:03:44                                                                                                                                                                                                     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