| 1 | RGUTEDT ;CAIRO/DKM - Screen-oriented line editor;04-Sep-1998 11:26;DKM
|
|---|
| 2 | ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | ; Inputs:
|
|---|
| 5 | ; RGDATA = Data to edit
|
|---|
| 6 | ; RGLEN = Maximum length of data
|
|---|
| 7 | ; RGX = Starting column position
|
|---|
| 8 | ; RGY = Starting row position
|
|---|
| 9 | ; RGVALD = List of valid inputs (optional)
|
|---|
| 10 | ; RGDISV = DISV node to save under (optional)
|
|---|
| 11 | ; RGTERM = Valid input terminators (default=<CR>)
|
|---|
| 12 | ; RGABRT = Valid input abort characters (default=none)
|
|---|
| 13 | ; RGRM = Right margin setting (default=IOM or 80)
|
|---|
| 14 | ; RGQUIT = Exit code (returned)
|
|---|
| 15 | ; RGOPT = Input options
|
|---|
| 16 | ; C = Mark <CR> with ~
|
|---|
| 17 | ; E = Echo off
|
|---|
| 18 | ; H = Horizontal scroll
|
|---|
| 19 | ; I = No timeout
|
|---|
| 20 | ; L = Lowercase only
|
|---|
| 21 | ; O = Overwrite mode
|
|---|
| 22 | ; Q = Quiet mode
|
|---|
| 23 | ; R = Reverse video
|
|---|
| 24 | ; T = Auto-terminate
|
|---|
| 25 | ; U = Uppercase only
|
|---|
| 26 | ; V = Up/down cursor keys terminate input
|
|---|
| 27 | ; X = Suppress auto-erase
|
|---|
| 28 | ; Outputs:
|
|---|
| 29 | ; Return value = Edited data
|
|---|
| 30 | ;=================================================================
|
|---|
| 31 | ENTRY(RGDATA,RGLEN,RGX,RGY,RGVALD,RGOPT,RGDISV,RGTERM,RGABRT,RGRM,RGQUIT) ;
|
|---|
| 32 | N RGZ,RGZ1,RGZ2,RGSAVE,RGINS,RGAE,RGBUF,RGTAB,RGPOS,RGEON,RGLEFT,RGBEL,RGMAX,RGRVON,RGRVOFF,RGC,RGW
|
|---|
| 33 | S RGVALD=$G(RGVALD),RGOPT=$$UP^XLFSTR($G(RGOPT)),RGBEL=$S(RGOPT'["Q":$C(7),1:""),RGDISV=$G(RGDISV)
|
|---|
| 34 | S:$G(RGTERM)="" RGTERM=$C(13) ; Valid line terminators
|
|---|
| 35 | S RGABRT=$G(RGABRT) ; Valid input abort keys
|
|---|
| 36 | S RGRVON=$C(27,91,55,109),RGRVOFF=$C(27,91,109) ; Reverse video control
|
|---|
| 37 | S RGINS=RGOPT'["O" ; Default mode = insert
|
|---|
| 38 | S RGAE=RGOPT'["X" ; Auto-erase option
|
|---|
| 39 | S RGEON=RGOPT'["E" ; No echo option
|
|---|
| 40 | I RGOPT["I"!'$D(DTIME) N DTIME S DTIME=9999999999 ; Suppress timeout option
|
|---|
| 41 | S RGBUF=""
|
|---|
| 42 | S RGRM=$G(RGRM,$G(IOM,80)) ; Display width
|
|---|
| 43 | S RGTAB=$C(9) ; Tab character
|
|---|
| 44 | S RGX=$G(RGX,$X),RGY=$G(RGY,$Y),RGW=RGRM-RGX
|
|---|
| 45 | S:RGW'>0 RGW=1
|
|---|
| 46 | S:'$G(RGLEN) RGLEN=RGW ; Default field width
|
|---|
| 47 | S RGMAX=$S(RGOPT["H":250,1:RGLEN) ; Maximum data length
|
|---|
| 48 | S (RGSAVE,RGDATA)=$E($G(RGDATA),1,RGMAX) ; Truncate data if too long
|
|---|
| 49 | I $$NEWERR^%ZTER N $ET S $ET=""
|
|---|
| 50 | S @$$TRAP^RGZOSF("ERROR^RGUTEDT")
|
|---|
| 51 | D RM^RGZOSF(0)
|
|---|
| 52 | X ^%ZOSF("EOFF")
|
|---|
| 53 | F Q:RGDATA'[RGTAB S RGZ=$P(RGDATA,RGTAB),RGDATA=RGZ_$J("",8-($L(RGZ)#8))_$P(RGDATA,RGTAB,2,999)
|
|---|
| 54 | RESTART D RESET
|
|---|
| 55 | AGAIN F RGQUIT=0:0 Q:RGQUIT D NXT S RGAE=0
|
|---|
| 56 | X ^%ZOSF("EON")
|
|---|
| 57 | W $$XY^RGUT(RGX,RGY),$S(RGOPT["R":RGRVOFF,1:"")
|
|---|
| 58 | I RGDISV'="" Q:"^^"[RGDATA RGDATA S:RGDATA=" " RGDATA=$G(^DISV(DUZ,RGDISV))
|
|---|
| 59 | S:RGDISV'="" ^DISV(DUZ,RGDISV)=RGDATA
|
|---|
| 60 | Q RGDATA ; Return to calling routine
|
|---|
| 61 | NXT D POSCUR() ; Position cursor
|
|---|
| 62 | R *RGC:DTIME ; Next character typed
|
|---|
| 63 | I RGC=27 D ESC Q:'RGC
|
|---|
| 64 | I RGC<1!(RGABRT[$C(RGC)) S RGDATA=U,RGQUIT=1 Q
|
|---|
| 65 | I RGTERM[$C(RGC) D TERM Q
|
|---|
| 66 | I RGC<28 D:RGC'=27 @("CTL"_$C(RGC+64)) Q
|
|---|
| 67 | I RGC=127!(RGC=240) D CTLH Q
|
|---|
| 68 | I RGC>64,RGC<91,RGOPT["L" S RGC=RGC+32
|
|---|
| 69 | E I RGC>96,RGC<123,RGOPT["U" S RGC=RGC-32
|
|---|
| 70 | I $L(RGVALD),RGVALD'[$C(RGC) D RAISE^RGZOSF()
|
|---|
| 71 | D:RGAE CTLK,POSCUR() ; Erase buffer if auto erase on
|
|---|
| 72 | D INSW($C(RGC))
|
|---|
| 73 | S RGQUIT=RGPOS=RGLEN&(RGOPT["T")
|
|---|
| 74 | Q
|
|---|
| 75 | CTLA S RGINS='RGINS ; Toggle insert mode
|
|---|
| 76 | Q
|
|---|
| 77 | CTLB D MOVETO(0) ; Move cursor to beginning
|
|---|
| 78 | Q
|
|---|
| 79 | CTLX S RGDATA=RGSAVE ; Restore buffer to original
|
|---|
| 80 | G RESET
|
|---|
| 81 | CTLE D MOVETO($L(RGDATA)) ; Move cursor to end
|
|---|
| 82 | Q
|
|---|
| 83 | CTLI D INSW($J("",8-(RGPOS#8))) ; Insert expanded tab
|
|---|
| 84 | Q
|
|---|
| 85 | CTLJ F RGZ=RGPOS:-1:1 Q:$A(RGDATA,RGZ)'=32 ; Find previous nonspace
|
|---|
| 86 | F RGZ=RGZ:-1:1 Q:$A(RGDATA,RGZ)=32 ; Find previous space
|
|---|
| 87 | S RGBUF=$E(RGDATA,RGZ,RGPOS) ; Save deleted portion
|
|---|
| 88 | S RGDATA=$E(RGDATA,1,RGZ-1)_$E(RGDATA,RGPOS+1,RGLEN) ; Remove word
|
|---|
| 89 | D MOVETO(RGZ-1)
|
|---|
| 90 | Q
|
|---|
| 91 | CTLK S RGBUF=RGDATA ; Save buffer
|
|---|
| 92 | S RGDATA="" ; Erase buffer
|
|---|
| 93 | D RESET
|
|---|
| 94 | Q
|
|---|
| 95 | CTLL S RGBUF=$E(RGDATA,RGPOS+1,RGLEN) ; Save deleted portion
|
|---|
| 96 | S RGDATA=$E(RGDATA,1,RGPOS) ; Truncate at current position
|
|---|
| 97 | D DSPLY(RGPOS)
|
|---|
| 98 | Q
|
|---|
| 99 | CTLM D POSCUR(RGPOS),INSW("~"):RGOPT["C",MOVETO(RGPOS-$X+RGX+RGW)
|
|---|
| 100 | Q
|
|---|
| 101 | CTLR D INSW(RGBUF) ; Insert at current position
|
|---|
| 102 | Q
|
|---|
| 103 | CTLT D CTLL
|
|---|
| 104 | Q
|
|---|
| 105 | CTLU S RGBUF=$E(RGDATA,1,RGPOS) ; Save deleted portion
|
|---|
| 106 | S RGDATA=$E(RGDATA,RGPOS+1,RGLEN) ; Remove to left of cursor
|
|---|
| 107 | D RESET
|
|---|
| 108 | Q
|
|---|
| 109 | CTLH I 'RGPOS W RGBEL Q
|
|---|
| 110 | D LEFT
|
|---|
| 111 | CTLD S RGDATA=$E(RGDATA,1,RGPOS)_$E(RGDATA,RGPOS+2,RGMAX) ; Delete character to left
|
|---|
| 112 | D DSPLY(RGPOS,1)
|
|---|
| 113 | Q
|
|---|
| 114 | TERM S RGQUIT=2
|
|---|
| 115 | Q
|
|---|
| 116 | ESC R *RGZ:1
|
|---|
| 117 | R:RGZ>0 *RGZ:1
|
|---|
| 118 | S RGC=0
|
|---|
| 119 | G UP:RGZ=65,DOWN:RGZ=66,RIGHT:RGZ=67,LEFT:RGZ=68 ;Execute code
|
|---|
| 120 | S RGC=27
|
|---|
| 121 | Q
|
|---|
| 122 | DSPLY(RGP1,RGP2) ;
|
|---|
| 123 | Q:'RGEON ; Refresh buffer display starting at position RGP1
|
|---|
| 124 | N RGZ,RGZ1
|
|---|
| 125 | S RGP1=+$G(RGP1,RGLEFT),RGZ=$E(RGDATA,RGP1+1,RGLEFT+RGLEN),RGP2=$S($D(RGP2):RGP2+$L(RGZ),1:RGLEN-RGP1+RGLEFT)
|
|---|
| 126 | S:RGP2>RGLEN RGP2=RGLEN
|
|---|
| 127 | S RGZ=RGZ_$J("",RGP2-$L(RGZ))
|
|---|
| 128 | F D Q:RGZ=""
|
|---|
| 129 | .D POSCUR(RGP1)
|
|---|
| 130 | .S RGZ1=RGRM-$X
|
|---|
| 131 | .S:RGZ1<1 RGZ1=1
|
|---|
| 132 | .W $E(RGZ,1,RGZ1)
|
|---|
| 133 | .S RGZ=$E(RGZ,RGZ1+1,999),RGP1=RGP1+RGZ1
|
|---|
| 134 | Q
|
|---|
| 135 | INSW(RGTXT) ;
|
|---|
| 136 | S:RGPOS>$L(RGDATA) RGDATA=RGDATA_$J("",RGPOS-$L(RGDATA)) ; Pad if past end of buffer
|
|---|
| 137 | S RGDATA=$E($E(RGDATA,1,RGPOS)_RGTXT_$E(RGDATA,RGPOS+2-RGINS,RGMAX),1,RGMAX)
|
|---|
| 138 | D DSPLY(RGPOS,0),MOVETO(RGPOS+$L(RGTXT))
|
|---|
| 139 | Q
|
|---|
| 140 | POSCUR(RGP) ;
|
|---|
| 141 | N RGZX,RGZY
|
|---|
| 142 | S RGP=+$G(RGP,RGPOS),RGZX=RGP-RGLEFT,RGZY=RGZX\RGW+RGY,RGZX=RGZX#RGW+RGX
|
|---|
| 143 | W $$XY^RGUT(RGZX,RGZY)
|
|---|
| 144 | Q
|
|---|
| 145 | MOVETO(RGP) ;
|
|---|
| 146 | I RGP>RGMAX!(RGP<0) W RGBEL Q
|
|---|
| 147 | S RGPOS=RGP,RGP=RGLEFT
|
|---|
| 148 | S:RGPOS<RGLEFT RGLEFT=RGPOS-RGW-1
|
|---|
| 149 | S:RGLEFT+RGLEN<RGPOS RGLEFT=RGPOS-RGW+1
|
|---|
| 150 | S:RGLEFT'<RGMAX RGLEFT=RGMAX-RGW
|
|---|
| 151 | S:RGLEFT<0 RGLEFT=0
|
|---|
| 152 | D DSPLY():RGLEFT'=RGP,POSCUR()
|
|---|
| 153 | Q
|
|---|
| 154 | UP I RGOPT["V" S RGQUIT=3
|
|---|
| 155 | E D MOVETO(RGPOS-RGW)
|
|---|
| 156 | Q
|
|---|
| 157 | DOWN I RGOPT["V" S RGQUIT=4
|
|---|
| 158 | E D MOVETO(RGPOS+RGW)
|
|---|
| 159 | Q
|
|---|
| 160 | RIGHT D MOVETO(RGPOS+1)
|
|---|
| 161 | Q
|
|---|
| 162 | LEFT D MOVETO(RGPOS-1)
|
|---|
| 163 | Q
|
|---|
| 164 | RESET W $S(RGOPT["R":RGRVON,1:RGRVOFF)
|
|---|
| 165 | S (RGPOS,RGLEFT)=0 ; Current edit offset
|
|---|
| 166 | D DSPLY() ; Refresh display
|
|---|
| 167 | Q
|
|---|
| 168 | ERROR W RGBEL ; Sound bell
|
|---|
| 169 | S @$$TRAP^RGZOSF("ERROR^RGUTEDT")
|
|---|
| 170 | G AGAIN
|
|---|
