Annotation of freem_fileman/DDW5.m, revision 1.1
1.1 ! snw 1: DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM 21 Dec 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: WRAP ;Wrap at word boundary
! 6: S:$E(DDWN,DDWC,999)?1." " (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
! 7: I DDWC'>$L(DDWN) D WRAPI Q
! 8: I 'DDWRAP D POS(DDWRW,DDWRMAR+1,"R"),BREAK(1) Q
! 9: D WRAPW
! 10: Q
! 11: ;
! 12: WRAPI ;Cursor in middle
! 13: I $E(DDWN,DDWLMAR,999)'[" "!'DDWRAP D BREAK(-1),POS(DDWRW-1,"E","RN") Q
! 14: N DDWCSV,DDWI,DDWLST,DDWRMSV
! 15: S DDWI=$F(DDWN," ",DDWC)
! 16: I DDWI,DDWI-2'>DDWRMAR D
! 17: . S DDWCSV=DDWC
! 18: . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
! 19: . D POS(DDWRW,DDWI,"R"),BREAK(-1),POS(DDWRW-1,DDWCSV,"RN")
! 20: . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
! 21: E I DDWC=2 D
! 22: . D POS(DDWRW,DDWRMAR+1,"R"),BREAK(-1),POS(DDWRW-1,2,"RN")
! 23: E D
! 24: . S DDWLST=$$TR($E(DDWN,DDWC,999))
! 25: . S (DDWL(DDWRW),DDWN)=$E(DDWN,1,DDWC-1)
! 26: . S DDWRMSV=DDWRMAR,DDWRMAR=$$MIN(DDWRMAR,DDWC-2)
! 27: . D WRAPW
! 28: . W $E(DDWLST,1,IOM+DDWOFS-DDWC)
! 29: . S DDWL(DDWRW)=DDWN_DDWLST,DDWRMAR=DDWRMSV
! 30: . D POS(DDWRW,DDWC,"RN")
! 31: Q
! 32: ;
! 33: WRAPW ;Cursor at end
! 34: N DDWI,DDWS1,DDWS2,DDWTXT
! 35: S DDWTXT(1)=DDWN
! 36: D ADJMAR^DDW6(.DDWTXT,"","I")
! 37: ;
! 38: S DDWS1=$$SCR($L(DDWTXT(1))+1),DDWS2=$$SCR($L(DDWTXT(DDWTXT))+1)
! 39: I DDWS1=$P(DDWOFS,U,4),DDWS2=$P(DDWOFS,U,4),DDWTXT=2 D
! 40: . S (DDWN,DDWL(DDWRW))=DDWTXT(1)_DDWTXT(2)
! 41: . S DDWC=$L(DDWTXT(1))+1
! 42: . D POS(DDWRW,DDWC),BREAK(1)
! 43: ;
! 44: E D
! 45: . F DDWI=1:1:DDWTXT-1 D
! 46: .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
! 47: .. D ILINE
! 48: .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI+1)
! 49: .. I DDWS2=$P(DDWOFS,U,4) D
! 50: ... D CUP(DDWRW-1,1)
! 51: ... W $P(DDGLCLR,DDGLDEL)_$E(DDWTXT(DDWI),1+DDWOFS,IOM+DDWOFS)
! 52: ... D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 53: . D POS(DDWRW,"E","R")
! 54: Q
! 55: ;
! 56: BREAK(DDWFLAG) ;Break line, make new line current
! 57: ;Final cursor position:
! 58: ; 0:lmar of new line (used by <RET>)
! 59: ; 1:end of new line (used by Wrap)
! 60: ;-1:doesn't matter (used by Wrap)
! 61: N DDWRST
! 62: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
! 63: S DDWRST=$E(DDWN,DDWC,999)
! 64: I DDWLMAR>1,DDWRST'?@(DDWLMAR-1_""" "".E") D
! 65: . S DDWRST=$J("",DDWLMAR-1)_$$LD(DDWRST)
! 66: S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
! 67: W $P(DDGLCLR,DDGLDEL)
! 68: D ILINE
! 69: S (DDWN,DDWL(DDWRW))=DDWRST
! 70: ;
! 71: I $G(DDWFLAG)=1 D
! 72: . I $$SCR($L(DDWN)+1)=$P(DDWOFS,U,4) D
! 73: .. D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 74: . D POS(DDWRW,"E","R")
! 75: ;
! 76: E I '$G(DDWFLAG) D
! 77: . I $P(DDWOFS,U,4)=1 D CUP(DDWRW,1) W $E(DDWN,1,IOM)
! 78: . D POS(DDWRW,DDWLMAR,"R")
! 79: ;
! 80: E D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 81: Q
! 82: ;
! 83: ILINE ;Insert line below current line, make that current
! 84: ;Column is unchanged
! 85: N DDWI,DDWX
! 86: I DDWRW<DDWMR D
! 87: . I DDWA+DDWMR'>DDWCNT D
! 88: .. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWMR)
! 89: . F DDWI=DDWMR:-1:DDWRW+2 S DDWL(DDWI)=DDWL(DDWI-1)
! 90: . S DDWL(DDWRW+1)=""
! 91: . D CUP(DDWRW+1,1)
! 92: . ;
! 93: . I $P(DDGLED,DDGLDEL,3)]"" D
! 94: .. I $P(DDGLED,DDGLDEL,2)="" D
! 95: ... D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4) D CUP(DDWRW+1,1)
! 96: .. W $P(DDGLED,DDGLDEL,3)
! 97: . E D
! 98: .. S DDWX=IOTM
! 99: .. S IOTM=IOTM+DDWRW W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
! 100: .. D CUP(DDWRW+1,1) W $P(DDGLED,DDGLDEL)
! 101: .. W @$P(DDGLED,DDGLDEL,2)
! 102: . D POS(DDWRW+1,DDWC,"RN")
! 103: ;
! 104: E D
! 105: . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(1)
! 106: . F DDWI=1:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
! 107: . S DDWL(DDWMR)=""
! 108: . D SCRUP^DDW3(1)
! 109: S DDWCNT=DDWCNT+1
! 110: S $E(DDWBF,1,3)=111
! 111: Q
! 112: ;
! 113: XLINE(DDWFLAG,DDWNP) ;Delete current line
! 114: ;DDWFLAG:
! 115: ; 1:leave cursor on deleted line (used by Join)
! 116: ; 0:move cursor up one line if deleted line is last line
! 117: ; (used by PF1-D and DELBLK)
! 118: ; DDWNP = 1:don't bother printing, used by DELBLK
! 119: N DDWI,DDWX
! 120: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
! 121: F DDWI=DDWRW:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
! 122: S DDWX="" S:DDWSTB DDWX=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
! 123: S DDWL(DDWMR)=DDWX
! 124: ;
! 125: D:'$G(DDWNP) XLINEP
! 126: ;
! 127: S DDWCNT=DDWCNT-1
! 128: I 'DDWCNT D
! 129: . S DDWCNT=1 D POS(1,DDWLMAR,"RN")
! 130: E I DDWA+DDWRW>DDWCNT,'$G(DDWFLAG) D
! 131: . D UP^DDWT1
! 132: E D POS(DDWRW,DDWC,"N")
! 133: S $E(DDWBF,1,3)=111
! 134: Q
! 135: ;
! 136: XLINEP ;Redisplay screen
! 137: I $P(DDGLED,DDGLDEL,4)]"" D
! 138: . W $P(DDGLED,DDGLDEL,4)
! 139: . I $P(DDGLED,DDGLDEL,2)="" D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
! 140: E I DDWRW<DDWMR D
! 141: . S DDWX=IOTM
! 142: . S IOTM=IOTM+DDWRW-1 W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
! 143: . D CUP(DDWMR,1) W $C(10)
! 144: . W @$P(DDGLED,DDGLDEL,2)
! 145: E D
! 146: . D CUP(DDWMR,1) W $P(DDGLCLR,DDGLDEL)
! 147: ;
! 148: I DDWL(DDWMR)'?." " D
! 149: . D CUP(DDWMR,1)
! 150: . W $E(DDWL(DDWMR),1+DDWOFS,IOM+DDWOFS)
! 151: Q
! 152: ;
! 153: TR(X) Q:$G(X)="" X
! 154: N I
! 155: F I=$L(X):-1:0 Q:$E(X,I)'=" "
! 156: Q $E(X,1,I)
! 157: ;
! 158: LD(X) Q:$G(X)="" X
! 159: N I
! 160: F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
! 161: Q $E(X,I,999)
! 162: ;
! 163: CUP(Y,X) ;
! 164: S DY=IOTM+Y-2,DX=X-1 X IOXY
! 165: Q
! 166: ;
! 167: POS(R,C,F) ;
! 168: N DDWX
! 169: S:$G(C)="E" C=$L($G(DDWL(R)))+1
! 170: S:$G(F)["N" DDWN=$G(DDWL(R))
! 171: S:$G(F)["R" DDWRW=R,DDWC=C
! 172: ;
! 173: S DDWX=C-DDWOFS
! 174: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
! 175: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
! 176: Q
! 177: ;
! 178: SCR(C) ;
! 179: Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
! 180: ;
! 181: MIN(X,Y) ;
! 182: Q $S(X<Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDW5.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman