Annotation of freem_fileman/USER/DDW8.m, revision 1.1
1.1 ! snw 1: DDW8 ;SFISC/MKO-COPY, CUT, PASTE ;10:39 AM 23 Jun 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: CUT() ;Cut selected text
! 6: N DDWADJ,DDWC1,DDWC2,DDWCSV,DDWISIN,DDWNDEL,DDWR1,DDWR2,DDWRSV
! 7: I '$D(DDWMARK) D ERR("No text selected.") Q
! 8: ;
! 9: S DDWISIN=$$ISINSEL()
! 10: D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
! 11: D COPYBUF
! 12: ;
! 13: S DDWRSV=DDWRW,DDWCSV=DDWC
! 14: I DDWR2>DDWA,DDWR2-DDWA<DDWRW S DDWADJ=1
! 15: E I DDWR1-DDWA'>DDWMR,DDWR1-DDWA>DDWRW S DDWADJ=0
! 16: ;
! 17: D DELBLK^DDW9(.DDWNDEL)
! 18: D:$D(DDWADJ) POS(DDWRSV-(DDWADJ*DDWNDEL),DDWCSV,"RN")
! 19: D:'DDWISIN PASTE()
! 20: Q
! 21: ;
! 22: COPY() ;Copy selected text
! 23: N DDWC1,DDWC2,DDWISIN,DDWR1,DDWR2
! 24: I '$D(DDWMARK) D ERR("No text selected.") Q
! 25: ;
! 26: S DDWISIN=$$ISINSEL()
! 27: D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
! 28: D COPYBUF
! 29: D UNMARK^DDW7
! 30: D:'DDWISIN PASTE()
! 31: Q
! 32: ;
! 33: COPYBUF ;Copy selected text to buffer
! 34: N DDWND,DDWI,DDWX,DDWX1,DDWX2
! 35: K ^TMP("DDWB",$J)
! 36: S DDWND=0
! 37: ;
! 38: D:DDWR2-DDWR1>50 MSG^DDW("Copying text to buffer ...")
! 39: ;
! 40: F DDWI=DDWR1:1:$$MIN(DDWA,DDWR2) D
! 41: . S DDWND=DDWND+1
! 42: . S DDWX=^TMP("DDW",$J,DDWI)
! 43: . S DDWX=$E(DDWX,$S(DDWI=DDWR1:DDWC1,1:1),$S(DDWI=DDWR2:DDWC2,1:999))
! 44: . S ^TMP("DDWB",$J,DDWND)=DDWX
! 45: ;
! 46: F DDWI=$$MAX(DDWR1-DDWA,1):1:$$MIN(DDWR2-DDWA,DDWMR) D
! 47: . S DDWX=$E(DDWL(DDWI),$S(DDWI+DDWA=DDWR1:DDWC1,1:1),$S(DDWI+DDWA=DDWR2:DDWC2,1:999))
! 48: . S DDWND=DDWND+1
! 49: . S ^TMP("DDWB",$J,DDWND)=DDWX
! 50: ;
! 51: S DDWX1=$$RTOSTB(DDWR1),DDWX2=$$RTOSTB(DDWR2)
! 52: F DDWI=$$MIN(DDWSTB,DDWX1):-1:DDWX2 D
! 53: . S DDWND=DDWND+1
! 54: . S DDWX=^TMP("DDW1",$J,DDWI)
! 55: . S DDWX=$E(DDWX,$S(DDWI=DDWX1:DDWC1,1:1),$S(DDWI=DDWX2:DDWC2,1:999))
! 56: . S ^TMP("DDWB",$J,DDWND)=DDWX
! 57: ;
! 58: D:DDWR2-DDWR1>50 MSG^DDW()
! 59: Q
! 60: ;
! 61: PASTE() ;Paste text
! 62: I $D(DDWMARK) D ERR("You curently have text selected.") Q
! 63: I '$D(^TMP("DDWB",$J)) D ERR("The buffer contains no text.") Q
! 64: ;
! 65: N DDWBSIZ,DDWFC,DDWI,DDWLST,DDWNSV,DDWTXT,DDWX
! 66: S DDWBSIZ=$O(^TMP("DDWB",$J,""),-1)
! 67: ;
! 68: S DDWTXT=1
! 69: S:$L(DDWN)+1<DDWC DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
! 70: S (DDWNSV,DDWX)=$E(DDWN,1,DDWC-1)
! 71: S DDWTXT(1)=DDWX
! 72: I $L(DDWX)+$L(^TMP("DDWB",$J,1))<256!(DDWX="") S DDWTXT(1)=DDWTXT(1)_^(1)
! 73: E S DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=^TMP("DDWB",$J,1)
! 74: ;
! 75: S DDWLST=$E(DDWN,DDWC,999)
! 76: I DDWRAP,DDWLST?1." " S DDWLST=""
! 77: I DDWLST]"",DDWBSIZ=1 S DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=DDWLST,DDWLST=""
! 78: ;
! 79: D:DDWTXT ADJMAR^DDW6(.DDWTXT,"","I")
! 80: S (DDWN,DDWL(DDWRW))=DDWTXT(1)
! 81: ;
! 82: I DDWBSIZ=1,DDWTXT=1 S DDWFC=$L(DDWNSV)+$L(^TMP("DDWB",$J,1))+1
! 83: E I DDWBSIZ=1,DDWTXT=2,DDWLST="" S DDWFC=$L(DDWTXT(2))+1
! 84: E S DDWFC=1
! 85: ;
! 86: I $$SCR(DDWFC)=$P(DDWOFS,U,4) D
! 87: . D POS(DDWRW,$$MIN($L(DDWNSV),$L(DDWN))+1)
! 88: . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,$L(DDWNSV)+1,IOM+DDWOFS)
! 89: ;
! 90: D POS(DDWRW,DDWFC,"R")
! 91: ;
! 92: F DDWI=2:1:DDWTXT D
! 93: . D ILINE^DDW5
! 94: . S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
! 95: . D CUP(DDWRW,1)
! 96: . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 97: ;
! 98: F DDWI=2:1:DDWBSIZ D
! 99: . D ILINE^DDW5
! 100: . S (DDWN,DDWL(DDWRW))=^TMP("DDWB",$J,DDWI)
! 101: . D CUP(DDWRW,1)
! 102: . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 103: ;
! 104: I DDWLST]"" D
! 105: . D ILINE^DDW5
! 106: . S (DDWN,DDWL(DDWRW))=DDWLST
! 107: . D CUP(DDWRW,1)
! 108: . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
! 109: ;
! 110: D POS(DDWRW,DDWFC,"RN")
! 111: Q
! 112: ;
! 113: CUP(Y,X) ;
! 114: S DY=IOTM+Y-2,DX=X-1 X IOXY
! 115: Q
! 116: ;
! 117: POS(R,C,F) ;Pos cursor based on char pos C
! 118: N DDWX
! 119: S:$G(C)="E" C=$L($G(DDWL(R)))+1
! 120: S:$G(F)["N" DDWN=$G(DDWL(R))
! 121: S:$G(F)["R" DDWRW=R,DDWC=C
! 122: ;
! 123: S DDWX=C-DDWOFS
! 124: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
! 125: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
! 126: Q
! 127: ;
! 128: ISINSEL() ;Is the cursor within the selected text
! 129: N DDWI,DDWY
! 130: S DDWI=DDWRW+DDWA,DDWY=0
! 131: I DDWI<$P(DDWMARK,U)
! 132: E I DDWI>$P(DDWMARK,U,3)
! 133: E I DDWI=$P(DDWMARK,U),DDWC<$P(DDWMARK,U,2)
! 134: E I DDWI=$P(DDWMARK,U,3),DDWC-1>$P(DDWMARK,U,4)
! 135: E S DDWY=1
! 136: Q DDWY
! 137: ;
! 138: PMARK(M,R1,C1,R2,C2) ;Parse M (DDWMARK)
! 139: S R1=$P(M,U),C1=$P(M,U,2)
! 140: S R2=$P(M,U,3),C2=$P(M,U,4)
! 141: Q
! 142: ;
! 143: ERR(DDWX) ;
! 144: D MSG^DDW($C(7)_DDWX) H 2 D MSG^DDW()
! 145: D CUP(DDWRW,DDWC-DDWOFS)
! 146: F R *DDWX:0 E Q
! 147: Q
! 148: ;
! 149: TR(X) ;Strip trailing blanks
! 150: Q:$G(X)="" X
! 151: N I
! 152: F I=$L(X):-1:0 Q:$E(X,I)'=" "
! 153: Q $E(X,1,I)
! 154: ;
! 155: LD(X) ;Strip leading blanks
! 156: Q:$G(X)="" X
! 157: N I
! 158: F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
! 159: Q $E(X,I,999)
! 160: ;
! 161: RTOSTB(R) ;Return node in STB given line #
! 162: Q DDWSTB+DDWA+DDWMR+1-R
! 163: ;
! 164: SCR(C) ;Return screen number
! 165: Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
! 166: ;
! 167: MIN(X,Y) ;
! 168: Q $S(X<Y:X,1:Y)
! 169: ;
! 170: MAX(X,Y) ;
! 171: Q $S(X>Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDW8.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER