Browse Source

Merged revisions 7253,7312,7417-7418,7545,7547-7550 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

r7253 (pierre)
* correct Read/write methods to use same parameter type as TStream ancestors

r7312 (pierre)
* more option updates

r7417 (pierre)
* avoid crash if removing several editor windows

r7418 (pierre)
+ Add GetLineCount method to TMemoryTextFile object

r7545 (pierre)
further html improvements

r7547 (pierre)
clean up DocDecodeNamedEntity

r7548 (pierre)
more DocDecodeNamedEntity cleanup

r7549 (pierre)
* Use bright forground colors for ansi files

r7550 (pierre)
* avoid debug message if DEBUG is not defined

git-svn-id: branches/fixes_2_2@7558 -

florian 18 years ago
parent
commit
6808c20cc1
6 changed files with 663 additions and 79 deletions
  1. 17 1
      ide/fpmwnd.inc
  2. 33 13
      ide/fpswitch.pas
  3. 42 18
      ide/whtml.pas
  4. 128 10
      ide/whtmlhlp.pas
  5. 434 28
      ide/whtmlscn.pas
  6. 9 9
      ide/wutils.pas

+ 17 - 1
ide/fpmwnd.inc

@@ -182,6 +182,7 @@ end;
 
 
 procedure TWindowListDialog.HandleEvent(var Event: TEvent);
 procedure TWindowListDialog.HandleEvent(var Event: TEvent);
 var W: PWindow;
 var W: PWindow;
+    KeePOwner : PGroup;
 begin
 begin
   case Event.What of
   case Event.What of
     evKeyDown :
     evKeyDown :
@@ -203,7 +204,22 @@ begin
         cmDeleteItem :
         cmDeleteItem :
           if C^.Count>0 then
           if C^.Count>0 then
           begin
           begin
-            Message(C^.At(LB^.Focused),evCommand,cmClose,nil);
+            W:=PWindow(C^.At(LB^.Focused));
+            { we need to remove the window from the list
+              because otherwise
+              IDEApp.SourceWindowClosed
+              is called after the object has been freed
+              but the ListBox.Redraw will still try to
+              read the title PM }
+            KeepOwner:=W^.Owner;
+            if assigned(KeepOwner) then
+              KeepOwner^.Delete(W);
+            UpdateList;
+            { But reinsert it as Close might only
+              trigger Hide in some cases }
+            if assigned(KeepOwner) then
+              KeepOwner^.Insert(W);
+            Message(W,evCommand,cmClose,nil);
             UpdateList;
             UpdateList;
             ClearEvent(Event);
             ClearEvent(Event);
           end;
           end;

+ 33 - 13
ide/fpswitch.pas

@@ -30,7 +30,7 @@ type
     TParamID =
     TParamID =
       (idNone,idAlign,idRangeChecks,idStackChecks,idIOChecks,
       (idNone,idAlign,idRangeChecks,idStackChecks,idIOChecks,
        idOverflowChecks,idObjMethCallChecks,
        idOverflowChecks,idObjMethCallChecks,
-       idAsmDirect,idAsmATT,idAsmIntel,idAsmMot,
+       idAsmDirect,idAsmATT,idAsmIntel,idAsmMot,idAsmStandard,
        idSymInfNone,idSymInfGlobalOnly,idSymInfGlobalLocal,
        idSymInfNone,idSymInfGlobalOnly,idSymInfGlobalLocal,
        idStackSize,idHeapSize,idStrictVarStrings,idExtendedSyntax,
        idStackSize,idHeapSize,idStrictVarStrings,idExtendedSyntax,
        idMMXOps,idTypedAddress,idPackRecords,idPackEnum,idStackFrames,
        idMMXOps,idTypedAddress,idPackRecords,idPackEnum,idStackFrames,
@@ -199,6 +199,7 @@ implementation
 uses
 uses
   Dos,
   Dos,
   GlobType,
   GlobType,
+  CpuInfo,
   FPVars,FPUtils;
   FPVars,FPUtils;
 
 
 var
 var
@@ -256,7 +257,8 @@ const
       opt_level1optimizations = 'Level ~1~ optimizations';
       opt_level1optimizations = 'Level ~1~ optimizations';
       opt_level2optimizations = 'Level ~2~ optimizations';
       opt_level2optimizations = 'Level ~2~ optimizations';
       opt_i386486 = 'i~3~86/i486';
       opt_i386486 = 'i~3~86/i486';
-      opt_pentiumandmmx = 'Pentium/PentiumMM~X~ (tm)';
+      opt_pentium = 'Pentium (tm)';
+      opt_pentiummmx = 'PentiumMM~X~ (tm)';
       opt_pentiumpro = '~P~entium2/PentiumM/AMD';
       opt_pentiumpro = '~P~entium2/PentiumM/AMD';
       opt_pentiumiv = 'Pentium~4~';
       opt_pentiumiv = 'Pentium~4~';
       opt_m68000 = 'm~6~8000';
       opt_m68000 = 'm~6~8000';
@@ -266,6 +268,7 @@ const
       opt_attassembler = '~A~T&T style assembler';
       opt_attassembler = '~A~T&T style assembler';
       opt_intelassembler = '~I~ntel style assembler';
       opt_intelassembler = '~I~ntel style assembler';
       opt_motassembler = '~M~otorola style assembler';
       opt_motassembler = '~M~otorola style assembler';
+      opt_standardassembler = '~S~tandard style assembler';
       opt_listsource = '~L~ist source';
       opt_listsource = '~L~ist source';
       opt_listregisterallocation = 'list ~r~egister allocation';
       opt_listregisterallocation = 'list ~r~egister allocation';
       opt_listtempallocation = 'list ~t~emp allocation';
       opt_listtempallocation = 'list ~t~emp allocation';
@@ -1137,6 +1140,8 @@ end;
 procedure InitSwitches;
 procedure InitSwitches;
 var
 var
   t : tsystem;
   t : tsystem;
+  cpu : tcputype;
+  st : string;
 begin
 begin
   New(SyntaxSwitches,Init('S'));
   New(SyntaxSwitches,Init('S'));
   with SyntaxSwitches^ do
   with SyntaxSwitches^ do
@@ -1214,17 +1219,30 @@ begin
   New(ProcessorSwitches,InitSelect('O'));
   New(ProcessorSwitches,InitSelect('O'));
   with ProcessorSwitches^ do
   with ProcessorSwitches^ do
    begin
    begin
+     for cpu:=low(tcputype) to high(tcputype) do
+       begin
+         st:=cputypestr[cpu];
 {$ifdef I386}
 {$ifdef I386}
-     AddSelectItem(opt_i386486,'p1',idNone);
-     AddSelectItem(opt_pentiumandmmx,'p2',idNone);
-     AddSelectItem(opt_pentiumpro,'p3',idNone);
-     AddSelectItem(opt_pentiumiv,'p4',idNone);
-{$else not I386}
- {$ifdef m68k}
-     AddSelectItem(opt_m68000,'',idNone);
-     AddSelectItem(opt_m68020,'2',idNone);
- {$endif m68k}
+         if st='386' then
+           st:=opt_i386486;
+         if st='PENTIUM' then
+           st:=opt_pentium;
+         if st='PENTIUM2' then
+           st:=opt_pentiummmx;
+         if st='PENTIUM3' then
+           st:=opt_pentiumpro;
+         if st='PENTIUM4' then
+           st:=opt_pentiumiv;
 {$endif not I386}
 {$endif not I386}
+{$ifdef m68k}
+         if st='68000' then
+           st:=opt_m68000;
+         if st='68020' then
+           st:=opt_m68020;
+{$endif m68k}
+         if st<>'' then
+           AddSelectItem(st,'p'+cputypestr[cpu],idNone);
+       end;
    end;
    end;
   New(TargetSwitches,InitSelect('T'));
   New(TargetSwitches,InitSelect('T'));
   with TargetSwitches^ do
   with TargetSwitches^ do
@@ -1243,7 +1261,8 @@ begin
      AddSelectItem(opt_intelassembler,'intel',idAsmIntel);
      AddSelectItem(opt_intelassembler,'intel',idAsmIntel);
 {$endif I386}
 {$endif I386}
 {$ifdef M68K}
 {$ifdef M68K}
-     AddSelectItem(opt_motassembler,'mot',idAsmDirect);
+     AddSelectItem(opt_standardassembler,'standard',idAsmStandard);
+     AddSelectItem(opt_motassembler,'motorola',idAsmMot);
 {$endif M68K}
 {$endif M68K}
    end;
    end;
   New(AsmInfoSwitches,Init('a'));
   New(AsmInfoSwitches,Init('a'));
@@ -1461,7 +1480,8 @@ begin
 {    idAsmDirect      : if P^.GetParamValueBool[SM] then AddParam('ASMMODE DIRECT');
 {    idAsmDirect      : if P^.GetParamValueBool[SM] then AddParam('ASMMODE DIRECT');
     idAsmATT         : if P^.GetParamValueBool[SM] then AddParam('ASMMODE ATT');
     idAsmATT         : if P^.GetParamValueBool[SM] then AddParam('ASMMODE ATT');
     idAsmIntel       : if P^.GetParamValueBool[SM] then AddParam('ASMMODE INTEL');
     idAsmIntel       : if P^.GetParamValueBool[SM] then AddParam('ASMMODE INTEL');
-    idAsmMot         : if P^.GetParamValueBool[SM] then AddParam('ASMMODE MOT');}
+    idAsmMot         : if P^.GetParamValueBool[SM] then AddParam('ASMMODE MOTOROLA');
+    idAsmStandard    : if P^.GetParamValueBool[SM] then AddParam('ASMMODE STANDARD');}
 {    idSymInfNone     : ;
 {    idSymInfNone     : ;
     idSymInfGlobalOnly:;
     idSymInfGlobalOnly:;
     idSymInfGlobalLocal:if P^.ParamValueBool(SM) then AddSwitch('L+');}
     idSymInfGlobalLocal:if P^.ParamValueBool(SM) then AddSwitch('L+');}

+ 42 - 18
ide/whtml.pas

@@ -30,7 +30,8 @@ type
       constructor Init;
       constructor Init;
       procedure   AddLine(const S: string); virtual;
       procedure   AddLine(const S: string); virtual;
       function    GetLine(Idx: sw_integer; var S: string): boolean; virtual;
       function    GetLine(Idx: sw_integer; var S: string): boolean; virtual;
-      function GetFileName : string; virtual;
+      function    GetFileName : string; virtual;
+      function    GetLineCount : sw_integer;
       destructor  Done; virtual;
       destructor  Done; virtual;
     private
     private
       Lines : PUnsortedStrCollection;
       Lines : PUnsortedStrCollection;
@@ -142,6 +143,11 @@ begin
   GetFileName:='unknown';
   GetFileName:='unknown';
 end;
 end;
 
 
+function TMemoryTextFile.GetLineCount : sw_integer;
+begin
+  GetLineCount:=Lines^.Count;
+end;
+
 procedure TMemoryTextFile.AddLine(const S: string);
 procedure TMemoryTextFile.AddLine(const S: string);
 begin
 begin
   Lines^.Insert(NewStr(S));
   Lines^.Insert(NewStr(S));
@@ -415,24 +421,32 @@ begin
           Code:=$ffff;
           Code:=$ffff;
         end;
         end;
     end;
     end;
-  if (Code=$22) or (Name='quot')   then E:='"'   else { double quote sign             }
-  if (Code=$26) or (Name='amp')    then E:='&'   else { ampersand                     }
-  if (Code=$3C) or (Name='lt')     then E:='<'   else { less-than sign                }
-  if (Code=$3E) or (Name='gt')     then E:='>'   else { greater-than sign              }
+  { #0 to #127 is same for Unicode and Code page 437 }
+  if (code<=127) then
+    begin
+      E:=chr(code);
+      DocDecodeNamedEntity:=true;
+      exit;
+    end;
+  if (Code=$22{34}) or (Name='quot')   then E:='"'   else { double quote sign             }
+  if (Code=$26{38}) or (Name='amp')    then E:='&'   else { ampersand                     }
+  if (Code=$27{39}) or (Name='apos')    then E:='''' else { apostrophe  }
+  if (Code=$3C{60}) or (Name='lt')     then E:='<'   else { less-than sign                }
+  if (Code=$3E{62}) or (Name='gt')     then E:='>'   else { greater-than sign              }
   if (Code=$5B)                    then E:='['   else { [ }
   if (Code=$5B)                    then E:='['   else { [ }
   if (Code=$5C)                    then E:='\'   else { \ }
   if (Code=$5C)                    then E:='\'   else { \ }
   if (Code=$5D)                    then E:=']'   else { ] }
   if (Code=$5D)                    then E:=']'   else { ] }
   if (Code=$5E)                    then E:='^'   else { ^ }
   if (Code=$5E)                    then E:='^'   else { ^ }
   if (Code=$5F)                    then E:='_'   else { _ }
   if (Code=$5F)                    then E:='_'   else { _ }
   if (Code=160) or (Name='nbsp')   then E:=#255  else { no-break space                }
   if (Code=160) or (Name='nbsp')   then E:=#255  else { no-break space                }
-  if (Code=161) or (Name='iexcl')  then E:='­'   else { inverted excalamation mark    }
+  if (Code=161) or (Name='iexcl')  then E:='­'   else { inverted exclamation mark    }
   if (Code=162) or (Name='cent')   then E:='›'   else { cent sign                     }
   if (Code=162) or (Name='cent')   then E:='›'   else { cent sign                     }
   if (Code=163) or (Name='pound')  then E:='œ'   else { pound sterling sign           }
   if (Code=163) or (Name='pound')  then E:='œ'   else { pound sterling sign           }
   if (Code=164) or (Name='curren') then E:='$'   else { general currency sign         }
   if (Code=164) or (Name='curren') then E:='$'   else { general currency sign         }
   if (Code=165) or (Name='yen')    then E:='�'   else { yen sign                      }
   if (Code=165) or (Name='yen')    then E:='�'   else { yen sign                      }
   if (Code=166) or (Name='brvbar') then E:='|'   else { broken vertical bar           }
   if (Code=166) or (Name='brvbar') then E:='|'   else { broken vertical bar           }
-(*  if (Code=167) or (Name='sect')   then E:=#255  else { section sign                  }*)
-(*  if (Code=168) or (Name='uml')    then E:=#255  else { umlaut  (dieresis)            }*)
+  if (Code=167) or (Name='sect')   then E:=''   else { section sign                  }
+  if (Code=168) or (Name='uml')    then E:='"'   else { umlaut  (dieresis)            }
   if (Code=169) or (Name='copy')   then E:='(C)' else { copyright sign                }
   if (Code=169) or (Name='copy')   then E:='(C)' else { copyright sign                }
 (*  if (Code=170) or (Name='ordf')   then E:=#255  else { ordinal indicator, feminine   }*)
 (*  if (Code=170) or (Name='ordf')   then E:=#255  else { ordinal indicator, feminine   }*)
   if (Code=171) or (Name='laquo')  then E:='"'   else { angle quotation mark -left    }
   if (Code=171) or (Name='laquo')  then E:='"'   else { angle quotation mark -left    }
@@ -462,8 +476,8 @@ begin
   if (Code=195) or (Name='Atilde') then E:='A'   else { capital A, tilde accent       }
   if (Code=195) or (Name='Atilde') then E:='A'   else { capital A, tilde accent       }
   if (Code=196) or (Name='Auml')   then E:='Ž'   else { capital A, dieresis or umlaut }
   if (Code=196) or (Name='Auml')   then E:='Ž'   else { capital A, dieresis or umlaut }
   if (Code=197) or (Name='Aring')  then E:='�'   else { capital A, ring               }
   if (Code=197) or (Name='Aring')  then E:='�'   else { capital A, ring               }
-  if (Code=198) or (Name='AElig')  then E:='AE'  else { capital AE diphthong          }
-(*  if (Code=199) or (Name='Ccedil') then E:='?'   else { capital C, cedilla            }*)
+  if (Code=198) or (Name='AElig')  then E:='’'   else { capital AE diphthong          }
+  if (Code=199) or (Name='Ccedil') then E:='€'   else { capital C, cedilla            }
   if (Code=200) or (Name='Egrave') then E:='�'   else { capital E, grave accent       }
   if (Code=200) or (Name='Egrave') then E:='�'   else { capital E, grave accent       }
   if (Code=201) or (Name='Eacute') then E:='�'   else { capital E, acute accent       }
   if (Code=201) or (Name='Eacute') then E:='�'   else { capital E, acute accent       }
   if (Code=202) or (Name='Ecirc')  then E:='E'   else { capital E, circumflex accent  }
   if (Code=202) or (Name='Ecirc')  then E:='E'   else { capital E, circumflex accent  }
@@ -495,7 +509,7 @@ begin
   if (Code=228) or (Name='auml')   then E:='„'   else { small a, dieresis or umlaut   }
   if (Code=228) or (Name='auml')   then E:='„'   else { small a, dieresis or umlaut   }
   if (Code=229) or (Name='aring')  then E:='†'   else { small a, ring                 }
   if (Code=229) or (Name='aring')  then E:='†'   else { small a, ring                 }
   if (Code=230) or (Name='aelig')  then E:='ae'  else { small ae, diphthong           }
   if (Code=230) or (Name='aelig')  then E:='ae'  else { small ae, diphthong           }
-(*  if (Code=231) or (Name='ccedil') then E:='?'   else { small c, cedilla              }*)
+  if (Code=231) or (Name='ccedil') then E:='‡'   else { small c, cedilla              }
   if (Code=232) or (Name='egrave') then E:='Š'   else { small e, grave accent         }
   if (Code=232) or (Name='egrave') then E:='Š'   else { small e, grave accent         }
   if (Code=233) or (Name='eacute') then E:='‚'   else { small e, acute accent         }
   if (Code=233) or (Name='eacute') then E:='‚'   else { small e, acute accent         }
   if (Code=234) or (Name='ecirc')  then E:='ˆ'   else { small e, circumflex accent    }
   if (Code=234) or (Name='ecirc')  then E:='ˆ'   else { small e, circumflex accent    }
@@ -521,15 +535,20 @@ begin
 (*  if (Code=254) or (Name='thorn')  then E:='?'   else { small thorn, Icelandic        }*)
 (*  if (Code=254) or (Name='thorn')  then E:='?'   else { small thorn, Icelandic        }*)
   if (Code=255) or (Name='yuml')   then E:='y'   else { small y, dieresis or umlaut   }
   if (Code=255) or (Name='yuml')   then E:='y'   else { small y, dieresis or umlaut   }
   { Special codes appearing in TeXH generated files }
   { Special codes appearing in TeXH generated files }
-  if (Code=8217) then E:=''''   else                  { acute accent as generated by TeXH   }
-  if (code=$2c6) then E:='^'  else                    { Modifier Letter Circumflex Accent }
-  if (code=$2013) then E:='-'  else                   { En dash }
-  if (code=$2014) then E:='--'  else                  { Em dash }
-  if (code=$201D) then E:='``'  else                  { right double quotation marks }
+  if (code=$2c6{710}) or (Name='circ')  then E:='^' else      { Modifier Letter Circumflex Accent }
+  if (code=$2dc{732}) or (Name='tilde') then E:='~' else      { Small tilde }
+  if (code=$2013{8211}) or (Name='endash') then E:='-' else   { En dash }
+  if (code=$2014{8212}) or (Name='emdash') then E:='--' else  { Em dash }
+  if (Code=$2018{8216}) or (Name='lsquo') then E:='`'  else   { Acute accent as generated by TeXH   }
+  if (Code=$2019{8217}) or (Name='rsquo') then E:='''' else   { acute accent as generated by TeXH   }
+  if (code=$201C{8220}) or (Name='ldquo') then E:='''''' else { left double quotation marks }
+  if (code=$201D{8221}) or (Name='rdquo') then E:='``' else   { right double quotation marks }
+  if (code=$2026{8230}) or (Name='hellip') then E:='...' else { horizontal ellipsis }
   if (Code=$FB00) then E:='ff'  else                  { ff together }
   if (Code=$FB00) then E:='ff'  else                  { ff together }
   if (Code=$FB01) then E:='fi'  else                  { fi together }
   if (Code=$FB01) then E:='fi'  else                  { fi together }
   if (Code=$FB02) then E:='fl'  else                  { fl together }
   if (Code=$FB02) then E:='fl'  else                  { fl together }
   if (Code=$FB03) then E:='ffi' else                  { ffi together }
   if (Code=$FB03) then E:='ffi' else                  { ffi together }
+  if (Code=$FB04) then E:='ffl' else                  { ffl together }
   Found:=false;
   Found:=false;
   DocDecodeNamedEntity:=Found;
   DocDecodeNamedEntity:=Found;
 {$ifdef DEBUG}
 {$ifdef DEBUG}
@@ -617,7 +636,9 @@ var Found: boolean;
     InStr: boolean;
     InStr: boolean;
     I: sw_integer;
     I: sw_integer;
 begin
 begin
-  Found:=false; Name:=UpcaseStr(Name);
+  Found:=false;
+  Name:=UpcaseStr(Name);
+  Value:='';
   S:=TagParams;
   S:=TagParams;
   repeat
   repeat
     InStr:=false;
     InStr:=false;
@@ -625,7 +646,10 @@ begin
     S:=Trim(S); I:=1;
     S:=Trim(S); I:=1;
     while (I<=length(S)) and (S[I]<>'=') do
     while (I<=length(S)) and (S[I]<>'=') do
       begin
       begin
-        ParamName:=ParamName+S[I];
+        if S[I]=' ' then
+          ParamName:=''
+        else
+          ParamName:=ParamName+S[I];
         Inc(I);
         Inc(I);
       end;
       end;
     ParamName:=Trim(ParamName);
     ParamName:=Trim(ParamName);

+ 128 - 10
ide/whtmlhlp.pas

@@ -87,11 +87,12 @@ type
       procedure DocTITLE(Entered: boolean); virtual;
       procedure DocTITLE(Entered: boolean); virtual;
       procedure DocBODY(Entered: boolean); virtual;
       procedure DocBODY(Entered: boolean); virtual;
       procedure DocAnchor(Entered: boolean); virtual;
       procedure DocAnchor(Entered: boolean); virtual;
-      procedure   DocUnknownTag; virtual;
+      procedure DocUnknownTag; virtual;
       procedure DocHeading(Level: integer; Entered: boolean); virtual;
       procedure DocHeading(Level: integer; Entered: boolean); virtual;
       procedure DocParagraph(Entered: boolean); virtual;
       procedure DocParagraph(Entered: boolean); virtual;
       procedure DocBreak; virtual;
       procedure DocBreak; virtual;
       procedure DocImage; virtual;
       procedure DocImage; virtual;
+      procedure DocProcessComment(Comment: string); virtual;
       procedure DocBold(Entered: boolean); virtual;
       procedure DocBold(Entered: boolean); virtual;
       procedure DocCite(Entered: boolean); virtual;
       procedure DocCite(Entered: boolean); virtual;
       procedure DocCode(Entered: boolean); virtual;
       procedure DocCode(Entered: boolean); virtual;
@@ -127,10 +128,13 @@ type
       InAnchor: boolean;
       InAnchor: boolean;
       InParagraph: boolean;
       InParagraph: boolean;
       InPreformatted: boolean;
       InPreformatted: boolean;
+      SuppressOutput: boolean;
+      SuppressUntil : string;
       InDefExp: boolean;
       InDefExp: boolean;
       TopicTitle: string;
       TopicTitle: string;
       Indent: integer;
       Indent: integer;
-      AnyCharsInLine: boolean;
+      AnyCharsInLine,
+      LastAnsiLoadFailed: boolean;
       CurHeadLevel: integer;
       CurHeadLevel: integer;
       PAlign: TParagraphAlign;
       PAlign: TParagraphAlign;
       LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
       LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
@@ -469,6 +473,7 @@ begin
   inherited init(R,nil,nil);
   inherited init(R,nil,nil);
   HTMLOwner:=AOwner;
   HTMLOwner:=AOwner;
   HTMLConsole:=New(PHTMLAnsiConsole,Init(@Self));
   HTMLConsole:=New(PHTMLAnsiConsole,Init(@Self));
+  HTMLConsole^.HighVideo;
   Dispose(Console,Done);
   Dispose(Console,Done);
   Console:=HTMLConsole;
   Console:=HTMLConsole;
   HTMLConsole^.Size.X:=80;
   HTMLConsole^.Size.X:=80;
@@ -658,7 +663,7 @@ begin
         begin
         begin
           Topic^.NamedMarks^.InsertStr(Name);
           Topic^.NamedMarks^.InsertStr(Name);
 {$ifdef DEBUG}
 {$ifdef DEBUG}
-          DebugMessage('',' Adding Name '+Name,1,1);
+          DebugMessage('',' Adding Name "'+Name+'"',1,1);
 {$endif DEBUG}
 {$endif DEBUG}
           AddChar(hscNamedMark);
           AddChar(hscNamedMark);
         end;
         end;
@@ -669,10 +674,12 @@ begin
             begin
             begin
               InAnchor:=true;
               InAnchor:=true;
               AddChar(hscLink);
               AddChar(hscLink);
+              if pos('#',HRef)=1 then
+                Href:=NameAndExtOf(GetFilename)+Href;
               HRef:=CompleteURL(URL,HRef);
               HRef:=CompleteURL(URL,HRef);
               LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef);
               LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef);
 {$ifdef DEBUG}
 {$ifdef DEBUG}
-          DebugMessage('',' Adding Link '+HRef,1,1);
+              DebugMessage('',' Adding Link "'+HRef+'"',1,1);
 {$endif DEBUG}
 {$endif DEBUG}
               Inc(LinkPtr);
               Inc(LinkPtr);
             end;
             end;
@@ -763,15 +770,95 @@ begin
   AnyCharsInLine:=false;
   AnyCharsInLine:=false;
 end;
 end;
 
 
+procedure THTMLTopicRenderer.DocProcessComment(Comment: string);
+var
+  src,index : string;
+begin
+  if pos('tex4ht:',Comment)=0 then
+    exit;
+{$ifdef DEBUG}
+  DebugMessage(GetFileName,'tex4ht comment "'
+        +Comment+'"',Line,1);
+{$endif DEBUG}
+  if SuppressOutput then
+    begin
+      if (pos(SuppressUntil,Comment)=0) then
+        exit
+      else
+        begin
+{$ifdef DEBUG}
+          DebugMessage(GetFileName,' Found '+SuppressUntil+'comment "'
+            +Comment+'" SuppressOuput reset to false',Line,1);
+{$endif DEBUG}
+          SuppressOutput:=false;
+          SuppressUntil:='';
+        end;
+    end;
+  if (pos('tex4ht:graphics ',Comment)>0) and
+     LastAnsiLoadFailed then
+    begin
+{$ifdef DEBUG}
+      DebugMessage(GetFileName,' Using tex4ht comment "'
+        +Comment+'"',Line,1);
+{$endif DEBUG}
+      { Try again with this info }
+      TagParams:=Comment;
+      DocImage;
+    end;
+  if (pos('tex4ht:syntaxdiagram ',Comment)>0) then
+    begin
+{$ifdef DEBUG}
+      DebugMessage(GetFileName,' Using tex4ht:syntaxdiagram comment "'
+        +Comment+'"',Line,1);
+{$endif DEBUG}
+      { Try again with this info }
+      TagParams:=Comment;
+      DocImage;
+      if not LastAnsiLoadFailed then
+        begin
+          SuppressOutput:=true;
+          SuppressUntil:='tex4ht:endsyntaxdiagram ';
+        end
+    end;
+  if (pos('tex4ht:mysyntdiag ',Comment)>0) then
+    begin
+{$ifdef DEBUG}
+      DebugMessage(GetFileName,' Using tex4ht:mysyntdiag comment "'
+        +Comment+'"',Line,1);
+{$endif DEBUG}
+      { Try again with this info }
+      TagParams:=Comment;
+      DocGetTagParam('SRC',src);
+      DocGetTagParam('INDEX',index);
+      TagParams:='src="../syntax/'+src+'-'+index+'.png"';
+      DocImage;
+      if not LastAnsiLoadFailed then
+        begin
+          SuppressOutput:=true;
+          SuppressUntil:='tex4ht:endmysyntdiag ';
+        end
+    end;
+end;
+
 procedure THTMLTopicRenderer.DocImage;
 procedure THTMLTopicRenderer.DocImage;
-var Src,Alt,SrcLine: string;
+var Name,Src,Alt,SrcLine: string;
     f : text;
     f : text;
     attr : byte;
     attr : byte;
     PA : PHTMLAnsiView;
     PA : PHTMLAnsiView;
     StorePreformatted : boolean;
     StorePreformatted : boolean;
 begin
 begin
+  if SuppressOutput then
+    exit;
+{$ifdef DEBUG}
+  if not DocGetTagParam('NAME',Name) then
+     Name:='<No name>';
+  DebugMessage(GetFileName,' Image "'+Name+'"',Line,1);
+{$endif DEBUG}
   if DocGetTagParam('SRC',src) then
   if DocGetTagParam('SRC',src) then
     begin
     begin
+{$ifdef DEBUG}
+      DebugMessage(GetFileName,' Image source tag "'+Src+'"',Line,1);
+{$endif DEBUG}
       if src<>'' then
       if src<>'' then
         begin
         begin
           src:=CompleteURL(URL,src);
           src:=CompleteURL(URL,src);
@@ -779,10 +866,30 @@ begin
             Try to see if a file with same name and extension .git
             Try to see if a file with same name and extension .git
             exists PM }
             exists PM }
           src:=DirAndNameOf(src)+'.ans';
           src:=DirAndNameOf(src)+'.ans';
-          if ExistsFile(src) then
+{$ifdef DEBUG}
+  DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
+{$endif DEBUG}
+          if not ExistsFile(src) then
+            begin
+              DocGetTagParam('SRC',src);
+              src:=DirAndNameOf(src)+'.ans';
+              src:=CompleteURL(DirOf(URL)+'../',src);
+{$ifdef DEBUG}
+              DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
+{$endif DEBUG}
+            end;
+          if not ExistsFile(src) then
+            begin
+              LastAnsiLoadFailed:=true;
+{$ifdef DEBUG}
+              DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
+{$endif DEBUG}
+            end
+          else
             begin
             begin
               PA:=New(PHTMLAnsiView,init(@self));
               PA:=New(PHTMLAnsiView,init(@self));
               PA^.LoadFile(src);
               PA^.LoadFile(src);
+              LastAnsiLoadFailed:=false;
               if AnyCharsInLine then DocBreak;
               if AnyCharsInLine then DocBreak;
               StorePreformatted:=InPreformatted;
               StorePreformatted:=InPreformatted;
               InPreformatted:=true;
               InPreformatted:=true;
@@ -798,7 +905,14 @@ begin
             end;
             end;
           { also look for a raw text file without colors }
           { also look for a raw text file without colors }
           src:=DirAndNameOf(src)+'.txt';
           src:=DirAndNameOf(src)+'.txt';
-          if ExistsFile(src) then
+          if not ExistsFile(src) then
+            begin
+              LastAnsiLoadFailed:=true;
+{$ifdef DEBUG}
+              DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
+{$endif DEBUG}
+            end
+          else
             begin
             begin
               Assign(f,src);
               Assign(f,src);
               Reset(f);
               Reset(f);
@@ -809,7 +923,9 @@ begin
                   AddText(SrcLine+hscLineBreak);
                   AddText(SrcLine+hscLineBreak);
                 end;
                 end;
               Close(f);
               Close(f);
+              LastAnsiLoadFailed:=false;
               DocPreformatted(false);
               DocPreformatted(false);
+              LastAnsiLoadFailed:=false;
               Exit;
               Exit;
             end;
             end;
         end;
         end;
@@ -1071,7 +1187,7 @@ end;
 
 
 procedure THTMLTopicRenderer.AddChar(C: char);
 procedure THTMLTopicRenderer.AddChar(C: char);
 begin
 begin
-  if (Topic=nil) or (TextPtr=MaxBytes) then Exit;
+  if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
   Topic^.Text^[TextPtr]:=ord(C);
   Topic^.Text^[TextPtr]:=ord(C);
   Inc(TextPtr);
   Inc(TextPtr);
   if (C>#15) and ((C<>' ') or (InPreFormatted=true)) then
   if (C>#15) and ((C<>' ') or (InPreFormatted=true)) then
@@ -1080,7 +1196,7 @@ end;
 
 
 procedure THTMLTopicRenderer.AddCharAt(C: char;AtPtr : sw_word);
 procedure THTMLTopicRenderer.AddCharAt(C: char;AtPtr : sw_word);
 begin
 begin
-  if (Topic=nil) or (TextPtr=MaxBytes) then Exit;
+  if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
   if AtPtr>TextPtr then
   if AtPtr>TextPtr then
     AtPtr:=TextPtr
     AtPtr:=TextPtr
   else
   else
@@ -1132,7 +1248,7 @@ function THTMLTopicRenderer.AddTextAt(const S: String;AtPtr : sw_word) : sw_word
 var
 var
   i,slen,len : sw_word;
   i,slen,len : sw_word;
 begin
 begin
-  if (Topic=nil) or (TextPtr>=MaxBytes) then Exit;
+  if (Topic=nil) or (TextPtr>=MaxBytes)  or SuppressOutput then Exit;
   slen:=length(s);
   slen:=length(s);
   if TextPtr+slen>=MaxBytes then
   if TextPtr+slen>=MaxBytes then
     slen:=MaxBytes-TextPtr;
     slen:=MaxBytes-TextPtr;
@@ -1185,6 +1301,8 @@ begin
       TextPtr:=0; LinkPtr:=0;
       TextPtr:=0; LinkPtr:=0;
       AnyCharsInLine:=false;
       AnyCharsInLine:=false;
       LastTextChar:=#0;
       LastTextChar:=#0;
+      SuppressUntil:='';
+      SuppressOutput:=false;
       OK:=Process(HTMLFile);
       OK:=Process(HTMLFile);
 
 
       if OK then
       if OK then

+ 434 - 28
ide/whtmlscn.pas

@@ -34,16 +34,50 @@ type
     {a}function    CheckURL(const URL: string): boolean; virtual;
     {a}function    CheckURL(const URL: string): boolean; virtual;
     {a}function    CheckText(const Text: string): boolean; virtual;
     {a}function    CheckText(const Text: string): boolean; virtual;
     {a}procedure   AddLink(const LinkText, LinkURL: string); virtual;
     {a}procedure   AddLink(const LinkText, LinkURL: string); virtual;
+    {a}procedure   AddRef(LinkURL: string); virtual;
+    {a}procedure   AddNameID(AName: string); virtual;
+    {a}procedure   AddID(AName: string); virtual;
     {a}function    GetDocumentBaseURL: string; virtual;
     {a}function    GetDocumentBaseURL: string; virtual;
      private
      private
        CurLinkText: string;
        CurLinkText: string;
        CurURL: string;
        CurURL: string;
-       CurName: string;
+       CurName,
+       CurID: string;
        CurDoc: string;
        CurDoc: string;
-       InAnchor,InNameAnchor: boolean;
+       InAnchor,InNameAnchor,
+       HasHRef : boolean;
        LastSynonym: PHTMLLinkScanDocument;
        LastSynonym: PHTMLLinkScanDocument;
      end;
      end;
 
 
+     TNameIDState = (IsReferenced, IsFound,IsID);
+     TNameIDStates = set of TNameIDState;
+
+
+     PNameID  = ^TNameID;
+     TNameID  = object(TObject)
+       constructor Init(const AName : string; Astate : TNameIDState);
+       destructor  Done; virtual;
+       procedure SetState(Astate : TNameIDState; enabled : boolean);
+       procedure SetOrigin(const AOrigin : string);
+       procedure SetLine(ALine : sw_integer);
+       function GetLine : sw_integer;
+       function GetState : TNameIDStates;
+       function GetName : string;
+       function GetOrigin : string;
+     private
+       Name : pstring;
+       Origin : pstring;
+       Line : sw_integer;
+       State : TNameIDStates;
+     end;
+
+     PNameIDCollection = ^TNameIDCollection;
+     TNameIDCollection = object(TSortedCollection)
+       function At(Index: sw_Integer): PNameID;
+       function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
+     end;
+
+
      THTMLLinkScanDocument = object(TObject)
      THTMLLinkScanDocument = object(TObject)
        constructor Init(const ADocName: string);
        constructor Init(const ADocName: string);
        function    GetName: string;
        function    GetName: string;
@@ -74,6 +108,7 @@ type
      THTMLLinkScanner = object(TCustomHTMLLinkScanner)
      THTMLLinkScanner = object(TCustomHTMLLinkScanner)
        constructor Init(const ABaseDir: string);
        constructor Init(const ABaseDir: string);
        procedure   SetBaseDir(const ABaseDir: string);
        procedure   SetBaseDir(const ABaseDir: string);
+    {a}function    FindID(const AName : string) : PNameID; virtual;
        function    GetDocumentCount: sw_integer;
        function    GetDocumentCount: sw_integer;
        function    GetDocumentURL(DocIndex: sw_integer): string;
        function    GetDocumentURL(DocIndex: sw_integer): string;
        function    GetUniqueDocumentURL(DocIndex: sw_integer): string;
        function    GetUniqueDocumentURL(DocIndex: sw_integer): string;
@@ -85,8 +120,8 @@ type
      public
      public
        procedure   AddLink(const LinkText, LinkURL: string); virtual;
        procedure   AddLink(const LinkText, LinkURL: string); virtual;
      private
      private
-       Documents: PHTMLLinkScanDocumentCollection;
-       BaseDir: PString;
+       Documents:  PHTMLLinkScanDocumentCollection;
+       BaseDir:    PString;
        function    ExpandChildURL(const S: string): string;
        function    ExpandChildURL(const S: string): string;
        function    NormalizeChildURL(const S: string): string;
        function    NormalizeChildURL(const S: string): string;
      end;
      end;
@@ -98,18 +133,25 @@ type
        constructor Init(const ADocumentURL: string);
        constructor Init(const ADocumentURL: string);
        function    GetDocumentURL: string;
        function    GetDocumentURL: string;
        destructor  Done; virtual;
        destructor  Done; virtual;
+       function    AddReferencedName (const AName : string) : PNameID;
+       function    AddFoundName (const AName : string) : PNameID;
+       procedure   CheckNameList;
+       function    FindID(const AName : string) : PNameID; virtual;
      private
      private
        DocumentURL  : PString;
        DocumentURL  : PString;
+       NameIDList   : PNameIDCollection;
+       Owner        : PHTMLLinkScanner;
      public
      public
        State        : THTMLLinkScanState;
        State        : THTMLLinkScanState;
      end;
      end;
 
 
      PHTMLLinkScanFileCollection = ^THTMLLinkScanFileCollection;
      PHTMLLinkScanFileCollection = ^THTMLLinkScanFileCollection;
      THTMLLinkScanFileCollection = object(TSortedCollection)
      THTMLLinkScanFileCollection = object(TSortedCollection)
-       function At(Index: sw_Integer): PHTMLLinkScanFile;
-       function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
-       function SearchFile(const DocURL: string): PHTMLLinkScanFile;
-       function FindFileWithState(AState: THTMLLinkScanState): PHTMLLinkScanFile;
+       function   At(Index: sw_Integer): PHTMLLinkScanFile;
+       function   Compare(Key1, Key2: Pointer): sw_Integer; virtual;
+       function   SearchFile(const DocURL: string): PHTMLLinkScanFile;
+       function   FindFileWithState(AState: THTMLLinkScanState): PHTMLLinkScanFile;
+       procedure  CheckNameIDLists;
      end;
      end;
 
 
      THTMLLinkScanOption = (soSubDocsOnly);
      THTMLLinkScanOption = (soSubDocsOnly);
@@ -121,12 +163,17 @@ type
        destructor  Done; virtual;
        destructor  Done; virtual;
      public
      public
        function    GetDocumentBaseURL: string; virtual;
        function    GetDocumentBaseURL: string; virtual;
+       function    FindID(const AName : string) : PNameID; virtual;
        procedure   AddLink(const LinkText, LinkURL: string); virtual;
        procedure   AddLink(const LinkText, LinkURL: string); virtual;
+       procedure   AddRef(LinkURL: string); virtual;
+       procedure   AddNameID(AName: string); virtual;
+       procedure   AddID(AName: string); virtual;
        function    CheckURL(const URL: string): boolean; virtual;
        function    CheckURL(const URL: string): boolean; virtual;
      private
      private
        Options: THTMLLinkScanOptions;
        Options: THTMLLinkScanOptions;
        BaseURL: string;
        BaseURL: string;
        CurBaseURL: string;
        CurBaseURL: string;
+       IDList   : PNameIDCollection;
        DocumentFiles: PHTMLLinkScanFileCollection;
        DocumentFiles: PHTMLLinkScanFileCollection;
        procedure   ScheduleDoc(const DocumentURL: string);
        procedure   ScheduleDoc(const DocumentURL: string);
      public
      public
@@ -170,11 +217,15 @@ begin
   if Entered then
   if Entered then
     begin
     begin
       CurLinkText:='';
       CurLinkText:='';
-      if DocGetTagParam('HREF',CurURL)=false then
+      if DocGetTagParam('HREF',CurURL) then
+        HasHRef:=true
+      else
         CurURL:='';
         CurURL:='';
       if not DocGetTagParam('NAME',CurName) then
       if not DocGetTagParam('NAME',CurName) then
       if not DocGetTagParam('ID',CurName) then
       if not DocGetTagParam('ID',CurName) then
         CurName:='';
         CurName:='';
+      if not DocGetTagParam('ID',CurID) then
+        CurID:='';
       if CurName<>'' then
       if CurName<>'' then
         begin
         begin
           InNameAnchor:=true;
           InNameAnchor:=true;
@@ -188,28 +239,43 @@ begin
       else
       else
         CurName:='';
         CurName:='';
       CurURL:=Trim(CurURL);
       CurURL:=Trim(CurURL);
+      if pos('#',CurURL)=1 then
+        CurURL:=CurDoc+CurURL;
       CurURL:=CompleteURL(GetDocumentBaseURL,CurURL);
       CurURL:=CompleteURL(GetDocumentBaseURL,CurURL);
     end
     end
   else
   else
     begin
     begin
       CurLinkText:=Trim(CurLinkText);
       CurLinkText:=Trim(CurLinkText);
-      if (CurName='') and CheckURL(CurURL) and CheckText(CurLinkText) and
-         not DisableCrossIndexing then
+      if HasHRef then
         begin
         begin
-          AddLink(CurLinkText,CurURL);
-{$ifdef DEBUG}
-          DebugMessage('',' Adding ScanLink "'+CurLinkText+'" to "'+
-            CurURL+'"',1,1);
-{$endif DEBUG}
+          if CheckURL(CurURL) and CheckText(CurLinkText) and
+             not DisableCrossIndexing then
+            begin
+              AddLink(CurLinkText,CurURL);
+    {$ifdef DEBUG}
+              DebugMessage(CurDoc,' Adding ScanLink "'+CurLinkText+'" to "'+
+                CurURL+'"',Line,1);
+    {$endif DEBUG}
+            end;
+          { Be sure to parse referenced file,
+            even if that link is not valid }
+          AddRef(CurURL);
         end;
         end;
-      if InNameAnchor and CheckURL(CurName) and CheckText(CurLinkText) then
+      if not HasHRef and InNameAnchor and CheckURL(CurName) and CheckText(CurLinkText) then
         begin
         begin
           AddLink(CurLinkText,CurName);
           AddLink(CurLinkText,CurName);
 {$ifdef DEBUG}
 {$ifdef DEBUG}
-          DebugMessage('',' Adding ScanName '+CurLinkText+' to '+CurName,1,1);
+          DebugMessage(CurDoc,' Adding ScanName "'+CurLinkText+'" to "'+CurName+'"',Line,1);
 {$endif DEBUG}
 {$endif DEBUG}
         end;
         end;
+      if InNameAnchor then
+        begin
+          AddNameID(CurName);
+        end;
+      if not HasHRef and (CurID<>'') then
+        AddID(CurID);
       InNameAnchor:=false;
       InNameAnchor:=false;
+      HasHRef:=false;
     end;
     end;
   InAnchor:=Entered;
   InAnchor:=Entered;
 end;
 end;
@@ -237,11 +303,110 @@ begin
   { Abstract }
   { Abstract }
 end;
 end;
 
 
+procedure TCustomHTMLLinkScanner.AddRef(LinkURL: string);
+begin
+  { Abstract }
+end;
+
+procedure TCustomHTMLLinkScanner.AddNameID(AName: string);
+begin
+  { Abstract }
+end;
+
+procedure TCustomHTMLLinkScanner.AddID(AName: string);
+begin
+  { Abstract }
+end;
+
+
+constructor TNameID.Init(const AName : string; Astate : TNameIDState);
+begin
+  inherited Init;
+  SetStr(Name,AName);
+  Origin:=nil;
+  State:=[AState];
+end;
+
+destructor  TNameID.Done;
+begin
+  if assigned(Name) then
+    DisposeStr(Name);
+  Name:=nil;
+  if assigned(Origin) then
+    DisposeStr(Origin);
+  Origin:=nil;
+  inherited Done;
+end;
+
+procedure TNameID.SetState(Astate : TNameIDState; enabled : boolean);
+begin
+  if enabled then
+    Include(State,AState)
+  else
+    Exclude(State,AState);
+end;
+
+
+function TNameID.GetState : TNameIDStates;
+begin
+  GetState:=State;
+end;
+
+function TNameID.GetName : string;
+begin
+  GetName:=GetStr(Name);
+end;
+
+function TNameID.GetOrigin : string;
+begin
+  GetOrigin:=GetStr(Origin);
+end;
+
+procedure TNameID.SetOrigin(const AOrigin : string);
+begin
+  SetStr(Origin,AOrigin);
+end;
+procedure TNameID.SetLine(ALine : sw_integer);
+begin
+  Line:=ALine;
+end;
+
+function TNameID.GetLine : sw_integer;
+begin
+  GetLine:=Line;
+end;
+
+
+function TNameIDCollection.At(Index: sw_Integer): PNameID;
+begin
+  At:=Inherited At(Index);
+end;
+
+function TNameIDCollection.Compare(Key1, Key2: Pointer): sw_Integer;
+var
+  R: sw_integer;
+  K1: PNameID absolute Key1;
+  K2: PNameID absolute Key2;
+  S1,S2: string;
+begin
+  S1:=K1^.GetName;
+  S2:=K2^.GetName;
+  S1:=UpcaseStr(S1); S2:=UpcaseStr(S2);
+  if S1<S2 then R:=-1 else
+  if S1>S2 then R:= 1 else
+  R:=0;
+  Compare:=R;
+end;
+
+
 constructor THTMLLinkScanDocument.Init(const ADocName: string);
 constructor THTMLLinkScanDocument.Init(const ADocName: string);
 begin
 begin
   inherited Init;
   inherited Init;
   SetStr(DocName,ADocName);
   SetStr(DocName,ADocName);
   New(Aliases, Init(10,10));
   New(Aliases, Init(10,10));
+{$ifdef DEBUG}
+  DebugMessage('',' Adding New LinkScan document "'+ADocName+'"',1,1);
+{$endif DEBUG}
   Synonym:=nil;
   Synonym:=nil;
 end;
 end;
 
 
@@ -274,6 +439,9 @@ end;
 procedure THTMLLinkScanDocument.AddAlias(const Alias: string);
 procedure THTMLLinkScanDocument.AddAlias(const Alias: string);
 begin
 begin
   Aliases^.Insert(NewStr(Alias));
   Aliases^.Insert(NewStr(Alias));
+{$ifdef DEBUG}
+  DebugMessage('',' Adding alias "'+Alias+'" to LinkScan document "'+GetStr(DocName)+'"',1,1);
+{$endif DEBUG}
 end;
 end;
 
 
 constructor THTMLLinkScanDocument.Load(var S: TStream);
 constructor THTMLLinkScanDocument.Load(var S: TStream);
@@ -297,9 +465,13 @@ end;
 
 
 destructor THTMLLinkScanDocument.Done;
 destructor THTMLLinkScanDocument.Done;
 begin
 begin
+  if Assigned(Aliases) then
+    Dispose(Aliases, Done);
+  Aliases:=nil;
+  if Assigned(DocName) then
+    DisposeStr(DocName);
+  DocName:=nil;
   inherited Done;
   inherited Done;
-  if Assigned(Aliases) then Dispose(Aliases, Done); Aliases:=nil;
-  if Assigned(DocName) then DisposeStr(DocName); DocName:=nil;
 end;
 end;
 
 
 constructor THTMLLinkScanDocumentCollection.Init(AScanner: PHTMLLinkScanner; ALimit, ADelta: Integer);
 constructor THTMLLinkScanDocumentCollection.Init(AScanner: PHTMLLinkScanner; ALimit, ADelta: Integer);
@@ -472,6 +644,12 @@ begin
   CurrentHTMLIndexVersion:=HTMLIndexVersion;
   CurrentHTMLIndexVersion:=HTMLIndexVersion;
 end;
 end;
 
 
+function THTMLLinkScanner.FindID(const AName : string) : PNameID;
+begin
+  {abstract}FindID:=nil;
+end;
+
+
 procedure THTMLLinkScanner.StoreDocuments(var S: TStream);
 procedure THTMLLinkScanner.StoreDocuments(var S: TStream);
 var L: longint;
 var L: longint;
 begin
 begin
@@ -487,15 +665,20 @@ end;
 
 
 destructor THTMLLinkScanner.Done;
 destructor THTMLLinkScanner.Done;
 begin
 begin
+  if Assigned(Documents) then
+    Dispose(Documents, Done);
+  Documents:=nil;
+  if Assigned(BaseDir) then
+    DisposeStr(BaseDir);
+  BaseDir:=nil;
   inherited Done;
   inherited Done;
-  if Assigned(Documents) then Dispose(Documents, Done); Documents:=nil;
-  if Assigned(BaseDir) then DisposeStr(BaseDir); BaseDir:=nil;
 end;
 end;
 
 
 constructor THTMLLinkScanFile.Init(const ADocumentURL: string);
 constructor THTMLLinkScanFile.Init(const ADocumentURL: string);
 begin
 begin
   inherited Init;
   inherited Init;
   SetStr(DocumentURL,ADocumentURL);
   SetStr(DocumentURL,ADocumentURL);
+  New(NameIDList, Init(5,10));
 end;
 end;
 
 
 function THTMLLinkScanFile.GetDocumentURL: string;
 function THTMLLinkScanFile.GetDocumentURL: string;
@@ -503,10 +686,98 @@ begin
   GetDocumentURL:=GetStr(DocumentURL);
   GetDocumentURL:=GetStr(DocumentURL);
 end;
 end;
 
 
+function THTMLLinkScanFile.AddReferencedName (const AName : string) : PNameID;
+var
+  index : sw_integer;
+  PN : PNameID;
+begin
+  new(PN,init(AName,IsReferenced));
+  if not NameIDList^.Search(PN,Index) then
+    NameIDList^.Insert(PN)
+  else
+    begin
+      dispose(PN,Done);
+      PN:=NameIDList^.At(Index);
+      PN^.SetState(IsReferenced,true);
+    end;
+  AddReferencedName:=PN;
+end;
+
+function THTMLLinkScanFile.AddFoundName (const AName : string) : PNameID;
+var
+  index : sw_integer;
+  PN : PNameID;
+begin
+  new(PN,init(AName,IsFound));
+  if not NameIDList^.Search(PN,Index) then
+    NameIDList^.Insert(PN)
+  else
+    begin
+      dispose(PN,Done);
+      PN:=NameIDList^.At(Index);
+      PN^.SetState(IsFound,true);
+    end;
+  AddFoundName:=PN;
+end;
+
+procedure THTMLLinkScanFile.CheckNameList;
+var
+  i : sw_integer;
+  PN,PN2 : PNameID;
+begin
+{$ifdef DEBUG}
+  for i:=0 to NameIDList^.Count-1 do
+    begin
+      PN:=NameIDList^.At(i);
+      if not (IsFound in PN^.GetState) then
+        begin
+          if (IsReferenced in PN^.GetState) then
+            DebugMessage(GetDocumentURL,'Name "'+PN^.GetName+'" from "'+
+              PN^.GetOrigin+'" not found',1,1);
+          PN2:=Owner^.FindID(PN^.GetName);
+          if assigned(PN2) then
+            begin
+              DebugMessage('','ID found in "'+PN2^.GetOrigin+'"',1,1);
+              if not (IsFound in PN2^.GetState) then
+                DebugMessage('','ID not found',1,1);
+            end;
+        end;
+    end;
+{$endif DEBUG}
+end;
+
+
+function  THTMLLinkScanFile.FindID(const AName : string) : PNameID;
+var
+  PN : PNameID;
+  Index : sw_integer;
+begin
+  new(PN,init(AName,IsID));
+  if NameIDList^.Search(PN,Index) then
+    begin
+      dispose(PN,done);
+      PN:=NameIDList^.At(Index);
+      if (IsID in PN^.GetState) then
+        FindId:=PN
+      else
+        FindID:=nil;
+    end
+  else
+    begin
+      dispose(PN,done);
+      PN:=nil;
+      FindID:=nil;
+    end;
+
+end;
 destructor THTMLLinkScanFile.Done;
 destructor THTMLLinkScanFile.Done;
 begin
 begin
+  if Assigned(DocumentURL) then
+    DisposeStr(DocumentURL);
+  DocumentURL:=nil;
+  dispose(NameIDList,done);
+  NameIDList:=nil;
   inherited Done;
   inherited Done;
-  if Assigned(DocumentURL) then DisposeStr(DocumentURL); DocumentURL:=nil;
 end;
 end;
 
 
 function THTMLLinkScanFileCollection.At(Index: sw_Integer): PHTMLLinkScanFile;
 function THTMLLinkScanFileCollection.At(Index: sw_Integer): PHTMLLinkScanFile;
@@ -555,22 +826,44 @@ begin
   FindFileWithState:=P;
   FindFileWithState:=P;
 end;
 end;
 
 
+procedure THTMLLinkScanFileCollection.CheckNameIDLists;
+
+  procedure DoCheckNameList(P : PHTMLLinkScanFile);
+    begin
+      P^.CheckNameList;
+    end;
+
+begin
+  ForEach(@DoCheckNameList);
+end;
+
+
 constructor THTMLFileLinkScanner.Init(const ABaseDir: string);
 constructor THTMLFileLinkScanner.Init(const ABaseDir: string);
 begin
 begin
   inherited Init(ABaseDir);
   inherited Init(ABaseDir);
   New(DocumentFiles, Init(50,100));
   New(DocumentFiles, Init(50,100));
+  New(IDList, Init(50,100));
+{$ifdef DEBUG}
+  DebugMessage('','THTMLFileLinkScanner Init "'+ABaseDir+'"',1,1);
+{$endif DEBUG}
 end;
 end;
 
 
 procedure THTMLFileLinkScanner.ProcessDocument(const DocumentURL: string; AOptions: THTMLLinkScanOptions);
 procedure THTMLFileLinkScanner.ProcessDocument(const DocumentURL: string; AOptions: THTMLLinkScanOptions);
 var P: PHTMLLinkScanFile;
 var P: PHTMLLinkScanFile;
 begin
 begin
-  CurBaseURL:=''; Options:=AOptions;
+  CurBaseURL:='';
+  Options:=AOptions;
   ScheduleDoc(DocumentURL);
   ScheduleDoc(DocumentURL);
   repeat
   repeat
     P:=DocumentFiles^.FindFileWithState(ssScheduled);
     P:=DocumentFiles^.FindFileWithState(ssScheduled);
     if Assigned(P) then
     if Assigned(P) then
       ProcessDoc(P);
       ProcessDoc(P);
   until P=nil;
   until P=nil;
+{$ifdef DEBUG}
+  DebugMessage('','THTMLFileLinkScanner CheckNameList start ',1,1);
+  DocumentFiles^.CheckNameIDLists;
+  DebugMessage('','THTMLFileLinkScanner CheckNameList end ',1,1);
+{$endif DEBUG}
 end;
 end;
 
 
 function THTMLFileLinkScanner.GetDocumentBaseURL: string;
 function THTMLFileLinkScanner.GetDocumentBaseURL: string;
@@ -596,11 +889,109 @@ begin
   P:=Pos('#',LinkURL);
   P:=Pos('#',LinkURL);
   if P=0 then DocURL:=LinkURL else DocURL:=copy(LinkURL,1,P-1);
   if P=0 then DocURL:=LinkURL else DocURL:=copy(LinkURL,1,P-1);
   D:=DocumentFiles^.SearchFile(DocURL);
   D:=DocumentFiles^.SearchFile(DocURL);
-  if Assigned(D)=false then
+  if not Assigned(D) then
       ScheduleDoc(DocURL);
       ScheduleDoc(DocURL);
   inherited AddLink(LinkText,LinkURL);
   inherited AddLink(LinkText,LinkURL);
 end;
 end;
 
 
+procedure THTMLFileLinkScanner.AddRef(LinkURL: string);
+var D: PHTMLLinkScanFile;
+    P: sw_integer;
+    DocURL: string;
+    PN : PNameID;
+begin
+{$ifdef DEBUG}
+  DebugMessage(CurDoc,' Adding Ref to "'+
+    LinkURL+'"',Line,1);
+{$endif DEBUG}
+  P:=Pos('#',LinkURL);
+  if P=0 then DocURL:=LinkURL else DocURL:=copy(LinkURL,1,P-1);
+  D:=DocumentFiles^.SearchFile(DocURL);
+  if not Assigned(D) then
+      ScheduleDoc(DocURL);
+  D:=DocumentFiles^.SearchFile(DocURL);
+  if P>0 then
+    begin
+      PN:=D^.AddReferencedName(copy(LinkURL,P+1,length(LinkURL)));
+      PN^.SetOrigin(CurDoc);
+      PN^.SetLine(Line);
+    end;
+end;
+
+procedure THTMLFileLinkScanner.AddNameID(AName : string);
+var D: PHTMLLinkScanFile;
+    P: sw_integer;
+    PN : PNameID;
+    DocURL: string;
+begin
+{$ifdef DEBUG}
+  DebugMessage(CurDoc,' Adding NameID "'+
+    CurName+'"',Line,1);
+{$endif DEBUG}
+  P:=Pos('#',AName);
+  if P=0 then DocURL:=AName else DocURL:=copy(AName,1,P-1);
+  D:=DocumentFiles^.SearchFile(DocURL);
+  if not Assigned(D) then
+      ScheduleDoc(DocURL);
+  D:=DocumentFiles^.SearchFile(DocURL);
+  PN:=D^.AddFoundName(copy(AName,P+1,length(AName)));
+  PN^.SetOrigin(CurDoc);
+  PN^.SetLine(Line);
+end;
+
+procedure THTMLFileLinkScanner.AddID(AName : string);
+var
+  D: PHTMLLinkScanFile;
+  PN : PNameID;
+  index : sw_integer;
+begin
+{$ifdef DEBUG}
+  DebugMessage(CurDoc,' Adding Id "'+
+    AName+'"',Line,1);
+{$endif DEBUG}
+  D:=DocumentFiles^.SearchFile(CurDoc);
+  if not Assigned(D) then
+      ScheduleDoc(CurDoc);
+  D:=DocumentFiles^.SearchFile(CurDoc);
+  PN:=D^.AddFoundName(AName);
+  PN^.SetState(IsId,true);
+  PN^.SetOrigin(CurDoc);
+  PN^.SetLine(Line);
+
+  new(PN,init(AName,IsID));
+  if IDList^ .Search(PN,index) then
+    begin
+      dispose(PN,done);
+{$ifdef DEBUG}
+      PN:=IDList^.At(Index);
+      DebugMessage(CurDoc,'ID "'+AName+'" already defined in "'+
+        PN^.GetOrigin+'('+IntToStr(PN^.GetLine)+')"',Line,1);
+{$endif DEBUG}
+    end
+  else
+    begin
+      IDList^.Insert(PN);
+      PN^.SetOrigin(CurDoc);
+      PN^.SetLine(Line);
+    end;
+end;
+
+function THTMLFileLinkScanner.FindID(const AName : string) : PNameID;
+
+  Function ContainsNamedID(D : PHTMLLinkScanFile) : boolean;
+    begin
+      ContainsNamedID:=D^.FindID(AName)<>nil;
+    end;
+var
+  D : PHTMLLinkScanFile;
+begin
+  D:=DocumentFiles^.FirstThat(@ContainsNamedID);
+  if assigned(D) then
+    FindID:=D^.FindID(AName)
+  else
+    FindID:=nil;
+end;
+
 procedure THTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
 procedure THTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
 var F: PDOSTextFile;
 var F: PDOSTextFile;
 begin
 begin
@@ -608,11 +999,17 @@ begin
 
 
   Doc^.State:=ssProcessing;
   Doc^.State:=ssProcessing;
   CurDoc:=Doc^.GetDocumentURL;
   CurDoc:=Doc^.GetDocumentURL;
-  New(F, Init(Doc^.GetDocumentURL));
+  New(F, Init(CurDoc));
   if Assigned(F) then
   if Assigned(F) then
     begin
     begin
-      CurBaseURL:=CompleteURL(Doc^.GetDocumentURL,'');
+      CurBaseURL:=CompleteURL(CurDoc,'');
+{$ifdef DEBUG}
+      DebugMessage(CurDoc,'Processing "'+CurDoc+'"',1,1);
+{$endif DEBUG}
       Process(F);
       Process(F);
+{$ifdef DEBUG}
+      DebugMessage(CurDoc,'Finished processing "'+CurDoc+'"',Line,1);
+{$endif DEBUG}
       Dispose(F, Done);
       Dispose(F, Done);
     end
     end
   else
   else
@@ -630,13 +1027,22 @@ var D: PHTMLLinkScanFile;
 begin
 begin
   New(D, Init(DocumentURL));
   New(D, Init(DocumentURL));
   D^.State:=ssScheduled;
   D^.State:=ssScheduled;
+  D^.Owner:=@Self;
+{$ifdef DEBUG}
+      DebugMessage('','Scheduling file "'+DocumentURL+'"',1,1);
+{$endif DEBUG}
   DocumentFiles^.Insert(D);
   DocumentFiles^.Insert(D);
 end;
 end;
 
 
 destructor THTMLFileLinkScanner.Done;
 destructor THTMLFileLinkScanner.Done;
 begin
 begin
+  if Assigned(DocumentFiles) then
+    Dispose(DocumentFiles, Done);
+  DocumentFiles:=nil;
+  if Assigned(IDList) then
+    Dispose(IDList, Done);
+  IDList:=nil;
   inherited Done;
   inherited Done;
-  if Assigned(DocumentFiles) then Dispose(DocumentFiles, Done); DocumentFiles:=nil;
 end;
 end;
 
 
 procedure RegisterWHTMLScan;
 procedure RegisterWHTMLScan;

+ 9 - 9
ide/wutils.pas

@@ -76,9 +76,9 @@ type
     constructor Init;
     constructor Init;
     function    GetPos: Longint; virtual;
     function    GetPos: Longint; virtual;
     function    GetSize: Longint; virtual;
     function    GetSize: Longint; virtual;
-    procedure   Read(var Buf; Count: Word); virtual;
+    procedure   Read(var Buf; Count: longint); virtual;
     procedure   Seek(Pos: Longint); virtual;
     procedure   Seek(Pos: Longint); virtual;
-    procedure   Write(var Buf; Count: Word); virtual;
+    procedure   Write(var Buf; Count: longint); virtual;
   end;
   end;
 
 
   PSubStream = ^TSubStream;
   PSubStream = ^TSubStream;
@@ -86,9 +86,9 @@ type
     constructor Init(AStream: PStream; AStartPos, ASize: longint);
     constructor Init(AStream: PStream; AStartPos, ASize: longint);
     function    GetPos: Longint; virtual;
     function    GetPos: Longint; virtual;
     function    GetSize: Longint; virtual;
     function    GetSize: Longint; virtual;
-    procedure   Read(var Buf; Count: Word); virtual;
+    procedure   Read(var Buf; Count: longint); virtual;
     procedure   Seek(Pos: Longint); virtual;
     procedure   Seek(Pos: Longint); virtual;
-    procedure   Write(var Buf; Count: Word); virtual;
+    procedure   Write(var Buf; Count: longint); virtual;
   private
   private
     StartPos: longint;
     StartPos: longint;
     S       : PStream;
     S       : PStream;
@@ -827,7 +827,7 @@ begin
   GetSize:=Position;
   GetSize:=Position;
 end;
 end;
 
 
-procedure TNulStream.Read(var Buf; Count: Word);
+procedure TNulStream.Read(var Buf; Count: longint);
 begin
 begin
   Error(stReadError,0);
   Error(stReadError,0);
 end;
 end;
@@ -838,7 +838,7 @@ begin
     Position:=Pos;
     Position:=Pos;
 end;
 end;
 
 
-procedure TNulStream.Write(var Buf; Count: Word);
+procedure TNulStream.Write(var Buf; Count: longint);
 begin
 begin
   Inc(Position,Count);
   Inc(Position,Count);
 end;
 end;
@@ -863,9 +863,9 @@ begin
   GetSize:=StreamSize;
   GetSize:=StreamSize;
 end;
 end;
 
 
-procedure TSubStream.Read(var Buf; Count: Word);
+procedure TSubStream.Read(var Buf; Count: longint);
 var Pos: longint;
 var Pos: longint;
-    RCount: word;
+    RCount: longint;
 begin
 begin
   Pos:=GetPos;
   Pos:=GetPos;
   if Pos+Count>StreamSize then RCount:=StreamSize-Pos else RCount:=Count;
   if Pos+Count>StreamSize then RCount:=StreamSize-Pos else RCount:=Count;
@@ -881,7 +881,7 @@ begin
   S^.Seek(StartPos+RPos);
   S^.Seek(StartPos+RPos);
 end;
 end;
 
 
-procedure TSubStream.Write(var Buf; Count: Word);
+procedure TSubStream.Write(var Buf; Count: longint);
 begin
 begin
   S^.Write(Buf,Count);
   S^.Write(Buf,Count);
 end;
 end;