* synchronized with trunk

git-svn-id: branches/wasm@48185 -

.gitattributes

@@ -19425,6 +19425,7 @@ utils/fpdoc/fpdocclasstree.pp svneol=native#text/plain
 utils/fpdoc/fpdocproj.pas svneol=native#text/plain
 utils/fpdoc/fpdocstripper.lpi svneol=native#text/plain
 utils/fpdoc/fpdocstripper.pp svneol=native#text/plain
+utils/fpdoc/fpdocstrs.pp svneol=native#text/plain
 utils/fpdoc/fpdocxmlopts.pas svneol=native#text/plain
 utils/fpdoc/fpmake.pp svneol=native#text/plain
 utils/fpdoc/images/minus.png -text svneol=unset#image/png

compiler/armgen/aoptarm.pas

@@ -902,8 +902,8 @@ Implementation
         { reg1 might not be modified inbetween }
         not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
         begin
-          DebugMsg('Peephole SxtbAndImm2Sxtb done', p);
-          taicpu(hp1).opcode:=A_SXTB;
+          DebugMsg('Peephole SxtbAndImm2Uxtb done', p);
+          taicpu(hp1).opcode:=A_UXTB;
           taicpu(hp1).ops:=2;
           taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
           GetNextInstruction(p,hp2);
@@ -913,7 +913,7 @@ Implementation
           result:=true;
         end
       else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-           RemoveSuperfluousMove(p, hp1, 'SxtbMov2Data') then
+           RemoveSuperfluousMove(p, hp1, 'UxtbMov2Data') then
         Result:=true;
     end;
 
@@ -983,7 +983,7 @@ Implementation
         and reg3,reg2,#65535
         dealloc reg2
         to
-        sxth reg3,reg1
+        uxth reg3,reg1
       }
       else if MatchInstruction(p, A_SXTH, [C_None], [PF_None]) and
         (taicpu(p).ops=2) and
@@ -997,8 +997,8 @@ Implementation
         { reg1 might not be modified inbetween }
         not(RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) then
         begin
-          DebugMsg('Peephole SxthAndImm2Sxth done', p);
-          taicpu(hp1).opcode:=A_SXTH;
+          DebugMsg('Peephole SxthAndImm2Uxth done', p);
+          taicpu(hp1).opcode:=A_UXTH;
           taicpu(hp1).ops:=2;
           taicpu(hp1).loadReg(1,taicpu(p).oper[1]^.reg);
           GetNextInstruction(p, hp1);
@@ -1008,7 +1008,7 @@ Implementation
           result:=true;
         end
       else if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-           RemoveSuperfluousMove(p, hp1, 'SxthMov2Data') then
+           RemoveSuperfluousMove(p, hp1, 'UxthMov2Data') then
         Result:=true;
     end;
 

compiler/nflw.pas

@@ -2722,6 +2722,13 @@ implementation
            result:=right;
            right:=nil;
          end;
+       { if the finally block contains no code, we can kill
+         it and just return the try part }
+       if has_no_code(right) and not(assigned(third)) and not(implicitframe) then
+         begin
+           result:=left;
+           left:=nil;
+         end;
      end;
 
 

compiler/x86/aoptx86.pas

@@ -5693,93 +5693,91 @@ unit aoptx86;
         symbol: TAsmSymbol;
         reg: tsuperregister;
         regavailable: Boolean;
-        tmpreg: TRegister;
+        increg, tmpreg: TRegister;
       begin
         result:=false;
-        symbol:=nil;
-        if GetNextInstruction(p,hp1) then
+        if GetNextInstruction(p,hp1) and (hp1.typ=ait_instruction) then
           begin
             symbol := TAsmLabel(taicpu(p).oper[0]^.ref^.symbol);
 
-            if (hp1.typ=ait_instruction) and
-               GetNextInstruction(hp1,hp2) and
-               ((hp2.typ=ait_label) or
-                 { trick to skip align }
+            if GetNextInstruction(hp1,hp2) and
+              (
+                (hp2.typ=ait_label) or
+                { trick to skip align }
                 ((hp2.typ=ait_align) and GetNextInstruction(hp2,hp2) and (hp2.typ=ait_label))
-               ) and
-               (Tasmlabel(symbol) = Tai_label(hp2).labsym) then
-                 { jb @@1                            cmc
-                   inc/dec operand           -->     adc/sbb operand,0
-                   @@1:
+              ) and
+              (Tasmlabel(symbol) = Tai_label(hp2).labsym) and
+              (
+                (
+                  ((Taicpu(hp1).opcode=A_ADD) or (Taicpu(hp1).opcode=A_SUB)) and
+                  MatchOptype(Taicpu(hp1),top_const,top_reg) and
+                  (Taicpu(hp1).oper[0]^.val=1)
+                ) or
+                ((Taicpu(hp1).opcode=A_INC) or (Taicpu(hp1).opcode=A_DEC))
+              ) then
+             { jb @@1                            cmc
+               inc/dec operand           -->     adc/sbb operand,0
+               @@1:
 
-                   ... and ...
+               ... and ...
 
-                   jnb @@1
-                   inc/dec operand           -->     adc/sbb operand,0
-                   @@1: }
+               jnb @@1
+               inc/dec operand           -->     adc/sbb operand,0
+               @@1: }
               begin
-                carryadd_opcode:=A_NONE;
                 if Taicpu(p).condition in [C_NAE,C_B,C_C] then
                   begin
-                    if (Taicpu(hp1).opcode=A_INC) or
-                      ((Taicpu(hp1).opcode=A_ADD) and
-                       MatchOptype(Taicpu(hp1),top_const,top_reg) and
-                       (Taicpu(hp1).oper[0]^.val=1)
-                      ) then
-                      carryadd_opcode:=A_ADC;
-                    if (Taicpu(hp1).opcode=A_DEC) or
-                      ((Taicpu(hp1).opcode=A_SUB) and
-                       MatchOptype(Taicpu(hp1),top_const,top_reg) and
-                       (Taicpu(hp1).oper[0]^.val=1)
-                      ) then
-                      carryadd_opcode:=A_SBB;
-                    if carryadd_opcode<>A_NONE then
-                      begin
-                        Taicpu(p).clearop(0);
-                        Taicpu(p).ops:=0;
-                        Taicpu(p).is_jmp:=false;
-                        Taicpu(p).opcode:=A_CMC;
-                        Taicpu(p).condition:=C_NONE;
-                        DebugMsg(SPeepholeOptimization+'JccAdd/Inc/Dec2CmcAdc/Sbb',p);
-                        Taicpu(hp1).ops:=2;
-                        if (Taicpu(hp1).opcode=A_ADD) or (Taicpu(hp1).opcode=A_SUB) then
-                          Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[1]^)
-                        else
-                          Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^);
-                        Taicpu(hp1).loadconst(0,0);
-                        Taicpu(hp1).opcode:=carryadd_opcode;
-                        result:=true;
-                        exit;
-                      end;
+                    case taicpu(hp1).opcode of
+                      A_INC,
+                      A_ADD:
+                        carryadd_opcode:=A_ADC;
+                      A_DEC,
+                      A_SUB:
+                        carryadd_opcode:=A_SBB;
+                      else
+                        InternalError(2021011001);
+                    end;
+
+                    Taicpu(p).clearop(0);
+                    Taicpu(p).ops:=0;
+                    Taicpu(p).is_jmp:=false;
+                    Taicpu(p).opcode:=A_CMC;
+                    Taicpu(p).condition:=C_NONE;
+                    DebugMsg(SPeepholeOptimization+'JccAdd/Inc/Dec2CmcAdc/Sbb',p);
+                    Taicpu(hp1).ops:=2;
+                    if (Taicpu(hp1).opcode=A_ADD) or (Taicpu(hp1).opcode=A_SUB) then
+                      Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[1]^)
+                    else
+                      Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^);
+                    Taicpu(hp1).loadconst(0,0);
+                    Taicpu(hp1).opcode:=carryadd_opcode;
+                    result:=true;
+                    exit;
                   end
                 else if Taicpu(p).condition in [C_AE,C_NB,C_NC] then
                   begin
-                    if (Taicpu(hp1).opcode=A_INC) or
-                      ((Taicpu(hp1).opcode=A_ADD) and
-                       MatchOptype(Taicpu(hp1),top_const,top_reg) and
-                       (Taicpu(hp1).oper[0]^.val=1)
-                      ) then
-                      carryadd_opcode:=A_ADC;
-                    if (Taicpu(hp1).opcode=A_DEC) or
-                      ((Taicpu(hp1).opcode=A_SUB) and
-                       MatchOptype(Taicpu(hp1),top_const,top_reg) and
-                       (Taicpu(hp1).oper[0]^.val=1)
-                      ) then
-                      carryadd_opcode:=A_SBB;
-                    if carryadd_opcode<>A_NONE then
-                      begin
-                        Taicpu(hp1).ops:=2;
-                        DebugMsg(SPeepholeOptimization+'JccAdd/Inc/Dec2Adc/Sbb',p);
-                        if (Taicpu(hp1).opcode=A_ADD) or (Taicpu(hp1).opcode=A_SUB) then
-                          Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[1]^)
-                        else
-                          Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^);
-                        Taicpu(hp1).loadconst(0,0);
-                        Taicpu(hp1).opcode:=carryadd_opcode;
-                        RemoveCurrentP(p, hp1);
-                        result:=true;
-                        exit;
-                      end;
+                    case taicpu(hp1).opcode of
+                      A_INC,
+                      A_ADD:
+                        carryadd_opcode:=A_ADC;
+                      A_DEC,
+                      A_SUB:
+                        carryadd_opcode:=A_SBB;
+                      else
+                        InternalError(2021011002);
+                    end;
+
+                    Taicpu(hp1).ops:=2;
+                    DebugMsg(SPeepholeOptimization+'JccAdd/Inc/Dec2Adc/Sbb',p);
+                    if (Taicpu(hp1).opcode=A_ADD) or (Taicpu(hp1).opcode=A_SUB) then
+                      Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[1]^)
+                    else
+                      Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^);
+                    Taicpu(hp1).loadconst(0,0);
+                    Taicpu(hp1).opcode:=carryadd_opcode;
+                    RemoveCurrentP(p, hp1);
+                    result:=true;
+                    exit;
                   end
                  {
                    jcc @@1                            setcc tmpreg
@@ -5789,312 +5787,323 @@ unit aoptx86;
                    While this increases code size slightly, it makes the code much faster if the
                    jump is unpredictable
                  }
-                else if not(cs_opt_size in current_settings.optimizerswitches) and
-                  ((((Taicpu(hp1).opcode=A_ADD) or (Taicpu(hp1).opcode=A_SUB)) and
-                    (Taicpu(hp1).oper[0]^.typ=top_const) and
-                    (Taicpu(hp1).oper[1]^.typ=top_reg) and
-                    (Taicpu(hp1).oper[0]^.val=1)) or
-                   ((Taicpu(hp1).opcode=A_INC) or (Taicpu(hp1).opcode=A_DEC))
-                  ) then
-                  begin
-                    { search for an available register which is volatile }
-                    regavailable:=false;
-                    for reg in tcpuregisterset do
-                      begin
-                        tmpreg:=newreg(R_INTREGISTER,reg,R_SUBL);
-                        if (reg in paramanager.get_volatile_registers_int(current_procinfo.procdef.proccalloption)) and
-                          not(reg in UsedRegs[R_INTREGISTER].GetUsedRegs) and
-                          not(RegInInstruction(tmpreg,hp1))
-{$ifdef i386}
-                          { use only registers which can be accessed byte wise }
-                          and (reg in [RS_EAX,RS_EBX,RS_ECX,RS_EDX])
-{$endif i386}
-                          then
-                          begin
-                            regavailable:=true;
-                            break;
-                          end;
-                      end;
-
-                    if regavailable then
-                      begin
-                        TAsmLabel(symbol).decrefs;
-                        Taicpu(p).clearop(0);
-                        Taicpu(p).ops:=1;
-                        Taicpu(p).is_jmp:=false;
-                        Taicpu(p).opcode:=A_SETcc;
-                        DebugMsg(SPeepholeOptimization+'JccAdd2SetccAdd',p);
-                        Taicpu(p).condition:=inverse_cond(Taicpu(p).condition);
-                        Taicpu(p).loadreg(0,tmpreg);
-
-                        if getsubreg(Taicpu(hp1).oper[1]^.reg)<>R_SUBL then
-                          begin
-                            case getsubreg(Taicpu(hp1).oper[1]^.reg) of
-                              R_SUBW:
-                                hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BW,tmpreg,
-                                  newreg(R_INTREGISTER,reg,R_SUBW));
-                              R_SUBD,
-                              R_SUBQ:
-                                hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BL,tmpreg,
-                                  newreg(R_INTREGISTER,reg,R_SUBD));
-                              else
-                                Internalerror(2020030601);
-                            end;
-                            taicpu(hp2).fileinfo:=taicpu(hp1).fileinfo;
-                            asml.InsertAfter(hp2,p);
-                          end;
-                        if (Taicpu(hp1).opcode=A_INC) or (Taicpu(hp1).opcode=A_DEC) then
-                          begin
-                            Taicpu(hp1).ops:=2;
-                            Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^)
-                          end;
-                        Taicpu(hp1).loadreg(0,newreg(R_INTREGISTER,reg,getsubreg(Taicpu(hp1).oper[1]^.reg)));
-                        AllocRegBetween(newreg(R_INTREGISTER,reg,getsubreg(Taicpu(hp1).oper[1]^.reg)),p,hp1,UsedRegs);
-                      end;
-                  end;
-              end;
+                 else if not(cs_opt_size in current_settings.optimizerswitches) then
+                   begin
+                     { search for an available register which is volatile }
+                     for reg in tcpuregisterset do
+                       begin
+                         if
+ {$if defined(i386) or defined(i8086)}
+                           { Only use registers whose lowest 8-bits can Be accessed }
+                           (reg in [RS_EAX,RS_EBX,RS_ECX,RS_EDX]) and
+ {$endif i386 or i8086}
+                           (reg in paramanager.get_volatile_registers_int(current_procinfo.procdef.proccalloption)) and
+                           not(reg in UsedRegs[R_INTREGISTER].GetUsedRegs)
+                           { We don't need to check if tmpreg is in hp1 or not, because
+                             it will be marked as in use at p (if not, this is
+                             indictive of a compiler bug). }
+                           then
+                           begin
+                             TAsmLabel(symbol).decrefs;
+                             increg := newreg(R_INTREGISTER,reg,R_SUBL);
+                             Taicpu(p).clearop(0);
+                             Taicpu(p).ops:=1;
+                             Taicpu(p).is_jmp:=false;
+                             Taicpu(p).opcode:=A_SETcc;
+                             DebugMsg(SPeepholeOptimization+'JccAdd2SetccAdd',p);
+                             Taicpu(p).condition:=inverse_cond(Taicpu(p).condition);
+                             Taicpu(p).loadreg(0,increg);
+
+                             if getsubreg(Taicpu(hp1).oper[1]^.reg)<>R_SUBL then
+                               begin
+                                 case getsubreg(Taicpu(hp1).oper[1]^.reg) of
+                                   R_SUBW:
+                                     begin
+                                       tmpreg := newreg(R_INTREGISTER,reg,R_SUBW);
+                                       hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BW,increg,tmpreg);
+                                     end;
+                                   R_SUBD:
+                                     begin
+                                       tmpreg := newreg(R_INTREGISTER,reg,R_SUBD);
+                                       hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BL,increg,tmpreg);
+                                     end;
+ {$ifdef x86_64}
+                                   R_SUBQ:
+                                     begin
+                                       { MOVZX doesn't have a 64-bit variant, because
+                                         the 32-bit version implicitly zeroes the
+                                         upper 32-bits of the destination register }
+                                       hp2:=Taicpu.op_reg_reg(A_MOVZX,S_BL,increg,
+                                         newreg(R_INTREGISTER,reg,R_SUBD));
+                                       tmpreg := newreg(R_INTREGISTER,reg,R_SUBQ);
+                                     end;
+ {$endif x86_64}
+                                   else
+                                     Internalerror(2020030601);
+                                 end;
+                                 taicpu(hp2).fileinfo:=taicpu(hp1).fileinfo;
+                                 asml.InsertAfter(hp2,p);
+                               end
+                             else
+                               tmpreg := increg;
+
+                             if (Taicpu(hp1).opcode=A_INC) or (Taicpu(hp1).opcode=A_DEC) then
+                               begin
+                                 Taicpu(hp1).ops:=2;
+                                 Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^)
+                               end;
+                             Taicpu(hp1).loadreg(0,tmpreg);
+                             AllocRegBetween(tmpreg,p,hp1,UsedRegs);
+
+                             Result := True;
+
+                             { p is no longer a Jcc instruction, so exit }
+                             Exit;
+                           end;
+                       end;
+                   end;
+               end;
 
-          { Detect the following:
-              jmp<cond>     @Lbl1
-              jmp           @Lbl2
-              ...
-            @Lbl1:
-              ret
+              { Detect the following:
+                  jmp<cond>     @Lbl1
+                  jmp           @Lbl2
+                  ...
+                @Lbl1:
+                  ret
 
-            Change to:
+                Change to:
 
-              jmp<inv_cond> @Lbl2
-              ret
-          }
-            if MatchInstruction(hp1,A_JMP,[]) and (taicpu(hp1).oper[0]^.ref^.refaddr=addr_full) then
-              begin
-                hp2:=getlabelwithsym(TAsmLabel(symbol));
-                if Assigned(hp2) and SkipLabels(hp2,hp2) and
-                  MatchInstruction(hp2,A_RET,[S_NO]) then
-                  begin
-                    taicpu(p).condition := inverse_cond(taicpu(p).condition);
-
-                    { Change label address to that of the unconditional jump }
-                    taicpu(p).loadoper(0, taicpu(hp1).oper[0]^);
-
-                    TAsmLabel(symbol).DecRefs;
-                    taicpu(hp1).opcode := A_RET;
-                    taicpu(hp1).is_jmp := false;
-                    taicpu(hp1).ops := taicpu(hp2).ops;
-                    DebugMsg(SPeepholeOptimization+'JccJmpRet2J!ccRet',p);
-                    case taicpu(hp2).ops of
-                      0:
-                        taicpu(hp1).clearop(0);
-                      1:
-                        taicpu(hp1).loadconst(0,taicpu(hp2).oper[0]^.val);
-                      else
-                        internalerror(2016041302);
+                  jmp<inv_cond> @Lbl2
+                  ret
+              }
+              if MatchInstruction(hp1,A_JMP,[]) and (taicpu(hp1).oper[0]^.ref^.refaddr=addr_full) then
+                begin
+                  hp2:=getlabelwithsym(TAsmLabel(symbol));
+                  if Assigned(hp2) and SkipLabels(hp2,hp2) and
+                    MatchInstruction(hp2,A_RET,[S_NO]) then
+                    begin
+                      taicpu(p).condition := inverse_cond(taicpu(p).condition);
+
+                      { Change label address to that of the unconditional jump }
+                      taicpu(p).loadoper(0, taicpu(hp1).oper[0]^);
+
+                      TAsmLabel(symbol).DecRefs;
+                      taicpu(hp1).opcode := A_RET;
+                      taicpu(hp1).is_jmp := false;
+                      taicpu(hp1).ops := taicpu(hp2).ops;
+                      DebugMsg(SPeepholeOptimization+'JccJmpRet2J!ccRet',p);
+                      case taicpu(hp2).ops of
+                        0:
+                          taicpu(hp1).clearop(0);
+                        1:
+                          taicpu(hp1).loadconst(0,taicpu(hp2).oper[0]^.val);
+                        else
+                          internalerror(2016041302);
+                      end;
                     end;
-                  end;
-              end;
-          end;
 {$ifndef i8086}
-        if CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype] then
-          begin
-             { check for
-                    jCC   xxx
-                    <several movs>
-                 xxx:
-             }
-             l:=0;
-             GetNextInstruction(p, hp1);
-             while assigned(hp1) and
-               CanBeCMOV(hp1) and
-               { stop on labels }
-               not(hp1.typ=ait_label) do
-               begin
-                  inc(l);
-                  GetNextInstruction(hp1,hp1);
-               end;
-             if assigned(hp1) then
-               begin
-                  if FindLabel(tasmlabel(symbol),hp1) then
-                    begin
-                      if (l<=4) and (l>0) then
+                end
+              else if CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype] then
+                begin
+                 { check for
+                        jCC   xxx
+                        <several movs>
+                     xxx:
+                 }
+                 l:=0;
+                 while assigned(hp1) and
+                   CanBeCMOV(hp1) and
+                   { stop on labels }
+                   not(hp1.typ=ait_label) do
+                   begin
+                      inc(l);
+                      GetNextInstruction(hp1,hp1);
+                   end;
+                 if assigned(hp1) then
+                   begin
+                      if FindLabel(tasmlabel(symbol),hp1) then
                         begin
-                          condition:=inverse_cond(taicpu(p).condition);
-                          GetNextInstruction(p,hp1);
-                          repeat
-                            if not Assigned(hp1) then
-                              InternalError(2018062900);
-
-                            taicpu(hp1).opcode:=A_CMOVcc;
-                            taicpu(hp1).condition:=condition;
-                            UpdateUsedRegs(hp1);
-                            GetNextInstruction(hp1,hp1);
-                          until not(CanBeCMOV(hp1));
-
-                          { Remember what hp1 is in case there's multiple aligns to get rid of }
-                          hp2 := hp1;
-                          repeat
-                            if not Assigned(hp2) then
-                              InternalError(2018062910);
-
-                            case hp2.typ of
-                              ait_label:
-                                { What we expected - break out of the loop (it won't be a dead label at the top of
-                                  a cluster because that was optimised at an earlier stage) }
-                                Break;
-                              ait_align:
-                                { Go to the next entry until a label is found (may be multiple aligns before it) }
-                                begin
-                                  hp2 := tai(hp2.Next);
-                                  Continue;
-                                end;
-                              else
-                                begin
-                                  { Might be a comment or temporary allocation entry }
-                                  if not (hp2.typ in SkipInstr) then
-                                    InternalError(2018062911);
+                          if (l<=4) and (l>0) then
+                            begin
+                              condition:=inverse_cond(taicpu(p).condition);
+                              GetNextInstruction(p,hp1);
+                              repeat
+                                if not Assigned(hp1) then
+                                  InternalError(2018062900);
+
+                                taicpu(hp1).opcode:=A_CMOVcc;
+                                taicpu(hp1).condition:=condition;
+                                UpdateUsedRegs(hp1);
+                                GetNextInstruction(hp1,hp1);
+                              until not(CanBeCMOV(hp1));
+
+                              { Remember what hp1 is in case there's multiple aligns to get rid of }
+                              hp2 := hp1;
+                              repeat
+                                if not Assigned(hp2) then
+                                  InternalError(2018062910);
+
+                                case hp2.typ of
+                                  ait_label:
+                                    { What we expected - break out of the loop (it won't be a dead label at the top of
+                                      a cluster because that was optimised at an earlier stage) }
+                                    Break;
+                                  ait_align:
+                                    { Go to the next entry until a label is found (may be multiple aligns before it) }
+                                    begin
+                                      hp2 := tai(hp2.Next);
+                                      Continue;
+                                    end;
+                                  else
+                                    begin
+                                      { Might be a comment or temporary allocation entry }
+                                      if not (hp2.typ in SkipInstr) then
+                                        InternalError(2018062911);
 
-                                  hp2 := tai(hp2.Next);
-                                  Continue;
+                                      hp2 := tai(hp2.Next);
+                                      Continue;
+                                    end;
                                 end;
-                            end;
 
-                          until False;
+                              until False;
 
-                          { Now we can safely decrement the reference count }
-                          tasmlabel(symbol).decrefs;
+                              { Now we can safely decrement the reference count }
+                              tasmlabel(symbol).decrefs;
 
-                          DebugMsg(SPeepholeOptimization+'JccMov2CMov',p);
+                              DebugMsg(SPeepholeOptimization+'JccMov2CMov',p);
 
-                          { Remove the original jump }
-                          RemoveInstruction(p); { Note, the choice to not use RemoveCurrentp is deliberate }
+                              { Remove the original jump }
+                              RemoveInstruction(p); { Note, the choice to not use RemoveCurrentp is deliberate }
 
-                          GetNextInstruction(hp2, p); { Instruction after the label }
+                              GetNextInstruction(hp2, p); { Instruction after the label }
 
-                          { Remove the label if this is its final reference }
-                          if (tasmlabel(symbol).getrefs=0) then
-                            StripLabelFast(hp1);
+                              { Remove the label if this is its final reference }
+                              if (tasmlabel(symbol).getrefs=0) then
+                                StripLabelFast(hp1);
 
-                          if Assigned(p) then
-                            begin
-                              UpdateUsedRegs(p);
-                              result:=true;
+                              if Assigned(p) then
+                                begin
+                                  UpdateUsedRegs(p);
+                                  result:=true;
+                                end;
+                              exit;
                             end;
-                          exit;
-                        end;
-                    end
-                  else
-                    begin
-                       { check further for
-                              jCC   xxx
-                              <several movs 1>
-                              jmp   yyy
-                      xxx:
-                              <several movs 2>
-                      yyy:
-                       }
-                      { hp2 points to jmp yyy }
-                      hp2:=hp1;
-                      { skip hp1 to xxx (or an align right before it) }
-                      GetNextInstruction(hp1, hp1);
-
-                      if assigned(hp2) and
-                        assigned(hp1) and
-                        (l<=3) and
-                        (hp2.typ=ait_instruction) and
-                        (taicpu(hp2).is_jmp) and
-                        (taicpu(hp2).condition=C_None) and
-                        { real label and jump, no further references to the
-                          label are allowed }
-                        (tasmlabel(symbol).getrefs=1) and
-                        FindLabel(tasmlabel(symbol),hp1) then
-                         begin
-                           l:=0;
-                           { skip hp1 to <several moves 2> }
-                           if (hp1.typ = ait_align) then
-                             GetNextInstruction(hp1, hp1);
-
-                           GetNextInstruction(hp1, hpmov2);
-
-                           hp1 := hpmov2;
-                           while assigned(hp1) and
-                             CanBeCMOV(hp1) do
-                             begin
-                               inc(l);
-                               GetNextInstruction(hp1, hp1);
-                             end;
-                           { hp1 points to yyy (or an align right before it) }
-                           hp3 := hp1;
-                           if assigned(hp1) and
-                             FindLabel(tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol),hp1) then
+                        end
+                      else
+                        begin
+                           { check further for
+                                  jCC   xxx
+                                  <several movs 1>
+                                  jmp   yyy
+                          xxx:
+                                  <several movs 2>
+                          yyy:
+                           }
+                          { hp2 points to jmp yyy }
+                          hp2:=hp1;
+                          { skip hp1 to xxx (or an align right before it) }
+                          GetNextInstruction(hp1, hp1);
+
+                          if assigned(hp2) and
+                            assigned(hp1) and
+                            (l<=3) and
+                            (hp2.typ=ait_instruction) and
+                            (taicpu(hp2).is_jmp) and
+                            (taicpu(hp2).condition=C_None) and
+                            { real label and jump, no further references to the
+                              label are allowed }
+                            (tasmlabel(symbol).getrefs=1) and
+                            FindLabel(tasmlabel(symbol),hp1) then
                              begin
-                                condition:=inverse_cond(taicpu(p).condition);
-                                GetNextInstruction(p,hp1);
-                                repeat
-                                  taicpu(hp1).opcode:=A_CMOVcc;
-                                  taicpu(hp1).condition:=condition;
-                                  UpdateUsedRegs(hp1);
-                                  GetNextInstruction(hp1,hp1);
-                                until not(assigned(hp1)) or
-                                  not(CanBeCMOV(hp1));
-
-                                condition:=inverse_cond(condition);
-                                hp1 := hpmov2;
-                                { hp1 is now at <several movs 2> }
-                                while Assigned(hp1) and CanBeCMOV(hp1) do
-                                  begin
-                                    taicpu(hp1).opcode:=A_CMOVcc;
-                                    taicpu(hp1).condition:=condition;
-                                    UpdateUsedRegs(hp1);
-                                    GetNextInstruction(hp1,hp1);
-                                  end;
+                               l:=0;
+                               { skip hp1 to <several moves 2> }
+                               if (hp1.typ = ait_align) then
+                                 GetNextInstruction(hp1, hp1);
+
+                               GetNextInstruction(hp1, hpmov2);
+
+                               hp1 := hpmov2;
+                               while assigned(hp1) and
+                                 CanBeCMOV(hp1) do
+                                 begin
+                                   inc(l);
+                                   GetNextInstruction(hp1, hp1);
+                                 end;
+                               { hp1 points to yyy (or an align right before it) }
+                               hp3 := hp1;
+                               if assigned(hp1) and
+                                 FindLabel(tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol),hp1) then
+                                 begin
+                                    condition:=inverse_cond(taicpu(p).condition);
+                                    GetNextInstruction(p,hp1);
+                                    repeat
+                                      taicpu(hp1).opcode:=A_CMOVcc;
+                                      taicpu(hp1).condition:=condition;
+                                      UpdateUsedRegs(hp1);
+                                      GetNextInstruction(hp1,hp1);
+                                    until not(assigned(hp1)) or
+                                      not(CanBeCMOV(hp1));
+
+                                    condition:=inverse_cond(condition);
+                                    hp1 := hpmov2;
+                                    { hp1 is now at <several movs 2> }
+                                    while Assigned(hp1) and CanBeCMOV(hp1) do
+                                      begin
+                                        taicpu(hp1).opcode:=A_CMOVcc;
+                                        taicpu(hp1).condition:=condition;
+                                        UpdateUsedRegs(hp1);
+                                        GetNextInstruction(hp1,hp1);
+                                      end;
 
-                                hp1 := p;
+                                    hp1 := p;
 
-                                { Get first instruction after label }
-                                GetNextInstruction(hp3, p);
+                                    { Get first instruction after label }
+                                    GetNextInstruction(hp3, p);
 
-                                if assigned(p) and (hp3.typ = ait_align) then
-                                  GetNextInstruction(p, p);
+                                    if assigned(p) and (hp3.typ = ait_align) then
+                                      GetNextInstruction(p, p);
 
-                                { Don't dereference yet, as doing so will cause
-                                  GetNextInstruction to skip the label and
-                                  optional align marker. [Kit] }
-                                GetNextInstruction(hp2, hp4);
+                                    { Don't dereference yet, as doing so will cause
+                                      GetNextInstruction to skip the label and
+                                      optional align marker. [Kit] }
+                                    GetNextInstruction(hp2, hp4);
 
-                                DebugMsg(SPeepholeOptimization+'JccMovJmpMov2CMovCMov',hp1);
+                                    DebugMsg(SPeepholeOptimization+'JccMovJmpMov2CMovCMov',hp1);
 
-                                { remove jCC }
-                                RemoveInstruction(hp1);
+                                    { remove jCC }
+                                    RemoveInstruction(hp1);
 
-                                { Now we can safely decrement it }
-                                tasmlabel(symbol).decrefs;
+                                    { Now we can safely decrement it }
+                                    tasmlabel(symbol).decrefs;
 
-                                { Remove label xxx (it will have a ref of zero due to the initial check }
-                                StripLabelFast(hp4);
+                                    { Remove label xxx (it will have a ref of zero due to the initial check }
+                                    StripLabelFast(hp4);
 
-                                { remove jmp }
-                                symbol := taicpu(hp2).oper[0]^.ref^.symbol;
+                                    { remove jmp }
+                                    symbol := taicpu(hp2).oper[0]^.ref^.symbol;
 
-                                RemoveInstruction(hp2);
+                                    RemoveInstruction(hp2);
 
-                                { As before, now we can safely decrement it }
-                                tasmlabel(symbol).decrefs;
+                                    { As before, now we can safely decrement it }
+                                    tasmlabel(symbol).decrefs;
 
-                                { Remove label yyy (and the optional alignment) if its reference falls to zero }
-                                if tasmlabel(symbol).getrefs = 0 then
-                                  StripLabelFast(hp3);
+                                    { Remove label yyy (and the optional alignment) if its reference falls to zero }
+                                    if tasmlabel(symbol).getrefs = 0 then
+                                      StripLabelFast(hp3);
 
-                                if Assigned(p) then
-                                  begin
-                                    UpdateUsedRegs(p);
-                                    result:=true;
-                                  end;
-                                exit;
+                                    if Assigned(p) then
+                                      begin
+                                        UpdateUsedRegs(p);
+                                        result:=true;
+                                      end;
+                                    exit;
+                                 end;
                              end;
-                         end;
-                    end;
-               end;
-          end;
+                        end;
+                   end;
 {$endif i8086}
+              end;
+          end;
       end;
 
 

compiler/x86/cgx86.pas

@@ -1995,7 +1995,7 @@ unit cgx86;
             href.scalefactor:=a;
             list.concat(taicpu.op_ref_reg(A_LEA,TCgSize2OpSize[size],href,dst));
           end
-        else if (op in [OP_MUL,OP_IMUL]) and (size in [OS_32,OS_S32,OS_64,OS_S64]) and
+        else if (op in [OP_MUL,OP_IMUL]) and (size in [OS_16,OS_S16,OS_32,OS_S32,OS_64,OS_S64]) and
           (a>1) and (a<=maxLongint) and not ispowerof2(int64(a),power) then
           begin
             { MUL with overflow checking should be handled specifically in the code generator }
@@ -2343,6 +2343,17 @@ unit cgx86;
             begin
               if reg2opsize(src) <> dstsize then
                 internalerror(200109226);
+              { x86 does not have an 8 Bit imul, so do 16 Bit multiplication
+                we do not need to zero/sign extend as we discard the upper bits anyways }
+              if (TOpCG2AsmOp[op]=A_IMUL) and (size in [OS_8,OS_S8]) then
+                begin
+                  { this might only happen if no overflow checking is done }
+                  if cs_check_overflow in current_settings.localswitches then
+                    Internalerror(2021011601);
+                  src:=makeregsize(list,src,OS_16);
+                  dst:=makeregsize(list,dst,OS_16);
+                  dstsize:=S_W;
+                end;
               instr:=taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,src,dst);
               list.concat(instr);
             end;

compiler/x86/nx86mat.pas

@@ -387,7 +387,10 @@ interface
         cgsize:=def_cgsize(resultdef);
         opsize:=TCGSize2OpSize[cgsize];
         rega:=newreg(R_INTREGISTER,RS_EAX,cgsize2subreg(R_INTREGISTER,cgsize));
-        regd:=newreg(R_INTREGISTER,RS_EDX,cgsize2subreg(R_INTREGISTER,cgsize));
+        if cgsize in [OS_8,OS_S8] then
+          regd:=NR_AH
+        else
+          regd:=newreg(R_INTREGISTER,RS_EDX,cgsize2subreg(R_INTREGISTER,cgsize));
 
         location_reset(location,LOC_REGISTER,cgsize);
         hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,false);

compiler/x86_64/nx64mat.pas

@@ -43,6 +43,7 @@ implementation
 
     uses
       globtype,constexp,
+      cutils,
       aasmdata,defutil,
       pass_2,
       ncon,
@@ -69,24 +70,8 @@ implementation
         else
           op:=OP_SHR;
 
-        { special treatment of 32bit values for backwards compatibility }
-        { mul optimizations require to keep the sign (FK) }
-        if left.resultdef.size<=4 then
-          begin
-            if is_signed(left.resultdef) then
-              opsize:=OS_S32
-            else
-              opsize:=OS_32;
-            mask:=31;
-          end
-        else
-          begin
-            if is_signed(left.resultdef) then
-              opsize:=OS_S64
-            else
-              opsize:=OS_64;
-            mask:=63;
-          end;
+        opsize:=def_cgsize(resultdef);
+        mask:=max(resultdef.size,4)*8-1;
 
         { load left operators in a register }
         if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or

utils/fpdoc/dglobals.pp

@@ -33,203 +33,6 @@ Var
   LEOL : Integer;
   modir : string;
 
-resourcestring
-  // Output strings
-  SDocPackageTitle           = 'Reference for package ''%s''';
-  SDocPackageMenuTitle       = 'Package ''%s''';
-  SDocPackageLinkTitle       = 'Package';
-  SDocPrograms               = 'Programs';
-  SDocUnits                  = 'Units';
-  SDocUnitTitle              = 'Reference for unit ''%s''';
-  SDocUnitMenuTitle          = 'Unit ''%s''';
-  SDocInheritanceHierarchy   = 'Inheritance Hierarchy';
-  SDocInterfaceSection       = 'Interface section';
-  SDocImplementationSection  = 'Implementation section';
-  SDocUsedUnits              = 'Used units';
-  SDocUsedUnitsByUnitXY      = 'Used units by unit ''%s''';
-  SDocConstsTypesVars        = 'Constants, types and variables';
-  SDocResStrings             = 'Resource strings';
-  SDocTypes                  = 'Types';
-  SDocType                   = 'Type';
-  SDocConstants              = 'Constants';
-  SDocConstant               = 'Constant';
-  SDocClasses                = 'Classes';
-  SDocClass                  = 'Class';
-  SDocProceduresAndFunctions = 'Procedures and functions';
-  SDocProcedureOrFunction    = 'Procedure/function';
-  SDocVariables              = 'Variables';
-  SDocVariable               = 'Variable';
-  SDocIdentifierIndex        = 'Index';
-  SDocPackageClassHierarchy  = 'Class hierarchy';
-  SDocModuleIndex            = 'Index of all identifiers in unit ''%s''';
-  SDocPackageIndex           = 'Index of all identifiers in package ''%s''';
-  SDocUnitOverview           = 'Overview of unit ''%s''';
-  SDocOverview               = 'Overview';
-  SDocSearch                 = 'Search';
-  SDocDeclaration            = 'Declaration';
-  SDocDescription            = 'Description';
-  SDocErrors                 = 'Errors';
-  SDocVersion                = 'Version info';
-  SDocSeeAlso                = 'See also';
-  SDocExample                = 'Example';
-  SDocArguments              = 'Arguments';
-  SDocFunctionResult         = 'Function result';
-  SDocRemark                 = 'Remark:   ';
-  SDocMethodOverview         = 'Method overview';
-  SDocPropertyOverview       = 'Property overview';
-  SDocEventOverview          = 'Event overview';
-  SDocInterfacesOverview     = 'Interfaces overview';
-  SDocInterface              = 'Interfaces';
-  SDocPage                   = 'Page';
-  SDocMember                 = 'Member';
-  SDocMembers                = 'Members';
-  SDocField                  = 'Field';
-  SDocMethod                 = 'Method';
-  SDocProperty               = 'Property';
-  SDocAccess                 = 'Access';
-  SDocInheritance            = 'Inheritance';
-  SDocProperties             = 'Properties';
-  SDocMethods                = 'Methods';
-  SDocEvents                 = 'Events';
-  SDocByName                 = 'by Name';
-  SDocByInheritance          = 'By inheritance';
-  SDocValue                  = 'Value';
-  SDocExplanation            = 'Explanation';
-  SDocProcedure              = 'Procedure';
-  SDocValuesForEnum          = 'Enumeration values for type %s';
-  SDocSourcePosition         = 'Source position: %s line %d';
-  SDocSynopsis               = 'Synopsis';
-  SDocVisibility             = 'Visibility';
-  SDocOpaque                 = 'Opaque type';
-  SDocDateGenerated          = 'Documentation generated on: %s';
-  // The next line requires leading/trailing space due to XML comment layout:
-  SDocGeneratedByComment     = ' Generated using FPDoc - (c) 2000-2012 FPC contributors and Sebastian Guenther, [email protected] ';
-  SDocNotes                  = 'Notes';
-  SDocName                   = 'Name';
-  SDocType_s                 = 'Type(s)';
-  SDocTopic                  = 'Topic';
-  SDocNoneAVailable          = 'No members available';
-  
-  // Topics
-  SDocRelatedTopics = 'Related topics';
-  SDocUp            = 'Up';
-  SDocNext          = 'Next';
-  SDocPrevious      = 'Previous';
-
-  // Various backend constants
-  SDocChapter    = 'Chapter';
-  SDocSection    = 'Section';
-  SDocSubSection = 'Subsection';
-  SDocTable      = 'Table';
-  SDocListing    = 'Listing';
-
-  // Man page usage
-  SManUsageManSection         = 'Use ASection as the man page section';
-  SManUsageNoUnitPrefix       = 'Do not prefix man pages with unit name.';
-  SManUsageWriterDescr        = 'UNIX man page output.';
-  SManUsagePackageDescription = 'Use descr as the description of man pages';
-  
-  // HTML usage
-  SHTMLUsageFooter = 'Append xhtml (@filename reads from file) as footer to html page';
-  SHTMLUsageNavigator = 'Append xhtml (@filename reads from file) in navigator bar';
-  SHTMLUsageHeader = 'Append xhtml (@filename reads from file) as header to html page below navigation bar';
-  SHTMLUsageFooterDate = 'Append footer with date. fmt is Optional format for FormatDateTime';
-  SHTMLUsageCharset = 'Set the HTML character set';
-  SHTMLHtmlSearch = 'Add search page with given name to the menu bar';
-  SHTMLIndexColcount = 'Use N columns in the identifier index pages';
-  SHTMLImageUrl = 'Prefix image URLs with url';
-  SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css';
-
-  // CHM usage
-  SCHMUsageTOC     = 'Use [File] as the table of contents. Usually a .hhc file.';
-  SCHMUsageIndex   = 'Use [File] as the index. Usually a .hhk file.';
-  SCHMUsageDefPage = 'Set the "Home" page relative to where it lives in the chm. i.e. "/index.html"';
-  SCHMUsageOtrFiles= 'A txt file containing a list of files to be added relative to the working directory.';
-  SCHMUsageCSSFile = 'Filename of a .css file to be included in the chm.';
-  SCHMUsageAutoTOC = 'Automatically generate a Table of Contents. Ignores --toc-file';
-  SCHMUsageAutoIDX = 'Automatically generate an Index. Ignores --index-file';
-  SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
-  SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
-
-  // MarkDown usage
-  SMDUsageFooter = 'Append markdown (@filename reads from file) as footer to every markdown page';
-  SMDUsageHeader = 'Prepend markdown (@filename reads from file) as header to every markdown page';
-  SMDIndexColcount = 'Use N columns in the identifier index pages';
-  SMDImageUrl = 'Prefix image URLs with url';
-  SMDTheme = 'Use name as theme name';
-  SMDNavigation = 'Use scheme for navigation tree, here scheme is one of:';
-  SMDNavSubtree = '    UnitSubTree : put all units in a sub tree of a Units node';
-  SMDNavTree =    '    UnitTree : put every units as a node on the same level as packages node';
-
-  SXMLUsageFlatStructure  = 'Use a flat output structure of XML files and directories';
-  SXMLUsageSource  = 'Include source file and line info in generated XML';
-
-  // Linear usage
-  SLinearUsageDupLinkedDocsP1 = 'Duplicate linked element documentation in';
-  SLinearUsageDupLinkedDocsP2 = 'descendant classes.';
-
-  STitle           = 'FPDoc - Free Pascal Documentation Tool';
-  SVersion         = 'Version %s [%s]';
-  SCopyright1      = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, [email protected]';
-  SCopyright2      = '(c) 2005 - 2021 various FPC contributors';
-
-  SCmdLineHelp     = 'Usage: %s [options]';
-  SUsageOption008  = '--base-descr-dir=DIR prefix all description files with this directory';
-  SUsageOption009  = '--base-input-dir=DIR prefix all input files with this directory';
-  SUsageOption010  = '--content         Create content file for package cross-references';
-  SUsageOption020  = '--cputarget=value Set the target CPU for the scanner.';
-  SUsageOption030  = '--descr=file      use file as description file, e.g.: ';
-  SUsageOption035  = '                  --descr=c:\WIP\myzipperdoc.xml';
-  SUsageOption040  = '                  This option is allowed more than once';
-  SUsageOption050  = '--descr-dir=Dir   Add All XML files in Dir to list of description files';
-  SUsageOption060  = '--format=fmt      Select output format.';
-  SUsageOption070  = '--help            Show this help.';
-  SUsageOption080  = '--hide-protected  Do not show protected methods in overview';
-  SUsageOption090  = '--import=file     Import content file for package cross-references';
-  SUsageOption100  = '--input=cmd       use cmd as input for the parser, e.g.:';
-  SUsageOption110  = '           --input=C:\fpc\packages\paszlib\src\zipper.pp';
-  SUsageOption120  = '                  At least one input option is required.';
-  SUsageOption130  = '--input-dir=Dir   Add All *.pp and *.pas files in Dir to list of input files';
-  SUsageOption140  = '--lang=lng        Select output language.';
-  SUsageOption145  = '--macro=name=value Define a macro to preprocess the project file with.';
-  SUsageOption150  = '--ostarget=value  Set the target OS for the scanner.';
-  SUsageOption160  = '--output=name     use name as the output name.';
-  SUsageOption170  = '                  Each backend interprets this as needed.';
-  SUsageOption180  = '--package=name    Set the package name for which to create output,';
-  SUsageOption190  = '                  e.g. --package=fcl';
-  SUsageOption200  = '--project=file    Use file as project file';
-  SUsageOption210  = '--show-private    Show private methods.';
-  SUsageOption215  = '--stop-on-parser-error';
-  SUsageOption215A = '                  Stop when a parser error occurs. Default is to ignore parser errors.';
-  SUsageOption220  = '--warn-no-node    Warn if no documentation node was found.';
-  SUsageOption230  = '--mo-dir=dir      Set directory where language files reside to dir';
-  SUsageOption240  = '--parse-impl      (Experimental) try to parse implementation too';
-  SUsageOption250  = '--dont-trim       Do not trim XML contents. Useful for preserving';
-  SUsageOption260  = '                  formatting inside e.g <pre> tags';
-  SUsageOption270  = '--write-project=file';
-  SUsageOption280  = '                  Do not write documentation, create project file instead';
-  SUsageOption290  = '--verbose         Write more information on the screen';
-  SUsageOption300  = '--dry-run         Only parse sources and XML, do not create output';
-  SUsageOption310  = '--write-project=file';
-  SUsageOption320  = '                  Write all command-line options to a project file';
-  SUsageSubNames   = 'Use the file subnames instead the indexes as postfixes';
-
-  SUsageFormats        = 'The following output formats are supported by this fpdoc:';
-  SUsageBackendHelp    = 'Specify an output format, combined with --help to get more help for this backend.';
-  SUsageFormatSpecific = 'Output format "%s" supports the following options:';
-  SCmdLineErrInvalidMacro     = 'Macro needs to be in the form name=value';
-
-  SCmdLineInvalidOption       = 'Ignoring unknown option "%s"';
-  SCmdLineInvalidFormat       = 'Invalid format "%s" specified';
-  SCmdLineOutputOptionMissing = 'Need an output filename, please specify one with --output=<filename>';
-  SWritingPages               = 'Writing %d pages...';
-  SNeedPackageName            = 'No package name specified. Please specify one using the --package option.';
-  SAvailablePackages          = 'Available packages: ';
-  SDone                       = 'Done.';
-  SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
-  SErrCouldNotCreateFile      = 'Could not create file "%s": %s';
-  SSeeURL                     = '(See %s)';      // For linear text writers.
-  SParsingUsedUnit            = 'Parsing used unit "%s" with commandLine "%s"';
 
 Const
   SVisibility: array[TPasMemberVisibility] of string =
@@ -335,7 +138,7 @@ type
 
 
   // The main FPDoc engine
-  TFPDocLogLevel = (dleWarnNoNode);
+  TFPDocLogLevel = (dleWarnNoNode, dleWarnUsedFile, dleDocumentationEmpty, dleXCT);
   TFPDocLogLevels = set of TFPDocLogLevel;
   TOnParseUnitEvent = Procedure (Sender : TObject; Const AUnitName : String; Out AInputFile,OSTarget,CPUTarget : String) of  Object;
 
@@ -364,8 +167,7 @@ type
     HasContentFile: Boolean;
     HidePrivate: Boolean;       // Hide private class members in output?
     HideProtected: Boolean;     // Hide protected class members in output?
-    WarnNoNode : Boolean;       // Warn if no description node found for element.
-
+    FalbackSeeAlsoLinks: Boolean; // Simplify SeeAlso Links
     constructor Create;
     destructor Destroy; override;
     procedure SetPackageName(const APackageName: String);
@@ -378,7 +180,7 @@ type
       AParent: TPasElement; AVisibility: TPasMemberVisibility;
       const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
       override;
-    function FindInModule(const AName: String ; AModule: TPasModule): TPasElement;
+    function FindElement(const AName: String ; AModule: TPasModule): TPasElement; overload;
     function FindElement(const AName: String): TPasElement; override;
     function FindModule(const AName: String): TPasModule; override;
     Function HintsToStr(Hints : TPasMemberHints) : String;
@@ -386,6 +188,7 @@ type
     // Link tree support
     procedure AddLink(const APathName, ALinkTo: String);
     function FindAbsoluteLink(const AName: String): String;
+    // resolve link inside actual AModule and AModule.Parent = APackage
     function ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
     function FindLinkedNode(ANode: TDocNode): TDocNode;
     Function ShowElement(El : TPasElement) : Boolean; inline;
@@ -411,7 +214,9 @@ type
 
 
 procedure TranslateDocStrings(const Lang: String);
+{$IFDEF EXCEPTION_STACK}
 function DumpExceptionCallStack(E: Exception):String;
+{$ENDIF}
 
 Function IsLinkNode(Node : TDomNode) : Boolean;
 Function IsExampleNode(Example : TDomNode) : Boolean;
@@ -422,7 +227,7 @@ Function IsLinkAbsolute(ALink: String): boolean;
 
 implementation
 
-uses Gettext, XMLRead;
+uses Gettext, XMLRead, fpdocstrs;
 
 const
   AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:');
@@ -670,8 +475,11 @@ destructor TFPDocEngine.Destroy;
 var
   i: Integer;
 begin
+  if FPackages.Count > 0 then
   for i := 0 to FPackages.Count - 1 do
-    TPasPackage(FPackages[i]).Release{$IFDEF CheckPasTreeRefCount}('TFPDocEngine.Destroy'){$ENDIF};
+    TPasPackage(FPackages[i]).Release{$IFDEF CheckPasTreeRefCount}('TFPDocEngine.Destroy'){$ENDIF}
+  else
+    FreeAndNil(FPackages);
   FreeAndNil(FRootDocNode);
   FreeAndNil(FRootLinkNode);
   FreeAndNil(DescrDocNames);
@@ -910,7 +718,7 @@ var
            end;
        end
      else
-       if cls<>result then
+       if (dleXCT in FDocLogLevels) and (cls<>result) then
          DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]);
     end;
 
@@ -970,7 +778,7 @@ var
                if alname<>'' then // the class//interface we refered to is an alias
                  begin
                    // writeln('Found alias pair ',clname,' = ',alname);
-                   if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
+                   if (dleXCT in FDocLogLevels) and not assigned(CreateAliasType(alname,clname,cls,cls2)) then
                       DoLog('Warning: creating alias %s for %s failed!',[alname,clname]);
                  end 
                else
@@ -1217,7 +1025,7 @@ begin
   Result.SourceLinenumber := ASourceLinenumber;
 end;
 
-function TFPDocEngine.FindInModule ( const AName: String; AModule: TPasModule
+function TFPDocEngine.FindElement ( const AName: String; AModule: TPasModule
   ) : TPasElement;
 var
   l: TFPList;
@@ -1244,14 +1052,14 @@ var
   i: Integer;
   Module: TPasElement;
 begin
-  Result := FindInModule( AName, CurModule );
+  Result := FindElement( AName, CurModule );
   if not Assigned(Result) and assigned (CurModule.InterfaceSection) then
     for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
     begin
       Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
       if Module.ClassType.InheritsFrom(TPasModule) then
       begin
-        Result := FindInModule(AName, TPasModule(Module));
+        Result := FindElement(AName, TPasModule(Module));
         if Assigned(Result) then
           exit;
       end;
@@ -1264,6 +1072,7 @@ function TFPDocEngine.FindModule(const AName: String): TPasModule;
   var
     i: Integer;
   begin
+    if not Assigned(APackage) then Exit;
     for i := 0 to APackage.Modules.Count - 1 do
     begin
       Result := TPasModule(APackage.Modules[i]);
@@ -1279,7 +1088,7 @@ var
 
 begin
   Result := FindInPackage(Package);
-  if not Assigned(Result) then
+  if not Assigned(Result) and (FPackages.Count > 0) then
     for i := FPackages.Count - 1 downto 0 do
     begin
       if TPasPackage(FPackages[i]) = Package then
@@ -1319,11 +1128,12 @@ Var
   M : TPasModule;
 
 begin
-  DoLog(SParsingUsedUnit,[AName,AInputLine]);
+  if dleWarnUsedFile in FDocLogLevels then
+    DoLog(SParsingUsedUnit,[AName,AInputLine]);
   M:=CurModule;
   CurModule:=Nil;
   try
-    ParseSource(Self,AInputLine,AOSTarget,ACPUTarget,[poUseStreams,poSkipDefaultDefs]);
+    ParseSource(Self,AInputLine,AOSTarget,ACPUTarget,[poUseStreams]); //[poSkipDefaultDefs];
     Result:=CurModule;
   finally
     CurModule:=M;
@@ -1382,7 +1192,6 @@ end;
 function TFPDocEngine.ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
 var
   i: Integer;
-
 begin
 {
   if Assigned(AModule) then
@@ -1393,14 +1202,18 @@ begin
   if (ALinkDest='') then
     Exit('');
   if (ALinkDest[1] = '#') then
+    // Link has full path
     Result := FindAbsoluteLink(ALinkDest)
   else if (AModule=Nil) then
+    // Trying to add package name only
     Result:= FindAbsoluteLink(RootLinkNode.FirstChild.Name+'.'+ALinkDest)
   else
     begin
-    if Pos(AModule.Name,ALinkDest) = 1 then
+    if Pos(LowerCase(AModule.Name)+'.',LowerCase(ALinkDest)) = 1 then
+      // fix ERROR - Link starts from name of module
       Result := ResolveLink(AModule, AModule.packagename + '.' + ALinkDest, Strict)
     else
+      // Link should be a first level inside of module
       Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest, Strict);
     if (Result='') then
       begin
@@ -1411,12 +1224,17 @@ begin
     end;
   // Match on parent : class/enumerated/record/module
   if (Result='') and not strict then
+    begin
+    // TODO: I didn't see a calling this code at entire lcl package
+    // Writeln('INFO UnStrinct(): ' + ALinkDest);
     for i := Length(ALinkDest) downto 1 do
       if ALinkDest[i] = '.' then
         begin
         Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1), Strict);
+        //if Result <> '' then Writeln('INFO LinkResolved UnStrinct(): '+Result);
         exit;
         end;
+    end;
 end;
 
 procedure ReadXMLFileALT(OUT ADoc:TXMLDocument;const AFileName:ansistring);
@@ -1590,7 +1408,7 @@ begin
     if aElement.CustomData=Nil then
       aElement.CustomData:=Result;
     end
-  else if WarnNoNode and
+  else if (dleWarnNoNode in FDocLogLevels) and
           (Length(AElement.PathName)>0) and
           (AElement.PathName[1]='#') then
     DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName]));
@@ -1791,6 +1609,7 @@ begin
     end;
 end;
 
+{$IFDEF EXCEPTION_STACK}
 function DumpExceptionCallStack(E: Exception):String;
 var
   I: Integer;
@@ -1807,6 +1626,7 @@ begin
   for I := 0 to ExceptFrameCount - 1 do
     Result := Result + LineEnding + BackTraceStrFunc(Frames[I]);
 end;
+{$ENDIF}
 
 initialization
   LEOL:=Length(LineEnding);

utils/fpdoc/dw_basehtml.pp

@@ -158,7 +158,7 @@ Function FixHTMLpath(S : String) : STring;
 
 implementation
 
-uses xmlread, sysutils, sh_pas;
+uses fpdocstrs, xmlread, sysutils, sh_pas;
 
 Function FixHTMLpath(S : String) : STring;
 
@@ -428,6 +428,7 @@ begin
     else
       N:='?';
     DoLog(SErrUnknownLinkID, [s,n,a]);
+    LinkUnresolvedInc();
     PushOutputNode(CreateEl(CurOutputNode, 'b'));
   end else
     PushOutputNode(CreateLink(CurOutputNode, s));
@@ -797,7 +798,10 @@ begin
        TREl:=CreateTR(TableEl);
        ParaEl:=CreatePara(CreateTD_vtop(TREl));
        l:=El['id'];
-       s:= ResolveLinkID(UTF8ENcode(l));
+       if Assigned(Engine) and Engine.FalbackSeeAlsoLinks then
+         s:= ResolveLinkIDUnStrict(UTF8ENcode(l))
+       else
+         s:= ResolveLinkID(UTF8ENcode(l));
        if Length(s)=0 then
          begin
          if assigned(module) then
@@ -806,10 +810,11 @@ begin
            s:='?';
          if l='' then l:='<empty>';
          if Assigned(AElement) then
-           N:=UTF8Decode(AElement.Name)
+           N:=UTF8Decode(AElement.PathName)
          else
            N:='?';
          DoLog(SErrUnknownLinkID, [s,N,l]);
+         LinkUnresolvedInc();
          NewEl := CreateEl(ParaEl,'b')
          end
        else

utils/fpdoc/dw_basemd.pp

@@ -184,15 +184,8 @@ Type
 
 implementation
 
-resourcestring
-  SErrCannotChangeIndentSizeWhenIndented = 'Cannot change indent size while text is indented.';
-  SErrIndentMismatch = 'Indent mismatch: trying to undent when current indent too small';
-  SErrNotInList = 'Not in list';
-  SErrPopListStack = 'Pop list stack list type mismatch';
-  SErrMinListStack = 'Min list stack reached';
-  SErrMaxListStack = 'Max list stack reached';
-  SErrMinIndentStack = 'Min indent stack reached';
-  SErrMaxIndentStack = 'Max indent stack reached';
+uses fpdocstrs;
+
 
 procedure TBaseMarkdownWriter.SetIndentSize(AValue: Byte);
 begin
@@ -558,6 +551,7 @@ begin
     else
       N:='?';
     DoLog(SErrUnknownLinkID, [s,n,a]);
+    LinkUnresolvedInc();
     end
 end;
 

utils/fpdoc/dw_chm.pp

@@ -40,7 +40,7 @@ type
     FAutoIndex: Boolean;
     FOtherFiles: String;
     procedure ProcessOptions;
-    function ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString;
+    function ResolveLinkIDAbs(const Name: String): DOMString;
     function RetrieveOtherFiles(const DataName: String; out PathInChm: String;
               out FileName: String; var Stream: TStream): Boolean;
     procedure LastFileAdded(Sender: TObject);
@@ -50,10 +50,10 @@ type
             APasEl: TPasElement; Prefix:String);
     procedure GenerateTOC;
     procedure GenerateIndex;
+  protected
+    procedure DoWriteDocumentation; override;
   public
-    procedure WriteDoc; override;
     function CreateAllocator: TFileAllocator; override;
-    
     function  InterPretOption(const Cmd,Arg : String): boolean; override;
 
     class procedure Usage(List: TStrings); override;
@@ -63,7 +63,7 @@ type
 
 implementation
 
-uses SysUtils, HTMWrite, dw_basehtml;
+uses fpdocstrs, SysUtils, HTMWrite, dw_basehtml;
 
 { TCHmFileNameAllocator }
 
@@ -163,7 +163,7 @@ end;
 
 { TCHMHTMLWriter }
 
-function TCHMHTMLWriter.ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString;
+function TCHMHTMLWriter.ResolveLinkIDAbs(const Name: String): DOMString;
 
 begin
   Result:=UTF8Decode(FixHTMLpath(Engine.ResolveLink(Module,Name, True)));
@@ -341,8 +341,10 @@ begin
        Continue;
     ObjUnitItem := ObjByUnitItem.Children.NewItem;
     ObjUnitItem.Text := AModule.Name;
+    ObjUnitItem.addLocal(FixHTMLpath(Allocator.GetFilename(AModule, ClassesSubindex)));
     RoutinesUnitItem := RoutinesByUnitItem.Children.NewItem;
     RoutinesUnitItem.Text := AModule.Name;
+    RoutinesUnitItem.addLocal(FixHTMLpath(Allocator.GetFilename(AModule, ProcsSubindex)));
     for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
     begin
       Element := TPasClassType(AModule.InterfaceSection.Classes[j]);
@@ -621,7 +623,7 @@ begin
   DoLog('Generating Index Done');
 end;
 
-procedure TCHMHTMLWriter.WriteDoc;
+procedure TCHMHTMLWriter.DoWriteDocumentation;
 var
   i: Integer;
   PageDoc: TXMLDocument;
@@ -629,8 +631,6 @@ var
   IFileName,FileName: String;
   FilePath: String;
 begin
-  FAllocator:=CreateAllocator;
-  FAllocator.SubPageNames:= SubPageNames;
   AllocatePages;
   DoLog(SWritingPages, [PageCount]);
 

utils/fpdoc/dw_dxml.pp

@@ -12,7 +12,7 @@ type
   { TXMLWriter }
 
   TDXMLWriter = class(TFPDocWriter)
-    procedure WriteDoc; override;
+    procedure DoWriteDocumentation; override;
   end;
 
   { TDocumentation }
@@ -472,7 +472,7 @@ end;
 
 { TXMLWriter }
 
-procedure TDXMLWriter.WriteDoc;
+procedure TDXMLWriter.DoWriteDocumentation;
 var
   i: integer;
 begin

utils/fpdoc/dw_html.pp

@@ -67,7 +67,6 @@ type
     procedure FinishElementPage(AElement: TPasElement);virtual;
     procedure AppendFooter;virtual;
 
-
     procedure AppendClassMemberListLink(aClass: TPasClassType; ParaEl: TDomElement; AListSubpageIndex: Integer; const AText: DOMString);virtual;
     procedure CreateClassMainPage(aClass: TPasClassType);virtual;
     procedure CreateClassInheritanceSubpage(aClass: TPasClassType; AFilter: TMemberFilter);virtual;
@@ -97,6 +96,9 @@ type
     procedure CreateProcPageBody(AProc: TPasProcedureBase);
     Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
     procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
+    //  Main documentation process
+    Procedure DoWriteDocumentation; override;
+
     Property HeaderHTML : TStringStream Read FHeaderHTML;
     Property NavigatorHTML : TStringStream read FNavigatorHTML;
     Property FooterHTML : TStringStream read FFooterHTML;
@@ -104,7 +106,7 @@ type
     Property HeadElement : TDomElement Read FHeadElement;
     Property TitleElement: TDOMElement Read FTitleElement;
   public
-    // Creating all module hierarchy classes is here !!!!
+    // Creating all module hierarchy classes happens here !
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     // Overrides
     Class Function FileNameExtension : String; override;
@@ -112,7 +114,6 @@ type
     Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
 
     Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
-    Procedure WriteDoc; override;
 
     // Single-page generation
     function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; virtual;
@@ -129,7 +130,7 @@ type
 
 implementation
 
-uses SysUtils, HTMWrite, fpdocclasstree;
+uses fpdocstrs, SysUtils, HTMWrite, fpdocclasstree;
 
 {$i css.inc}
 {$i plusimage.inc}
@@ -207,7 +208,8 @@ begin
   PageDoc.Free;
 end;
 
-procedure THTMLWriter.WriteDoc;
+procedure THTMLWriter.DoWriteDocumentation;
+
 
 begin
   Inherited;
@@ -338,6 +340,8 @@ function THTMLWriter.AppendProcType(CodeEl, TableEl: TDOMElement;
 var
   i: Integer;
   Arg: TPasArgument;
+  S : String;
+
 begin
   if Element.Args.Count > 0 then
   begin
@@ -347,12 +351,9 @@ begin
     begin
       Arg := TPasArgument(Element.Args[i]);
       CodeEl := CreateIndentedCodeEl(Indent + 2);
-
-      case Arg.Access of
-        argConst: AppendKw(CodeEl, 'const ');
-        argVar: AppendKw(CodeEl, 'var ');
-        argOut: AppendKw(CodeEl, 'out ');
-      end;
+      S:=AccessNames[Arg.Access];
+      if (S<>'') then
+        AppendKw(CodeEl,S);
       AppendText(CodeEl, Arg.Name);
       if Assigned(Arg.ArgType) then
       begin
@@ -1758,12 +1759,25 @@ procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
     AppendSym(CodeEl, '>');
   end;
 
+  procedure AppendInterfaceInfo(ACodeEl : TDomElement ; AThisClass: TPasClassType);
+  var
+    i:Integer;
+    ThisInterface:TPasClassType;
+  begin
+  if Assigned(AThisClass) and (AThisClass.Interfaces.count>0) then
+    begin
+      for i:=0 to AThisClass.interfaces.count-1 do
+        begin
+          ThisInterface:=TPasClassType(AThisClass.Interfaces[i]);
+          AppendText(ACodeEl,',');
+          AppendHyperlink(ACodeEl, ThisInterface);
+        end;
+    end;
+  end;
 
 var
   ParaEl,TableEl, TREl, TDEl, CodeEl: TDOMElement;
-  i: Integer;
-  ThisInterface,
-  ThisClass: TPasClassType;
+  ThisClass, PrevClass: TPasClassType;
   ThisTreeNode: TPasElementNode;
 begin
   //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
@@ -1794,32 +1808,36 @@ begin
   AppendText(CodeEl, ' ');
   AppendKw(CodeEl, UTF8Decode(ObjKindNames[AClass.ObjKind]));
 
+  // Now we are using only TreeClass for show inheritance
+
+  ThisClass := AClass; ThisTreeNode := Nil;
+  if AClass.ObjKind = okInterface then
+    ThisTreeNode := TreeInterface.GetPasElNode(AClass)
+  else
+    ThisTreeNode := TreeClass.GetPasElNode(AClass);
+  if not Assigned(ThisTreeNode) Then
+    DoLog('EROOR Tree Class information: '+ThisClass.PathName);
+
   if Assigned(AClass.AncestorType) then
   begin
     AppendSym(CodeEl, '(');
+    // Show parent class information
+    //TODO: Specialized generic classes is not processed now.
+    //      TLazFixedRoundBufferListMemBase as example
     AppendHyperlink(CodeEl, AClass.AncestorType);
-    if AClass.Interfaces.count>0 Then
-      begin
-        for i:=0 to AClass.interfaces.count-1 do
-         begin
-           AppendSym(CodeEl, ', ');
-           AppendHyperlink(CodeEl,TPasClassType(AClass.Interfaces[i]));
-         end;
-      end;
+    AppendInterfaceInfo(CodeEl, AClass);
     AppendSym(CodeEl, ')');
   end;
+  // Class members
   CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
 
   AppendText(CreateH2(ContentElement), UTF8Decode(SDocInheritance));
   TableEl := CreateTable(ContentElement);
 
-  // Now we are using only TreeClass for show inheritance
+  // Process tree class information
+  // First tree class link is to This class
+  PrevClass:= nil;
 
-  ThisClass := AClass; ThisTreeNode := Nil;
-  if AClass.ObjKind = okInterface then
-    ThisTreeNode := TreeInterface.GetPasElNode(AClass)
-  else
-    ThisTreeNode := TreeClass.GetPasElNode(AClass);
   while True do
   begin
     TREl := CreateTR(TableEl);
@@ -1828,23 +1846,10 @@ begin
     CodeEl := CreateCode(CreatePara(TDEl));
 
     // Show class item
-    if Assigned(ThisClass) Then
-      AppendHyperlink(CodeEl, ThisClass);
-    //else
-    //  AppendHyperlink(CodeEl, ThisTreeNode);
-    // Show links to class interfaces
-    if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
-      begin
-        for i:=0 to ThisClass.interfaces.count-1 do
-          begin
-            ThisInterface:=TPasClassType(ThisClass.Interfaces[i]);
-            AppendText(CodeEl,',');
-            AppendHyperlink(CodeEl, ThisInterface);
-          end;
-      end;
-    // short class description
-    if Assigned(ThisClass) then
-          AppendShortDescrCell(TREl, ThisClass);
+    AppendHyperlink(CodeEl, ThisClass);
+    if Assigned(PrevClass) then // Interfaces from prevClass
+      AppendInterfaceInfo(CodeEl, PrevClass);
+    AppendShortDescrCell(TREl, ThisClass);
 
     if Assigned(ThisTreeNode) then
       if Assigned(ThisTreeNode.ParentNode) then
@@ -1852,6 +1857,7 @@ begin
         TDEl := CreateTD(CreateTR(TableEl));
         TDEl['align'] := 'center';
         AppendText(TDEl, '|');
+        PrevClass:= ThisClass;
         ThisClass := ThisTreeNode.ParentNode.Element;
         ThisTreeNode := ThisTreeNode.ParentNode;
       end
@@ -1859,6 +1865,7 @@ begin
       begin
         ThisClass := nil;
         ThisTreeNode:= nil;
+        PrevClass:= nil;
         break;
       end
     else

utils/fpdoc/dw_ipflin.pas

@@ -151,7 +151,7 @@ type
 implementation
 
 uses
-  SysUtils, dwriter;
+  fpdocstrs, SysUtils, dwriter;
 
 
 { TFPDocWriter overrides }

utils/fpdoc/dw_latex.pp

@@ -30,7 +30,7 @@ Procedure CreateLaTeXDocForPackage(APackage: TPasPackage; AEngine: TFPDocEngine)
 
 implementation
 
-uses SysUtils, Classes, dwLinear, dwriter;
+uses fpdocstrs, SysUtils, Classes, dwLinear, dwriter;
 
 
 Type
@@ -638,7 +638,7 @@ var
 begin
   Writer := TLaTeXWriter.Create(APackage, AEngine);
   try
-    Writer.WriteDoc;
+    Writer.DoWriteDocumentation;
   finally
     Writer.Free;
   end;

utils/fpdoc/dw_linrtf.pp

@@ -28,7 +28,7 @@ Procedure CreateRTFDocForPackage(APackage: TPasPackage; AEngine: TFPDocEngine);
 
 implementation
 
-uses SysUtils, Classes, dwLinear, dwriter;
+uses fpdocstrs, SysUtils, Classes, dwLinear, dwriter;
 
 const
   Indent = 300;
@@ -782,7 +782,7 @@ var
 begin
   Writer := TRTFWriter.Create(APackage, AEngine);
   try
-    Writer.WriteDoc;
+    Writer.DoWriteDocumentation;
   finally
     Writer.Free;
   end;

utils/fpdoc/dw_man.pp

@@ -99,9 +99,10 @@ Type
     Procedure WriteExampleFile(FN : String); virtual;
     procedure WriteExample(ADocNode: TDocNode);
     procedure WriteSeeAlso(ADocNode: TDocNode; Comma : Boolean);
+    // Here we write the documentation.
+    procedure DoWriteDocumentation; override;
   Public
     Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
-    procedure WriteDoc; override;
     // Documentation writing methods.
     // Package
     Procedure WritePackagePage;
@@ -185,6 +186,8 @@ Type
 
 implementation
 
+uses fpdocstrs;
+
 { TManWriter }
 
 constructor TManWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
@@ -968,7 +971,7 @@ end;
   Actual man page writing
   ---------------------------------------------------------------------}
 
-procedure TManWriter.WriteDoc;
+procedure TManWriter.DoWriteDocumentation;
 
 var
   i : Integer;

utils/fpdoc/dw_markdown.pp

@@ -116,6 +116,8 @@ type
     procedure CreateClassMemberPageBody(AElement: TPasElement); virtual;
     procedure CreateInheritanceSubpage(aClass: TPasClassType; aTitle : string; AFilter: TMemberFilter); virtual;
     procedure CreateSortedSubpage(ACLass: TPasClassType; aTitle : string; AFilter: TMemberFilter ); virtual;
+    //  Here we write the documentation
+    Procedure DoWriteDocumentation; override;
   public
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     destructor Destroy; override;
@@ -126,7 +128,6 @@ type
     // Start producing html complete package documentation
 
     Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
-    Procedure WriteDoc; override;
     Class Function FileNameExtension : String; override;
     class procedure Usage(List: TStrings); override;
     Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
@@ -142,7 +143,7 @@ type
 
 implementation
 
-uses SysUtils, fpdocclasstree;
+uses fpdocstrs, SysUtils, fpdocclasstree;
 
 
 Function FixHTMLpath(S : String) : STring;
@@ -300,9 +301,7 @@ begin
     end;
 end;
 
-
-
-procedure TMarkdownWriter.WriteDoc;
+procedure TMarkdownWriter.DoWriteDocumentation;
 
 begin
   Inherited;
@@ -310,7 +309,6 @@ begin
     WriteMkdocsYaml;
 end;
 
-
 function TMarkdownWriter.GetFooterMarkDown: TStrings;
 begin
   If FFooterMarkDown=Nil then
@@ -650,6 +648,7 @@ procedure TMarkdownWriter.AppendSeeAlsoSection(AElement: TPasElement; DocNode: T
       else
         N:='?';
       DoLog(SErrUnknownLinkID, [s,N,aID]);
+      LinkUnresolvedInc();
       end ;
      if doBold then
        DescrBeginBold

utils/fpdoc/dw_txt.pp

@@ -28,7 +28,7 @@ Procedure CreateTxtDocForPackage(APackage: TPasPackage; AEngine: TFPDocEngine);
 
 implementation
 
-uses SysUtils, Classes, dwLinear;
+uses fpdocstrs, SysUtils, Classes, dwLinear;
 
 Const
   MaxListLevel     = 10;
@@ -603,7 +603,7 @@ var
 begin
   Writer := TTxtWriter.Create(APackage, AEngine);
   try
-    Writer.WriteDoc;
+    Writer.DoWriteDocumentation;
   finally
     Writer.Free;
   end;

utils/fpdoc/dw_xml.pp

@@ -38,10 +38,11 @@ Type
     procedure AllocatePackagePages; override;
     procedure AllocateModulePages(AModule: TPasModule; {%H-}LinkList: TObjectList); override;
     procedure WriteDocPage(const aFileName: String; aElement: TPasElement; {%H-}aSubPageIndex: Integer); override;
+    //  Here we write the documentation.
+    Procedure DoWriteDocumentation; override;
   public
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
-    Procedure WriteDoc; override;
     class procedure Usage(List: TStrings); override;
     function  InterPretOption(const Cmd,Arg : String): boolean; override;
   end;
@@ -61,6 +62,8 @@ Type
 
 implementation
 
+uses fpdocstrs;
+
 const
   DefaultVisibility = [visDefault, visPublic, visPublished, visProtected];
 
@@ -108,6 +111,8 @@ var
       visAutomated       : Result := 'automated';
       visStrictPrivate   : Result := 'strictprivate';
       visStrictProtected : Result := 'strictprotected';
+      visRequired        : Result := 'required';
+      visOptional        : Result := 'optional';
     end;
   end;
 
@@ -629,9 +634,9 @@ end;
 
 { TXMLWriter }
 
-procedure TXMLWriter.WriteDoc;
+procedure TXMLWriter.DoWriteDocumentation;
 begin
-  inherited WriteDoc;
+  inherited DoWriteDocumentation;
 end;
 
 function TXMLWriter.CreateAllocator: TFileAllocator;

utils/fpdoc/dwlinear.pp

@@ -89,11 +89,12 @@ Type
     Property LastURL : DomString Read FLastURL Write FLastURL;
     // Overriden from fpdocwriter;
     procedure DescrWriteText(const AText: DOMString); override;
+    // Actual writing happens here.
+    Procedure DoWriteDocumentation; override;
   Public
     Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     function InterpretOption(const Cmd, Arg: String): Boolean; override;
     class procedure Usage(List: TStrings); override;
-    procedure WriteDoc; override;
     // Linear Documentation writing methods.
     Procedure ProcessPackage;
     Procedure ProcessTopics(DocNode : TDocNode; Alevel : Integer);
@@ -121,6 +122,8 @@ Type
 
 implementation
 
+uses fpdocstrs;
+
 const
   cDupLinkedDocParam = '--duplinkeddoc';
 
@@ -591,7 +594,7 @@ begin
     Result := '<nil>';
 end;
 
-procedure TLinearWriter.WriteDoc;
+procedure TLinearWriter.DoWriteDocumentation;
 
 var
   i : Integer;

utils/fpdoc/dwriter.pp

@@ -27,31 +27,6 @@ interface
 
 uses Classes, DOM, contnrs, dGlobals, PasTree, SysUtils, fpdocclasstree;
 
-resourcestring
-  SErrFileWriting = 'An error occurred during writing of file "%s": %s';
-
-  SErrInvalidShortDescr = 'Invalid short description';
-  SErrInvalidDescr = 'Invalid description (illegal XML element: "%s")';
-  SErrInvalidParaContent = 'Invalid paragraph content';
-  SErrInvalidElementInList = 'Invalid element in list - only "li" allowed';
-  SErrInvalidListContent = 'Invalid list content';
-  SErrInvalidRemarkContent = 'Invalid <remark> content (illegal XML element: "%s")';
-  SErrListIsEmpty = 'List is empty - need at least one "li" element';
-  SErrInvalidDefinitionTermContent = 'Invalid content in definition term';
-  SErrDefinitionEntryMissing = 'Definition entry after definition term is missing';
-  SErrInvalidBorderValue = 'Invalid "border" value for %s';
-  SErrInvalidTableContent = 'Invalid table content';
-  SErrTableRowEmpty = 'Table row is empty (no "td" elements found)';
-  SErrInvalidContentBeforeSectionTitle = 'Invalid content before section title';
-  SErrSectionTitleExpected = 'Section title ("title" element) expected';
-
-  SErrDescrTagUnknown = 'Warning: Unknown tag "%s" in description';
-  SErrUnknownEntityReference = 'Warning: Unknown entity reference "&%s;" found';
-  SErrUnknownLinkID = 'Warning: Target ID of <link> in unit "%s", element "%s", is unknown: "%s"';
-  SErrUnknownPrintShortID = 'Warning: Target ID of <printshort> is unknown: "%s"';
-  SErrUnknownLink = 'Could not resolve link to "%s"';
-  SErralreadyRegistered = 'Class for output format "%s" already registered';
-  SErrUnknownWriterClass = 'Unknown output format "%s"';
 
 type
   // Phony element for pas pages.
@@ -116,6 +91,7 @@ type
     procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
     Procedure DoLog(Const Msg : String);
     Procedure DoLog(Const Fmt : String; Args : Array of const);
+    Procedure OutputResults(); virtual;
     procedure Warning(AContext: TPasElement; const AMsg: String);
     procedure Warning(AContext: TPasElement; const AMsg: String;
       const Args: array of const);
@@ -194,6 +170,9 @@ type
     procedure DescrEndTableRow; virtual; abstract;
     procedure DescrBeginTableCell; virtual; abstract;
     procedure DescrEndTableCell; virtual; abstract;
+    procedure PrepareDocumentation; virtual;
+    // Descendents must override this.
+    procedure DoWriteDocumentation; virtual; Abstract;
 
     Property CurrentContext : TPasElement Read FContext ;
   public
@@ -209,7 +188,8 @@ type
     Class Function FileNameExtension : String; virtual;
     Class Procedure Usage(List : TStrings); virtual;
     Class procedure SplitImport(var AFilename, ALinkPrefix: String); virtual;
-    procedure WriteDoc; virtual; Abstract;
+    // Here we start the generation of documentation
+    procedure WriteDocumentation;
     Function WriteDescr(Element: TPasElement) : TDocNode;
     procedure WriteDescr(Element: TPasElement; DocNode: TDocNode);
     procedure WriteDescr(AContext: TPasElement; DescrNode: TDOMElement); virtual;
@@ -275,14 +255,21 @@ Type
     FCurDirectory: String;
     FModule: TPasModule;
     FPageInfos: TFPObjectList;     // list of TPageInfo objects
+    FLinkUnresolvedCnt: Integer;
     function GetPageCount: Integer;
 
   Protected
     FAllocator: TFileAllocator;
-    function ResolveLinkID(const Name: String; Level: Integer=0): DOMString;
+    Procedure LinkUnresolvedInc();
+    // General resolving routine
+    function ResolveLinkID(const Name: String): DOMString;
+    // Simplified resolving routine. Excluded last path after dot
+    function ResolveLinkIDUnStrict(const Name: String): DOMString;
     function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
     function ResolveLinkWithinPackage(AElement: TPasElement; ASubpageIndex: Integer): String;
-    Function CreateAllocator : TFileAllocator; virtual; abstract;
+    procedure PrepareDocumentation; override;
+    function CreateAllocator() : TFileAllocator; virtual; abstract;
+    Procedure OutputResults(); override;
     // aFileName is the filename allocated by the Allocator, nothing prefixed.
     procedure WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer); virtual; abstract;
     procedure AllocatePages; virtual;
@@ -297,12 +284,14 @@ Type
     function GetFileBaseDir(aOutput: String): String; virtual;
     function InterPretOption(const Cmd, Arg: String): boolean; override;
     function  ModuleHasClasses(AModule: TPasModule): Boolean;
+    // Allocate pages etc.
+    Procedure DoWriteDocumentation; override;
+
     Property PageInfos : TFPObjectList Read FPageInfos;
     Property SubPageNames: Boolean Read FSubPageNames;
   Public
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     Destructor Destroy; override;
-    procedure WriteDoc; override;
     class procedure Usage(List: TStrings); override;
     property PageCount: Integer read GetPageCount;
     Property Allocator : TFileAllocator Read FAllocator;
@@ -339,6 +328,8 @@ function SortPasElements(Item1, Item2: Pointer): Integer;
 
 implementation
 
+uses fpdocstrs;
+
 function SortPasElements(Item1, Item2: Pointer): Integer;
 begin
   Result:=CompareText(TPasElement(Item1).Name,TPasElement(Item2).Name)
@@ -412,6 +403,7 @@ begin
   inherited Create(APackage, AEngine);
   FPageInfos:=TFPObjectList.Create;
   FSubPageNames:= False;
+  FLinkUnresolvedCnt:=0;
 end;
 
 destructor TMultiFileDocWriter.Destroy;
@@ -426,8 +418,18 @@ begin
   Result := PageInfos.Count;
 end;
 
-function TMultiFileDocWriter.ResolveLinkID(const Name: String; Level : Integer = 0): DOMString;
+procedure TMultiFileDocWriter.OutputResults();
+begin
+  DoLog('Unresolved links: %d', [FLinkUnresolvedCnt]);
+  inherited OutputResults();
+end;
 
+procedure TMultiFileDocWriter.LinkUnresolvedInc();
+begin
+  Inc(FLinkUnresolvedCnt);
+end;
+
+function TMultiFileDocWriter.ResolveLinkID(const Name: String): DOMString;
 var
   res,s: String;
 
@@ -435,16 +437,46 @@ begin
   res:=Engine.ResolveLink(Module,Name, True);
   // engine can return backslashes on Windows
   if Length(res) > 0 then
-   begin
-     s:=Copy(Res, 1, Length(CurDirectory) + 1);
+  begin
+    s:=Copy(Res, 1, Length(CurDirectory) + 1);
     if (S= CurDirectory + '/') or (s= CurDirectory + '\') then
-      Res := Copy(Res, Length(CurDirectory) + 2, Length(Res))
+    begin
+      // TODO: I didn`t see a call to this code on a processing the lcl ana lazutil. What is that?
+      Res := Copy(Res, Length(CurDirectory) + 2, Length(Res));
+      //writeLn('INFO: ResolveLinkID "\" - ', Res);
+    end
     else if not IsLinkAbsolute(Res) then
       Res := BaseDirectory + Res;
-   end;
+  end;
   Result:=UTF8Decode(Res);
 end;
 
+function TMultiFileDocWriter.ResolveLinkIDUnStrict(const Name: String
+  ): DOMString;
+var
+  idDot, idLast: Integer;
+  res: String;
+begin
+  res:=Engine.ResolveLink(Module,Name, True);
+  if res = '' then
+  begin
+    // do simplify on one level from end.
+    // TOCO: I want to move that code to last check of Engine.ResolveLink() for not Strict
+    IdDot:= Pos('.', Name);
+    IdLast:= 0;
+    // search last dot
+    while idDot > 0 do
+    begin
+      IdLast:= idDot;
+      IdDot:= Pos('.', Name, IdLast+1);
+    end;
+    if idLast > 0 then
+      // have cut last element
+      res:= Engine.ResolveLink(Module, Copy(Name, 1, IdLast-1), True);
+  end;
+  Result:=UTF8Decode(res);
+end;
+
 { Used for:
   - <link> elements in descriptions
   - "see also" entries
@@ -482,8 +514,15 @@ begin
     SetLength(Result, 0);
 end;
 
+procedure TMultiFileDocWriter.PrepareDocumentation;
+begin
+  inherited PrepareDocumentation;
+  FAllocator:= CreateAllocator();
+  FAllocator.SubPageNames:= SubPageNames;
+end;
 
-Function TMultiFileDocWriter.AddPage(AElement: TPasElement; ASubpageIndex: Integer) : TPageInfo;
+function TMultiFileDocWriter.AddPage(AElement: TPasElement;
+  ASubpageIndex: Integer): TPageInfo;
 
 begin
   Result:= TPageInfo.Create(aElement,aSubPageIndex);
@@ -531,7 +570,7 @@ begin
 end;
 
 
-Function TMultiFileDocWriter.ModuleHasClasses(AModule: TPasModule) : Boolean;
+function TMultiFileDocWriter.ModuleHasClasses(AModule: TPasModule): Boolean;
 
 begin
   result:=assigned(AModule)
@@ -574,7 +613,8 @@ begin
     end;
 end;
 
-Procedure TMultiFileDocWriter.AllocateClassMemberPages(AModule: TPasModule; LinkList : TObjectList);
+procedure TMultiFileDocWriter.AllocateClassMemberPages(AModule: TPasModule;
+  LinkList: TObjectList);
 var
   i, j, k: Integer;
   ClassEl: TPasClassType;
@@ -738,7 +778,7 @@ begin
     Result:=IncludeTrailingPathDelimiter(Result);
 end;
 
-procedure TMultiFileDocWriter.WriteDoc;
+procedure TMultiFileDocWriter.DoWriteDocumentation;
 
   procedure CreatePath(const AFilename: String);
 
@@ -771,8 +811,6 @@ var
   FinalFilename: String;
 
 begin
-  FAllocator:=CreateAllocator;
-  FAllocator.SubPageNames:= SubPageNames;
   AllocatePages;
   DoLog(SWritingPages, [PageCount]);
   if Engine.Output <> '' then
@@ -1065,8 +1103,8 @@ begin
   FPackage := APackage;
   FTopics:=Tlist.Create;
   FImgExt:='.png';
-  TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass);
-  TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface);
+  TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okWithFields);
+  TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, [okInterface]);
   CreateClassTree;
 end;
 
@@ -1129,6 +1167,13 @@ begin
     end;
 end;
 
+procedure TFPDocWriter.WriteDocumentation;
+begin
+  PrepareDocumentation();
+  DoWriteDocumentation();
+  OutputResults();
+end;
+
 function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
 
 Var
@@ -1152,6 +1197,11 @@ begin
   DoLog('%s : No support for images yet: %s (caption: "%s")',[ClassName,AFileName,ACaption]);
 end;
 
+procedure TFPDocWriter.PrepareDocumentation;
+begin
+  // Ancestors can call AllocatePages();CreateAllocator(); into base class
+end;
+
 { ---------------------------------------------------------------------
   Generic documentation node conversion
   ---------------------------------------------------------------------}
@@ -1509,6 +1559,11 @@ begin
   DoLog(Format(Fmt,Args));
 end;
 
+procedure TFPDocWriter.OutputResults();
+begin
+  DoLog('Documentation process finished.');
+end;
+
 function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
   Node: TDOMNode): Boolean;
 begin
@@ -1722,8 +1777,8 @@ begin
   if Node.NodeType <> ELEMENT_NODE then
   begin
     if Node.NodeType = TEXT_NODE then
-	  Result := IsWhitespaceNode(TDOMText(Node))
-	else  
+      Result := IsWhitespaceNode(TDOMText(Node))
+    else
       Result := Node.NodeType = COMMENT_NODE;
     exit;
   end;

utils/fpdoc/fpclasschart.pp

@@ -42,7 +42,7 @@ type
     FTree : TClassTreeBuilder;
     FObjects : TStringList;
   public
-    Constructor Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
+    Constructor Create(AClassTree : TXMLDocument; AObjectKindSet : TPasObjKindSet);
     Destructor Destroy; override;
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility :TPasMemberVisibility;
@@ -442,14 +442,12 @@ begin
     end;
 end;
 
-Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
-
-
+Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKindSet : TPasObjKindSet);
 begin
+  Inherited Create;
   FPackage:=TPasPackage.Create('dummy',Nil);
-  FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKind);
+  FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKindSet);
   FObjects:=TStringList.Create;
-  Inherited Create;
 end;
 
 destructor TClassTreeEngine.Destroy;
@@ -538,11 +536,13 @@ Var
   end;
 
 begin
+  Result:= 0;
   aSrc:=TXMLDocument.Create();
   try
     aSrc.AppendChild(aSrc.CreateElement('TObject'));
     AppendChildClasses(aSrc.DocumentElement,aRootNode);
     MergeTrees(Dest,aSrc);
+    Inc(Result);
   finally
     aSrc.Free;
   end;
@@ -578,7 +578,7 @@ begin
       end;
     For I:=0 to InputFiles.Count-1 do
       begin
-      Engine := TClassTreeEngine.Create(XML,AObjectKind);
+      Engine := TClassTreeEngine.Create(XML,[AObjectKind]);
       Try
         ParseSource(Engine,InputFiles[I],OSTarget,CPUTarget);
         Engine.Ftree.BuildTree(Engine.FObjects);

utils/fpdoc/fpdoc.lpi

@@ -8,6 +8,7 @@
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
         <CompatibilityMode Value="True"/>
@@ -46,7 +47,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="20">
+    <Units Count="21">
       <Unit0>
         <Filename Value="fpdoc.pp"/>
         <IsPartOfProject Value="True"/>
@@ -134,6 +135,10 @@
         <Filename Value="dw_basehtml.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit19>
+      <Unit20>
+        <Filename Value="fpdocstrs.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit20>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -143,13 +148,22 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../packages/fcl-passrc/src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>
       <Debugging>
         <DebugInfoType Value="dsDwarf3"/>
+        <UseHeaptrc Value="True"/>
       </Debugging>
     </Linking>
+    <Other>
+      <CustomOptions Value="-dCheckPasTreeRefCount
+-dDebugRefCount"/>
+      <OtherDefines Count="1">
+        <Define0 Value="CheckPasTreeRefCount"/>
+      </OtherDefines>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

utils/fpdoc/fpdoc.pp

@@ -37,7 +37,7 @@ uses
   dw_man,    // Man page writer
   dw_linrtf, // linear RTF writer
   dw_txt,    // TXT writer
-  fpdocproj, mkfpdoc, dw_basemd, dw_basehtml;
+  fpdocproj, mkfpdoc, dw_basemd, dw_basehtml, fpdocstrs;
 
 
 Type
@@ -101,9 +101,14 @@ begin
   Writeln(SUsageOption190);
   Writeln(SUsageOption200);
   Writeln(SUsageOption210);
+  Writeln(SUsageOption211);
+  Writeln(SUsageOption212);
   Writeln(SUsageOption215);
   Writeln(SUsageOption215A);
   Writeln(SUsageOption220);
+  Writeln(SUsageOption221);
+  Writeln(SUsageOption222);
+  Writeln(SUsageOption223);
   Writeln(SUsageOption230);
   Writeln(SUsageOption240);
   Writeln(SUsageOption250);
@@ -151,7 +156,11 @@ end;
 
 procedure TFPDocApplication.ExceptProc(Sender: TObject; E: Exception);
 begin
+  OutputLog(Sender, Format('Exception: Class - %s', [E.ClassName]));
+  OutputLog(Sender, E.Message);
+{$IFDEF EXCEPTION_STACK}
   OutputLog(Sender, DumpExceptionCallStack(E));
+{$ENDIF}
 end;
 
 destructor TFPDocApplication.Destroy;
@@ -305,8 +314,16 @@ begin
     Usage(0)
   else if s = '--hide-protected' then
     FCreator.Options.HideProtected := True
+  else if s = '--fallback-seealso-links' Then
+   FCreator.Options.FallBackSeeAlsoLinks := True
   else if s = '--warn-no-node' then
     FCreator.Options.WarnNoNode := True
+  else if s = '--warn-documentation-empty' then
+    FCreator.Options.WarnDocumentationEmpty := True
+  else if s = '--info-used-file' then
+    FCreator.Options.InfoUsedFile := True
+  else if s = '--warn-XCT' then
+    FCreator.Options.WarnXCT := True
   else if s = '--show-private' then
     FCreator.Options.ShowPrivate := True
   else if s = '--stop-on-parser-error' then
@@ -430,15 +447,15 @@ end;
 constructor TFPDocApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  StopOnException:=true;
+  StopOnException:=false;
   FCreator:=TFPDocCreator.Create(Self);
   FCreator.OnLog:=@OutputLog;
   OnException:= @ExceptProc;
 end;
 
 begin
-  //AssignFile(Output, 'fpdoc.log');
-  //rewrite(Output);
+  //AssignFile(StdErr, 'fpdoc_err.log');
+  //rewrite(StdErr);
   With TFPDocApplication.Create(Nil) do
     try
       Run;

utils/fpdoc/fpdocclasstree.pp

@@ -2,6 +2,7 @@ unit fpdocclasstree;
 
 {$mode objfpc}{$H+}
 
+
 interface
 
 uses
@@ -9,6 +10,8 @@ uses
 
 Type
 
+  TPasObjKindSet = set of TPasObjKind;
+
   { TPasElementNode }
 
   TPasElementNode = Class
@@ -35,7 +38,7 @@ Type
   Private
     FEngine:TFPDocEngine;
     FElementList : TFPObjectHashTable;
-    FObjectKind : TPasObjKind;
+    FObjectKind : TPasObjKindSet;
     FPackage: TPasPackage;
     FParentObject : TPasClassType;
     FRootNode : TPasElementNode;
@@ -45,7 +48,7 @@ Type
     function AddToList(aElement: TPasClassType): TPasElementNode;
   Public
     Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
-                          AObjectKind : TPasObjKind = okClass);
+                          AObjectKind : TPasObjKindSet = okWithFields);
     Destructor Destroy; override;
     Function BuildTree(AObjects : TStringList) : Integer;
     Procedure SaveToXml(AFileName: String);
@@ -56,6 +59,9 @@ Type
 
 implementation
 
+uses
+  fpdocstrs, pasresolver;
+
 { TPasElementNode }
 
 function SortOnElementName(Item1, Item2: Pointer): Integer;
@@ -104,33 +110,36 @@ begin
 end;
 
 constructor TClassTreeBuilder.Create(AEngine:TFPDocEngine; APackage : TPasPackage;
-  AObjectKind: TPasObjKind);
+  AObjectKind: TPasObjKindSet);
 
 begin
   FEngine:= AEngine;
   FPackage:= APAckage;
   FObjectKind:=AObjectKind;
-  Case FObjectkind of
-    okInterface :
+  if (okInterface in FObjectkind) then
       begin
         FRootObjectPathName:='#rtl.System.IInterface';
         FRootObjectName:= 'IInterface';
-      end;
-    okObject, okClass :
+      end
+  else if (FObjectkind * okWithFields) <> [] then
       begin
         FRootObjectPathName:='#rtl.System.TObject';
         FRootObjectName:= 'TObject';
       end
-  else
+  else  // TODO: I don`t know need it ? Without that the code may be simplified.
     begin
       FRootObjectPathName:='#rtl.System.TObject';
       FRootObjectName:= 'TObject';
     end;
-  end;
   FParentObject:=TPasClassType.Create(FRootObjectName,FEngine.FindModule('System'));
   if not Assigned(FParentObject) then
     FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
-  FParentObject.ObjKind:=FObjectKind;
+  if (okInterface in FObjectkind) then
+      FParentObject.ObjKind:=okInterface
+  else if (FObjectkind * okWithFields) <> [] then
+    FParentObject.ObjKind:=okClass
+  else
+    FParentObject.ObjKind:=okClass;
   FRootNode:=TPasElementNode.Create(FParentObject);
   FRootNode.FParentNode := nil;
   FElementList:=TFPObjectHashTable.Create(False);
@@ -154,7 +163,8 @@ Var
 
 begin
   Result:= nil;
-  if (aElement.ObjKind <> FObjectKind) then exit;
+  if not (aElement.ObjKind in FObjectKind) then exit;
+
   aParentNode:= nil;
   if aElement=Nil then
     aName:=FRootObjectName
@@ -227,10 +237,11 @@ procedure TClassTreeBuilder.SaveToXml ( AFileName: String );
     for CounterVar := 0 to ParentPasEl.ChildCount-1 do
     begin
       PasElNode:= ParentPasEl.Children[CounterVar];
-      xmlEl:= AXmlDoc.CreateElement(UnicodeString(PasElNode.Element.Name));
+      xmlEl:= AXmlDoc.CreateElement(UTF8Decode(PasElNode.Element.Name));
       M:= PasElNode.Element.GetModule;
-      xmlEl['unit'] := UnicodeString(M.Name);
-      xmlEl['package'] := UnicodeString(M.PackageName);
+      xmlEl['unit'] := UTF8Decode(M.Name);
+      xmlEl['package'] := UTF8Decode(M.PackageName);
+      xmlEl['type'] := UTF8Decode(GetElementTypeName(PasElNode.Element));
       ParentxmlEl.AppendChild(xmlEl);
       AddPasElChildsToXml(xmlEl, PasElNode);
     end;
@@ -244,17 +255,24 @@ begin
   XmlDoc:= TXMLDocument.Create;
   XmlDoc.AppendChild(XmlDoc.CreateComment(UTF8Decode(SDocGeneratedByComment)));
   try
-    XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
+    XmlRootEl:= XmlDoc.CreateElement(UTF8Decode(FRootNode.Element.Name));
     M:= FRootNode.Element.GetModule;
     if Assigned(M) then
     begin
-      XmlRootEl['unit'] := UnicodeString(M.Name);
-      XmlRootEl['package'] := UnicodeString(M.PackageName);
+      XmlRootEl['unit'] := UTF8Decode(M.Name);
+      XmlRootEl['package'] := UTF8Decode(M.PackageName);
+      XmlRootEl['type'] := UTF8Decode(GetElementTypeName(FRootNode.Element));
     end
       else
     begin
       XmlRootEl['unit'] := 'system';
       XmlRootEl['package'] := 'rtl';
+      if (okWithFields * FObjectKind) <> [] then
+        XmlRootEl['type'] := 'class'
+      else if (okInterface in FObjectKind) then
+        XmlRootEl['type'] := 'interface'
+      else
+        XmlRootEl['type'] := 'class';
     end;
     XmlDoc.AppendChild(XmlRootEl);
     AddPasElChildsToXml(XmlRootEl, FRootNode);

utils/fpdoc/fpdocproj.pas

@@ -55,13 +55,17 @@ Type
     FFormat: String;
     FHidePrivate: Boolean;
     FHideProtected: Boolean;
+    FFallBackSeeAlsoLinks: Boolean;
     FIO: Boolean;
     FLanguage: String;
     FMoDir: String;
     FOSTarget: String;
     FSOPE: Boolean;
+    FWarnDocumentationEmpty: Boolean;
     FWarnNoNode: Boolean;
     FDontTrim : Boolean;
+    FInfoUsedFile: Boolean;
+    FWarnXCT: Boolean;
     procedure SetBackendOptions(const AValue: TStrings);
   Public
     Constructor Create;
@@ -76,7 +80,11 @@ Type
     Property BackendOptions : TStrings Read FBackEndoptions Write SetBackendOptions;
     Property StopOnParseError : Boolean Read FSOPE Write FSOPE;
     Property HideProtected : Boolean Read FHideProtected Write FHideProtected;
+    Property FallBackSeeAlsoLinks :Boolean Read  FFallBackSeeAlsoLinks Write FFallBackSeeAlsoLinks;
     Property WarnNoNode : Boolean Read FWarnNoNode Write FWarnNoNode;
+    Property InfoUsedFile : Boolean Read FInfoUsedFile Write FInfoUsedFile;
+    Property WarnDocumentationEmpty : Boolean Read FWarnDocumentationEmpty Write FWarnDocumentationEmpty;
+    Property WarnXCT : Boolean Read FWarnXCT Write FWarnXCT;
     Property ShowPrivate : Boolean Read FHidePrivate Write FHidePrivate;
     Property InterfaceOnly : Boolean Read FIO Write FIO;
     Property MoDir : String Read FMoDir Write FMODir;
@@ -189,6 +197,9 @@ begin
     FSOPE:=O.StopOnParseError;
     HideProtected:=O.HideProtected;
     WarnNoNode:=O.WarnNoNode;
+    InfoUsedFile:=O.InfoUsedFile;
+    WarnDocumentationEmpty:=O.WarnDocumentationEmpty;
+    WarnXCT:=O.WarnXCT;
     ShowPrivate:=O.ShowPrivate;
     InterfaceOnly:=O.InterfaceOnly;
     MoDir:=O.MoDir;

utils/fpdoc/fpdocstrs.pp

@@ -0,0 +1,255 @@
+unit fpdocstrs;
+
+{$mode objfpc}{$H+}
+
+interface
+
+resourcestring
+  // Output strings
+  SDocPackageTitle           = 'Reference for package ''%s''';
+  SDocPackageMenuTitle       = 'Package ''%s''';
+  SDocPackageLinkTitle       = 'Package';
+  SDocPrograms               = 'Programs';
+  SDocUnits                  = 'Units';
+  SDocUnitTitle              = 'Reference for unit ''%s''';
+  SDocUnitMenuTitle          = 'Unit ''%s''';
+  SDocInheritanceHierarchy   = 'Inheritance Hierarchy';
+  SDocInterfaceSection       = 'Interface section';
+  SDocImplementationSection  = 'Implementation section';
+  SDocUsedUnits              = 'Used units';
+  SDocUsedUnitsByUnitXY      = 'Used units by unit ''%s''';
+  SDocConstsTypesVars        = 'Constants, types and variables';
+  SDocResStrings             = 'Resource strings';
+  SDocTypes                  = 'Types';
+  SDocType                   = 'Type';
+  SDocConstants              = 'Constants';
+  SDocConstant               = 'Constant';
+  SDocClasses                = 'Classes';
+  SDocClass                  = 'Class';
+  SDocProceduresAndFunctions = 'Procedures and functions';
+  SDocProcedureOrFunction    = 'Procedure/function';
+  SDocVariables              = 'Variables';
+  SDocVariable               = 'Variable';
+  SDocIdentifierIndex        = 'Index';
+  SDocPackageClassHierarchy  = 'Class hierarchy';
+  SDocModuleIndex            = 'Index of all identifiers in unit ''%s''';
+  SDocPackageIndex           = 'Index of all identifiers in package ''%s''';
+  SDocUnitOverview           = 'Overview of unit ''%s''';
+  SDocOverview               = 'Overview';
+  SDocSearch                 = 'Search';
+  SDocDeclaration            = 'Declaration';
+  SDocDescription            = 'Description';
+  SDocErrors                 = 'Errors';
+  SDocVersion                = 'Version info';
+  SDocSeeAlso                = 'See also';
+  SDocExample                = 'Example';
+  SDocArguments              = 'Arguments';
+  SDocFunctionResult         = 'Function result';
+  SDocRemark                 = 'Remark:   ';
+  SDocMethodOverview         = 'Method overview';
+  SDocPropertyOverview       = 'Property overview';
+  SDocEventOverview          = 'Event overview';
+  SDocInterfacesOverview     = 'Interfaces overview';
+  SDocInterface              = 'Interfaces';
+  SDocPage                   = 'Page';
+  SDocMember                 = 'Member';
+  SDocMembers                = 'Members';
+  SDocField                  = 'Field';
+  SDocMethod                 = 'Method';
+  SDocProperty               = 'Property';
+  SDocAccess                 = 'Access';
+  SDocInheritance            = 'Inheritance';
+  SDocProperties             = 'Properties';
+  SDocMethods                = 'Methods';
+  SDocEvents                 = 'Events';
+  SDocByName                 = 'by Name';
+  SDocByInheritance          = 'By inheritance';
+  SDocValue                  = 'Value';
+  SDocExplanation            = 'Explanation';
+  SDocProcedure              = 'Procedure';
+  SDocValuesForEnum          = 'Enumeration values for type %s';
+  SDocSourcePosition         = 'Source position: %s line %d';
+  SDocSynopsis               = 'Synopsis';
+  SDocVisibility             = 'Visibility';
+  SDocOpaque                 = 'Opaque type';
+  SDocDateGenerated          = 'Documentation generated on: %s';
+  // The next line requires leading/trailing space due to XML comment layout:
+  SDocGeneratedByComment     = ' Generated using FPDoc - (c) 2000-2021 FPC contributors and Sebastian Guenther, [email protected] ';
+  SDocNotes                  = 'Notes';
+  SDocName                   = 'Name';
+  SDocType_s                 = 'Type(s)';
+  SDocTopic                  = 'Topic';
+  SDocNoneAVailable          = 'No members available';
+
+  // Topics
+  SDocRelatedTopics = 'Related topics';
+  SDocUp            = 'Up';
+  SDocNext          = 'Next';
+  SDocPrevious      = 'Previous';
+
+  // Various backend constants
+  SDocChapter    = 'Chapter';
+  SDocSection    = 'Section';
+  SDocSubSection = 'Subsection';
+  SDocTable      = 'Table';
+  SDocListing    = 'Listing';
+
+  // Man page usage
+  SManUsageManSection         = 'Use ASection as the man page section';
+  SManUsageNoUnitPrefix       = 'Do not prefix man pages with unit name.';
+  SManUsageWriterDescr        = 'UNIX man page output.';
+  SManUsagePackageDescription = 'Use descr as the description of man pages';
+
+  // HTML usage
+  SHTMLUsageFooter = 'Append xhtml (@filename reads from file) as footer to html page';
+  SHTMLUsageNavigator = 'Append xhtml (@filename reads from file) in navigator bar';
+  SHTMLUsageHeader = 'Append xhtml (@filename reads from file) as header to html page below navigation bar';
+  SHTMLUsageFooterDate = 'Append footer with date. fmt is Optional format for FormatDateTime';
+  SHTMLUsageCharset = 'Set the HTML character set';
+  SHTMLHtmlSearch = 'Add search page with given name to the menu bar';
+  SHTMLIndexColcount = 'Use N columns in the identifier index pages';
+  SHTMLImageUrl = 'Prefix image URLs with url';
+  SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css';
+
+  // CHM usage
+  SCHMUsageTOC     = 'Use [File] as the table of contents. Usually a .hhc file.';
+  SCHMUsageIndex   = 'Use [File] as the index. Usually a .hhk file.';
+  SCHMUsageDefPage = 'Set the "Home" page relative to where it lives in the chm. i.e. "/index.html"';
+  SCHMUsageOtrFiles= 'A txt file containing a list of files to be added relative to the working directory.';
+  SCHMUsageCSSFile = 'Filename of a .css file to be included in the chm.';
+  SCHMUsageAutoTOC = 'Automatically generate a Table of Contents. Ignores --toc-file';
+  SCHMUsageAutoIDX = 'Automatically generate an Index. Ignores --index-file';
+  SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
+  SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
+
+  // MarkDown usage
+  SMDUsageFooter = 'Append markdown (@filename reads from file) as footer to every markdown page';
+  SMDUsageHeader = 'Prepend markdown (@filename reads from file) as header to every markdown page';
+  SMDIndexColcount = 'Use N columns in the identifier index pages';
+  SMDImageUrl = 'Prefix image URLs with url';
+  SMDTheme = 'Use name as theme name';
+  SMDNavigation = 'Use scheme for navigation tree, here scheme is one of:';
+  SMDNavSubtree = '    UnitSubTree : put all units in a sub tree of a Units node';
+  SMDNavTree =    '    UnitTree : put every units as a node on the same level as packages node';
+
+  SXMLUsageFlatStructure  = 'Use a flat output structure of XML files and directories';
+  SXMLUsageSource  = 'Include source file and line info in generated XML';
+
+  // Linear usage
+  SLinearUsageDupLinkedDocsP1 = 'Duplicate linked element documentation in';
+  SLinearUsageDupLinkedDocsP2 = 'descendant classes.';
+
+  STitle           = 'FPDoc - Free Pascal Documentation Tool';
+  SVersion         = 'Version %s [%s]';
+  SCopyright1      = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, [email protected]';
+  SCopyright2      = '(c) 2005 - 2021 various FPC contributors';
+
+  SCmdLineHelp     = 'Usage: %s [options]';
+  SUsageOption008  = '--base-descr-dir=DIR prefix all description files with this directory';
+  SUsageOption009  = '--base-input-dir=DIR prefix all input files with this directory';
+  SUsageOption010  = '--content         Create content file for package cross-references';
+  SUsageOption020  = '--cputarget=value Set the target CPU for the scanner.';
+  SUsageOption030  = '--descr=file      use file as description file, e.g.: ';
+  SUsageOption035  = '                  --descr=c:\WIP\myzipperdoc.xml';
+  SUsageOption040  = '                  This option is allowed more than once';
+  SUsageOption050  = '--descr-dir=Dir   Add All XML files in Dir to list of description files';
+  SUsageOption060  = '--format=fmt      Select output format.';
+  SUsageOption070  = '--help            Show this help.';
+  SUsageOption080  = '--hide-protected  Do not show protected methods in overview';
+  SUsageOption090  = '--import=file     Import content file for package cross-references';
+  SUsageOption100  = '--input=cmd       use cmd as input for the parser, e.g.:';
+  SUsageOption110  = '           --input=C:\fpc\packages\paszlib\src\zipper.pp';
+  SUsageOption120  = '                  At least one input option is required.';
+  SUsageOption130  = '--input-dir=Dir   Add All *.pp and *.pas files in Dir to list of input files';
+  SUsageOption140  = '--lang=lng        Select output language.';
+  SUsageOption145  = '--macro=name=value Define a macro to preprocess the project file with.';
+  SUsageOption150  = '--ostarget=value  Set the target OS for the scanner.';
+  SUsageOption160  = '--output=name     use name as the output name.';
+  SUsageOption170  = '                  Each backend interprets this as needed.';
+  SUsageOption180  = '--package=name    Set the package name for which to create output,';
+  SUsageOption190  = '                  e.g. --package=fcl';
+  SUsageOption200  = '--project=file    Use file as project file';
+  SUsageOption210  = '--show-private    Show private methods.';
+  SUsageOption211  = '--fallback-seealso-links';
+  SUsageOption212  = '                  Simplify seealso links by exluding last link level';
+  SUsageOption215  = '--stop-on-parser-error';
+  SUsageOption215A = '                  Stop when a parser error occurs. Default is to ignore parser errors.';
+  SUsageOption220  = '--warn-no-node    Warn if no documentation node was found.';
+  SUsageOption221  = '--warn-documentation-empty    Warn if documentation is empty.';
+  SUsageOption222  = '--warn-xct        Warn if an external class could not be resolved.';
+  SUsageOption223  = '--info-used-file  Output the file path of an implicitly processed file.';
+  SUsageOption230  = '--mo-dir=dir      Set directory where language files reside to dir';
+  SUsageOption240  = '--parse-impl      (Experimental) try to parse implementation too';
+  SUsageOption250  = '--dont-trim       Do not trim XML contents. Useful for preserving';
+  SUsageOption260  = '                  formatting inside e.g <pre> tags';
+  SUsageOption270  = '--write-project=file';
+  SUsageOption280  = '                  Do not write documentation, create project file instead';
+  SUsageOption290  = '--verbose         Write more information on the screen';
+  SUsageOption300  = '--dry-run         Only parse sources and XML, do not create output';
+  SUsageOption310  = '--write-project=file';
+  SUsageOption320  = '                  Write all command-line options to a project file';
+  SUsageSubNames   = 'Use the file subnames instead the indexes as postfixes';
+
+  SUsageFormats        = 'The following output formats are supported by this fpdoc:';
+  SUsageBackendHelp    = 'Specify an output format, combined with --help to get more help for this backend.';
+  SUsageFormatSpecific = 'Output format "%s" supports the following options:';
+  SCmdLineErrInvalidMacro     = 'Macro needs to be in the form name=value';
+
+  SCmdLineInvalidOption       = 'Ignoring unknown option "%s"';
+  SCmdLineInvalidFormat       = 'Invalid format "%s" specified';
+  SCmdLineOutputOptionMissing = 'Need an output filename, please specify one with --output=<filename>';
+  SWritingPages               = 'Writing %d pages...';
+  SNeedPackageName            = 'No package name specified. Please specify one using the --package option.';
+  SAvailablePackages          = 'Available packages: ';
+  SDone                       = 'Done.';
+  SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
+  SErrCouldNotCreateFile      = 'Could not create file "%s": %s';
+  SSeeURL                     = '(See %s)';      // For linear text writers.
+  SParsingUsedUnit            = 'Parsing used unit "%s" with commandLine "%s"';
+
+  SErrFileWriting = 'An error occurred during writing of file "%s": %s';
+
+  SErrInvalidShortDescr = 'Invalid short description';
+  SErrInvalidDescr = 'Invalid description (illegal XML element: "%s")';
+  SErrInvalidParaContent = 'Invalid paragraph content';
+  SErrInvalidElementInList = 'Invalid element in list - only "li" allowed';
+  SErrInvalidListContent = 'Invalid list content';
+  SErrInvalidRemarkContent = 'Invalid <remark> content (illegal XML element: "%s")';
+  SErrListIsEmpty = 'List is empty - need at least one "li" element';
+  SErrInvalidDefinitionTermContent = 'Invalid content in definition term';
+  SErrDefinitionEntryMissing = 'Definition entry after definition term is missing';
+  SErrInvalidBorderValue = 'Invalid "border" value for %s';
+  SErrInvalidTableContent = 'Invalid table content';
+  SErrTableRowEmpty = 'Table row is empty (no "td" elements found)';
+  SErrInvalidContentBeforeSectionTitle = 'Invalid content before section title';
+  SErrSectionTitleExpected = 'Section title ("title" element) expected';
+
+  SErrDescrTagUnknown = 'Warning: Unknown tag "%s" in description';
+  SErrUnknownEntityReference = 'Warning: Unknown entity reference "&%s;" found';
+  SErrUnknownLinkID = 'Warning: Target ID of <link> in unit "%s", element "%s", is unknown: "%s"';
+  SErrUnknownPrintShortID = 'Warning: Target ID of <printshort> is unknown: "%s"';
+  SErrUnknownLink = 'Could not resolve link to "%s"';
+  SErralreadyRegistered = 'Class for output format "%s" already registered';
+  SErrUnknownWriterClass = 'Unknown output format "%s"';
+
+  SErrCannotChangeIndentSizeWhenIndented = 'Cannot change indent size while text is indented.';
+  SErrIndentMismatch = 'Indent mismatch: trying to undent when current indent too small';
+  SErrNotInList = 'Not in list';
+  SErrPopListStack = 'Pop list stack list type mismatch';
+  SErrMinListStack = 'Min list stack reached';
+  SErrMaxListStack = 'Max list stack reached';
+  SErrMinIndentStack = 'Min indent stack reached';
+  SErrMaxIndentStack = 'Max indent stack reached';
+
+  // doc xml
+  SErrInvalidRootNode = 'Invalid options root node: Got "%s", expected "docproject"';
+  SErrNoPackagesNode = 'No "packages" node found in docproject';
+  SErrNoInputFile = 'unit tag without file attribute found';
+  SErrNoDescrFile = 'description tag without file attribute';
+  SErrNoImportFile = 'Import tag without file attribute';
+  SErrNoImportPrefix = 'Import tag without prefix attribute';
+
+implementation
+
+end.
+

utils/fpdoc/fpdocxmlopts.pas

@@ -44,15 +44,8 @@ Const
 
 implementation
 
-Uses XMLRead, XMLWrite;
-
-Resourcestring
-  SErrInvalidRootNode = 'Invalid options root node: Got "%s", expected "docproject"';
-  SErrNoPackagesNode = 'No "packages" node found in docproject';
-  SErrNoInputFile = 'unit tag without file attribute found';
-  SErrNoDescrFile = 'description tag without file attribute';
-  SErrNoImportFile = 'Import tag without file attribute';
-  SErrNoImportPrefix = 'Import tag without prefix attribute';
+Uses fpdocstrs, XMLRead, XMLWrite;
+
 
 { TXMLFPDocOptions }
 

utils/fpdoc/fpmake.pp

@@ -42,6 +42,7 @@ begin
     P.Options.Add('-S2h');
 
     T:=P.Targets.AddProgram('fpdoc.pp');
+    T.Dependencies.AddUnit('fpdocstrs');
     T.Dependencies.AddUnit('dglobals');
     T.Dependencies.AddUnit('dw_ipflin');
     T.Dependencies.AddUnit('dwriter');
@@ -65,17 +66,18 @@ begin
     T:=P.Targets.AddProgram('fpclasschart.pp');
     T.ResourceStrings:=true;
 
-    T := P.Targets.AddUnit('dglobals.pp');
+    T := P.Targets.AddUnit('fpdocstrs.pp');
     T.install:=false;
     T.ResourceStrings:=true;
 
+    T := P.Targets.AddUnit('dglobals.pp');
+    T.install:=false;
+
     T := P.Targets.AddUnit('dwriter.pp');
     T.install:=false;
-    T.ResourceStrings:=true;
 
     T := P.Targets.AddUnit('fpdocxmlopts.pas');
     T.install:=false;
-    T.ResourceStrings:=true;
 
     P.Targets.AddUnit('dw_xml.pp').install:=false;
     P.Targets.AddUnit('sh_pas.pp').install:=false;
@@ -84,7 +86,7 @@ begin
     P.Targets.AddUnit('dw_markdown.pp').install:=false;
     T:=P.Targets.AddUnit('dw_latex.pp');
     T.install:=false;
-    T.ResourceStrings:=true;
+
     P.Targets.AddUnit('dw_txt.pp').install:=false;
     P.Targets.AddUnit('dw_man.pp').install:=false;
     P.Targets.AddUnit('dwlinear.pp').install:=false;

utils/fpdoc/makeskel.pp

@@ -23,7 +23,7 @@ program MakeSkel;
 {$h+}
 
 uses
-  SysUtils, Classes, Gettext, dGlobals, PasTree, PParser,PScanner;
+  fpdocstrs, SysUtils, Classes, Gettext, dGlobals, PasTree, PParser,PScanner;
 
 resourcestring
   STitle = 'MakeSkel - FPDoc skeleton XML description file generator';

utils/fpdoc/mkfpdoc.pp

@@ -34,6 +34,7 @@ Type
     FProjectMacros: TStrings;
     FScannerLogEvents: TPScannerLogEvents;
     FVerbose: Boolean;
+    function GetLogLevels: TFPDocLogLevels;
     function GetOptions: TEngineOptions;
     function GetPackages: TFPDocPackages;
     procedure SetBaseDescrDir(AValue: String);
@@ -73,6 +74,7 @@ Type
 
 implementation
 
+uses fpdocstrs;
 
 { TFPDocCreator }
 
@@ -84,6 +86,9 @@ begin
     begin
     ScannerLogEvents:=[sleFile];
     ParserLogEvents:=[];
+    Options.InfoUsedFile:= true;
+    Options.WarnDocumentationEmpty:= true;
+    Options.WarnXCT:= true;
     end
   else
     begin
@@ -243,8 +248,8 @@ begin
           If not InterPretOption(Cmd,Arg) then
             DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
           end;
-      // Output created Documentation
-      WriteDoc;
+      // Create documentation by writer
+      WriteDocumentation();
     Finally
       Free;
     end;
@@ -255,6 +260,23 @@ begin
     Engine.WriteContentFile(APackage.ContentFile);
 end;
 
+Function TFPDocCreator.GetLogLevels : TFPDocLogLevels;
+
+  Procedure DoOpt(doSet : Boolean; aLevel: TFPDocLogLevel);
+
+  begin
+    if DoSet then
+      Result:=Result+[aLevel];
+  end;
+
+begin
+  Result:=[];
+  DoOpt(Options.WarnNoNode,dleWarnNoNode);
+  DoOpt(Options.InfoUsedFile,dleWarnUsedFile);
+  DoOpt(Options.WarnDocumentationEmpty,dleDocumentationEmpty);
+  DoOpt(Options.WarnXCT,dleXCT);
+end;
+
 procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage;
   ParseOnly: Boolean);
 
@@ -263,7 +285,7 @@ var
   Engine : TFPDocEngine;
   Cmd,Arg : String;
   WriterClass: TFPDocWriterClass;
-
+  eMsg: String;
 begin
   Cmd:='';
   FCurPackage:=APackage;
@@ -291,35 +313,53 @@ begin
     Engine.HideProtected:=Options.HideProtected;
     Engine.HidePrivate:=Not Options.ShowPrivate;
     Engine.OnParseUnit:=@HandleOnParseUnit;
-    Engine.WarnNoNode:=Options.WarnNoNode;
+    Engine.DocLogLevels:=GetLogLevels;
+    Engine.FalbackSeeAlsoLinks:= Options.FallBackSeeAlsoLinks;
     if Length(Options.Language) > 0 then
       TranslateDocStrings(Options.Language);
     // scan the input source files
     for i := 0 to APackage.Inputs.Count - 1 do
       try
-        // get options from input packages
-        SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
-        arg:=Arg+' -d'+Options.EndianNess;
-        // make absolute filepath
-        Cmd:=FixInputFile(Cmd);
-        if FProcessedUnits.IndexOf(Cmd)=-1 then
+        try
+          eMsg:='';
+          // get options from input packages
+          SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
+          arg:=Arg+' -d'+Options.EndianNess;
+          // make absolute filepath
+          Cmd:=FixInputFile(Cmd);
+          if FProcessedUnits.IndexOf(Cmd)=-1 then
           begin
-          FProcessedUnits.Add(Cmd);
-
-          // Parce sources for OS Target
-          //WriteLn(Format('Parsing unit: %s', [ExtractFilenameOnly(Cmd)]));
-          ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
+            FProcessedUnits.Add(Cmd);
+            // Parce sources for OS Target
+            //WriteLn(Format('Parsing unit: %s', [ExtractFilenameOnly(Cmd)]));
+            ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]); // poSkipDefaultDefs
           end;
-      except
-        on E: EParserError do
-          If Options.StopOnParseError then
-            Raise
-          else
+          //else WriteLn(Format('Processed unit: %s', [ExtractFilenameOnly(Cmd)]));
+        except
+          on E: EParserError do
             begin
-            DoLog('Error: %s(%d,%d): %s',[E.Filename, E.Row, E.Column, E.Message]);
-            DoLog('Ignoring error, continuing with next unit (if any).');
+              eMsg:= Format('Parser error: %s (%d,%d): %s',[E.Filename, E.Row, E.Column, E.Message]);
+              If Options.StopOnParseError then Raise;
             end;
-      end;
+          on E: EFileNotFoundError do
+            begin
+              eMsg:= Format('Error: file not found - %s', [E.Message]);
+              If Options.StopOnParseError then Raise;
+            end;
+          on E: Exception do
+            begin
+              eMsg:= Format('Error: %s', [E.Message]);
+              If Options.StopOnParseError then Raise;
+            end;
+        end; // try except
+      finally
+        if eMsg <> '' then
+        begin
+          DoLog(eMsg);
+          If not Options.StopOnParseError then
+            DoLog('Ignoring error, continuing with next unit (if any).');
+        end;
+      end; // try finally
     if Not ParseOnly then
       begin
       Engine.StartDocumenting;