unit GenDocUnit; var fname := ''; var fname1 := ''; var RootOutputDirectory := ''; procedure Step1; begin var q := ReadLines(fname).Where(s->s.Trim.Length>0); var l := new List; var skip := true; var ll := ReadLines(fname); if fname1<>'' then ll := ll + ReadLines(fname1); foreach var s in ll do begin if s.StartsWith('//{{{doc:') then begin skip := false; continue; end; if s.StartsWith('//{{{--doc:') then begin skip := true; end; if skip then continue; l.Add(s.Replace('&','')); end; WriteLines('__PABC.pas',l); end; procedure Step2; const fname = '__PABC.pas'; begin var l := new List; var skipNext := False; var skipUntilEnd := False; foreach var s in ReadLines(fname) do begin if '[Serializable]' in s then continue; if s.Trim.StartsWith('/// !! ')then continue; if s.Trim.StartsWith('// ') then continue; if s.Trim.StartsWith('//---')then continue; if s.Trim.StartsWith('///!#') then continue; if s.Trim.StartsWith('const ')then continue; if s.Trim.StartsWith('type ')then continue; if s.Trim.Length=0 then continue; if s.StartsWith('///--') or s.StartsWith('///!!-') then begin skipNext := True; continue; end; if skipNext then begin skipNext := false; continue; end; if s.StartsWith('begin') then begin skipUntilEnd := True; continue; end; if s.StartsWith('end') then begin skipUntilEnd := False; continue; end; if skipUntilEnd then begin continue; end; l.Add(s.Trim); end; WriteLines('__PABC1.pas',l); end; procedure Step3; const fname = '__PABC1.pas'; begin var l := new List; var Prev: string := ''; foreach var s in ReadLines(fname) do begin if Prev.StartsWith('/// ') and s.StartsWith('///') and not s.StartsWith('///-') then begin l[l.Count-1] := l[l.Count-1] + '' + s.Remove(0,3).Trim; end else l.Add(s); Prev := s; end; WriteLines('__PABC1-1.pas',l); end; procedure Step3_1(); // пропускать подряд идущие строки без /// или //>> в начале const fname = '__PABC1-1.pas'; begin var l := new List; var Prev: string := ''; foreach var s in ReadLines(fname) do begin if Prev.StartsWith('///') or Prev.StartsWith('//>>') or s.StartsWith('///') or s.StartsWith('//>>') then l.Add(s); Prev := s; end; WriteLines('__PABC2.pas',l); end; procedure Step4; const fname = '__PABC2.pas'; begin var l := new List; var p1 := ''; var p2 := ''; foreach var s in ReadLines(fname) do begin if s.StartsWith('///-') then begin p1 := s; continue; end; if (p1<>'') and (p2='') then begin p2 := s; continue; end; if (p1<>'') and (p2<>'') then begin l.Add(p2); l.Add(p1.Remove(0,4).Trim); p1 := ''; p2 := ''; continue; end; {var s1 := s; var ind := s.IndexOf(' = '); if ind>=0 then s1 := s.Substring(0,ind);} l.Add(s); end; WriteLines('__PABCdoc.pas',l); end; function Around(Self: string; s: string): string; extensionmethod; begin var opentag := '<'+s+'>'; var closetag := ''; Result := opentag + Self + closetag; end; function DeleteFirst(Self: string; s: string): string; extensionmethod; begin if Self.StartsWith(s) then Result := Self.Remove(0,s.Length) else Result := Self end; var toc := Seq(''); var hrefs := Seq(''); type FD = auto class fun,def: string; end; BFD = auto class basename: string; fds: List; end; var dictClasses := new Dictionary; procedure ConvertFunDef(var fun: string); begin fun := fun.Trim; if (fun.Length>0) and (fun.Last<>';') then fun += ';'; fun := Regex.Replace(fun,'extensionmethod[^;]*;',''); fun := Regex.Replace(fun,' read.*;',''); fun := Regex.Replace(fun,' write.*;',''); fun := Regex.Replace(fun,'\)\s*:=.*',')'); fun := fun.DeleteFirst('var '); fun := fun.Trim; // Попробуем убрать := реализация // Это первое := на внешнем уровне (вне скобок) var p := fun.IndexOf(':='); while p>=0 do begin if fun[:p].Count(c->c='(')=fun[:p].Count(c->c=')') then break; p := fun.IndexOf(':=',p+1); end; if p>=0 then fun := fun[:p]; if (fun.Length>0) and (fun.Last<>';') then fun += ';'; end; function CreateTableData(fds: List; Keywords: SortedSet): string; begin Result := ''; for var i:=0 to fds.Count-1 do begin //funcs[i] := Regex.Replace(funcs[i],'\(\ *Self[^;\)]*\)','()'); //funcs[i] := Regex.Replace(funcs[i],'\(\ *Self[^;]*;\ *','('); ConvertFunDef(fds[i].fun); var dd: string; try //if fds[i].def.Length >= 3 then dd := fds[i].def.Remove(0,3).Trim; //else dd := fds[i].def; except Println(fds[i-3].fun,'!!!',fds[i-3].def); Println(fds[i-2].fun,'!!!',fds[i-2].def); Println(fds[i-1].fun,'!!!',fds[i-1].def); Println(fds[i-0].fun,'!!!',fds[i-0].def); Println('i=',i); halt; end; var td := fds[i].fun.Around('code') .Replace('System.IComparable','IComparable') .Replace('function','function') .Replace('procedure','procedure') .Replace('constructor','constructor') .Replace('class','class') .Replace('property','property') .Replace(' read',' read') .Replace(' write',' write') .Replace('virtual','virtual') .Replace('sequence ','sequence ') .Replace('set ','set ') .Replace('array ','array ') .Replace('where ','where ') .Replace('file ',' file ') .Replace('of ',' of ') .Replace('var ','var ') .Replace('params ','params ') .Replace('const ','const ') .Replace('extensionmethod','extensionmethod') + NewLine + '
' + ' '*8 + dd; if keywords<>nil then // =nil если мы добавляем имена предка и в Keywords их не надо добавлять if not fds[i].fun.StartsWith('constructor') then begin var k := fds[i].fun.DeleteFirst('function ').DeleteFirst('procedure ').DeleteFirst('property '); k := k.MatchValue('\w+'); keywords += k; end; td := td.Around('td').Around('tr')+NewLine; Result += td; end; end; function CreateSectionInClassDef(title: string; fds: sequence of System.Linq.IGrouping; Keywords: SortedSet): string; begin Result := ''; if fds.Count=0 then exit; title := ''+title+''; title := ''+title+''; title := '' + title.Around('tr'); Result += title + NewLine; foreach var group in fds do Result += NewLine + CreateTableData(group.ToList,keywords).Around('tr'); end; procedure GenerateHTMLFile(HelpFileName,Title: string; lst: List); begin var keywords := new SortedSet; var s := ''; var lst1 := lst.Select(s->s.Replace('<','<').Replace('>','>')); var funcs := lst1.Slice(1,2).ToList; var defs := lst1.Slice(0,2).ToList; // Вырезать из funcs строку где встречается class, его имя и предка var classdef,classname,classbase: string; var ind := funcs.FindIndex(s ->s.Contains(' class') and not s.Trim.StartsWith('class')); if ind<>-1 then begin Println(funcs[ind]); var str := funcs[ind]; //try //if defs[ind].ToString.Length>=3 then classdef := defs[ind].ToString.Remove(0,3).Trim; //else classdef := defs[ind].ToString; {except //Println(defs[ind-0],'!!!'); Println('ind=',ind,defs.Count); halt; end; } funcs.RemoveAt(ind); defs.RemoveAt(ind); var ss := str.ToWords(' =()'); classname := ss[0]; if ss.Length>2 then classbase := ss[2]; var q := classbase.ToWords(','); if q.Count>0 then classbase := q[0]; classdef := classdef + '.'; if classbase<>'' then classdef += ' Базовый класс - '+ classbase.Around('code') + '.'; s += classdef; end; var names := funcs.Select(s->begin Result := ''; var ss := s.Split(' ','<','(','&',':'); if (ss[0]='class') then // class function Result := ss[2] else if (ss[0]='procedure') or (ss[0]='function') or (ss[0]='property') then Result := ss[1] else Result := ss[0]; end).ToList; var ttt := funcs.ZipTuple(defs,names).OrderBy(t->t[2]); funcs := ttt.Select(t->t[0]).ToList; defs := ttt.Select(t->t[1]).ToList; if funcs.Count<>defs.Count then begin Println(HelpFileName,Title); writeln('Разное количество'); halt; end; // Слить funcs defs в одну структуру FD var fds := funcs.Zip(defs,(f,d)->new FD(f,d)).ToList; var table := ''; if classname<>'' then begin // пополнение словарика классов. Чтобы потом добавлять свойства и методы предков dictClasses[classname] := new BFD(classbase,fds); Keywords += classname; // funcs надо отклассифицировать: конструкторы, свойства, методы, события // Каждую группу предварить заголовком var gr := fds.GroupBy(fd->fd.fun.ToWords[0].Trim); var cons := gr.Where(g->g.Key='constructor'); table += CreateSectionInClassDef('Конструкторы класса '+classname,cons,Keywords); var prop := gr.Where(g->g.Key='property'); table += CreateSectionInClassDef('Свойства класса '+classname,prop,Keywords); var pf := gr.Where(g->(g.Key='procedure') or (g.Key='function')); table += CreateSectionInClassDef('Методы класса '+classname,pf,Keywords); var cpf := gr.Where(g->(g.Key='class')); table += CreateSectionInClassDef('Статические методы класса '+classname,cpf,Keywords); while (classbase<>'') and dictClasses.ContainsKey(classbase) do begin gr := dictClasses[classbase].fds.GroupBy(fd->fd.fun.ToWords[0].Trim); // Добавить свойства предка prop := gr.Where(g->g.Key='property'); table += CreateSectionInClassDef('Свойства базового класса '+classbase,prop,nil); // Добавить методы предка pf := gr.Where(g->(g.Key='procedure') or (g.Key='function')); table += CreateSectionInClassDef('Методы базового класса '+classbase,pf,nil); classbase := dictClasses[classbase].basename; end; end else begin table := CreateTableData(fds.ToList,keywords); end; table := NewLine+'' + table + '
'+NewLine; s += table; //AddToTable(fds,table,keywords); var keys := keywords.Select(s->'').JoinIntoString(NewLine); keys := '' + NewLine +keys + ''+ NewLine ; keys += ''+NewLine; s := keys.Around('HEAD') + (Title.Around('H1') + s).Around('body'); //Println('..\'+RootOutputDirectory+'Files\'+HelpFileName+'.html'); WriteAllText('..\'+RootOutputDirectory+'Files\'+HelpFileName+'.html',s.Around('HTML')); var s1 := ''; var s2 := ''; toc := toc + '
  • ' + s1; toc := toc + s2; toc := toc + ''; hrefs := hrefs + ('
  • '+Title+'
  • '); end; procedure FinalStep; begin var lines := ReadLines('__PABCdoc.pas').ToArray; var lst := new List; var HelpFileName := ''; var Title := ''; var num := 0; for var i:=0 to lines.Count-1 do begin var s := lines[i]; if s.StartsWith('//>>') then begin num += 1; //if num=2 then break; if num>1 then GenerateHTMLFile(HelpFileName,Title,lst); lst.Clear; HelpFileName := s.Remove(0,4).Trim; var ss := HelpFileName.Split('#'); try HelpFileName := ss[1].Trim; except Print(ss[0]) end; Title := ss[0].Trim; continue; //Println(Title,HelpFileName); end; lst.Add(s); end; GenerateHTMLFile(HelpFileName,Title,lst); WriteLines('toc.html',toc); WriteLines('hrefs.html',hrefs); Println(num); end; begin end.