Return to DDW8.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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)