home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / wizards / Wzfoxdoc / main.prg < prev    next >
Encoding:
Text File  |  1998-05-01  |  11.0 KB  |  505 lines
  1. * THIS FILE SHOULD NOT BE LOCALIZED!!!
  2. #include wzfoxdoc.h
  3. para mmode
  4. clear
  5. set path to ..\wzcommon
  6. if !file("..\wzcommon\wzengine.fxp")
  7.     comp wzengine
  8. endif
  9.  
  10. if file("tr.prg")
  11.     do tr
  12.     retu
  13. endif
  14. IF FILE("try.prg")
  15.     opts=""
  16.     * -1 = Tab, 0 = nochange, >0 = # spaces
  17.     opts=opts+"INDENT0"
  18.     *1 All caps, 2 All small 3 mixed as in fdkeywrd 4 nochange
  19.     opts=opts+"KEYWORDCASE2"
  20.     *1 All caps, 2 All small 3 mixed as in fdxref   4 nochange
  21.     opts=opts+"USERCASE1"
  22.     do wzformt with "","","SNOQUALMIE::FLEW","try.prg",opts
  23.     IF !EMPTY(DBF())
  24.         LOCA
  25.     ENDIF
  26.     modi comm out\try nowait
  27. ELSE
  28.     do wzformt with "","","SNOQUALMIE::FLEW","",""
  29. ENDIF
  30.  
  31.  
  32. return
  33.  
  34. public m.symbol
  35. if type("mmode")#'L'
  36.     if !used("fdxref")
  37.         use fdxref
  38.     else
  39.         select fdxref
  40.     endif
  41.     brow last nowai
  42.     scan rest
  43.         do tex in main with "G"
  44.         wait wind  allt(symbol)+' '+str(lineno,5)
  45.     endscan
  46.     
  47.     retu
  48. endif
  49. ?"a"
  50. clear
  51. set head off
  52. set talk off
  53. set safe off
  54. close data
  55. clear
  56. public m.symbol,m.lineno,m.filename,m.mode,m.file,m.totallines
  57. public classname,baseclass
  58. public mydebug
  59. public mglob
  60. mydebug=0
  61.  
  62. rele wind outfile.prg
  63. rele wind view
  64. rele wind t.prg
  65. if set("dire")="C:\DEV"
  66.     DIMENSION mf[19]
  67.     mf[1]="t.prg"
  68.     mf[2]="genscrn.prg"
  69.     mf[3]="t.scx"
  70.     mf[4]="d:\dw\com\slist.prg"
  71.     mf[5]="f:\qw\wz_bquer.prg"
  72.     mf[6]="f:\qw\wz_bquer.pjx"
  73.     mf[7]="d:\dw\qw\action.prg"
  74.     mf[8]="j:\tro\tro.pjx"
  75.     mf[9]="d:\dw\cmls\main.pjx"
  76.     mf[10]="d:\dw\ff\programs\ffisdupe.prg"
  77.     mf[11]="d:\dw\cmls\licn.prg"
  78.     mf[12]="j:\fox30\samples\orders\orders.prg"
  79.     mf[13]="d:\d\acct\main.prg"
  80.     mf[14]="d:\dw\ff\foxfire.pjx"
  81.     mf[15]="d:\d\atlas\main.pjx"
  82.     mf[16]="tiny.prg"
  83.     mf[17]=_genscrn
  84.     mf[18]=_Transport
  85.     mf[19]="j:\fox30\convert\tazform.prg"
  86.     define popup pp from 10,10
  87.     FOR i=1 TO ALEN(mf)
  88.         define bar i of  pp prompt mf[i]
  89.     ENDFOR
  90.     on selection popup pp deact popup pp
  91.     acti popup pp
  92.     mfile=prompt()
  93.     mout="c:\dev\out"
  94.     if mfile="t.prg"
  95.         _Cliptext="modi comm "+mout+"\t.prg"
  96.     endif
  97.  
  98. ELSE
  99.     mfile=getfile("prg;pjx","Pjx or Prg")
  100.     mout="out"
  101.     mout=getdir("","Output DIR:")
  102. ENDIF
  103.  
  104. if empty(mfile)
  105.     return
  106. endif
  107.  
  108.  
  109. erase outfile.prg
  110. #define MAXPATH 50
  111. SET LIBR TO
  112. FPOutFile=0    &&set by FLL
  113. UserCaseMode   =2  && 0 upper, 1 lower, 2 unchanged, 3 as first occur
  114. KeyWordCaseMode=2  && 0 upper, 1 lower, 2 unchanged, 3 as in fdkeywrd 
  115. OutputMode=0  && 0 to a single dir named outdir
  116.               && 1 to multiple dirs called outdir which are subdirs of orig PJX dirs              
  117.               && 2 to replace input. Input moved to outdir
  118.               && 3 to a single root dir, with same dir structure
  119. LookupInOutput=1    && for dynamic searches in input(0) or output(1)
  120. SingleFile=0    && Suck in referenced files?
  121. CREATE TABLE fdxref (;
  122.     Symbol c(65),;
  123.     ProcName c(40),;
  124.     Flag c(1),;
  125.     lineno n(5),;
  126.     adjust n(5),;
  127.     Filename c(MAXPATH);
  128.     )
  129. INDEX ON flag TAG flag && for rushmore
  130. index on UPPER(symbol)+flag tag symbol
  131. SCATTER MEMVAR BLANK
  132. CREATE TABLE files (;
  133.     FileType c(1),;
  134.     Flags c(1),;
  135.     File c(MAXPATH),;
  136.     Done c(1);
  137.     )
  138. SCATTER MEMVAR BLANK
  139. USE fdkeywrd order 1 SHARED in 0
  140.  
  141. do setlibr
  142. ?"foxdocver=",foxdocver()
  143. ?sys(1016)
  144. ?
  145. set udfparms to value
  146. starttime= seconds ()
  147. #if .f.
  148.     =beautify("d:\dw\qw\action.prg","out\outfile.prg","")
  149.     modi comm out\outfile nowait
  150.     return
  151. #endif
  152.  
  153. *3rd parm is 0 for 1 pass, 1 for 2 passes
  154. mdele=set("dele")
  155. set dele on
  156. =fdfoxdoc(mfile,mout,"1","")
  157. set dele &mdele
  158. set libr to
  159. SELECT files
  160. SET FILTER TO
  161. LOCATE
  162. BROW LAST NOWAIT
  163. SELECT fdxref
  164. set order to
  165. loca
  166. BROW LAST NOWAIT
  167.  
  168. SET TALK ON
  169. set
  170. do setview
  171. set esca off
  172. wait wind  'Total lines processed='+str(totallines,8)+chr(13)+;
  173.   'Seconds='+str(seconds()-StartTime,8)+'  Avg='+str(Totallines/(seconds()-Starttime),8,2)
  174. set esca on
  175. return
  176.  
  177. PROC IsProj
  178.     SELECT *,IIF(mainprog,'0','1')+PADR(filename,100) AS ord;
  179.       FROM foxdocpjx1 ORDER BY ord INTO CURSOR foxdocpjx 
  180.     SCAN FOR !DELETED() AND type$"SPRMxs"
  181.         INSERT INTO files (file,filetype,flags) VALUES ;
  182.             (UPPER(STRTRAN(foxdocpjx.name,CHR(0),"")),;
  183.                 IIF(foxdocpjx.type='M','m',foxdocpjx.type),;
  184.             IIF(foxdocpjx.mainprog,"0","1"))
  185.         *MPR is 'M', MNX is 'm'
  186.         if foxdocpjx.type='M'
  187.             INSERT INTO files (file,filetype,flags) VALUES ;
  188.                 (UPPER(STRTRAN(foxdocpjx.outfile,CHR(0),"")),;
  189.                 foxdocpjx.type,;
  190.                 "0");
  191.             
  192.         endif
  193.     ENDSCAN
  194.     USE
  195.     USE IN foxdocpjx1
  196.     SELECT files
  197. RETURN
  198.  
  199. PROC ScanRef
  200. *Pass1: will scan symtab & suck in referenced files 
  201.     priv mfilt
  202.     SET ESCAPE OFF
  203.     loca
  204.     if !EOF()
  205.         return
  206.     endif
  207.     *First, find all function calls: type 'F'
  208.     SELECT DISTINCT symbol ;
  209.         FROM fdxref ;
  210.         WHERE flag='F';
  211.         INTO CURSOR t1
  212.     *of those, find the ones that don't have a Def
  213.     SELECT t1.symbol ;
  214.         FROM t1 ;
  215.         WHERE t1.symbol NOT IN ;
  216.         (SELECT symbol FROM fdxref WHERE flag='D');
  217.         INTO CURSOR t2
  218.     SELECT files
  219.     mfilt=set("filt")
  220.     SET FILTER TO
  221.     SELECT t2
  222.     *add the results into the files table if not there already
  223.     SCAN
  224.         m.file=ALLTRIM(t2.symbol)+".PRG"
  225.         IF EMPTY(LOOKUP(files.file,m.file,files.file))
  226.             INSERT INTO files (filetype,flags,file,done) VALUES ;
  227.                 ('P',"",m.file,"")
  228.             ?"Adding ",LEFT(files.file,15)
  229.         ENDIF
  230.     ENDSCAN
  231.     USE IN t1
  232.     USE IN t2
  233.     SELECT files
  234.     SET ORDER TO
  235.     SET FILTER TO &mfilt
  236.     LOCATE
  237.     SET ESCAPE ON
  238. RETURN
  239.  
  240.  
  241. PROC Setview
  242.     on key label ctrl+d do tex in main with "D"
  243.     on key label ctrl+r do tex in main with "R"
  244.     on key label ctrl+n do tex in main with "N"
  245.     on key label ctrl+b do tex in main with "B"
  246.     on key label ctrl+g do tex in main with "G"
  247.     on key label f7 do tex in main with "T"
  248.  
  249.     m.symbol=""
  250.     RETURN
  251.  
  252. PROC tex
  253.     para mm && Definition Reference Next Back Goto
  254.     publ mwinname,mwinpos,seekmode,m.symbol
  255.     SELECT fdxref
  256.     set order to symbol
  257.     seekmode=m.mm
  258.     do setlibr
  259.     if m.seekmode='G'
  260.         IF EMPTY(filename)
  261.             RETURN
  262.         ENDIF
  263.         IF RIGHT(UPPER(ALLTRIM(filename)),4)$".VCX.SCX"
  264.             IF USED("snipfile")
  265.                 USE IN snipfile
  266.             ENDIF
  267.             USE (fdxref.filename) AGAIN IN 0 ALIAS snipfile
  268.             GO (fdxref.sniprecno) IN snipfile
  269.             IF !EMPTY(fdxref.snipfld)
  270.                 MODI MEMO (fdxref.snipfld) nowait noedit
  271.                 =Gotorec()
  272.             ENDIF
  273.         ELSE
  274.             modi comm (filename) nowait noedit
  275.             =Gotorec()
  276.         ENDIF
  277.         SET LIBR TO
  278.         return
  279.     endif
  280.     IF type("fdstack[1]")='U'
  281.         PUBLIC fdstack[1,1],FDSP
  282.         fdsp=0
  283.     ENDIF
  284.     IF m.seekmode='B'
  285.         IF m.fdsp>0
  286.             mwinname=fdstack[fdsp,1]
  287.             mwinpos=fdstack[fdsp,2]
  288.             =CurPos("S")
  289.             fdsp=m.fdsp-1
  290.             IF m.fdsp>0
  291.                 DIMENSION fdstack[fdsp,2]
  292.             ENDIF
  293.             WAIT WINDOW NOWAIT " SP="+str(fdsp,2)
  294.         ELSE
  295.             WAIT WINDOW NOWAIT "Top"
  296.         ENDIF
  297.         set libr to
  298.         RETURN
  299.     ENDIF
  300.     IF m.seekmode$"DR"
  301.         IF TYPE("_screen.activeform.caption")#'C'
  302.             =CurPos("G")
  303.         ELSE
  304.             =MessageBox("Activate an edit window first",16)
  305.             RETURN
  306.         ENDIF
  307.     ENDIF
  308.     if m.seekmode$"DR"
  309.         =examine(seekmode)    &&see what's under cursor
  310.     endif
  311.     do exam    &&get cursor word into m.symbol
  312.     set libr to
  313. RETURN
  314.  
  315. PROC exam
  316.     *called by examine()... m.symbol ="" if not found
  317.     PRIVATE str
  318.     SELECT fdxref
  319.     if m.seekmode='T'
  320.         set orde to
  321.         skip
  322.         IF eof()
  323.             GO BOTT
  324.         ENDIF
  325.     else
  326.         if empty(set("order"))
  327.             SET ORDER TO symbol
  328.         ENDIF
  329.         str=PADR(UPPER(m.symbol),LEN(symbol))
  330.         IF m.seekmode$"DR"
  331.             SEEK str+m.seekmode
  332.             IF m.seekmode='D' AND !FOUND()
  333.                 SEEK str+'V'
  334.             ENDIF
  335.             IF m.seekmode='R' AND !FOUND()
  336.                 SEEK str
  337.             ENDIF
  338.         ELSE
  339.             IF !EOF()
  340.                 SKIP
  341.             ENDIF
  342.         ENDIF
  343.     ENDIF
  344.     IF m.seekmode#'T' and (EMPTY(m.symbol) OR UPPER(symbol)#UPPER(m.symbol) OR EOF())
  345.         WAIT WINDOW NOWAIT m.seekmode+' '+m.symbol+" not found"
  346.         m.symbol=""
  347.     ELSE
  348.         IF RIGHT(UPPER(ALLTRIM(filename)),4)$".VCX.SCX"
  349.             IF USED("snipfile")
  350.                 USE IN snipfile
  351.             ENDIF
  352.             USE (fdxref.filename) AGAIN IN 0 ALIAS snipfile
  353.             GO (fdxref.sniprecno) IN snipfile
  354.             IF !EMPTY(fdxref.snipfld)
  355.                 MODI MEMO (fdxref.snipfld) nowait noedit
  356.             ENDIF
  357.         ELSE
  358.             modi comm (filename) nowait noedit
  359.         ENDIF
  360.  
  361.         IF RIGHT(TRIM(filename),3)$"PRG MPR SPR"
  362.             SCATTER MEMVAR
  363.             m.lineno=INT(m.lineno)
  364.             if m.seekmode$"DR"
  365.                 fdsp=m.fdsp+1
  366.                 DIMENSION fdstack[fdsp,2]
  367.                 fdstack[fdsp,1]=mwinname
  368.                 fdstack[fdsp,2]=mwinpos
  369.             ENDIF
  370.         ELSE
  371.             m.symbol=""
  372.         ENDIF
  373.         =Gotorec()
  374.         WAIT WINDOW NOWAIT ALLTRIM(m.symbol)+" "+flag+" found in "+ALLTRIM(fdxref.Filename)+' '+STR(lineno,5)+" SP="+str(fdsp,2)
  375.     ENDIF
  376. RETURN
  377.  
  378. proc chkstat
  379.     ?recno("files")
  380. RETURN
  381.  
  382. proc setlibr
  383.     set libr to (IIF(file("fd3fll\fd3.fll"),;
  384.             "fd3fll\fd3.fll",;
  385.             sys(2004)+"wizards\fd3.fll"))
  386. return
  387.  
  388. proc fileins
  389.     priv mrecno
  390.     mrecno=recno("files")
  391.     insert into files from memvar
  392.     go mrecno in files
  393.     
  394. proc HeaderProc
  395.     *Pass2: add a header for each proc
  396.     priv mc
  397.     =fputs(fpoutfile,"*!"+repl('*',78))
  398.     =fputs(fpoutfile,"*!")
  399.     =fputs(fpoutfile,"*! Procedure "+alltrim(m.symbol))
  400.     m.adjust=3
  401.     m.symbol=m.symbol+' '    &&for exact match
  402.     *find procs called by this proc
  403.     select dist procname from fdxref;
  404.         where upper(symbol)+flag=m.symbol+'F';
  405.         order by 1;
  406.         into cursor fdxref3
  407.     if _tally>0
  408.         =fputs(fpoutfile,"*!")
  409.         =fputs(fpoutfile,"*!   Called by   ")
  410.         m.adjust=m.adjust+2
  411.         scan
  412.             =fputs(fpoutfile,"*!              "+alltrim(procname))
  413.             mc=procname
  414.             m.adjust=m.adjust+1
  415.         endscan
  416.     endif
  417.  
  418.     *position to right recno in fdxref for adj
  419.     select fdxref
  420.     seek m.symbol
  421.     loca while upper(symbol)=m.symbol for filename=m.filename and lineno=m.lineno 
  422.     if !found()
  423.         wait wind "can't find proc rec"
  424.     endif
  425.     
  426.     select distinct symbol from fdxref;
  427.         where flag='F' and procname=m.procname;
  428.         order by 1;
  429.         into curs fdxref3
  430.     if _tally>0
  431.         =fputs(fpoutfile,"*!")
  432.         =fputs(fpoutfile,"*!  Calls")
  433.         m.adjust=m.adjust+2
  434.         scan
  435.             =fputs(fpoutfile,"*!      "+alltrim(symbol))
  436.             m.adjust=m.adjust+1
  437.             mc=symbol
  438.         endscan
  439.     endif
  440.     use in fdxref3
  441.  
  442.     =fputs(fpoutfile,"*!")
  443.     =fputs(fpoutfile,"*!"+repl('*',78))
  444.     m.adjust=m.adjust+2
  445.     sele fdxref    && so not at eof
  446.     repl fdxref.adjust with fdxref.adjust+m.adjust
  447.     select fdkeywrd
  448. retu
  449.  
  450. proc HeaderFile
  451.     =fputs(fpoutfile,"*:"+repl('*',78))
  452.     =fputs(fpoutfile,"*:")
  453.     =fputs(fpoutfile,"*: Procedure File "+Alltrim(m.filename))
  454.     =fputs(fpoutfile,"*:")
  455.     =fputs(fpoutfile,"*: Documented           FoxDoc version 1")    
  456.     =fputs(fpoutfile,"*:"+repl('*',78))
  457.     adjust=6
  458.     if Seek(m.filename,"xreffile")
  459.         select xreffile
  460.         GO RECNO("xreffile") IN fdxref
  461.         scan whil filename=m.filename for flag='D'
  462.             =fputs(fpoutfile,"*:   "+trim(symbol))
  463.             m.adjust=m.adjust+1
  464.         endscan
  465.     endif
  466.     selec fdxref
  467.     repl fdxref.adjust with m.adjust
  468. return
  469.  
  470. proc HeaderClass
  471.     =fputs(fpoutfile,"*:"+repl('*',78))
  472.     =fputs(fpoutfile,"*:")
  473.     =fputs(fpoutfile,"*: Class: "+Alltrim(classname)+"  BaseClass: "+BaseClass)
  474.     =fputs(fpoutfile,"*:")
  475.     =fputs(fpoutfile,"*:"+repl('*',78))
  476.     adjust=5
  477.     select fdxref
  478.     =seek(padr(upper(classname),len(symbol))+'C')
  479.     repl adjust with m.adjust
  480.     sele fdkeywrd
  481. return
  482.  
  483. proc adjust
  484.     priv mc
  485.     set step on
  486.     rele wind trace
  487.     select fdxref
  488.     set orde to
  489.     loca
  490.     do while !eof()
  491.         mc=filename
  492.         m.adjust=0
  493.         scan while mc=filename
  494.             m.adjust=m.adjust+adjust
  495.             repl lineno with lineno+m.adjust
  496.         endscan
  497.     enddo
  498.     
  499. proc debugdisp
  500.     set esca off
  501.     set esca on
  502.     if recc("fdxref")=174 and mglob=.f.
  503.         wait wind  "aa"
  504.     endif
  505.