/* $VER: 3.1 (11/12/99) by Bruce Steers */
/*
mailto:bsteers@btinternet.com
http://www.btinternet.com/~bsteers/
*/


OPTIONS RESULTS

hlp.0=0
seld=0
ver='3.1' ; verdate='(11/12/99)'

parse arg prefsfile
if prefsfile=="" then prefsfile='env:Clipper.cfg'

call loadprefs()

if ~show('l','rexxsupport.library') then call addlib('rexxsupport.library',0,-30,0);
ib=showlist(l,'intuition.library',,a); call forbid; scrA=next(ib,56); screen=word(IMPORT(next(scrA,26)),1); call permit

parse source . . progname .

 do forever
 reload=0
 call makegui()
eofl=0

 do while eofl==0
  eofl=eof(pipe)
  if ~eofl then do
  call topipe('con')
  in= readln(pipe)
  parse var in in1 in2 in3 in4 in5 .
  if in1='gadget' then call gadget()
  if in1='menu' then call menu()
  if in1='help' then if in2~=-1 then call help()
  if in1='iconify' then call topipe('id 0 s '64-(in2*32))
  if in1='key' then call key()
  end
 end

 IF pipe~=0 THEN call Close(pipe)
 openp=0
 if eofl~=-3 then exit
 end

key:   /*say in*/
select
when in2==69 then exit(0)
when in2==147 then do ; address command 'run rx 'progname ;exit; end
otherwise nop
end
return

menu:   /* say in */
 if in2==0 then do
 if in3==0 then call req('Clipper',' Clipper 'ver' *n Written by Bruce Steers *n on 'verdate' *n *n bsteers@btinternet.com *n http://www.btinternet.com/~bsteers/ *n *n :^) *n ','_OK')
 /* --- bar ---*/
 if in3==3 then call prefs()
 if in3==5 then do ; hs=in5 ; call reopenwindow() ; end
 if in3==7 then exit(0)

 end
if in2==1 then do
if in3==0 then call insertTE('0')
if in3==1 then call insertTE('1')
if in3==2 then call insertTE('2')
if in3==3 then call insertTE('3')
if in3==4 then call insertTE('4')
if in3==5 then call insertTE('5')
if in3==6 then call insertTE('6')
if in3==7 then call insertTE('7')
if in3==8 then call insertTE('8')
if in3==9 then call insertTE('9')
if in3==10 then call insertTE('10')
if in3==11 then call insertTE('11')
if in3==12 then call insertTE('12')
if in3==13 then call insertTE('13')
if in3==14 then call insertTE('14')
if in3==15 then call insertTE('15')

if in3==17 then call insertTE('')
if in3==18 then call insertTE('')
if in3==19 then call insertTE('')
if in3==20 then call insertTE('')
if in3==21 then call insertTE('')
end

/* say in */

return

insertTE:;
 msgs.lstat.seld.text=''msgs.lstat.seld.text''arg(1)''
 tt=nocom(msgs.lstat.seld.text)
 tp=length(msgs.lstat.seld.text)

 call topipe('id 'cpat' gt "'nocom(msgs.lstat.seld.name)'¿'tt'"')
 call topipe('id 'txts' gt "'tt'" s 'tp'')
return


prefs:
if arg(1)=="" then type=req('Clipper',' Preferences ','Save','_Load','_Cancel')
else; type=arg(1)


 if type==1 then do
 np=getf(prefsfile,'Prefs to Save')
 if np=="" then return
 prefsfile=np ;
 call open(ph,prefsfile,'W')
txt=";Prefs for Clipper "ver" saved on ("date('e')") at "time('c')""
call writeln(ph,txt)
 call writeln(pipe,'id 0 read') ; ln=readln(pipe)
 parse var ln wl wt ww wh .
 call writeln(ph,''wl' 'wt' 'ww' 'wh' 'amode' 'hs' 'warnclip' 'lstat' 'seld'')
 call writeln(ph,strip(list,,'"'))

  do l=1 to listem.0
   do c=1 to msgs.l.0
   call writeln(ph,''nocom(msgs.l.c.name)'¿'nocom(msgs.l.c.text)'')
   end
  if l~=listem.0 then call writeln(ph,'[¿]')
  end

 call close(ph)
if upper(prefsfile)=='ENVARC:CLIPPER.CFG' then address command 'copy clone envarc:Clipper.cfg env:'
if upper(prefsfile)=='ENV:CLIPPER.CFG' then address command 'copy clone env:Clipper.cfg envarc:'
 end


if type==2 then do
call loadprefs()
end

if type==3 then return
return

loadprefs:
if ~exists('env:Clipper.cfg') then do
if req('Clipper by Bruce',' No Clipper.cfg File *n was found in ENV: *n *n What Default Shall i do ?','_Create Default','_Abort')==2 then exit
address command 'echo >env:Clipper.cfg ";Prefs for Clipper 'ver' saved on ('date(e)') at 'time(c)'*n10 10 10 200 0 0"'
address command 'echo >>env:Clipper.cfg "commands¿Internet*nAWeb Home¿run >nil: aweb3:aweb-II http://www.btinternet.com/~bsteers/*nget awnp ver¿version full file l:awnpipe-handler%n*n[¿]*nMY e-mail¿Bruce Steers <bsteers@btinternet.com>*nMY URL¿http://www.btinternet.com/~bsteers/"'
end

if ~exists('envarc:Clipper.cfg') then address command 'copy clone env:Clipper.cfg envarc:'
 if openp=='main' then do
 np=getf(prefsfile,'Prefs to Load')
 if np=="" then return
 prefsfile=np ;
 end

call open(ph,prefsfile)

ln=readln(ph)
newpref=0
if index(ln,';Prefs for Clipper')==0 then newpref=1
else ; ln=readln(ph)
if ln~="" then parse var ln wl wt ww wh amode hs warnclip lstat seld . ; else exit(205)
if amode=="" then amode=0 ; if hs=="" then hs=0 ; if warnclip=="" then warnclip=20 ; if lstat=="" then lstat=1; if seld=="" then seld=0
if newpref==1 then ln='Main'
else; ln=readln(ph)

 if ln~="" then do;
  list='"'ln'"'
  p=1
  do c=1 until p<0
  p=index(ln,'¿')
   if p~=0 then do
   listem.0=c
   listem.c=substr(ln,1,p-1)
   ln=substr(ln,p+1)
   end
   else do; p=-5 ; listem.0=c ; listem.c=ln; end

  end
 end
 else; exit(20)

doing=1 ; p=1
 do while ~eof(ph)
 ln=readln(ph)
  if ln~="" then do;
  if ln=='[¿]' then do; doing=doing+1 ;p=1; end
   else do;
   parse var ln msgs.doing.p.name '¿' msgs.doing.p.text
   msgs.doing.0=p;
   p=p+1
   end
  end
 end

call close(ph)

if openp=='main' then call reopenwindow()
return

freshlist:
call topipe('id 'lview' remn')
call topipe('id 'lview' list 0')
 do c=1 to msgs.lstat.0
 num=topipe('id 'lview' addn gt "'nocom(msgs.lstat.c.name)'¿'nocom(msgs.lstat.c.text)'"')
 msgs.lstat.c.node=num
 bn.num=c
 end
 call topipe('id 'lview' list 1')
 call topipe('id 'lview' s 0')
in2=lview ; in5=''
call gadget()
return

getf:
f=arg(1)
lp=max(lastpos(':',f),lastpos('/',f))
parse var f fp +lp fn ; fn=strip(fn)

if ~show('l','rexxreqtools.library') then call addlib('rexxreqtools.library',0,-30,0)

ret=rtfilerequest(fp,fn,arg(2))
return ret

gets: parse var in . . ret ; return(substr(ret,2))

nocom: ; nxt=arg(1) ;
p=1;
do while p~=0;
p=index(nxt,'*',p)
if P~=0 then do; nxt=insert('*',nxt,p-1);p=p+2; end;
end;
p=1;
do while p~=0;
p=index(nxt,'"',p);
if P~=0 then do; nxt=insert('*',nxt,p-1);p=p+2; end;
end;
return nxt

makelist: list='"'; do y=1 to listem.0; list=''list''listem.y'¿'; end; list=''strip(list,,'¿')'"'; call topipe('id 'lstg' cl 'list' s 'lstat-1' ref');  call dispud(); return
dispud:
pdis=(lstat==1); call topipe('id 'uppg' dis 'pdis'');
pdis=(lstat==listem.0); call topipe('id 'dnpg' dis 'pdis'');
pdis=(pdis&(lstat==1));
call topipe('id 'lstg' dis 'pdis'');
call topipe('id 'sortpg' dis 'pdis'');
call topipe('id 'delpg' dis 'pdis'');
return

gadget:
 select
 when in2==alertg then warnclip=in3
 when in2=nams then do; msgs.lstat.seld.name=gets(); call topipe('id 'cpat' gt "'nocom(msgs.lstat.seld.name)'¿'nocom(msgs.lstat.seld.text)'"'); end
 when in2=txts then do; msgs.lstat.seld.text=gets(); call topipe('id 'cpat' gt "'nocom(msgs.lstat.seld.name)'¿'nocom(msgs.lstat.seld.text)'"'); end
 when in2=addg then call addgad()
 when in2=delg then call delgad()
 when in2=upg then call movegad('U')
 when in2=dng then call movegad('D')
 when in2=pags then do; listem.lstat=gets(); call makelist(); end
 when in2=addpg then call addpage()
 when in2=delpg then call delpage()
 when in2=uppg then call movepage('U')
 when in2=dnpg then call movepage('D')
 when in2=lstg then do;
 lstat=in3+1;
  if hs then do
  call topipe('id 'pags' gt "'listem.lstat'" ref')
  call dispud()
  end
 call freshlist();
 end
 when in2==sortpg then do
  do c=1 to listem.0
   if c~=listem.0 then do
    do cc=c to listem.0
     if upper(listem.c)>upper(listem.cc) then do;
      select
      when cc==lstat then lstat=c
      when c==lstat then lstat=cc
      otherwise nop
      end
     call swapp()
     end
    end
   end
  end
 call makelist()
 /*call freshlist()*/
 end

 when in2==sortg then do
  do c=1 to msgs.lstat.0
   if c~=msgs.lstat.0 then do
    do cc=c to msgs.lstat.0
     if upper(msgs.lstat.c.name)>upper(msgs.lstat.cc.name) then; call swapm();
    end
   end
  end
 call freshlist()
 end

 when in2=lview then do
 if in5=="" then seld=0;
  if in5=="" then do;
   if hs then do
   call topipe('id 'nams' gt "" dis 1 ref');
   call topipe('id 'delg' dis 1');
   dis=(2>msgs.lstat.0); call topipe('id 'sortg' dis 'dis'')
   call topipe('id 'sortg' dis 'dis'');
   call topipe('id 'upg' dis 1');
   call topipe('id 'dng' dis 1');
   end
  call topipe('id 'txts' gt "" dis 1 ref');
  call topipe('id 'tmen' dis 1');
  return;
  end;

  else; nseld=bn.in5
  if nseld~=seld then; seld=nseld;
  cpat=in5
  nxt=msgs.lstat.seld.name;
  dis=(seld==0)
  call topipe('id 'txts' dis 'dis' gt "'nocom(msgs.lstat.seld.text)'" ref')
  call topipe('id 'tmen' dis 'dis'');
   if hs then do
   call topipe('id 'delg' dis 'dis' ref')
   call topipe('id 'nams' dis 'dis' gt "'nocom(msgs.lstat.seld.name)'" ref')
   dis=(seld=1); call topipe('id 'upg' dis 'dis' ref')
   dis=(seld=msgs.lstat.0); call topipe('id 'dng' dis 'dis' ref')
   dis=(2>msgs.lstat.0); call topipe('id 'sortg' dis 'dis'')
   end
   if in3==16 then do
   if open(hh,'awnpipe:/C','W')==0 then do; call req('Fatal ERROR',' ERROR OPENING CLIPBOARD *n try resetting ? ','_Doh ! :-\'); exit(205); end
   call newlines(msgs.lstat.seld.text)
    do c=1 to coms.0 ;
    if c==coms.0 then call writech(hh,coms.c)
    else; call writeln(hh,coms.c)
    end
   call close(hh)
   if warnclip~=0 then do
   call topipe('id 0 s 264 gt "Clipped 'nocom(msgs.lstat.seld.name)'"')
   call delay(warnclip)
   call topipe('id 0 s 520 gt "'hlp.0'"')
   end
  end
 end

 otherwise nop /*say in*/
 end
return

newlines:
p=0 ; txt=arg(1)
p=1

 do xx=1 while p>0
 p=index(upper(txt),'%N',1)
  if p~=0 then do
  coms.0=xx
  coms.xx=substr(txt,1,p-1)
  txt=substr(txt,p+2)
  end

  else do
  coms.0=xx
  coms.xx=txt
  p=-20
  end
 end
return

swapp:
       tmp=listem.c
       tmpc.0=msgs.c.0
  do y=1 to tmpc.0 ; tmpc.y.name=msgs.c.y.name; tmpc.y.text=msgs.c.y.text; end
       msgs.c.0=msgs.cc.0
  do y=1 to msgs.c.0 ; msgs.c.y.name=msgs.cc.y.name; msgs.c.y.text=msgs.cc.y.text; end
       msgs.cc.0=tmpc.0
  do y=1 to tmpc.0 ; msgs.cc.y.name=tmpc.y.name; msgs.cc.y.text=tmpc.y.text; end
      listem.c=listem.cc
      listem.cc=tmp
return

movepage: ;
if arg(1)='U' then cc=lstat-1; else; cc=lstat+1;
c=lstat
call swapp()
lstat=cc ; call makelist()
return

delpage: ;
 np=listem.0 ; np=np-1 ; listem.0=np
 do n=lstat to np
  plus=n+1
  listem.n=listem.plus
  msgs.n.0=msgs.plus.0;
  do y=1 to msgs.n.0; msgs.n.y.name=msgs.plus.y.name ; end
 end

lstat=min(lstat,listem.0)

call makelist()
call freshlist()
call topipe('id 'pags' gt "'listem.lstat'" ref')
return

makegui:
call open(pipe,"awnpipe:Clipper/xc")

call topipe('"T2C By Brucey" left 'wl' top 'wt' width 'ww' height 'wh' sk st "Clipper By Bruce Steers 'ver' 'verdate'" m h sc="¿" defg v ig it "Clipper.Zzz" ii "'progname'" a ps "'screen'"')
hsc=word('% &',hs+1)
call topipe('menu gt "Main¿@?About¿Help¿$!Help is displayed on the¿$!screen title bar when¿$!moving the mouse over¿$!any of the gadgets¿-¿@PLoad/Save Preferences¿-¿@S^'hsc'Show Edit Gadgets¿-¿@QQuit"')
tmen=topipe('menu gt "`  Append TextInput Style¿Colour 0¿Colour 1¿Colour 2¿Colour 3¿Colour 4¿Colour 5¿Colour 6¿Colour 7¿Colour 8¿Colour 9¿Colour 10¿Colour 11¿Colour 12¿Colour 13¿Colour 14¿Colour 15¿-¿Bold¿Underline¿Reverse¿Reset¿Beep"')

lview=topipe('listbrowser lbl "Name¿Text 2 Clipboard" v h a')

do yy=1 to msgs.lstat.0
num=topipe('browsernode gt "'nocom(msgs.lstat.yy.name)'¿'nocom(msgs.lstat.yy.text)'"')
msgs.lstat.yy.node=num
bn.num=yy
end

 call topipe('layout b 0 cj v weih 0')
  if (listem.0>1)|(hs==1) then do
  call topipe('layout b 0 si weih 0')
  dis=(listem.0<2)
  lstg=topipe('chooser pu cl 'list' s 'lstat-1' dis 'dis'') ;
  call topipe('le')
  end
 if hs==1 then do
 pags=topipe('string lj gt "'listem.lstat'"') ;
  call topipe('layout b 0 weiw 0 weih 0')
  addpg=topipe('button tc gt "A"')
  delpg=topipe('button tc gt "D"')
  sortpg=topipe('button tc gt "S"')
  pdis=(lstat==1)
  uppg=topipe('button tc ab 5 weiw 0 dis 'pdis'')
  pdis=(lstat==listem.0)
  dnpg=topipe('button tc ab 6 weiw 0 dis 'pdis'')
  call topipe('le')
 nams=topipe('string lj dis 1') ;
 end
 txts=topipe('string maxc 32767 lj dis 1')
  if hs==1 then do
  call topipe('layout cj b 0 weiw 0 weih 0')
  addg=topipe('button tc gt "A"')
  delg=topipe('button tc gt "D" dis 1')
  sortg=topipe('button tc gt "S"')
  upg=topipe('button tc ab 5 weiw 0 dis 1')
  dng=topipe('button tc ab 6 weiw 0 dis 1')
  call topipe('le')
  call topipe('layout b 0 weih 0')
  call topipe('space')
  call topipe('label gt "*nAlert "')
  alertg=topipe('integer weiw 0 a minn 0 maxn 200 minc 3 defn 'warnclip'')
  call topipe('space')
  call topipe('le')
  end

 call topipe('le')
call topipe('open')
openp='main'
if seld~=0 then call topipe('id 'lview' s 'msgs.lstat.seld.node'')
call makehelp()
return

reopenwindow: ; writeln(pipe,'id 0 read'); ln=readln(pipe) ; parse var ln wl wt ww wh . ;writeln(pipe,'close'); call readln(pipe) ; eofl=-3 ; return

topipe: ; parse arg out; call writeln(pipe,out); res=readln(pipe); parse var res res1 res2 .; if res1='ok' then return(res2);say 'error from: 'out; say '  responce: ' res; IF pipe~=0 THEN close(pipe); exit

req: PROCEDURE;
if openp=='main' then call topipe('id 0 s 256')
 parse arg bar,txt,g1,g2,g3,g4,g5,g6,g7,g8 .; if rf~=0 then call close(rf); call open(rf,'awnpipe:ClipperReq/xc'); call writeln(rf,'"'bar'" v it "Clipper" sw dg db a ps "'screen'"');
call writeln(rf,'space');; call writeln(rf,'layout b 5'); call writeln(rf,'space'); call writeln(rf,'label so weih 5 weiw 10 gt "*n*n'txt'"'); call writeln(rf,'space'); call writeln(rf,'le'); call writeln(rf,'layout b 0 si so');
if g1~="" then call writeln(rf,'button gt "'g1'" close');if g2~="" then call writeln(rf,'button gt "'g2'" close');if g3~="" then call writeln(rf,'button gt "'g3'" close'); if g4~="" then call writeln(rf,'button gt "'g4'" close');
if g5~="" then call writeln(rf,'button gt "'g5'" close');if g6~="" then call writeln(rf,'button gt "'g6'" close');if g7~="" then call writeln(rf,'button gt "'g7'" close');if g8~="" then call writeln(rf,'button gt "'g8'" close');
call writeln(rf,'le'); call writeln(rf,'open');call readln(rf); do while ~eof(rf); rn=readln(rf); parse var rn rn1 rn2 rn3 rn4 rn5 .; if rn1=='gadget' then do; if openp=='main' then call topipe('id 0 s 512');return(rn2-2); end; end;if openp=='main' then call topipe('id 0 s 512'); return(0)

delgad:
np=msgs.lstat.0
np=np-1
do n=seld to np
 if n~=np then do
 plus=n+1
 msgs.lstat.n.name=msgs.lstat.plus.name
 msgs.lstat.n.text=msgs.lstat.plus.text
 msgs.lstat.n.node=msgs.lstat.plus.node
 nn=msgs.lstat.n.node; m=bn.nn ; bn.nn=m-1
 end
end

call topipe('id 'cpat' remn')
in2=lview
msgs.lstat.0=np
seld=min(seld,msgs.lstat.0)
 if msgs.lstat.0~=0 then do
 in5=msgs.lstat.seld.node
 call topipe('id 'lview' s 'in5'')
 end
 else do;
 in5=''
 call topipe('id 'lview' s 0')
 end

call gadget()
return

swapm:
tn=msgs.lstat.cc.name
tt=msgs.lstat.cc.text
msgs.lstat.cc.name=msgs.lstat.c.name
msgs.lstat.cc.text=msgs.lstat.c.text
msgs.lstat.c.name=tn
msgs.lstat.c.text=tt
return

movegad: ;
if arg(1)='U' then cc=seld-1; else; cc=seld+1;
c=seld
call swapm()
in5=msgs.lstat.cc.node
call topipe('id 'lview' list 0')

call topipe('id 'in5' gt "'nocom(msgs.lstat.cc.name)'¿'nocom(msgs.lstat.cc.text)'"')
call topipe('id 'msgs.lstat.c.node' gt "'nocom(msgs.lstat.c.name)'¿'nocom(msgs.lstat.c.text)'"')

call topipe('id 'lview' list 1')
call topipe('id 'lview' s 'in5'')
seld=cc ; in2=lview
call gadget()
return

addgad:

next=1+msgs.lstat.0
msgs.lstat.0=next
msgs.lstat.next.name='NewName'
msgs.lstat.next.text='NewText'
in5=topipe('id 'lview' addn gt "NewName¿Newtext"')
msgs.lstat.next.node=in5
bn.in5=next
call topipe('id 'lview' s 'in5'')
seld=next
in2=lview
call gadget()
return

addpage:
lstat=1+listem.0; listem.0=lstat
listem.lstat='New'
list='"'Strip(list,,'"')'¿New"'
call topipe('id 'lstg' cl 'list' s 'lstat-1'')
in2=lstg ; in3=lstat-1
msgs.lstat.0=0
call gadget()
return

help:
call topipe('id 0 s 16 gt "'hlp.in2'"')
return

makehelp:
hlp.0='Clipper By Bruce Steers 'ver' 'verdate''
hlp.lview='Double Click Item to send to the clipboard'
hlp.txts='Change the text thats sent'
hlp.lstg='Change Current Page'
if hs then do
hlp.nams='Change the Name of this Text'
hlp.addg='Add a New Text to the list'
hlp.delg='Delete Selected Text from the list'
hlp.sortg='Sort all Texts in this list by name'
hlp.upg='Move Selected Text UP'
hlp.dng='Move Selected Text DOWN'
hlp.pags='Change the Name of this Page'
hlp.addpg='Add a New Page to the Chooser Gadget'
hlp.delpg='Delete Selected Page from the Chooser Gadget'
hlp.sortpg='Sort Page Names in the Chooser Gadget'
hlp.uppg='Move Page UP in the Chooser Gadget'
hlp.dnpg='Move Page DOWN in the Chooser Gadget'
hlp.alertg='Time in Ticks (50/second) Pointer is Busy when Sending Clip (0=none)'
end
return