vhBIGEDIT(sPos,sY,sBGAtr,sStOpt,sEdOpt,sExec) ;Input van Tekstveld met wrap [ 12/14/2003 9:58 PM ] ; sPos = Positie met ";" gescheiden Top;Left;Bottom;Right ; sY = Local met de paragraaf text. Via .Local doorgegeven ; sBGAtr : Achtergrond attribute "I" of blanko ; sStOpt : Lijst van store opties ; O = One, tekst in local met parargraaf separ ; M = Multi, verschillende lijnen in verschillende pieces ; G = Global, afgekapt op 500 bytes per node ; L = Local, reeds in sY formaat, wordt nog wel gekopieerd ; D = Display, afgekapt op Horizontale lengte van x bytes ; F = Fast formaat zoals Local, wordt niet gecopieerd, ESC is niet mogelijk ; sEdOpt : Lijst van Edit opties ; T = NoTABS (geen tijdelijke linkermarge) ; F = Allow formatting (ªB,...) ; 1 = Rectangle ; D = Display ; E = Goto laatste karakter ; A = Append blanko paragraaf ; X = Toevoegen van Annuleer (aan snelmenu) ; S = Smart de tekst wordt niet herschreven indien Display -> Edit en Edit -> Display ; P = NO paragraph mark ; B = Both UpperCase en LowerCase ; L = LowerCase ; U = UpperCase ; ~ = Paragraaf separator is "~" New sYF,sCharPos,sParPos,sCharK,sCharR,sTop,sLeft,sBot,sRight,sLen,sVLen,sOffset,sModCnt,zbTO,zbold,sI,sJ,sOldYF,sIntern,sParSep Set sIntern=1 Goto VERWERK EDIT(sPos,sY,sBGAtr,sStOpt,sEdOpt,sExec,sWrapLen,sRefs,sMenu) New sYF,sCharPos,sParPos,sCharK,sCharR,sTop,sLeft,sBot,sRight,sLen,sVLen,sOffset,sModCnt,zbTO,zbold,sI,sJ,sOldYF,sIntern,sStRef,sParSep Set sIntern=1 If sStOpt'="" Set sStRef=sY Do CDISP(sStRef,.sY,sStOpt,sEdOpt,sRefs) Do VERWERK Quit:zb="ESC" If sStOpt'="" Do CSTORE(.sY,sStRef,sStOpt,sEdOpt,sWrapLen,sRefs) Quit ; ONE(sPos,sTxt,sBGAtr,sEdOpt) New sYF,sCharPos,sParPos,sCharK,sCharR,sTop,sLeft,sBot,sRight,sLen,sVLen,sOffset,sModCnt,zbTO,zbold,sI,sJ,sOldYF,sStOpt,sIntern,sParSep Set sStOpt="O" Set sIntern=1 Do CDISP("sTxt",.sY,sStOpt,sEdOpt) Do VERWERK Do CSTORE(.sY,"sTxt",sStOpt,sEdOpt) Quit sTxt MULTI(sPos,Local,sRefs,sBGAtr,sEdOpt,sLen) New sYF,sCharPos,sParPos,sCharK,sCharR,sTop,sLeft,sBot,sRight,sVLen,sOffset,sModCnt,zbTO,zbold,sI,sJ,sOldYF,sIntern,sParSep New sY,sStOpt,sCntN Set sStOpt="M" set sIntern=1 Do CDISP(Local,.sY,sStOpt,sEdOpt,sRefs) Set sCntN=$L(sRefs,D) Set:$P(sRefs,D,sCntN)="" sCntN=sCntN-1 Set:sEdOpt'["A" sEdOpt=sEdOpt_"X" MULTI2 Do VERWERK If zb=-2 Quit For sI=$O(sYF(""),-1):-1:1 Quit:$L($TR($P(sYF(sI),"`",5)," ","")) Kill sYF(sI) If $O(sYF(""),-1)>sCntN Set sI=$$^vhTXTPOP("SYS","BIGEDITMULTI"),sEdOpt=sEdOpt_"E" Goto MULTI2 Do CSTORE(.sY,Local,sStOpt,sEdOpt,sLen,sRefs) Quit GETWRAP(sY,sLen,sYF,sStOpt,sEdOpt,sRefs,sParam) ;sY oproepen via .Local indien sStOpt="" ;sY oproepen via $NA(Ref) indien sStOpt'="" ;sParam oproepen via .Local ;sYF oproepen via .Local, wordt verwijderd en ingevuld met de tekst ;De tekst zit in de 5de piece van sYF(x) New sCharPos,sParPos,sCharK,sCharR,sTop,sLeft,sBot,sRight,sVLen,sOffset,sModCnt,zbTO,zbold,sI,sJ,sOldYF,sIntern,sPos Set sPos="" If sStOpt'="" Do CDISP(sY,.sY,sStOpt,sEdOpt,sRefs) Set sCharPos=1,sParPos=1 Kill sYF Set sYF="" Set sY=$O(sY(""),-1) Do WRAP Quit DISPLAY(sPos,sY,sBGAtr,sStOpt,sEdOpt,sRefs,sParam) ;sY oproepen via .Local indien sStOpt="" ;sY oproepen via $NA(Ref) indien sStOpt'="" ;sParam oproepen via .Local New sYF,sCharPos,sParPos,sCharK,sCharR,sTop,sLeft,sBot,sRight,sLen,sVLen,sOffset,sModCnt,zbTO,zbold,sI,sJ,sOldYF,sIntern,sDSModif,sDSTime,sParSep Set sIntern=1 If sStOpt'="" Do CDISP(sY,.sY,sStOpt,sEdOpt,sRefs) Do INIT Do WRAP Do WRITE Quit VERWERK New ZMode,sDSNode,sDSModif,sDSTime,sCheckAttr Do INIT Set (^DEVSAVE($I,"BIGEDIT"),sDSNode)=$G(^DEVSAVE($I,"BIGEDIT"))+1#5 Do WRAP Do WRITE Quit:sEdOpt["D" ; Display only Set ZMode=$ZMODE ; onthouden instelling If $L($G(sEdOpt)) Xecute:sEdOpt["U" FUP Xecute:$G(sEdOpt)["L"!($G(sEdOpt)["B") FLO Use 0:(:"+S":$C(13,127,8,9,5)) Do READ For sY=$O(sY(""),-1):-1:2 Quit:$L($G(sY(sY))) Kill sY(sY) Set sY=$O(sY(""),-1) Use 0:(:$S($P(ZMode,"\")["U":"+",1:"-")_"U":$C(13)) ; herzetten uppercase Use 0:(:$S($P(ZMode,"\")["S":"+",1:"-")_"S":$C(13)) ; herzetten silent (no echo) Do KILL Set sCheckAttr="" For sY=1:1:sY Set sCheckAttr=sCheckAttr_sY(sY) Goto VERWERK:'$$CheckAttr(sCheckAttr) Quit INIT Kill sYF Set sYF=0 Set sEdOpt=$G(sEdOpt) Set sTop=$P(sPos,U,1) Set:'sTop sTop=1 Set:sTop=1&(sEdOpt["1") sTop=2 Set sLeft=$P(sPos,U,2) Set:'sLeft sLeft=1 Set:sLeft=1&(sEdOpt["1") sLeft=2 Set sBot=$P(sPos,U,3) Set:'sBot sBot=sScr("ROW") Set:sBot=sScr("ROW")&(sEdOpt["1") sBot=sBot-1 Set sRight=$P(sPos,U,4) Set:'sRight sRight=sScr("KOL") Set:sRight=sScr("KOL")&(sEdOpt["1") sRight=sRight-1 Set:'$G(sLen) sLen=sRight-sLeft-1 Set sVLen=sBot-sTop+1 Set sOffset=0 Set sDSModif=0 Set sDSTime=$P($H,",",2) Set:'$D(sBGAtr) sBGAtr="I" Do FILL^vhTERMINA(sTop,sLeft,sBot,sRight," ",sBGAtr) If sEdOpt["1" Do .Write @F7 .Do HLIJN^vhTERMINA(sTop-1,sLeft-1,sRight+1,"T","T",1) .Do VLIJN^vhTERMINA(sLeft-1,sTop,sBot,"","",1) .Do HLIJN^vhTERMINA(sBot+1,sLeft-1,sRight+1,"B","B",1) .Do VLIJN^vhTERMINA(sRight+1,sTop,sBot,"","",1) .Write @F8 Set sCharPos=1,sParPos=1 If sEdOpt'["D",sEdOpt["E"!(sEdOpt["A") Set sParPos=$O(sY(""),-1),sCharPos=$L(sY(sParPos))+1 ; End of tekst If sEdOpt'["D",sEdOpt["A",sCharPos>1 Set sParPos=sParPos+1,sCharPos=1,sY(sParPos)="" Set sParSep=$C(182) Set:sEdOpt["~" sParSep="~" Set sY=$O(sY(""),-1) Set zb="" Quit ; 1 W *7 READ ;I $G(sTimeOut) R in#sLen-sCharK-$P(sYF(sCharR),"`",4)+2:sTimeOut else S zb=-1 Q ;E R in#sLen-sCharK-$P(sYF(sCharR),"`",4)+2 Do KEY($G(TimeOut)) COM I in]"" Goto INSERT If $L(zb),"ENTER;TAB;HO;EN;INS;WIS;DEL;UP;DO;LE;RI;EOL;SPEC;LP;LK;HELP"[zb Goto @("L"_zb) If zb=0 goto LLE If $L(zb) Goto EXEC Goto READ EXEC If sStOpt["F",zb="ESC" Goto READ ; Bij Fast-optie geen Escape If $G(sExec)="" Quit:"PP;NP;ESC;SAV;CAN"[zb Goto READ Do EXEC^vhRES($P(sExec,"`"),$P(sExec,"`",2),"zb","(zb)") Quit:zb'="" Write @FMTCL For sI=1:1:$L(sBGAtr) Write @(@("FMT"_$E(sBGAtr,sI))) Goto READ Quit LSPEC New Input Do CALLSPEC^vhMenu(sTop_";"_(sRight+(sEdOpt["1"))_";T;R","SYSBIGEDIT") If $ZV["MSM" Use 0:(::::65::::$C(13,27,8,9)) ; Escape processing en No echo Else Use 0:(:"+S":$C(13,8,9)) Write @FMTCL For sI=1:1:$L(sBGAtr) Write @(@("FMT"_$E(sBGAtr,sI))) Do CALCPOS If $L($G(Input)),"DA;DP;SL;AN;LHO;LEN;LLK;LLP;RESTORE,EXPORT"[Input Goto @Input Goto READ EXPORT New K,sI,FVAN,FNAAR ; Exporten van de tekst naar een ascii file Do VANNAAR^vhTERMINA("MC") Do STORE^vhTERMINA() Set FP=1501 Write @F,@F1,!,"TRANSFERT via de ASCII transfert receiver" Read K For sI=1:1:$O(sY(""),-1) Write $TR(sY(sI),FVAN,FNAAR),! Write "~~~" Do REFRESH^vhTERMINA() Do CALCPOS Goto READ BACKUP(NewNode) ; Opslaan van tekst voor latere restore Set sDSTime=$P($H,",",2),sDSModif=0 Do CSTORE(.sY,$NA(^DEVSAVE($I,"BIGEDIT",sDSNode)),"G","",500) Set:NewNode (^DEVSAVE($I,"BIGEDIT"),sDSNode)=$G(^DEVSAVE($I,"BIGEDIT"))+1#5 Quit RESTORE New Node Set Node=^DEVSAVE($I,"BIGEDIT")-1 Set:Node<0 Node=4 If '$D(^DEVSAVE($I,"BIGEDIT",Node)) Quit Kill sY Do CDISP($NA(^DEVSAVE($I,"BIGEDIT",Node)),.sY,"G","") Set sParPos=1,sCharPos=1 Do WRAP,MARKALL,WRITE Goto READ LHELP Goto READ LINS New Input Set:'$L($G(sMenu)) sMenu="SYSBIGINS" Do CALLSPEC^vhMenu(sTop_";"_(sLeft+(sEdOpt["1"))_";T;R",sMenu) If $ZV["MSM" Use 0:(::::65::::$C(13,27,8,9)) ; Escape processing en No echo Else Use 0:(:"+S":$C(13,8,9)) Write @FMTCL For sI=1:1:$L(sBGAtr) Write @(@("FMT"_$E(sBGAtr,sI))) Do CALCPOS If $L($G(Input)) Set in=Input Goto INSERT Goto READ DA ;Delete All Do BACKUP(1) Kill sY Set sY=1,sY(1)="" Set sParPos=1,sCharPos=1 Do WRAP,WRITE Goto READ LEOL DP ;Delete paragraaf Do BACKUP(1) Do LDELETE^vhLISTE(sParPos,sY,"sY") Set sY=sY-1 If sY<1 Kill sY Set sY=1,sY(1)="" Set sParPos=sParPos-1 Set:sParPos<1 sParPos=1 Set sCharPos=$L($G(sY(sParPos)))+1 Do WRAP,WRITE Goto READ Quit LLP ; Invoegen van tekst in ^FAX("COPY") Do .New sClip,sI .Do CDISP($NA(^DEVSAVE($I,"CLIP")),.sClip,"G","") .For sI=1:1:$O(sClip(""),-1) Do ..If sI>1 Do ; Invoegen paragraaf einde ...Do LINSERT^vhLISTE(sParPos+1,sY,"sY") ...Set sY=sY+1 ...Set sY(sParPos+1)=$E(sY(sParPos),sCharPos,9999) ...Set sY(sParPos)=$E(sY(sParPos),1,sCharPos-1) ...Set sParPos=sParPos+1,sCharPos=1 ..Set in=sClip(sI) ..Set:'$L(sY(sParPos)) sCharPos=1 ..Set sY(sParPos)=$E(sY(sParPos),1,sCharPos-1)_sClip(sI)_$E(sY(sParPos),sCharPos,9999) ..Set sCharPos=sCharPos+$L(sClip(sI)) Do WRAP,WRITE Goto READ Quit LLK ;Kopieren naar ^FAX("COPY") Do CSTORE(.sY,$NA(^DEVSAVE($I,"CLIP")),"G","") Goto READ SL ; Sluit Set zb="ENTER" Quit AN ; Annuleer Set zb="ESC" Quit KEY(TimeOut) Set zbold=zb,zbTO=0 If $L(TimeOut) Read in#1:TimeOut Else Set zb=-1 Quit Else Read in#1 Set in=$TR(in,$C(2),"") If sDSModif,$P($H,",",2)>($G(sDSTime)+10) Do BACKUP(0) Set zb=$$TRANS^vhKEY(1) Quit INSERT ; tussenvoegen Set zbold=999,sDSModif=1 Set:'$L(sY(sParPos)) sCharPos=1 Set in=$TR(in,$C(182),"") ; geen ParSep invoegen bij Paste Set sY(sParPos)=$E(sY(sParPos),1,sCharPos-1)_in_$E(sY(sParPos),sCharPos,9999) Set sCharPos=sCharPos+$L(in) Do WRAP If sModCnt>1 Do WRITE Goto READ Do KEY(0) If zb=zbold G INSERT Do WRITE Goto COM:zb'=-1,READ ; LENTER ; Carriage return = Insert paragraaf ; Nakijken of eninde van de txt bereikt en alleen nog maar LEGE lijnen Set sExit=1 For sI=sParPos+1:1:sY If $L(sY(sI)) Set sExit=0 Quit If sExit,'$L(sY(sParPos)),'$L($G(sY(sParPos-1))) Quit Do LINSERT^vhLISTE(sParPos+1,sY,"sY") Set sY=sY+1 Set sY(sParPos+1)=$E(sY(sParPos),sCharPos,9999) Set sY(sParPos)=$E(sY(sParPos),1,sCharPos-1) Set sParPos=sParPos+1,sCharPos=1 Do WRAP,WRITE Goto READ LUP ; Cursor UP If sCharR=1 Goto READ Set sCharR=sCharR-1 If $P(sYF(sCharR),"`",3)>sCharK,$P(sYF(sCharR),"`",3)sCharK,$P(sYF(sCharR),"`",3)$P(sYF(sCharR),"`",3) Goto READ:sCharR=sYF Set sCharK=1,sCharR=sCharR+1 Else Set sCharK=sCharK+1 Do KEY(0) If zb=zbold G LRI Do CALCPOS Goto COM:zb'=-1,READ LLE ;Cursor LEFT If sCharK=1 Goto READ:sCharR=1 Set sCharR=sCharR-1,sCharK=$P(sYF(sCharR),"`",3)+1 Else Set sCharK=sCharK-1 Do KEY(0) If zb=zbold G LLE Do CALCPOS Goto COM:zb'=-1,READ LHO ; Cursor HOME If sCharPos=1,sParPos=1 Goto READ Set:sCharPos=1 sParPos=sParPos-1 Set sCharPos=1 Do WRAP,WRITE Goto READ LEN ; Cursor END If sCharPos>$L(sY(sParPos)),sParPos=sY Goto READ Set:sCharPos>$L(sY(sParPos)) sParPos=sParPos+1 Set sCharPos=$L(sY(sParPos))+1 Do WRAP,WRITE Goto READ LTAB ; Tab Goto READ:sEdOpt["T" ; Geen TABs toegelaten Goto READ:sCharPos>20 Set in=$C(9) Goto INSERT If sCharK+8>$P(sYF(sCharR),"`",3) Goto READ:sCharR=sYF Set sCharK=1,sCharR=sCharR+1 Else Set sCharK=sCharK+8 Do CALCPOS Goto READ LWIS ; Verwijder op cursorpos Set sParOld=sParPos,zbold="" If sCharPos>$L(sY(sParPos)),sParPos1 Do WRITE Goto READ Do KEY(0) If zb=zbold Goto LINS Do WRITE Goto COM:zb'=-1,READ LDEL ; Ook backspace ; Verwijder voor cursorpos Set sParOld=sParPos,zbold="" If sCharPos>1 Set sY(sParPos)=$E(sY(sParPos),1,sCharPos-2)_$E(sY(sParPos),sCharPos,9999),sCharPos=sCharPos-1 Else If sParPos>1 Set sParPos=sParPos-1,sCharPos=$L(sY(sParPos))+1,sY(sParPos)=sY(sParPos)_sY(sParPos+1),sY=sY-1 Do LDELETE^vhLISTE(sParPos+1,sY+1,"sY") Do WRAP If sModCnt>1 Do WRITE Goto READ Do KEY(0) If zb=zbold G LDEL Do WRITE Goto COM:zb'=-1,READ ST F a=0:0 Q:$E(X,$L(X)\2,999)'?1." " S X=$E(X,1,$L(X)\2-1) F a=$L(X):-1:1 I $E(X,a)]" " S X=$E(X,1,a) Q Q KILL K char,if,in,urv,xc,EOL,IsCVL w @FMTCL Q CALCPOS ; Omzetting van PARAGRAAF Pos naar RIJ&KOLOM Pos Set sParPos=$P(sYF(sCharR),"`",2) Set sCharPos=0 For sI=sCharR:-1:1 Quit:$P($G(sYF(sI-1)),"`",2)'=sParPos For sI=sI:1:sCharR-1 Set sCharPos=sCharPos+$P(sYF(sI),"`",3) Set sCharPos=sCharPos+sCharK If sOffset+sVLensTot Do FILL^vhTERMINA(sTop+sTot-sOffset,sLeft,sTop+sOldYF-sOffset-1,sLeft+$P(sLen,";",$L(sLen,";"))-1) .Set sOldYF=0 Set FP=sCharR-sOffset+sTop-1*100+sCharK+$P(sYF(sCharR),"`",4)+sLeft-1 Write @F w @FCS Quit MARKALL ; Markeren van alle lijnen om herschreven te worden. Set sModCnt=sVLen For sI=sOffset+1:1:sOffset+sVLen Set:$D(sYF(sI)) $P(sYF(sI),"`")=1 Quit WONE(sPos,sIndent,sParMark,sString) ; Schrijven van een lijn ;Do FILL^vhTERMINA(sTop+sPos-1,sLeft,sTop+sPos-1,sLeft+$P(sLen,";",$L(sLen,";"))) Set FP=sTop+sPos-1*100+sLeft Write @F,$J("",sIndent),$E(sString,1,$P(sLen,";",$L(sLen,";"))) Write:sParMark&(sBGAtr'["B") @FMTB,$C(182),@FMTb Write:sParMark&(sBGAtr["B") @FMTb,$C(182),@FMTB Write $J("",$P(sLen,";",$L(sLen,";"))-sIndent-$L(sString)+1-sParMark) Quit WRAP ; Wrappen van de paragraaf tekst naar tekst per rij. ; Velden : Changed`Paragraaf in sY`Lengte`Indent`String New sTT,sIndent,sCharCnt,sMax,sTxt Set sOldYF=sYF Set (sJ,sYF,sCharK,sCharR,sModCnt)=0 Set sIndent="" For sJ=1:1:sY Do .Set sTT=sY(sJ) .Set:$D(sParam)&(sTT["«") sTT=$$CONVERT(sTT,.sParam) .Set:$E(sTT)'=$C(9) sIndent="" .Set sCharCnt=0 .Set sMax=$L(sTT) .For Do Quit:sTT="" ..Set sL=$P(sLen,";",sYF+1) Set:'sL sL=$P(sLen,";",$L(sLen,";")) ..Set sI=$L(sTT) ..If sI+sIndent>sL Do ; Opzoeken van woordsplitsing ...Set sI=0 ...For Set sMem=$F(sTT," ",sI+1) Set:'sMem sMem=$L(sTT) Quit:sMem+sIndent>sL Set sI=sMem-1 ...Set:'sI sI=sL-sIndent ..Set sYF=sYF+1,sTxt="`"_sJ_"`"_sI_"`"_(sIndent-$S(sIndent>0&($E(sTT)=$C(9)):1,1:0))_"`"_$TR($E(sTT,1,sI),$C(9,160)," ") ..Set:$P(sTxt,"`",1,5)'=$P($G(sYF(sYF)),"`",1,5) $P(sTxt,"`",1)=1,sModCnt=sModCnt+1 ..Set sYF(sYF)=sTxt ..If sCharCnt+sI'20 sIndent=0 ..Set $E(sTT,1,sI)="" .If sParPos=sJ,'sCharR Set sCharPos=$L(sY(sJ))+1,sCharR=sYF,sCharK=$P(sYF(sYF),"`",3)+1 Quit CONVERT(sTxt,sParam) ;sParam oproepen via .Local New sE,sB,sVal,sLabel Set sE=1 For Set sB=$F(sTxt,"«",sE),sE=$F(sTxt,"»",sE) Quit:'sB!'sE Do .Set sLabel=$E(sTxt,sB,sE-2) .Quit:'$L(sLabel) .Set:'$D(sParam(sLabel)) sLabel=$$UPTRIMAN^vhRtn1(sLabel) .Quit:'$D(sParam(sLabel)) .Set sVal=sParam(sLabel) .Set:sVal["`" sVal=$$CEL^vhFMT(0,$P(sVal,"`"),$P(sVal,"`",2),$P(sVal,"`",3),$P(sVal,"`",4),$P(sVal,"`",5),"","") .Set $E(sTxt,sB-1,sE-1)=sVal .Set sE=sE-(sE-sB)+$L(sVal) Quit sTxt CST2ST(sRef,sStOpt,sEdOpt,sRefs,sRef2,sStOpt2,sEdOpt2,sWrapLn2,sRefs2,sParam) ;Conversie van STORE formaat naar een ander STORE formaat ;sParam oproepen via .Local New sY,sI Do CDISP(sRef,.sY,sStOpt,$G(sEdOpt),$G(sRefs)) If $D(sParam) For sI=1:1:$O(sY(""),-1) Set sY(sI)=$$CONVERT(sY(sI),.sParam) Do CSTORE(.sY,sRef2,sStOpt2,$G(sEdOpt2),$G(sWrapLn2),$G(sRefs2)) Quit CDISP(sRef,sY,sStOpt,sEdOpt,sRefs) ; Convertie van store naar intern format ; sY oproepen via .Local New sI,Ref,sParSep Set sParSep=$C(182) Set:sEdOpt["~" sParSep="~" If sStOpt["O" Do .For sI=1:1:$L(@sRef,sParSep) Set sY(sI)=$P(@sRef,sParSep,sI) If sStOpt["L" Do .For sI=1:1 Quit:'$D(@sRef@(sI)) Set sY(sI)=@sRef@(sI) If sStOpt["M" Do .For sI=1:1 Set Ref=$P(sRefs,D,sI) Quit:Ref="" Set sY(sI)=$P(@sRef@($P(Ref,U)),D,$P(Ref,U,2)) If sStOpt["G"!(sStOpt["D") Do .New sJ,sTxt .Set sY=1,sY(1)="" .For sI=1:1 Quit:'$D(@sRef@(sI)) Set sTxt=@sRef@(sI) For sJ=1:1:$L(sTxt,sParSep) Set sY(sY)=sY(sY)_$P(sTxt,sParSep,sJ) Set:$P(sTxt,sParSep,sJ,sJ+1)[sParSep sY=sY+1,sY(sY)="" Set sY=$O(sY(""),-1) Quit CSTORE(sY,sRef,sStOpt,sEdOpt,sWrapLen,sRefs) ; Convertie van intern format naar store ; sY oproepen via .Local New sI,Ref,sParSep Set sParSep=$C(182) Set:sEdOpt["~" sParSep="~" If sStOpt["O" Do Quit .Set @sRef="" .For sI=1:1:$O(sY(""),-1) Set:$L(@sRef)+$L(sY(sI))<4000 $P(@sRef,sParSep,sI)=sY(sI) Kill sY(sI) If sStOpt["L" Do Quit .For sI=1:1 Quit:'$D(@sY@(sI)) Set @sRef@(sI)=sY(sI) .Set @sRef=$O(@sRef@(""),-1) If sStOpt["M" Do Quit .If '$G(sIntern)!($G(sLen)'=$G(sWrapLen,$G(sLen))) New sYF Do GETWRAP(.sY,sWrapLen,.sYF,"","") .For sI=1:1 Set Ref=$P(sRefs,D,sI) Quit:Ref="" Set $P(@sRef@($P(Ref,U)),D,$P(Ref,U,2))=$J("",$P($G(sYF(sI)),"`",4))_$P($G(sYF(sI)),"`",5) If sStOpt["D" Do Quit .If '$G(sIntern)!($G(sLen)'=$G(sWrapLen,$G(sLen))) New sYF Do GETWRAP(.sY,sWrapLen,.sYF,"","") .For sI=1:1 Quit:'$D(@sRef@(sI)) Kill @sRef@(sI) .For sI=1:1:$O(sYF(""),-1) Set @sRef@(sI)=$P($G(sYF(sI)),"`",5)_$S('$D(sYF(sI+1)):"",$P(sYF(sI),"`",2)'=$P(sYF(sI+1),"`",2):sParSep,1:"") If sStOpt["G" Do Quit .New sJ .For sI=1:1 Quit:'$D(@sRef@(sI)) Kill @sRef@(sI) .Set:'$G(sWrapLen) sWrapLen=500 Set:sWrapLen>500 sWrapLen=500 .Set sJ=0,sTxt="" .For sI=1:1:$O(sY(""),-1) Do ..Set sTxt=sTxt_$S(sI>1:sParSep,1:"")_sY(sI) ..For Quit:$L(sTxt)$L(Tekst,"ªb") Warn=Warn_"~Geleive vetdruk af te zetten!" Set:$L(Tekst,"ªU")<$L(Tekst,"ªu") Warn=Warn_"~Geleive onderlijnen op te zetten!" Set:$L(Tekst,"ªU")>$L(Tekst,"ªu") Warn=Warn_"~Geleive onderlijnen af te zetten!" ; Is de volgorde van op en afzetten vetdruk en onderlijnen juist (eerst op, dan af)? If Warn'["vetdruk",Tekst["ªB",Tekst["ªb" Do . Set VVetdruk=0 . For I=1:1:($L(Tekst,"ªB")-1) If $L($P(Tekst,"ªB",1,I),"ªb")'=I Set VVetdruk=1 Quit . Set:VVetdruk Warn=Warn_"~De volgorde vetdruk op en af is verkeerd!" If Warn'["onderlijnen",Tekst["ªU",Tekst["ªu" Do . Set VOnderlijn=0 . For I=1:1:($L(Tekst,"ªU")-1) If $L($P(Tekst,"ªU",1,I),"ªu")'=I Set VOnderlijn=1 Quit . Set:VOnderlijn Warn=Warn_"~De volgorde onderlijnen op en af is verkeerd!" ; Is de nesting van vetdruk en onderlijnen juist? If Warn'["vetdruk",Warn'["onderlijnen" Do . Set Stack="" . For I=1:1:$L(Tekst) Do:$E(Tekst,I)="ª" If Stack="?" Set Warn=Warn_"~Het opeenvolgen van vetdruk en onderlijnen is verkeerd!" Quit . . If "BU"[$E(Tekst,I+1) Set Stack=Stack_$E(Tekst,I,I+1) Quit . . If $E(Tekst,I+1)="b",$E(Stack,$L(Stack))'="B" Set Stack="?" Quit . . If $E(Tekst,I+1)="u",$E(Stack,$L(Stack))'="U" Set Stack="?" Quit . . Set $E(Stack,$L(Stack)-1,$L(Stack))="" ; Er is een probleem! Do:$L(Warn) . Set $E(Warn)="" . Do WARN^vhTXTPOP(.Warn,"") . Set CheckTekst=0 Quit CheckTekst