* New Gabor changes : see fixes.txt

ide/text/fixes.txt

@@ -1,3 +1,5 @@
+Gabor's log 25/4/2000 commits
+
 ========================= Fixes to apply ==============================
 
 The GO32 mouse.inc (API) displays a message ("No mouse driver found!") when
@@ -43,3 +45,34 @@ it doesn't find a mouse driver. This message should be removed.
 
 =========================== Todo ========================================
 
+Gabor's log for 18/4/2000 commits
+
+========================= Already fixed ================================
+
+ [*] THTMLTopicRenderer didn't handle table tags (<TABLE>,<TR>,<TH>,<TD>)
+ [*] the IDE didn't prompt the user for saving modified files at exit, when
+     there were multiple editor windows open for the same file
+ [*] the IDE didn't respond to some hotkeys (for ex. Alt+F3) after a success-
+     ful compilation
+
+========================== Other improvements ============================
+
+ [+] HTML index generation added. This enables users to index any collection
+     of HTML files, for ex. the HTML version of the FPC docs.
+     This way we can finally get a WinAPI help for the IDE. The user simply
+     has to download a .chm version of the WinAPI help, decompile it with the
+     M$ HTML Help Workshop, and install it as a help file...
+     (however this will only work in a DOS box under W9X, or with the win32
+     version of IDE, as these HTML files use long filenames)
+ [+] TCodeEditor acts now on several additional keys, like
+     Ctrl+O+A - Open at cursor      , Ctrl+O+B - Browse at cursor      ,
+     Ctrl+O+G - Go to line number   , Ctrl+O+O - Insert options        ,
+     Ctrl+O+U - Toggle case of char , Ctrl+O+L - Select line           ,
+     Ctrl+K+S - Save file           , Ctrl+K+D - Activate menubar      ,
+     Ctrl+K+N - Block to uppercase  , Ctrl+K+O - Block to lowercase    ,
+     Ctrl+K+E - Word to lowercase   , Ctrl+K+F - Word to uppercase     ,
+     Ctrl+Q+E - Jump to top of wnd  , Ctrl+Q+T - Jump to top of wnd    ,
+     Ctrl+Q+U - Jump to bottom of wnd,Ctrl+Q+X - Jump to bottom of wnd ,
+     Ctrl+Q+[ - find delimiter-match, Ctrl+Q+] - find delimited match (backw)
+
+=========================== Todo ========================================

ide/text/fp.pas

@@ -38,7 +38,7 @@ uses
   Drivers,Views,App,Dialogs,ColorSel,Menus,StdDlg,Validate,
   {$ifdef EDITORS}Editors{$else}WEditor,WCEdit{$endif},
   ASCIITab,Calc,
-  WUtils,WViews,
+  WUtils,WViews,WHTMLScn,
   FPIDE,FPCalc,FPCompile,
   FPIni,FPViews,FPConst,FPVars,FPUtils,FPHelp,FPSwitch,FPUsrScr,
   FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPTemplt,FPCatch,FPRedir,FPDesk,
@@ -147,6 +147,7 @@ begin
   RegisterValidate;
   RegisterViews;
 
+  RegisterWHTMLScan;
   RegisterWUtils;
   RegisterWViews;
 end;
@@ -205,7 +206,7 @@ BEGIN
   repeat
     IDEApp.Run;
     if (AutoSaveOptions and asEditorFiles)=0 then
-      CanExit:=true
+      CanExit:=IDEApp.AskSaveAll
     else
       CanExit:=IDEApp.SaveAll;
   until CanExit;
@@ -237,7 +238,10 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.43  2000-04-18 11:42:36  pierre
+  Revision 1.44  2000-04-25 08:42:32  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.43  2000/04/18 11:42:36  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.42  2000/03/21 23:34:10  pierre

ide/text/fpcompil.pas

@@ -28,7 +28,7 @@ interface
 uses
   Objects,
   Drivers,Views,Dialogs,
-  WViews,
+  WUtils,WViews,
   FPSymbol,
   FPViews;
 
@@ -85,7 +85,6 @@ procedure ParseUserScreen;
 
 procedure RegisterFPCompile;
 
-
 implementation
 
 uses
@@ -94,8 +93,8 @@ uses
 {$endif}
   Dos,Video,
   App,Commands,tokens,
-  CompHook, Compiler, systems, browcol,
-  WUtils,WEditor,
+  CompHook, Compiler, systems, browcol, switches,
+  WEditor,
   FPRedir,FPDesk,FPUsrScr,FPHelp,
   FPIde,FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
 
@@ -636,6 +635,8 @@ var
   ErrFile : Text;
   Error,LinkErrorCount : longint;
   E : TEvent;
+  DummyView: PView;
+  R: TRect;
 const
   PpasFile = 'ppas';
 
@@ -793,6 +794,17 @@ begin
   releasetempheap;
   unsplit_heap;
 {$endif TEMPHEAP}
+  DummyView:=Desktop^.First;
+  while (DummyView<>nil) and (DummyView^.GetState(sfVisible)=false) do
+  begin
+    DummyView:=DummyView^.NextView;
+  end;
+  with DummyView^ do
+   if GetState(sfVisible) then
+    begin
+      SetState(sfSelected,false);
+      SetState(sfSelected,true);
+    end;
   if Assigned(CompilerMessageWindow) then
     with CompilerMessageWindow^ do
       begin
@@ -873,7 +885,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.55  2000-04-18 11:42:36  pierre
+  Revision 1.56  2000-04-25 08:42:32  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.55  2000/04/18 11:42:36  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.54  2000/03/23 22:23:21  pierre

ide/text/fpconst.pas

@@ -18,7 +18,7 @@ unit FPConst;
 interface
 
 uses Views,App,Commands,
-     WViews;
+     WViews,WEditor;
 
 const
      VersionStr           = '0.9';
@@ -44,7 +44,8 @@ const
      GDBOutPutFileName    = 'gdb___.txt';
      DesktopTempName      = 'fp___.dsk';
 
-     HelpFileExts         = '*.tph;*.htm*';
+     HTMLIndexExt         = '.htx';
+     HelpFileExts         = '*.tph;*.htm*;*'+HTMLIndexExt;
 
      EnterSign            = #17#196#217;
 
@@ -188,8 +189,6 @@ const
      cmHelpFiles         = 2105;
      cmAbout             = 2106;
 
-     cmOpenAtCursor      = 2200;
-     cmBrowseAtCursor    = 2201;
      cmEditorOptions     = 2202;
      cmBrowserOptions    = 2203;
 
@@ -396,7 +395,10 @@ implementation
 END.
 {
   $Log$
-  Revision 1.36  2000-04-18 11:42:36  pierre
+  Revision 1.37  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.36  2000/04/18 11:42:36  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.35  2000/03/14 14:16:13  pierre

ide/text/fpdesk.pas

@@ -21,6 +21,7 @@ const
      DesktopVersion     = $0007; { <- if you change any Load&Store methods,
                                       default object properties (Options,State)
                                       then you should also change this }
+     HTMLIndexVersion   = DesktopVersion;
 
      ResDesktopFlags    = 'FLAGS';
      ResVideo           = 'VIDEOMODE';
@@ -792,7 +793,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.26  2000-04-18 11:42:36  pierre
+  Revision 1.27  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.26  2000/04/18 11:42:36  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.25  2000/03/21 23:32:05  pierre

ide/text/fphelp.pas

@@ -25,7 +25,8 @@ uses
 {$else}
   WEditor,WCEdit,
 {$endif}
-  WViews,FPViews;
+  WViews,WHTMLScn,
+  FPViews;
 
 type
     PIDEStatusLine = ^TIDEStatusLine;
@@ -34,6 +35,13 @@ type
       procedure HandleEvent(var Event: TEvent); virtual;
     end;
 
+    PFPHTMLFileLinkScanner = ^TFPHTMLFileLinkScanner;
+    TFPHTMLFileLinkScanner = object(THTMLFileLinkScanner)
+       function    CheckURL(const URL: string): boolean; virtual;
+       function    CheckText(const Text: string): boolean; virtual;
+       procedure   ProcessDoc(Doc: PHTMLLinkScanFile); virtual;
+    end;
+
 procedure Help(FileID, Context: THelpCtx; Modal: boolean);
 procedure HelpIndex(Keyword: string);
 procedure HelpTopicSearch(Editor: PEditor);
@@ -58,7 +66,7 @@ const
 implementation
 
 uses Objects,Views,App,MsgBox,Commands,
-     WHTMLHlp,
+     WUtils,WHTMLHlp,
      FPConst,FPVars,FPUtils;
 
 const
@@ -225,6 +233,35 @@ begin
   Hint:=S;
 end;
 
+procedure TFPHTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
+begin
+  PushStatus('Indexing file '+Doc^.GetDocumentURL);
+  inherited ProcessDoc(Doc);
+  PopStatus;
+end;
+
+function TFPHTMLFileLinkScanner.CheckURL(const URL: string): boolean;
+var OK: boolean;
+const HTTPPrefix = 'http:';
+      FTPPrefix  = 'ftp:';
+begin
+  OK:=inherited CheckURL(URL);
+  if OK then OK:=DirAndNameOf(URL)<>'';
+  if OK then OK:=CompareText(copy(ExtOf(URL),1,4),'.HTM')=0;
+  if OK then OK:=CompareText(copy(URL,1,length(HTTPPrefix)),HTTPPrefix)<>0;
+  if OK then OK:=CompareText(copy(URL,1,length(FTPPrefix)),FTPPrefix)<>0;
+  CheckURL:=OK;
+end;
+
+function TFPHTMLFileLinkScanner.CheckText(const Text: string): boolean;
+var OK: boolean;
+    S: string;
+begin
+  S:=Trim(Text);
+  OK:=(S<>'') and (copy(S,1,1)<>'[');
+  CheckText:=OK;
+end;
+
 procedure InitHelpSystem;
 
   procedure AddOAFile(HelpFile: string);
@@ -241,6 +278,13 @@ procedure InitHelpSystem;
     {$IFDEF DEBUG}SetStatus(strLoadingHelp);{$ENDIF}
   end;
 
+  procedure AddHTMLIndexFile(HelpFile: string);
+  begin
+    {$IFDEF DEBUG}SetStatus(strLoadingHelp+' ('+SmartPath(HelpFile)+')');{$ENDIF}
+    HelpFacility^.AddHTMLIndexHelpFile(HelpFile);
+    {$IFDEF DEBUG}SetStatus(strLoadingHelp);{$ENDIF}
+  end;
+
 var I,P: sw_integer;
     S: string;
     TopicTitle: string;
@@ -256,8 +300,9 @@ begin
         begin TopicTitle:=copy(S,P+1,255); S:=copy(S,1,P-1); end;
       if TopicTitle='' then TopicTitle:=S;
       if copy(UpcaseStr(ExtOf(S)),1,4)='.HTM' then { this recognizes both .htm and .html }
-          AddHTMLFile(TopicTitle,S)
-      else
+          AddHTMLFile(TopicTitle,S) else
+      if UpcaseStr(ExtOf(S))='.HTX' then
+          AddHTMLIndexFile(S) else
         AddOAFile(S);
     end;
   PopStatus;
@@ -409,11 +454,13 @@ begin
   Desktop^.ForEach(@CloseIfHelpWindow);
 end;
 
-
 END.
 {
   $Log$
-  Revision 1.28  2000-03-21 23:31:14  pierre
+  Revision 1.29  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.28  2000/03/21 23:31:14  pierre
    adapted to wcedit addition by Gabor
 
   Revision 1.27  2000/02/07 11:58:01  pierre

ide/text/fpide.pas

@@ -22,6 +22,7 @@ uses
   Objects,Drivers,Views,App,Gadgets,MsgBox,
   {$ifdef EDITORS}Editors,{$else}WEditor,WCEdit,{$endif}
   Comphook,Browcol,
+  WHTMLScn,
   FPViews,FPSymbol,fpstring;
 
 type
@@ -34,6 +35,7 @@ type
       procedure   InitStatusLine; virtual;
       procedure   Open(FileName: string);
       function    OpenSearch(FileName: string) : boolean;
+      function    AskSaveAll: boolean;
       function    SaveAll: boolean;
       function    AutoSave: boolean;
       procedure   Idle; virtual;
@@ -989,7 +991,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.57  2000-04-18 11:42:37  pierre
+  Revision 1.58  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.57  2000/04/18 11:42:37  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.56  2000/03/21 23:30:49  pierre

ide/text/fpmfile.inc

@@ -167,6 +167,15 @@ begin
      RemoveRecentFile(RecentIndex);
 end;
 
+function TIDEApp.AskSaveAll: boolean;
+function CanClose(P: PView): boolean; {$ifndef FPC}far;{$endif}
+begin
+  CanClose:=not P^.Valid(cmQuit);
+end;
+begin
+  AskSaveAll:=Desktop^.FirstThat(@CanClose)=nil;
+end;
+
 function TIDEApp.SaveAll: boolean;
 
   procedure SendSave(P: PView); {$ifndef FPC}far;{$endif}
@@ -189,7 +198,10 @@ end;
 
 {
   $Log$
-  Revision 1.18  2000-03-21 23:29:52  pierre
+  Revision 1.19  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.18  2000/03/21 23:29:52  pierre
    + Use TrimEndSlash by Gabor
 
   Revision 1.17  1999/12/01 16:48:09  pierre

ide/text/fpmhelp.inc

@@ -110,6 +110,9 @@ var I: integer;
     FileName: string;
     Re: word;
     S: string;
+    LS: PFPHTMLFileLinkScanner;
+    BS: PBufStream;
+{    Version: word;}
 begin
   case Event.What of
     evKeyDown :
@@ -135,8 +138,64 @@ begin
             if Re<>cmCancel then
             begin
               D^.GetFileName(FileName);
+              if UpcaseStr(ExtOf(FileName))='.HTX' then
+                begin
+                  S:='HTML Index';
+                end
+              else
               if UpcaseStr(copy(ExtOf(FileName),1,4))='.HTM' then
-                Re:=InputBox('Topic title','Title',S,40);
+              begin
+                Re:=ConfirmBox('Create keyword index from help file?',nil,true);
+                if Re<>cmCancel then
+                if Re=cmNo then
+                  Re:=InputBox('Topic title','Title',S,40)
+                else
+                  begin
+                    ShowMessage('Please wait while creating index...');
+                    S:='HTML Index';
+                    PushStatus('Building index file '+FileName);
+                    New(LS, Init);
+                    LS^.ProcessDocument(FileName,[soSubDocsOnly]);
+                    if LS^.GetDocumentCount=0 then
+                      begin
+                        ErrorBox(FileName+' doesn''t contain any links, thus it isn''t suitable for indexing.',nil);
+                        Re:=cmCancel;
+                      end
+                    else
+                      begin
+                        FileName:=DirAndNameOf(FileName)+HTMLIndexExt;
+                        if ExistsFile(FileName) then
+                          if ConfirmBox('Index file '+FileName+' already exists. Overwrite?',nil,true)<>cmYes then
+                            Re:=cmCancel;
+                        if Re<>cmCancel then
+                        begin
+                          PushStatus('Storing HTML index in '+FileName);
+                          New(BS, Init(FileName, stCreate, 4096));
+                          if Assigned(BS)=false then
+                            begin
+                              ErrorBox('Can''t create '+FileName,nil);
+                              Re:=cmCancel;
+                            end
+                          else
+                            begin
+{                              Version:=HTMLIndexVersion;
+                              BS^.Write(Version,sizeof(Version));}
+                              LS^.StoreDocuments(BS^);
+                              if BS^.Status<>stOK then
+                                begin
+                                  ErrorBox('Error storing index data',nil);
+                                  Re:=cmCancel;
+                                end;
+                              Dispose(BS, Done);
+                            end;
+                          PopStatus;
+                        end;
+                      end;
+                    Dispose(LS, Done);
+                    PopStatus;
+                    HideMessage;
+                  end;
+              end;
             end;
             if Re<>cmCancel then
             begin
@@ -190,7 +249,10 @@ end;
 
 {
   $Log$
-  Revision 1.8  2000-02-07 08:29:13  michael
+  Revision 1.9  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.8  2000/02/07 08:29:13  michael
   [*] the fake (!) TOKENS.PAS still contained the typo bug
        FSplit(,n,d,e) (correctly FSplit(,d,n,e))
   [*] CodeComplete had a very ugly bug - coordinates were document-relative

ide/text/fpmopts.inc

@@ -89,8 +89,8 @@ begin
     Count:=SyntaxSwitches^.ItemCount;
     R.Copy(TabIR);
     R2.Copy(R);
-    R2.B.X:=(R2.A.X+(R2.B.X-R2.A.X) div 2)-2;
-    R2.B.Y:=R2.A.Y+Count;
+{    R2.B.X:=(R2.A.X+(R2.B.X-R2.A.X) div 2)-2;} R2.B.X:=R2.B.X-4;
+    R2.B.Y:=R2.A.Y+((Count+1) div 2);
     Items:=nil;
     for I:=Count-1 downto 0 do
       Items:=NewSItem(SyntaxSwitches^.ItemName(I), Items);
@@ -1212,7 +1212,10 @@ end;
 
 {
   $Log$
-  Revision 1.31  2000-03-21 23:28:13  pierre
+  Revision 1.32  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.31  2000/03/21 23:28:13  pierre
    adapted to wcedit addition by Gabor
 
   Revision 1.30  2000/03/13 20:34:07  pierre

ide/text/fpswitch.pas

@@ -20,6 +20,7 @@ interface
 uses
   Objects,
   Systems,
+  WUtils,
   FPConst;
 
 const
@@ -27,6 +28,15 @@ const
      MaxMemSize      = 67107840; { max. local heap and stack size }
 
 type
+    TParamID =
+      (idNone,idAlign,idRangeChecks,idStackChecks,idIOChecks,
+       idOverflowChecks,idAsmDirect,idAsmATT,idAsmIntel,
+       idSymInfNone,idSymInfGlobalOnly,idSymInfGlobalLocal,
+       idStackSize,idHeapSize,idStrictVarStrings,idExtendedSyntax,
+       idMMXOps,idTypedAddress,idPackRecords,idPackEnum,idStackFrames,
+       idReferenceInfo,idDebugInfo,idBoolEval,
+       idLongString,idTypeInfo);
+
     TSwitchMode = (om_Normal,om_Debug,om_Release);
 
     TSwitchItemTyp = (ot_Select,ot_Boolean,ot_String,ot_Longint);
@@ -36,30 +46,37 @@ type
       Typ       : TSwitchItemTyp;
       Name      : string[50];
       Param     : string[10];
-      constructor Init(const n,p:string);
+      ParamID   : TParamID;
+      constructor Init(const n,p:string; AID: TParamID);
       function  NeedParam:boolean;virtual;
       function  ParamValue:string;virtual;
+      function  ParamValueBool(SM: TSwitchMode):boolean;virtual;
+      function  GetSwitchStr(SM: TSwitchMode): string; virtual;
+      function  GetNumberStr(SM: TSwitchMode): string; virtual;
+      function  GetOptionStr(SM: TSwitchMode): string; virtual;
       procedure Reset;virtual;
     end;
 
     PSelectItem = ^TSelectItem;
     TSelectItem = object(TSwitchItem)
-      constructor Init(const n,p:string);
+      constructor Init(const n,p:string; AID: TParamID);
     end;
 
     PBooleanItem = ^TBooleanItem;
     TBooleanItem = object(TSwitchItem)
       IsSet : array[TSwitchMode] of boolean;
-      constructor Init(const n,p:string);
+      constructor Init(const n,p:string; AID: TParamID);
       function  NeedParam:boolean;virtual;
       procedure Reset;virtual;
+      function  GetSwitchStr(SM: TSwitchMode): string; virtual;
+      function  ParamValueBool(SM: TSwitchMode):boolean;virtual;
     end;
 
     PStringItem = ^TStringItem;
     TStringItem = object(TSwitchItem)
       Str : array[TSwitchMode] of string;
       multiple : boolean;
-      constructor Init(const n,p:string;mult:boolean);
+      constructor Init(const n,p:string;AID: TParamID; mult:boolean);
       function  NeedParam:boolean;virtual;
       function  ParamValue:string;virtual;
       procedure Reset;virtual;
@@ -68,9 +85,10 @@ type
     PLongintItem = ^TLongintItem;
     TLongintItem = object(TSwitchItem)
       Val : array[TSwitchMode] of longint;
-      constructor Init(const n,p:string);
+      constructor Init(const n,p:string; AID: TParamID);
       function  NeedParam:boolean;virtual;
       function  ParamValue:string;virtual;
+      function  GetNumberStr(SM: TSwitchMode): string; virtual;
       procedure Reset;virtual;
     end;
 
@@ -84,10 +102,10 @@ type
       function  ItemName(index:integer):string;
       function  ItemParam(index:integer):string;
       { type specific }
-      procedure AddSelectItem(const name,param:string);
-      procedure AddBooleanItem(const name,param:string);
-      procedure AddLongintItem(const name,param:string);
-      procedure AddStringItem(const name,param:string;mult:boolean);
+      procedure AddSelectItem(const name,param:string; AID: TParamID);
+      procedure AddBooleanItem(const name,param:string; AID: TParamID);
+      procedure AddLongintItem(const name,param:string; AID: TParamID);
+      procedure AddStringItem(const name,param:string;AID: TParamID;mult:boolean);
       function  GetCurrSel:integer;
       function  GetCurrSelParam : String;
       function  GetBooleanItem(index:integer):boolean;
@@ -148,6 +166,7 @@ procedure SetDefaultSwitches;
 procedure DoneSwitches;
 function  GetSourceDirectories : string;
 
+procedure GetCompilerOptionLines(C: PUnsortedStringCollection);
 
 implementation
 
@@ -163,11 +182,12 @@ var
             TSwitchItem
 *****************************************************************************}
 
-constructor TSwitchItem.Init(const n,p:string);
+constructor TSwitchItem.Init(const n,p:string; AID: TParamID);
 begin
   Inherited Init;
   Name:=n;
   Param:=p;
+  ParamID:=AID;
 end;
 
 
@@ -182,6 +202,29 @@ begin
   ParamValue:='';
 end;
 
+function TSwitchItem.ParamValueBool(SM: TSwitchMode):boolean;
+begin
+  Abstract;
+  ParamValueBool:=false;
+end;
+
+function TSwitchItem.GetSwitchStr(SM: TSwitchMode): string;
+begin
+  Abstract;
+  GetSwitchStr:='';
+end;
+
+function TSwitchItem.GetNumberStr(SM: TSwitchMode): string;
+begin
+  Abstract;
+  GetNumberStr:='';
+end;
+
+function TSwitchItem.GetOptionStr(SM: TSwitchMode): string;
+begin
+  Abstract;
+  GetOptionStr:='';
+end;
 
 procedure TSwitchItem.Reset;
 begin
@@ -192,9 +235,9 @@ end;
             TSelectItem
 *****************************************************************************}
 
-constructor TSelectItem.Init(const n,p:string);
+constructor TSelectItem.Init(const n,p:string; AID: TParamID);
 begin
-  Inherited Init(n,p);
+  Inherited Init(n,p,AID);
   Typ:=ot_Select;
 end;
 
@@ -203,9 +246,9 @@ end;
                 TBooleanItem
 *****************************************************************************}
 
-constructor TBooleanItem.Init(const n,p:string);
+constructor TBooleanItem.Init(const n,p:string; AID: TParamID);
 begin
-  Inherited Init(n,p);
+  Inherited Init(n,p,AID);
   Typ:=ot_Boolean;
   Reset;
 end;
@@ -222,14 +265,24 @@ begin
   FillChar(IsSet,sizeof(IsSet),0);
 end;
 
+function TBooleanItem.ParamValueBool(SM: TSwitchMode):boolean;
+begin
+  ParamValueBool:=IsSet[SM];
+end;
+
+function TBooleanItem.GetSwitchStr(SM: TSwitchMode): string;
+begin
+  GetSwitchStr:=BoolToStr(IsSet[SM],'+','-');
+end;
+
 
 {*****************************************************************************
             TStringItem
 *****************************************************************************}
 
-constructor TStringItem.Init(const n,p:string;mult:boolean);
+constructor TStringItem.Init(const n,p:string; AID: TParamID; mult:boolean);
 begin
-  Inherited Init(n,p);
+  Inherited Init(n,p,AID);
   Typ:=ot_String;
   Multiple:=mult;
   Reset;
@@ -258,9 +311,9 @@ end;
                 TLongintItem
 *****************************************************************************}
 
-constructor TLongintItem.Init(const n,p:string);
+constructor TLongintItem.Init(const n,p:string; AID: TParamID);
 begin
-  Inherited Init(n,p);
+  Inherited Init(n,p,AID);
   Typ:=ot_Longint;
   Reset;
 end;
@@ -280,12 +333,16 @@ begin
   ParamValue:=s;
 end;
 
-
 procedure TLongintItem.Reset;
 begin
   FillChar(Val,sizeof(Val),0);
 end;
 
+function TLongintItem.GetNumberStr(SM: TSwitchMode): string;
+begin
+  GetNumberStr:=IntToStr(Val[SM]);
+end;
+
 
 {*****************************************************************************
                TSwitch
@@ -315,27 +372,27 @@ begin
 end;
 
 
-procedure TSwitches.AddSelectItem(const name,param:string);
+procedure TSwitches.AddSelectItem(const name,param:string; AID: TParamID);
 begin
-  Items^.Insert(New(PSelectItem,Init(name,Param)));
+  Items^.Insert(New(PSelectItem,Init(name,Param,AID)));
 end;
 
 
-procedure TSwitches.AddBooleanItem(const name,param:string);
+procedure TSwitches.AddBooleanItem(const name,param:string; AID: TParamID);
 begin
-  Items^.Insert(New(PBooleanItem,Init(name,Param)));
+  Items^.Insert(New(PBooleanItem,Init(name,Param,AID)));
 end;
 
 
-procedure TSwitches.AddLongintItem(const name,param:string);
+procedure TSwitches.AddLongintItem(const name,param:string; AID: TParamID);
 begin
-  Items^.Insert(New(PLongintItem,Init(name,Param)));
+  Items^.Insert(New(PLongintItem,Init(name,Param,AID)));
 end;
 
 
-procedure TSwitches.AddStringItem(const name,param:string;mult:boolean);
+procedure TSwitches.AddStringItem(const name,param:string;AID: TParamID;mult:boolean);
 begin
-  Items^.Insert(New(PStringItem,Init(name,Param,mult)));
+  Items^.Insert(New(PStringItem,Init(name,Param,AID,mult)));
 end;
 
 
@@ -731,139 +788,142 @@ begin
   New(SyntaxSwitches,Init('S'));
   with SyntaxSwitches^ do
    begin
-     AddBooleanItem('~D~elphi 2 extensions on','2');
-     AddBooleanItem('~C~-like operators','c');
-     AddBooleanItem('S~t~op after first error','e');
-     AddBooleanItem('Allo~w~ LABEL and GOTO','g');
-     AddBooleanItem('C++ styled ~i~nline','i');
-     AddBooleanItem('Global C ~m~acros','m');
-     AddBooleanItem('TP/BP ~7~.0 compatibility','o');
-     AddBooleanItem('Del~p~hi compatibility','d');
-     AddBooleanItem('A~l~low STATIC in objects','s');
+     AddBooleanItem('~D~elphi 2 extensions on','2',idNone);
+     AddBooleanItem('~C~-like operators','c',idNone);
+     AddBooleanItem('S~t~op after first error','e',idNone);
+     AddBooleanItem('Allo~w~ LABEL and GOTO','g',idNone);
+     AddBooleanItem('C++ styled ~i~nline','i',idNone);
+     AddBooleanItem('Global C ~m~acros','m',idNone);
+     AddBooleanItem('TP/BP ~7~.0 compatibility','o',idNone);
+     AddBooleanItem('Del~p~hi compatibility','d',idNone);
+     AddBooleanItem('A~l~low STATIC in objects','s',idNone);
+     AddBooleanItem('Strict ~v~ar-strings','',idStrictVarStrings);
+     AddBooleanItem('E~x~tended syntax','',idExtendedSyntax);
+     AddBooleanItem('Allow MMX op~e~rations','',idMMXOps);
    end;
   New(VerboseSwitches,Init('v'));
   with VerboseSwitches^ do
    begin
-     AddBooleanItem('~W~arnings','w');
-     AddBooleanItem('N~o~tes','n');
-     AddBooleanItem('~H~ints','h');
-     AddBooleanItem('General ~I~nfo','i');
-     AddBooleanItem('~U~sed,tried info','ut');
-     AddBooleanItem('~A~ll','a');
-     AddBooleanItem('Show all ~P~rocedures if error','b');
+     AddBooleanItem('~W~arnings','w',idNone);
+     AddBooleanItem('N~o~tes','n',idNone);
+     AddBooleanItem('~H~ints','h',idNone);
+     AddBooleanItem('General ~I~nfo','i',idNone);
+     AddBooleanItem('~U~sed,tried info','ut',idNone);
+     AddBooleanItem('~A~ll','a',idNone);
+     AddBooleanItem('Show all ~P~rocedures if error','b',idNone);
    end;
   New(CodegenSwitches,Init('C'));
   with CodegenSwitches^ do
    begin
-     AddBooleanItem('~R~ange checking','r');
-     AddBooleanItem('~S~tack checking','t');
-     AddBooleanItem('~I~/O checking','i');
-     AddBooleanItem('Integer ~o~verflow checking','o');
+     AddBooleanItem('~R~ange checking','r',idRangeChecks);
+     AddBooleanItem('~S~tack checking','t',idStackChecks);
+     AddBooleanItem('~I~/O checking','i',idIOChecks);
+     AddBooleanItem('Integer ~o~verflow checking','o',idOverflowChecks);
    end;
   New(OptimizingGoalSwitches,InitSelect('O'));
   with OptimizingGoalSwitches^ do
     begin
-       AddSelectItem('Generate ~f~aster code','G');
-       AddSelectItem('Generate s~m~aller code','g');
+       AddSelectItem('Generate ~f~aster code','G',idNone);
+       AddSelectItem('Generate s~m~aller code','g',idNone);
     end;
   New(OptimizationSwitches,Init('O'));
   with OptimizationSwitches^ do
    begin
-     AddBooleanItem('Use regis~t~er-variables','r');
-     AddBooleanItem('~U~ncertain optimizations','u');
-     AddBooleanItem('Level ~1~ optimizations','1');
-     AddBooleanItem('Level ~2~ optimizations','2');
+     AddBooleanItem('Use regis~t~er-variables','r',idNone);
+     AddBooleanItem('~U~ncertain optimizations','u',idNone);
+     AddBooleanItem('Level ~1~ optimizations','1',idNone);
+     AddBooleanItem('Level ~2~ optimizations','2',idNone);
    end;
   New(ProcessorSwitches,InitSelect('O'));
   with ProcessorSwitches^ do
    begin
-     AddSelectItem('i~3~86/i486','p1');
-     AddSelectItem('Pentium/PentiumMM~X~ (tm)','p2');
-     AddSelectItem('P~P~ro/PII/c6x86/K6 (tm)','p3');
+     AddSelectItem('i~3~86/i486','p1',idNone);
+     AddSelectItem('Pentium/PentiumMM~X~ (tm)','p2',idNone);
+     AddSelectItem('P~P~ro/PII/c6x86/K6 (tm)','p3',idNone);
    end;
   New(TargetSwitches,InitSelect('T'));
   with TargetSwitches^ do
    begin
-     AddSelectItem('DOS (GO32V~1~)','go32v1');
-     AddSelectItem('~D~OS (GO32V2)','go32v2');
-     AddSelectItem('~L~inux','linux');
-     AddSelectItem('~O~S/2','os2');
-     AddSelectItem('~W~IN32','win32');
+     AddSelectItem('DOS (GO32V~1~)','go32v1',idNone);
+     AddSelectItem('~D~OS (GO32V2)','go32v2',idNone);
+     AddSelectItem('~L~inux','linux',idNone);
+     AddSelectItem('~O~S/2','os2',idNone);
+     AddSelectItem('~W~IN32','win32',idNone);
    end;
   New(AsmReaderSwitches,InitSelect('R'));
   with AsmReaderSwitches^ do
    begin
-     AddSelectItem('~D~irect assembler','direct');
-     AddSelectItem('~A~T&T style assembler','att');
-     AddSelectItem('~I~ntel style assembler','intel');
+     AddSelectItem('~D~irect assembler','direct',idAsmDirect);
+     AddSelectItem('~A~T&T style assembler','att',idAsmATT);
+     AddSelectItem('~I~ntel style assembler','intel',idAsmIntel);
    end;
   New(AsmInfoSwitches,Init('a'));
   with AsmInfoSwitches^ do
    begin
-     AddBooleanItem('~L~ist source','l');
-     AddBooleanItem('list ~r~egister allocation','r');
-     AddBooleanItem('list ~t~emp allocation','t');
+     AddBooleanItem('~L~ist source','l',idNone);
+     AddBooleanItem('list ~r~egister allocation','r',idNone);
+     AddBooleanItem('list ~t~emp allocation','t',idNone);
    end;
   New(AsmOutputSwitches,InitSelect('A'));
   with AsmOutputSwitches^ do
    begin
-     AddSelectItem('Use ~G~NU as','as');
-     AddSelectItem('Use ~N~ASM coff','nasmcoff');
-     AddSelectItem('Use NASM ~e~lf','nasmelf');
-     AddSelectItem('Use NASM ~o~bj','nasmobj');
-     AddSelectItem('Use ~M~ASM','masm');
-     AddSelectItem('Use ~T~ASM','tasm');
-     AddSelectItem('Use ~c~off','coff');
-     AddSelectItem('Use ~p~ecoff','pecoff');
+     AddSelectItem('Use ~G~NU as','as',idNone);
+     AddSelectItem('Use ~N~ASM coff','nasmcoff',idNone);
+     AddSelectItem('Use NASM ~e~lf','nasmelf',idNone);
+     AddSelectItem('Use NASM ~o~bj','nasmobj',idNone);
+     AddSelectItem('Use ~M~ASM','masm',idNone);
+     AddSelectItem('Use ~T~ASM','tasm',idNone);
+     AddSelectItem('Use ~c~off','coff',idNone);
+     AddSelectItem('Use ~p~ecoff','pecoff',idNone);
    end;
   New(BrowserSwitches,InitSelect('b'));
   with BrowserSwitches^ do
    begin
-     AddSelectItem('N~o~ browser','-');
-     AddSelectItem('Only Glob~a~l browser','+');
-     AddSelectItem('~L~ocal and global browser','l');
+     AddSelectItem('N~o~ browser','-',idSymInfNone);
+     AddSelectItem('Only Glob~a~l browser','+',idSymInfGlobalOnly);
+     AddSelectItem('~L~ocal and global browser','l',idSymInfGlobalLocal);
    end;
   New(ConditionalSwitches,Init('d'));
   with ConditionalSwitches^ do
    begin
-     AddStringItem('Conditio~n~al defines','',true);
+     AddStringItem('Conditio~n~al defines','',idNone,true);
    end;
   New(MemorySwitches,Init('C'));
   with MemorySwitches^ do
    begin
-     AddLongintItem('~S~tack size','s');
-     AddLongintItem('~H~eap size','h');
+     AddLongintItem('~S~tack size','s',idStackSize);
+     AddLongintItem('~H~eap size','h',idHeapSize);
    end;
   New(DirectorySwitches,Init('F'));
   with DirectorySwitches^ do
    begin
-     AddStringItem('~U~nit directories','u',true);
-     AddStringItem('~I~nclude directories','i',true);
-     AddStringItem('~L~ibrary directories','l',true);
-     AddStringItem('~O~bject directories','o',true);
-     AddStringItem('~E~XE & PPU directories','E',true);
+     AddStringItem('~U~nit directories','u',idNone,true);
+     AddStringItem('~I~nclude directories','i',idNone,true);
+     AddStringItem('~L~ibrary directories','l',idNone,true);
+     AddStringItem('~O~bject directories','o',idNone,true);
+     AddStringItem('~E~XE & PPU directories','E',idNone,true);
    end;
 
   New(LibLinkerSwitches,InitSelect('X'));
   with LibLinkerSwitches^ do
    begin
-     AddSelectItem('~D~ynamic libraries','D');
-     AddSelectItem('~S~tatic libraries','S');
+     AddSelectItem('~D~ynamic libraries','D',idNone);
+     AddSelectItem('~S~tatic libraries','S',idNone);
    end;
   New(DebugInfoSwitches,InitSelect('g'));
   with DebugInfoSwitches^ do
    begin
-     AddSelectItem('~S~trip all debug symbols from executable','-');
-     AddSelectItem('Generate ~d~ebug symbol information','');
-     AddSelectItem('Generate also backtrace ~l~ine information','l');
+     AddSelectItem('~S~trip all debug symbols from executable','-',idNone);
+     AddSelectItem('Generate ~d~ebug symbol information','',idNone);
+     AddSelectItem('Generate also backtrace ~l~ine information','l',idNone);
      { AddSelectItem('Generate ~d~bx symbol information','d');
        does not work anyhow (PM) }
    end;
   New(ProfileInfoSwitches,InitSelect('p'));
   with ProfileInfoSwitches^ do
    begin
-     AddSelectItem('~N~o profile information','-');
-     AddSelectItem('Generate profile code for g~p~rof','g');
+     AddSelectItem('~N~o profile information','-',idNone);
+     AddSelectItem('Generate profile code for g~p~rof','g',idNone);
    end;
   {New(MemorySizeSwitches,Init('C'));
   with MemorySizeSwitches^ do
@@ -875,7 +935,6 @@ begin
   if SwitchesPath='' then
     SwitchesPath:=SwitchesName;
   SwitchesPath:=FExpand(SwitchesPath);
-
 end;
 
 procedure SetDefaultSwitches;
@@ -958,11 +1017,106 @@ begin
 
 end;
 
+procedure GetCompilerOptionLines(C: PUnsortedStringCollection);
+procedure AddLine(const S: string);
+begin
+  C^.Insert(NewStr(S));
+end;
+procedure ConstructSwitchModeDirectives(SM: TSwitchMode; const IfDefSym: string);
+var SwitchParams: PStringCollection;
+    MiscParams  : PStringCollection;
+procedure AddSwitch(const S: string);
+begin
+  SwitchParams^.Insert(NewStr(S));
+end;
+procedure AddParam(const S: string);
+begin
+  MiscParams^.Insert(NewStr(S));
+end;
+procedure EnumSwitches(P: PSwitches);
+procedure HandleSwitch(P: PSwitchItem); {$ifndef FPC}far;{$endif}
+begin
+  case P^.ParamID of
+{    idAlign :}
+    idRangeChecks    : AddSwitch('R'+P^.GetSwitchStr(SM));
+    idStackChecks    : AddSwitch('S'+P^.GetSwitchStr(SM));
+    idIOChecks       : AddSwitch('I'+P^.GetSwitchStr(SM));
+    idOverflowChecks : AddSwitch('Q'+P^.GetSwitchStr(SM));
+{    idAsmDirect      : if P^.GetParamValueBool[SM] then AddParam('ASMMODE DIRECT');
+    idAsmATT         : if P^.GetParamValueBool[SM] then AddParam('ASMMODE ATT');
+    idAsmIntel       : if P^.GetParamValueBool[SM] then AddParam('ASMMODE INTEL');}
+{    idSymInfNone     : ;
+    idSymInfGlobalOnly:;
+    idSymInfGlobalLocal:if P^.ParamValueBool(SM) then AddSwitch('L+');}
+{    idStackSize
+    idHeapSize}
+    idStrictVarStrings: AddSwitch('V'+P^.GetSwitchStr(SM));
+    idExtendedSyntax  : AddSwitch('X'+P^.GetSwitchStr(SM));
+    idMMXOps          : if P^.ParamValueBool(SM) then AddParam('MMX');
+    idTypedAddress    : AddSwitch('T'+P^.GetSwitchStr(SM));
+{    idPackRecords
+    idPackEnum}
+    idStackFrames     : AddSwitch('W'+P^.GetSwitchStr(SM));
+    idReferenceInfo   : AddSwitch('Y'+P^.GetSwitchStr(SM));
+    idDebugInfo       : AddSwitch('D'+P^.GetSwitchStr(SM));
+    idBoolEval        : AddSwitch('B'+P^.GetSwitchStr(SM));
+    idLongString      : AddSwitch('H'+P^.GetSwitchStr(SM));
+    idTypeInfo        : AddSwitch('M'+P^.GetSwitchStr(SM));
+   end;
+end;
+begin
+  P^.Items^.ForEach(@HandleSwitch);
+end;
+var I: integer;
+    S: string;
+begin
+  AddLine('{$IFDEF '+IfDefSym+'}');
+  New(SwitchParams, Init(10,10));
+  New(MiscParams, Init(10,10));
+  EnumSwitches(LibLinkerSwitches);
+  EnumSwitches(DebugInfoSwitches);
+  EnumSwitches(ProfileInfoSwitches);
+  EnumSwitches(SyntaxSwitches);
+  EnumSwitches(VerboseSwitches);
+  EnumSwitches(CodegenSwitches);
+  EnumSwitches(OptimizationSwitches);
+  EnumSwitches(OptimizingGoalSwitches);
+  EnumSwitches(ProcessorSwitches);
+  EnumSwitches(AsmReaderSwitches);
+  EnumSwitches(AsmInfoSwitches);
+  EnumSwitches(AsmOutputSwitches);
+  EnumSwitches(TargetSwitches);
+  EnumSwitches(ConditionalSwitches);
+  EnumSwitches(MemorySwitches);
+  EnumSwitches(BrowserSwitches);
+  EnumSwitches(DirectorySwitches);
+  S:='';
+  for I:=0 to SwitchParams^.Count-1 do
+  begin
+    if I=0 then S:='{$' else S:=S+',';
+    S:=S+PString(SwitchParams^.At(I))^;
+  end;
+  if S<>'' then S:=S+'}';
+  if S<>'' then AddLine('  '+S);
+  for I:=0 to MiscParams^.Count-1 do
+    AddLine('  {$'+PString(MiscParams^.At(I))^+'}');
+  Dispose(SwitchParams, Done); Dispose(MiscParams, Done);
+  AddLine('{$ENDIF '+IfDefSym+'}');
+end;
+var SM: TSwitchMode;
+begin
+  for SM:=Low(TSwitchMode) to High(TSwitchMode) do
+    ConstructSwitchModeDirectives(SM,SwitchesModeStr[SM]);
+end;
+
 
 end.
 {
   $Log$
-  Revision 1.20  2000-03-08 16:51:50  pierre
+  Revision 1.21  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.20  2000/03/08 16:51:50  pierre
    + -gl option support
 
   Revision 1.19  2000/03/07 22:52:50  pierre

ide/text/fptools.pas

@@ -1206,7 +1206,7 @@ begin
               begin
                 I:=I+ReplacePart(LastWordStart,I-1,'')-1;
                 if W<>nil then
-                  if W^.Editor^.SaveAsk=false then
+                  if W^.Editor^.SaveAsk(true)=false then
                     Err:=-1;
               end;
           end else
@@ -1507,7 +1507,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.17  2000-04-18 11:42:37  pierre
+  Revision 1.18  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.17  2000/04/18 11:42:37  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.16  2000/03/13 20:31:54  pierre

ide/text/fpusrscr.pas

@@ -18,14 +18,6 @@ unit FPUsrScr;
 
 interface
 
-{$ifdef TP}
-  {$define DOS}
-{$else}
-  {$ifdef GO32V2}
-    {$define DOS}
-  {$endif}
-{$endif}
-
 uses
 {$ifdef win32}
   windows,
@@ -723,7 +715,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  2000-04-18 11:42:37  pierre
+  Revision 1.12  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.11  2000/04/18 11:42:37  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.10  2000/03/13 20:30:37  pierre

ide/text/fpvars.pas

@@ -20,7 +20,7 @@ unit FPVars;
 interface
 
 uses Objects,Views,App,
-     WUtils,
+     WUtils,WEditor,
      FPConst,
      FPDebug,
      FPUtils,FPViews,FPCalc;
@@ -100,7 +100,10 @@ implementation
 END.
 {
   $Log$
-  Revision 1.31  2000-04-18 11:42:37  pierre
+  Revision 1.32  2000-04-25 08:42:33  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.31  2000/04/18 11:42:37  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.30  2000/03/13 20:35:36  pierre

ide/text/fpviews.pas

@@ -151,6 +151,7 @@ type
       function    GetCommandTarget: PView; virtual;
       function    CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
       procedure   ModifiedChanged; virtual;
+      procedure   InsertOptions; virtual;
     end;
 
     PSourceWindow = ^TSourceWindow;
@@ -965,6 +966,30 @@ begin
     EditorModified:=true;
 end;
 
+procedure TSourceEditor.InsertOptions;
+var C: PUnsortedStringCollection;
+    Y: sw_integer;
+    S: string;
+begin
+  Lock;
+  New(C, Init(10,10));
+  GetCompilerOptionLines(C);
+  if C^.Count>0 then
+  begin
+    for Y:=0 to C^.Count-1 do
+    begin
+      S:=C^.At(Y)^;
+      InsertLine(Y,S);
+    end;
+    AdjustSelectionPos(0,0,0,C^.Count);
+    UpdateAttrs(0,attrAll);
+    DrawLines(0);
+    SetModified(true);
+  end;
+  Dispose(C, Done);
+  UnLock;
+end;
+
 function TSourceEditor.GetLocalMenu: PMenu;
 var M: PMenu;
 begin
@@ -1046,6 +1071,19 @@ var DontClear: boolean;
     S: string;
 begin
   TranslateMouseClick(@Self,Event);
+  case Event.What of
+    evKeyDown :
+      begin
+        DontClear:=false;
+        case Event.KeyCode of
+          kbCtrlEnter :
+            Message(@Self,evCommand,cmOpenAtCursor,nil);
+        else DontClear:=true;
+        end;
+        if not DontClear then ClearEvent(Event);
+      end;
+  end;
+  inherited HandleEvent(Event);
   case Event.What of
     evCommand :
       begin
@@ -1079,18 +1117,7 @@ begin
         end;
         if not DontClear then ClearEvent(Event);
       end;
-    evKeyDown :
-      begin
-        DontClear:=false;
-        case Event.KeyCode of
-          kbCtrlEnter :
-            Message(@Self,evCommand,cmOpenAtCursor,nil);
-        else DontClear:=true;
-        end;
-        if not DontClear then ClearEvent(Event);
-      end;
   end;
-  inherited HandleEvent(Event);
 end;
 
 constructor TFPHeapView.Init(var Bounds: TRect);
@@ -2953,7 +2980,7 @@ begin
 {$ifdef os2}
   OSStr:='OS/2';
 {$endif}
-  R.Assign(0,0,38,13);
+  R.Assign(0,0,38,14{$ifdef NODEBUG}-1{$endif});
   inherited Init(R, 'About');
 
   GetExtent(R); R.Grow(-3,-2);
@@ -3342,7 +3369,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.67  2000-04-18 11:42:37  pierre
+  Revision 1.68  2000-04-25 08:42:34  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.67  2000/04/18 11:42:37  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.66  2000/03/23 22:22:25  pierre

ide/text/wcedit.pas

@@ -213,7 +213,7 @@ type
           PScrollBar; AIndicator: PIndicator; ACore: PCodeEditorCore; const AFileName: string);
       function    Save: Boolean; virtual;
       function    SaveAs: Boolean; virtual;
-      function    SaveAsk: Boolean; virtual;
+      function    SaveAsk(Force: boolean): Boolean; virtual;
       function    LoadFile: boolean; virtual;
       function    SaveFile: boolean; virtual;
       function    Valid(Command: Word): Boolean; virtual;
@@ -1624,13 +1624,14 @@ begin
   end;
 end;
 
-function TFileEditor.SaveAsk: boolean;
+function TFileEditor.SaveAsk(Force: boolean): boolean;
 var OK: boolean;
     D: Sw_integer;
 begin
   OK:=GetModified=false;
-  if (OK=false) and (Core^.GetBindingCount>1) then
-    OK:=true;
+  if Force=false then
+    if (OK=false) and (Core^.GetBindingCount>1) then
+      OK:=true;
   if OK=false then
   begin
     if FileName = '' then D := edSaveUntitled else D := edSaveModify;
@@ -1681,7 +1682,7 @@ begin
   OK:=inherited Valid(Command);
   if OK and ((Command=cmClose) or (Command=cmQuit)) then
      if IsClipboard=false then
-    OK:=SaveAsk;
+    OK:=SaveAsk(Command=cmQuit);
   Valid:=OK;
 end;
 

ide/text/weditor.pas

@@ -40,6 +40,19 @@ const
       cmResetDebuggerRow     = 51248;
       cmAddChar              = 51249;
       cmExpandCodeTemplate   = 51250;
+      cmUpperCase            = 51251;
+      cmLowerCase            = 51252;
+      cmWindowStart          = 51253;
+      cmWindowEnd            = 51254;
+      cmFindMatchingDelimiter= 51255;
+      cmFindMatchingDelimiterBack=51256;
+      cmActivateMenu         = 51257;
+      cmWordLowerCase        = 51258;
+      cmWordUpperCase        = 51259;
+      cmOpenAtCursor         = 51260;
+      cmBrowseAtCursor       = 51261;
+      cmInsertOptions        = 51262;
+      cmToggleCase           = 51263;
 
       EditorTextBufSize = {$ifdef FPC}32768{$else} 4096{$endif};
       MaxLineLength     = {$ifdef FPC}  255{$else}  255{$endif};
@@ -376,6 +389,8 @@ type
       procedure   UpdateUndoRedo(cm : word; action : byte);virtual;
     end;
 
+    TCaseAction = (caToLowerCase,caToUpperCase,caToggleCase);
+
     TCustomCodeEditor = object(TScroller)
       SelStart   : TPoint;
       SelEnd     : TPoint;
@@ -418,8 +433,10 @@ type
    {a}function    GetInsertMode: boolean; virtual;
    {a}procedure   SetInsertMode(InsertMode: boolean); virtual;
       procedure   SetCurPtr(X,Y: sw_integer); virtual;
+      procedure   GetSelectionArea(var StartP,EndP: TPoint); virtual;
       procedure   SetSelection(A, B: TPoint); virtual;
       procedure   SetHighlight(A, B: TPoint); virtual;
+      procedure   ChangeCaseArea(StartP,EndP: TPoint; CaseAction: TCaseAction); virtual;
       procedure   SetLineFlagState(LineNo: sw_integer; Flags: longint; ASet: boolean);
       procedure   SetLineFlagExclusive(Flags: longint; LineNo: sw_integer);
       procedure   Update; virtual;
@@ -535,11 +552,20 @@ type
       procedure PageDown; virtual;
       procedure TextStart; virtual;
       procedure TextEnd; virtual;
+      procedure WindowStart; virtual;
+      procedure WindowEnd; virtual;
       procedure JumpSelStart; virtual;
       procedure JumpSelEnd; virtual;
       procedure JumpMark(MarkIdx: integer); virtual;
       procedure DefineMark(MarkIdx: integer); virtual;
       procedure JumpToLastCursorPos; virtual;
+      procedure FindMatchingDelimiter(ScanForward: boolean); virtual;
+      procedure UpperCase; virtual;
+      procedure LowerCase; virtual;
+      procedure WordLowerCase; virtual;
+      procedure WordUpperCase; virtual;
+      procedure InsertOptions; virtual;
+      procedure ToggleCase; virtual;
       function  InsertNewLine: Sw_integer; virtual;
       procedure BreakLine; virtual;
       procedure BackSpace; virtual;
@@ -572,6 +598,7 @@ type
       procedure ClipCut; virtual;
       procedure ClipPaste; virtual;
       function  GetCurrentWord : string;
+      function  GetCurrentWordArea(var StartP,EndP: TPoint): boolean;
       procedure Undo; virtual;
       procedure Redo; virtual;
       procedure Find; virtual;
@@ -670,7 +697,7 @@ const
      kbShift = kbLeftShift+kbRightShift;
 
 const
-  FirstKeyCount = 40;
+  FirstKeyCount = 41;
   FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
     Ord(^A), cmWordLeft, Ord(^B), cmJumpLine, Ord(^C), cmPageDown,
     Ord(^D), cmCharRight, Ord(^E), cmLineUp,
@@ -678,6 +705,7 @@ const
     Ord(^H), cmBackSpace, Ord(^J), cmExpandCodeTemplate,
     Ord(^K), $FF02, Ord(^L), cmSearchAgain,
     Ord(^M), cmNewLine, Ord(^N), cmBreakLine,
+    Ord(^O), $FF03,
     Ord(^P), cmASCIIChar, Ord(^Q), $FF01,
     Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
     Ord(^T), cmDelWord, Ord(^U), cmUndo,
@@ -692,7 +720,7 @@ const
     kbDel, cmDelChar, kbShiftIns, cmPaste,
     kbShiftDel, cmCut, kbCtrlIns, cmCopy,
     kbCtrlDel, cmClear);
-  QuickKeyCount = 23;
+  QuickKeyCount = 29;
   QuickKeys: array[0..QuickKeyCount * 2] of Word = (QuickKeyCount,
     Ord('A'), cmReplace, Ord('C'), cmTextEnd,
     Ord('D'), cmLineEnd, Ord('F'), cmFind,
@@ -701,11 +729,14 @@ const
     Ord('G'), cmJumpLine, Ord('A'), cmReplace,
     Ord('B'), cmSelStart, Ord('K'), cmSelEnd,
     Ord('P'), cmLastCursorPos,
+    Ord('E'), cmWindowStart, Ord('T'), cmWindowStart,
+    Ord('U'), cmWindowEnd, Ord('X'), cmWindowEnd,
+    Ord('['), cmFindMatchingDelimiter, Ord(']'), cmFindMatchingDelimiterBack,
     Ord('0'), cmJumpMark0, Ord('1'), cmJumpMark1, Ord('2'), cmJumpMark2,
     Ord('3'), cmJumpMark3, Ord('4'), cmJumpMark4, Ord('5'), cmJumpMark5,
     Ord('6'), cmJumpMark6, Ord('7'), cmJumpMark7, Ord('8'), cmJumpMark8,
     Ord('9'), cmJumpMark9);
-  BlockKeyCount = 23;
+  BlockKeyCount = 29;
   BlockKeys: array[0..BlockKeyCount * 2] of Word = (BlockKeyCount,
     Ord('B'), cmStartSelect, Ord('C'), cmCopyBlock,
     Ord('H'), cmHideSelect, Ord('K'), cmEndSelect,
@@ -714,11 +745,20 @@ const
     Ord('T'), cmSelectWord, Ord('L'), cmSelectLine,
     Ord('W'), cmWriteBlock, Ord('R'), cmReadBlock,
     Ord('P'), cmPrintBlock,
+    Ord('N'), cmUpperCase, Ord('O'), cmLowerCase,
+    Ord('D'), cmActivateMenu,
+    Ord('E'), cmWordLowerCase, Ord('F'), cmWordUpperCase,
+    Ord('S'), cmSave,
     Ord('0'), cmSetMark0, Ord('1'), cmSetMark1, Ord('2'), cmSetMark2,
     Ord('3'), cmSetMark3, Ord('4'), cmSetMark4, Ord('5'), cmSetMark5,
     Ord('6'), cmSetMark6, Ord('7'), cmSetMark7, Ord('8'), cmSetMark8,
     Ord('9'), cmSetMark9);
-  KeyMap: array[0..2] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys);
+  MiscKeyCount = 6;
+  MiscKeys: array[0..MiscKeyCount * 2] of Word = (MiscKeyCount,
+    Ord('A'), cmOpenAtCursor, Ord('B'), cmBrowseAtCursor,
+    Ord('G'), cmJumpLine, Ord('O'), cmInsertOptions,
+    Ord('U'), cmToggleCase, Ord('L'), cmSelectLine);
+  KeyMap: array[0..3] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys, @MiscKeys);
 
 function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
 type
@@ -750,10 +790,10 @@ begin
   IsWordSeparator:=C in[' ',#0,#255,':','=','''','"','.',',','/',';','$','#','(',')','<','>','^','*','+','-','?','&','[',']'];
 end;
 
-function IsSpace(C: char): boolean;
+{function IsSpace(C: char): boolean;
 begin
   IsSpace:=C in[' ',#0,#255];
-end;
+end;}
 
 function LTrim(S: string): string;
 begin
@@ -837,13 +877,6 @@ begin
   upper[0]:=s[0];
 end;
 
-function DirAndNameOf(const Path: string): string;
-var D: DirStr; N: NameStr; E: ExtStr;
-begin
-  FSplit(Path,D,N,E);
-  DirAndNameOf:=D+N;
-end;
-
 type TPosOfs = {$ifdef TP}longint{$endif}{$ifdef FPC}comp{$endif};
 
 function PosToOfs(const X,Y: sw_integer): TPosOfs;
@@ -906,7 +939,7 @@ begin
   ExtractTabs:=S;
 end;
 
-function CompressUsingTabs(S: string; TabSize: byte): string;
+{function CompressUsingTabs(S: string; TabSize: byte): string;
 var TabS: string;
     P: byte;
 begin
@@ -917,7 +950,7 @@ begin
       S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,255);
   until P=0;
   CompressUsingTabs:=S;
-end;
+end;}
 
 
 {*****************************************************************************
@@ -2086,14 +2119,14 @@ begin
     NextLine:=GetLine(CurLine);
     if Assigned(NextLine) then NextLI:=NextLine^.GetEditorInfo(Editor) else NextLI:=nil;
     if ((Attrs and attrForceFull)=0) then
-      if {  Why should we go
-         (InAsm=false) and (NextLine^.BeginsWithAsm=false) and
-         (InComment=false) and (NextLine^.BeginsWithComment=false) and
-         (InDirective=false) and (NextLine^.BeginsWithDirective=false) and
-          OldLine = Line so this is nonsense
-         (OldLine^.EndsWithComment=Line^.EndsWithComment) and
-         (OldLine^.EndsWithAsm=Line^.EndsWithAsm) and
-         (OldLine^.EndsWithDirective=Line^.EndsWithDirective) and }
+      if (*  Why should we go
+         (InAsm=false) and (NextLI^.BeginsWithAsm=false) and
+         (InComment=false) and (NextLI^.BeginsWithComment=false) and
+         (InDirective=false) and (NextLI^.BeginsWithDirective=false) and
+{          OldLine = Line so this is nonsense}
+         (PrevLI^.EndsWithComment=LI^.EndsWithComment) and
+         (PrevLI^.EndsWithAsm=LI^.EndsWithAsm) and
+         (PrevLI^.EndsWithDirective=LI^.EndsWithDirective) and *)
 {$ifdef TEST_PARTIAL_SYNTAX}
          (CurLine>FromLine) and
 {$endif TEST_PARTIAL_SYNTAX}
@@ -2936,6 +2969,8 @@ begin
           cmPageDown    : PageDown;
           cmTextStart   : TextStart;
           cmTextEnd     : TextEnd;
+          cmWindowStart : WindowStart;
+          cmWindowEnd   : WindowEnd;
           cmNewLine     : InsertNewLine;
           cmBreakLine   : BreakLine;
           cmBackSpace   : BackSpace;
@@ -2957,6 +2992,14 @@ begin
           cmSelStart    : JumpSelStart;
           cmSelEnd      : JumpSelEnd;
           cmLastCursorPos : JumpToLastCursorPos;
+          cmFindMatchingDelimiter : FindMatchingDelimiter(true);
+          cmFindMatchingDelimiterBack : FindMatchingDelimiter(false);
+          cmUpperCase     : UpperCase;
+          cmLowerCase     : LowerCase;
+          cmWordLowerCase : WordLowerCase;
+          cmWordUpperCase : WordUpperCase;
+          cmInsertOptions : InsertOptions;
+          cmToggleCase    : ToggleCase;
           cmJumpMark0..cmJumpMark9 : JumpMark(Event.Command-cmJumpMark0);
           cmSetMark0..cmSetMark9 : DefineMark(Event.Command-cmSetMark0);
           cmSelectWord  : SelectWord;
@@ -2986,6 +3029,8 @@ begin
               P:=CurPos; Inc(P.X); Inc(P.Y);
               LocalMenu(P);
             end;
+          cmActivateMenu :
+            Message(Application,evCommand,cmMenu,nil);
         else
           begin
             DontClear:=true;
@@ -3542,6 +3587,16 @@ begin
   SetCurPtr(i,GetLineCount-1);
 end;
 
+procedure TCustomCodeEditor.WindowStart;
+begin
+  SetCurPtr(CurPos.X,Delta.Y);
+end;
+
+procedure TCustomCodeEditor.WindowEnd;
+begin
+  SetCurPtr(CurPos.X,Delta.Y+Size.Y-1);
+end;
+
 procedure TCustomCodeEditor.JumpSelStart;
 begin
   if ValidBlock then
@@ -3585,6 +3640,163 @@ begin
   NotImplemented;
 end;
 
+procedure TCustomCodeEditor.UpperCase;
+var StartP,EndP: TPoint;
+begin
+  if ValidBlock=false then Exit;
+  GetSelectionArea(StartP,EndP);
+  ChangeCaseArea(StartP,EndP,caToUpperCase);
+end;
+
+procedure TCustomCodeEditor.LowerCase;
+var StartP,EndP: TPoint;
+begin
+  if ValidBlock=false then Exit;
+  GetSelectionArea(StartP,EndP);
+  ChangeCaseArea(StartP,EndP,caToLowerCase);
+end;
+
+procedure TCustomCodeEditor.ToggleCase;
+var StartP,EndP: TPoint;
+begin
+  if ValidBlock=false then Exit;
+  GetSelectionArea(StartP,EndP);
+  ChangeCaseArea(StartP,EndP,caToggleCase);
+end;
+
+procedure TCustomCodeEditor.WordLowerCase;
+var StartP,EndP: TPoint;
+begin
+  if GetCurrentWordArea(StartP,EndP)=false then Exit;
+  ChangeCaseArea(StartP,EndP,caToLowerCase);
+end;
+
+procedure TCustomCodeEditor.WordUpperCase;
+var StartP,EndP: TPoint;
+begin
+  if GetCurrentWordArea(StartP,EndP)=false then Exit;
+  ChangeCaseArea(StartP,EndP,caToUpperCase);
+end;
+
+procedure TCustomCodeEditor.ChangeCaseArea(StartP,EndP: TPoint; CaseAction: TCaseAction);
+var Y,X: sw_integer;
+    X1,X2: sw_integer;
+    S: string;
+    C: char;
+begin
+  Lock;
+  for Y:=StartP.Y to EndP.Y do
+  begin
+    S:=GetDisplayText(Y);
+    { Pierre, please implement undo here! Gabor }
+    X1:=0; X2:=length(S)-1;
+    if Y=StartP.Y then X1:=StartP.X;
+    if Y=EndP.Y then X2:=EndP.X;
+    for X:=X1 to X2 do
+    begin
+      C:=S[X+1];
+      case CaseAction of
+        caToLowerCase : C:=LowCase(C);
+        caToUpperCase : C:=UpCase(C);
+        caToggleCase  : if C in['a'..'z'] then
+                          C:=Upcase(C)
+                        else
+                         C:=LowCase(C);
+       end;
+      S[X+1]:=C;
+    end;
+    SetDisplayText(Y,S);
+  end;
+  UpdateAttrsRange(StartP.Y,EndP.Y,attrAll);
+  DrawLines(CurPos.Y);
+  SetModified(true);
+  UnLock;
+end;
+
+procedure TCustomCodeEditor.InsertOptions;
+begin
+  { Abstract }
+  NotImplemented;
+end;
+
+procedure TCustomCodeEditor.FindMatchingDelimiter(ScanForward: boolean);
+const OpenSymbols  : string[6] = '[{(<''"';
+      CloseSymbols : string[6] = ']})>''"';
+var SymIdx: integer;
+    LineText,LineAttr: string;
+    CurChar: char;
+    X,Y: sw_integer;
+    P,LineCount: sw_integer;
+    JumpPos: TPoint;
+    BracketLevel: integer;
+begin
+  JumpPos.X:=-1; JumpPos.Y:=-1;
+  LineText:=GetDisplayText(CurPos.Y);
+  LineText:=copy(LineText,CurPos.X+1,1);
+  if LineText='' then Exit;
+  CurChar:=LineText[1];
+  Y:=CurPos.Y; X:=CurPos.X; LineCount:=0;
+  BracketLevel:=1;
+  if ScanForward then
+    begin
+      SymIdx:=Pos(CurChar,OpenSymbols);
+      if SymIdx=0 then Exit;
+      repeat
+        Inc(LineCount);
+        GetDisplayTextFormat(Y,LineText,LineAttr);
+        if LineCount<>1 then X:=-1;
+        repeat
+          Inc(X);
+          if X<length(LineText) then
+           if copy(LineAttr,X+1,1)<>chr(attrComment) then
+             if (LineText[X+1]=CloseSymbols[SymIdx]) and (BracketLevel=1) then
+               begin
+                 JumpPos.X:=X; JumpPos.Y:=Y;
+               end
+             else
+               if LineText[X+1]=OpenSymbols[SymIdx] then
+                 Inc(BracketLevel)
+               else
+               if LineText[X+1]=CloseSymbols[SymIdx] then
+                 if BracketLevel>1 then
+                   Dec(BracketLevel);
+        until (X>=length(LineText)) or (JumpPos.X<>-1);
+        Inc(Y);
+      until (Y>=GetLineCount) or (JumpPos.X<>-1);
+    end
+  else
+    begin
+      SymIdx:=Pos(CurChar,CloseSymbols);
+      if SymIdx=0 then Exit;
+      repeat
+        Inc(LineCount);
+        GetDisplayTextFormat(Y,LineText,LineAttr);
+        if LineCount<>1 then X:=length(LineText);
+        repeat
+          Dec(X);
+          if X>0 then
+           if copy(LineAttr,X+1,1)<>chr(attrComment) then
+             if (LineText[X+1]=OpenSymbols[SymIdx]) and (BracketLevel=1) then
+               begin
+                 JumpPos.X:=X; JumpPos.Y:=Y;
+               end
+             else
+               if LineText[X+1]=CloseSymbols[SymIdx] then
+                 Inc(BracketLevel)
+               else
+               if LineText[X+1]=OpenSymbols[SymIdx] then
+                 if BracketLevel>1 then
+                   Dec(BracketLevel);
+        until (X<0) or (JumpPos.X<>-1);
+        Dec(Y);
+      until (Y<0) or (JumpPos.X<>-1);
+    end;
+  if JumpPos.X<>-1 then
+  begin
+    SetCurPtr(JumpPos.X,JumpPos.Y);
+    TrackCursor(true);
+  end;
+end;
 
 function TCustomCodeEditor.InsertNewLine: Sw_integer;
 var Ind: Sw_integer;
@@ -3885,26 +4097,42 @@ begin
   SetInsertMode(Overwrite);
 end;
 
-function  TCustomCodeEditor.GetCurrentWord : string;
+function TCustomCodeEditor.GetCurrentWordArea(var StartP,EndP: TPoint): boolean;
 const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
 var P : TPoint;
     S : String;
     StartPos,EndPos : byte;
+    OK: boolean;
 begin
   P:=CurPos;
   S:=GetLineText(P.Y);
   StartPos:=P.X+1;
   EndPos:=StartPos;
-  if not (S[StartPos] in WordChars) then
-    GetCurrentWord:=''
-  else
+  OK:=(S[StartPos] in WordChars);
+  if OK then
     begin
        While (StartPos>0) and (S[StartPos-1] in WordChars) do
-    Dec(StartPos);
+         Dec(StartPos);
        While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
-    Inc(EndPos);
-       GetCurrentWord:=Copy(S,StartPos,EndPos-StartPos+1);
+         Inc(EndPos);
+       StartP.X:=StartPos-1; StartP.Y:=CurPos.Y;
+       EndP.X:=EndPos-1; EndP.Y:=CurPos.Y;
+    end;
+  GetCurrentWordArea:=OK;
+end;
+
+function  TCustomCodeEditor.GetCurrentWord : string;
+var S: string;
+    StartP,EndP: TPoint;
+begin
+  if GetCurrentWordArea(StartP,EndP)=false then
+    S:=''
+  else
+    begin
+      S:=GetLineText(StartP.Y);
+      S:=copy(S,StartP.X+1,EndP.X-StartP.X+1);
     end;
+  GetCurrentWord:=S;
 end;
 
 procedure TCustomCodeEditor.StartSelect;
@@ -5039,6 +5267,18 @@ begin
   SetHighlight(CurPos,CurPos);
 end;
 
+procedure TCustomCodeEditor.GetSelectionArea(var StartP,EndP: TPoint);
+begin
+  StartP:=SelStart; EndP:=SelEnd;
+  if EndP.X=0 then
+    begin
+      Dec(EndP.Y);
+      EndP.X:=length(GetDisplayText(EndP.Y))-1;
+    end
+  else
+   Dec(EndP.X);
+end;
+
 function TCustomCodeEditor.ValidBlock: boolean;
 begin
   ValidBlock:=(SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y);
@@ -5600,7 +5840,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.87  2000-04-18 11:42:38  pierre
+  Revision 1.88  2000-04-25 08:42:34  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.87  2000/04/18 11:42:38  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.86  2000/03/23 21:36:19  pierre

ide/text/whelp.pas

@@ -207,8 +207,9 @@ type
         HelpFiles: PHelpFileCollection;
         IndexTabSize: sw_integer;
         constructor Init;
-        function    AddOAHelpFile(FileName: string): boolean;
-        function    AddHTMLHelpFile(FileName, TOCEntry: string): boolean;
+        function    AddOAHelpFile(const FileName: string): boolean;
+        function    AddHTMLHelpFile(const FileName, TOCEntry: string): boolean;
+        function    AddHTMLIndexHelpFile(const FileName: string): boolean;
         function    LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic; virtual;
         function    TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean; virtual;
         function    BuildIndexTopic: PTopic; virtual;
@@ -224,7 +225,7 @@ type
 const TopicCacheSize    : sw_integer = 10;
       HelpStreamBufSize : sw_integer = 4096;
       HelpFacility      : PHelpFacility = nil;
-      MaxHelpTopicSize  : sw_word = MaxBytes;
+      MaxHelpTopicSize  : sw_word = {$ifdef FPC}3*65520{$else}65520{$endif};
 
 function  NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string): PTopic;
 procedure DisposeTopic(P: PTopic);
@@ -773,20 +774,27 @@ begin
 end;
 
 
-function THelpFacility.AddOAHelpFile(FileName: string): boolean;
+function THelpFacility.AddOAHelpFile(const FileName: string): boolean;
 var H: PHelpFile;
 begin
   H:=New(POAHelpFile, Init(FileName, LastID+1));
   AddOAHelpFile:=AddFile(H);
 end;
 
-function THelpFacility.AddHTMLHelpFile(FileName, TOCEntry: string): boolean;
+function THelpFacility.AddHTMLHelpFile(const FileName, TOCEntry: string): boolean;
 var H: PHelpFile;
 begin
   H:=New(PHTMLHelpFile, Init(FileName, LastID+1, TOCEntry));
   AddHTMLHelpFile:=AddFile(H);;
 end;
 
+function THelpFacility.AddHTMLIndexHelpFile(const FileName: string): boolean;
+var H: PHelpFile;
+begin
+  H:=New(PHTMLIndexHelpFile, Init(FileName, LastID+1));
+  AddHTMLIndexHelpFile:=AddFile(H);;
+end;
+
 function THelpFacility.AddFile(H: PHelpFile): boolean;
 begin
   if H<>nil then
@@ -977,7 +985,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.18  2000-04-18 11:42:38  pierre
+  Revision 1.19  2000-04-25 08:42:35  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.18  2000/04/18 11:42:38  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.17  2000/02/07 11:47:25  pierre

ide/text/whlpview.pas

@@ -90,6 +90,7 @@ type
         Lines: PUnsortedStringCollection;
         Links: PLinkCollection;
         ColorAreas: PColorAreaCollection;
+      public
         constructor Init(ATopic: PTopic);
         procedure   SetParams(AMargin, AWidth: sw_integer); virtual;
         function    GetLineCount: sw_integer; virtual;
@@ -128,6 +129,7 @@ type
         procedure   SetCurPtr(X,Y: sw_integer); virtual;
         function    GetLineCount: sw_integer; virtual;
         function    GetLineText(Line: sw_integer): string; virtual;
+        function    GetDisplayText(I: sw_integer): string; virtual;
         function    GetLinkCount: sw_integer; virtual;
         procedure   GetLinkBounds(Index: sw_integer; var R: TRect); virtual;
         function    GetLinkFileID(Index: sw_integer): word; virtual;
@@ -607,6 +609,11 @@ begin
   GetLineCount:=Count;
 end;
 
+function THelpViewer.GetDisplayText(I: sw_integer): string;
+begin
+  GetDisplayText:=ExtractTabs(GetLineText(I),DefaultTabSize);
+end;
+
 function THelpViewer.GetLineText(Line: sw_integer): string;
 var S: string;
 begin
@@ -1147,7 +1154,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.13  2000-04-18 11:42:39  pierre
+  Revision 1.14  2000-04-25 08:42:35  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.13  2000/04/18 11:42:39  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.12  2000/03/21 23:21:38  pierre

ide/text/whtml.pas

@@ -98,6 +98,10 @@ type
       procedure   DocDefList(Entered: boolean); virtual;
       procedure   DocDefTerm; virtual;
       procedure   DocDefExp; virtual;
+      procedure   DocTable(Entered: boolean); virtual;
+      procedure   DocTableRow(Entered: boolean); virtual;
+      procedure   DocTableHeaderItem(Entered: boolean); virtual;
+      procedure   DocTableItem(Entered: boolean); virtual;
       procedure   DocHorizontalRuler; virtual;
     end;
 
@@ -168,6 +172,7 @@ var f: text;
     S: string;
 begin
   inherited Init;
+  if AFileName='' then Fail;
 {$I-}
   Assign(f,AFileName);
   Reset(f);
@@ -501,6 +506,11 @@ begin
   if (ETagName='DL') then DocDefList(NotEndTag) else
   if (UTagName='DT') then DocDefTerm else
   if (UTagName='DD') then DocDefExp else
+  { Table }
+  if (ETagName='TABLE') then DocTable(NotEndTag) else
+  if (UTagName='TR') then DocTableRow(NotEndTag) else
+  if (UTagName='TH') then DocTableHeaderItem(NotEndTag) else
+  if (UTagName='TD') then DocTableItem(NotEndTag) else
   { Misc. tags }
   if (UTagName='META') then DocMETA else
   if (UTagName='IMG') then DocImage else
@@ -676,6 +686,22 @@ procedure THTMLParser.DocDefExp;
 begin
 end;
 
+procedure THTMLParser.DocTable(Entered: boolean);
+begin
+end;
+
+procedure THTMLParser.DocTableRow(Entered: boolean);
+begin
+end;
+
+procedure THTMLParser.DocTableHeaderItem(Entered: boolean);
+begin
+end;
+
+procedure THTMLParser.DocTableItem(Entered: boolean);
+begin
+end;
+
 procedure THTMLParser.DocHorizontalRuler;
 begin
 end;
@@ -685,7 +711,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.5  2000-03-21 23:20:47  pierre
+  Revision 1.6  2000-04-25 08:42:35  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.5  2000/03/21 23:20:47  pierre
    suppress some warnings by Gabor
 
   Revision 1.4  1999/04/07 21:56:03  peter

ide/text/whtmlhlp.pas

@@ -8,7 +8,7 @@ const
      ListIndent = 2;
      DefIndent  = 4;
 
-     MaxTopicLinks = 500;
+     MaxTopicLinks = 500; { maximum link on a single HTML page }
 
 type
     PTopicLinkCollection = ^TTopicLinkCollection;
@@ -54,6 +54,9 @@ type
       procedure DocDefList(Entered: boolean); virtual;
       procedure DocDefTerm; virtual;
       procedure DocDefExp; virtual;
+      procedure DocTable(Entered: boolean); virtual;
+      procedure DocTableRow(Entered: boolean); virtual;
+      procedure DocTableItem(Entered: boolean); virtual;
       procedure DocHorizontalRuler; virtual;
     private
       URL: string;
@@ -78,84 +81,41 @@ type
       procedure AddChar(C: char);
     end;
 
-    PHTMLHelpFile = ^THTMLHelpFile;
-    THTMLHelpFile = object(THelpFile)
-      constructor Init(AFileName: string; AID: word; ATOCEntry: string);
+    PCustomHTMLHelpFile = ^TCustomHTMLHelpFile;
+    TCustomHTMLHelpFile = object(THelpFile)
+      constructor Init(AID: word);
       destructor  Done; virtual;
     public
-      function    LoadIndex: boolean; virtual;
       function    SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
       function    ReadTopic(T: PTopic): boolean; virtual;
     private
       Renderer: PHTMLTopicRenderer;
-      FileName: string;
+      DefaultFileName: string;
       CurFileName: string;
-      TOCEntry: string;
       TopicLinks: PTopicLinkCollection;
     end;
 
-implementation
-
-uses WUtils,
-     Dos;
+    PHTMLHelpFile = ^THTMLHelpFile;
+    THTMLHelpFile = object(TCustomHTMLHelpFile)
+      constructor Init(AFileName: string; AID: word; ATOCEntry: string);
+    public
+      function    LoadIndex: boolean; virtual;
+    private
+      TOCEntry: string;
+    end;
 
-const
-{$ifdef LINUX}
-  dirsep = '/';
-{$else}
-  dirsep = '\';
-{$endif}
-
-function FormatPath(Path: string): string;
-var P: sw_integer;
-    SC: char;
-begin
-  if ord(DirSep)=ord('/') then
-    SC:='\'
-  else
-    SC:='/';
+    PHTMLIndexHelpFile = ^THTMLIndexHelpFile;
+    THTMLIndexHelpFile = object(TCustomHTMLHelpFile)
+      constructor Init(AFileName: string; AID: word);
+      function    LoadIndex: boolean; virtual;
+    private
+      IndexFileName: string;
+    end;
 
-  repeat
-    P:=Pos(SC,Path);
-    if P>0 then Path[P]:=DirSep;
-  until P=0;
-  FormatPath:=Path;
-end;
+implementation
 
-function CompletePath(const Base, InComplete: string): string;
-var Drv,BDrv: string[40]; D,BD: DirStr; N,BN: NameStr; E,BE: ExtStr;
-    P: sw_integer;
-    Complete: string;
-begin
-  Complete:=FormatPath(InComplete);
-  FSplit(FormatPath(InComplete),D,N,E);
-  P:=Pos(':',D); if P=0 then Drv:='' else begin Drv:=copy(D,1,P); Delete(D,1,P); end;
-  FSplit(FormatPath(Base),BD,BN,BE);
-  P:=Pos(':',BD); if P=0 then BDrv:='' else begin BDrv:=copy(BD,1,P); Delete(BD,1,P); end;
-  if copy(D,1,1)<>'\' then
-    Complete:=BD+D+N+E;
-  if Drv='' then
-    Complete:=BDrv+Complete;
-  Complete:=FExpand(Complete);
-  CompletePath:=Complete;
-end;
-
-function CompleteURL(const Base, URLRef: string): string;
-var P: integer;
-    Drive: string[20];
-    IsComplete: boolean;
-    S: string;
-begin
-  IsComplete:=false;
-  P:=Pos(':',URLRef);
-  if P=0 then Drive:='' else Drive:=UpcaseStr(copy(URLRef,1,P-1));
-  if Drive<>'' then
-  if (Drive='MAILTO') or (Drive='FTP') or (Drive='HTTP') or (Drive='GOPHER') then
-    IsComplete:=true;
-  if IsComplete then S:=URLRef else
-    S:=CompletePath(Base,URLRef);
-  CompleteURL:=S;
-end;
+uses WUtils,WHTMLScn,
+     Dos;
 
 function EncodeHTMLCtx(FileID: integer; LinkNo: word): longint;
 var Ctx: longint;
@@ -377,6 +337,9 @@ end;
 
 procedure THTMLTopicRenderer.DocCode(Entered: boolean);
 begin
+  if AnyCharsInLine then DocBreak;
+  AddText(hscCode);
+  DocBreak;
 end;
 
 procedure THTMLTopicRenderer.DocEmphasized(Entered: boolean);
@@ -394,6 +357,7 @@ end;
 procedure THTMLTopicRenderer.DocPreformatted(Entered: boolean);
 begin
   if AnyCharsInLine then DocBreak;
+  AddText(hscCode);
   DocBreak;
   InPreformatted:=Entered;
 end;
@@ -464,6 +428,26 @@ begin
   Dec(Indent,DefIndent);
 end;
 
+procedure THTMLTopicRenderer.DocTable(Entered: boolean);
+begin
+  if AnyCharsInLine then
+    DocBreak;
+  if Entered then
+    DocBreak;
+end;
+
+procedure THTMLTopicRenderer.DocTableRow(Entered: boolean);
+begin
+  if AnyCharsInLine then
+    DocBreak;
+end;
+
+procedure THTMLTopicRenderer.DocTableItem(Entered: boolean);
+begin
+  if Entered then
+    AddText(' - ');
+end;
+
 procedure THTMLTopicRenderer.DocHorizontalRuler;
 var OAlign: TParagraphAlign;
 begin
@@ -530,7 +514,8 @@ begin
             end;
           Topic^.LinkCount:=LinkPtr{TopicLinks^.Count}; { <- eeeeeek! }
           GetMem(Topic^.Links,Topic^.LinkSize);
-          for I:=0 to Topic^.LinkCount-1 do
+          if Topic^.LinkCount>0 then { FP causes numeric RTE 215 without this }
+          for I:=0 to Min(Topic^.LinkCount-1,High(LinkIndexes)-1) do
             begin
               Topic^.Links^[I].FileID:=Topic^.FileID;
               Topic^.Links^[I].Context:=EncodeHTMLCtx(Topic^.FileID,LinkIndexes[I]+1);
@@ -550,22 +535,14 @@ begin
   BuildTopic:=OK;
 end;
 
-constructor THTMLHelpFile.Init(AFileName: string; AID: word; ATOCEntry: string);
+constructor TCustomHTMLHelpFile.Init(AID: word);
 begin
   inherited Init(AID);
-  FileName:=AFileName; TOCEntry:=ATOCEntry;
-  if FileName='' then Fail;
   New(Renderer, Init);
   New(TopicLinks, Init(50,500));
 end;
 
-function THTMLHelpFile.LoadIndex: boolean;
-begin
-  IndexEntries^.Insert(NewIndexEntry(TOCEntry,ID,0));
-  LoadIndex:=true;
-end;
-
-function THTMLHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
+function TCustomHTMLHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
 function MatchCtx(P: PTopic): boolean; {$ifndef FPC}far;{$endif}
 begin
   MatchCtx:=P^.HelpCtx=HelpCtx;
@@ -582,7 +559,7 @@ begin
       if P=nil then
         begin
           if LinkNo=0 then
-            FName:=FileName
+            FName:=DefaultFileName
           else
             FName:=TopicLinks^.At(LinkNo-1)^;
           P:=NewTopic(ID,HelpCtx,0,FName);
@@ -592,7 +569,7 @@ begin
   SearchTopic:=P;
 end;
 
-function THTMLHelpFile.ReadTopic(T: PTopic): boolean;
+function TCustomHTMLHelpFile.ReadTopic(T: PTopic): boolean;
 var OK: boolean;
     HTMLFile: PMemoryTextFile;
     Name: string;
@@ -602,7 +579,7 @@ begin
   OK:=T<>nil;
   if OK then
     begin
-      if T^.HelpCtx=0 then Name:=FileName else
+      if T^.HelpCtx=0 then Name:=DefaultFileName else
         begin
           Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
           Link:=FormatPath(Link);
@@ -628,11 +605,73 @@ begin
   ReadTopic:=OK;
 end;
 
-destructor THTMLHelpFile.Done;
+destructor TCustomHTMLHelpFile.Done;
 begin
   inherited Done;
   if Renderer<>nil then Dispose(Renderer, Done);
   if TopicLinks<>nil then Dispose(TopicLinks, Done);
 end;
 
+constructor THTMLHelpFile.Init(AFileName: string; AID: word; ATOCEntry: string);
+begin
+  if inherited Init(AID)=false then Fail;
+  DefaultFileName:=AFileName; TOCEntry:=ATOCEntry;
+  if DefaultFileName='' then
+  begin
+    Done;
+    Fail;
+  end;
+end;
+
+function THTMLHelpFile.LoadIndex: boolean;
+begin
+  IndexEntries^.Insert(NewIndexEntry(TOCEntry,ID,0));
+  LoadIndex:=true;
+end;
+
+constructor THTMLIndexHelpFile.Init(AFileName: string; AID: word);
+begin
+  inherited Init(AID);
+  IndexFileName:=AFileName;
+end;
+
+function THTMLIndexHelpFile.LoadIndex: boolean;
+function FormatAlias(Alias: string): string;
+begin
+  if Assigned(HelpFacility) then
+    if length(Alias)>HelpFacility^.IndexTabSize-4 then
+      Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
+  FormatAlias:=Alias;
+end;
+procedure AddDoc(P: PHTMLLinkScanDocument); {$ifndef FPC}far;{$endif}
+var I: sw_integer;
+    TLI: THelpCtx;
+begin
+  for I:=1 to P^.GetAliasCount do
+  begin
+    TLI:=TopicLinks^.AddItem(P^.GetName);
+    TLI:=EncodeHTMLCtx(ID,TLI+1);
+    IndexEntries^.Insert(NewIndexEntry(FormatAlias(P^.GetAlias(I-1)),ID,TLI));
+  end;
+end;
+var S: PBufStream;
+    DC: PHTMLLinkScanDocumentCollection;
+    OK: boolean;
+begin
+  New(S, Init(IndexFileName,stOpenRead,4096));
+  OK:=Assigned(S);
+  if OK then
+  begin
+    New(DC, Load(S^));
+    OK:=Assigned(DC);
+    if OK then
+    begin
+      DC^.ForEach(@AddDoc);
+      Dispose(DC, Done);
+    end;
+    Dispose(S, Done);
+  end;
+  LoadIndex:=OK;
+end;
+
 END.

ide/text/whtmlscn.pas

@@ -0,0 +1,450 @@
+{
+    $Id$
+    This file is part of the Free Pascal Integrated Development Environment
+    Copyright (c) 2000 by Berczi Gabor
+
+    HTML scanner objects
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit WHTMLScn;
+
+interface
+
+uses Objects,
+     WHTML;
+
+type
+     TCustomHTMLLinkScanner = object(THTMLParser)
+       function    DocAddTextChar(C: char): boolean; virtual;
+       procedure   DocAnchor(Entered: boolean); virtual;
+     public
+    {a}function    CheckURL(const URL: string): boolean; virtual;
+    {a}function    CheckText(const Text: string): boolean; virtual;
+    {a}procedure   AddLink(const LinkText, LinkURL: string); virtual;
+    {a}function    GetDocumentBaseURL: string; virtual;
+     private
+       CurLinkText: string;
+       CurURL: string;
+       InAnchor: boolean;
+     end;
+
+     PHTMLLinkScanDocument = ^THTMLLinkScanDocument;
+     THTMLLinkScanDocument = object(TObject)
+       constructor Init(const ADocName: string);
+       function    GetName: string;
+       function    GetAliasCount: sw_integer;
+       function    GetAlias(Index: sw_integer): string;
+       procedure   AddAlias(const Alias: string);
+       constructor Load(var S: TStream);
+       procedure   Store(var S: TStream);
+       destructor  Done; virtual;
+     private
+       DocName: PString;
+       Aliases: PStringCollection;
+     end;
+
+     PHTMLLinkScanDocumentCollection = ^THTMLLinkScanDocumentCollection;
+     THTMLLinkScanDocumentCollection = object(TSortedCollection)
+       function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
+       function At(Index: sw_Integer): PHTMLLinkScanDocument;
+       function SearchDocument(const DocName: string): PHTMLLinkScanDocument;
+     end;
+
+     THTMLLinkScanner = object(TCustomHTMLLinkScanner)
+       constructor Init;
+       function    GetDocumentCount: sw_integer;
+       function    GetDocumentURL(DocIndex: sw_integer): string;
+       function    GetDocumentAliasCount(DocIndex: sw_integer): sw_integer;
+       function    GetDocumentAlias(DocIndex, AliasIndex: sw_integer): string;
+       procedure   StoreDocuments(var S: TStream);
+       destructor  Done; virtual;
+     public
+       procedure   AddLink(const LinkText, LinkURL: string); virtual;
+     private
+       Documents: PHTMLLinkScanDocumentCollection;
+     end;
+
+     THTMLLinkScanState = (ssScheduled,ssProcessing,ssScanned);
+
+     PHTMLLinkScanFile = ^THTMLLinkScanFile;
+     THTMLLinkScanFile = object(TObject)
+       constructor Init(const ADocumentURL: string);
+       function    GetDocumentURL: string;
+       destructor  Done; virtual;
+     private
+       DocumentURL  : PString;
+     public
+       State        : THTMLLinkScanState;
+     end;
+
+     PHTMLLinkScanFileCollection = ^THTMLLinkScanFileCollection;
+     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;
+     end;
+
+     THTMLLinkScanOption = (soSubDocsOnly);
+     THTMLLinkScanOptions = set of THTMLLinkScanOption;
+
+     THTMLFileLinkScanner = object(THTMLLinkScanner)
+       constructor Init;
+       procedure   ProcessDocument(const DocumentURL: string; AOptions: THTMLLinkScanOptions);
+       destructor  Done; virtual;
+     public
+       function    GetDocumentBaseURL: string; virtual;
+       procedure   AddLink(const LinkText, LinkURL: string); virtual;
+       function    CheckURL(const URL: string): boolean; virtual;
+     private
+       Options: THTMLLinkScanOptions;
+       BaseURL: string;
+       CurBaseURL: string;
+       DocumentFiles: PHTMLLinkScanFileCollection;
+       procedure   ScheduleDoc(const DocumentURL: string);
+     public
+       procedure   ProcessDoc(Doc: PHTMLLinkScanFile); virtual;
+     end;
+
+procedure RegisterWHTMLScan;
+
+implementation
+
+uses WUtils;
+
+const
+  RHTMLLinkScanDocument: TStreamRec = (
+     ObjType: 19500;
+     VmtLink: Ofs(TypeOf(THTMLLinkScanDocument)^);
+     Load:    @THTMLLinkScanDocument.Load;
+     Store:   @THTMLLinkScanDocument.Store
+  );
+
+function TCustomHTMLLinkScanner.DocAddTextChar(C: char): boolean;
+begin
+  if InAnchor then
+    CurLinkText:=CurLinkText+C;
+end;
+
+procedure TCustomHTMLLinkScanner.DocAnchor(Entered: boolean);
+begin
+  if Entered then
+    begin
+      CurLinkText:='';
+      if DocGetTagParam('HREF',CurURL)=false then CurURL:='';
+      CurURL:=Trim(CurURL);
+      CurURL:=CompleteURL(GetDocumentBaseURL,CurURL);
+    end
+  else
+    begin
+      CurLinkText:=Trim(CurLinkText);
+      if CheckURL(CurURL) and CheckText(CurLinkText) then
+        AddLink(CurLinkText,CurURL);
+    end;
+  InAnchor:=Entered;
+end;
+
+function TCustomHTMLLinkScanner.GetDocumentBaseURL: string;
+begin
+  { Abstract }
+  GetDocumentBaseURL:='';
+end;
+
+function TCustomHTMLLinkScanner.CheckURL(const URL: string): boolean;
+begin
+  { Abstract }
+  CheckURL:=true;
+end;
+
+function TCustomHTMLLinkScanner.CheckText(const Text: string): boolean;
+begin
+  { Abstract }
+  CheckText:=true;
+end;
+
+procedure TCustomHTMLLinkScanner.AddLink(const LinkText, LinkURL: string);
+begin
+  { Abstract }
+end;
+
+constructor THTMLLinkScanDocument.Init(const ADocName: string);
+begin
+  inherited Init;
+  SetStr(DocName,ADocName);
+  New(Aliases, Init(10,10));
+end;
+
+function THTMLLinkScanDocument.GetName: string;
+begin
+  GetName:=GetStr(DocName);
+end;
+
+function THTMLLinkScanDocument.GetAliasCount: sw_integer;
+begin
+  GetAliasCount:=Aliases^.Count;
+end;
+
+function THTMLLinkScanDocument.GetAlias(Index: sw_integer): string;
+begin
+  GetAlias:=GetStr(Aliases^.At(Index));
+end;
+
+procedure THTMLLinkScanDocument.AddAlias(const Alias: string);
+begin
+  Aliases^.Insert(NewStr(Alias));
+end;
+
+constructor THTMLLinkScanDocument.Load(var S: TStream);
+begin
+  inherited Init;
+  DocName:=S.ReadStr;
+  New(Aliases, Load(S));
+end;
+
+procedure THTMLLinkScanDocument.Store(var S: TStream);
+var I: integer;
+begin
+  S.WriteStr(DocName);
+  Aliases^.Store(S);
+end;
+
+destructor THTMLLinkScanDocument.Done;
+begin
+  inherited Done;
+  if Assigned(Aliases) then Dispose(Aliases, Done); Aliases:=nil;
+  if Assigned(DocName) then DisposeStr(DocName); DocName:=nil;
+end;
+
+function THTMLLinkScanDocumentCollection.Compare(Key1, Key2: Pointer): sw_Integer;
+var R: sw_integer;
+    K1: PHTMLLinkScanDocument absolute Key1;
+    K2: PHTMLLinkScanDocument absolute Key2;
+    S1,S2: string;
+begin
+  S1:=UpcaseStr(K1^.GetName); S2:=UpcaseStr(K2^.GetName);
+  if S1<S2 then R:=-1 else
+  if S1>S2 then R:= 1 else
+  R:=0;
+  Compare:=R;
+end;
+
+function THTMLLinkScanDocumentCollection.At(Index: sw_Integer): PHTMLLinkScanDocument;
+begin
+  At:=inherited At(Index);
+end;
+
+function THTMLLinkScanDocumentCollection.SearchDocument(const DocName: string): PHTMLLinkScanDocument;
+var D,P: PHTMLLinkScanDocument;
+    Index: sw_integer;
+begin
+  New(D, Init(DocName));
+  if Search(D, Index)=false then P:=nil else
+    P:=At(Index);
+  Dispose(D, Done);
+  SearchDocument:=P;
+end;
+
+constructor THTMLLinkScanner.Init;
+begin
+  inherited Init;
+  New(Documents, Init(50,100));
+end;
+
+function THTMLLinkScanner.GetDocumentCount: sw_integer;
+begin
+  GetDocumentCount:=Documents^.Count;
+end;
+
+function THTMLLinkScanner.GetDocumentURL(DocIndex: sw_integer): string;
+begin
+  GetDocumentURL:=Documents^.At(DocIndex)^.GetName;
+end;
+
+function THTMLLinkScanner.GetDocumentAliasCount(DocIndex: sw_integer): sw_integer;
+begin
+  GetDocumentAliasCount:=Documents^.At(DocIndex)^.GetAliasCount;
+end;
+
+function THTMLLinkScanner.GetDocumentAlias(DocIndex, AliasIndex: sw_integer): string;
+begin
+  GetDocumentAlias:=Documents^.At(DocIndex)^.GetAlias(AliasIndex);
+end;
+
+procedure THTMLLinkScanner.AddLink(const LinkText, LinkURL: string);
+var D: PHTMLLinkScanDocument;
+begin
+  D:=Documents^.SearchDocument(LinkURL);
+  if D=nil then
+  begin
+    New(D, Init(LinkURL));
+    Documents^.Insert(D);
+  end;
+  D^.AddAlias(LinkText);
+end;
+
+procedure THTMLLinkScanner.StoreDocuments(var S: TStream);
+begin
+  Documents^.Store(S);
+end;
+
+destructor THTMLLinkScanner.Done;
+begin
+  inherited Done;
+  if Assigned(Documents) then Dispose(Documents, Done); Documents:=nil;
+end;
+
+constructor THTMLLinkScanFile.Init(const ADocumentURL: string);
+begin
+  inherited Init;
+  SetStr(DocumentURL,ADocumentURL);
+end;
+
+function THTMLLinkScanFile.GetDocumentURL: string;
+begin
+  GetDocumentURL:=GetStr(DocumentURL);
+end;
+
+destructor THTMLLinkScanFile.Done;
+begin
+  inherited Done;
+  if Assigned(DocumentURL) then DisposeStr(DocumentURL); DocumentURL:=nil;
+end;
+
+function THTMLLinkScanFileCollection.At(Index: sw_Integer): PHTMLLinkScanFile;
+begin
+  At:=inherited At(Index);
+end;
+
+function THTMLLinkScanFileCollection.Compare(Key1, Key2: Pointer): sw_Integer;
+var R: integer;
+    K1: PHTMLLinkScanFile absolute Key1;
+    K2: PHTMLLinkScanFile absolute Key2;
+    S1,S2: string;
+begin
+  S1:=UpcaseStr(K1^.GetDocumentURL); S2:=UpcaseStr(K2^.GetDocumentURL);
+  if S1<S2 then R:=-1 else
+  if S1>S2 then R:= 1 else
+  R:=0;
+  Compare:=R;
+end;
+
+function THTMLLinkScanFileCollection.SearchFile(const DocURL: string): PHTMLLinkScanFile;
+var P,D: PHTMLLinkScanFile;
+    Index: sw_integer;
+begin
+  New(D, Init(DocURL));
+  if Search(D,Index)=false then P:=nil else
+    P:=At(Index);
+  Dispose(D, Done);
+  SearchFile:=P;
+end;
+
+function THTMLLinkScanFileCollection.FindFileWithState(AState: THTMLLinkScanState): PHTMLLinkScanFile;
+var I: sw_integer;
+    P,D: PHTMLLinkScanFile;
+begin
+  P:=nil;
+  for I:=0 to Count-1 do
+  begin
+    D:=At(I);
+    if D^.State=AState then
+      begin
+        P:=D;
+        Break;
+      end;
+  end;
+  FindFileWithState:=P;
+end;
+
+constructor THTMLFileLinkScanner.Init;
+begin
+  inherited Init;
+  New(DocumentFiles, Init(50,100));
+end;
+
+procedure THTMLFileLinkScanner.ProcessDocument(const DocumentURL: string; AOptions: THTMLLinkScanOptions);
+var P: PHTMLLinkScanFile;
+begin
+  CurBaseURL:=''; Options:=AOptions;
+  ScheduleDoc(DocumentURL);
+  repeat
+    P:=DocumentFiles^.FindFileWithState(ssScheduled);
+    if Assigned(P) then
+      ProcessDoc(P);
+  until P=nil;
+end;
+
+function THTMLFileLinkScanner.GetDocumentBaseURL: string;
+begin
+  GetDocumentBaseURL:=CurBaseURL;
+end;
+
+function THTMLFileLinkScanner.CheckURL(const URL: string): boolean;
+var OK: boolean;
+begin
+  if soSubDocsOnly in Options then
+    OK:=UpcaseStr(copy(URL,1,length(BaseURL)))=UpcaseStr(BaseURL)
+  else
+    OK:=true;
+  CheckURL:=OK;
+end;
+
+procedure THTMLFileLinkScanner.AddLink(const LinkText, LinkURL: string);
+var D: PHTMLLinkScanFile;
+begin
+  D:=DocumentFiles^.SearchFile(LinkURL);
+  if Assigned(D)=false then
+    ScheduleDoc(LinkURL);
+  inherited AddLink(LinkText,LinkURL);
+end;
+
+procedure THTMLFileLinkScanner.ProcessDoc(Doc: PHTMLLinkScanFile);
+var F: PDOSTextFile;
+begin
+  if Assigned(Doc)=false then Exit;
+
+  Doc^.State:=ssProcessing;
+  New(F, Init(Doc^.GetDocumentURL));
+  if Assigned(F) then
+  begin
+    CurBaseURL:=CompleteURL(Doc^.GetDocumentURL,'');
+    Process(F);
+    Dispose(F, Done);
+  end;
+  Doc^.State:=ssScanned;
+end;
+
+procedure THTMLFileLinkScanner.ScheduleDoc(const DocumentURL: string);
+var D: PHTMLLinkScanFile;
+begin
+  New(D, Init(DocumentURL));
+  D^.State:=ssScheduled;
+  DocumentFiles^.Insert(D);
+end;
+
+destructor THTMLFileLinkScanner.Done;
+begin
+  inherited Done;
+  if Assigned(DocumentFiles) then Dispose(DocumentFiles, Done); DocumentFiles:=nil;
+end;
+
+procedure RegisterWHTMLScan;
+begin
+  RegisterType(RHTMLLinkScanDocument);
+end;
+
+
+END.
+{
+  $Log$
+  Revision 1.1  2000-04-25 08:42:32  pierre
+   * New Gabor changes : see fixes.txt
+
+}

ide/text/winclip.pas

@@ -34,10 +34,12 @@ implementation
 {$ifdef WinClipSupported}
 {$ifdef DOS}
   uses
+    pmode,
 {$ifdef go32v2}
-    go32,{ sorry Gabor, but its still not compiling without that ! }
+    {go32   sorry Gabor, but its still not compiling without that ! }
+    {now it works. btw. you don't have to sorry - just to tell me... ;)) Gabor }
 {$endif go32v2}
-    strings,dos,pmode;
+    strings,dos;
 {$endif DOS}
 
 {$ifdef win32}
@@ -140,8 +142,7 @@ function GetTextWinClipBoardData(var p : pchar;var l : longint) : boolean;
 var
 {$ifdef DOS}
   r : Registers;
-  tb_all : longint;
-  tb_seg,tb_ofs,tb_sel : word;
+  M : MemPtr;
 {$endif DOS}
 {$ifdef win32}
   h : HGlobal;
@@ -152,43 +153,23 @@ begin
   GetTextWinClipBoardData:=False;
   if not OpenWinClipBoard then
     exit;
-{$ifdef go32v2}
+{$ifdef DOS}
   l:=InternGetDataSize;
-  if (l=0) or (l>100000) then
+  if (l=0) or (l>65520) then
     begin
       l:=0;
       CloseWinClipBoard;
       exit;
     end;
   GetMem(p,l);
-  if l>tb_size then
-    begin
-      tb_all:=global_dos_alloc(l);
-      { zero means allocation failure }
-      if tb_all=0 then
-        begin
-          FreeMem(p,l);
-          p:=nil;
-          l:=0;
-          CloseWinClipBoard;
-          exit;
-        end;
-      tb_seg:=tb_all shr 16;
-      tb_sel:=tb_all and $ffff;
-    end
-  else
-    begin
-      tb_seg:=tb_segment;
-      tb_ofs:=tb_offset;
-      tb_sel:=0;
-    end;
+  GetDosMem(M,l);
   r.ax:=$1705;
   r.dx:=7{ OEM Text rather then 1 : Text };
-  r.es:=tb_seg;
-  r.bx:=tb_ofs;
+  r.es:=M.DosSeg;
+  r.bx:=M.DosOfs;
   RealIntr($2F,r);
   GetTextWinClipBoardData:=(r.ax<>0);
-{$endif go32v2}
+{$endif DOS}
 {$ifdef win32}
   h:=GetClipboardData(CF_OEMTEXT);
   if h<>0 then
@@ -202,19 +183,17 @@ begin
   GetTextWinClipBoardData:=h<>0;
 {$endif win32}
   CloseWinClipBoard;
-{$ifdef go32v2}
-  DosMemGet(tb_seg,tb_ofs,p^,l);
-  if tb_sel<>0 then
-    global_dos_free(tb_sel);
-{$endif go32v2}
+{$ifdef DOS}
+  M.MoveDataFrom(l,P^);
+  FreeDosMem(M);
+{$endif DOS}
 end;
 
 function SetTextWinClipBoardData(p : pchar;l : longint) : boolean;
 var
 {$ifdef DOS}
   r : Registers;
-  tb_all : longint;
-  tb_seg,tb_ofs,tb_sel : word;
+  M : MemPtr;
 {$endif DOS}
 {$ifdef win32}
   h : HGlobal;
@@ -222,42 +201,24 @@ var
 {$endif win32}
 begin
   SetTextWinClipBoardData:=False;
-  if (l=0) or (l>100000) then
+  if (l=0) or (l>65520) then
     exit;
   if not OpenWinClipBoard then
     exit;
   EmptyWinClipBoard;
-{$ifdef go32v2}
-  if l>tb_size then
-    begin
-      tb_all:=global_dos_alloc(l);
-      { zero means allocation failure }
-      if tb_all=0 then
-        begin
-          CloseWinClipBoard;
-          exit;
-        end;
-      tb_seg:=tb_all shr 16;
-      tb_sel:=tb_all and $ffff;
-    end
-  else
-    begin
-      tb_seg:=tb_segment;
-      tb_ofs:=tb_offset;
-      tb_sel:=0;
-    end;
-  DosMemPut(tb_seg,tb_ofs,p^,l);
+{$ifdef DOS}
+  GetDosMem(M,l);
+  M.MoveDataTo(P^,l);
   r.ax:=$1703;
   r.dx:=7{ OEM Text rather then 1 : Text };
-  r.es:=tb_seg;
-  r.bx:=tb_ofs;
+  r.es:=M.DosSeg;
+  r.bx:=M.DosOfs;
   r.si:=l shr 16;
   r.cx:=l and $ffff;
   RealIntr($2F,r);
   SetTextWinClipBoardData:=(r.ax<>0);
-  if tb_sel<>0 then
-    global_dos_free(tb_sel);
-{$endif go32v2}
+  FreeDosMem(M);
+{$endif DOS}
 {$ifdef win32}
   h:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,l);
   pp:=pchar(GlobalLock(h));
@@ -273,7 +234,10 @@ end.
 
 {
  $Log$
- Revision 1.5  2000-04-18 11:42:39  pierre
+ Revision 1.6  2000-04-25 08:42:35  pierre
+  * New Gabor changes : see fixes.txt
+
+ Revision 1.5  2000/04/18 11:42:39  pierre
   lot of Gabor changes : see fixes.txt
 
  Revision 1.4  1999/11/05 13:46:26  pierre

ide/text/wutils.pas

@@ -81,7 +81,7 @@ function eofstream(s: pstream): boolean;
 function Min(A,B: longint): longint;
 function Max(A,B: longint): longint;
 
-function CharStr(C: char; Count: byte): string;
+function CharStr(C: char; Count: integer): string;
 function UpcaseStr(const S: string): string;
 function LowCase(C: char): char;
 function LowcaseStr(S: string): string;
@@ -109,6 +109,10 @@ function GetLongName(const n:string):string;
 function TrimEndSlash(const Path: string): string;
 function CompareText(S1, S2: string): integer;
 
+function FormatPath(Path: string): string;
+function CompletePath(const Base, InComplete: string): string;
+function CompleteURL(const Base, URLRef: string): string;
+
 function EatIO: integer;
 
 procedure GiveUpTimeSlice;
@@ -210,7 +214,7 @@ begin
   if A<B then Min:=A else Min:=B;
 end;
 
-function CharStr(C: char; Count: byte): string;
+function CharStr(C: char; Count: integer): string;
 {$ifndef FPC}
 var S: string;
 {$endif}
@@ -660,6 +664,59 @@ begin
   CompareText:=R;
 end;
 
+function FormatPath(Path: string): string;
+var P: sw_integer;
+    SC: char;
+begin
+  if ord(DirSep)=ord('/') then
+    SC:='\'
+  else
+    SC:='/';
+
+  repeat
+    P:=Pos(SC,Path);
+    if P>0 then Path[P]:=DirSep;
+  until P=0;
+  FormatPath:=Path;
+end;
+
+function CompletePath(const Base, InComplete: string): string;
+var Drv,BDrv: string[40]; D,BD: DirStr; N,BN: NameStr; E,BE: ExtStr;
+    P: sw_integer;
+    Complete: string;
+begin
+  Complete:=FormatPath(InComplete);
+  FSplit(FormatPath(InComplete),D,N,E);
+  P:=Pos(':',D); if P=0 then Drv:='' else begin Drv:=copy(D,1,P); Delete(D,1,P); end;
+  FSplit(FormatPath(Base),BD,BN,BE);
+  P:=Pos(':',BD); if P=0 then BDrv:='' else begin BDrv:=copy(BD,1,P); Delete(BD,1,P); end;
+  if copy(D,1,1)<>'\' then
+    Complete:=BD+D+N+E;
+  if Drv='' then
+    Complete:=BDrv+Complete;
+  Complete:=FExpand(Complete);
+  CompletePath:=Complete;
+end;
+
+function CompleteURL(const Base, URLRef: string): string;
+var P: integer;
+    Drive: string[20];
+    IsComplete: boolean;
+    S: string;
+begin
+  IsComplete:=false;
+  P:=Pos(':',URLRef);
+  if P=0 then Drive:='' else Drive:=UpcaseStr(copy(URLRef,1,P-1));
+  if Drive<>'' then
+  if (Drive='MAILTO') or (Drive='FTP') or (Drive='HTTP') or
+     (Drive='GOPHER') or (Drive='FILE') then
+    IsComplete:=true;
+  if IsComplete then S:=URLRef else
+    S:=CompletePath(Base,URLRef);
+  CompleteURL:=S;
+end;
+
+
 procedure GiveUpTimeSlice;
 {$ifdef GO32V2}{$define DOS}{$endif}
 {$ifdef TP}{$define DOS}{$endif}
@@ -691,7 +748,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.19  2000-04-18 11:42:39  pierre
+  Revision 1.20  2000-04-25 08:42:36  pierre
+   * New Gabor changes : see fixes.txt
+
+  Revision 1.19  2000/04/18 11:42:39  pierre
    lot of Gabor changes : see fixes.txt
 
   Revision 1.18  2000/03/21 23:19:13  pierre