Return to DIR01.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIR01	;SFISC/MKO-FIELD EDITOR ;02:39 PM  12 Oct 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	I DIR0A]"" D F X IOXY Q:DIR0QT
	F  D E X IOXY Q:DIR0QT
	Q
	;
F	D READ(.DIR0CH)
	I "?^"'[DIR0CH=$L(DIR0CH) S DIR0A="" D REP,DEOF Q
	D:DIR0CH]"" E1
	Q
	;
E	I $G(DIR0("REP"))&DIR0C>1!(DIR0C>$L(DIR0A)),DIR0F>DX,DIR0M>$L(DIR0A),'$D(DIR0KD) D
	. D PREAD($$MIN(DIR0F-DX,DIR0M-DIR0C+1),.DIR0ST,.DIR0CH)
	. Q:DIR0ST=""
	. S DIR0CHG=1
	. I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
	. E  S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
	. S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
	E  D READ(.DIR0CH)
	Q:DIR0CH=""
	;
E1	I "?^"[DIR0CH,DIR0C=1,'DIR0QU S DIR0A="",DIR0QU=1 D REP,DEOF Q
	D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
	I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
	Q
	;
REP	I DIR0C>DIR0M W $C(7) Q
	S DIR0CHG=1
	S $E(DIR0A,DIR0C)=DIR0CH,DIR0C=DIR0C+1
	I DIR0F>DX S DX=DX+1 W DIR0CH Q
	N DIX
	S DIX=DIR0C-(DIR0L\2)
	S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
	S DX=DIR0S X IOXY
	W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
	Q
	;
INS	I $L(DIR0A)'<DIR0M W $C(7) Q
	S DIR0CHG=1
	S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999),DIR0C=DIR0C+1
	I DIR0F>DX S DX=DX+1 W $E(DIR0A,DIR0C-1,DIR0C+DIR0F-DX-1) Q
	S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1) S DX=DIR0F
	Q
	;
RIGHT	Q:DIR0C>$L(DIR0A)
	I DX<DIR0F S DX=DX+1,DIR0C=DIR0C+1 Q
	S DIR0C=DIR0C+1,DX=DIR0S X IOXY
	W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
	S DX=DIR0F
	Q
	;
LEFT	Q:DIR0C'>1
	I DX>DIR0S S DX=DX-1,DIR0C=DIR0C-1 Q
	S DIR0C=DIR0C-1 W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
	Q
	;
JRT	Q:DIR0C>$L(DIR0A)
	I DIR0F=DX D  Q
	. S DIR0C=DIR0C+DIR0L S:DIR0C+1>$L(DIR0A) DIR0C=$L(DIR0A)+1
	. S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
	. S DX=DIR0F
	N DIX
	S DIX=$L(DIR0A)-DIR0C+1
	I DIR0F-DX>DIX S DX=DX+DIX,DIR0C=DIR0C+DIX Q
	S DIR0C=DIR0C+DIR0F-DX,DX=DIR0F
	Q
	;
JLT	Q:DIR0C'>1
	I DX=DIR0S D  Q
	. S DIR0C=DIR0C-DIR0L S:DIR0C<1 DIR0C=1
	. W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
	S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
	Q
	;
FDE	Q:DIR0C>$L(DIR0A)
	I DX+$L(DIR0A)-DIR0C-DIR0L<DIR0S D  Q
	. S DX=DX+$L(DIR0A)-DIR0C+1,DIR0C=$L(DIR0A)+1
	S DIR0C=$L(DIR0A)+1,DX=DIR0S X IOXY
	W $E(DIR0A,DIR0C-DIR0L,DIR0C)
	S DX=DIR0F
	Q
	;
FDB	Q:DIR0C'>1
	I DX-DIR0C+1<DIR0S S DX=DIR0S X IOXY W $E(DIR0A,1,DIR0L)
	S DX=DIR0S,DIR0C=1
	Q
	;
BS	Q:DIR0C'>1
	S DIR0CHG=1
	S DIR0C=DIR0C-1,DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
	I DX>DIR0S D  Q
	. S DX=DX-1 X IOXY
	. W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
	N DIX
	S DIX=DIR0C-(DIR0L\2)
	S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
	S:DIX<1 DIX=1
	W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
	Q
	;
DEL	Q:DIR0C>$L(DIR0A)!(DIR0F'>DX)
	S DIR0CHG=1
	S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
	W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
	Q
	;
CLR	S DIR0CHG=1
	S DIR0C=1,DX=DIR0S X IOXY
	I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
	S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
	W $E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
	Q
	;
DEOF	S DIR0CHG=1
	W $E(DIR0SP,DX-DIR0S+1,999)
	S DIR0A=$E(DIR0A,1,DIR0C-1)
	Q
	;
RPM	N DX,DY
	I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
	I $G(DIR0("REP")) W:$D(DDS) "Insert " K DIR0("REP")
	E  W:$D(DDS) "Replace" S DIR0("REP")=1
	Q
	;
KPM	I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
	E  S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
	Q
	;
WRT	G WRT^DIR0W
WLT	G WLT^DIR0W
DLW	G DLW^DIR0W
HLP	G ^DIR0H
ZM	G SM^DIR02
	;
TO	S DTOUT=1,DIR0A=DIR0D
UP	;
DOWN	;
TAB	;
FDL	;
CR	;
NB	;
NP	;
PP	;
SEL	;
EX	;
QT	;
CL	;
SV	;
RF	;
	S DIR0QT=1
	Q
NOP	W $C(7)
	Q
	;
READ(Y)	;Out: Y=char or mnemonic
	F  D  Q:Y'=-1
	. R *Y:DTIME
	. I Y>31,Y<127 S Y=$C(Y) Q
	. I Y<0 S Y="TO" Q
	. D MNE(.Y)
	I Y'="TO",$D(DIR0KD) D @DIR0KD
	Q
	;
PREAD(DIR0LEN,DIR0ST,Y)	;
	; Y = Mnem, Null if DIR0LEN chars read or invalid
	X DDGLZOSF("EON")
	R DIR0ST#DIR0LEN:DTIME E  S Y="TO" Q
	X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
	I $C(Y)?1C,Y D
	. D MNE(.Y) S:Y=-1 Y=""
	E  S Y=""
	Q
	;
MNE(Y)	;Out: Y=mnemonic, or -1 if invalid
	N S,F
	S S="",F=0
	F  D MNELOOP Q:F
	Q
	;
MNELOOP	;
	S S=S_$C(Y)
	I DIR0(DIR0P_"IN")'[(U_S) D  I Y=-1 D FLUSH Q
	. I $C(Y)'?1L S Y=-1 Q
	. S S=$E(S,1,$L(S)-1)_$C(Y-32)
	. S:DIR0(DIR0P_"IN")'[(U_S_U) Y=-1
	;
	I DIR0(DIR0P_"IN")[(U_S_U),S'=$C(27) D
	. S Y=$P(DIR0(DIR0P_"OUT"),";",$L($P(DIR0(DIR0P_"IN"),U_S_U),U)),F=1
	E  R *Y:5 D:Y=-1 FLUSH
	Q
	;
FLUSH	N X
	S F=1 W $C(7) F  R *X:0 E  Q
	Q
	;
MIN(X,Y)	;
	Q $S(X<Y:X,1:Y)