Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDW8

DDW8.m

Go to the documentation of this file. 
  1. DDW8 ;SFISC/MKO-COPY, CUT, PASTE ;2:15 PM  5 Jul 1996
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. CUT() ;Cut selected text
  1.  N DDWADJ,DDWC1,DDWC2,DDWCSV,DDWISIN,DDWNDEL,DDWR1,DDWR2,DDWRSV
  1.  I '$D(DDWMARK) D ERR("No text selected.") Q
  1.  ;
  1.  S DDWED=1
  1.  S DDWISIN=$$ISINSEL()
  1.  D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
  1.  D COPYBUF
  1.  ;
  1.  S DDWRSV=DDWRW,DDWCSV=DDWC
  1.  I DDWR2>DDWA,DDWR2-DDWA<DDWRW S DDWADJ=1
  1.  E  I DDWR1-DDWA'>DDWMR,DDWR1-DDWA>DDWRW S DDWADJ=0
  1.  ;
  1.  D DELBLK^DDW9(.DDWNDEL)
  1.  D:$D(DDWADJ) POS(DDWRSV-(DDWADJ*DDWNDEL),DDWCSV,"RN")
  1.  D:'DDWISIN PASTE()
  1.  Q
  1.  ;
  1. COPY() ;Copy selected text
  1.  N DDWC1,DDWC2,DDWISIN,DDWR1,DDWR2
  1.  I '$D(DDWMARK) D ERR("No text selected.") Q
  1.  ;
  1.  S DDWISIN=$$ISINSEL()
  1.  D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
  1.  D COPYBUF
  1.  D UNMARK^DDW7
  1.  D:'DDWISIN PASTE()
  1.  Q
  1.  ;
  1. COPYBUF ;Copy selected text to buffer
  1.  N DDWND,DDWI,DDWX,DDWX1,DDWX2
  1.  K ^TMP("DDWB",$J)
  1.  S DDWND=0
  1.  ;
  1.  D:DDWR2-DDWR1>50 MSG^DDW("Copying text to buffer ...")
  1.  ;
  1.  F DDWI=DDWR1:1:$$MIN(DDWA,DDWR2) D
  1.  . S DDWND=DDWND+1
  1.  . S DDWX=^TMP("DDW",$J,DDWI)
  1.  . S DDWX=$E(DDWX,$S(DDWI=DDWR1:DDWC1,1:1),$S(DDWI=DDWR2:DDWC2,1:999))
  1.  . S ^TMP("DDWB",$J,DDWND)=DDWX
  1.  ;
  1.  F DDWI=$$MAX(DDWR1-DDWA,1):1:$$MIN(DDWR2-DDWA,DDWMR) D
  1.  . S DDWX=$E(DDWL(DDWI),$S(DDWI+DDWA=DDWR1:DDWC1,1:1),$S(DDWI+DDWA=DDWR2:DDWC2,1:999))
  1.  . S DDWND=DDWND+1
  1.  . S ^TMP("DDWB",$J,DDWND)=DDWX
  1.  ;
  1.  S DDWX1=$$RTOSTB(DDWR1),DDWX2=$$RTOSTB(DDWR2)
  1.  F DDWI=$$MIN(DDWSTB,DDWX1):-1:DDWX2 D
  1.  . S DDWND=DDWND+1
  1.  . S DDWX=^TMP("DDW1",$J,DDWI)
  1.  . S DDWX=$E(DDWX,$S(DDWI=DDWX1:DDWC1,1:1),$S(DDWI=DDWX2:DDWC2,1:999))
  1.  . S ^TMP("DDWB",$J,DDWND)=DDWX
  1.  ;
  1.  D:DDWR2-DDWR1>50 MSG^DDW()
  1.  Q
  1.  ;
  1. PASTE() ;Paste text
  1.  I $D(DDWMARK) D ERR("You curently have text selected.") Q
  1.  I '$D(^TMP("DDWB",$J)) D ERR("The buffer contains no text.") Q
  1.  ;
  1.  S DDWED=1
  1.  N DDWBSIZ,DDWFC,DDWI,DDWLST,DDWNSV,DDWTXT,DDWX
  1.  S DDWBSIZ=$O(^TMP("DDWB",$J,""),-1)
  1.  ;
  1.  S DDWTXT=1
  1.  S:$L(DDWN)+1<DDWC DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
  1.  S (DDWNSV,DDWX)=$E(DDWN,1,DDWC-1)
  1.  S DDWTXT(1)=DDWX
  1.  I $L(DDWX)+$L(^TMP("DDWB",$J,1))<256!(DDWX="") S DDWTXT(1)=DDWTXT(1)_^(1)
  1.  E  S DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=^TMP("DDWB",$J,1)
  1.  ;
  1.  S DDWLST=$E(DDWN,DDWC,999)
  1.  I DDWRAP,DDWLST?1." " S DDWLST=""
  1.  I DDWLST]"",DDWBSIZ=1 S DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=DDWLST,DDWLST=""
  1.  ;
  1.  D:DDWTXT ADJMAR^DDW6(.DDWTXT,"","I")
  1.  S (DDWN,DDWL(DDWRW))=DDWTXT(1)
  1.  ;
  1.  I DDWBSIZ=1,DDWTXT=1 S DDWFC=$L(DDWNSV)+$L(^TMP("DDWB",$J,1))+1
  1.  E  I DDWBSIZ=1,DDWTXT=2,DDWLST="" S DDWFC=$L(DDWTXT(2))+1
  1.  E  S DDWFC=1
  1.  ;
  1.  I $$SCR(DDWFC)=$P(DDWOFS,U,4) D
  1.  . D POS(DDWRW,$$MIN($L(DDWNSV),$L(DDWN))+1)
  1.  . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,$L(DDWNSV)+1,IOM+DDWOFS)
  1.  ;
  1.  D POS(DDWRW,DDWFC,"R")
  1.  ;
  1.  F DDWI=2:1:DDWTXT D
  1.  . D ILINE^DDW5
  1.  . S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
  1.  . D CUP(DDWRW,1)
  1.  . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  ;
  1.  F DDWI=2:1:DDWBSIZ D
  1.  . D ILINE^DDW5
  1.  . S (DDWN,DDWL(DDWRW))=^TMP("DDWB",$J,DDWI)
  1.  . D CUP(DDWRW,1)
  1.  . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  ;
  1.  I DDWLST]"" D
  1.  . D ILINE^DDW5
  1.  . S (DDWN,DDWL(DDWRW))=DDWLST
  1.  . D CUP(DDWRW,1)
  1.  . W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  ;
  1.  D POS(DDWRW,DDWFC,"RN")
  1.  Q
  1.  ;
  1. CUP(Y,X) ;
  1.  S DY=IOTM+Y-2,DX=X-1 X IOXY
  1.  Q
  1.  ;
  1. POS(R,C,F) ;Pos cursor based on char pos C
  1.  N DDWX
  1.  S:$G(C)="E" C=$L($G(DDWL(R)))+1
  1.  S:$G(F)["N" DDWN=$G(DDWL(R))
  1.  S:$G(F)["R" DDWRW=R,DDWC=C
  1.  ;
  1.  S DDWX=C-DDWOFS
  1.  I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  1.  S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1.  Q
  1.  ;
  1. ISINSEL() ;Is the cursor within the selected text
  1.  N DDWI,DDWY
  1.  S DDWI=DDWRW+DDWA,DDWY=0
  1.  I DDWI<$P(DDWMARK,U)
  1.  E  I DDWI>$P(DDWMARK,U,3)
  1.  E  I DDWI=$P(DDWMARK,U),DDWC<$P(DDWMARK,U,2)
  1.  E  I DDWI=$P(DDWMARK,U,3),DDWC-1>$P(DDWMARK,U,4)
  1.  E  S DDWY=1
  1.  Q DDWY
  1.  ;
  1. PMARK(M,R1,C1,R2,C2) ;Parse M (DDWMARK)
  1.  S R1=$P(M,U),C1=$P(M,U,2)
  1.  S R2=$P(M,U,3),C2=$P(M,U,4)
  1.  Q
  1.  ;
  1. ERR(DDWX) ;
  1.  D MSG^DDW($C(7)_DDWX) H 2 D MSG^DDW()
  1.  D CUP(DDWRW,DDWC-DDWOFS)
  1.  F  R *DDWX:0 E  Q
  1.  Q
  1.  ;
  1. TR(X) ;Strip trailing blanks
  1.  Q:$G(X)="" X
  1.  N I
  1.  F I=$L(X):-1:0 Q:$E(X,I)'=" "
  1.  Q $E(X,1,I)
  1.  ;
  1. LD(X) ;Strip leading blanks
  1.  Q:$G(X)="" X
  1.  N I
  1.  F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
  1.  Q $E(X,I,999)
  1.  ;
  1. RTOSTB(R) ;Return node in STB given line #
  1.  Q DDWSTB+DDWA+DDWMR+1-R
  1.  ;
  1. SCR(C) ;Return screen number
  1.  Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
  1.  ;
  1. MIN(X,Y) ;
  1.  Q $S(X<Y:X,1:Y)
  1.  ;
  1. MAX(X,Y) ;
  1.  Q $S(X>Y:X,1:Y)